libgfortran/io/io.h

   1 /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
   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 2, 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 You should have received a copy of the GNU General Public License
  19 along with Libgfortran; see the file COPYING.  If not, write to
  20 the Free Software Foundation, 51 Franklin Street, Fifth Floor,
  21 Boston, MA 02110-1301, USA.  */
  22
  23 /* As a special exception, if you link this library with other files,
  24    some of which are compiled with GCC, to produce an executable,
  25    this library does not by itself cause the resulting executable
  26    to be covered by the GNU General Public License.
  27    This exception does not however invalidate any other reasons why
  28    the executable file might be covered by the GNU General Public License.  */
  29
  30 #ifndef GFOR_IO_H
  31 #define GFOR_IO_H
  32
  33 /* IO library include.  */
  34
  35 #include "libgfortran.h"
  36
  37 #include <setjmp.h>
  38 #include <gthr.h>
  39
  40 /* Basic types used in data transfers.  */
  41
  42 typedef enum
  43 { BT_NULL, BT_INTEGER, BT_LOGICAL, BT_CHARACTER, BT_REAL,
  44   BT_COMPLEX
  45 }
  46 bt;
  47
  48 struct st_parameter_dt;
  49
  50 typedef struct stream
  51 {
  52   ssize_t (*read) (struct stream *, void *, ssize_t);
  53   ssize_t (*write) (struct stream *, const void *, ssize_t);
  54   off_t (*seek) (struct stream *, off_t, int);
  55   off_t (*tell) (struct stream *);
  56   /* Avoid keyword truncate due to AIX namespace collision.  */
  57   int (*trunc) (struct stream *, off_t);
  58   int (*flush) (struct stream *);
  59   int (*close) (struct stream *);
  60 }
  61 stream;
  62
  63 /* Inline functions for doing file I/O given a stream.  */
  64 static inline ssize_t
  65 sread (stream * s, void * buf, ssize_t nbyte)
  66 {
  67   return s->read (s, buf, nbyte);
  68 }
  69
  70 static inline ssize_t
  71 swrite (stream * s, const void * buf, ssize_t nbyte)
  72 {
  73   return s->write (s, buf, nbyte);
  74 }
  75
  76 static inline off_t
  77 sseek (stream * s, off_t offset, int whence)
  78 {
  79   return s->seek (s, offset, whence);
  80 }
  81
  82 static inline off_t
  83 stell (stream * s)
  84 {
  85   return s->tell (s);
  86 }
  87
  88 static inline int
  89 struncate (stream * s, off_t length)
  90 {
  91   return s->trunc (s, length);
  92 }
  93
  94 static inline int
  95 sflush (stream * s)
  96 {
  97   return s->flush (s);
  98 }
  99
 100 static inline int
 101 sclose (stream * s)
 102 {
 103   return s->close (s);
 104 }
 105
 106
 107 /* Macros for testing what kinds of I/O we are doing.  */
 108
 109 #define is_array_io(dtp) ((dtp)->internal_unit_desc)
 110
 111 #define is_internal_unit(dtp) ((dtp)->u.p.unit_is_internal)
 112
 113 #define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM)
 114
 115 /* The array_loop_spec contains the variables for the loops over index ranges
 116    that are encountered.  Since the variables can be negative, ssize_t
 117    is used.  */
 118
 119 typedef struct array_loop_spec
 120 {
 121   /* Index counter for this dimension.  */
 122   ssize_t idx;
 123
 124   /* Start for the index counter.  */
 125   ssize_t start;
 126
 127   /* End for the index counter.  */
 128   ssize_t end;
 129
 130   /* Step for the index counter.  */
 131   ssize_t step;
 132 }
 133 array_loop_spec;
 134
 135 /* A stucture to build a hash table for format data.  */
 136
 137 #define FORMAT_HASH_SIZE 16
 138
 139 typedef struct format_hash_entry
 140 {
 141   char *key;
 142   gfc_charlen_type key_len;
 143   struct format_data *hashed_fmt;
 144 }
 145 format_hash_entry;
 146
 147 /* Representation of a namelist object in libgfortran
 148
 149    Namelist Records
 150       &GROUPNAME  OBJECT=value[s] [,OBJECT=value[s]].../
 151      or
 152       &GROUPNAME  OBJECT=value[s] [,OBJECT=value[s]]...&END
 153
 154    The object can be a fully qualified, compound name for an intrinsic
 155    type, derived types or derived type components.  So, a substring
 156    a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist
 157    read. Hence full information about the structure of the object has
 158    to be available to list_read.c and write.
 159
 160    These requirements are met by the following data structures.
 161
 162    namelist_info type contains all the scalar information about the
 163    object and arrays of descriptor_dimension and array_loop_spec types for
 164    arrays.  */
 165
 166 typedef struct namelist_type
 167 {
 168   /* Object type, stored as GFC_DTYPE_xxxx.  */
 169   bt type;
 170
 171   /* Object name.  */
 172   char * var_name;
 173
 174   /* Address for the start of the object's data.  */
 175   void * mem_pos;
 176
 177   /* Flag to show that a read is to be attempted for this node.  */
 178   int touched;
 179
 180   /* Length of intrinsic type in bytes.  */
 181   int len;
 182
 183   /* Rank of the object.  */
 184   int var_rank;
 185
 186   /* Overall size of the object in bytes.  */
 187   index_type size;
 188
 189   /* Length of character string.  */
 190   index_type string_length;
 191
 192   descriptor_dimension * dim;
 193   array_loop_spec * ls;
 194   struct namelist_type * next;
 195 }
 196 namelist_info;
 197
 198 /* Options for the OPEN statement.  */
 199
 200 typedef enum
 201 { ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_STREAM,
 202   ACCESS_UNSPECIFIED
 203 }
 204 unit_access;
 205
 206 typedef enum
 207 { ACTION_READ, ACTION_WRITE, ACTION_READWRITE,
 208   ACTION_UNSPECIFIED
 209 }
 210 unit_action;
 211
 212 typedef enum
 213 { BLANK_NULL, BLANK_ZERO, BLANK_UNSPECIFIED }
 214 unit_blank;
 215
 216 typedef enum
 217 { DELIM_NONE, DELIM_APOSTROPHE, DELIM_QUOTE,
 218   DELIM_UNSPECIFIED
 219 }
 220 unit_delim;
 221
 222 typedef enum
 223 { FORM_FORMATTED, FORM_UNFORMATTED, FORM_UNSPECIFIED }
 224 unit_form;
 225
 226 typedef enum
 227 { POSITION_ASIS, POSITION_REWIND, POSITION_APPEND,
 228   POSITION_UNSPECIFIED
 229 }
 230 unit_position;
 231
 232 typedef enum
 233 { STATUS_UNKNOWN, STATUS_OLD, STATUS_NEW, STATUS_SCRATCH,
 234   STATUS_REPLACE, STATUS_UNSPECIFIED
 235 }
 236 unit_status;
 237
 238 typedef enum
 239 { PAD_YES, PAD_NO, PAD_UNSPECIFIED }
 240 unit_pad;
 241
 242 typedef enum
 243 { DECIMAL_POINT, DECIMAL_COMMA, DECIMAL_UNSPECIFIED }
 244 unit_decimal;
 245
 246 typedef enum
 247 { ENCODING_UTF8, ENCODING_DEFAULT, ENCODING_UNSPECIFIED }
 248 unit_encoding;
 249
 250 typedef enum
 251 { ROUND_UP, ROUND_DOWN, ROUND_ZERO, ROUND_NEAREST, ROUND_COMPATIBLE,
 252   ROUND_PROCDEFINED, ROUND_UNSPECIFIED }
 253 unit_round;
 254
 255 /* NOTE: unit_sign must correspond with the sign_status enumerator in
 256    st_parameter_dt to not break the ABI.  */
 257 typedef enum
 258 { SIGN_PROCDEFINED, SIGN_SUPPRESS, SIGN_PLUS, SIGN_UNSPECIFIED }
 259 unit_sign;
 260
 261 typedef enum
 262 { ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED }
 263 unit_advance;
 264
 265 typedef enum
 266 {READING, WRITING}
 267 unit_mode;
 268
 269 typedef enum
 270 { ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED }
 271 unit_async;
 272
 273 typedef enum
 274 { SIGN_S, SIGN_SS, SIGN_SP }
 275 unit_sign_s;
 276
 277 #define CHARACTER1(name) \
 278               char * name; \
 279               gfc_charlen_type name ## _len
 280 #define CHARACTER2(name) \
 281               gfc_charlen_type name ## _len; \
 282               char * name
 283
 284 typedef struct
 285 {
 286   st_parameter_common common;
 287   GFC_INTEGER_4 recl_in;
 288   CHARACTER2 (file);
 289   CHARACTER1 (status);
 290   CHARACTER2 (access);
 291   CHARACTER1 (form);
 292   CHARACTER2 (blank);
 293   CHARACTER1 (position);
 294   CHARACTER2 (action);
 295   CHARACTER1 (delim);
 296   CHARACTER2 (pad);
 297   CHARACTER1 (convert);
 298   CHARACTER2 (decimal);
 299   CHARACTER1 (encoding);
 300   CHARACTER2 (round);
 301   CHARACTER1 (sign);
 302   CHARACTER2 (asynchronous);
 303 }
 304 st_parameter_open;
 305
 306 #define IOPARM_CLOSE_HAS_STATUS         (1 << 7)
 307
 308 typedef struct
 309 {
 310   st_parameter_common common;
 311   CHARACTER1 (status);
 312 }
 313 st_parameter_close;
 314
 315 typedef struct
 316 {
 317   st_parameter_common common;
 318 }
 319 st_parameter_filepos;
 320
 321 #define IOPARM_INQUIRE_HAS_EXIST        (1 << 7)
 322 #define IOPARM_INQUIRE_HAS_OPENED       (1 << 8)
 323 #define IOPARM_INQUIRE_HAS_NUMBER       (1 << 9)
 324 #define IOPARM_INQUIRE_HAS_NAMED        (1 << 10)
 325 #define IOPARM_INQUIRE_HAS_NEXTREC      (1 << 11)
 326 #define IOPARM_INQUIRE_HAS_RECL_OUT     (1 << 12)
 327 #define IOPARM_INQUIRE_HAS_STRM_POS_OUT (1 << 13)
 328 #define IOPARM_INQUIRE_HAS_FILE         (1 << 14)
 329 #define IOPARM_INQUIRE_HAS_ACCESS       (1 << 15)
 330 #define IOPARM_INQUIRE_HAS_FORM         (1 << 16)
 331 #define IOPARM_INQUIRE_HAS_BLANK        (1 << 17)
 332 #define IOPARM_INQUIRE_HAS_POSITION     (1 << 18)
 333 #define IOPARM_INQUIRE_HAS_ACTION       (1 << 19)
 334 #define IOPARM_INQUIRE_HAS_DELIM        (1 << 20)
 335 #define IOPARM_INQUIRE_HAS_PAD          (1 << 21)
 336 #define IOPARM_INQUIRE_HAS_NAME         (1 << 22)
 337 #define IOPARM_INQUIRE_HAS_SEQUENTIAL   (1 << 23)
 338 #define IOPARM_INQUIRE_HAS_DIRECT       (1 << 24)
 339 #define IOPARM_INQUIRE_HAS_FORMATTED    (1 << 25)
 340 #define IOPARM_INQUIRE_HAS_UNFORMATTED  (1 << 26)
 341 #define IOPARM_INQUIRE_HAS_READ         (1 << 27)
 342 #define IOPARM_INQUIRE_HAS_WRITE        (1 << 28)
 343 #define IOPARM_INQUIRE_HAS_READWRITE    (1 << 29)
 344 #define IOPARM_INQUIRE_HAS_CONVERT      (1 << 30)
 345 #define IOPARM_INQUIRE_HAS_FLAGS2       (1 << 31)
 346
 347 #define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0)
 348 #define IOPARM_INQUIRE_HAS_DECIMAL      (1 << 1)
 349 #define IOPARM_INQUIRE_HAS_ENCODING     (1 << 2)
 350 #define IOPARM_INQUIRE_HAS_ROUND        (1 << 3)
 351 #define IOPARM_INQUIRE_HAS_SIGN         (1 << 4)
 352 #define IOPARM_INQUIRE_HAS_PENDING      (1 << 5)
 353 #define IOPARM_INQUIRE_HAS_SIZE         (1 << 6)
 354 #define IOPARM_INQUIRE_HAS_ID           (1 << 7)
 355
 356 typedef struct
 357 {
 358   st_parameter_common common;
 359   GFC_INTEGER_4 *exist, *opened, *number, *named;
 360   GFC_INTEGER_4 *nextrec, *recl_out;
 361   GFC_IO_INT *strm_pos_out;
 362   CHARACTER1 (file);
 363   CHARACTER2 (access);
 364   CHARACTER1 (form);
 365   CHARACTER2 (blank);
 366   CHARACTER1 (position);
 367   CHARACTER2 (action);
 368   CHARACTER1 (delim);
 369   CHARACTER2 (pad);
 370   CHARACTER1 (name);
 371   CHARACTER2 (sequential);
 372   CHARACTER1 (direct);
 373   CHARACTER2 (formatted);
 374   CHARACTER1 (unformatted);
 375   CHARACTER2 (read);
 376   CHARACTER1 (write);
 377   CHARACTER2 (readwrite);
 378   CHARACTER1 (convert);
 379   GFC_INTEGER_4 flags2;
 380   CHARACTER1 (asynchronous);
 381   CHARACTER2 (decimal);
 382   CHARACTER1 (encoding);
 383   CHARACTER2 (round);
 384   CHARACTER1 (sign);
 385   GFC_INTEGER_4 *pending;
 386   GFC_INTEGER_4 *size;
 387   GFC_INTEGER_4 *id;
 388 }
 389 st_parameter_inquire;
 390
 391 struct gfc_unit;
 392 struct format_data;
 393
 394 #define IOPARM_DT_LIST_FORMAT                   (1 << 7)
 395 #define IOPARM_DT_NAMELIST_READ_MODE            (1 << 8)
 396 #define IOPARM_DT_HAS_REC                       (1 << 9)
 397 #define IOPARM_DT_HAS_SIZE                      (1 << 10)
 398 #define IOPARM_DT_HAS_IOLENGTH                  (1 << 11)
 399 #define IOPARM_DT_HAS_FORMAT                    (1 << 12)
 400 #define IOPARM_DT_HAS_ADVANCE                   (1 << 13)
 401 #define IOPARM_DT_HAS_INTERNAL_UNIT             (1 << 14)
 402 #define IOPARM_DT_HAS_NAMELIST_NAME             (1 << 15)
 403 #define IOPARM_DT_HAS_ID                        (1 << 16)
 404 #define IOPARM_DT_HAS_POS                       (1 << 17)
 405 #define IOPARM_DT_HAS_ASYNCHRONOUS              (1 << 18)
 406 #define IOPARM_DT_HAS_BLANK                     (1 << 19)
 407 #define IOPARM_DT_HAS_DECIMAL                   (1 << 20)
 408 #define IOPARM_DT_HAS_DELIM                     (1 << 21)
 409 #define IOPARM_DT_HAS_PAD                       (1 << 22)
 410 #define IOPARM_DT_HAS_ROUND                     (1 << 23)
 411 #define IOPARM_DT_HAS_SIGN                      (1 << 24)
 412 #define IOPARM_DT_HAS_F2003                     (1 << 25)
 413 /* Internal use bit.  */
 414 #define IOPARM_DT_IONML_SET                     (1 << 31)
 415
 416
 417 typedef struct st_parameter_dt
 418 {
 419   st_parameter_common common;
 420   GFC_IO_INT rec;
 421   GFC_IO_INT *size, *iolength;
 422   gfc_array_char *internal_unit_desc;
 423   CHARACTER1 (format);
 424   CHARACTER2 (advance);
 425   CHARACTER1 (internal_unit);
 426   CHARACTER2 (namelist_name);
 427   /* Private part of the structure.  The compiler just needs
 428      to reserve enough space.  */
 429   union
 430     {
 431       struct
 432         {
 433           void (*transfer) (struct st_parameter_dt *, bt, void *, int,
 434                             size_t, size_t);
 435           struct gfc_unit *current_unit;
 436           /* Item number in a formatted data transfer.  Also used in namelist
 437              read_logical as an index into line_buffer.  */
 438           int item_count;
 439           unit_mode mode;
 440           unit_blank blank_status;
 441           unit_sign sign_status;
 442           int scale_factor;
 443           int max_pos; /* Maximum righthand column written to.  */
 444           /* Number of skips + spaces to be done for T and X-editing.  */
 445           int skips;
 446           /* Number of spaces to be done for T and X-editing.  */
 447           int pending_spaces;
 448           /* Whether an EOR condition was encountered. Value is:
 449                0 if no EOR was encountered
 450                1 if an EOR was encountered due to a 1-byte marker (LF)
 451                2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
 452           int sf_seen_eor;
 453           unit_advance advance_status;
 454           unsigned reversion_flag : 1; /* Format reversion has occurred.  */
 455           unsigned first_item : 1;
 456           unsigned seen_dollar : 1;
 457           unsigned eor_condition : 1;
 458           unsigned no_leading_blank : 1;
 459           unsigned char_flag : 1;
 460           unsigned input_complete : 1;
 461           unsigned at_eol : 1;
 462           unsigned comma_flag : 1;
 463           /* A namelist specific flag used in the list directed library
 464              to flag that calls are being made from namelist read (eg. to
 465              ignore comments or to treat '/' as a terminator)  */
 466           unsigned namelist_mode : 1;
 467           /* A namelist specific flag used in the list directed library
 468              to flag read errors and return, so that an attempt can be
 469              made to read a new object name.  */
 470           unsigned nml_read_error : 1;
 471           /* A sequential formatted read specific flag used to signal that a
 472              character string is being read so don't use commas to shorten a
 473              formatted field width.  */
 474           unsigned sf_read_comma : 1;
 475           /* A namelist specific flag used to enable reading input from
 476              line_buffer for logical reads.  */
 477           unsigned line_buffer_enabled : 1;
 478           /* An internal unit specific flag used to identify that the associated
 479              unit is internal.  */
 480           unsigned unit_is_internal : 1;
 481           /* An internal unit specific flag to signify an EOF condition for list
 482              directed read.  */
 483           unsigned at_eof : 1;
 484           /* Used for g0 floating point output.  */
 485           unsigned g0_no_blanks : 1;
 486           /* 15 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 large
 505              enough to hold a complex value (two reals) of the largest
 506              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 move_pos_offset (stream *, int);
 714 internal_proto(move_pos_offset);
 715
 716 extern int compare_files (stream *, stream *);
 717 internal_proto(compare_files);
 718
 719 extern stream *open_external (st_parameter_open *, unit_flags *);
 720 internal_proto(open_external);
 721
 722 extern stream *open_internal (char *, int, gfc_offset);
 723 internal_proto(open_internal);
 724
 725 extern char * mem_alloc_w (stream *, int *);
 726 internal_proto(mem_alloc_w);
 727
 728 extern char * mem_alloc_r (stream *, int *);
 729 internal_proto(mem_alloc_w);
 730
 731 extern stream *input_stream (void);
 732 internal_proto(input_stream);
 733
 734 extern stream *output_stream (void);
 735 internal_proto(output_stream);
 736
 737 extern stream *error_stream (void);
 738 internal_proto(error_stream);
 739
 740 extern int compare_file_filename (gfc_unit *, const char *, int);
 741 internal_proto(compare_file_filename);
 742
 743 extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len);
 744 internal_proto(find_file);
 745
 746 extern int delete_file (gfc_unit *);
 747 internal_proto(delete_file);
 748
 749 extern int file_exists (const char *file, gfc_charlen_type file_len);
 750 internal_proto(file_exists);
 751
 752 extern const char *inquire_sequential (const char *, int);
 753 internal_proto(inquire_sequential);
 754
 755 extern const char *inquire_direct (const char *, int);
 756 internal_proto(inquire_direct);
 757
 758 extern const char *inquire_formatted (const char *, int);
 759 internal_proto(inquire_formatted);
 760
 761 extern const char *inquire_unformatted (const char *, int);
 762 internal_proto(inquire_unformatted);
 763
 764 extern const char *inquire_read (const char *, int);
 765 internal_proto(inquire_read);
 766
 767 extern const char *inquire_write (const char *, int);
 768 internal_proto(inquire_write);
 769
 770 extern const char *inquire_readwrite (const char *, int);
 771 internal_proto(inquire_readwrite);
 772
 773 extern gfc_offset file_length (stream *);
 774 internal_proto(file_length);
 775
 776 extern int is_seekable (stream *);
 777 internal_proto(is_seekable);
 778
 779 extern int is_special (stream *);
 780 internal_proto(is_special);
 781
 782 extern int is_preconnected (stream *);
 783 internal_proto(is_preconnected);
 784
 785 extern void flush_if_preconnected (stream *);
 786 internal_proto(flush_if_preconnected);
 787
 788 extern void empty_internal_buffer(stream *);
 789 internal_proto(empty_internal_buffer);
 790
 791 extern int stream_isatty (stream *);
 792 internal_proto(stream_isatty);
 793
 794 extern char * stream_ttyname (stream *);
 795 internal_proto(stream_ttyname);
 796
 797 extern int unpack_filename (char *, const char *, int);
 798 internal_proto(unpack_filename);
 799
 800 /* unit.c */
 801
 802 /* Maximum file offset, computed at library initialization time.  */
 803 extern gfc_offset max_offset;
 804 internal_proto(max_offset);
 805
 806 /* Unit tree root.  */
 807 extern gfc_unit *unit_root;
 808 internal_proto(unit_root);
 809
 810 extern __gthread_mutex_t unit_lock;
 811 internal_proto(unit_lock);
 812
 813 extern int close_unit (gfc_unit *);
 814 internal_proto(close_unit);
 815
 816 extern gfc_unit *get_internal_unit (st_parameter_dt *);
 817 internal_proto(get_internal_unit);
 818
 819 extern void free_internal_unit (st_parameter_dt *);
 820 internal_proto(free_internal_unit);
 821
 822 extern gfc_unit *find_unit (int);
 823 internal_proto(find_unit);
 824
 825 extern gfc_unit *find_or_create_unit (int);
 826 internal_proto(find_or_create_unit);
 827
 828 extern gfc_unit *get_unit (st_parameter_dt *, int);
 829 internal_proto(get_unit);
 830
 831 extern void unlock_unit (gfc_unit *);
 832 internal_proto(unlock_unit);
 833
 834 extern void update_position (gfc_unit *);
 835 internal_proto(update_position);
 836
 837 extern void finish_last_advance_record (gfc_unit *u);
 838 internal_proto (finish_last_advance_record);
 839
 840 extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
 841 internal_proto (unit_truncate);
 842
 843 /* open.c */
 844
 845 extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
 846 internal_proto(new_unit);
 847
 848 /* format.c */
 849
 850 extern void parse_format (st_parameter_dt *);
 851 internal_proto(parse_format);
 852
 853 extern const fnode *next_format (st_parameter_dt *);
 854 internal_proto(next_format);
 855
 856 extern void unget_format (st_parameter_dt *, const fnode *);
 857 internal_proto(unget_format);
 858
 859 extern void format_error (st_parameter_dt *, const fnode *, const char *);
 860 internal_proto(format_error);
 861
 862 extern void free_format_data (struct format_data *);
 863 internal_proto(free_format_data);
 864
 865 extern void free_format_hash_table (gfc_unit *);
 866 internal_proto(free_format_hash_table);
 867
 868 extern void init_format_hash (st_parameter_dt *);
 869 internal_proto(init_format_hash);
 870
 871 extern void free_format_hash (st_parameter_dt *);
 872 internal_proto(free_format_hash);
 873
 874 /* transfer.c */
 875
 876 #define SCRATCH_SIZE 300
 877
 878 extern const char *type_name (bt);
 879 internal_proto(type_name);
 880
 881 extern void * read_block_form (st_parameter_dt *, int *);
 882 internal_proto(read_block_form);
 883
 884 extern char *read_sf (st_parameter_dt *, int *, int);
 885 internal_proto(read_sf);
 886
 887 extern void *write_block (st_parameter_dt *, int);
 888 internal_proto(write_block);
 889
 890 extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *,
 891                                      int*);
 892 internal_proto(next_array_record);
 893
 894 extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *,
 895                                   gfc_offset *);
 896 internal_proto(init_loop_spec);
 897
 898 extern void next_record (st_parameter_dt *, int);
 899 internal_proto(next_record);
 900
 901 extern void reverse_memcpy (void *, const void *, size_t);
 902 internal_proto (reverse_memcpy);
 903
 904 extern void st_wait (st_parameter_wait *);
 905 export_proto(st_wait);
 906
 907 extern void hit_eof (st_parameter_dt *);
 908 internal_proto(hit_eof);
 909
 910 /* read.c */
 911
 912 extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
 913 internal_proto(set_integer);
 914
 915 extern GFC_UINTEGER_LARGEST max_value (int, int);
 916 internal_proto(max_value);
 917
 918 extern int convert_real (st_parameter_dt *, void *, const char *, int);
 919 internal_proto(convert_real);
 920
 921 extern void read_a (st_parameter_dt *, const fnode *, char *, int);
 922 internal_proto(read_a);
 923
 924 extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, int);
 925 internal_proto(read_a);
 926
 927 extern void read_f (st_parameter_dt *, const fnode *, char *, int);
 928 internal_proto(read_f);
 929
 930 extern void read_l (st_parameter_dt *, const fnode *, char *, int);
 931 internal_proto(read_l);
 932
 933 extern void read_x (st_parameter_dt *, int);
 934 internal_proto(read_x);
 935
 936 extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);
 937 internal_proto(read_radix);
 938
 939 extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
 940 internal_proto(read_decimal);
 941
 942 /* list_read.c */
 943
 944 extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t,
 945                                  size_t);
 946 internal_proto(list_formatted_read);
 947
 948 extern void finish_list_read (st_parameter_dt *);
 949 internal_proto(finish_list_read);
 950
 951 extern void namelist_read (st_parameter_dt *);
 952 internal_proto(namelist_read);
 953
 954 extern void namelist_write (st_parameter_dt *);
 955 internal_proto(namelist_write);
 956
 957 /* write.c */
 958
 959 extern void write_a (st_parameter_dt *, const fnode *, const char *, int);
 960 internal_proto(write_a);
 961
 962 extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, int);
 963 internal_proto(write_a_char4);
 964
 965 extern void write_b (st_parameter_dt *, const fnode *, const char *, int);
 966 internal_proto(write_b);
 967
 968 extern void write_d (st_parameter_dt *, const fnode *, const char *, int);
 969 internal_proto(write_d);
 970
 971 extern void write_e (st_parameter_dt *, const fnode *, const char *, int);
 972 internal_proto(write_e);
 973
 974 extern void write_en (st_parameter_dt *, const fnode *, const char *, int);
 975 internal_proto(write_en);
 976
 977 extern void write_es (st_parameter_dt *, const fnode *, const char *, int);
 978 internal_proto(write_es);
 979
 980 extern void write_f (st_parameter_dt *, const fnode *, const char *, int);
 981 internal_proto(write_f);
 982
 983 extern void write_i (st_parameter_dt *, const fnode *, const char *, int);
 984 internal_proto(write_i);
 985
 986 extern void write_l (st_parameter_dt *, const fnode *, char *, int);
 987 internal_proto(write_l);
 988
 989 extern void write_o (st_parameter_dt *, const fnode *, const char *, int);
 990 internal_proto(write_o);
 991
 992 extern void write_real (st_parameter_dt *, const char *, int);
 993 internal_proto(write_real);
 994
 995 extern void write_real_g0 (st_parameter_dt *, const char *, int, int);
 996 internal_proto(write_real_g0);
 997
 998 extern void write_x (st_parameter_dt *, int, int);
 999 internal_proto(write_x);
1000
1001 extern void write_z (st_parameter_dt *, const fnode *, const char *, int);
1002 internal_proto(write_z);
1003
1004 extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t,
1005                                   size_t);
1006 internal_proto(list_formatted_write);
1007
1008 /* size_from_kind.c */
1009 extern size_t size_from_real_kind (int);
1010 internal_proto(size_from_real_kind);
1011
1012 extern size_t size_from_complex_kind (int);
1013 internal_proto(size_from_complex_kind);
1014
1015 /* fbuf.c */
1016 extern void fbuf_init (gfc_unit *, int);
1017 internal_proto(fbuf_init);
1018
1019 extern void fbuf_destroy (gfc_unit *);
1020 internal_proto(fbuf_destroy);
1021
1022 extern int fbuf_reset (gfc_unit *);
1023 internal_proto(fbuf_reset);
1024
1025 extern char * fbuf_alloc (gfc_unit *, int);
1026 internal_proto(fbuf_alloc);
1027
1028 extern int fbuf_flush (gfc_unit *, unit_mode);
1029 internal_proto(fbuf_flush);
1030
1031 extern int fbuf_seek (gfc_unit *, int, int);
1032 internal_proto(fbuf_seek);
1033
1034 extern char * fbuf_read (gfc_unit *, int *);
1035 internal_proto(fbuf_read);
1036
1037 /* Never call this function, only use fbuf_getc().  */
1038 extern int fbuf_getc_refill (gfc_unit *);
1039 internal_proto(fbuf_getc_refill);
1040
1041 static inline int
1042 fbuf_getc (gfc_unit * u)
1043 {
1044   if (u->fbuf->pos < u->fbuf->act)
1045     return (unsigned char) u->fbuf->buf[u->fbuf->pos++];
1046   return fbuf_getc_refill (u);
1047 }
1048
1049 /* lock.c */
1050 extern void free_ionml (st_parameter_dt *);
1051 internal_proto(free_ionml);
1052
1053 static inline void
1054 inc_waiting_locked (gfc_unit *u)
1055 {
1056 #ifdef HAVE_SYNC_FETCH_AND_ADD
1057   (void) __sync_fetch_and_add (&u->waiting, 1);
1058 #else
1059   u->waiting++;
1060 #endif
1061 }
1062
1063 static inline int
1064 predec_waiting_locked (gfc_unit *u)
1065 {
1066 #ifdef HAVE_SYNC_FETCH_AND_ADD
1067   return __sync_add_and_fetch (&u->waiting, -1);
1068 #else
1069   return --u->waiting;
1070 #endif
1071 }
1072
1073 static inline void
1074 dec_waiting_unlocked (gfc_unit *u)
1075 {
1076 #ifdef HAVE_SYNC_FETCH_AND_ADD
1077   (void) __sync_fetch_and_add (&u->waiting, -1);
1078 #else
1079   __gthread_mutex_lock (&unit_lock);
1080   u->waiting--;
1081   __gthread_mutex_unlock (&unit_lock);
1082 #endif
1083 }
1084
1085 #endif
1086