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, FMT_STAR
 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