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   char *(*alloc_w_at) (struct stream *, int *);
  53   try (*sfree) (struct stream *);
  54   try (*close) (struct stream *);
  55   try (*seek) (struct stream *, gfc_offset);
  56   try (*trunc) (struct stream *);
  57   int (*read) (struct stream *, void *, size_t *);
  58   int (*write) (struct stream *, const void *, size_t *);
  59   try (*set) (struct stream *, int, size_t);
  60 }
  61 stream;
  62
  63 typedef enum
  64 { SYNC_BUFFERED, SYNC_UNBUFFERED, ASYNC }
  65 io_mode;
  66
  67 /* Macros for doing file I/O given a stream.  */
  68
  69 #define sfree(s) ((s)->sfree)(s)
  70 #define sclose(s) ((s)->close)(s)
  71
  72 #define salloc_w(s, len) ((s)->alloc_w_at)(s, len)
  73
  74 #define sseek(s, pos) ((s)->seek)(s, pos)
  75 #define struncate(s) ((s)->trunc)(s)
  76 #define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes)
  77 #define swrite(s, buf, nbytes) ((s)->write)(s, buf, nbytes)
  78
  79 #define sset(s, c, n) ((s)->set)(s, c, n)
  80
  81 /* Macros for testing what kinds of I/O we are doing.  */
  82
  83 #define is_array_io(dtp) ((dtp)->internal_unit_desc)
  84
  85 #define is_internal_unit(dtp) ((dtp)->u.p.unit_is_internal)
  86
  87 #define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM)
  88
  89 /* The array_loop_spec contains the variables for the loops over index ranges
  90    that are encountered.  Since the variables can be negative, ssize_t
  91    is used.  */
  92
  93 typedef struct array_loop_spec
  94 {
  95   /* Index counter for this dimension.  */
  96   ssize_t idx;
  97
  98   /* Start for the index counter.  */
  99   ssize_t start;
 100
 101   /* End for the index counter.  */
 102   ssize_t end;
 103
 104   /* Step for the index counter.  */
 105   ssize_t step;
 106 }
 107 array_loop_spec;
 108
 109 /* Representation of a namelist object in libgfortran
 110
 111    Namelist Records
 112       &GROUPNAME  OBJECT=value[s] [,OBJECT=value[s]].../
 113      or
 114       &GROUPNAME  OBJECT=value[s] [,OBJECT=value[s]]...&END
 115
 116    The object can be a fully qualified, compound name for an intrinsic
 117    type, derived types or derived type components.  So, a substring
 118    a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist
 119    read. Hence full information about the structure of the object has
 120    to be available to list_read.c and write.
 121
 122    These requirements are met by the following data structures.
 123
 124    namelist_info type contains all the scalar information about the
 125    object and arrays of descriptor_dimension and array_loop_spec types for
 126    arrays.  */
 127
 128 typedef struct namelist_type
 129 {
 130
 131   /* Object type, stored as GFC_DTYPE_xxxx.  */
 132   bt type;
 133
 134   /* Object name.  */
 135   char * var_name;
 136
 137   /* Address for the start of the object's data.  */
 138   void * mem_pos;
 139
 140   /* Flag to show that a read is to be attempted for this node.  */
 141   int touched;
 142
 143   /* Length of intrinsic type in bytes.  */
 144   int len;
 145
 146   /* Rank of the object.  */
 147   int var_rank;
 148
 149   /* Overall size of the object in bytes.  */
 150   index_type size;
 151
 152   /* Length of character string.  */
 153   index_type string_length;
 154
 155   descriptor_dimension * dim;
 156   array_loop_spec * ls;
 157   struct namelist_type * next;
 158 }
 159 namelist_info;
 160
 161 /* Options for the OPEN statement.  */
 162
 163 typedef enum
 164 { ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_STREAM,
 165   ACCESS_UNSPECIFIED
 166 }
 167 unit_access;
 168
 169 typedef enum
 170 { ACTION_READ, ACTION_WRITE, ACTION_READWRITE,
 171   ACTION_UNSPECIFIED
 172 }
 173 unit_action;
 174
 175 typedef enum
 176 { BLANK_NULL, BLANK_ZERO, BLANK_UNSPECIFIED }
 177 unit_blank;
 178
 179 typedef enum
 180 { DELIM_NONE, DELIM_APOSTROPHE, DELIM_QUOTE,
 181   DELIM_UNSPECIFIED
 182 }
 183 unit_delim;
 184
 185 typedef enum
 186 { FORM_FORMATTED, FORM_UNFORMATTED, FORM_UNSPECIFIED }
 187 unit_form;
 188
 189 typedef enum
 190 { POSITION_ASIS, POSITION_REWIND, POSITION_APPEND,
 191   POSITION_UNSPECIFIED
 192 }
 193 unit_position;
 194
 195 typedef enum
 196 { STATUS_UNKNOWN, STATUS_OLD, STATUS_NEW, STATUS_SCRATCH,
 197   STATUS_REPLACE, STATUS_UNSPECIFIED
 198 }
 199 unit_status;
 200
 201 typedef enum
 202 { PAD_YES, PAD_NO, PAD_UNSPECIFIED }
 203 unit_pad;
 204
 205 typedef enum
 206 { DECIMAL_POINT, DECIMAL_COMMA, DECIMAL_UNSPECIFIED }
 207 unit_decimal;
 208
 209 typedef enum
 210 { ENCODING_UTF8, ENCODING_DEFAULT, ENCODING_UNSPECIFIED }
 211 unit_encoding;
 212
 213 typedef enum
 214 { ROUND_UP, ROUND_DOWN, ROUND_ZERO, ROUND_NEAREST, ROUND_COMPATIBLE,
 215   ROUND_PROCDEFINED, ROUND_UNSPECIFIED }
 216 unit_round;
 217
 218 /* NOTE: unit_sign must correspond with the sign_status enumerator in
 219    st_parameter_dt to not break the ABI.  */
 220 typedef enum
 221 { SIGN_PROCDEFINED, SIGN_SUPPRESS, SIGN_PLUS, SIGN_UNSPECIFIED }
 222 unit_sign;
 223
 224 typedef enum
 225 { ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED }
 226 unit_advance;
 227
 228 typedef enum
 229 {READING, WRITING}
 230 unit_mode;
 231
 232 typedef enum
 233 { ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED }
 234 unit_async;
 235
 236 typedef enum
 237 { SIGN_S, SIGN_SS, SIGN_SP }
 238 unit_sign_s;
 239
 240 #define CHARACTER1(name) \
 241               char * name; \
 242               gfc_charlen_type name ## _len
 243 #define CHARACTER2(name) \
 244               gfc_charlen_type name ## _len; \
 245               char * name
 246
 247 typedef struct
 248 {
 249   st_parameter_common common;
 250   GFC_INTEGER_4 recl_in;
 251   CHARACTER2 (file);
 252   CHARACTER1 (status);
 253   CHARACTER2 (access);
 254   CHARACTER1 (form);
 255   CHARACTER2 (blank);
 256   CHARACTER1 (position);
 257   CHARACTER2 (action);
 258   CHARACTER1 (delim);
 259   CHARACTER2 (pad);
 260   CHARACTER1 (convert);
 261   CHARACTER2 (decimal);
 262   CHARACTER1 (encoding);
 263   CHARACTER2 (round);
 264   CHARACTER1 (sign);
 265   CHARACTER2 (asynchronous);
 266 }
 267 st_parameter_open;
 268
 269 #define IOPARM_CLOSE_HAS_STATUS         (1 << 7)
 270
 271 typedef struct
 272 {
 273   st_parameter_common common;
 274   CHARACTER1 (status);
 275 }
 276 st_parameter_close;
 277
 278 typedef struct
 279 {
 280   st_parameter_common common;
 281 }
 282 st_parameter_filepos;
 283
 284 #define IOPARM_INQUIRE_HAS_EXIST        (1 << 7)
 285 #define IOPARM_INQUIRE_HAS_OPENED       (1 << 8)
 286 #define IOPARM_INQUIRE_HAS_NUMBER       (1 << 9)
 287 #define IOPARM_INQUIRE_HAS_NAMED        (1 << 10)
 288 #define IOPARM_INQUIRE_HAS_NEXTREC      (1 << 11)
 289 #define IOPARM_INQUIRE_HAS_RECL_OUT     (1 << 12)
 290 #define IOPARM_INQUIRE_HAS_STRM_POS_OUT (1 << 13)
 291 #define IOPARM_INQUIRE_HAS_FILE         (1 << 14)
 292 #define IOPARM_INQUIRE_HAS_ACCESS       (1 << 15)
 293 #define IOPARM_INQUIRE_HAS_FORM         (1 << 16)
 294 #define IOPARM_INQUIRE_HAS_BLANK        (1 << 17)
 295 #define IOPARM_INQUIRE_HAS_POSITION     (1 << 18)
 296 #define IOPARM_INQUIRE_HAS_ACTION       (1 << 19)
 297 #define IOPARM_INQUIRE_HAS_DELIM        (1 << 20)
 298 #define IOPARM_INQUIRE_HAS_PAD          (1 << 21)
 299 #define IOPARM_INQUIRE_HAS_NAME         (1 << 22)
 300 #define IOPARM_INQUIRE_HAS_SEQUENTIAL   (1 << 23)
 301 #define IOPARM_INQUIRE_HAS_DIRECT       (1 << 24)
 302 #define IOPARM_INQUIRE_HAS_FORMATTED    (1 << 25)
 303 #define IOPARM_INQUIRE_HAS_UNFORMATTED  (1 << 26)
 304 #define IOPARM_INQUIRE_HAS_READ         (1 << 27)
 305 #define IOPARM_INQUIRE_HAS_WRITE        (1 << 28)
 306 #define IOPARM_INQUIRE_HAS_READWRITE    (1 << 29)
 307 #define IOPARM_INQUIRE_HAS_CONVERT      (1 << 30)
 308 #define IOPARM_INQUIRE_HAS_FLAGS2       (1 << 31)
 309
 310 #define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0)
 311 #define IOPARM_INQUIRE_HAS_DECIMAL      (1 << 1)
 312 #define IOPARM_INQUIRE_HAS_ENCODING     (1 << 2)
 313 #define IOPARM_INQUIRE_HAS_ROUND        (1 << 3)
 314 #define IOPARM_INQUIRE_HAS_SIGN         (1 << 4)
 315 #define IOPARM_INQUIRE_HAS_PENDING      (1 << 5)
 316 #define IOPARM_INQUIRE_HAS_SIZE         (1 << 6)
 317 #define IOPARM_INQUIRE_HAS_ID           (1 << 7)
 318
 319 typedef struct
 320 {
 321   st_parameter_common common;
 322   GFC_INTEGER_4 *exist, *opened, *number, *named;
 323   GFC_INTEGER_4 *nextrec, *recl_out;
 324   GFC_IO_INT *strm_pos_out;
 325   CHARACTER1 (file);
 326   CHARACTER2 (access);
 327   CHARACTER1 (form);
 328   CHARACTER2 (blank);
 329   CHARACTER1 (position);
 330   CHARACTER2 (action);
 331   CHARACTER1 (delim);
 332   CHARACTER2 (pad);
 333   CHARACTER1 (name);
 334   CHARACTER2 (sequential);
 335   CHARACTER1 (direct);
 336   CHARACTER2 (formatted);
 337   CHARACTER1 (unformatted);
 338   CHARACTER2 (read);
 339   CHARACTER1 (write);
 340   CHARACTER2 (readwrite);
 341   CHARACTER1 (convert);
 342   GFC_INTEGER_4 flags2;
 343   CHARACTER1 (asynchronous);
 344   CHARACTER2 (decimal);
 345   CHARACTER1 (encoding);
 346   CHARACTER2 (round);
 347   CHARACTER1 (sign);
 348   GFC_INTEGER_4 *pending;
 349   GFC_INTEGER_4 *size;
 350   GFC_INTEGER_4 *id;
 351 }
 352 st_parameter_inquire;
 353
 354 struct gfc_unit;
 355 struct format_data;
 356
 357 #define IOPARM_DT_LIST_FORMAT                   (1 << 7)
 358 #define IOPARM_DT_NAMELIST_READ_MODE            (1 << 8)
 359 #define IOPARM_DT_HAS_REC                       (1 << 9)
 360 #define IOPARM_DT_HAS_SIZE                      (1 << 10)
 361 #define IOPARM_DT_HAS_IOLENGTH                  (1 << 11)
 362 #define IOPARM_DT_HAS_FORMAT                    (1 << 12)
 363 #define IOPARM_DT_HAS_ADVANCE                   (1 << 13)
 364 #define IOPARM_DT_HAS_INTERNAL_UNIT             (1 << 14)
 365 #define IOPARM_DT_HAS_NAMELIST_NAME             (1 << 15)
 366 #define IOPARM_DT_HAS_ID                        (1 << 16)
 367 #define IOPARM_DT_HAS_POS                       (1 << 17)
 368 #define IOPARM_DT_HAS_ASYNCHRONOUS              (1 << 18)
 369 #define IOPARM_DT_HAS_BLANK                     (1 << 19)
 370 #define IOPARM_DT_HAS_DECIMAL                   (1 << 20)
 371 #define IOPARM_DT_HAS_DELIM                     (1 << 21)
 372 #define IOPARM_DT_HAS_PAD                       (1 << 22)
 373 #define IOPARM_DT_HAS_ROUND                     (1 << 23)
 374 #define IOPARM_DT_HAS_SIGN                      (1 << 24)
 375 #define IOPARM_DT_HAS_F2003                     (1 << 25)
 376 /* Internal use bit.  */
 377 #define IOPARM_DT_IONML_SET                     (1 << 31)
 378
 379
 380 typedef struct st_parameter_dt
 381 {
 382   st_parameter_common common;
 383   GFC_IO_INT rec;
 384   GFC_IO_INT *size, *iolength;
 385   gfc_array_char *internal_unit_desc;
 386   CHARACTER1 (format);
 387   CHARACTER2 (advance);
 388   CHARACTER1 (internal_unit);
 389   CHARACTER2 (namelist_name);
 390   /* Private part of the structure.  The compiler just needs
 391      to reserve enough space.  */
 392   union
 393     {
 394       struct
 395         {
 396           void (*transfer) (struct st_parameter_dt *, bt, void *, int,
 397                             size_t, size_t);
 398           struct gfc_unit *current_unit;
 399           /* Item number in a formatted data transfer.  Also used in namelist
 400              read_logical as an index into line_buffer.  */
 401           int item_count;
 402           unit_mode mode;
 403           unit_blank blank_status;
 404           unit_sign sign_status;
 405           int scale_factor;
 406           int max_pos; /* Maximum righthand column written to.  */
 407           /* Number of skips + spaces to be done for T and X-editing.  */
 408           int skips;
 409           /* Number of spaces to be done for T and X-editing.  */
 410           int pending_spaces;
 411           /* Whether an EOR condition was encountered. Value is:
 412                0 if no EOR was encountered
 413                1 if an EOR was encountered due to a 1-byte marker (LF)
 414                2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
 415           int sf_seen_eor;
 416           unit_advance advance_status;
 417           unsigned reversion_flag : 1; /* Format reversion has occurred.  */
 418           unsigned first_item : 1;
 419           unsigned seen_dollar : 1;
 420           unsigned eor_condition : 1;
 421           unsigned no_leading_blank : 1;
 422           unsigned char_flag : 1;
 423           unsigned input_complete : 1;
 424           unsigned at_eol : 1;
 425           unsigned comma_flag : 1;
 426           /* A namelist specific flag used in the list directed library
 427              to flag that calls are being made from namelist read (eg. to
 428              ignore comments or to treat '/' as a terminator)  */
 429           unsigned namelist_mode : 1;
 430           /* A namelist specific flag used in the list directed library
 431              to flag read errors and return, so that an attempt can be
 432              made to read a new object name.  */
 433           unsigned nml_read_error : 1;
 434           /* A sequential formatted read specific flag used to signal that a
 435              character string is being read so don't use commas to shorten a
 436              formatted field width.  */
 437           unsigned sf_read_comma : 1;
 438           /* A namelist specific flag used to enable reading input from
 439              line_buffer for logical reads.  */
 440           unsigned line_buffer_enabled : 1;
 441           /* An internal unit specific flag used to identify that the associated
 442              unit is internal.  */
 443           unsigned unit_is_internal : 1;
 444           /* An internal unit specific flag to signify an EOF condition for list
 445              directed read.  */
 446           unsigned at_eof : 1;
 447           /* Used for g0 floating point output.  */
 448           unsigned g0_no_blanks : 1;
 449           /* 15 unused bits.  */
 450
 451           char last_char;
 452           char nml_delim;
 453
 454           int repeat_count;
 455           int saved_length;
 456           int saved_used;
 457           bt saved_type;
 458           char *saved_string;
 459           char *scratch;
 460           char *line_buffer;
 461           struct format_data *fmt;
 462           jmp_buf *eof_jump;
 463           namelist_info *ionml;
 464           /* A flag used to identify when a non-standard expanded namelist read
 465              has occurred.  */
 466           int expanded_read;
 467           /* Storage area for values except for strings.  Must be large
 468              enough to hold a complex value (two reals) of the largest
 469              kind.  */
 470           char value[32];
 471           GFC_IO_INT size_used;
 472         } p;
 473       /* This pad size must be equal to the pad_size declared in
 474          trans-io.c (gfc_build_io_library_fndecls).  The above structure
 475          must be smaller or equal to this array.  */
 476       char pad[16 * sizeof (char *) + 32 * sizeof (int)];
 477     } u;
 478   GFC_INTEGER_4 *id;
 479   GFC_IO_INT pos;
 480   CHARACTER1 (asynchronous);
 481   CHARACTER2 (blank);
 482   CHARACTER1 (decimal);
 483   CHARACTER2 (delim);
 484   CHARACTER1 (pad);
 485   CHARACTER2 (round);
 486   CHARACTER1 (sign);
 487 }
 488 st_parameter_dt;
 489
 490 /* Ensure st_parameter_dt's u.pad is bigger or equal to u.p.  */
 491 extern char check_st_parameter_dt[sizeof (((st_parameter_dt *) 0)->u.pad)
 492                                   >= sizeof (((st_parameter_dt *) 0)->u.p)
 493                                   ? 1 : -1];
 494
 495 #define IOPARM_WAIT_HAS_ID              (1 << 7)
 496
 497 typedef struct
 498 {
 499   st_parameter_common common;
 500   CHARACTER1 (id);
 501 }
 502 st_parameter_wait;
 503
 504
 505 #undef CHARACTER1
 506 #undef CHARACTER2
 507
 508 typedef struct
 509 {
 510   unit_access access;
 511   unit_action action;
 512   unit_blank blank;
 513   unit_delim delim;
 514   unit_form form;
 515   int is_notpadded;
 516   unit_position position;
 517   unit_status status;
 518   unit_pad pad;
 519   unit_convert convert;
 520   int has_recl;
 521   unit_decimal decimal;
 522   unit_encoding encoding;
 523   unit_round round;
 524   unit_sign sign;
 525   unit_async async;
 526 }
 527 unit_flags;
 528
 529
 530 /* Formatting buffer. This is a temporary scratch buffer. Currently used only
 531    by formatted writes. After every
 532    formatted write statement, this buffer is flushed. This buffer is needed since
 533    not all devices are seekable, and T or TL edit descriptors require
 534    moving backwards in the record.  However, advance='no' complicates the
 535    situation, so the buffer must only be partially flushed from the end of the
 536    last flush until the current position in the record. */
 537
 538 typedef struct fbuf
 539 {
 540   char *buf;                    /* Start of buffer.  */
 541   size_t len;                   /* Length of buffer.  */
 542   size_t act;                   /* Active bytes in buffer.  */
 543   size_t flushed;               /* Flushed bytes from beginning of buffer.  */
 544   size_t pos;                   /* Current position in buffer.  */
 545 }
 546 fbuf;
 547
 548
 549 typedef struct gfc_unit
 550 {
 551   int unit_number;
 552   stream *s;
 553
 554   /* Treap links.  */
 555   struct gfc_unit *left, *right;
 556   int priority;
 557
 558   int read_bad, current_record, saved_pos, previous_nonadvancing_write;
 559
 560   enum
 561   { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
 562   endfile;
 563
 564   unit_mode mode;
 565   unit_flags flags;
 566   unit_pad pad_status;
 567   unit_decimal decimal_status;
 568   unit_delim delim_status;
 569
 570   /* recl                 -- Record length of the file.
 571      last_record          -- Last record number read or written
 572      maxrec               -- Maximum record number in a direct access file
 573      bytes_left           -- Bytes left in current record.
 574      strm_pos             -- Current position in file for STREAM I/O.
 575      recl_subrecord       -- Maximum length for subrecord.
 576      bytes_left_subrecord -- Bytes left in current subrecord.  */
 577   gfc_offset recl, last_record, maxrec, bytes_left, strm_pos,
 578     recl_subrecord, bytes_left_subrecord;
 579
 580   /* Set to 1 if we have read a subrecord.  */
 581
 582   int continued;
 583
 584   __gthread_mutex_t lock;
 585   /* Number of threads waiting to acquire this unit's lock.
 586      When non-zero, close_unit doesn't only removes the unit
 587      from the UNIT_ROOT tree, but doesn't free it and the
 588      last of the waiting threads will do that.
 589      This must be either atomically increased/decreased, or
 590      always guarded by UNIT_LOCK.  */
 591   int waiting;
 592   /* Flag set by close_unit if the unit as been closed.
 593      Must be manipulated under unit's lock.  */
 594   int closed;
 595
 596   /* For traversing arrays */
 597   array_loop_spec *ls;
 598   int rank;
 599
 600   int file_len;
 601   char *file;
 602
 603   /* Formatting buffer.  */
 604   struct fbuf *fbuf;
 605 }
 606 gfc_unit;
 607
 608 /* Format tokens.  Only about half of these can be stored in the
 609    format nodes.  */
 610
 611 typedef enum
 612 {
 613   FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD,
 614   FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL,
 615   FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING,
 616   FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F,
 617   FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_DC,
 618   FMT_DP
 619 }
 620 format_token;
 621
 622
 623 /* Format nodes.  A format string is converted into a tree of these
 624    structures, which is traversed as part of a data transfer statement.  */
 625
 626 typedef struct fnode
 627 {
 628   format_token format;
 629   int repeat;
 630   struct fnode *next;
 631   char *source;
 632
 633   union
 634   {
 635     struct
 636     {
 637       int w, d, e;
 638     }
 639     real;
 640
 641     struct
 642     {
 643       int length;
 644       char *p;
 645     }
 646     string;
 647
 648     struct
 649     {
 650       int w, m;
 651     }
 652     integer;
 653
 654     int w;
 655     int k;
 656     int r;
 657     int n;
 658
 659     struct fnode *child;
 660   }
 661   u;
 662
 663   /* Members for traversing the tree during data transfer.  */
 664
 665   int count;
 666   struct fnode *current;
 667
 668 }
 669 fnode;
 670
 671
 672 /* unix.c */
 673
 674 extern int move_pos_offset (stream *, int);
 675 internal_proto(move_pos_offset);
 676
 677 extern int compare_files (stream *, stream *);
 678 internal_proto(compare_files);
 679
 680 extern stream *open_external (st_parameter_open *, unit_flags *);
 681 internal_proto(open_external);
 682
 683 extern stream *open_internal (char *, int, gfc_offset);
 684 internal_proto(open_internal);
 685
 686 extern stream *input_stream (void);
 687 internal_proto(input_stream);
 688
 689 extern stream *output_stream (void);
 690 internal_proto(output_stream);
 691
 692 extern stream *error_stream (void);
 693 internal_proto(error_stream);
 694
 695 extern int compare_file_filename (gfc_unit *, const char *, int);
 696 internal_proto(compare_file_filename);
 697
 698 extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len);
 699 internal_proto(find_file);
 700
 701 extern int stream_at_bof (stream *);
 702 internal_proto(stream_at_bof);
 703
 704 extern int stream_at_eof (stream *);
 705 internal_proto(stream_at_eof);
 706
 707 extern int delete_file (gfc_unit *);
 708 internal_proto(delete_file);
 709
 710 extern int file_exists (const char *file, gfc_charlen_type file_len);
 711 internal_proto(file_exists);
 712
 713 extern const char *inquire_sequential (const char *, int);
 714 internal_proto(inquire_sequential);
 715
 716 extern const char *inquire_direct (const char *, int);
 717 internal_proto(inquire_direct);
 718
 719 extern const char *inquire_formatted (const char *, int);
 720 internal_proto(inquire_formatted);
 721
 722 extern const char *inquire_unformatted (const char *, int);
 723 internal_proto(inquire_unformatted);
 724
 725 extern const char *inquire_read (const char *, int);
 726 internal_proto(inquire_read);
 727
 728 extern const char *inquire_write (const char *, int);
 729 internal_proto(inquire_write);
 730
 731 extern const char *inquire_readwrite (const char *, int);
 732 internal_proto(inquire_readwrite);
 733
 734 extern gfc_offset file_length (stream *);
 735 internal_proto(file_length);
 736
 737 extern gfc_offset file_position (stream *);
 738 internal_proto(file_position);
 739
 740 extern int is_seekable (stream *);
 741 internal_proto(is_seekable);
 742
 743 extern int is_special (stream *);
 744 internal_proto(is_special);
 745
 746 extern int is_preconnected (stream *);
 747 internal_proto(is_preconnected);
 748
 749 extern void flush_if_preconnected (stream *);
 750 internal_proto(flush_if_preconnected);
 751
 752 extern void empty_internal_buffer(stream *);
 753 internal_proto(empty_internal_buffer);
 754
 755 extern try flush (stream *);
 756 internal_proto(flush);
 757
 758 extern int stream_isatty (stream *);
 759 internal_proto(stream_isatty);
 760
 761 extern char * stream_ttyname (stream *);
 762 internal_proto(stream_ttyname);
 763
 764 extern gfc_offset stream_offset (stream *s);
 765 internal_proto(stream_offset);
 766
 767 extern int unpack_filename (char *, const char *, int);
 768 internal_proto(unpack_filename);
 769
 770 /* unit.c */
 771
 772 /* Maximum file offset, computed at library initialization time.  */
 773 extern gfc_offset max_offset;
 774 internal_proto(max_offset);
 775
 776 /* Unit tree root.  */
 777 extern gfc_unit *unit_root;
 778 internal_proto(unit_root);
 779
 780 extern __gthread_mutex_t unit_lock;
 781 internal_proto(unit_lock);
 782
 783 extern int close_unit (gfc_unit *);
 784 internal_proto(close_unit);
 785
 786 extern gfc_unit *get_internal_unit (st_parameter_dt *);
 787 internal_proto(get_internal_unit);
 788
 789 extern void free_internal_unit (st_parameter_dt *);
 790 internal_proto(free_internal_unit);
 791
 792 extern gfc_unit *find_unit (int);
 793 internal_proto(find_unit);
 794
 795 extern gfc_unit *find_or_create_unit (int);
 796 internal_proto(find_or_create_unit);
 797
 798 extern gfc_unit *get_unit (st_parameter_dt *, int);
 799 internal_proto(get_unit);
 800
 801 extern void unlock_unit (gfc_unit *);
 802 internal_proto(unlock_unit);
 803
 804 extern void update_position (gfc_unit *);
 805 internal_proto(update_position);
 806
 807 extern void finish_last_advance_record (gfc_unit *u);
 808 internal_proto (finish_last_advance_record);
 809
 810 /* open.c */
 811
 812 extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
 813 internal_proto(new_unit);
 814
 815 /* format.c */
 816
 817 extern void parse_format (st_parameter_dt *);
 818 internal_proto(parse_format);
 819
 820 extern const fnode *next_format (st_parameter_dt *);
 821 internal_proto(next_format);
 822
 823 extern void unget_format (st_parameter_dt *, const fnode *);
 824 internal_proto(unget_format);
 825
 826 extern void format_error (st_parameter_dt *, const fnode *, const char *);
 827 internal_proto(format_error);
 828
 829 extern void free_format_data (st_parameter_dt *);
 830 internal_proto(free_format_data);
 831
 832 /* transfer.c */
 833
 834 #define SCRATCH_SIZE 300
 835
 836 extern const char *type_name (bt);
 837 internal_proto(type_name);
 838
 839 extern try read_block_form (st_parameter_dt *, void *, size_t *);
 840 internal_proto(read_block_form);
 841
 842 extern char *read_sf (st_parameter_dt *, int *, int);
 843 internal_proto(read_sf);
 844
 845 extern void *write_block (st_parameter_dt *, int);
 846 internal_proto(write_block);
 847
 848 extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *,
 849                                      int*);
 850 internal_proto(next_array_record);
 851
 852 extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *,
 853                                   gfc_offset *);
 854 internal_proto(init_loop_spec);
 855
 856 extern void next_record (st_parameter_dt *, int);
 857 internal_proto(next_record);
 858
 859 extern void reverse_memcpy (void *, const void *, size_t);
 860 internal_proto (reverse_memcpy);
 861
 862 extern void st_wait (st_parameter_wait *);
 863 export_proto(st_wait);
 864
 865 /* read.c */
 866
 867 extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
 868 internal_proto(set_integer);
 869
 870 extern GFC_UINTEGER_LARGEST max_value (int, int);
 871 internal_proto(max_value);
 872
 873 extern int convert_real (st_parameter_dt *, void *, const char *, int);
 874 internal_proto(convert_real);
 875
 876 extern void read_a (st_parameter_dt *, const fnode *, char *, int);
 877 internal_proto(read_a);
 878
 879 extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, int);
 880 internal_proto(read_a);
 881
 882 extern void read_f (st_parameter_dt *, const fnode *, char *, int);
 883 internal_proto(read_f);
 884
 885 extern void read_l (st_parameter_dt *, const fnode *, char *, int);
 886 internal_proto(read_l);
 887
 888 extern void read_x (st_parameter_dt *, int);
 889 internal_proto(read_x);
 890
 891 extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);
 892 internal_proto(read_radix);
 893
 894 extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
 895 internal_proto(read_decimal);
 896
 897 /* list_read.c */
 898
 899 extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t,
 900                                  size_t);
 901 internal_proto(list_formatted_read);
 902
 903 extern void finish_list_read (st_parameter_dt *);
 904 internal_proto(finish_list_read);
 905
 906 extern void namelist_read (st_parameter_dt *);
 907 internal_proto(namelist_read);
 908
 909 extern void namelist_write (st_parameter_dt *);
 910 internal_proto(namelist_write);
 911
 912 /* write.c */
 913
 914 extern void write_a (st_parameter_dt *, const fnode *, const char *, int);
 915 internal_proto(write_a);
 916
 917 extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, int);
 918 internal_proto(write_a_char4);
 919
 920 extern void write_b (st_parameter_dt *, const fnode *, const char *, int);
 921 internal_proto(write_b);
 922
 923 extern void write_d (st_parameter_dt *, const fnode *, const char *, int);
 924 internal_proto(write_d);
 925
 926 extern void write_e (st_parameter_dt *, const fnode *, const char *, int);
 927 internal_proto(write_e);
 928
 929 extern void write_en (st_parameter_dt *, const fnode *, const char *, int);
 930 internal_proto(write_en);
 931
 932 extern void write_es (st_parameter_dt *, const fnode *, const char *, int);
 933 internal_proto(write_es);
 934
 935 extern void write_f (st_parameter_dt *, const fnode *, const char *, int);
 936 internal_proto(write_f);
 937
 938 extern void write_i (st_parameter_dt *, const fnode *, const char *, int);
 939 internal_proto(write_i);
 940
 941 extern void write_l (st_parameter_dt *, const fnode *, char *, int);
 942 internal_proto(write_l);
 943
 944 extern void write_o (st_parameter_dt *, const fnode *, const char *, int);
 945 internal_proto(write_o);
 946
 947 extern void write_real (st_parameter_dt *, const char *, int);
 948 internal_proto(write_real);
 949
 950 extern void write_real_g0 (st_parameter_dt *, const char *, int, int);
 951 internal_proto(write_real_g0);
 952
 953 extern void write_x (st_parameter_dt *, int, int);
 954 internal_proto(write_x);
 955
 956 extern void write_z (st_parameter_dt *, const fnode *, const char *, int);
 957 internal_proto(write_z);
 958
 959 extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t,
 960                                   size_t);
 961 internal_proto(list_formatted_write);
 962
 963 /* size_from_kind.c */
 964 extern size_t size_from_real_kind (int);
 965 internal_proto(size_from_real_kind);
 966
 967 extern size_t size_from_complex_kind (int);
 968 internal_proto(size_from_complex_kind);
 969
 970 /* fbuf.c */
 971 extern void fbuf_init (gfc_unit *, size_t);
 972 internal_proto(fbuf_init);
 973
 974 extern void fbuf_destroy (gfc_unit *);
 975 internal_proto(fbuf_destroy);
 976
 977 extern void fbuf_reset (gfc_unit *);
 978 internal_proto(fbuf_reset);
 979
 980 extern char * fbuf_alloc (gfc_unit *, size_t);
 981 internal_proto(fbuf_alloc);
 982
 983 extern int fbuf_flush (gfc_unit *, int);
 984 internal_proto(fbuf_flush);
 985
 986 extern int fbuf_seek (gfc_unit *, gfc_offset);
 987 internal_proto(fbuf_seek);
 988
 989 /* lock.c */
 990 extern void free_ionml (st_parameter_dt *);
 991 internal_proto(free_ionml);
 992
 993 static inline void
 994 inc_waiting_locked (gfc_unit *u)
 995 {
 996 #ifdef HAVE_SYNC_FETCH_AND_ADD
 997   (void) __sync_fetch_and_add (&u->waiting, 1);
 998 #else
 999   u->waiting++;
1000 #endif
1001 }
1002
1003 static inline int
1004 predec_waiting_locked (gfc_unit *u)
1005 {
1006 #ifdef HAVE_SYNC_FETCH_AND_ADD
1007   return __sync_add_and_fetch (&u->waiting, -1);
1008 #else
1009   return --u->waiting;
1010 #endif
1011 }
1012
1013 static inline void
1014 dec_waiting_unlocked (gfc_unit *u)
1015 {
1016 #ifdef HAVE_SYNC_FETCH_AND_ADD
1017   (void) __sync_fetch_and_add (&u->waiting, -1);
1018 #else
1019   __gthread_mutex_lock (&unit_lock);
1020   u->waiting--;
1021   __gthread_mutex_unlock (&unit_lock);
1022 #endif
1023 }
1024
1025 #endif
1026