OSDN Git Service

2a077629a6d2aff5a67280b2aa44f5eaaf85b253
[pf3gnuchains/gcc-fork.git] / libgfortran / io / io.h
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
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 3, 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 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/>.  */
26
27 #ifndef GFOR_IO_H
28 #define GFOR_IO_H
29
30 /* IO library include.  */
31
32 #include "libgfortran.h"
33
34 #include <setjmp.h>
35 #include <gthr.h>
36
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
45 struct st_parameter_dt;
46
47 typedef struct stream
48 {
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 *);
57 }
58 stream;
59
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 }
66
67 static inline ssize_t
68 swrite (stream * s, const void * buf, ssize_t nbyte)
69 {
70   return s->write (s, buf, nbyte);
71 }
72
73 static inline off_t
74 sseek (stream * s, off_t offset, int whence)
75 {
76   return s->seek (s, offset, whence);
77 }
78
79 static inline off_t
80 stell (stream * s)
81 {
82   return s->tell (s);
83 }
84
85 static inline int
86 struncate (stream * s, off_t length)
87 {
88   return s->trunc (s, length);
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 }
102
103
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
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
114    is used.  */
115
116 typedef struct array_loop_spec
117 {
118   /* Index counter for this dimension.  */
119   ssize_t idx;
120
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 }
130 array_loop_spec;
131
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
144 /* Representation of a namelist object in libgfortran
145
146    Namelist Records
147       &GROUPNAME  OBJECT=value[s] [,OBJECT=value[s]].../
148      or
149       &GROUPNAME  OBJECT=value[s] [,OBJECT=value[s]]...&END
150
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.
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
161    arrays.  */
162
163 typedef struct namelist_type
164 {
165   /* Object type, stored as GFC_DTYPE_xxxx.  */
166   dtype type;
167
168   /* Object name.  */
169   char * var_name;
170
171   /* Address for the start of the object's data.  */
172   void * mem_pos;
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.  */
178   int len;
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;
190   array_loop_spec * ls;
191   struct namelist_type * next;
192 }
193 namelist_info;
194
195 /* Options for the OPEN statement.  */
196
197 typedef enum
198 { ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_STREAM,
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
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
258 typedef enum
259 { ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED }
260 unit_advance;
261
262 typedef enum
263 {READING, WRITING}
264 unit_mode;
265
266 typedef enum
267 { ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED }
268 unit_async;
269
270 typedef enum
271 { SIGN_S, SIGN_SS, SIGN_SP }
272 unit_sign_s;
273
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
281 typedef struct
282 {
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);
294   CHARACTER1 (convert);
295   CHARACTER2 (decimal);
296   CHARACTER1 (encoding);
297   CHARACTER2 (round);
298   CHARACTER1 (sign);
299   CHARACTER2 (asynchronous);
300   GFC_INTEGER_4 *newunit;
301 }
302 st_parameter_open;
303
304 #define IOPARM_CLOSE_HAS_STATUS         (1 << 7)
305
306 typedef struct
307 {
308   st_parameter_common common;
309   CHARACTER1 (status);
310 }
311 st_parameter_close;
312
313 typedef struct
314 {
315   st_parameter_common common;
316 }
317 st_parameter_filepos;
318
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)
344
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)
353
354 typedef struct
355 {
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;
360   CHARACTER1 (file);
361   CHARACTER2 (access);
362   CHARACTER1 (form);
363   CHARACTER2 (blank);
364   CHARACTER1 (position);
365   CHARACTER2 (action);
366   CHARACTER1 (delim);
367   CHARACTER2 (pad);
368   CHARACTER1 (name);
369   CHARACTER2 (sequential);
370   CHARACTER1 (direct);
371   CHARACTER2 (formatted);
372   CHARACTER1 (unformatted);
373   CHARACTER2 (read);
374   CHARACTER1 (write);
375   CHARACTER2 (readwrite);
376   CHARACTER1 (convert);
377   GFC_INTEGER_4 flags2;
378   CHARACTER1 (asynchronous);
379   CHARACTER2 (decimal);
380   CHARACTER1 (encoding);
381   CHARACTER2 (round);
382   CHARACTER1 (sign);
383   GFC_INTEGER_4 *pending;
384   GFC_INTEGER_4 *size;
385   GFC_INTEGER_4 *id;
386 }
387 st_parameter_inquire;
388
389 struct gfc_unit;
390 struct format_data;
391
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)
413
414
415 typedef struct st_parameter_dt
416 {
417   st_parameter_common common;
418   GFC_IO_INT rec;
419   GFC_IO_INT *size, *iolength;
420   gfc_array_char *internal_unit_desc;
421   CHARACTER1 (format);
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.  */
427   union
428     {
429       struct
430         {
431           void (*transfer) (struct st_parameter_dt *, bt, void *, int,
432                             size_t, size_t);
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.  */
436           int item_count;
437           unit_mode mode;
438           unit_blank blank_status;
439           unit_sign sign_status;
440           int scale_factor;
441           int max_pos; /* Maximum righthand column written to.  */
442           /* Number of skips + spaces to be done for T and X-editing.  */
443           int skips;
444           /* Number of spaces to be done for T and X-editing.  */
445           int pending_spaces;
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) */
450           int sf_seen_eor;
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;
459           unsigned at_eol : 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
477              unit is internal.  */
478           unsigned unit_is_internal : 1;
479           /* An internal unit specific flag to signify an EOF condition for list
480              directed read.  */
481           unsigned at_eof : 1;
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.  */
487
488           char last_char;
489           char nml_delim;
490
491           int repeat_count;
492           int saved_length;
493           int saved_used;
494           bt saved_type;
495           char *saved_string;
496           char *scratch;
497           char *line_buffer;
498           struct format_data *fmt;
499           jmp_buf *eof_jump;
500           namelist_info *ionml;
501           /* A flag used to identify when a non-standard expanded namelist read
502              has occurred.  */
503           int expanded_read;
504           /* Storage area for values except for strings.  Must be
505              large enough to hold a complex value (two reals) of the
506              largest kind.  */
507           char value[32];
508           GFC_IO_INT size_used;
509         } p;
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)];
514     } u;
515   GFC_INTEGER_4 *id;
516   GFC_IO_INT pos;
517   CHARACTER1 (asynchronous);
518   CHARACTER2 (blank);
519   CHARACTER1 (decimal);
520   CHARACTER2 (delim);
521   CHARACTER1 (pad);
522   CHARACTER2 (round);
523   CHARACTER1 (sign);
524 }
525 st_parameter_dt;
526
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)
530                                   ? 1 : -1];
531
532 #define IOPARM_WAIT_HAS_ID              (1 << 7)
533
534 typedef struct
535 {
536   st_parameter_common common;
537   CHARACTER1 (id);
538 }
539 st_parameter_wait;
540
541
542 #undef CHARACTER1
543 #undef CHARACTER2
544
545 typedef struct
546 {
547   unit_access access;
548   unit_action action;
549   unit_blank blank;
550   unit_delim delim;
551   unit_form form;
552   int is_notpadded;
553   unit_position position;
554   unit_status status;
555   unit_pad pad;
556   unit_convert convert;
557   int has_recl;
558   unit_decimal decimal;
559   unit_encoding encoding;
560   unit_round round;
561   unit_sign sign;
562   unit_async async;
563 }
564 unit_flags;
565
566
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. */
574
575 typedef struct fbuf
576 {
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.  */
581 }
582 fbuf;
583
584
585 typedef struct gfc_unit
586 {
587   int unit_number;
588   stream *s;
589   
590   /* Treap links.  */
591   struct gfc_unit *left, *right;
592   int priority;
593
594   int read_bad, current_record, saved_pos, previous_nonadvancing_write;
595
596   enum
597   { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
598   endfile;
599
600   unit_mode mode;
601   unit_flags flags;
602   unit_pad pad_status;
603   unit_decimal decimal_status;
604   unit_delim delim_status;
605
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;
615
616   /* Set to 1 if we have read a subrecord.  */
617
618   int continued;
619
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.  */
627   int waiting;
628   /* Flag set by close_unit if the unit as been closed.
629      Must be manipulated under unit's lock.  */
630   int closed;
631
632   /* For traversing arrays */
633   array_loop_spec *ls;
634   int rank;
635
636   int file_len;
637   char *file;
638
639   /* The format hash table.  */
640   struct format_hash_entry format_hash_table[FORMAT_HASH_SIZE];
641   
642   /* Formatting buffer.  */
643   struct fbuf *fbuf;
644 }
645 gfc_unit;
646
647 /* Format tokens.  Only about half of these can be stored in the
648    format nodes.  */
649
650 typedef enum
651 {
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,
657   FMT_DP
658 }
659 format_token;
660
661
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.  */
664
665 typedef struct fnode
666 {
667   format_token format;
668   int repeat;
669   struct fnode *next;
670   char *source;
671
672   union
673   {
674     struct
675     {
676       int w, d, e;
677     }
678     real;
679
680     struct
681     {
682       int length;
683       char *p;
684     }
685     string;
686
687     struct
688     {
689       int w, m;
690     }
691     integer;
692
693     int w;
694     int k;
695     int r;
696     int n;
697
698     struct fnode *child;
699   }
700   u;
701
702   /* Members for traversing the tree during data transfer.  */
703
704   int count;
705   struct fnode *current;
706
707 }
708 fnode;
709
710
711 /* unix.c */
712
713 extern int compare_files (stream *, stream *);
714 internal_proto(compare_files);
715
716 extern stream *open_external (st_parameter_open *, unit_flags *);
717 internal_proto(open_external);
718
719 extern stream *open_internal (char *, int, gfc_offset);
720 internal_proto(open_internal);
721
722 extern char * mem_alloc_w (stream *, int *);
723 internal_proto(mem_alloc_w);
724
725 extern char * mem_alloc_r (stream *, int *);
726 internal_proto(mem_alloc_w);
727
728 extern stream *input_stream (void);
729 internal_proto(input_stream);
730
731 extern stream *output_stream (void);
732 internal_proto(output_stream);
733
734 extern stream *error_stream (void);
735 internal_proto(error_stream);
736
737 extern int compare_file_filename (gfc_unit *, const char *, int);
738 internal_proto(compare_file_filename);
739
740 extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len);
741 internal_proto(find_file);
742
743 extern int delete_file (gfc_unit *);
744 internal_proto(delete_file);
745
746 extern int file_exists (const char *file, gfc_charlen_type file_len);
747 internal_proto(file_exists);
748
749 extern const char *inquire_sequential (const char *, int);
750 internal_proto(inquire_sequential);
751
752 extern const char *inquire_direct (const char *, int);
753 internal_proto(inquire_direct);
754
755 extern const char *inquire_formatted (const char *, int);
756 internal_proto(inquire_formatted);
757
758 extern const char *inquire_unformatted (const char *, int);
759 internal_proto(inquire_unformatted);
760
761 extern const char *inquire_read (const char *, int);
762 internal_proto(inquire_read);
763
764 extern const char *inquire_write (const char *, int);
765 internal_proto(inquire_write);
766
767 extern const char *inquire_readwrite (const char *, int);
768 internal_proto(inquire_readwrite);
769
770 extern gfc_offset file_length (stream *);
771 internal_proto(file_length);
772
773 extern int is_seekable (stream *);
774 internal_proto(is_seekable);
775
776 extern int is_special (stream *);
777 internal_proto(is_special);
778
779 extern void flush_if_preconnected (stream *);
780 internal_proto(flush_if_preconnected);
781
782 extern void empty_internal_buffer(stream *);
783 internal_proto(empty_internal_buffer);
784
785 extern int stream_isatty (stream *);
786 internal_proto(stream_isatty);
787
788 extern char * stream_ttyname (stream *);
789 internal_proto(stream_ttyname);
790
791 extern int unpack_filename (char *, const char *, int);
792 internal_proto(unpack_filename);
793
794 /* unit.c */
795
796 /* Maximum file offset, computed at library initialization time.  */
797 extern gfc_offset max_offset;
798 internal_proto(max_offset);
799
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);
803
804 /* Unit tree root.  */
805 extern gfc_unit *unit_root;
806 internal_proto(unit_root);
807
808 extern __gthread_mutex_t unit_lock;
809 internal_proto(unit_lock);
810
811 extern int close_unit (gfc_unit *);
812 internal_proto(close_unit);
813
814 extern gfc_unit *get_internal_unit (st_parameter_dt *);
815 internal_proto(get_internal_unit);
816
817 extern void free_internal_unit (st_parameter_dt *);
818 internal_proto(free_internal_unit);
819
820 extern gfc_unit *find_unit (int);
821 internal_proto(find_unit);
822
823 extern gfc_unit *find_or_create_unit (int);
824 internal_proto(find_or_create_unit);
825
826 extern gfc_unit *get_unit (st_parameter_dt *, int);
827 internal_proto(get_unit);
828
829 extern void unlock_unit (gfc_unit *);
830 internal_proto(unlock_unit);
831
832 extern void update_position (gfc_unit *);
833 internal_proto(update_position);
834
835 extern void finish_last_advance_record (gfc_unit *u);
836 internal_proto (finish_last_advance_record);
837
838 extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
839 internal_proto (unit_truncate);
840
841 extern GFC_INTEGER_4 get_unique_unit_number (st_parameter_open *);
842 internal_proto(get_unique_unit_number);
843
844 /* open.c */
845
846 extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
847 internal_proto(new_unit);
848
849 /* format.c */
850
851 extern void parse_format (st_parameter_dt *);
852 internal_proto(parse_format);
853
854 extern const fnode *next_format (st_parameter_dt *);
855 internal_proto(next_format);
856
857 extern void unget_format (st_parameter_dt *, const fnode *);
858 internal_proto(unget_format);
859
860 extern void format_error (st_parameter_dt *, const fnode *, const char *);
861 internal_proto(format_error);
862
863 extern void free_format_data (struct format_data *);
864 internal_proto(free_format_data);
865
866 extern void free_format_hash_table (gfc_unit *);
867 internal_proto(free_format_hash_table);
868
869 extern void init_format_hash (st_parameter_dt *);
870 internal_proto(init_format_hash);
871
872 extern void free_format_hash (st_parameter_dt *);
873 internal_proto(free_format_hash);
874
875 /* transfer.c */
876
877 #define SCRATCH_SIZE 300
878
879 extern const char *type_name (bt);
880 internal_proto(type_name);
881
882 extern void * read_block_form (st_parameter_dt *, int *);
883 internal_proto(read_block_form);
884
885 extern char *read_sf (st_parameter_dt *, int *, int);
886 internal_proto(read_sf);
887
888 extern void *write_block (st_parameter_dt *, int);
889 internal_proto(write_block);
890
891 extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *,
892                                      int*);
893 internal_proto(next_array_record);
894
895 extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *,
896                                   gfc_offset *);
897 internal_proto(init_loop_spec);
898
899 extern void next_record (st_parameter_dt *, int);
900 internal_proto(next_record);
901
902 extern void reverse_memcpy (void *, const void *, size_t);
903 internal_proto (reverse_memcpy);
904
905 extern void st_wait (st_parameter_wait *);
906 export_proto(st_wait);
907
908 extern void hit_eof (st_parameter_dt *);
909 internal_proto(hit_eof);
910
911 /* read.c */
912
913 extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
914 internal_proto(set_integer);
915
916 extern GFC_UINTEGER_LARGEST max_value (int, int);
917 internal_proto(max_value);
918
919 extern int convert_real (st_parameter_dt *, void *, const char *, int);
920 internal_proto(convert_real);
921
922 extern void read_a (st_parameter_dt *, const fnode *, char *, int);
923 internal_proto(read_a);
924
925 extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, int);
926 internal_proto(read_a);
927
928 extern void read_f (st_parameter_dt *, const fnode *, char *, int);
929 internal_proto(read_f);
930
931 extern void read_l (st_parameter_dt *, const fnode *, char *, int);
932 internal_proto(read_l);
933
934 extern void read_x (st_parameter_dt *, int);
935 internal_proto(read_x);
936
937 extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);
938 internal_proto(read_radix);
939
940 extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
941 internal_proto(read_decimal);
942
943 /* list_read.c */
944
945 extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t,
946                                  size_t);
947 internal_proto(list_formatted_read);
948
949 extern void finish_list_read (st_parameter_dt *);
950 internal_proto(finish_list_read);
951
952 extern void namelist_read (st_parameter_dt *);
953 internal_proto(namelist_read);
954
955 extern void namelist_write (st_parameter_dt *);
956 internal_proto(namelist_write);
957
958 /* write.c */
959
960 extern void write_a (st_parameter_dt *, const fnode *, const char *, int);
961 internal_proto(write_a);
962
963 extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, int);
964 internal_proto(write_a_char4);
965
966 extern void write_b (st_parameter_dt *, const fnode *, const char *, int);
967 internal_proto(write_b);
968
969 extern void write_d (st_parameter_dt *, const fnode *, const char *, int);
970 internal_proto(write_d);
971
972 extern void write_e (st_parameter_dt *, const fnode *, const char *, int);
973 internal_proto(write_e);
974
975 extern void write_en (st_parameter_dt *, const fnode *, const char *, int);
976 internal_proto(write_en);
977
978 extern void write_es (st_parameter_dt *, const fnode *, const char *, int);
979 internal_proto(write_es);
980
981 extern void write_f (st_parameter_dt *, const fnode *, const char *, int);
982 internal_proto(write_f);
983
984 extern void write_i (st_parameter_dt *, const fnode *, const char *, int);
985 internal_proto(write_i);
986
987 extern void write_l (st_parameter_dt *, const fnode *, char *, int);
988 internal_proto(write_l);
989
990 extern void write_o (st_parameter_dt *, const fnode *, const char *, int);
991 internal_proto(write_o);
992
993 extern void write_real (st_parameter_dt *, const char *, int);
994 internal_proto(write_real);
995
996 extern void write_real_g0 (st_parameter_dt *, const char *, int, int);
997 internal_proto(write_real_g0);
998
999 extern void write_x (st_parameter_dt *, int, int);
1000 internal_proto(write_x);
1001
1002 extern void write_z (st_parameter_dt *, const fnode *, const char *, int);
1003 internal_proto(write_z);
1004
1005 extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t,
1006                                   size_t);
1007 internal_proto(list_formatted_write);
1008
1009 /* size_from_kind.c */
1010 extern size_t size_from_real_kind (int);
1011 internal_proto(size_from_real_kind);
1012
1013 extern size_t size_from_complex_kind (int);
1014 internal_proto(size_from_complex_kind);
1015
1016 /* fbuf.c */
1017 extern void fbuf_init (gfc_unit *, int);
1018 internal_proto(fbuf_init);
1019
1020 extern void fbuf_destroy (gfc_unit *);
1021 internal_proto(fbuf_destroy);
1022
1023 extern int fbuf_reset (gfc_unit *);
1024 internal_proto(fbuf_reset);
1025
1026 extern char * fbuf_alloc (gfc_unit *, int);
1027 internal_proto(fbuf_alloc);
1028
1029 extern int fbuf_flush (gfc_unit *, unit_mode);
1030 internal_proto(fbuf_flush);
1031
1032 extern int fbuf_seek (gfc_unit *, int, int);
1033 internal_proto(fbuf_seek);
1034
1035 extern char * fbuf_read (gfc_unit *, int *);
1036 internal_proto(fbuf_read);
1037
1038 /* Never call this function, only use fbuf_getc().  */
1039 extern int fbuf_getc_refill (gfc_unit *);
1040 internal_proto(fbuf_getc_refill);
1041
1042 static inline int
1043 fbuf_getc (gfc_unit * u)
1044 {
1045   if (u->fbuf->pos < u->fbuf->act)
1046     return (unsigned char) u->fbuf->buf[u->fbuf->pos++];
1047   return fbuf_getc_refill (u);
1048 }
1049
1050 /* lock.c */
1051 extern void free_ionml (st_parameter_dt *);
1052 internal_proto(free_ionml);
1053
1054 static inline void
1055 inc_waiting_locked (gfc_unit *u)
1056 {
1057 #ifdef HAVE_SYNC_FETCH_AND_ADD
1058   (void) __sync_fetch_and_add (&u->waiting, 1);
1059 #else
1060   u->waiting++;
1061 #endif
1062 }
1063
1064 static inline int
1065 predec_waiting_locked (gfc_unit *u)
1066 {
1067 #ifdef HAVE_SYNC_FETCH_AND_ADD
1068   return __sync_add_and_fetch (&u->waiting, -1);
1069 #else
1070   return --u->waiting;
1071 #endif
1072 }
1073
1074 static inline void
1075 dec_waiting_unlocked (gfc_unit *u)
1076 {
1077 #ifdef HAVE_SYNC_FETCH_AND_ADD
1078   (void) __sync_fetch_and_add (&u->waiting, -1);
1079 #else
1080   __gthread_mutex_lock (&unit_lock);
1081   u->waiting--;
1082   __gthread_mutex_unlock (&unit_lock);
1083 #endif
1084 }
1085
1086 #endif
1087