libgfortran/io/io.h

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