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