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