libgfortran/io/io.h

   1 /* Copyright (C) 2002-2015 Free Software Foundation, Inc.
   2    Contributed by Andy Vaught
   3    F2003 I/O support contributed by Jerry DeLisle
   4
   5 This file is part of the GNU Fortran runtime library (libgfortran).
   6
   7 Libgfortran is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 3, or (at your option)
  10 any later version.
  11
  12 Libgfortran is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 Under Section 7 of GPL version 3, you are granted additional
  18 permissions described in the GCC Runtime Library Exception, version
  19 3.1, as published by the Free Software Foundation.
  20
  21 You should have received a copy of the GNU General Public License and
  22 a copy of the GCC Runtime Library Exception along with this program;
  23 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  24 <http://www.gnu.org/licenses/>.  */
  25
  26 #ifndef GFOR_IO_H
  27 #define GFOR_IO_H
  28
  29 /* IO library include.  */
  30
  31 #include "libgfortran.h"
  32
  33 #include <gthr.h>
  34
  35
  36 /* POSIX 2008 specifies that the extended locale stuff is found in
  37    locale.h, but some systems have them in xlocale.h.  */
  38
  39 #include <locale.h>
  40
  41 #ifdef HAVE_XLOCALE_H
  42 #include <xlocale.h>
  43 #endif
  44
  45
  46 /* Forward declarations.  */
  47 struct st_parameter_dt;
  48 typedef struct stream stream;
  49 struct fbuf;
  50 struct format_data;
  51 typedef struct fnode fnode;
  52 struct gfc_unit;
  53
  54 #ifdef HAVE_NEWLOCALE
  55 /* We have POSIX 2008 extended locale stuff.  */
  56 extern locale_t c_locale;
  57 internal_proto(c_locale);
  58 #else
  59 extern char* old_locale;
  60 internal_proto(old_locale);
  61 extern int old_locale_ctr;
  62 internal_proto(old_locale_ctr);
  63 extern __gthread_mutex_t old_locale_lock;
  64 internal_proto(old_locale_lock);
  65 #endif
  66
  67
  68 /* Macros for testing what kinds of I/O we are doing.  */
  69
  70 #define is_array_io(dtp) ((dtp)->internal_unit_desc)
  71
  72 #define is_internal_unit(dtp) ((dtp)->u.p.unit_is_internal)
  73
  74 #define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM)
  75
  76 #define is_char4_unit(dtp) ((dtp)->u.p.unit_is_internal && (dtp)->common.unit)
  77
  78 /* The array_loop_spec contains the variables for the loops over index ranges
  79    that are encountered.  */
  80
  81 typedef struct array_loop_spec
  82 {
  83   /* Index counter for this dimension.  */
  84   index_type idx;
  85
  86   /* Start for the index counter.  */
  87   index_type start;
  88
  89   /* End for the index counter.  */
  90   index_type end;
  91
  92   /* Step for the index counter.  */
  93   index_type step;
  94 }
  95 array_loop_spec;
  96
  97 /* A structure to build a hash table for format data.  */
  98
  99 #define FORMAT_HASH_SIZE 16
 100
 101 typedef struct format_hash_entry
 102 {
 103   char *key;
 104   gfc_charlen_type key_len;
 105   struct format_data *hashed_fmt;
 106 }
 107 format_hash_entry;
 108
 109 /* Representation of a namelist object in libgfortran
 110
 111    Namelist Records
 112       &GROUPNAME  OBJECT=value[s] [,OBJECT=value[s]].../
 113      or
 114       &GROUPNAME  OBJECT=value[s] [,OBJECT=value[s]]...&END
 115
 116    The object can be a fully qualified, compound name for an intrinsic
 117    type, derived types or derived type components.  So, a substring
 118    a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist
 119    read. Hence full information about the structure of the object has
 120    to be available to list_read.c and write.
 121
 122    These requirements are met by the following data structures.
 123
 124    namelist_info type contains all the scalar information about the
 125    object and arrays of descriptor_dimension and array_loop_spec types for
 126    arrays.  */
 127
 128 typedef struct namelist_type
 129 {
 130   /* Object type.  */
 131   bt type;
 132
 133   /* Object name.  */
 134   char * var_name;
 135
 136   /* Address for the start of the object's data.  */
 137   void * mem_pos;
 138
 139   /* Flag to show that a read is to be attempted for this node.  */
 140   int touched;
 141
 142   /* Length of intrinsic type in bytes.  */
 143   int len;
 144
 145   /* Rank of the object.  */
 146   int var_rank;
 147
 148   /* Overall size of the object in bytes.  */
 149   index_type size;
 150
 151   /* Length of character string.  */
 152   index_type string_length;
 153
 154   descriptor_dimension * dim;
 155   array_loop_spec * ls;
 156   struct namelist_type * next;
 157 }
 158 namelist_info;
 159
 160 /* Options for the OPEN statement.  */
 161
 162 typedef enum
 163 { ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_STREAM,
 164   ACCESS_UNSPECIFIED
 165 }
 166 unit_access;
 167
 168 typedef enum
 169 { ACTION_READ, ACTION_WRITE, ACTION_READWRITE,
 170   ACTION_UNSPECIFIED
 171 }
 172 unit_action;
 173
 174 typedef enum
 175 { BLANK_NULL, BLANK_ZERO, BLANK_UNSPECIFIED }
 176 unit_blank;
 177
 178 typedef enum
 179 { DELIM_NONE, DELIM_APOSTROPHE, DELIM_QUOTE,
 180   DELIM_UNSPECIFIED
 181 }
 182 unit_delim;
 183
 184 typedef enum
 185 { FORM_FORMATTED, FORM_UNFORMATTED, FORM_UNSPECIFIED }
 186 unit_form;
 187
 188 typedef enum
 189 { POSITION_ASIS, POSITION_REWIND, POSITION_APPEND,
 190   POSITION_UNSPECIFIED
 191 }
 192 unit_position;
 193
 194 typedef enum
 195 { STATUS_UNKNOWN, STATUS_OLD, STATUS_NEW, STATUS_SCRATCH,
 196   STATUS_REPLACE, STATUS_UNSPECIFIED
 197 }
 198 unit_status;
 199
 200 typedef enum
 201 { PAD_YES, PAD_NO, PAD_UNSPECIFIED }
 202 unit_pad;
 203
 204 typedef enum
 205 { DECIMAL_POINT, DECIMAL_COMMA, DECIMAL_UNSPECIFIED }
 206 unit_decimal;
 207
 208 typedef enum
 209 { ENCODING_UTF8, ENCODING_DEFAULT, ENCODING_UNSPECIFIED }
 210 unit_encoding;
 211
 212 typedef enum
 213 { ROUND_UP = GFC_FPE_UPWARD,
 214   ROUND_DOWN = GFC_FPE_DOWNWARD,
 215   ROUND_ZERO = GFC_FPE_TOWARDZERO,
 216   ROUND_NEAREST = GFC_FPE_TONEAREST,
 217   ROUND_COMPATIBLE = 10, /* round away from zero.  */
 218   ROUND_PROCDEFINED, /* Here as ROUND_NEAREST. */
 219   ROUND_UNSPECIFIED /* Should never occur. */
 220 }
 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, LIST_READING, LIST_WRITING}
 235 unit_mode;
 236
 237 typedef enum
 238 { ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED }
 239 unit_async;
 240
 241 typedef enum
 242 { SIGN_S, SIGN_SS, SIGN_SP }
 243 unit_sign_s;
 244
 245 #define CHARACTER1(name) \
 246               char * name; \
 247               gfc_charlen_type name ## _len
 248 #define CHARACTER2(name) \
 249               gfc_charlen_type name ## _len; \
 250               char * name
 251
 252 typedef struct
 253 {
 254   st_parameter_common common;
 255   GFC_INTEGER_4 recl_in;
 256   CHARACTER2 (file);
 257   CHARACTER1 (status);
 258   CHARACTER2 (access);
 259   CHARACTER1 (form);
 260   CHARACTER2 (blank);
 261   CHARACTER1 (position);
 262   CHARACTER2 (action);
 263   CHARACTER1 (delim);
 264   CHARACTER2 (pad);
 265   CHARACTER1 (convert);
 266   CHARACTER2 (decimal);
 267   CHARACTER1 (encoding);
 268   CHARACTER2 (round);
 269   CHARACTER1 (sign);
 270   CHARACTER2 (asynchronous);
 271   GFC_INTEGER_4 *newunit;
 272 }
 273 st_parameter_open;
 274
 275 #define IOPARM_CLOSE_HAS_STATUS         (1 << 7)
 276
 277 typedef struct
 278 {
 279   st_parameter_common common;
 280   CHARACTER1 (status);
 281 }
 282 st_parameter_close;
 283
 284 typedef struct
 285 {
 286   st_parameter_common common;
 287 }
 288 st_parameter_filepos;
 289
 290 #define IOPARM_INQUIRE_HAS_EXIST        (1 << 7)
 291 #define IOPARM_INQUIRE_HAS_OPENED       (1 << 8)
 292 #define IOPARM_INQUIRE_HAS_NUMBER       (1 << 9)
 293 #define IOPARM_INQUIRE_HAS_NAMED        (1 << 10)
 294 #define IOPARM_INQUIRE_HAS_NEXTREC      (1 << 11)
 295 #define IOPARM_INQUIRE_HAS_RECL_OUT     (1 << 12)
 296 #define IOPARM_INQUIRE_HAS_STRM_POS_OUT (1 << 13)
 297 #define IOPARM_INQUIRE_HAS_FILE         (1 << 14)
 298 #define IOPARM_INQUIRE_HAS_ACCESS       (1 << 15)
 299 #define IOPARM_INQUIRE_HAS_FORM         (1 << 16)
 300 #define IOPARM_INQUIRE_HAS_BLANK        (1 << 17)
 301 #define IOPARM_INQUIRE_HAS_POSITION     (1 << 18)
 302 #define IOPARM_INQUIRE_HAS_ACTION       (1 << 19)
 303 #define IOPARM_INQUIRE_HAS_DELIM        (1 << 20)
 304 #define IOPARM_INQUIRE_HAS_PAD          (1 << 21)
 305 #define IOPARM_INQUIRE_HAS_NAME         (1 << 22)
 306 #define IOPARM_INQUIRE_HAS_SEQUENTIAL   (1 << 23)
 307 #define IOPARM_INQUIRE_HAS_DIRECT       (1 << 24)
 308 #define IOPARM_INQUIRE_HAS_FORMATTED    (1 << 25)
 309 #define IOPARM_INQUIRE_HAS_UNFORMATTED  (1 << 26)
 310 #define IOPARM_INQUIRE_HAS_READ         (1 << 27)
 311 #define IOPARM_INQUIRE_HAS_WRITE        (1 << 28)
 312 #define IOPARM_INQUIRE_HAS_READWRITE    (1 << 29)
 313 #define IOPARM_INQUIRE_HAS_CONVERT      (1 << 30)
 314 #define IOPARM_INQUIRE_HAS_FLAGS2       (1u << 31)
 315
 316 #define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0)
 317 #define IOPARM_INQUIRE_HAS_DECIMAL      (1 << 1)
 318 #define IOPARM_INQUIRE_HAS_ENCODING     (1 << 2)
 319 #define IOPARM_INQUIRE_HAS_ROUND        (1 << 3)
 320 #define IOPARM_INQUIRE_HAS_SIGN         (1 << 4)
 321 #define IOPARM_INQUIRE_HAS_PENDING      (1 << 5)
 322 #define IOPARM_INQUIRE_HAS_SIZE         (1 << 6)
 323 #define IOPARM_INQUIRE_HAS_ID           (1 << 7)
 324 #define IOPARM_INQUIRE_HAS_IQSTREAM     (1 << 8)
 325
 326 typedef struct
 327 {
 328   st_parameter_common common;
 329   GFC_INTEGER_4 *exist, *opened, *number, *named;
 330   GFC_INTEGER_4 *nextrec, *recl_out;
 331   GFC_IO_INT *strm_pos_out;
 332   CHARACTER1 (file);
 333   CHARACTER2 (access);
 334   CHARACTER1 (form);
 335   CHARACTER2 (blank);
 336   CHARACTER1 (position);
 337   CHARACTER2 (action);
 338   CHARACTER1 (delim);
 339   CHARACTER2 (pad);
 340   CHARACTER1 (name);
 341   CHARACTER2 (sequential);
 342   CHARACTER1 (direct);
 343   CHARACTER2 (formatted);
 344   CHARACTER1 (unformatted);
 345   CHARACTER2 (read);
 346   CHARACTER1 (write);
 347   CHARACTER2 (readwrite);
 348   CHARACTER1 (convert);
 349   GFC_INTEGER_4 flags2;
 350   CHARACTER1 (asynchronous);
 351   CHARACTER2 (decimal);
 352   CHARACTER1 (encoding);
 353   CHARACTER2 (round);
 354   CHARACTER1 (sign);
 355   GFC_INTEGER_4 *pending;
 356   GFC_IO_INT *size;
 357   GFC_INTEGER_4 *id;
 358   CHARACTER1 (iqstream);
 359 }
 360 st_parameter_inquire;
 361
 362
 363 #define IOPARM_DT_LIST_FORMAT                   (1 << 7)
 364 #define IOPARM_DT_NAMELIST_READ_MODE            (1 << 8)
 365 #define IOPARM_DT_HAS_REC                       (1 << 9)
 366 #define IOPARM_DT_HAS_SIZE                      (1 << 10)
 367 #define IOPARM_DT_HAS_IOLENGTH                  (1 << 11)
 368 #define IOPARM_DT_HAS_FORMAT                    (1 << 12)
 369 #define IOPARM_DT_HAS_ADVANCE                   (1 << 13)
 370 #define IOPARM_DT_HAS_INTERNAL_UNIT             (1 << 14)
 371 #define IOPARM_DT_HAS_NAMELIST_NAME             (1 << 15)
 372 #define IOPARM_DT_HAS_ID                        (1 << 16)
 373 #define IOPARM_DT_HAS_POS                       (1 << 17)
 374 #define IOPARM_DT_HAS_ASYNCHRONOUS              (1 << 18)
 375 #define IOPARM_DT_HAS_BLANK                     (1 << 19)
 376 #define IOPARM_DT_HAS_DECIMAL                   (1 << 20)
 377 #define IOPARM_DT_HAS_DELIM                     (1 << 21)
 378 #define IOPARM_DT_HAS_PAD                       (1 << 22)
 379 #define IOPARM_DT_HAS_ROUND                     (1 << 23)
 380 #define IOPARM_DT_HAS_SIGN                      (1 << 24)
 381 #define IOPARM_DT_HAS_F2003                     (1 << 25)
 382 /* Internal use bit.  */
 383 #define IOPARM_DT_IONML_SET                     (1u << 31)
 384
 385
 386 typedef struct st_parameter_dt
 387 {
 388   st_parameter_common common;
 389   GFC_IO_INT rec;
 390   GFC_IO_INT *size, *iolength;
 391   gfc_array_char *internal_unit_desc;
 392   CHARACTER1 (format);
 393   CHARACTER2 (advance);
 394   CHARACTER1 (internal_unit);
 395   CHARACTER2 (namelist_name);
 396   /* Private part of the structure.  The compiler just needs
 397      to reserve enough space.  */
 398   union
 399     {
 400       struct
 401         {
 402           void (*transfer) (struct st_parameter_dt *, bt, void *, int,
 403                             size_t, size_t);
 404           struct gfc_unit *current_unit;
 405           /* Item number in a formatted data transfer.  Also used in namelist
 406              read_logical as an index into line_buffer.  */
 407           int item_count;
 408           unit_mode mode;
 409           unit_blank blank_status;
 410           unit_sign sign_status;
 411           int scale_factor;
 412           int max_pos; /* Maximum righthand column written to.  */
 413           /* Number of skips + spaces to be done for T and X-editing.  */
 414           int skips;
 415           /* Number of spaces to be done for T and X-editing.  */
 416           int pending_spaces;
 417           /* Whether an EOR condition was encountered. Value is:
 418                0 if no EOR was encountered
 419                1 if an EOR was encountered due to a 1-byte marker (LF)
 420                2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
 421           int sf_seen_eor;
 422           unit_advance advance_status;
 423           unsigned reversion_flag : 1; /* Format reversion has occurred.  */
 424           unsigned first_item : 1;
 425           unsigned seen_dollar : 1;
 426           unsigned eor_condition : 1;
 427           unsigned no_leading_blank : 1;
 428           unsigned char_flag : 1;
 429           unsigned input_complete : 1;
 430           unsigned at_eol : 1;
 431           unsigned comma_flag : 1;
 432           /* A namelist specific flag used in the list directed library
 433              to flag that calls are being made from namelist read (e.g. to
 434              ignore comments or to treat '/' as a terminator)  */
 435           unsigned namelist_mode : 1;
 436           /* A namelist specific flag used in the list directed library
 437              to flag read errors and return, so that an attempt can be
 438              made to read a new object name.  */
 439           unsigned nml_read_error : 1;
 440           /* A sequential formatted read specific flag used to signal that a
 441              character string is being read so don't use commas to shorten a
 442              formatted field width.  */
 443           unsigned sf_read_comma : 1;
 444           /* A namelist specific flag used to enable reading input from
 445              line_buffer for logical reads.  */
 446           unsigned line_buffer_enabled : 1;
 447           /* An internal unit specific flag used to identify that the associated
 448              unit is internal.  */
 449           unsigned unit_is_internal : 1;
 450           /* An internal unit specific flag to signify an EOF condition for list
 451              directed read.  */
 452           unsigned at_eof : 1;
 453           /* Used for g0 floating point output.  */
 454           unsigned g0_no_blanks : 1;
 455           /* Used to signal use of free_format_data.  */
 456           unsigned format_not_saved : 1;
 457           /* A flag used to identify when a non-standard expanded namelist read
 458              has occurred.  */
 459           unsigned expanded_read : 1;
 460           /* 13 unused bits.  */
 461
 462           /* Used for ungetc() style functionality. Possible values
 463              are an unsigned char, EOF, or EOF - 1 used to mark the
 464              field as not valid.  */
 465           int last_char;
 466           char nml_delim;
 467
 468           int repeat_count;
 469           int saved_length;
 470           int saved_used;
 471           bt saved_type;
 472           char *saved_string;
 473           char *scratch;
 474           char *line_buffer;
 475           struct format_data *fmt;
 476           namelist_info *ionml;
 477 #ifdef HAVE_NEWLOCALE
 478           locale_t old_locale;
 479 #endif
 480           /* Current position within the look-ahead line buffer.  */
 481           int line_buffer_pos;
 482           /* Storage area for values except for strings.  Must be
 483              large enough to hold a complex value (two reals) of the
 484              largest kind.  */
 485           char value[32];
 486           GFC_IO_INT size_used;
 487         } p;
 488       /* This pad size must be equal to the pad_size declared in
 489          trans-io.c (gfc_build_io_library_fndecls).  The above structure
 490          must be smaller or equal to this array.  */
 491       char pad[16 * sizeof (char *) + 32 * sizeof (int)];
 492     } u;
 493   GFC_INTEGER_4 *id;
 494   GFC_IO_INT pos;
 495   CHARACTER1 (asynchronous);
 496   CHARACTER2 (blank);
 497   CHARACTER1 (decimal);
 498   CHARACTER2 (delim);
 499   CHARACTER1 (pad);
 500   CHARACTER2 (round);
 501   CHARACTER1 (sign);
 502 }
 503 st_parameter_dt;
 504
 505 /* Ensure st_parameter_dt's u.pad is bigger or equal to u.p.  */
 506 extern char check_st_parameter_dt[sizeof (((st_parameter_dt *) 0)->u.pad)
 507                                   >= sizeof (((st_parameter_dt *) 0)->u.p)
 508                                   ? 1 : -1];
 509
 510 #define IOPARM_WAIT_HAS_ID              (1 << 7)
 511
 512 typedef struct
 513 {
 514   st_parameter_common common;
 515   CHARACTER1 (id);
 516 }
 517 st_parameter_wait;
 518
 519
 520 #undef CHARACTER1
 521 #undef CHARACTER2
 522
 523 typedef struct
 524 {
 525   unit_access access;
 526   unit_action action;
 527   unit_blank blank;
 528   unit_delim delim;
 529   unit_form form;
 530   int is_notpadded;
 531   unit_position position;
 532   unit_status status;
 533   unit_pad pad;
 534   unit_convert convert;
 535   int has_recl;
 536   unit_decimal decimal;
 537   unit_encoding encoding;
 538   unit_round round;
 539   unit_sign sign;
 540   unit_async async;
 541 }
 542 unit_flags;
 543
 544
 545 typedef struct gfc_unit
 546 {
 547   int unit_number;
 548   stream *s;
 549
 550   /* Treap links.  */
 551   struct gfc_unit *left, *right;
 552   int priority;
 553
 554   int read_bad, current_record, saved_pos, previous_nonadvancing_write;
 555
 556   enum
 557   { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
 558   endfile;
 559
 560   unit_mode mode;
 561   unit_flags flags;
 562   unit_pad pad_status;
 563   unit_decimal decimal_status;
 564   unit_delim delim_status;
 565   unit_round round_status;
 566
 567   /* recl                 -- Record length of the file.
 568      last_record          -- Last record number read or written
 569      maxrec               -- Maximum record number in a direct access file
 570      bytes_left           -- Bytes left in current record.
 571      strm_pos             -- Current position in file for STREAM I/O.
 572      recl_subrecord       -- Maximum length for subrecord.
 573      bytes_left_subrecord -- Bytes left in current subrecord.  */
 574   gfc_offset recl, last_record, maxrec, bytes_left, strm_pos,
 575     recl_subrecord, bytes_left_subrecord;
 576
 577   /* Set to 1 if we have read a subrecord.  */
 578
 579   int continued;
 580
 581   __gthread_mutex_t lock;
 582   /* Number of threads waiting to acquire this unit's lock.
 583      When non-zero, close_unit doesn't only removes the unit
 584      from the UNIT_ROOT tree, but doesn't free it and the
 585      last of the waiting threads will do that.
 586      This must be either atomically increased/decreased, or
 587      always guarded by UNIT_LOCK.  */
 588   int waiting;
 589   /* Flag set by close_unit if the unit as been closed.
 590      Must be manipulated under unit's lock.  */
 591   int closed;
 592
 593   /* For traversing arrays */
 594   array_loop_spec *ls;
 595   int rank;
 596
 597   /* Name of the file at the time OPEN was executed, as a
 598      null-terminated C string.  */
 599   char *filename;
 600
 601   /* The format hash table.  */
 602   struct format_hash_entry format_hash_table[FORMAT_HASH_SIZE];
 603
 604   /* Formatting buffer.  */
 605   struct fbuf *fbuf;
 606
 607   /* Function pointer, points to list_read worker functions.  */
 608   int (*next_char_fn_ptr) (st_parameter_dt *);
 609   void (*push_char_fn_ptr) (st_parameter_dt *, int);
 610 }
 611 gfc_unit;
 612
 613
 614 /* unit.c */
 615
 616 /* Maximum file offset, computed at library initialization time.  */
 617 extern gfc_offset max_offset;
 618 internal_proto(max_offset);
 619
 620 /* Unit tree root.  */
 621 extern gfc_unit *unit_root;
 622 internal_proto(unit_root);
 623
 624 extern __gthread_mutex_t unit_lock;
 625 internal_proto(unit_lock);
 626
 627 extern int close_unit (gfc_unit *);
 628 internal_proto(close_unit);
 629
 630 extern gfc_unit *get_internal_unit (st_parameter_dt *);
 631 internal_proto(get_internal_unit);
 632
 633 extern void free_internal_unit (st_parameter_dt *);
 634 internal_proto(free_internal_unit);
 635
 636 extern gfc_unit *find_unit (int);
 637 internal_proto(find_unit);
 638
 639 extern gfc_unit *find_or_create_unit (int);
 640 internal_proto(find_or_create_unit);
 641
 642 extern gfc_unit *get_unit (st_parameter_dt *, int);
 643 internal_proto(get_unit);
 644
 645 extern void unlock_unit (gfc_unit *);
 646 internal_proto(unlock_unit);
 647
 648 extern void finish_last_advance_record (gfc_unit *u);
 649 internal_proto (finish_last_advance_record);
 650
 651 extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
 652 internal_proto (unit_truncate);
 653
 654 extern GFC_INTEGER_4 get_unique_unit_number (st_parameter_open *);
 655 internal_proto(get_unique_unit_number);
 656
 657 /* open.c */
 658
 659 extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
 660 internal_proto(new_unit);
 661
 662
 663 /* transfer.c */
 664
 665 #define SCRATCH_SIZE 300
 666
 667 extern const char *type_name (bt);
 668 internal_proto(type_name);
 669
 670 extern void * read_block_form (st_parameter_dt *, int *);
 671 internal_proto(read_block_form);
 672
 673 extern void * read_block_form4 (st_parameter_dt *, int *);
 674 internal_proto(read_block_form4);
 675
 676 extern void *write_block (st_parameter_dt *, int);
 677 internal_proto(write_block);
 678
 679 extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *,
 680                                      int*);
 681 internal_proto(next_array_record);
 682
 683 extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *,
 684                                   gfc_offset *);
 685 internal_proto(init_loop_spec);
 686
 687 extern void next_record (st_parameter_dt *, int);
 688 internal_proto(next_record);
 689
 690 extern void st_wait (st_parameter_wait *);
 691 export_proto(st_wait);
 692
 693 extern void hit_eof (st_parameter_dt *);
 694 internal_proto(hit_eof);
 695
 696 /* read.c */
 697
 698 extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
 699 internal_proto(set_integer);
 700
 701 extern GFC_UINTEGER_LARGEST si_max (int);
 702 internal_proto(si_max);
 703
 704 extern int convert_real (st_parameter_dt *, void *, const char *, int);
 705 internal_proto(convert_real);
 706
 707 extern int convert_infnan (st_parameter_dt *, void *, const char *, int);
 708 internal_proto(convert_infnan);
 709
 710 extern void read_a (st_parameter_dt *, const fnode *, char *, int);
 711 internal_proto(read_a);
 712
 713 extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, int);
 714 internal_proto(read_a);
 715
 716 extern void read_f (st_parameter_dt *, const fnode *, char *, int);
 717 internal_proto(read_f);
 718
 719 extern void read_l (st_parameter_dt *, const fnode *, char *, int);
 720 internal_proto(read_l);
 721
 722 extern void read_x (st_parameter_dt *, int);
 723 internal_proto(read_x);
 724
 725 extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);
 726 internal_proto(read_radix);
 727
 728 extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
 729 internal_proto(read_decimal);
 730
 731 /* list_read.c */
 732
 733 extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t,
 734                                  size_t);
 735 internal_proto(list_formatted_read);
 736
 737 extern void finish_list_read (st_parameter_dt *);
 738 internal_proto(finish_list_read);
 739
 740 extern void namelist_read (st_parameter_dt *);
 741 internal_proto(namelist_read);
 742
 743 extern void namelist_write (st_parameter_dt *);
 744 internal_proto(namelist_write);
 745
 746 /* write.c */
 747
 748 extern void write_a (st_parameter_dt *, const fnode *, const char *, int);
 749 internal_proto(write_a);
 750
 751 extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, int);
 752 internal_proto(write_a_char4);
 753
 754 extern void write_b (st_parameter_dt *, const fnode *, const char *, int);
 755 internal_proto(write_b);
 756
 757 extern void write_d (st_parameter_dt *, const fnode *, const char *, int);
 758 internal_proto(write_d);
 759
 760 extern void write_e (st_parameter_dt *, const fnode *, const char *, int);
 761 internal_proto(write_e);
 762
 763 extern void write_en (st_parameter_dt *, const fnode *, const char *, int);
 764 internal_proto(write_en);
 765
 766 extern void write_es (st_parameter_dt *, const fnode *, const char *, int);
 767 internal_proto(write_es);
 768
 769 extern void write_f (st_parameter_dt *, const fnode *, const char *, int);
 770 internal_proto(write_f);
 771
 772 extern void write_i (st_parameter_dt *, const fnode *, const char *, int);
 773 internal_proto(write_i);
 774
 775 extern void write_l (st_parameter_dt *, const fnode *, char *, int);
 776 internal_proto(write_l);
 777
 778 extern void write_o (st_parameter_dt *, const fnode *, const char *, int);
 779 internal_proto(write_o);
 780
 781 extern void write_real (st_parameter_dt *, const char *, int);
 782 internal_proto(write_real);
 783
 784 extern void write_real_g0 (st_parameter_dt *, const char *, int, int);
 785 internal_proto(write_real_g0);
 786
 787 extern void write_x (st_parameter_dt *, int, int);
 788 internal_proto(write_x);
 789
 790 extern void write_z (st_parameter_dt *, const fnode *, const char *, int);
 791 internal_proto(write_z);
 792
 793 extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t,
 794                                   size_t);
 795 internal_proto(list_formatted_write);
 796
 797 /* size_from_kind.c */
 798 extern size_t size_from_real_kind (int);
 799 internal_proto(size_from_real_kind);
 800
 801 extern size_t size_from_complex_kind (int);
 802 internal_proto(size_from_complex_kind);
 803
 804
 805 /* lock.c */
 806 extern void free_ionml (st_parameter_dt *);
 807 internal_proto(free_ionml);
 808
 809 static inline void
 810 inc_waiting_locked (gfc_unit *u)
 811 {
 812 #ifdef HAVE_SYNC_FETCH_AND_ADD
 813   (void) __sync_fetch_and_add (&u->waiting, 1);
 814 #else
 815   u->waiting++;
 816 #endif
 817 }
 818
 819 static inline int
 820 predec_waiting_locked (gfc_unit *u)
 821 {
 822 #ifdef HAVE_SYNC_FETCH_AND_ADD
 823   return __sync_add_and_fetch (&u->waiting, -1);
 824 #else
 825   return --u->waiting;
 826 #endif
 827 }
 828
 829 static inline void
 830 dec_waiting_unlocked (gfc_unit *u)
 831 {
 832 #ifdef HAVE_SYNC_FETCH_AND_ADD
 833   (void) __sync_fetch_and_add (&u->waiting, -1);
 834 #else
 835   __gthread_mutex_lock (&unit_lock);
 836   u->waiting--;
 837   __gthread_mutex_unlock (&unit_lock);
 838 #endif
 839 }
 840
 841
 842 static inline void
 843 memset4 (gfc_char4_t *p, gfc_char4_t c, int k)
 844 {
 845   int j;
 846   for (j = 0; j < k; j++)
 847     *p++ = c;
 848 }
 849
 850 #endif
 851