libgfortran/io/io.h

   1 /* Copyright (C) 2002, 2003, 2004, 2005 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 #ifdef HAVE_PRAGMA_WEAK
  36 /* Used by gthr.h.  */
  37 #define SUPPORTS_WEAK 1
  38 #endif
  39
  40 #include <gthr.h>
  41
  42 #define DEFAULT_TEMPDIR "/tmp"
  43
  44 /* Basic types used in data transfers.  */
  45
  46 typedef enum
  47 { BT_NULL, BT_INTEGER, BT_LOGICAL, BT_CHARACTER, BT_REAL,
  48   BT_COMPLEX
  49 }
  50 bt;
  51
  52
  53 typedef enum
  54 { SUCCESS = 1, FAILURE }
  55 try;
  56
  57 struct st_parameter_dt;
  58
  59 typedef struct stream
  60 {
  61   char *(*alloc_w_at) (struct stream *, int *, gfc_offset);
  62   char *(*alloc_r_at) (struct stream *, int *, gfc_offset);
  63   try (*sfree) (struct stream *);
  64   try (*close) (struct stream *);
  65   try (*seek) (struct stream *, gfc_offset);
  66   try (*truncate) (struct stream *);
  67   int (*read) (struct stream *, void *, size_t *);
  68   int (*write) (struct stream *, const void *, size_t *);
  69 }
  70 stream;
  71
  72
  73 /* Macros for doing file I/O given a stream.  */
  74
  75 #define sfree(s) ((s)->sfree)(s)
  76 #define sclose(s) ((s)->close)(s)
  77
  78 #define salloc_r(s, len) ((s)->alloc_r_at)(s, len, -1)
  79 #define salloc_w(s, len) ((s)->alloc_w_at)(s, len, -1)
  80
  81 #define salloc_r_at(s, len, where) ((s)->alloc_r_at)(s, len, where)
  82 #define salloc_w_at(s, len, where) ((s)->alloc_w_at)(s, len, where)
  83
  84 #define sseek(s, pos) ((s)->seek)(s, pos)
  85 #define struncate(s) ((s)->truncate)(s)
  86 #define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes)
  87 #define swrite(s, buf, nbytes) ((s)->write)(s, buf, nbytes)
  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 instrinsic
 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,
 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 { ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED }
 207 unit_advance;
 208
 209 typedef enum
 210 {READING, WRITING}
 211 unit_mode;
 212
 213 #define CHARACTER1(name) \
 214               char * name; \
 215               gfc_charlen_type name ## _len
 216 #define CHARACTER2(name) \
 217               gfc_charlen_type name ## _len; \
 218               char * name
 219
 220 #define IOPARM_LIBRETURN_MASK           (3 << 0)
 221 #define IOPARM_LIBRETURN_OK             (0 << 0)
 222 #define IOPARM_LIBRETURN_ERROR          (1 << 0)
 223 #define IOPARM_LIBRETURN_END            (2 << 0)
 224 #define IOPARM_LIBRETURN_EOR            (3 << 0)
 225 #define IOPARM_ERR                      (1 << 2)
 226 #define IOPARM_END                      (1 << 3)
 227 #define IOPARM_EOR                      (1 << 4)
 228 #define IOPARM_HAS_IOSTAT               (1 << 5)
 229 #define IOPARM_HAS_IOMSG                (1 << 6)
 230
 231 #define IOPARM_COMMON_MASK              ((1 << 7) - 1)
 232
 233 typedef struct st_parameter_common
 234 {
 235   GFC_INTEGER_4 flags;
 236   GFC_INTEGER_4 unit;
 237   const char *filename;
 238   GFC_INTEGER_4 line;
 239   CHARACTER2 (iomsg);
 240   GFC_INTEGER_4 *iostat;
 241 }
 242 st_parameter_common;
 243
 244 #define IOPARM_OPEN_HAS_RECL_IN         (1 << 7)
 245 #define IOPARM_OPEN_HAS_FILE            (1 << 8)
 246 #define IOPARM_OPEN_HAS_STATUS          (1 << 9)
 247 #define IOPARM_OPEN_HAS_ACCESS          (1 << 10)
 248 #define IOPARM_OPEN_HAS_FORM            (1 << 11)
 249 #define IOPARM_OPEN_HAS_BLANK           (1 << 12)
 250 #define IOPARM_OPEN_HAS_POSITION        (1 << 13)
 251 #define IOPARM_OPEN_HAS_ACTION          (1 << 14)
 252 #define IOPARM_OPEN_HAS_DELIM           (1 << 15)
 253 #define IOPARM_OPEN_HAS_PAD             (1 << 16)
 254
 255 typedef struct
 256 {
 257   st_parameter_common common;
 258   GFC_INTEGER_4 recl_in;
 259   CHARACTER2 (file);
 260   CHARACTER1 (status);
 261   CHARACTER2 (access);
 262   CHARACTER1 (form);
 263   CHARACTER2 (blank);
 264   CHARACTER1 (position);
 265   CHARACTER2 (action);
 266   CHARACTER1 (delim);
 267   CHARACTER2 (pad);
 268 }
 269 st_parameter_open;
 270
 271 #define IOPARM_CLOSE_HAS_STATUS         (1 << 7)
 272
 273 typedef struct
 274 {
 275   st_parameter_common common;
 276   CHARACTER1 (status);
 277 }
 278 st_parameter_close;
 279
 280 typedef struct
 281 {
 282   st_parameter_common common;
 283 }
 284 st_parameter_filepos;
 285
 286 #define IOPARM_INQUIRE_HAS_EXIST        (1 << 7)
 287 #define IOPARM_INQUIRE_HAS_OPENED       (1 << 8)
 288 #define IOPARM_INQUIRE_HAS_NUMBER       (1 << 9)
 289 #define IOPARM_INQUIRE_HAS_NAMED        (1 << 10)
 290 #define IOPARM_INQUIRE_HAS_NEXTREC      (1 << 11)
 291 #define IOPARM_INQUIRE_HAS_RECL_OUT     (1 << 12)
 292 #define IOPARM_INQUIRE_HAS_FILE         (1 << 13)
 293 #define IOPARM_INQUIRE_HAS_ACCESS       (1 << 14)
 294 #define IOPARM_INQUIRE_HAS_FORM         (1 << 15)
 295 #define IOPARM_INQUIRE_HAS_BLANK        (1 << 16)
 296 #define IOPARM_INQUIRE_HAS_POSITION     (1 << 17)
 297 #define IOPARM_INQUIRE_HAS_ACTION       (1 << 18)
 298 #define IOPARM_INQUIRE_HAS_DELIM        (1 << 19)
 299 #define IOPARM_INQUIRE_HAS_PAD          (1 << 20)
 300 #define IOPARM_INQUIRE_HAS_NAME         (1 << 21)
 301 #define IOPARM_INQUIRE_HAS_SEQUENTIAL   (1 << 22)
 302 #define IOPARM_INQUIRE_HAS_DIRECT       (1 << 23)
 303 #define IOPARM_INQUIRE_HAS_FORMATTED    (1 << 24)
 304 #define IOPARM_INQUIRE_HAS_UNFORMATTED  (1 << 25)
 305 #define IOPARM_INQUIRE_HAS_READ         (1 << 26)
 306 #define IOPARM_INQUIRE_HAS_WRITE        (1 << 27)
 307 #define IOPARM_INQUIRE_HAS_READWRITE    (1 << 28)
 308
 309 typedef struct
 310 {
 311   st_parameter_common common;
 312   GFC_INTEGER_4 *exist, *opened, *number, *named;
 313   GFC_INTEGER_4 *nextrec, *recl_out;
 314   CHARACTER1 (file);
 315   CHARACTER2 (access);
 316   CHARACTER1 (form);
 317   CHARACTER2 (blank);
 318   CHARACTER1 (position);
 319   CHARACTER2 (action);
 320   CHARACTER1 (delim);
 321   CHARACTER2 (pad);
 322   CHARACTER1 (name);
 323   CHARACTER2 (sequential);
 324   CHARACTER1 (direct);
 325   CHARACTER2 (formatted);
 326   CHARACTER1 (unformatted);
 327   CHARACTER2 (read);
 328   CHARACTER1 (write);
 329   CHARACTER2 (readwrite);
 330 }
 331 st_parameter_inquire;
 332
 333 struct gfc_unit;
 334 struct format_data;
 335
 336 #define IOPARM_DT_LIST_FORMAT                   (1 << 7)
 337 #define IOPARM_DT_NAMELIST_READ_MODE            (1 << 8)
 338 #define IOPARM_DT_HAS_REC                       (1 << 9)
 339 #define IOPARM_DT_HAS_SIZE                      (1 << 10)
 340 #define IOPARM_DT_HAS_IOLENGTH                  (1 << 11)
 341 #define IOPARM_DT_HAS_FORMAT                    (1 << 12)
 342 #define IOPARM_DT_HAS_ADVANCE                   (1 << 13)
 343 #define IOPARM_DT_HAS_INTERNAL_UNIT             (1 << 14)
 344 #define IOPARM_DT_HAS_NAMELIST_NAME             (1 << 15)
 345 /* Internal use bit.  */
 346 #define IOPARM_DT_IONML_SET                     (1 << 31)
 347
 348 typedef struct st_parameter_dt
 349 {
 350   st_parameter_common common;
 351   GFC_INTEGER_4 rec;
 352   GFC_INTEGER_4 *size, *iolength;
 353   gfc_array_char *internal_unit_desc;
 354   CHARACTER1 (format);
 355   CHARACTER2 (advance);
 356   CHARACTER1 (internal_unit);
 357   CHARACTER2 (namelist_name);
 358   /* Private part of the structure.  The compiler just needs
 359      to reserve enough space.  */
 360   union
 361     {
 362       struct
 363         {
 364           void (*transfer) (struct st_parameter_dt *, bt, void *, int,
 365                             size_t, size_t);
 366           struct gfc_unit *current_unit;
 367           int item_count; /* Item number in a formatted data transfer.  */
 368           unit_mode mode;
 369           unit_blank blank_status;
 370           enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status;
 371           int scale_factor;
 372           int max_pos; /* Maximum righthand column written to.  */
 373           /* Number of skips + spaces to be done for T and X-editing.  */
 374           int skips;
 375           /* Number of spaces to be done for T and X-editing.  */
 376           int pending_spaces;
 377           /* Whether an EOR condition was encountered. Value is:
 378                0 if no EOR was encountered
 379                1 if an EOR was encountered due to a 1-byte marker (LF)
 380                2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
 381           int sf_seen_eor;
 382           unit_advance advance_status;
 383
 384           unsigned reversion_flag : 1; /* Format reversion has occurred.  */
 385           unsigned first_item : 1;
 386           unsigned seen_dollar : 1;
 387           unsigned eor_condition : 1;
 388           unsigned no_leading_blank : 1;
 389           unsigned char_flag : 1;
 390           unsigned input_complete : 1;
 391           unsigned at_eol : 1;
 392           unsigned comma_flag : 1;
 393           /* A namelist specific flag used in the list directed library
 394              to flag that calls are being made from namelist read (eg. to
 395              ignore comments or to treat '/' as a terminator)  */
 396           unsigned namelist_mode : 1;
 397           /* A namelist specific flag used in the list directed library
 398              to flag read errors and return, so that an attempt can be
 399              made to read a new object name.  */
 400           unsigned nml_read_error : 1;
 401           /* 20 unused bits.  */
 402
 403           char last_char;
 404           char nml_delim;
 405
 406           int repeat_count;
 407           int saved_length;
 408           int saved_used;
 409           bt saved_type;
 410           char *saved_string;
 411           char *scratch;
 412           char *line_buffer;
 413           struct format_data *fmt;
 414           jmp_buf *eof_jump;
 415           namelist_info *ionml;
 416
 417           /* Storage area for values except for strings.  Must be large
 418              enough to hold a complex value (two reals) of the largest
 419              kind.  */
 420           char value[32];
 421         } p;
 422       char pad[16 * sizeof (char *) + 32 * sizeof (int)];
 423     } u;
 424 }
 425 st_parameter_dt;
 426
 427 #undef CHARACTER1
 428 #undef CHARACTER2
 429
 430 typedef struct
 431 {
 432   unit_access access;
 433   unit_action action;
 434   unit_blank blank;
 435   unit_delim delim;
 436   unit_form form;
 437   int is_notpadded;
 438   unit_position position;
 439   unit_status status;
 440   unit_pad pad;
 441 }
 442 unit_flags;
 443
 444
 445 /* The default value of record length for preconnected units is defined
 446    here. This value can be overriden by an environment variable.
 447    Default value is 1 Gb.  */
 448
 449 #define DEFAULT_RECL 1073741824
 450
 451
 452 typedef struct gfc_unit
 453 {
 454   int unit_number;
 455   stream *s;
 456
 457   /* Treap links.  */
 458   struct gfc_unit *left, *right;
 459   int priority;
 460
 461   int read_bad, current_record;
 462   enum
 463   { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
 464   endfile;
 465
 466   unit_mode mode;
 467   unit_flags flags;
 468
 469   /* recl           -- Record length of the file.
 470      last_record    -- Last record number read or written
 471      maxrec         -- Maximum record number in a direct access file
 472      bytes_left     -- Bytes left in current record.  */
 473   gfc_offset recl, last_record, maxrec, bytes_left;
 474
 475   __gthread_mutex_t lock;
 476   /* Number of threads waiting to acquire this unit's lock.
 477      When non-zero, close_unit doesn't only removes the unit
 478      from the UNIT_ROOT tree, but doesn't free it and the
 479      last of the waiting threads will do that.
 480      This must be either atomically increased/decreased, or
 481      always guarded by UNIT_LOCK.  */
 482   int waiting;
 483   /* Flag set by close_unit if the unit as been closed.
 484      Must be manipulated under unit's lock.  */
 485   int closed;
 486
 487   /* For traversing arrays */
 488   array_loop_spec *ls;
 489   int rank;
 490
 491   int file_len;
 492   char *file;
 493 }
 494 gfc_unit;
 495
 496 /* Format tokens.  Only about half of these can be stored in the
 497    format nodes.  */
 498
 499 typedef enum
 500 {
 501   FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD,
 502   FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL,
 503   FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING,
 504   FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F,
 505   FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END
 506 }
 507 format_token;
 508
 509
 510 /* Format nodes.  A format string is converted into a tree of these
 511    structures, which is traversed as part of a data transfer statement.  */
 512
 513 typedef struct fnode
 514 {
 515   format_token format;
 516   int repeat;
 517   struct fnode *next;
 518   char *source;
 519
 520   union
 521   {
 522     struct
 523     {
 524       int w, d, e;
 525     }
 526     real;
 527
 528     struct
 529     {
 530       int length;
 531       char *p;
 532     }
 533     string;
 534
 535     struct
 536     {
 537       int w, m;
 538     }
 539     integer;
 540
 541     int w;
 542     int k;
 543     int r;
 544     int n;
 545
 546     struct fnode *child;
 547   }
 548   u;
 549
 550   /* Members for traversing the tree during data transfer.  */
 551
 552   int count;
 553   struct fnode *current;
 554
 555 }
 556 fnode;
 557
 558
 559 /* unix.c */
 560
 561 extern int move_pos_offset (stream *, int);
 562 internal_proto(move_pos_offset);
 563
 564 extern int compare_files (stream *, stream *);
 565 internal_proto(compare_files);
 566
 567 extern stream *open_external (st_parameter_open *, unit_flags *);
 568 internal_proto(open_external);
 569
 570 extern stream *open_internal (char *, int);
 571 internal_proto(open_internal);
 572
 573 extern stream *input_stream (void);
 574 internal_proto(input_stream);
 575
 576 extern stream *output_stream (void);
 577 internal_proto(output_stream);
 578
 579 extern stream *error_stream (void);
 580 internal_proto(error_stream);
 581
 582 extern int compare_file_filename (gfc_unit *, const char *, int);
 583 internal_proto(compare_file_filename);
 584
 585 extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len);
 586 internal_proto(find_file);
 587
 588 extern void flush_all_units (void);
 589 internal_proto(flush_all_units);
 590
 591 extern int stream_at_bof (stream *);
 592 internal_proto(stream_at_bof);
 593
 594 extern int stream_at_eof (stream *);
 595 internal_proto(stream_at_eof);
 596
 597 extern int delete_file (gfc_unit *);
 598 internal_proto(delete_file);
 599
 600 extern int file_exists (const char *file, gfc_charlen_type file_len);
 601 internal_proto(file_exists);
 602
 603 extern const char *inquire_sequential (const char *, int);
 604 internal_proto(inquire_sequential);
 605
 606 extern const char *inquire_direct (const char *, int);
 607 internal_proto(inquire_direct);
 608
 609 extern const char *inquire_formatted (const char *, int);
 610 internal_proto(inquire_formatted);
 611
 612 extern const char *inquire_unformatted (const char *, int);
 613 internal_proto(inquire_unformatted);
 614
 615 extern const char *inquire_read (const char *, int);
 616 internal_proto(inquire_read);
 617
 618 extern const char *inquire_write (const char *, int);
 619 internal_proto(inquire_write);
 620
 621 extern const char *inquire_readwrite (const char *, int);
 622 internal_proto(inquire_readwrite);
 623
 624 extern gfc_offset file_length (stream *);
 625 internal_proto(file_length);
 626
 627 extern gfc_offset file_position (stream *);
 628 internal_proto(file_position);
 629
 630 extern int is_seekable (stream *);
 631 internal_proto(is_seekable);
 632
 633 extern int is_preconnected (stream *);
 634 internal_proto(is_preconnected);
 635
 636 extern void flush_if_preconnected (stream *);
 637 internal_proto(flush_if_preconnected);
 638
 639 extern void empty_internal_buffer(stream *);
 640 internal_proto(empty_internal_buffer);
 641
 642 extern try flush (stream *);
 643 internal_proto(flush);
 644
 645 extern int stream_isatty (stream *);
 646 internal_proto(stream_isatty);
 647
 648 extern char * stream_ttyname (stream *);
 649 internal_proto(stream_ttyname);
 650
 651 extern gfc_offset stream_offset (stream *s);
 652 internal_proto(stream_offset);
 653
 654 extern int unit_to_fd (int);
 655 internal_proto(unit_to_fd);
 656
 657 extern int unpack_filename (char *, const char *, int);
 658 internal_proto(unpack_filename);
 659
 660 /* unit.c */
 661
 662 /* Maximum file offset, computed at library initialization time.  */
 663 extern gfc_offset max_offset;
 664 internal_proto(max_offset);
 665
 666 /* Unit tree root.  */
 667 extern gfc_unit *unit_root;
 668 internal_proto(unit_root);
 669
 670 extern __gthread_mutex_t unit_lock;
 671 internal_proto(unit_lock);
 672
 673 extern int close_unit (gfc_unit *);
 674 internal_proto(close_unit);
 675
 676 extern int is_internal_unit (st_parameter_dt *);
 677 internal_proto(is_internal_unit);
 678
 679 extern int is_array_io (st_parameter_dt *);
 680 internal_proto(is_array_io);
 681
 682 extern gfc_unit *find_unit (int);
 683 internal_proto(find_unit);
 684
 685 extern gfc_unit *find_or_create_unit (int);
 686 internal_proto(find_unit);
 687
 688 extern gfc_unit *get_unit (st_parameter_dt *, int);
 689 internal_proto(get_unit);
 690
 691 extern void unlock_unit (gfc_unit *);
 692 internal_proto(unlock_unit);
 693
 694 /* open.c */
 695
 696 extern void test_endfile (gfc_unit *);
 697 internal_proto(test_endfile);
 698
 699 extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
 700 internal_proto(new_unit);
 701
 702 /* format.c */
 703
 704 extern void parse_format (st_parameter_dt *);
 705 internal_proto(parse_format);
 706
 707 extern const fnode *next_format (st_parameter_dt *);
 708 internal_proto(next_format);
 709
 710 extern void unget_format (st_parameter_dt *, const fnode *);
 711 internal_proto(unget_format);
 712
 713 extern void format_error (st_parameter_dt *, const fnode *, const char *);
 714 internal_proto(format_error);
 715
 716 extern void free_format_data (st_parameter_dt *);
 717 internal_proto(free_format_data);
 718
 719 /* transfer.c */
 720
 721 #define SCRATCH_SIZE 300
 722
 723 extern const char *type_name (bt);
 724 internal_proto(type_name);
 725
 726 extern void *read_block (st_parameter_dt *, int *);
 727 internal_proto(read_block);
 728
 729 extern void *write_block (st_parameter_dt *, int);
 730 internal_proto(write_block);
 731
 732 extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *);
 733 internal_proto(next_array_record);
 734
 735 extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *);
 736 internal_proto(init_loop_spec);
 737
 738 extern void next_record (st_parameter_dt *, int);
 739 internal_proto(next_record);
 740
 741 /* read.c */
 742
 743 extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
 744 internal_proto(set_integer);
 745
 746 extern GFC_UINTEGER_LARGEST max_value (int, int);
 747 internal_proto(max_value);
 748
 749 extern int convert_real (st_parameter_dt *, void *, const char *, int);
 750 internal_proto(convert_real);
 751
 752 extern void read_a (st_parameter_dt *, const fnode *, char *, int);
 753 internal_proto(read_a);
 754
 755 extern void read_f (st_parameter_dt *, const fnode *, char *, int);
 756 internal_proto(read_f);
 757
 758 extern void read_l (st_parameter_dt *, const fnode *, char *, int);
 759 internal_proto(read_l);
 760
 761 extern void read_x (st_parameter_dt *, int);
 762 internal_proto(read_x);
 763
 764 extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);
 765 internal_proto(read_radix);
 766
 767 extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
 768 internal_proto(read_decimal);
 769
 770 /* list_read.c */
 771
 772 extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t,
 773                                  size_t);
 774 internal_proto(list_formatted_read);
 775
 776 extern void finish_list_read (st_parameter_dt *);
 777 internal_proto(finish_list_read);
 778
 779 extern void namelist_read (st_parameter_dt *);
 780 internal_proto(namelist_read);
 781
 782 extern void namelist_write (st_parameter_dt *);
 783 internal_proto(namelist_write);
 784
 785 /* write.c */
 786
 787 extern void write_a (st_parameter_dt *, const fnode *, const char *, int);
 788 internal_proto(write_a);
 789
 790 extern void write_b (st_parameter_dt *, const fnode *, const char *, int);
 791 internal_proto(write_b);
 792
 793 extern void write_d (st_parameter_dt *, const fnode *, const char *, int);
 794 internal_proto(write_d);
 795
 796 extern void write_e (st_parameter_dt *, const fnode *, const char *, int);
 797 internal_proto(write_e);
 798
 799 extern void write_en (st_parameter_dt *, const fnode *, const char *, int);
 800 internal_proto(write_en);
 801
 802 extern void write_es (st_parameter_dt *, const fnode *, const char *, int);
 803 internal_proto(write_es);
 804
 805 extern void write_f (st_parameter_dt *, const fnode *, const char *, int);
 806 internal_proto(write_f);
 807
 808 extern void write_i (st_parameter_dt *, const fnode *, const char *, int);
 809 internal_proto(write_i);
 810
 811 extern void write_l (st_parameter_dt *, const fnode *, char *, int);
 812 internal_proto(write_l);
 813
 814 extern void write_o (st_parameter_dt *, const fnode *, const char *, int);
 815 internal_proto(write_o);
 816
 817 extern void write_x (st_parameter_dt *, int, int);
 818 internal_proto(write_x);
 819
 820 extern void write_z (st_parameter_dt *, const fnode *, const char *, int);
 821 internal_proto(write_z);
 822
 823 extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t,
 824                                   size_t);
 825 internal_proto(list_formatted_write);
 826
 827 /* error.c */
 828 extern try notify_std (int, const char *);
 829 internal_proto(notify_std);
 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