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 #define DEFAULT_TEMPDIR "/tmp"
  37
  38 /* Basic types used in data transfers.  */
  39
  40 typedef enum
  41 { BT_NULL, BT_INTEGER, BT_LOGICAL, BT_CHARACTER, BT_REAL,
  42   BT_COMPLEX
  43 }
  44 bt;
  45
  46
  47 typedef enum
  48 { SUCCESS = 1, FAILURE }
  49 try;
  50
  51 typedef struct stream
  52 {
  53   char *(*alloc_w_at) (struct stream *, int *, gfc_offset);
  54   char *(*alloc_r_at) (struct stream *, int *, gfc_offset);
  55   try (*sfree) (struct stream *);
  56   try (*close) (struct stream *);
  57   try (*seek) (struct stream *, gfc_offset);
  58   try (*truncate) (struct stream *);
  59   int (*read) (struct stream *, void *, size_t *);
  60   int (*write) (struct stream *, const void *, size_t *);
  61 }
  62 stream;
  63
  64
  65 /* Macros for doing file I/O given a stream.  */
  66
  67 #define sfree(s) ((s)->sfree)(s)
  68 #define sclose(s) ((s)->close)(s)
  69
  70 #define salloc_r(s, len) ((s)->alloc_r_at)(s, len, -1)
  71 #define salloc_w(s, len) ((s)->alloc_w_at)(s, len, -1)
  72
  73 #define salloc_r_at(s, len, where) ((s)->alloc_r_at)(s, len, where)
  74 #define salloc_w_at(s, len, where) ((s)->alloc_w_at)(s, len, where)
  75
  76 #define sseek(s, pos) ((s)->seek)(s, pos)
  77 #define struncate(s) ((s)->truncate)(s)
  78 #define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes)
  79 #define swrite(s, buf, nbytes) ((s)->write)(s, buf, nbytes)
  80
  81 /* The array_loop_spec contains the variables for the loops over index ranges
  82    that are encountered.  Since the variables can be negative, ssize_t
  83    is used.  */
  84
  85 typedef struct array_loop_spec
  86 {
  87   /* Index counter for this dimension.  */
  88   ssize_t idx;
  89
  90   /* Start for the index counter.  */
  91   ssize_t start;
  92
  93   /* End for the index counter.  */
  94   ssize_t end;
  95
  96   /* Step for the index counter.  */
  97   ssize_t step;
  98 }
  99 array_loop_spec;
 100
 101 /* Representation of a namelist object in libgfortran
 102
 103    Namelist Records
 104       &GROUPNAME  OBJECT=value[s] [,OBJECT=value[s]].../
 105      or
 106       &GROUPNAME  OBJECT=value[s] [,OBJECT=value[s]]...&END
 107
 108    The object can be a fully qualified, compound name for an instrinsic
 109    type, derived types or derived type components.  So, a substring
 110    a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist
 111    read. Hence full information about the structure of the object has
 112    to be available to list_read.c and write.
 113
 114    These requirements are met by the following data structures.
 115
 116    namelist_info type contains all the scalar information about the
 117    object and arrays of descriptor_dimension and array_loop_spec types for
 118    arrays.  */
 119
 120 typedef struct namelist_type
 121 {
 122
 123   /* Object type, stored as GFC_DTYPE_xxxx.  */
 124   bt type;
 125
 126   /* Object name.  */
 127   char * var_name;
 128
 129   /* Address for the start of the object's data.  */
 130   void * mem_pos;
 131
 132   /* Flag to show that a read is to be attempted for this node.  */
 133   int touched;
 134
 135   /* Length of intrinsic type in bytes.  */
 136   int len;
 137
 138   /* Rank of the object.  */
 139   int var_rank;
 140
 141   /* Overall size of the object in bytes.  */
 142   index_type size;
 143
 144   /* Length of character string.  */
 145   index_type string_length;
 146
 147   descriptor_dimension * dim;
 148   array_loop_spec * ls;
 149   struct namelist_type * next;
 150 }
 151 namelist_info;
 152
 153 /* Options for the OPEN statement.  */
 154
 155 typedef enum
 156 { ACCESS_SEQUENTIAL, ACCESS_DIRECT,
 157   ACCESS_UNSPECIFIED
 158 }
 159 unit_access;
 160
 161 typedef enum
 162 { ACTION_READ, ACTION_WRITE, ACTION_READWRITE,
 163   ACTION_UNSPECIFIED
 164 }
 165 unit_action;
 166
 167 typedef enum
 168 { BLANK_NULL, BLANK_ZERO, BLANK_UNSPECIFIED }
 169 unit_blank;
 170
 171 typedef enum
 172 { DELIM_NONE, DELIM_APOSTROPHE, DELIM_QUOTE,
 173   DELIM_UNSPECIFIED
 174 }
 175 unit_delim;
 176
 177 typedef enum
 178 { FORM_FORMATTED, FORM_UNFORMATTED, FORM_UNSPECIFIED }
 179 unit_form;
 180
 181 typedef enum
 182 { POSITION_ASIS, POSITION_REWIND, POSITION_APPEND,
 183   POSITION_UNSPECIFIED
 184 }
 185 unit_position;
 186
 187 typedef enum
 188 { STATUS_UNKNOWN, STATUS_OLD, STATUS_NEW, STATUS_SCRATCH,
 189   STATUS_REPLACE, STATUS_UNSPECIFIED
 190 }
 191 unit_status;
 192
 193 typedef enum
 194 { PAD_YES, PAD_NO, PAD_UNSPECIFIED }
 195 unit_pad;
 196
 197 typedef enum
 198 { ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED }
 199 unit_advance;
 200
 201 typedef enum
 202 {READING, WRITING}
 203 unit_mode;
 204
 205 /* Statement parameters.  These are all the things that can appear in
 206    an I/O statement.  Some are inputs and some are outputs, but none
 207    are both.  All of these values are initially zeroed and are zeroed
 208    at the end of a library statement.  The relevant values need to be
 209    set before entry to an I/O statement.  This structure needs to be
 210    duplicated by the back end.  */
 211
 212 typedef struct
 213 {
 214   GFC_INTEGER_4 unit;
 215   GFC_INTEGER_4 err, end, eor, list_format; /* These are flags, not values.  */
 216
 217 /* Return values from library statements.  These are returned only if
 218    the labels are specified in the statement itself and the condition
 219    occurs.  In most cases, none of the labels are specified and the
 220    return value does not have to be checked.  Must be consistent with
 221    the front end.  */
 222
 223   enum
 224   {
 225     LIBRARY_OK = 0,
 226     LIBRARY_ERROR,
 227     LIBRARY_END,
 228     LIBRARY_EOR
 229   }
 230   library_return;
 231
 232   GFC_INTEGER_4 *iostat, *exist, *opened, *number, *named;
 233   GFC_INTEGER_4 rec;
 234   GFC_INTEGER_4 *nextrec, *size;
 235
 236   GFC_INTEGER_4 recl_in;
 237   GFC_INTEGER_4 *recl_out;
 238
 239   GFC_INTEGER_4 *iolength;
 240
 241 #define CHARACTER(name) \
 242               char * name; \
 243               gfc_charlen_type name ## _len
 244   CHARACTER (file);
 245   CHARACTER (status);
 246   CHARACTER (access);
 247   CHARACTER (form);
 248   CHARACTER (blank);
 249   CHARACTER (position);
 250   CHARACTER (action);
 251   CHARACTER (delim);
 252   CHARACTER (pad);
 253   CHARACTER (format);
 254   CHARACTER (advance);
 255   CHARACTER (name);
 256   CHARACTER (internal_unit);
 257   gfc_array_char *internal_unit_desc;
 258   CHARACTER (sequential);
 259   CHARACTER (direct);
 260   CHARACTER (formatted);
 261   CHARACTER (unformatted);
 262   CHARACTER (read);
 263   CHARACTER (write);
 264   CHARACTER (readwrite);
 265
 266 /* namelist related data */
 267   CHARACTER (namelist_name);
 268   GFC_INTEGER_4 namelist_read_mode;
 269
 270   /* iomsg */
 271   CHARACTER (iomsg);
 272
 273 #undef CHARACTER
 274 }
 275 st_parameter;
 276
 277 extern st_parameter ioparm;
 278 iexport_data_proto(ioparm);
 279
 280 extern namelist_info * ionml;
 281 internal_proto(ionml);
 282
 283 typedef struct
 284 {
 285   unit_access access;
 286   unit_action action;
 287   unit_blank blank;
 288   unit_delim delim;
 289   unit_form form;
 290   int is_notpadded;
 291   unit_position position;
 292   unit_status status;
 293   unit_pad pad;
 294 }
 295 unit_flags;
 296
 297
 298 /* The default value of record length for preconnected units is defined
 299    here. This value can be overriden by an environment variable.
 300    Default value is 1 Gb.  */
 301
 302 #define DEFAULT_RECL 1073741824
 303
 304
 305 typedef struct gfc_unit
 306 {
 307   int unit_number;
 308   stream *s;
 309
 310   /* Treap links.  */
 311   struct gfc_unit *left, *right;
 312   int priority;
 313
 314   int read_bad, current_record;
 315   enum
 316   { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
 317   endfile;
 318
 319   unit_mode  mode;
 320   unit_flags flags;
 321
 322   /* recl           -- Record length of the file.
 323      last_record    -- Last record number read or written
 324      maxrec         -- Maximum record number in a direct access file
 325      bytes_left     -- Bytes left in current record.  */
 326   gfc_offset recl, last_record, maxrec, bytes_left;
 327
 328   /* For traversing arrays */
 329   array_loop_spec *ls;
 330   int rank;
 331
 332   /* Filename is allocated at the end of the structure.  */
 333   int file_len;
 334   char file[1];
 335 }
 336 gfc_unit;
 337
 338 /* Global variables.  Putting these in a structure makes it easier to
 339    maintain, particularly with the constraint of a prefix.  */
 340
 341 typedef struct
 342 {
 343   int in_library;       /* Nonzero if a library call is being processed.  */
 344   int size;     /* Bytes processed by the current data-transfer statement.  */
 345   gfc_offset max_offset;        /* Maximum file offset.  */
 346   int item_count;       /* Item number in a formatted data transfer.  */
 347   int reversion_flag;   /* Format reversion has occurred.  */
 348   int first_item;
 349
 350   gfc_unit *unit_root;
 351   int seen_dollar;
 352
 353   unit_mode  mode;
 354
 355   unit_blank blank_status;
 356   enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status;
 357   int scale_factor;
 358   jmp_buf eof_jump;
 359 }
 360 global_t;
 361
 362 extern global_t g;
 363 internal_proto(g);
 364
 365 extern gfc_unit *current_unit;
 366 internal_proto(current_unit);
 367
 368 /* Format tokens.  Only about half of these can be stored in the
 369    format nodes.  */
 370
 371 typedef enum
 372 {
 373   FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD,
 374   FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL,
 375   FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING,
 376   FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F,
 377   FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END
 378 }
 379 format_token;
 380
 381
 382 /* Format nodes.  A format string is converted into a tree of these
 383    structures, which is traversed as part of a data transfer statement.  */
 384
 385 typedef struct fnode
 386 {
 387   format_token format;
 388   int repeat;
 389   struct fnode *next;
 390   char *source;
 391
 392   union
 393   {
 394     struct
 395     {
 396       int w, d, e;
 397     }
 398     real;
 399
 400     struct
 401     {
 402       int length;
 403       char *p;
 404     }
 405     string;
 406
 407     struct
 408     {
 409       int w, m;
 410     }
 411     integer;
 412
 413     int w;
 414     int k;
 415     int r;
 416     int n;
 417
 418     struct fnode *child;
 419   }
 420   u;
 421
 422   /* Members for traversing the tree during data transfer.  */
 423
 424   int count;
 425   struct fnode *current;
 426
 427 }
 428 fnode;
 429
 430
 431 /* unix.c */
 432
 433 extern int move_pos_offset (stream *, int);
 434 internal_proto(move_pos_offset);
 435
 436 extern int compare_files (stream *, stream *);
 437 internal_proto(compare_files);
 438
 439 extern stream *init_error_stream (void);
 440 internal_proto(init_error_stream);
 441
 442 extern stream *open_external (unit_flags *);
 443 internal_proto(open_external);
 444
 445 extern stream *open_internal (char *, int);
 446 internal_proto(open_internal);
 447
 448 extern stream *input_stream (void);
 449 internal_proto(input_stream);
 450
 451 extern stream *output_stream (void);
 452 internal_proto(output_stream);
 453
 454 extern stream *error_stream (void);
 455 internal_proto(error_stream);
 456
 457 extern int compare_file_filename (gfc_unit *, const char *, int);
 458 internal_proto(compare_file_filename);
 459
 460 extern gfc_unit *find_file (void);
 461 internal_proto(find_file);
 462
 463 extern int stream_at_bof (stream *);
 464 internal_proto(stream_at_bof);
 465
 466 extern int stream_at_eof (stream *);
 467 internal_proto(stream_at_eof);
 468
 469 extern int delete_file (gfc_unit *);
 470 internal_proto(delete_file);
 471
 472 extern int file_exists (void);
 473 internal_proto(file_exists);
 474
 475 extern const char *inquire_sequential (const char *, int);
 476 internal_proto(inquire_sequential);
 477
 478 extern const char *inquire_direct (const char *, int);
 479 internal_proto(inquire_direct);
 480
 481 extern const char *inquire_formatted (const char *, int);
 482 internal_proto(inquire_formatted);
 483
 484 extern const char *inquire_unformatted (const char *, int);
 485 internal_proto(inquire_unformatted);
 486
 487 extern const char *inquire_read (const char *, int);
 488 internal_proto(inquire_read);
 489
 490 extern const char *inquire_write (const char *, int);
 491 internal_proto(inquire_write);
 492
 493 extern const char *inquire_readwrite (const char *, int);
 494 internal_proto(inquire_readwrite);
 495
 496 extern gfc_offset file_length (stream *);
 497 internal_proto(file_length);
 498
 499 extern gfc_offset file_position (stream *);
 500 internal_proto(file_position);
 501
 502 extern int is_seekable (stream *);
 503 internal_proto(is_seekable);
 504
 505 extern int is_preconnected (stream *);
 506 internal_proto(is_preconnected);
 507
 508 extern void flush_if_preconnected (stream *);
 509 internal_proto(flush_if_preconnected);
 510
 511 extern void empty_internal_buffer(stream *);
 512 internal_proto(empty_internal_buffer);
 513
 514 extern try flush (stream *);
 515 internal_proto(flush);
 516
 517 extern int stream_isatty (stream *);
 518 internal_proto(stream_isatty);
 519
 520 extern char * stream_ttyname (stream *);
 521 internal_proto(stream_ttyname);
 522
 523 extern gfc_offset stream_offset (stream *s);
 524 internal_proto(stream_offset);
 525
 526 extern int unit_to_fd (int);
 527 internal_proto(unit_to_fd);
 528
 529 extern int unpack_filename (char *, const char *, int);
 530 internal_proto(unpack_filename);
 531
 532 /* unit.c */
 533
 534 extern void insert_unit (gfc_unit *);
 535 internal_proto(insert_unit);
 536
 537 extern int close_unit (gfc_unit *);
 538 internal_proto(close_unit);
 539
 540 extern int is_internal_unit (void);
 541 internal_proto(is_internal_unit);
 542
 543 extern int is_array_io (void);
 544 internal_proto(is_array_io);
 545
 546 extern gfc_unit *find_unit (int);
 547 internal_proto(find_unit);
 548
 549 extern gfc_unit *get_unit (int);
 550 internal_proto(get_unit);
 551
 552 /* open.c */
 553
 554 extern void test_endfile (gfc_unit *);
 555 internal_proto(test_endfile);
 556
 557 extern void new_unit (unit_flags *);
 558 internal_proto(new_unit);
 559
 560 /* format.c */
 561
 562 extern void parse_format (void);
 563 internal_proto(parse_format);
 564
 565 extern fnode *next_format (void);
 566 internal_proto(next_format);
 567
 568 extern void unget_format (fnode *);
 569 internal_proto(unget_format);
 570
 571 extern void format_error (fnode *, const char *);
 572 internal_proto(format_error);
 573
 574 extern void free_fnodes (void);
 575 internal_proto(free_fnodes);
 576
 577 /* transfer.c */
 578
 579 #define SCRATCH_SIZE 300
 580
 581 extern char scratch[];
 582 internal_proto(scratch);
 583
 584 extern const char *type_name (bt);
 585 internal_proto(type_name);
 586
 587 extern void *read_block (int *);
 588 internal_proto(read_block);
 589
 590 extern void *write_block (int);
 591 internal_proto(write_block);
 592
 593 extern gfc_offset next_array_record (array_loop_spec *);
 594 internal_proto(next_array_record);
 595
 596 extern gfc_offset init_loop_spec (gfc_array_char *desc, array_loop_spec *ls);
 597 internal_proto(init_loop_spec);
 598
 599 extern void next_record (int);
 600 internal_proto(next_record);
 601
 602 /* read.c */
 603
 604 extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
 605 internal_proto(set_integer);
 606
 607 extern GFC_UINTEGER_LARGEST max_value (int, int);
 608 internal_proto(max_value);
 609
 610 extern int convert_real (void *, const char *, int);
 611 internal_proto(convert_real);
 612
 613 extern void read_a (fnode *, char *, int);
 614 internal_proto(read_a);
 615
 616 extern void read_f (fnode *, char *, int);
 617 internal_proto(read_f);
 618
 619 extern void read_l (fnode *, char *, int);
 620 internal_proto(read_l);
 621
 622 extern void read_x (int);
 623 internal_proto(read_x);
 624
 625 extern void read_radix (fnode *, char *, int, int);
 626 internal_proto(read_radix);
 627
 628 extern void read_decimal (fnode *, char *, int);
 629 internal_proto(read_decimal);
 630
 631 /* list_read.c */
 632
 633 extern void list_formatted_read (bt, void *, int, size_t, size_t);
 634 internal_proto(list_formatted_read);
 635
 636 extern void finish_list_read (void);
 637 internal_proto(finish_list_read);
 638
 639 extern void init_at_eol (void);
 640 internal_proto(init_at_eol);
 641
 642 extern void namelist_read (void);
 643 internal_proto(namelist_read);
 644
 645 extern void namelist_write (void);
 646 internal_proto(namelist_write);
 647
 648 /* write.c */
 649
 650 extern void write_a (fnode *, const char *, int);
 651 internal_proto(write_a);
 652
 653 extern void write_b (fnode *, const char *, int);
 654 internal_proto(write_b);
 655
 656 extern void write_d (fnode *, const char *, int);
 657 internal_proto(write_d);
 658
 659 extern void write_e (fnode *, const char *, int);
 660 internal_proto(write_e);
 661
 662 extern void write_en (fnode *, const char *, int);
 663 internal_proto(write_en);
 664
 665 extern void write_es (fnode *, const char *, int);
 666 internal_proto(write_es);
 667
 668 extern void write_f (fnode *, const char *, int);
 669 internal_proto(write_f);
 670
 671 extern void write_i (fnode *, const char *, int);
 672 internal_proto(write_i);
 673
 674 extern void write_l (fnode *, char *, int);
 675 internal_proto(write_l);
 676
 677 extern void write_o (fnode *, const char *, int);
 678 internal_proto(write_o);
 679
 680 extern void write_x (int, int);
 681 internal_proto(write_x);
 682
 683 extern void write_z (fnode *, const char *, int);
 684 internal_proto(write_z);
 685
 686 extern void list_formatted_write (bt, void *, int, size_t, size_t);
 687 internal_proto(list_formatted_write);
 688
 689 /* error.c */
 690 extern try notify_std (int, const char *);
 691 internal_proto(notify_std);
 692
 693 /* size_from_kind.c */
 694 extern size_t size_from_real_kind (int);
 695 internal_proto(size_from_real_kind);
 696
 697 extern size_t size_from_complex_kind (int);
 698 internal_proto(size_from_complex_kind);
 699
 700 #endif