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