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   bt 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           /* 15 unused bits.  */
 485
 486           char last_char;
 487           char nml_delim;
 488
 489           int repeat_count;
 490           int saved_length;
 491           int saved_used;
 492           bt saved_type;
 493           char *saved_string;
 494           char *scratch;
 495           char *line_buffer;
 496           struct format_data *fmt;
 497           jmp_buf *eof_jump;
 498           namelist_info *ionml;
 499           /* A flag used to identify when a non-standard expanded namelist read
 500              has occurred.  */
 501           int expanded_read;
 502           /* Storage area for values except for strings.  Must be
 503              large enough to hold a complex value (two reals) of the
 504              largest kind.  */
 505           char value[32];
 506           GFC_IO_INT size_used;
 507         } p;
 508       /* This pad size must be equal to the pad_size declared in
 509          trans-io.c (gfc_build_io_library_fndecls).  The above structure
 510          must be smaller or equal to this array.  */
 511       char pad[16 * sizeof (char *) + 32 * sizeof (int)];
 512     } u;
 513   GFC_INTEGER_4 *id;
 514   GFC_IO_INT pos;
 515   CHARACTER1 (asynchronous);
 516   CHARACTER2 (blank);
 517   CHARACTER1 (decimal);
 518   CHARACTER2 (delim);
 519   CHARACTER1 (pad);
 520   CHARACTER2 (round);
 521   CHARACTER1 (sign);
 522 }
 523 st_parameter_dt;
 524
 525 /* Ensure st_parameter_dt's u.pad is bigger or equal to u.p.  */
 526 extern char check_st_parameter_dt[sizeof (((st_parameter_dt *) 0)->u.pad)
 527                                   >= sizeof (((st_parameter_dt *) 0)->u.p)
 528                                   ? 1 : -1];
 529
 530 #define IOPARM_WAIT_HAS_ID              (1 << 7)
 531
 532 typedef struct
 533 {
 534   st_parameter_common common;
 535   CHARACTER1 (id);
 536 }
 537 st_parameter_wait;
 538
 539
 540 #undef CHARACTER1
 541 #undef CHARACTER2
 542
 543 typedef struct
 544 {
 545   unit_access access;
 546   unit_action action;
 547   unit_blank blank;
 548   unit_delim delim;
 549   unit_form form;
 550   int is_notpadded;
 551   unit_position position;
 552   unit_status status;
 553   unit_pad pad;
 554   unit_convert convert;
 555   int has_recl;
 556   unit_decimal decimal;
 557   unit_encoding encoding;
 558   unit_round round;
 559   unit_sign sign;
 560   unit_async async;
 561 }
 562 unit_flags;
 563
 564
 565 /* Formatting buffer. This is a temporary scratch buffer. Currently used only
 566    by formatted writes. After every
 567    formatted write statement, this buffer is flushed. This buffer is needed since
 568    not all devices are seekable, and T or TL edit descriptors require
 569    moving backwards in the record.  However, advance='no' complicates the
 570    situation, so the buffer must only be partially flushed from the end of the
 571    last flush until the current position in the record. */
 572
 573 typedef struct fbuf
 574 {
 575   char *buf;                    /* Start of buffer.  */
 576   int len;                      /* Length of buffer.  */
 577   int act;                      /* Active bytes in buffer.  */
 578   int pos;                      /* Current position in buffer.  */
 579 }
 580 fbuf;
 581
 582
 583 typedef struct gfc_unit
 584 {
 585   int unit_number;
 586   stream *s;
 587
 588   /* Treap links.  */
 589   struct gfc_unit *left, *right;
 590   int priority;
 591
 592   int read_bad, current_record, saved_pos, previous_nonadvancing_write;
 593
 594   enum
 595   { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
 596   endfile;
 597
 598   unit_mode mode;
 599   unit_flags flags;
 600   unit_pad pad_status;
 601   unit_decimal decimal_status;
 602   unit_delim delim_status;
 603
 604   /* recl                 -- Record length of the file.
 605      last_record          -- Last record number read or written
 606      maxrec               -- Maximum record number in a direct access file
 607      bytes_left           -- Bytes left in current record.
 608      strm_pos             -- Current position in file for STREAM I/O.
 609      recl_subrecord       -- Maximum length for subrecord.
 610      bytes_left_subrecord -- Bytes left in current subrecord.  */
 611   gfc_offset recl, last_record, maxrec, bytes_left, strm_pos,
 612     recl_subrecord, bytes_left_subrecord;
 613
 614   /* Set to 1 if we have read a subrecord.  */
 615
 616   int continued;
 617
 618   __gthread_mutex_t lock;
 619   /* Number of threads waiting to acquire this unit's lock.
 620      When non-zero, close_unit doesn't only removes the unit
 621      from the UNIT_ROOT tree, but doesn't free it and the
 622      last of the waiting threads will do that.
 623      This must be either atomically increased/decreased, or
 624      always guarded by UNIT_LOCK.  */
 625   int waiting;
 626   /* Flag set by close_unit if the unit as been closed.
 627      Must be manipulated under unit's lock.  */
 628   int closed;
 629
 630   /* For traversing arrays */
 631   array_loop_spec *ls;
 632   int rank;
 633
 634   int file_len;
 635   char *file;
 636
 637   /* The format hash table.  */
 638   struct format_hash_entry format_hash_table[FORMAT_HASH_SIZE];
 639
 640   /* Formatting buffer.  */
 641   struct fbuf *fbuf;
 642 }
 643 gfc_unit;
 644
 645 /* Format tokens.  Only about half of these can be stored in the
 646    format nodes.  */
 647
 648 typedef enum
 649 {
 650   FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD,
 651   FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL,
 652   FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING,
 653   FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F,
 654   FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_DC,
 655   FMT_DP
 656 }
 657 format_token;
 658
 659
 660 /* Format nodes.  A format string is converted into a tree of these
 661    structures, which is traversed as part of a data transfer statement.  */
 662
 663 typedef struct fnode
 664 {
 665   format_token format;
 666   int repeat;
 667   struct fnode *next;
 668   char *source;
 669
 670   union
 671   {
 672     struct
 673     {
 674       int w, d, e;
 675     }
 676     real;
 677
 678     struct
 679     {
 680       int length;
 681       char *p;
 682     }
 683     string;
 684
 685     struct
 686     {
 687       int w, m;
 688     }
 689     integer;
 690
 691     int w;
 692     int k;
 693     int r;
 694     int n;
 695
 696     struct fnode *child;
 697   }
 698   u;
 699
 700   /* Members for traversing the tree during data transfer.  */
 701
 702   int count;
 703   struct fnode *current;
 704
 705 }
 706 fnode;
 707
 708
 709 /* unix.c */
 710
 711 extern int compare_files (stream *, stream *);
 712 internal_proto(compare_files);
 713
 714 extern stream *open_external (st_parameter_open *, unit_flags *);
 715 internal_proto(open_external);
 716
 717 extern stream *open_internal (char *, int, gfc_offset);
 718 internal_proto(open_internal);
 719
 720 extern char * mem_alloc_w (stream *, int *);
 721 internal_proto(mem_alloc_w);
 722
 723 extern char * mem_alloc_r (stream *, int *);
 724 internal_proto(mem_alloc_w);
 725
 726 extern stream *input_stream (void);
 727 internal_proto(input_stream);
 728
 729 extern stream *output_stream (void);
 730 internal_proto(output_stream);
 731
 732 extern stream *error_stream (void);
 733 internal_proto(error_stream);
 734
 735 extern int compare_file_filename (gfc_unit *, const char *, int);
 736 internal_proto(compare_file_filename);
 737
 738 extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len);
 739 internal_proto(find_file);
 740
 741 extern int delete_file (gfc_unit *);
 742 internal_proto(delete_file);
 743
 744 extern int file_exists (const char *file, gfc_charlen_type file_len);
 745 internal_proto(file_exists);
 746
 747 extern const char *inquire_sequential (const char *, int);
 748 internal_proto(inquire_sequential);
 749
 750 extern const char *inquire_direct (const char *, int);
 751 internal_proto(inquire_direct);
 752
 753 extern const char *inquire_formatted (const char *, int);
 754 internal_proto(inquire_formatted);
 755
 756 extern const char *inquire_unformatted (const char *, int);
 757 internal_proto(inquire_unformatted);
 758
 759 extern const char *inquire_read (const char *, int);
 760 internal_proto(inquire_read);
 761
 762 extern const char *inquire_write (const char *, int);
 763 internal_proto(inquire_write);
 764
 765 extern const char *inquire_readwrite (const char *, int);
 766 internal_proto(inquire_readwrite);
 767
 768 extern gfc_offset file_length (stream *);
 769 internal_proto(file_length);
 770
 771 extern int is_seekable (stream *);
 772 internal_proto(is_seekable);
 773
 774 extern int is_special (stream *);
 775 internal_proto(is_special);
 776
 777 extern void flush_if_preconnected (stream *);
 778 internal_proto(flush_if_preconnected);
 779
 780 extern void empty_internal_buffer(stream *);
 781 internal_proto(empty_internal_buffer);
 782
 783 extern int stream_isatty (stream *);
 784 internal_proto(stream_isatty);
 785
 786 extern char * stream_ttyname (stream *);
 787 internal_proto(stream_ttyname);
 788
 789 extern int unpack_filename (char *, const char *, int);
 790 internal_proto(unpack_filename);
 791
 792 /* unit.c */
 793
 794 /* Maximum file offset, computed at library initialization time.  */
 795 extern gfc_offset max_offset;
 796 internal_proto(max_offset);
 797
 798 /* Unit number to be assigned when NEWUNIT is used in an OPEN statement.  */
 799 extern GFC_INTEGER_4 next_available_newunit;
 800 internal_proto(next_available_newunit);
 801
 802 /* Unit tree root.  */
 803 extern gfc_unit *unit_root;
 804 internal_proto(unit_root);
 805
 806 extern __gthread_mutex_t unit_lock;
 807 internal_proto(unit_lock);
 808
 809 extern int close_unit (gfc_unit *);
 810 internal_proto(close_unit);
 811
 812 extern gfc_unit *get_internal_unit (st_parameter_dt *);
 813 internal_proto(get_internal_unit);
 814
 815 extern void free_internal_unit (st_parameter_dt *);
 816 internal_proto(free_internal_unit);
 817
 818 extern gfc_unit *find_unit (int);
 819 internal_proto(find_unit);
 820
 821 extern gfc_unit *find_or_create_unit (int);
 822 internal_proto(find_or_create_unit);
 823
 824 extern gfc_unit *get_unit (st_parameter_dt *, int);
 825 internal_proto(get_unit);
 826
 827 extern void unlock_unit (gfc_unit *);
 828 internal_proto(unlock_unit);
 829
 830 extern void update_position (gfc_unit *);
 831 internal_proto(update_position);
 832
 833 extern void finish_last_advance_record (gfc_unit *u);
 834 internal_proto (finish_last_advance_record);
 835
 836 extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
 837 internal_proto (unit_truncate);
 838
 839 extern GFC_INTEGER_4 get_unique_unit_number (st_parameter_open *);
 840 internal_proto(get_unique_unit_number);
 841
 842 /* open.c */
 843
 844 extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
 845 internal_proto(new_unit);
 846
 847 /* format.c */
 848
 849 extern void parse_format (st_parameter_dt *);
 850 internal_proto(parse_format);
 851
 852 extern const fnode *next_format (st_parameter_dt *);
 853 internal_proto(next_format);
 854
 855 extern void unget_format (st_parameter_dt *, const fnode *);
 856 internal_proto(unget_format);
 857
 858 extern void format_error (st_parameter_dt *, const fnode *, const char *);
 859 internal_proto(format_error);
 860
 861 extern void free_format_data (struct format_data *);
 862 internal_proto(free_format_data);
 863
 864 extern void free_format_hash_table (gfc_unit *);
 865 internal_proto(free_format_hash_table);
 866
 867 extern void init_format_hash (st_parameter_dt *);
 868 internal_proto(init_format_hash);
 869
 870 extern void free_format_hash (st_parameter_dt *);
 871 internal_proto(free_format_hash);
 872
 873 /* transfer.c */
 874
 875 #define SCRATCH_SIZE 300
 876
 877 extern const char *type_name (bt);
 878 internal_proto(type_name);
 879
 880 extern void * read_block_form (st_parameter_dt *, int *);
 881 internal_proto(read_block_form);
 882
 883 extern char *read_sf (st_parameter_dt *, int *, int);
 884 internal_proto(read_sf);
 885
 886 extern void *write_block (st_parameter_dt *, int);
 887 internal_proto(write_block);
 888
 889 extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *,
 890                                      int*);
 891 internal_proto(next_array_record);
 892
 893 extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *,
 894                                   gfc_offset *);
 895 internal_proto(init_loop_spec);
 896
 897 extern void next_record (st_parameter_dt *, int);
 898 internal_proto(next_record);
 899
 900 extern void reverse_memcpy (void *, const void *, size_t);
 901 internal_proto (reverse_memcpy);
 902
 903 extern void st_wait (st_parameter_wait *);
 904 export_proto(st_wait);
 905
 906 extern void hit_eof (st_parameter_dt *);
 907 internal_proto(hit_eof);
 908
 909 /* read.c */
 910
 911 extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
 912 internal_proto(set_integer);
 913
 914 extern GFC_UINTEGER_LARGEST max_value (int, int);
 915 internal_proto(max_value);
 916
 917 extern int convert_real (st_parameter_dt *, void *, const char *, int);
 918 internal_proto(convert_real);
 919
 920 extern void read_a (st_parameter_dt *, const fnode *, char *, int);
 921 internal_proto(read_a);
 922
 923 extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, int);
 924 internal_proto(read_a);
 925
 926 extern void read_f (st_parameter_dt *, const fnode *, char *, int);
 927 internal_proto(read_f);
 928
 929 extern void read_l (st_parameter_dt *, const fnode *, char *, int);
 930 internal_proto(read_l);
 931
 932 extern void read_x (st_parameter_dt *, int);
 933 internal_proto(read_x);
 934
 935 extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);
 936 internal_proto(read_radix);
 937
 938 extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
 939 internal_proto(read_decimal);
 940
 941 /* list_read.c */
 942
 943 extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t,
 944                                  size_t);
 945 internal_proto(list_formatted_read);
 946
 947 extern void finish_list_read (st_parameter_dt *);
 948 internal_proto(finish_list_read);
 949
 950 extern void namelist_read (st_parameter_dt *);
 951 internal_proto(namelist_read);
 952
 953 extern void namelist_write (st_parameter_dt *);
 954 internal_proto(namelist_write);
 955
 956 /* write.c */
 957
 958 extern void write_a (st_parameter_dt *, const fnode *, const char *, int);
 959 internal_proto(write_a);
 960
 961 extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, int);
 962 internal_proto(write_a_char4);
 963
 964 extern void write_b (st_parameter_dt *, const fnode *, const char *, int);
 965 internal_proto(write_b);
 966
 967 extern void write_d (st_parameter_dt *, const fnode *, const char *, int);
 968 internal_proto(write_d);
 969
 970 extern void write_e (st_parameter_dt *, const fnode *, const char *, int);
 971 internal_proto(write_e);
 972
 973 extern void write_en (st_parameter_dt *, const fnode *, const char *, int);
 974 internal_proto(write_en);
 975
 976 extern void write_es (st_parameter_dt *, const fnode *, const char *, int);
 977 internal_proto(write_es);
 978
 979 extern void write_f (st_parameter_dt *, const fnode *, const char *, int);
 980 internal_proto(write_f);
 981
 982 extern void write_i (st_parameter_dt *, const fnode *, const char *, int);
 983 internal_proto(write_i);
 984
 985 extern void write_l (st_parameter_dt *, const fnode *, char *, int);
 986 internal_proto(write_l);
 987
 988 extern void write_o (st_parameter_dt *, const fnode *, const char *, int);
 989 internal_proto(write_o);
 990
 991 extern void write_real (st_parameter_dt *, const char *, int);
 992 internal_proto(write_real);
 993
 994 extern void write_real_g0 (st_parameter_dt *, const char *, int, int);
 995 internal_proto(write_real_g0);
 996
 997 extern void write_x (st_parameter_dt *, int, int);
 998 internal_proto(write_x);
 999
1000 extern void write_z (st_parameter_dt *, const fnode *, const char *, int);
1001 internal_proto(write_z);
1002
1003 extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t,
1004                                   size_t);
1005 internal_proto(list_formatted_write);
1006
1007 /* size_from_kind.c */
1008 extern size_t size_from_real_kind (int);
1009 internal_proto(size_from_real_kind);
1010
1011 extern size_t size_from_complex_kind (int);
1012 internal_proto(size_from_complex_kind);
1013
1014 /* fbuf.c */
1015 extern void fbuf_init (gfc_unit *, int);
1016 internal_proto(fbuf_init);
1017
1018 extern void fbuf_destroy (gfc_unit *);
1019 internal_proto(fbuf_destroy);
1020
1021 extern int fbuf_reset (gfc_unit *);
1022 internal_proto(fbuf_reset);
1023
1024 extern char * fbuf_alloc (gfc_unit *, int);
1025 internal_proto(fbuf_alloc);
1026
1027 extern int fbuf_flush (gfc_unit *, unit_mode);
1028 internal_proto(fbuf_flush);
1029
1030 extern int fbuf_seek (gfc_unit *, int, int);
1031 internal_proto(fbuf_seek);
1032
1033 extern char * fbuf_read (gfc_unit *, int *);
1034 internal_proto(fbuf_read);
1035
1036 /* Never call this function, only use fbuf_getc().  */
1037 extern int fbuf_getc_refill (gfc_unit *);
1038 internal_proto(fbuf_getc_refill);
1039
1040 static inline int
1041 fbuf_getc (gfc_unit * u)
1042 {
1043   if (u->fbuf->pos < u->fbuf->act)
1044     return (unsigned char) u->fbuf->buf[u->fbuf->pos++];
1045   return fbuf_getc_refill (u);
1046 }
1047
1048 /* lock.c */
1049 extern void free_ionml (st_parameter_dt *);
1050 internal_proto(free_ionml);
1051
1052 static inline void
1053 inc_waiting_locked (gfc_unit *u)
1054 {
1055 #ifdef HAVE_SYNC_FETCH_AND_ADD
1056   (void) __sync_fetch_and_add (&u->waiting, 1);
1057 #else
1058   u->waiting++;
1059 #endif
1060 }
1061
1062 static inline int
1063 predec_waiting_locked (gfc_unit *u)
1064 {
1065 #ifdef HAVE_SYNC_FETCH_AND_ADD
1066   return __sync_add_and_fetch (&u->waiting, -1);
1067 #else
1068   return --u->waiting;
1069 #endif
1070 }
1071
1072 static inline void
1073 dec_waiting_unlocked (gfc_unit *u)
1074 {
1075 #ifdef HAVE_SYNC_FETCH_AND_ADD
1076   (void) __sync_fetch_and_add (&u->waiting, -1);
1077 #else
1078   __gthread_mutex_lock (&unit_lock);
1079   u->waiting--;
1080   __gthread_mutex_unlock (&unit_lock);
1081 #endif
1082 }
1083
1084 #endif
1085