libgfortran/io/io.h

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