gcc/fortran/gfortran.h

   1 /* gfortran header file
   2    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
   3    2009, 2010
   4    Free Software Foundation, Inc.
   5    Contributed by Andy Vaught
   6
   7 This file is part of GCC.
   8
   9 GCC is free software; you can redistribute it and/or modify it under
  10 the terms of the GNU General Public License as published by the Free
  11 Software Foundation; either version 3, or (at your option) any later
  12 version.
  13
  14 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  15 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  16 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  17 for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with GCC; see the file COPYING3.  If not see
  21 <http://www.gnu.org/licenses/>.  */
  22
  23 #ifndef GCC_GFORTRAN_H
  24 #define GCC_GFORTRAN_H
  25
  26 /* It's probably insane to have this large of a header file, but it
  27    seemed like everything had to be recompiled anyway when a change
  28    was made to a header file, and there were ordering issues with
  29    multiple header files.  Besides, Microsoft's winnt.h was 250k last
  30    time I looked, so by comparison this is perfectly reasonable.  */
  31
  32 /* Declarations common to the front-end and library are put in
  33    libgfortran/libgfortran_frontend.h  */
  34 #include "libgfortran.h"
  35
  36
  37 #include "intl.h"
  38 #include "coretypes.h"
  39 #include "input.h"
  40 #include "splay-tree.h"
  41 /* The following ifdefs are recommended by the autoconf documentation
  42    for any code using alloca.  */
  43
  44 /* AIX requires this to be the first thing in the file.  */
  45 #ifdef __GNUC__
  46 #else /* not __GNUC__ */
  47 #ifdef HAVE_ALLOCA_H
  48 #include <alloca.h>
  49 #else /* do not HAVE_ALLOCA_H */
  50 #ifdef _AIX
  51 #pragma alloca
  52 #else
  53 #ifndef alloca                  /* predefined by HP cc +Olibcalls */
  54 char *alloca ();
  55 #endif /* not predefined */
  56 #endif /* not _AIX */
  57 #endif /* do not HAVE_ALLOCA_H */
  58 #endif /* not __GNUC__ */
  59
  60 /* Major control parameters.  */
  61
  62 #define GFC_MAX_SYMBOL_LEN 63   /* Must be at least 63 for F2003.  */
  63 #define GFC_MAX_BINDING_LABEL_LEN 126 /* (2 * GFC_MAX_SYMBOL_LEN) */
  64 #define GFC_MAX_LINE 132        /* Characters beyond this are not seen.  */
  65 #define GFC_LETTERS 26          /* Number of letters in the alphabet.  */
  66
  67 #define MAX_SUBRECORD_LENGTH 2147483639   /* 2**31-9 */
  68
  69
  70 #define free(x) Use_gfc_free_instead_of_free()
  71 #define gfc_is_whitespace(c) ((c==' ') || (c=='\t'))
  72
  73 #ifndef NULL
  74 #define NULL ((void *) 0)
  75 #endif
  76
  77 /* Stringization.  */
  78 #define stringize(x) expand_macro(x)
  79 #define expand_macro(x) # x
  80
  81 /* For the runtime library, a standard prefix is a requirement to
  82    avoid cluttering the namespace with things nobody asked for.  It's
  83    ugly to look at and a pain to type when you add the prefix by hand,
  84    so we hide it behind a macro.  */
  85 #define PREFIX(x) "_gfortran_" x
  86 #define PREFIX_LEN 10
  87
  88 #define BLANK_COMMON_NAME "__BLNK__"
  89
  90 /* Macro to initialize an mstring structure.  */
  91 #define minit(s, t) { s, NULL, t }
  92
  93 /* Structure for storing strings to be matched by gfc_match_string.  */
  94 typedef struct
  95 {
  96   const char *string;
  97   const char *mp;
  98   int tag;
  99 }
 100 mstring;
 101
 102
 103
 104 /*************************** Enums *****************************/
 105
 106 /* Used when matching and resolving data I/O transfer statements.  */
 107
 108 typedef enum
 109 { M_READ, M_WRITE, M_PRINT, M_INQUIRE }
 110 io_kind;
 111
 112 /* The author remains confused to this day about the convention of
 113    returning '0' for 'SUCCESS'... or was it the other way around?  The
 114    following enum makes things much more readable.  We also start
 115    values off at one instead of zero.  */
 116
 117 typedef enum
 118 { SUCCESS = 1, FAILURE }
 119 gfc_try;
 120
 121 /* This is returned by gfc_notification_std to know if, given the flags
 122    that were given (-std=, -pedantic) we should issue an error, a warning
 123    or nothing.  */
 124
 125 typedef enum
 126 { SILENT, WARNING, ERROR }
 127 notification;
 128
 129 /* Matchers return one of these three values.  The difference between
 130    MATCH_NO and MATCH_ERROR is that MATCH_ERROR means that a match was
 131    successful, but that something non-syntactic is wrong and an error
 132    has already been issued.  */
 133
 134 typedef enum
 135 { MATCH_NO = 1, MATCH_YES, MATCH_ERROR }
 136 match;
 137
 138 typedef enum
 139 { FORM_FREE, FORM_FIXED, FORM_UNKNOWN }
 140 gfc_source_form;
 141
 142 /* Basic types.  BT_VOID is used by ISO C Binding so funcs like c_f_pointer
 143    can take any arg with the pointer attribute as a param.  */
 144 typedef enum
 145 { BT_UNKNOWN = 1, BT_INTEGER, BT_REAL, BT_COMPLEX, BT_LOGICAL, BT_CHARACTER,
 146   BT_DERIVED, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID
 147 }
 148 bt;
 149
 150 /* Expression node types.  */
 151 typedef enum
 152 { EXPR_OP = 1, EXPR_FUNCTION, EXPR_CONSTANT, EXPR_VARIABLE,
 153   EXPR_SUBSTRING, EXPR_STRUCTURE, EXPR_ARRAY, EXPR_NULL, EXPR_COMPCALL, EXPR_PPC
 154 }
 155 expr_t;
 156
 157 /* Array types.  */
 158 typedef enum
 159 { AS_EXPLICIT = 1, AS_ASSUMED_SHAPE, AS_DEFERRED,
 160   AS_ASSUMED_SIZE, AS_UNKNOWN
 161 }
 162 array_type;
 163
 164 typedef enum
 165 { AR_FULL = 1, AR_ELEMENT, AR_SECTION, AR_UNKNOWN }
 166 ar_type;
 167
 168 /* Statement label types.  */
 169 typedef enum
 170 { ST_LABEL_UNKNOWN = 1, ST_LABEL_TARGET,
 171   ST_LABEL_BAD_TARGET, ST_LABEL_FORMAT
 172 }
 173 gfc_sl_type;
 174
 175 /* Intrinsic operators.  */
 176 typedef enum
 177 { GFC_INTRINSIC_BEGIN = 0,
 178   INTRINSIC_NONE = -1, INTRINSIC_UPLUS = GFC_INTRINSIC_BEGIN,
 179   INTRINSIC_UMINUS, INTRINSIC_PLUS, INTRINSIC_MINUS, INTRINSIC_TIMES,
 180   INTRINSIC_DIVIDE, INTRINSIC_POWER, INTRINSIC_CONCAT,
 181   INTRINSIC_AND, INTRINSIC_OR, INTRINSIC_EQV, INTRINSIC_NEQV,
 182   /* ==, /=, >, >=, <, <=  */
 183   INTRINSIC_EQ, INTRINSIC_NE, INTRINSIC_GT, INTRINSIC_GE,
 184   INTRINSIC_LT, INTRINSIC_LE,
 185   /* .EQ., .NE., .GT., .GE., .LT., .LE. (OS = Old-Style)  */
 186   INTRINSIC_EQ_OS, INTRINSIC_NE_OS, INTRINSIC_GT_OS, INTRINSIC_GE_OS,
 187   INTRINSIC_LT_OS, INTRINSIC_LE_OS,
 188   INTRINSIC_NOT, INTRINSIC_USER, INTRINSIC_ASSIGN,
 189   INTRINSIC_PARENTHESES, GFC_INTRINSIC_END /* Sentinel */
 190 }
 191 gfc_intrinsic_op;
 192
 193
 194 /* This macro is the number of intrinsic operators that exist.
 195    Assumptions are made about the numbering of the interface_op enums.  */
 196 #define GFC_INTRINSIC_OPS GFC_INTRINSIC_END
 197
 198 /* Arithmetic results.  */
 199 typedef enum
 200 { ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
 201   ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC, ARITH_PROHIBIT
 202 }
 203 arith;
 204
 205 /* Statements.  */
 206 typedef enum
 207 {
 208   ST_ARITHMETIC_IF, ST_ALLOCATE, ST_ATTR_DECL, ST_ASSOCIATE,
 209   ST_BACKSPACE, ST_BLOCK, ST_BLOCK_DATA,
 210   ST_CALL, ST_CASE, ST_CLOSE, ST_COMMON, ST_CONTINUE, ST_CONTAINS, ST_CYCLE,
 211   ST_DATA, ST_DATA_DECL, ST_DEALLOCATE, ST_DO, ST_ELSE, ST_ELSEIF,
 212   ST_ELSEWHERE, ST_END_ASSOCIATE, ST_END_BLOCK, ST_END_BLOCK_DATA,
 213   ST_ENDDO, ST_IMPLIED_ENDDO,
 214   ST_END_FILE, ST_FINAL, ST_FLUSH, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF,
 215   ST_END_INTERFACE, ST_END_MODULE, ST_END_PROGRAM, ST_END_SELECT,
 216   ST_END_SUBROUTINE, ST_END_WHERE, ST_END_TYPE, ST_ENTRY, ST_EQUIVALENCE,
 217   ST_ERROR_STOP, ST_EXIT, ST_FORALL, ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION,
 218   ST_GOTO, ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT,
 219   ST_INQUIRE, ST_INTERFACE, ST_SYNC_ALL, ST_SYNC_MEMORY, ST_SYNC_IMAGES,
 220   ST_PARAMETER, ST_MODULE, ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN,
 221   ST_PAUSE, ST_PRIVATE, ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND,
 222   ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WAIT,
 223   ST_WRITE, ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
 224   ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
 225   ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_SELECT_TYPE, ST_TYPE_IS, ST_CLASS_IS,
 226   ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_CRITICAL,
 227   ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED, ST_OMP_END_PARALLEL,
 228   ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
 229   ST_OMP_END_PARALLEL_WORKSHARE, ST_OMP_END_SECTIONS, ST_OMP_END_SINGLE,
 230   ST_OMP_END_WORKSHARE, ST_OMP_DO, ST_OMP_FLUSH, ST_OMP_MASTER, ST_OMP_ORDERED,
 231   ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS,
 232   ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE,
 233   ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK,
 234   ST_OMP_TASKWAIT, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
 235   ST_GET_FCN_CHARACTERISTICS, ST_NONE
 236 }
 237 gfc_statement;
 238
 239
 240 /* Types of interfaces that we can have.  Assignment interfaces are
 241    considered to be intrinsic operators.  */
 242 typedef enum
 243 {
 244   INTERFACE_NAMELESS = 1, INTERFACE_GENERIC,
 245   INTERFACE_INTRINSIC_OP, INTERFACE_USER_OP, INTERFACE_ABSTRACT
 246 }
 247 interface_type;
 248
 249 /* Symbol flavors: these are all mutually exclusive.
 250    10 elements = 4 bits.  */
 251 typedef enum sym_flavor
 252 {
 253   FL_UNKNOWN = 0, FL_PROGRAM, FL_BLOCK_DATA, FL_MODULE, FL_VARIABLE,
 254   FL_PARAMETER, FL_LABEL, FL_PROCEDURE, FL_DERIVED, FL_NAMELIST,
 255   FL_VOID
 256 }
 257 sym_flavor;
 258
 259 /* Procedure types.  7 elements = 3 bits.  */
 260 typedef enum procedure_type
 261 { PROC_UNKNOWN, PROC_MODULE, PROC_INTERNAL, PROC_DUMMY,
 262   PROC_INTRINSIC, PROC_ST_FUNCTION, PROC_EXTERNAL
 263 }
 264 procedure_type;
 265
 266 /* Intent types.  */
 267 typedef enum sym_intent
 268 { INTENT_UNKNOWN = 0, INTENT_IN, INTENT_OUT, INTENT_INOUT
 269 }
 270 sym_intent;
 271
 272 /* Access types.  */
 273 typedef enum gfc_access
 274 { ACCESS_UNKNOWN = 0, ACCESS_PUBLIC, ACCESS_PRIVATE
 275 }
 276 gfc_access;
 277
 278 /* Flags to keep track of where an interface came from.
 279    3 elements = 2 bits.  */
 280 typedef enum ifsrc
 281 { IFSRC_UNKNOWN = 0,    /* Interface unknown, only return type may be known.  */
 282   IFSRC_DECL,           /* FUNCTION or SUBROUTINE declaration.  */
 283   IFSRC_IFBODY          /* INTERFACE statement or PROCEDURE statement
 284                            with explicit interface.  */
 285 }
 286 ifsrc;
 287
 288 /* Whether a SAVE attribute was set explicitly or implicitly.  */
 289 typedef enum save_state
 290 { SAVE_NONE = 0, SAVE_EXPLICIT, SAVE_IMPLICIT
 291 }
 292 save_state;
 293
 294 /* Strings for all symbol attributes.  We use these for dumping the
 295    parse tree, in error messages, and also when reading and writing
 296    modules.  In symbol.c.  */
 297 extern const mstring flavors[];
 298 extern const mstring procedures[];
 299 extern const mstring intents[];
 300 extern const mstring access_types[];
 301 extern const mstring ifsrc_types[];
 302 extern const mstring save_status[];
 303
 304 /* Enumeration of all the generic intrinsic functions.  Used by the
 305    backend for identification of a function.  */
 306
 307 enum gfc_isym_id
 308 {
 309   /* GFC_ISYM_NONE is used for intrinsics which will never be seen by
 310      the backend (e.g. KIND).  */
 311   GFC_ISYM_NONE = 0,
 312   GFC_ISYM_ABORT,
 313   GFC_ISYM_ABS,
 314   GFC_ISYM_ACCESS,
 315   GFC_ISYM_ACHAR,
 316   GFC_ISYM_ACOS,
 317   GFC_ISYM_ACOSH,
 318   GFC_ISYM_ADJUSTL,
 319   GFC_ISYM_ADJUSTR,
 320   GFC_ISYM_AIMAG,
 321   GFC_ISYM_AINT,
 322   GFC_ISYM_ALARM,
 323   GFC_ISYM_ALL,
 324   GFC_ISYM_ALLOCATED,
 325   GFC_ISYM_AND,
 326   GFC_ISYM_ANINT,
 327   GFC_ISYM_ANY,
 328   GFC_ISYM_ASIN,
 329   GFC_ISYM_ASINH,
 330   GFC_ISYM_ASSOCIATED,
 331   GFC_ISYM_ATAN,
 332   GFC_ISYM_ATAN2,
 333   GFC_ISYM_ATANH,
 334   GFC_ISYM_BIT_SIZE,
 335   GFC_ISYM_BTEST,
 336   GFC_ISYM_CEILING,
 337   GFC_ISYM_CHAR,
 338   GFC_ISYM_CHDIR,
 339   GFC_ISYM_CHMOD,
 340   GFC_ISYM_CMPLX,
 341   GFC_ISYM_COMMAND_ARGUMENT_COUNT,
 342   GFC_ISYM_COMPLEX,
 343   GFC_ISYM_CONJG,
 344   GFC_ISYM_CONVERSION,
 345   GFC_ISYM_COS,
 346   GFC_ISYM_COSH,
 347   GFC_ISYM_COUNT,
 348   GFC_ISYM_CPU_TIME,
 349   GFC_ISYM_CSHIFT,
 350   GFC_ISYM_CTIME,
 351   GFC_ISYM_DATE_AND_TIME,
 352   GFC_ISYM_DBLE,
 353   GFC_ISYM_DIGITS,
 354   GFC_ISYM_DIM,
 355   GFC_ISYM_DOT_PRODUCT,
 356   GFC_ISYM_DPROD,
 357   GFC_ISYM_DTIME,
 358   GFC_ISYM_EOSHIFT,
 359   GFC_ISYM_EPSILON,
 360   GFC_ISYM_ERF,
 361   GFC_ISYM_ERFC,
 362   GFC_ISYM_ERFC_SCALED,
 363   GFC_ISYM_ETIME,
 364   GFC_ISYM_EXIT,
 365   GFC_ISYM_EXP,
 366   GFC_ISYM_EXPONENT,
 367   GFC_ISYM_EXTENDS_TYPE_OF,
 368   GFC_ISYM_FDATE,
 369   GFC_ISYM_FGET,
 370   GFC_ISYM_FGETC,
 371   GFC_ISYM_FLOOR,
 372   GFC_ISYM_FLUSH,
 373   GFC_ISYM_FNUM,
 374   GFC_ISYM_FPUT,
 375   GFC_ISYM_FPUTC,
 376   GFC_ISYM_FRACTION,
 377   GFC_ISYM_FREE,
 378   GFC_ISYM_FSEEK,
 379   GFC_ISYM_FSTAT,
 380   GFC_ISYM_FTELL,
 381   GFC_ISYM_TGAMMA,
 382   GFC_ISYM_GERROR,
 383   GFC_ISYM_GETARG,
 384   GFC_ISYM_GET_COMMAND,
 385   GFC_ISYM_GET_COMMAND_ARGUMENT,
 386   GFC_ISYM_GETCWD,
 387   GFC_ISYM_GETENV,
 388   GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
 389   GFC_ISYM_GETGID,
 390   GFC_ISYM_GETLOG,
 391   GFC_ISYM_GETPID,
 392   GFC_ISYM_GETUID,
 393   GFC_ISYM_GMTIME,
 394   GFC_ISYM_HOSTNM,
 395   GFC_ISYM_HUGE,
 396   GFC_ISYM_HYPOT,
 397   GFC_ISYM_IACHAR,
 398   GFC_ISYM_IAND,
 399   GFC_ISYM_IARGC,
 400   GFC_ISYM_IBCLR,
 401   GFC_ISYM_IBITS,
 402   GFC_ISYM_IBSET,
 403   GFC_ISYM_ICHAR,
 404   GFC_ISYM_IDATE,
 405   GFC_ISYM_IEOR,
 406   GFC_ISYM_IERRNO,
 407   GFC_ISYM_IMAGE_INDEX,
 408   GFC_ISYM_INDEX,
 409   GFC_ISYM_INT,
 410   GFC_ISYM_INT2,
 411   GFC_ISYM_INT8,
 412   GFC_ISYM_IOR,
 413   GFC_ISYM_IRAND,
 414   GFC_ISYM_ISATTY,
 415   GFC_ISYM_IS_IOSTAT_END,
 416   GFC_ISYM_IS_IOSTAT_EOR,
 417   GFC_ISYM_ISNAN,
 418   GFC_ISYM_ISHFT,
 419   GFC_ISYM_ISHFTC,
 420   GFC_ISYM_ITIME,
 421   GFC_ISYM_J0,
 422   GFC_ISYM_J1,
 423   GFC_ISYM_JN,
 424   GFC_ISYM_KILL,
 425   GFC_ISYM_KIND,
 426   GFC_ISYM_LBOUND,
 427   GFC_ISYM_LCOBOUND,
 428   GFC_ISYM_LEADZ,
 429   GFC_ISYM_LEN,
 430   GFC_ISYM_LEN_TRIM,
 431   GFC_ISYM_LGAMMA,
 432   GFC_ISYM_LGE,
 433   GFC_ISYM_LGT,
 434   GFC_ISYM_LINK,
 435   GFC_ISYM_LLE,
 436   GFC_ISYM_LLT,
 437   GFC_ISYM_LOC,
 438   GFC_ISYM_LOG,
 439   GFC_ISYM_LOG10,
 440   GFC_ISYM_LOGICAL,
 441   GFC_ISYM_LONG,
 442   GFC_ISYM_LSHIFT,
 443   GFC_ISYM_LSTAT,
 444   GFC_ISYM_LTIME,
 445   GFC_ISYM_MALLOC,
 446   GFC_ISYM_MATMUL,
 447   GFC_ISYM_MAX,
 448   GFC_ISYM_MAXEXPONENT,
 449   GFC_ISYM_MAXLOC,
 450   GFC_ISYM_MAXVAL,
 451   GFC_ISYM_MCLOCK,
 452   GFC_ISYM_MCLOCK8,
 453   GFC_ISYM_MERGE,
 454   GFC_ISYM_MIN,
 455   GFC_ISYM_MINEXPONENT,
 456   GFC_ISYM_MINLOC,
 457   GFC_ISYM_MINVAL,
 458   GFC_ISYM_MOD,
 459   GFC_ISYM_MODULO,
 460   GFC_ISYM_MOVE_ALLOC,
 461   GFC_ISYM_MVBITS,
 462   GFC_ISYM_NEAREST,
 463   GFC_ISYM_NEW_LINE,
 464   GFC_ISYM_NINT,
 465   GFC_ISYM_NOT,
 466   GFC_ISYM_NULL,
 467   GFC_ISYM_NUMIMAGES,
 468   GFC_ISYM_OR,
 469   GFC_ISYM_PACK,
 470   GFC_ISYM_PERROR,
 471   GFC_ISYM_PRECISION,
 472   GFC_ISYM_PRESENT,
 473   GFC_ISYM_PRODUCT,
 474   GFC_ISYM_RADIX,
 475   GFC_ISYM_RAND,
 476   GFC_ISYM_RANDOM_NUMBER,
 477   GFC_ISYM_RANDOM_SEED,
 478   GFC_ISYM_RANGE,
 479   GFC_ISYM_REAL,
 480   GFC_ISYM_RENAME,
 481   GFC_ISYM_REPEAT,
 482   GFC_ISYM_RESHAPE,
 483   GFC_ISYM_RRSPACING,
 484   GFC_ISYM_RSHIFT,
 485   GFC_ISYM_SAME_TYPE_AS,
 486   GFC_ISYM_SC_KIND,
 487   GFC_ISYM_SCALE,
 488   GFC_ISYM_SCAN,
 489   GFC_ISYM_SECNDS,
 490   GFC_ISYM_SECOND,
 491   GFC_ISYM_SET_EXPONENT,
 492   GFC_ISYM_SHAPE,
 493   GFC_ISYM_SIGN,
 494   GFC_ISYM_SIGNAL,
 495   GFC_ISYM_SI_KIND,
 496   GFC_ISYM_SIN,
 497   GFC_ISYM_SINH,
 498   GFC_ISYM_SIZE,
 499   GFC_ISYM_SLEEP,
 500   GFC_ISYM_SIZEOF,
 501   GFC_ISYM_SPACING,
 502   GFC_ISYM_SPREAD,
 503   GFC_ISYM_SQRT,
 504   GFC_ISYM_SRAND,
 505   GFC_ISYM_SR_KIND,
 506   GFC_ISYM_STAT,
 507   GFC_ISYM_SUM,
 508   GFC_ISYM_SYMLINK,
 509   GFC_ISYM_SYMLNK,
 510   GFC_ISYM_SYSTEM,
 511   GFC_ISYM_SYSTEM_CLOCK,
 512   GFC_ISYM_TAN,
 513   GFC_ISYM_TANH,
 514   GFC_ISYM_THIS_IMAGE,
 515   GFC_ISYM_TIME,
 516   GFC_ISYM_TIME8,
 517   GFC_ISYM_TINY,
 518   GFC_ISYM_TRAILZ,
 519   GFC_ISYM_TRANSFER,
 520   GFC_ISYM_TRANSPOSE,
 521   GFC_ISYM_TRIM,
 522   GFC_ISYM_TTYNAM,
 523   GFC_ISYM_UBOUND,
 524   GFC_ISYM_UCOBOUND,
 525   GFC_ISYM_UMASK,
 526   GFC_ISYM_UNLINK,
 527   GFC_ISYM_UNPACK,
 528   GFC_ISYM_VERIFY,
 529   GFC_ISYM_XOR,
 530   GFC_ISYM_Y0,
 531   GFC_ISYM_Y1,
 532   GFC_ISYM_YN
 533 };
 534 typedef enum gfc_isym_id gfc_isym_id;
 535
 536
 537 typedef enum
 538 {
 539   GFC_INIT_REAL_OFF = 0,
 540   GFC_INIT_REAL_ZERO,
 541   GFC_INIT_REAL_NAN,
 542   GFC_INIT_REAL_SNAN,
 543   GFC_INIT_REAL_INF,
 544   GFC_INIT_REAL_NEG_INF
 545 }
 546 init_local_real;
 547
 548 typedef enum
 549 {
 550   GFC_INIT_LOGICAL_OFF = 0,
 551   GFC_INIT_LOGICAL_FALSE,
 552   GFC_INIT_LOGICAL_TRUE
 553 }
 554 init_local_logical;
 555
 556 typedef enum
 557 {
 558   GFC_INIT_CHARACTER_OFF = 0,
 559   GFC_INIT_CHARACTER_ON
 560 }
 561 init_local_character;
 562
 563 typedef enum
 564 {
 565   GFC_INIT_INTEGER_OFF = 0,
 566   GFC_INIT_INTEGER_ON
 567 }
 568 init_local_integer;
 569
 570 typedef enum
 571 {
 572   GFC_FCOARRAY_NONE = 0,
 573   GFC_FCOARRAY_SINGLE
 574 }
 575 gfc_fcoarray;
 576
 577 /************************* Structures *****************************/
 578
 579 /* Used for keeping things in balanced binary trees.  */
 580 #define BBT_HEADER(self) int priority; struct self *left, *right
 581
 582 #define NAMED_INTCST(a,b,c,d) a,
 583 typedef enum
 584 {
 585   ISOFORTRANENV_INVALID = -1,
 586 #include "iso-fortran-env.def"
 587   ISOFORTRANENV_LAST, ISOFORTRANENV_NUMBER = ISOFORTRANENV_LAST
 588 }
 589 iso_fortran_env_symbol;
 590 #undef NAMED_INTCST
 591
 592 #define NAMED_INTCST(a,b,c,d) a,
 593 #define NAMED_REALCST(a,b,c) a,
 594 #define NAMED_CMPXCST(a,b,c) a,
 595 #define NAMED_LOGCST(a,b,c) a,
 596 #define NAMED_CHARKNDCST(a,b,c) a,
 597 #define NAMED_CHARCST(a,b,c) a,
 598 #define DERIVED_TYPE(a,b,c) a,
 599 #define PROCEDURE(a,b) a,
 600 typedef enum
 601 {
 602   ISOCBINDING_INVALID = -1,
 603 #include "iso-c-binding.def"
 604   ISOCBINDING_LAST,
 605   ISOCBINDING_NUMBER = ISOCBINDING_LAST
 606 }
 607 iso_c_binding_symbol;
 608 #undef NAMED_INTCST
 609 #undef NAMED_REALCST
 610 #undef NAMED_CMPXCST
 611 #undef NAMED_LOGCST
 612 #undef NAMED_CHARKNDCST
 613 #undef NAMED_CHARCST
 614 #undef DERIVED_TYPE
 615 #undef PROCEDURE
 616
 617 typedef enum
 618 {
 619   INTMOD_NONE = 0, INTMOD_ISO_FORTRAN_ENV, INTMOD_ISO_C_BINDING
 620 }
 621 intmod_id;
 622
 623 typedef struct
 624 {
 625   char name[GFC_MAX_SYMBOL_LEN + 1];
 626   int value;  /* Used for both integer and character values.  */
 627   bt f90_type;
 628 }
 629 CInteropKind_t;
 630
 631 /* Array of structs, where the structs represent the C interop kinds.
 632    The list will be implemented based on a hash of the kind name since
 633    these could be accessed multiple times.
 634    Declared in trans-types.c as a global, since it's in that file
 635    that the list is initialized.  */
 636 extern CInteropKind_t c_interop_kinds_table[];
 637
 638
 639 /* Structure and list of supported extension attributes.  */
 640 typedef enum
 641 {
 642   EXT_ATTR_DLLIMPORT = 0,
 643   EXT_ATTR_DLLEXPORT,
 644   EXT_ATTR_STDCALL,
 645   EXT_ATTR_CDECL,
 646   EXT_ATTR_FASTCALL,
 647   EXT_ATTR_LAST, EXT_ATTR_NUM = EXT_ATTR_LAST
 648 }
 649 ext_attr_id_t;
 650
 651 typedef struct
 652 {
 653   const char *name;
 654   unsigned id;
 655   const char *middle_end_name;
 656 }
 657 ext_attr_t;
 658
 659 extern const ext_attr_t ext_attr_list[];
 660
 661 /* Symbol attribute structure.  */
 662 typedef struct
 663 {
 664   /* Variable attributes.  */
 665   unsigned allocatable:1, dimension:1, codimension:1, external:1, intrinsic:1,
 666     optional:1, pointer:1, target:1, value:1, volatile_:1, temporary:1,
 667     dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1,
 668     implied_index:1, subref_array_pointer:1, proc_pointer:1, asynchronous:1,
 669     contiguous:1;
 670
 671   /* For CLASS containers, the pointer attribute is sometimes set internally
 672      even though it was not directly specified.  In this case, keep the
 673      "real" (original) value here.  */
 674   unsigned class_pointer:1;
 675
 676   ENUM_BITFIELD (save_state) save:2;
 677
 678   unsigned data:1,              /* Symbol is named in a DATA statement.  */
 679     is_protected:1,             /* Symbol has been marked as protected.  */
 680     use_assoc:1,                /* Symbol has been use-associated.  */
 681     use_only:1,                 /* Symbol has been use-associated, with ONLY.  */
 682     use_rename:1,               /* Symbol has been use-associated and renamed.  */
 683     imported:1;                 /* Symbol has been associated by IMPORT.  */
 684
 685   unsigned in_namelist:1, in_common:1, in_equivalence:1;
 686   unsigned function:1, subroutine:1, procedure:1;
 687   unsigned generic:1, generic_copy:1;
 688   unsigned implicit_type:1;     /* Type defined via implicit rules.  */
 689   unsigned untyped:1;           /* No implicit type could be found.  */
 690
 691   unsigned is_bind_c:1;         /* say if is bound to C.  */
 692   unsigned extension:8;         /* extension level of a derived type.  */
 693   unsigned is_class:1;          /* is a CLASS container.  */
 694   unsigned class_ok:1;          /* is a CLASS object with correct attributes.  */
 695   unsigned vtab:1;              /* is a derived type vtab, pointed to by CLASS objects.  */
 696   unsigned vtype:1;             /* is a derived type of a vtab.  */
 697
 698   /* These flags are both in the typespec and attribute.  The attribute
 699      list is what gets read from/written to a module file.  The typespec
 700      is created from a decl being processed.  */
 701   unsigned is_c_interop:1;      /* It's c interoperable.  */
 702   unsigned is_iso_c:1;          /* Symbol is from iso_c_binding.  */
 703
 704   /* Function/subroutine attributes */
 705   unsigned sequence:1, elemental:1, pure:1, recursive:1;
 706   unsigned unmaskable:1, masked:1, contained:1, mod_proc:1, abstract:1;
 707
 708   /* This is set if the subroutine doesn't return.  Currently, this
 709      is only possible for intrinsic subroutines.  */
 710   unsigned noreturn:1;
 711
 712   /* Set if this procedure is an alternate entry point.  These procedures
 713      don't have any code associated, and the backend will turn them into
 714      thunks to the master function.  */
 715   unsigned entry:1;
 716
 717   /* Set if this is the master function for a procedure with multiple
 718      entry points.  */
 719   unsigned entry_master:1;
 720
 721   /* Set if this is the master function for a function with multiple
 722      entry points where characteristics of the entry points differ.  */
 723   unsigned mixed_entry_master:1;
 724
 725   /* Set if a function must always be referenced by an explicit interface.  */
 726   unsigned always_explicit:1;
 727
 728   /* Set if the symbol has been referenced in an expression.  No further
 729      modification of type or type parameters is permitted.  */
 730   unsigned referenced:1;
 731
 732   /* Set if this is the symbol for the main program.  */
 733   unsigned is_main_program:1;
 734
 735   /* Mutually exclusive multibit attributes.  */
 736   ENUM_BITFIELD (gfc_access) access:2;
 737   ENUM_BITFIELD (sym_intent) intent:2;
 738   ENUM_BITFIELD (sym_flavor) flavor:4;
 739   ENUM_BITFIELD (ifsrc) if_source:2;
 740
 741   ENUM_BITFIELD (procedure_type) proc:3;
 742
 743   /* Special attributes for Cray pointers, pointees.  */
 744   unsigned cray_pointer:1, cray_pointee:1;
 745
 746   /* The symbol is a derived type with allocatable components, pointer
 747      components or private components, procedure pointer components,
 748      possibly nested.  zero_comp is true if the derived type has no
 749      component at all.  */
 750   unsigned alloc_comp:1, pointer_comp:1, proc_pointer_comp:1,
 751            private_comp:1, zero_comp:1, coarray_comp:1;
 752
 753   /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES).  */
 754   unsigned ext_attr:EXT_ATTR_NUM;
 755
 756   /* The namespace where the attribute has been set.  */
 757   struct gfc_namespace *volatile_ns, *asynchronous_ns;
 758 }
 759 symbol_attribute;
 760
 761
 762 /* We need to store source lines as sequences of multibyte source
 763    characters. We define here a type wide enough to hold any multibyte
 764    source character, just like libcpp does.  A 32-bit type is enough.  */
 765
 766 #if HOST_BITS_PER_INT >= 32
 767 typedef unsigned int gfc_char_t;
 768 #elif HOST_BITS_PER_LONG >= 32
 769 typedef unsigned long gfc_char_t;
 770 #elif defined(HAVE_LONG_LONG) && (HOST_BITS_PER_LONGLONG >= 32)
 771 typedef unsigned long long gfc_char_t;
 772 #else
 773 # error "Cannot find an integer type with at least 32 bits"
 774 #endif
 775
 776
 777 /* The following three structures are used to identify a location in
 778    the sources.
 779
 780    gfc_file is used to maintain a tree of the source files and how
 781    they include each other
 782
 783    gfc_linebuf holds a single line of source code and information
 784    which file it resides in
 785
 786    locus point to the sourceline and the character in the source
 787    line.
 788 */
 789
 790 typedef struct gfc_file
 791 {
 792   struct gfc_file *next, *up;
 793   int inclusion_line, line;
 794   char *filename;
 795 } gfc_file;
 796
 797 typedef struct gfc_linebuf
 798 {
 799   source_location location;
 800   struct gfc_file *file;
 801   struct gfc_linebuf *next;
 802
 803   int truncated;
 804   bool dbg_emitted;
 805
 806   gfc_char_t line[1];
 807 } gfc_linebuf;
 808
 809 #define gfc_linebuf_header_size (offsetof (gfc_linebuf, line))
 810
 811 #define gfc_linebuf_linenum(LBUF) (LOCATION_LINE ((LBUF)->location))
 812
 813 typedef struct
 814 {
 815   gfc_char_t *nextc;
 816   gfc_linebuf *lb;
 817 } locus;
 818
 819 /* In order for the "gfc" format checking to work correctly, you must
 820    have declared a typedef locus first.  */
 821 #if GCC_VERSION >= 4001
 822 #define ATTRIBUTE_GCC_GFC(m, n) __attribute__ ((__format__ (__gcc_gfc__, m, n))) ATTRIBUTE_NONNULL(m)
 823 #else
 824 #define ATTRIBUTE_GCC_GFC(m, n) ATTRIBUTE_NONNULL(m)
 825 #endif
 826
 827
 828 /* Suppress error messages or re-enable them.  */
 829
 830 void gfc_push_suppress_errors (void);
 831 void gfc_pop_suppress_errors (void);
 832
 833
 834 /* Character length structures hold the expression that gives the
 835    length of a character variable.  We avoid putting these into
 836    gfc_typespec because doing so prevents us from doing structure
 837    copies and forces us to deallocate any typespecs we create, as well
 838    as structures that contain typespecs.  They also can have multiple
 839    character typespecs pointing to them.
 840
 841    These structures form a singly linked list within the current
 842    namespace and are deallocated with the namespace.  It is possible to
 843    end up with gfc_charlen structures that have nothing pointing to them.  */
 844
 845 typedef struct gfc_charlen
 846 {
 847   struct gfc_expr *length;
 848   struct gfc_charlen *next;
 849   bool length_from_typespec; /* Length from explicit array ctor typespec?  */
 850   tree backend_decl;
 851   tree passed_length; /* Length argument explicitelly passed.  */
 852
 853   int resolved;
 854 }
 855 gfc_charlen;
 856
 857 #define gfc_get_charlen() XCNEW (gfc_charlen)
 858
 859 /* Type specification structure.  */
 860 typedef struct
 861 {
 862   bt type;
 863   int kind;
 864
 865   union
 866   {
 867     struct gfc_symbol *derived; /* For derived types only.  */
 868     gfc_charlen *cl;            /* For character types only.  */
 869   }
 870   u;
 871
 872   struct gfc_symbol *interface; /* For PROCEDURE declarations.  */
 873   int is_c_interop;
 874   int is_iso_c;
 875   bt f90_type;
 876 }
 877 gfc_typespec;
 878
 879 /* Array specification.  */
 880 typedef struct
 881 {
 882   int rank;     /* A rank of zero means that a variable is a scalar.  */
 883   int corank;
 884   array_type type, cotype;
 885   struct gfc_expr *lower[GFC_MAX_DIMENSIONS], *upper[GFC_MAX_DIMENSIONS];
 886
 887   /* These two fields are used with the Cray Pointer extension.  */
 888   bool cray_pointee; /* True iff this spec belongs to a cray pointee.  */
 889   bool cp_was_assumed; /* AS_ASSUMED_SIZE cp arrays are converted to
 890                         AS_EXPLICIT, but we want to remember that we
 891                         did this.  */
 892
 893 }
 894 gfc_array_spec;
 895
 896 #define gfc_get_array_spec() XCNEW (gfc_array_spec)
 897
 898
 899 /* Components of derived types.  */
 900 typedef struct gfc_component
 901 {
 902   const char *name;
 903   gfc_typespec ts;
 904
 905   symbol_attribute attr;
 906   gfc_array_spec *as;
 907
 908   tree backend_decl;
 909   locus loc;
 910   struct gfc_expr *initializer;
 911   struct gfc_component *next;
 912
 913   /* Needed for procedure pointer components.  */
 914   struct gfc_formal_arglist *formal;
 915   struct gfc_namespace *formal_ns;
 916   struct gfc_typebound_proc *tb;
 917 }
 918 gfc_component;
 919
 920 #define gfc_get_component() XCNEW (gfc_component)
 921
 922 /* Formal argument lists are lists of symbols.  */
 923 typedef struct gfc_formal_arglist
 924 {
 925   /* Symbol representing the argument at this position in the arglist.  */
 926   struct gfc_symbol *sym;
 927   /* Points to the next formal argument.  */
 928   struct gfc_formal_arglist *next;
 929 }
 930 gfc_formal_arglist;
 931
 932 #define gfc_get_formal_arglist() XCNEW (gfc_formal_arglist)
 933
 934
 935 /* The gfc_actual_arglist structure is for actual arguments.  */
 936 typedef struct gfc_actual_arglist
 937 {
 938   const char *name;
 939   /* Alternate return label when the expr member is null.  */
 940   struct gfc_st_label *label;
 941
 942   /* This is set to the type of an eventual omitted optional
 943      argument. This is used to determine if a hidden string length
 944      argument has to be added to a function call.  */
 945   bt missing_arg_type;
 946
 947   struct gfc_expr *expr;
 948   struct gfc_actual_arglist *next;
 949 }
 950 gfc_actual_arglist;
 951
 952 #define gfc_get_actual_arglist() XCNEW (gfc_actual_arglist)
 953
 954
 955 /* Because a symbol can belong to multiple namelists, they must be
 956    linked externally to the symbol itself.  */
 957 typedef struct gfc_namelist
 958 {
 959   struct gfc_symbol *sym;
 960   struct gfc_namelist *next;
 961 }
 962 gfc_namelist;
 963
 964 #define gfc_get_namelist() XCNEW (gfc_namelist)
 965
 966 enum
 967 {
 968   OMP_LIST_PRIVATE,
 969   OMP_LIST_FIRSTPRIVATE,
 970   OMP_LIST_LASTPRIVATE,
 971   OMP_LIST_COPYPRIVATE,
 972   OMP_LIST_SHARED,
 973   OMP_LIST_COPYIN,
 974   OMP_LIST_PLUS,
 975   OMP_LIST_REDUCTION_FIRST = OMP_LIST_PLUS,
 976   OMP_LIST_MULT,
 977   OMP_LIST_SUB,
 978   OMP_LIST_AND,
 979   OMP_LIST_OR,
 980   OMP_LIST_EQV,
 981   OMP_LIST_NEQV,
 982   OMP_LIST_MAX,
 983   OMP_LIST_MIN,
 984   OMP_LIST_IAND,
 985   OMP_LIST_IOR,
 986   OMP_LIST_IEOR,
 987   OMP_LIST_REDUCTION_LAST = OMP_LIST_IEOR,
 988   OMP_LIST_NUM
 989 };
 990
 991 /* Because a symbol can belong to multiple namelists, they must be
 992    linked externally to the symbol itself.  */
 993
 994 enum gfc_omp_sched_kind
 995 {
 996   OMP_SCHED_NONE,
 997   OMP_SCHED_STATIC,
 998   OMP_SCHED_DYNAMIC,
 999   OMP_SCHED_GUIDED,
1000   OMP_SCHED_RUNTIME,
1001   OMP_SCHED_AUTO
1002 };
1003
1004 enum gfc_omp_default_sharing
1005 {
1006   OMP_DEFAULT_UNKNOWN,
1007   OMP_DEFAULT_NONE,
1008   OMP_DEFAULT_PRIVATE,
1009   OMP_DEFAULT_SHARED,
1010   OMP_DEFAULT_FIRSTPRIVATE
1011 };
1012
1013 typedef struct gfc_omp_clauses
1014 {
1015   struct gfc_expr *if_expr;
1016   struct gfc_expr *num_threads;
1017   gfc_namelist *lists[OMP_LIST_NUM];
1018   enum gfc_omp_sched_kind sched_kind;
1019   struct gfc_expr *chunk_size;
1020   enum gfc_omp_default_sharing default_sharing;
1021   int collapse;
1022   bool nowait, ordered, untied;
1023 }
1024 gfc_omp_clauses;
1025
1026 #define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses)
1027
1028
1029 /* The gfc_st_label structure is a BBT attached to a namespace that
1030    records the usage of statement labels within that space.  */
1031
1032 typedef struct gfc_st_label
1033 {
1034   BBT_HEADER(gfc_st_label);
1035
1036   int value;
1037
1038   gfc_sl_type defined, referenced;
1039
1040   struct gfc_expr *format;
1041
1042   tree backend_decl;
1043
1044   locus where;
1045 }
1046 gfc_st_label;
1047
1048
1049 /* gfc_interface()-- Interfaces are lists of symbols strung together.  */
1050 typedef struct gfc_interface
1051 {
1052   struct gfc_symbol *sym;
1053   locus where;
1054   struct gfc_interface *next;
1055 }
1056 gfc_interface;
1057
1058 #define gfc_get_interface() XCNEW (gfc_interface)
1059
1060 /* User operator nodes.  These are like stripped down symbols.  */
1061 typedef struct
1062 {
1063   const char *name;
1064
1065   gfc_interface *op;
1066   struct gfc_namespace *ns;
1067   gfc_access access;
1068 }
1069 gfc_user_op;
1070
1071
1072 /* A list of specific bindings that are associated with a generic spec.  */
1073 typedef struct gfc_tbp_generic
1074 {
1075   /* The parser sets specific_st, upon resolution we look for the corresponding
1076      gfc_typebound_proc and set specific for further use.  */
1077   struct gfc_symtree* specific_st;
1078   struct gfc_typebound_proc* specific;
1079
1080   struct gfc_tbp_generic* next;
1081 }
1082 gfc_tbp_generic;
1083
1084 #define gfc_get_tbp_generic() XCNEW (gfc_tbp_generic)
1085
1086
1087 /* Data needed for type-bound procedures.  */
1088 typedef struct gfc_typebound_proc
1089 {
1090   locus where; /* Where the PROCEDURE/GENERIC definition was.  */
1091
1092   union
1093   {
1094     struct gfc_symtree* specific; /* The interface if DEFERRED.  */
1095     gfc_tbp_generic* generic;
1096   }
1097   u;
1098
1099   gfc_access access;
1100   const char* pass_arg; /* Argument-name for PASS.  NULL if not specified.  */
1101
1102   /* The overridden type-bound proc (or GENERIC with this name in the
1103      parent-type) or NULL if non.  */
1104   struct gfc_typebound_proc* overridden;
1105
1106   /* Once resolved, we use the position of pass_arg in the formal arglist of
1107      the binding-target procedure to identify it.  The first argument has
1108      number 1 here, the second 2, and so on.  */
1109   unsigned pass_arg_num;
1110
1111   unsigned nopass:1; /* Whether we have NOPASS (PASS otherwise).  */
1112   unsigned non_overridable:1;
1113   unsigned deferred:1;
1114   unsigned is_generic:1;
1115   unsigned function:1, subroutine:1;
1116   unsigned error:1; /* Ignore it, when an error occurred during resolution.  */
1117   unsigned ppc:1;
1118 }
1119 gfc_typebound_proc;
1120
1121
1122 /* Symbol nodes.  These are important things.  They are what the
1123    standard refers to as "entities".  The possibly multiple names that
1124    refer to the same entity are accomplished by a binary tree of
1125    symtree structures that is balanced by the red-black method-- more
1126    than one symtree node can point to any given symbol.  */
1127
1128 typedef struct gfc_symbol
1129 {
1130   const char *name;     /* Primary name, before renaming */
1131   const char *module;   /* Module this symbol came from */
1132   locus declared_at;
1133
1134   gfc_typespec ts;
1135   symbol_attribute attr;
1136
1137   /* The formal member points to the formal argument list if the
1138      symbol is a function or subroutine name.  If the symbol is a
1139      generic name, the generic member points to the list of
1140      interfaces.  */
1141
1142   gfc_interface *generic;
1143   gfc_access component_access;
1144
1145   gfc_formal_arglist *formal;
1146   struct gfc_namespace *formal_ns;
1147   struct gfc_namespace *f2k_derived;
1148
1149   struct gfc_expr *value;       /* Parameter/Initializer value */
1150   gfc_array_spec *as;
1151   struct gfc_symbol *result;    /* function result symbol */
1152   gfc_component *components;    /* Derived type components */
1153
1154   /* Defined only for Cray pointees; points to their pointer.  */
1155   struct gfc_symbol *cp_pointer;
1156
1157   int entry_id;                 /* Used in resolve.c for entries.  */
1158
1159   /* CLASS hashed name for declared and dynamic types in the class.  */
1160   int hash_value;
1161
1162   struct gfc_symbol *common_next;       /* Links for COMMON syms */
1163
1164   /* This is in fact a gfc_common_head but it is only used for pointer
1165      comparisons to check if symbols are in the same common block.  */
1166   struct gfc_common_head* common_head;
1167
1168   /* Make sure setup code for dummy arguments is generated in the correct
1169      order.  */
1170   int dummy_order;
1171
1172   gfc_namelist *namelist, *namelist_tail;
1173
1174   /* Change management fields.  Symbols that might be modified by the
1175      current statement have the mark member nonzero and are kept in a
1176      singly linked list through the tlink field.  Of these symbols,
1177      symbols with old_symbol equal to NULL are symbols created within
1178      the current statement.  Otherwise, old_symbol points to a copy of
1179      the old symbol.  */
1180
1181   struct gfc_symbol *old_symbol, *tlink;
1182   unsigned mark:1, gfc_new:1;
1183   /* Nonzero if all equivalences associated with this symbol have been
1184      processed.  */
1185   unsigned equiv_built:1;
1186   /* Set if this variable is used as an index name in a FORALL.  */
1187   unsigned forall_index:1;
1188   int refs;
1189   struct gfc_namespace *ns;     /* namespace containing this symbol */
1190
1191   tree backend_decl;
1192
1193   /* Identity of the intrinsic module the symbol comes from, or
1194      INTMOD_NONE if it's not imported from a intrinsic module.  */
1195   intmod_id from_intmod;
1196   /* Identity of the symbol from intrinsic modules, from enums maintained
1197      separately by each intrinsic module.  Used together with from_intmod,
1198      it uniquely identifies a symbol from an intrinsic module.  */
1199   int intmod_sym_id;
1200
1201   /* This may be repetitive, since the typespec now has a binding
1202      label field.  */
1203   char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
1204   /* Store a reference to the common_block, if this symbol is in one.  */
1205   struct gfc_common_head *common_block;
1206
1207   /* Link to corresponding association-list if this is an associate name.  */
1208   struct gfc_association_list *assoc;
1209 }
1210 gfc_symbol;
1211
1212
1213 /* This structure is used to keep track of symbols in common blocks.  */
1214 typedef struct gfc_common_head
1215 {
1216   locus where;
1217   char use_assoc, saved, threadprivate;
1218   char name[GFC_MAX_SYMBOL_LEN + 1];
1219   struct gfc_symbol *head;
1220   char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
1221   int is_bind_c;
1222 }
1223 gfc_common_head;
1224
1225 #define gfc_get_common_head() XCNEW (gfc_common_head)
1226
1227
1228 /* A list of all the alternate entry points for a procedure.  */
1229
1230 typedef struct gfc_entry_list
1231 {
1232   /* The symbol for this entry point.  */
1233   gfc_symbol *sym;
1234   /* The zero-based id of this entry point.  */
1235   int id;
1236   /* The LABEL_EXPR marking this entry point.  */
1237   tree label;
1238   /* The next item in the list.  */
1239   struct gfc_entry_list *next;
1240 }
1241 gfc_entry_list;
1242
1243 #define gfc_get_entry_list() \
1244   (gfc_entry_list *) gfc_getmem(sizeof(gfc_entry_list))
1245
1246 /* Lists of rename info for the USE statement.  */
1247
1248 typedef struct gfc_use_rename
1249 {
1250   char local_name[GFC_MAX_SYMBOL_LEN + 1], use_name[GFC_MAX_SYMBOL_LEN + 1];
1251   struct gfc_use_rename *next;
1252   int found;
1253   gfc_intrinsic_op op;
1254   locus where;
1255 }
1256 gfc_use_rename;
1257
1258 #define gfc_get_use_rename() XCNEW (gfc_use_rename);
1259
1260 /* A list of all USE statements in a namespace.  */
1261
1262 typedef struct gfc_use_list
1263 {
1264   const char *module_name;
1265   int only_flag;
1266   struct gfc_use_rename *rename;
1267   locus where;
1268   /* Next USE statement.  */
1269   struct gfc_use_list *next;
1270 }
1271 gfc_use_list;
1272
1273 #define gfc_get_use_list() \
1274   (gfc_use_list *) gfc_getmem(sizeof(gfc_use_list))
1275
1276 /* Within a namespace, symbols are pointed to by symtree nodes that
1277    are linked together in a balanced binary tree.  There can be
1278    several symtrees pointing to the same symbol node via USE
1279    statements.  */
1280
1281 typedef struct gfc_symtree
1282 {
1283   BBT_HEADER (gfc_symtree);
1284   const char *name;
1285   int ambiguous;
1286   union
1287   {
1288     gfc_symbol *sym;            /* Symbol associated with this node */
1289     gfc_user_op *uop;
1290     gfc_common_head *common;
1291     gfc_typebound_proc *tb;
1292   }
1293   n;
1294 }
1295 gfc_symtree;
1296
1297 /* A linked list of derived types in the namespace.  */
1298 typedef struct gfc_dt_list
1299 {
1300   struct gfc_symbol *derived;
1301   struct gfc_dt_list *next;
1302 }
1303 gfc_dt_list;
1304
1305 #define gfc_get_dt_list() XCNEW (gfc_dt_list)
1306
1307   /* A list of all derived types.  */
1308   extern gfc_dt_list *gfc_derived_types;
1309
1310 /* A namespace describes the contents of procedure, module, interface block
1311    or BLOCK construct.  */
1312 /* ??? Anything else use these?  */
1313
1314 typedef struct gfc_namespace
1315 {
1316   /* Tree containing all the symbols in this namespace.  */
1317   gfc_symtree *sym_root;
1318   /* Tree containing all the user-defined operators in the namespace.  */
1319   gfc_symtree *uop_root;
1320   /* Tree containing all the common blocks.  */
1321   gfc_symtree *common_root;
1322
1323   /* Tree containing type-bound procedures.  */
1324   gfc_symtree *tb_sym_root;
1325   /* Type-bound user operators.  */
1326   gfc_symtree *tb_uop_root;
1327   /* For derived-types, store type-bound intrinsic operators here.  */
1328   gfc_typebound_proc *tb_op[GFC_INTRINSIC_OPS];
1329   /* Linked list of finalizer procedures.  */
1330   struct gfc_finalizer *finalizers;
1331
1332   /* If set_flag[letter] is set, an implicit type has been set for letter.  */
1333   int set_flag[GFC_LETTERS];
1334   /* Keeps track of the implicit types associated with the letters.  */
1335   gfc_typespec default_type[GFC_LETTERS];
1336   /* Store the positions of IMPLICIT statements.  */
1337   locus implicit_loc[GFC_LETTERS];
1338
1339   /* If this is a namespace of a procedure, this points to the procedure.  */
1340   struct gfc_symbol *proc_name;
1341   /* If this is the namespace of a unit which contains executable
1342      code, this points to it.  */
1343   struct gfc_code *code;
1344
1345   /* Points to the equivalences set up in this namespace.  */
1346   struct gfc_equiv *equiv;
1347
1348   /* Points to the equivalence groups produced by trans_common.  */
1349   struct gfc_equiv_list *equiv_lists;
1350
1351   gfc_interface *op[GFC_INTRINSIC_OPS];
1352
1353   /* Points to the parent namespace, i.e. the namespace of a module or
1354      procedure in which the procedure belonging to this namespace is
1355      contained. The parent namespace points to this namespace either
1356      directly via CONTAINED, or indirectly via the chain built by
1357      SIBLING.  */
1358   struct gfc_namespace *parent;
1359   /* CONTAINED points to the first contained namespace. Sibling
1360      namespaces are chained via SIBLING.  */
1361   struct gfc_namespace  *contained, *sibling;
1362
1363   gfc_common_head blank_common;
1364   gfc_access default_access, operator_access[GFC_INTRINSIC_OPS];
1365
1366   gfc_st_label *st_labels;
1367   /* This list holds information about all the data initializers in
1368      this namespace.  */
1369   struct gfc_data *data;
1370
1371   gfc_charlen *cl_list, *old_cl_list;
1372
1373   gfc_dt_list *derived_types;
1374
1375   int save_all, seen_save, seen_implicit_none;
1376
1377   /* Normally we don't need to refcount namespaces.  However when we read
1378      a module containing a function with multiple entry points, this
1379      will appear as several functions with the same formal namespace.  */
1380   int refs;
1381
1382   /* A list of all alternate entry points to this procedure (or NULL).  */
1383   gfc_entry_list *entries;
1384
1385   /* A list of USE statements in this namespace.  */
1386   gfc_use_list *use_stmts;
1387
1388   /* Set to 1 if namespace is a BLOCK DATA program unit.  */
1389   unsigned is_block_data:1;
1390
1391   /* Set to 1 if namespace is an interface body with "IMPORT" used.  */
1392   unsigned has_import_set:1;
1393
1394   /* Set to 1 if resolved has been called for this namespace.
1395      Holds -1 during resolution.  */
1396   signed resolved:2;
1397
1398   /* Set to 1 if code has been generated for this namespace.  */
1399   unsigned translated:1;
1400
1401   /* Set to 1 if symbols in this namespace should be 'construct entities',
1402      i.e. for BLOCK local variables.  */
1403   unsigned construct_entities:1;
1404 }
1405 gfc_namespace;
1406
1407 extern gfc_namespace *gfc_current_ns;
1408 extern gfc_namespace *gfc_global_ns_list;
1409
1410 /* Global symbols are symbols of global scope. Currently we only use
1411    this to detect collisions already when parsing.
1412    TODO: Extend to verify procedure calls.  */
1413
1414 enum gfc_symbol_type
1415 {
1416   GSYM_UNKNOWN=1, GSYM_PROGRAM, GSYM_FUNCTION, GSYM_SUBROUTINE,
1417   GSYM_MODULE, GSYM_COMMON, GSYM_BLOCK_DATA
1418 };
1419
1420 typedef struct gfc_gsymbol
1421 {
1422   BBT_HEADER(gfc_gsymbol);
1423
1424   const char *name;
1425   const char *sym_name;
1426   const char *mod_name;
1427   const char *binding_label;
1428   enum gfc_symbol_type type;
1429
1430   int defined, used;
1431   locus where;
1432   gfc_namespace *ns;
1433 }
1434 gfc_gsymbol;
1435
1436 extern gfc_gsymbol *gfc_gsym_root;
1437
1438 /* Information on interfaces being built.  */
1439 typedef struct
1440 {
1441   interface_type type;
1442   gfc_symbol *sym;
1443   gfc_namespace *ns;
1444   gfc_user_op *uop;
1445   gfc_intrinsic_op op;
1446 }
1447 gfc_interface_info;
1448
1449 extern gfc_interface_info current_interface;
1450
1451
1452 /* Array reference.  */
1453
1454 enum gfc_array_ref_dimen_type
1455 {
1456   DIMEN_ELEMENT = 1, DIMEN_RANGE, DIMEN_VECTOR, DIMEN_STAR, DIMEN_UNKNOWN
1457 };
1458
1459 typedef struct gfc_array_ref
1460 {
1461   ar_type type;
1462   int dimen;                    /* # of components in the reference */
1463   int codimen;
1464   bool in_allocate;             /* For coarray checks. */
1465   locus where;
1466   gfc_array_spec *as;
1467
1468   locus c_where[GFC_MAX_DIMENSIONS];    /* All expressions can be NULL */
1469   struct gfc_expr *start[GFC_MAX_DIMENSIONS], *end[GFC_MAX_DIMENSIONS],
1470     *stride[GFC_MAX_DIMENSIONS];
1471
1472   enum gfc_array_ref_dimen_type dimen_type[GFC_MAX_DIMENSIONS];
1473
1474   struct gfc_expr *offset;
1475 }
1476 gfc_array_ref;
1477
1478 #define gfc_get_array_ref() XCNEW (gfc_array_ref)
1479
1480
1481 /* Component reference nodes.  A variable is stored as an expression
1482    node that points to the base symbol.  After that, a singly linked
1483    list of component reference nodes gives the variable's complete
1484    resolution.  The array_ref component may be present and comes
1485    before the component component.  */
1486
1487 typedef enum
1488   { REF_ARRAY, REF_COMPONENT, REF_SUBSTRING }
1489 ref_type;
1490
1491 typedef struct gfc_ref
1492 {
1493   ref_type type;
1494
1495   union
1496   {
1497     struct gfc_array_ref ar;
1498
1499     struct
1500     {
1501       gfc_component *component;
1502       gfc_symbol *sym;
1503     }
1504     c;
1505
1506     struct
1507     {
1508       struct gfc_expr *start, *end;     /* Substring */
1509       gfc_charlen *length;
1510     }
1511     ss;
1512
1513   }
1514   u;
1515
1516   struct gfc_ref *next;
1517 }
1518 gfc_ref;
1519
1520 #define gfc_get_ref() XCNEW (gfc_ref)
1521
1522
1523 /* Structures representing intrinsic symbols and their arguments lists.  */
1524 typedef struct gfc_intrinsic_arg
1525 {
1526   char name[GFC_MAX_SYMBOL_LEN + 1];
1527
1528   gfc_typespec ts;
1529   int optional;
1530   ENUM_BITFIELD (sym_intent) intent:2;
1531   gfc_actual_arglist *actual;
1532
1533   struct gfc_intrinsic_arg *next;
1534
1535 }
1536 gfc_intrinsic_arg;
1537
1538
1539 /* Specifies the various kinds of check functions used to verify the
1540    argument lists of intrinsic functions. fX with X an integer refer
1541    to check functions of intrinsics with X arguments. f1m is used for
1542    the MAX and MIN intrinsics which can have an arbitrary number of
1543    arguments, f3ml is used for the MINLOC and MAXLOC intrinsics as
1544    these have special semantics.  */
1545
1546 typedef union
1547 {
1548   gfc_try (*f0)(void);
1549   gfc_try (*f1)(struct gfc_expr *);
1550   gfc_try (*f1m)(gfc_actual_arglist *);
1551   gfc_try (*f2)(struct gfc_expr *, struct gfc_expr *);
1552   gfc_try (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
1553   gfc_try (*f3ml)(gfc_actual_arglist *);
1554   gfc_try (*f3red)(gfc_actual_arglist *);
1555   gfc_try (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1556             struct gfc_expr *);
1557   gfc_try (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1558             struct gfc_expr *, struct gfc_expr *);
1559 }
1560 gfc_check_f;
1561
1562 /* Like gfc_check_f, these specify the type of the simplification
1563    function associated with an intrinsic. The fX are just like in
1564    gfc_check_f. cc is used for type conversion functions.  */
1565
1566 typedef union
1567 {
1568   struct gfc_expr *(*f0)(void);
1569   struct gfc_expr *(*f1)(struct gfc_expr *);
1570   struct gfc_expr *(*f2)(struct gfc_expr *, struct gfc_expr *);
1571   struct gfc_expr *(*f3)(struct gfc_expr *, struct gfc_expr *,
1572                          struct gfc_expr *);
1573   struct gfc_expr *(*f4)(struct gfc_expr *, struct gfc_expr *,
1574                          struct gfc_expr *, struct gfc_expr *);
1575   struct gfc_expr *(*f5)(struct gfc_expr *, struct gfc_expr *,
1576                          struct gfc_expr *, struct gfc_expr *,
1577                          struct gfc_expr *);
1578   struct gfc_expr *(*cc)(struct gfc_expr *, bt, int);
1579 }
1580 gfc_simplify_f;
1581
1582 /* Again like gfc_check_f, these specify the type of the resolution
1583    function associated with an intrinsic. The fX are just like in
1584    gfc_check_f. f1m is used for MIN and MAX, s1 is used for abort().  */
1585
1586 typedef union
1587 {
1588   void (*f0)(struct gfc_expr *);
1589   void (*f1)(struct gfc_expr *, struct gfc_expr *);
1590   void (*f1m)(struct gfc_expr *, struct gfc_actual_arglist *);
1591   void (*f2)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
1592   void (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1593              struct gfc_expr *);
1594   void (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1595              struct gfc_expr *, struct gfc_expr *);
1596   void (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
1597              struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
1598   void (*s1)(struct gfc_code *);
1599 }
1600 gfc_resolve_f;
1601
1602
1603 typedef struct gfc_intrinsic_sym
1604 {
1605   const char *name, *lib_name;
1606   gfc_intrinsic_arg *formal;
1607   gfc_typespec ts;
1608   unsigned elemental:1, inquiry:1, transformational:1, pure:1,
1609     generic:1, specific:1, actual_ok:1, noreturn:1, conversion:1;
1610
1611   int standard;
1612
1613   gfc_simplify_f simplify;
1614   gfc_check_f check;
1615   gfc_resolve_f resolve;
1616   struct gfc_intrinsic_sym *specific_head, *next;
1617   gfc_isym_id id;
1618
1619 }
1620 gfc_intrinsic_sym;
1621
1622
1623 /* Expression nodes.  The expression node types deserve explanations,
1624    since the last couple can be easily misconstrued:
1625
1626    EXPR_OP         Operator node pointing to one or two other nodes
1627    EXPR_FUNCTION   Function call, symbol points to function's name
1628    EXPR_CONSTANT   A scalar constant: Logical, String, Real, Int or Complex
1629    EXPR_VARIABLE   An Lvalue with a root symbol and possible reference list
1630                    which expresses structure, array and substring refs.
1631    EXPR_NULL       The NULL pointer value (which also has a basic type).
1632    EXPR_SUBSTRING  A substring of a constant string
1633    EXPR_STRUCTURE  A structure constructor
1634    EXPR_ARRAY      An array constructor.
1635    EXPR_COMPCALL   Function (or subroutine) call of a procedure pointer
1636                    component or type-bound procedure.  */
1637
1638 #include <gmp.h>
1639 #include <mpfr.h>
1640 #include <mpc.h>
1641 #define GFC_RND_MODE GMP_RNDN
1642 #define GFC_MPC_RND_MODE MPC_RNDNN
1643
1644 typedef splay_tree gfc_constructor_base;
1645
1646 typedef struct gfc_expr
1647 {
1648   expr_t expr_type;
1649
1650   gfc_typespec ts;      /* These two refer to the overall expression */
1651
1652   int rank;
1653   mpz_t *shape;         /* Can be NULL if shape is unknown at compile time */
1654
1655   /* Nonnull for functions and structure constructors, may also used to hold the
1656      base-object for component calls.  */
1657   gfc_symtree *symtree;
1658
1659   gfc_ref *ref;
1660
1661   locus where;
1662
1663   /* True if the expression is a call to a function that returns an array,
1664      and if we have decided not to allocate temporary data for that array.
1665      is_boz is true if the integer is regarded as BOZ bitpatten and is_snan
1666      denotes a signalling not-a-number.  */
1667   unsigned int inline_noncopying_intrinsic : 1, is_boz : 1, is_snan : 1;
1668
1669   /* Sometimes, when an error has been emitted, it is necessary to prevent
1670       it from recurring.  */
1671   unsigned int error : 1;
1672
1673   /* Mark an expression where a user operator has been substituted by
1674      a function call in interface.c(gfc_extend_expr).  */
1675   unsigned int user_operator : 1;
1676
1677   /* Mark an expression as being a MOLD argument of ALLOCATE.  */
1678   unsigned int mold : 1;
1679
1680   /* If an expression comes from a Hollerith constant or compile-time
1681      evaluation of a transfer statement, it may have a prescribed target-
1682      memory representation, and these cannot always be backformed from
1683      the value.  */
1684   struct
1685   {
1686     int length;
1687     char *string;
1688   }
1689   representation;
1690
1691   union
1692   {
1693     int logical;
1694
1695     io_kind iokind;
1696
1697     mpz_t integer;
1698
1699     mpfr_t real;
1700
1701     mpc_t complex;
1702
1703     struct
1704     {
1705       gfc_intrinsic_op op;
1706       gfc_user_op *uop;
1707       struct gfc_expr *op1, *op2;
1708     }
1709     op;
1710
1711     struct
1712     {
1713       gfc_actual_arglist *actual;
1714       const char *name; /* Points to the ultimate name of the function */
1715       gfc_intrinsic_sym *isym;
1716       gfc_symbol *esym;
1717     }
1718     function;
1719
1720     struct
1721     {
1722       gfc_actual_arglist* actual;
1723       const char* name;
1724       /* Base-object, whose component was called.  NULL means that it should
1725          be taken from symtree/ref.  */
1726       struct gfc_expr* base_object;
1727       gfc_typebound_proc* tbp; /* Should overlap with esym.  */
1728
1729       /* For type-bound operators, we want to call PASS procedures but already
1730          have the full arglist; mark this, so that it is not extended by the
1731          PASS argument.  */
1732       unsigned ignore_pass:1;
1733
1734       /* Do assign-calls rather than calls, that is appropriate dependency
1735          checking.  */
1736       unsigned assign:1;
1737     }
1738     compcall;
1739
1740     struct
1741     {
1742       int length;
1743       gfc_char_t *string;
1744     }
1745     character;
1746
1747     gfc_constructor_base constructor;
1748   }
1749   value;
1750
1751 }
1752 gfc_expr;
1753
1754
1755 #define gfc_get_shape(rank) ((mpz_t *) gfc_getmem((rank)*sizeof(mpz_t)))
1756
1757 /* Structures for information associated with different kinds of
1758    numbers.  The first set of integer parameters define all there is
1759    to know about a particular kind.  The rest of the elements are
1760    computed from the first elements.  */
1761
1762 typedef struct
1763 {
1764   /* Values really representable by the target.  */
1765   mpz_t huge, pedantic_min_int, min_int;
1766
1767   int kind, radix, digits, bit_size, range;
1768
1769   /* True if the C type of the given name maps to this precision.
1770      Note that more than one bit can be set.  */
1771   unsigned int c_char : 1;
1772   unsigned int c_short : 1;
1773   unsigned int c_int : 1;
1774   unsigned int c_long : 1;
1775   unsigned int c_long_long : 1;
1776 }
1777 gfc_integer_info;
1778
1779 extern gfc_integer_info gfc_integer_kinds[];
1780
1781
1782 typedef struct
1783 {
1784   int kind, bit_size;
1785
1786   /* True if the C++ type bool, C99 type _Bool, maps to this precision.  */
1787   unsigned int c_bool : 1;
1788 }
1789 gfc_logical_info;
1790
1791 extern gfc_logical_info gfc_logical_kinds[];
1792
1793
1794 typedef struct
1795 {
1796   mpfr_t epsilon, huge, tiny, subnormal;
1797   int kind, radix, digits, min_exponent, max_exponent;
1798   int range, precision;
1799
1800   /* The precision of the type as reported by GET_MODE_PRECISION.  */
1801   int mode_precision;
1802
1803   /* True if the C type of the given name maps to this precision.
1804      Note that more than one bit can be set.  */
1805   unsigned int c_float : 1;
1806   unsigned int c_double : 1;
1807   unsigned int c_long_double : 1;
1808 }
1809 gfc_real_info;
1810
1811 extern gfc_real_info gfc_real_kinds[];
1812
1813 typedef struct
1814 {
1815   int kind, bit_size;
1816   const char *name;
1817 }
1818 gfc_character_info;
1819
1820 extern gfc_character_info gfc_character_kinds[];
1821
1822
1823 /* Equivalence structures.  Equivalent lvalues are linked along the
1824    *eq pointer, equivalence sets are strung along the *next node.  */
1825 typedef struct gfc_equiv
1826 {
1827   struct gfc_equiv *next, *eq;
1828   gfc_expr *expr;
1829   const char *module;
1830   int used;
1831 }
1832 gfc_equiv;
1833
1834 #define gfc_get_equiv() XCNEW (gfc_equiv)
1835
1836 /* Holds a single equivalence member after processing.  */
1837 typedef struct gfc_equiv_info
1838 {
1839   gfc_symbol *sym;
1840   HOST_WIDE_INT offset;
1841   HOST_WIDE_INT length;
1842   struct gfc_equiv_info *next;
1843 } gfc_equiv_info;
1844
1845 /* Holds equivalence groups, after they have been processed.  */
1846 typedef struct gfc_equiv_list
1847 {
1848   gfc_equiv_info *equiv;
1849   struct gfc_equiv_list *next;
1850 } gfc_equiv_list;
1851
1852 /* gfc_case stores the selector list of a case statement.  The *low
1853    and *high pointers can point to the same expression in the case of
1854    a single value.  If *high is NULL, the selection is from *low
1855    upwards, if *low is NULL the selection is *high downwards.
1856
1857    This structure has separate fields to allow single and double linked
1858    lists of CASEs at the same time.  The singe linked list along the NEXT
1859    field is a list of cases for a single CASE label.  The double linked
1860    list along the LEFT/RIGHT fields is used to detect overlap and to
1861    build a table of the cases for SELECT constructs with a CHARACTER
1862    case expression.  */
1863
1864 typedef struct gfc_case
1865 {
1866   /* Where we saw this case.  */
1867   locus where;
1868   int n;
1869
1870   /* Case range values.  If (low == high), it's a single value.  If one of
1871      the labels is NULL, it's an unbounded case.  If both are NULL, this
1872      represents the default case.  */
1873   gfc_expr *low, *high;
1874
1875   /* Only used for SELECT TYPE.  */
1876   gfc_typespec ts;
1877
1878   /* Next case label in the list of cases for a single CASE label.  */
1879   struct gfc_case *next;
1880
1881   /* Used for detecting overlap, and for code generation.  */
1882   struct gfc_case *left, *right;
1883
1884   /* True if this case label can never be matched.  */
1885   int unreachable;
1886 }
1887 gfc_case;
1888
1889 #define gfc_get_case() XCNEW (gfc_case)
1890
1891
1892 typedef struct
1893 {
1894   gfc_expr *var, *start, *end, *step;
1895 }
1896 gfc_iterator;
1897
1898 #define gfc_get_iterator() XCNEW (gfc_iterator)
1899
1900
1901 /* Allocation structure for ALLOCATE, DEALLOCATE and NULLIFY statements.  */
1902
1903 typedef struct gfc_alloc
1904 {
1905   gfc_expr *expr;
1906   struct gfc_alloc *next;
1907 }
1908 gfc_alloc;
1909
1910 #define gfc_get_alloc() XCNEW (gfc_alloc)
1911
1912
1913 typedef struct
1914 {
1915   gfc_expr *unit, *file, *status, *access, *form, *recl,
1916     *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert,
1917     *decimal, *encoding, *round, *sign, *asynchronous, *id, *newunit;
1918   gfc_st_label *err;
1919 }
1920 gfc_open;
1921
1922
1923 typedef struct
1924 {
1925   gfc_expr *unit, *status, *iostat, *iomsg;
1926   gfc_st_label *err;
1927 }
1928 gfc_close;
1929
1930
1931 typedef struct
1932 {
1933   gfc_expr *unit, *iostat, *iomsg;
1934   gfc_st_label *err;
1935 }
1936 gfc_filepos;
1937
1938
1939 typedef struct
1940 {
1941   gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
1942     *name, *access, *sequential, *direct, *form, *formatted,
1943     *unformatted, *recl, *nextrec, *blank, *position, *action, *read,
1944     *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos,
1945     *asynchronous, *decimal, *encoding, *pending, *round, *sign, *size, *id;
1946
1947   gfc_st_label *err;
1948
1949 }
1950 gfc_inquire;
1951
1952
1953 typedef struct
1954 {
1955   gfc_expr *unit, *iostat, *iomsg, *id;
1956   gfc_st_label *err, *end, *eor;
1957 }
1958 gfc_wait;
1959
1960
1961 typedef struct
1962 {
1963   gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg,
1964            *id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round,
1965            *sign, *extra_comma;
1966
1967   gfc_symbol *namelist;
1968   /* A format_label of `format_asterisk' indicates the "*" format */
1969   gfc_st_label *format_label;
1970   gfc_st_label *err, *end, *eor;
1971
1972   locus eor_where, end_where, err_where;
1973 }
1974 gfc_dt;
1975
1976
1977 typedef struct gfc_forall_iterator
1978 {
1979   gfc_expr *var, *start, *end, *stride;
1980   struct gfc_forall_iterator *next;
1981 }
1982 gfc_forall_iterator;
1983
1984
1985 /* Linked list to store associations in an ASSOCIATE statement.  */
1986
1987 typedef struct gfc_association_list
1988 {
1989   struct gfc_association_list *next;
1990
1991   /* Whether this is association to a variable that can be changed; otherwise,
1992      it's association to an expression and the name may not be used as
1993      lvalue.  */
1994   unsigned variable:1;
1995
1996   char name[GFC_MAX_SYMBOL_LEN + 1];
1997   gfc_symtree *st; /* Symtree corresponding to name.  */
1998   gfc_expr *target;
1999 }
2000 gfc_association_list;
2001 #define gfc_get_association_list() XCNEW (gfc_association_list)
2002
2003
2004 /* Executable statements that fill gfc_code structures.  */
2005 typedef enum
2006 {
2007   EXEC_NOP = 1, EXEC_END_BLOCK, EXEC_ASSIGN, EXEC_LABEL_ASSIGN,
2008   EXEC_POINTER_ASSIGN, EXEC_CRITICAL, EXEC_ERROR_STOP,
2009   EXEC_GOTO, EXEC_CALL, EXEC_COMPCALL, EXEC_ASSIGN_CALL, EXEC_RETURN,
2010   EXEC_ENTRY, EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE, EXEC_INIT_ASSIGN,
2011   EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT, EXEC_BLOCK,
2012   EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT, EXEC_CALL_PPC,
2013   EXEC_ALLOCATE, EXEC_DEALLOCATE, EXEC_END_PROCEDURE, EXEC_SELECT_TYPE,
2014   EXEC_SYNC_ALL, EXEC_SYNC_MEMORY, EXEC_SYNC_IMAGES,
2015   EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT,
2016   EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
2017   EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
2018   EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
2019   EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
2020   EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
2021   EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
2022   EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
2023   EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT
2024 }
2025 gfc_exec_op;
2026
2027 typedef struct gfc_code
2028 {
2029   gfc_exec_op op;
2030
2031   struct gfc_code *block, *next;
2032   locus loc;
2033
2034   gfc_st_label *here, *label1, *label2, *label3;
2035   gfc_symtree *symtree;
2036   gfc_expr *expr1, *expr2, *expr3;
2037   /* A name isn't sufficient to identify a subroutine, we need the actual
2038      symbol for the interface definition.
2039   const char *sub_name;  */
2040   gfc_symbol *resolved_sym;
2041   gfc_intrinsic_sym *resolved_isym;
2042
2043   union
2044   {
2045     gfc_actual_arglist *actual;
2046     gfc_case *case_list;
2047     gfc_iterator *iterator;
2048
2049     struct
2050     {
2051       gfc_typespec ts;
2052       gfc_alloc *list;
2053     }
2054     alloc;
2055
2056     struct
2057     {
2058       gfc_namespace *ns;
2059       gfc_association_list *assoc;
2060     }
2061     block;
2062
2063     gfc_open *open;
2064     gfc_close *close;
2065     gfc_filepos *filepos;
2066     gfc_inquire *inquire;
2067     gfc_wait *wait;
2068     gfc_dt *dt;
2069     gfc_forall_iterator *forall_iterator;
2070     struct gfc_code *whichloop;
2071     int stop_code;
2072     gfc_entry_list *entry;
2073     gfc_omp_clauses *omp_clauses;
2074     const char *omp_name;
2075     gfc_namelist *omp_namelist;
2076     bool omp_bool;
2077   }
2078   ext;          /* Points to additional structures required by statement */
2079
2080   /* Cycle and break labels in do loops.  */
2081   tree cycle_label;
2082   tree exit_label;
2083 }
2084 gfc_code;
2085
2086
2087 /* Storage for DATA statements.  */
2088 typedef struct gfc_data_variable
2089 {
2090   gfc_expr *expr;
2091   gfc_iterator iter;
2092   struct gfc_data_variable *list, *next;
2093 }
2094 gfc_data_variable;
2095
2096
2097 typedef struct gfc_data_value
2098 {
2099   mpz_t repeat;
2100   gfc_expr *expr;
2101   struct gfc_data_value *next;
2102 }
2103 gfc_data_value;
2104
2105
2106 typedef struct gfc_data
2107 {
2108   gfc_data_variable *var;
2109   gfc_data_value *value;
2110   locus where;
2111
2112   struct gfc_data *next;
2113 }
2114 gfc_data;
2115
2116
2117 /* Structure for holding compile options */
2118 typedef struct
2119 {
2120   char *module_dir;
2121   gfc_source_form source_form;
2122   /* Maximum line lengths in fixed- and free-form source, respectively.
2123      When fixed_line_length or free_line_length are 0, the whole line is used,
2124      regardless of length.
2125
2126      If the user requests a fixed_line_length <7 then gfc_init_options()
2127      emits a fatal error.  */
2128   int fixed_line_length;
2129   int free_line_length;
2130   /* Maximum number of continuation lines in fixed- and free-form source,
2131      respectively.  */
2132   int max_continue_fixed;
2133   int max_continue_free;
2134   int max_identifier_length;
2135   int dump_parse_tree;
2136
2137   int warn_aliasing;
2138   int warn_ampersand;
2139   int warn_conversion;
2140   int warn_conversion_extra;
2141   int warn_implicit_interface;
2142   int warn_implicit_procedure;
2143   int warn_line_truncation;
2144   int warn_surprising;
2145   int warn_tabs;
2146   int warn_underflow;
2147   int warn_intrinsic_shadow;
2148   int warn_intrinsics_std;
2149   int warn_character_truncation;
2150   int warn_array_temp;
2151   int warn_align_commons;
2152   int warn_unused_dummy_argument;
2153   int max_errors;
2154
2155   int flag_all_intrinsics;
2156   int flag_default_double;
2157   int flag_default_integer;
2158   int flag_default_real;
2159   int flag_dollar_ok;
2160   int flag_underscoring;
2161   int flag_second_underscore;
2162   int flag_implicit_none;
2163   int flag_max_stack_var_size;
2164   int flag_max_array_constructor;
2165   int flag_range_check;
2166   int flag_pack_derived;
2167   int flag_repack_arrays;
2168   int flag_preprocessed;
2169   int flag_f2c;
2170   int flag_automatic;
2171   int flag_backslash;
2172   int flag_backtrace;
2173   int flag_allow_leading_underscore;
2174   int flag_dump_core;
2175   int flag_external_blas;
2176   int blas_matmul_limit;
2177   int flag_cray_pointer;
2178   int flag_d_lines;
2179   int flag_openmp;
2180   int flag_sign_zero;
2181   int flag_module_private;
2182   int flag_recursive;
2183   int flag_init_local_zero;
2184   int flag_init_integer;
2185   int flag_init_integer_value;
2186   int flag_init_real;
2187   int flag_init_logical;
2188   int flag_init_character;
2189   char flag_init_character_value;
2190   int flag_align_commons;
2191   int flag_whole_file;
2192   int flag_protect_parens;
2193
2194   int fpe;
2195   int rtcheck;
2196   gfc_fcoarray coarray;
2197
2198   int warn_std;
2199   int allow_std;
2200   int convert;
2201   int record_marker;
2202   int max_subrecord_length;
2203 }
2204 gfc_option_t;
2205
2206 extern gfc_option_t gfc_option;
2207
2208 /* Constructor nodes for array and structure constructors.  */
2209 typedef struct gfc_constructor
2210 {
2211   gfc_constructor_base base;
2212   mpz_t offset;               /* Offset within a constructor, used as
2213                                  key within base. */
2214
2215   gfc_expr *expr;
2216   gfc_iterator *iterator;
2217   locus where;
2218
2219   union
2220   {
2221      gfc_component *component; /* Record the component being initialized.  */
2222   }
2223   n;
2224 }
2225 gfc_constructor;
2226
2227
2228 typedef struct iterator_stack
2229 {
2230   gfc_symtree *variable;
2231   mpz_t value;
2232   struct iterator_stack *prev;
2233 }
2234 iterator_stack;
2235 extern iterator_stack *iter_stack;
2236
2237
2238 /* Used for (possibly nested) SELECT TYPE statements.  */
2239 typedef struct gfc_select_type_stack
2240 {
2241   gfc_symbol *selector;                 /* Current selector variable.  */
2242   gfc_symtree *tmp;                     /* Current temporary variable.  */
2243   struct gfc_select_type_stack *prev;   /* Previous element on stack.  */
2244 }
2245 gfc_select_type_stack;
2246 extern gfc_select_type_stack *select_type_stack;
2247 #define gfc_get_select_type_stack() XCNEW (gfc_select_type_stack)
2248
2249
2250 /* Node in the linked list used for storing finalizer procedures.  */
2251
2252 typedef struct gfc_finalizer
2253 {
2254   struct gfc_finalizer* next;
2255   locus where; /* Where the FINAL declaration occurred.  */
2256
2257   /* Up to resolution, we want the gfc_symbol, there we lookup the corresponding
2258      symtree and later need only that.  This way, we can access and call the
2259      finalizers from every context as they should be "always accessible".  I
2260      don't make this a union because we need the information whether proc_sym is
2261      still referenced or not for dereferencing it on deleting a gfc_finalizer
2262      structure.  */
2263   gfc_symbol*  proc_sym;
2264   gfc_symtree* proc_tree;
2265 }
2266 gfc_finalizer;
2267 #define gfc_get_finalizer() XCNEW (gfc_finalizer)
2268
2269
2270 /************************ Function prototypes *************************/
2271
2272 /* decl.c */
2273 bool gfc_in_match_data (void);
2274 match gfc_match_char_spec (gfc_typespec *);
2275
2276 /* scanner.c */
2277 void gfc_scanner_done_1 (void);
2278 void gfc_scanner_init_1 (void);
2279
2280 void gfc_add_include_path (const char *, bool, bool);
2281 void gfc_add_intrinsic_modules_path (const char *);
2282 void gfc_release_include_path (void);
2283 FILE *gfc_open_included_file (const char *, bool, bool);
2284 FILE *gfc_open_intrinsic_module (const char *);
2285
2286 int gfc_at_end (void);
2287 int gfc_at_eof (void);
2288 int gfc_at_bol (void);
2289 int gfc_at_eol (void);
2290 void gfc_advance_line (void);
2291 int gfc_check_include (void);
2292 int gfc_define_undef_line (void);
2293
2294 int gfc_wide_is_printable (gfc_char_t);
2295 int gfc_wide_is_digit (gfc_char_t);
2296 int gfc_wide_fits_in_byte (gfc_char_t);
2297 gfc_char_t gfc_wide_tolower (gfc_char_t);
2298 gfc_char_t gfc_wide_toupper (gfc_char_t);
2299 size_t gfc_wide_strlen (const gfc_char_t *);
2300 int gfc_wide_strncasecmp (const gfc_char_t *, const char *, size_t);
2301 gfc_char_t *gfc_wide_memset (gfc_char_t *, gfc_char_t, size_t);
2302 char *gfc_widechar_to_char (const gfc_char_t *, int);
2303 gfc_char_t *gfc_char_to_widechar (const char *);
2304
2305 #define gfc_get_wide_string(n) XCNEWVEC (gfc_char_t, n)
2306
2307 void gfc_skip_comments (void);
2308 gfc_char_t gfc_next_char_literal (int);
2309 gfc_char_t gfc_next_char (void);
2310 char gfc_next_ascii_char (void);
2311 gfc_char_t gfc_peek_char (void);
2312 char gfc_peek_ascii_char (void);
2313 void gfc_error_recovery (void);
2314 void gfc_gobble_whitespace (void);
2315 gfc_try gfc_new_file (void);
2316 const char * gfc_read_orig_filename (const char *, const char **);
2317
2318 extern gfc_source_form gfc_current_form;
2319 extern const char *gfc_source_file;
2320 extern locus gfc_current_locus;
2321
2322 void gfc_start_source_files (void);
2323 void gfc_end_source_files (void);
2324
2325 /* misc.c */
2326 void *gfc_getmem (size_t) ATTRIBUTE_MALLOC;
2327 void gfc_free (void *);
2328 int gfc_terminal_width (void);
2329 void gfc_clear_ts (gfc_typespec *);
2330 FILE *gfc_open_file (const char *);
2331 const char *gfc_basic_typename (bt);
2332 const char *gfc_typename (gfc_typespec *);
2333 const char *gfc_op2string (gfc_intrinsic_op);
2334 const char *gfc_code2string (const mstring *, int);
2335 int gfc_string2code (const mstring *, const char *);
2336 const char *gfc_intent_string (sym_intent);
2337
2338 void gfc_init_1 (void);
2339 void gfc_init_2 (void);
2340 void gfc_done_1 (void);
2341 void gfc_done_2 (void);
2342
2343 int get_c_kind (const char *, CInteropKind_t *);
2344
2345 /* options.c */
2346 unsigned int gfc_init_options (unsigned int, const char **);
2347 int gfc_handle_option (size_t, const char *, int, int);
2348 bool gfc_post_options (const char **);
2349
2350 /* f95-lang.c */
2351 void gfc_maybe_initialize_eh (void);
2352
2353 /* iresolve.c */
2354 const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
2355 bool gfc_find_sym_in_expr (gfc_symbol *, gfc_expr *);
2356
2357 /* error.c */
2358
2359 typedef struct gfc_error_buf
2360 {
2361   int flag;
2362   size_t allocated, index;
2363   char *message;
2364 } gfc_error_buf;
2365
2366 void gfc_error_init_1 (void);
2367 void gfc_buffer_error (int);
2368
2369 const char *gfc_print_wide_char (gfc_char_t);
2370
2371 void gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
2372 void gfc_warning_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
2373 void gfc_clear_warning (void);
2374 void gfc_warning_check (void);
2375
2376 void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
2377 void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
2378 void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
2379 void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
2380 void gfc_clear_error (void);
2381 int gfc_error_check (void);
2382 int gfc_error_flag_test (void);
2383
2384 notification gfc_notification_std (int);
2385 gfc_try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
2386
2387 /* A general purpose syntax error.  */
2388 #define gfc_syntax_error(ST)    \
2389   gfc_error ("Syntax error in %s statement at %C", gfc_ascii_statement (ST));
2390
2391 void gfc_push_error (gfc_error_buf *);
2392 void gfc_pop_error (gfc_error_buf *);
2393 void gfc_free_error (gfc_error_buf *);
2394
2395 void gfc_get_errors (int *, int *);
2396 void gfc_errors_to_warnings (int);
2397
2398 /* arith.c */
2399 void gfc_arith_init_1 (void);
2400 void gfc_arith_done_1 (void);
2401 arith gfc_check_integer_range (mpz_t p, int kind);
2402 bool gfc_check_character_range (gfc_char_t, int);
2403
2404 /* trans-types.c */
2405 gfc_try gfc_check_any_c_kind (gfc_typespec *);
2406 int gfc_validate_kind (bt, int, bool);
2407 int gfc_get_int_kind_from_width_isofortranenv (int size);
2408 int gfc_get_real_kind_from_width_isofortranenv (int size);
2409 tree gfc_get_derived_type (gfc_symbol * derived);
2410 extern int gfc_index_integer_kind;
2411 extern int gfc_default_integer_kind;
2412 extern int gfc_max_integer_kind;
2413 extern int gfc_default_real_kind;
2414 extern int gfc_default_double_kind;
2415 extern int gfc_default_character_kind;
2416 extern int gfc_default_logical_kind;
2417 extern int gfc_default_complex_kind;
2418 extern int gfc_c_int_kind;
2419 extern int gfc_intio_kind;
2420 extern int gfc_charlen_int_kind;
2421 extern int gfc_numeric_storage_size;
2422 extern int gfc_character_storage_size;
2423
2424 /* symbol.c */
2425 void gfc_clear_new_implicit (void);
2426 gfc_try gfc_add_new_implicit_range (int, int);
2427 gfc_try gfc_merge_new_implicit (gfc_typespec *);
2428 void gfc_set_implicit_none (void);
2429 void gfc_check_function_type (gfc_namespace *);
2430 bool gfc_is_intrinsic_typename (const char *);
2431
2432 gfc_typespec *gfc_get_default_type (const char *, gfc_namespace *);
2433 gfc_try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
2434
2435 void gfc_set_sym_referenced (gfc_symbol *);
2436
2437 gfc_try gfc_add_attribute (symbol_attribute *, locus *);
2438 gfc_try gfc_add_ext_attribute (symbol_attribute *, ext_attr_id_t, locus *);
2439 gfc_try gfc_add_allocatable (symbol_attribute *, locus *);
2440 gfc_try gfc_add_codimension (symbol_attribute *, const char *, locus *);
2441 gfc_try gfc_add_contiguous (symbol_attribute *, const char *, locus *);
2442 gfc_try gfc_add_dimension (symbol_attribute *, const char *, locus *);
2443 gfc_try gfc_add_external (symbol_attribute *, locus *);
2444 gfc_try gfc_add_intrinsic (symbol_attribute *, locus *);
2445 gfc_try gfc_add_optional (symbol_attribute *, locus *);
2446 gfc_try gfc_add_pointer (symbol_attribute *, locus *);
2447 gfc_try gfc_add_cray_pointer (symbol_attribute *, locus *);
2448 gfc_try gfc_add_cray_pointee (symbol_attribute *, locus *);
2449 match gfc_mod_pointee_as (gfc_array_spec *);
2450 gfc_try gfc_add_protected (symbol_attribute *, const char *, locus *);
2451 gfc_try gfc_add_result (symbol_attribute *, const char *, locus *);
2452 gfc_try gfc_add_save (symbol_attribute *, const char *, locus *);
2453 gfc_try gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
2454 gfc_try gfc_add_saved_common (symbol_attribute *, locus *);
2455 gfc_try gfc_add_target (symbol_attribute *, locus *);
2456 gfc_try gfc_add_dummy (symbol_attribute *, const char *, locus *);
2457 gfc_try gfc_add_generic (symbol_attribute *, const char *, locus *);
2458 gfc_try gfc_add_common (symbol_attribute *, locus *);
2459 gfc_try gfc_add_in_common (symbol_attribute *, const char *, locus *);
2460 gfc_try gfc_add_in_equivalence (symbol_attribute *, const char *, locus *);
2461 gfc_try gfc_add_data (symbol_attribute *, const char *, locus *);
2462 gfc_try gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
2463 gfc_try gfc_add_sequence (symbol_attribute *, const char *, locus *);
2464 gfc_try gfc_add_elemental (symbol_attribute *, locus *);
2465 gfc_try gfc_add_pure (symbol_attribute *, locus *);
2466 gfc_try gfc_add_recursive (symbol_attribute *, locus *);
2467 gfc_try gfc_add_function (symbol_attribute *, const char *, locus *);
2468 gfc_try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
2469 gfc_try gfc_add_volatile (symbol_attribute *, const char *, locus *);
2470 gfc_try gfc_add_asynchronous (symbol_attribute *, const char *, locus *);
2471 gfc_try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where);
2472 gfc_try gfc_add_abstract (symbol_attribute* attr, locus* where);
2473
2474 gfc_try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
2475 gfc_try gfc_add_is_bind_c (symbol_attribute *, const char *, locus *, int);
2476 gfc_try gfc_add_extension (symbol_attribute *, locus *);
2477 gfc_try gfc_add_value (symbol_attribute *, const char *, locus *);
2478 gfc_try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
2479 gfc_try gfc_add_entry (symbol_attribute *, const char *, locus *);
2480 gfc_try gfc_add_procedure (symbol_attribute *, procedure_type,
2481                        const char *, locus *);
2482 gfc_try gfc_add_intent (symbol_attribute *, sym_intent, locus *);
2483 gfc_try gfc_add_explicit_interface (gfc_symbol *, ifsrc,
2484                                 gfc_formal_arglist *, locus *);
2485 gfc_try gfc_add_type (gfc_symbol *, gfc_typespec *, locus *);
2486
2487 void gfc_clear_attr (symbol_attribute *);
2488 gfc_try gfc_missing_attr (symbol_attribute *, locus *);
2489 gfc_try gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *);
2490
2491 gfc_try gfc_add_component (gfc_symbol *, const char *, gfc_component **);
2492 gfc_symbol *gfc_use_derived (gfc_symbol *);
2493 gfc_symtree *gfc_use_derived_tree (gfc_symtree *);
2494 gfc_component *gfc_find_component (gfc_symbol *, const char *, bool, bool);
2495
2496 gfc_st_label *gfc_get_st_label (int);
2497 void gfc_free_st_label (gfc_st_label *);
2498 void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *);
2499 gfc_try gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
2500
2501 gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
2502
2503 gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
2504 gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
2505 gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
2506 void gfc_delete_symtree (gfc_symtree **, const char *);
2507 gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
2508 gfc_user_op *gfc_get_uop (const char *);
2509 gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
2510 void gfc_free_symbol (gfc_symbol *);
2511 gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
2512 int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
2513 int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
2514 int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **);
2515 gfc_try verify_c_interop (gfc_typespec *);
2516 gfc_try verify_c_interop_param (gfc_symbol *);
2517 gfc_try verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
2518 gfc_try verify_bind_c_derived_type (gfc_symbol *);
2519 gfc_try verify_com_block_vars_c_interop (gfc_common_head *);
2520 void generate_isocbinding_symbol (const char *, iso_c_binding_symbol, const char *);
2521 gfc_symbol *get_iso_c_sym (gfc_symbol *, char *, char *, int);
2522 int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool);
2523 int gfc_get_ha_symbol (const char *, gfc_symbol **);
2524 int gfc_get_ha_sym_tree (const char *, gfc_symtree **);
2525
2526 int gfc_symbols_could_alias (gfc_symbol *, gfc_symbol *);
2527
2528 void gfc_undo_symbols (void);
2529 void gfc_commit_symbols (void);
2530 void gfc_commit_symbol (gfc_symbol *);
2531 gfc_charlen *gfc_new_charlen (gfc_namespace *, gfc_charlen *);
2532 void gfc_free_charlen (gfc_charlen *, gfc_charlen *);
2533 void gfc_free_namespace (gfc_namespace *);
2534
2535 void gfc_symbol_init_2 (void);
2536 void gfc_symbol_done_2 (void);
2537
2538 void gfc_traverse_symtree (gfc_symtree *, void (*)(gfc_symtree *));
2539 void gfc_traverse_ns (gfc_namespace *, void (*)(gfc_symbol *));
2540 void gfc_traverse_user_op (gfc_namespace *, void (*)(gfc_user_op *));
2541 void gfc_save_all (gfc_namespace *);
2542
2543 void gfc_symbol_state (void);
2544 void gfc_free_dt_list (void);
2545
2546
2547 gfc_gsymbol *gfc_get_gsymbol (const char *);
2548 gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
2549
2550 gfc_typebound_proc* gfc_get_typebound_proc (gfc_typebound_proc*);
2551 gfc_symbol* gfc_get_derived_super_type (gfc_symbol*);
2552 gfc_symbol* gfc_get_ultimate_derived_super_type (gfc_symbol*);
2553 bool gfc_type_is_extension_of (gfc_symbol *, gfc_symbol *);
2554 bool gfc_type_compatible (gfc_typespec *, gfc_typespec *);
2555
2556 void gfc_copy_formal_args (gfc_symbol *, gfc_symbol *);
2557 void gfc_copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *);
2558 void gfc_copy_formal_args_ppc (gfc_component *, gfc_symbol *);
2559
2560 void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too  */
2561
2562 gfc_try gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
2563
2564 /* intrinsic.c -- true if working in an init-expr, false otherwise.  */
2565 extern bool gfc_init_expr_flag;
2566
2567 /* Given a symbol that we have decided is intrinsic, mark it as such
2568    by placing it into a special module that is otherwise impossible to
2569    read or write.  */
2570
2571 #define gfc_intrinsic_symbol(SYM) SYM->module = gfc_get_string ("(intrinsic)")
2572
2573 void gfc_intrinsic_init_1 (void);
2574 void gfc_intrinsic_done_1 (void);
2575
2576 char gfc_type_letter (bt);
2577 gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *);
2578 gfc_try gfc_convert_type (gfc_expr *, gfc_typespec *, int);
2579 gfc_try gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int);
2580 gfc_try gfc_convert_chartype (gfc_expr *, gfc_typespec *);
2581 int gfc_generic_intrinsic (const char *);
2582 int gfc_specific_intrinsic (const char *);
2583 bool gfc_is_intrinsic (gfc_symbol*, int, locus);
2584 int gfc_intrinsic_actual_ok (const char *, const bool);
2585 gfc_intrinsic_sym *gfc_find_function (const char *);
2586 gfc_intrinsic_sym *gfc_find_subroutine (const char *);
2587
2588 match gfc_intrinsic_func_interface (gfc_expr *, int);
2589 match gfc_intrinsic_sub_interface (gfc_code *, int);
2590
2591 void gfc_warn_intrinsic_shadow (const gfc_symbol*, bool, bool);
2592 gfc_try gfc_check_intrinsic_standard (const gfc_intrinsic_sym*, const char**,
2593                                       bool, locus);
2594
2595 /* match.c -- FIXME */
2596 void gfc_free_iterator (gfc_iterator *, int);
2597 void gfc_free_forall_iterator (gfc_forall_iterator *);
2598 void gfc_free_alloc_list (gfc_alloc *);
2599 void gfc_free_namelist (gfc_namelist *);
2600 void gfc_free_equiv (gfc_equiv *);
2601 void gfc_free_data (gfc_data *);
2602 void gfc_free_case_list (gfc_case *);
2603
2604 /* matchexp.c -- FIXME too?  */
2605 gfc_expr *gfc_get_parentheses (gfc_expr *);
2606
2607 /* openmp.c */
2608 void gfc_free_omp_clauses (gfc_omp_clauses *);
2609 void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
2610 void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *);
2611 void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
2612 void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
2613
2614 /* expr.c */
2615 void gfc_free_actual_arglist (gfc_actual_arglist *);
2616 gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
2617 const char *gfc_extract_int (gfc_expr *, int *);
2618 bool is_subref_array (gfc_expr *);
2619 bool gfc_is_simply_contiguous (gfc_expr *, bool);
2620
2621 gfc_expr *gfc_build_conversion (gfc_expr *);
2622 void gfc_free_ref_list (gfc_ref *);
2623 void gfc_type_convert_binary (gfc_expr *, int);
2624 int gfc_is_constant_expr (gfc_expr *);
2625 gfc_try gfc_simplify_expr (gfc_expr *, int);
2626 int gfc_has_vector_index (gfc_expr *);
2627
2628 gfc_expr *gfc_get_expr (void);
2629 gfc_expr *gfc_get_array_expr (bt type, int kind, locus *);
2630 gfc_expr *gfc_get_null_expr (locus *);
2631 gfc_expr *gfc_get_operator_expr (locus *, gfc_intrinsic_op,gfc_expr *, gfc_expr *);
2632 gfc_expr *gfc_get_structure_constructor_expr (bt, int, locus *);
2633 gfc_expr *gfc_get_constant_expr (bt, int, locus *);
2634 gfc_expr *gfc_get_character_expr (int, locus *, const char *, int len);
2635 gfc_expr *gfc_get_int_expr (int, locus *, int);
2636 gfc_expr *gfc_get_logical_expr (int, locus *, bool);
2637 gfc_expr *gfc_get_iokind_expr (locus *, io_kind);
2638
2639 void gfc_free_expr (gfc_expr *);
2640 void gfc_replace_expr (gfc_expr *, gfc_expr *);
2641 mpz_t *gfc_copy_shape (mpz_t *, int);
2642 mpz_t *gfc_copy_shape_excluding (mpz_t *, int, gfc_expr *);
2643 gfc_expr *gfc_copy_expr (gfc_expr *);
2644 gfc_ref* gfc_copy_ref (gfc_ref*);
2645
2646 gfc_try gfc_specification_expr (gfc_expr *);
2647
2648 int gfc_numeric_ts (gfc_typespec *);
2649 int gfc_kind_max (gfc_expr *, gfc_expr *);
2650
2651 gfc_try gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3;
2652 gfc_try gfc_check_assign (gfc_expr *, gfc_expr *, int);
2653 gfc_try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
2654 gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
2655
2656 bool gfc_has_default_initializer (gfc_symbol *);
2657 gfc_expr *gfc_default_initializer (gfc_typespec *);
2658 gfc_expr *gfc_get_variable_expr (gfc_symtree *);
2659
2660 gfc_array_spec *gfc_get_full_arrayspec_from_expr (gfc_expr *expr);
2661
2662 bool gfc_traverse_expr (gfc_expr *, gfc_symbol *,
2663                         bool (*)(gfc_expr *, gfc_symbol *, int*),
2664                         int);
2665 void gfc_expr_set_symbols_referenced (gfc_expr *);
2666 gfc_try gfc_expr_check_typed (gfc_expr*, gfc_namespace*, bool);
2667 void gfc_expr_replace_symbols (gfc_expr *, gfc_symbol *);
2668 void gfc_expr_replace_comp (gfc_expr *, gfc_component *);
2669
2670 bool gfc_is_proc_ptr_comp (gfc_expr *, gfc_component **);
2671
2672 bool gfc_is_coindexed (gfc_expr *);
2673 bool gfc_has_ultimate_allocatable (gfc_expr *);
2674 bool gfc_has_ultimate_pointer (gfc_expr *);
2675
2676
2677 /* st.c */
2678 extern gfc_code new_st;
2679
2680 void gfc_clear_new_st (void);
2681 gfc_code *gfc_get_code (void);
2682 gfc_code *gfc_append_code (gfc_code *, gfc_code *);
2683 void gfc_free_statement (gfc_code *);
2684 void gfc_free_statements (gfc_code *);
2685 void gfc_free_association_list (gfc_association_list *);
2686
2687 /* resolve.c */
2688 gfc_try gfc_resolve_expr (gfc_expr *);
2689 void gfc_resolve (gfc_namespace *);
2690 void gfc_resolve_blocks (gfc_code *, gfc_namespace *);
2691 int gfc_impure_variable (gfc_symbol *);
2692 int gfc_pure (gfc_symbol *);
2693 int gfc_elemental (gfc_symbol *);
2694 gfc_try gfc_resolve_iterator (gfc_iterator *, bool);
2695 gfc_try find_forall_index (gfc_expr *, gfc_symbol *, int);
2696 gfc_try gfc_resolve_index (gfc_expr *, int);
2697 gfc_try gfc_resolve_dim_arg (gfc_expr *);
2698 int gfc_is_formal_arg (void);
2699 void gfc_resolve_substring_charlen (gfc_expr *);
2700 match gfc_iso_c_sub_interface(gfc_code *, gfc_symbol *);
2701 gfc_expr *gfc_expr_to_initialize (gfc_expr *);
2702 bool gfc_type_is_extensible (gfc_symbol *sym);
2703
2704
2705 /* array.c */
2706 gfc_iterator *gfc_copy_iterator (gfc_iterator *);
2707
2708 void gfc_free_array_spec (gfc_array_spec *);
2709 gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *);
2710
2711 gfc_try gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *);
2712 gfc_array_spec *gfc_copy_array_spec (gfc_array_spec *);
2713 gfc_try gfc_resolve_array_spec (gfc_array_spec *, int);
2714
2715 int gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *);
2716
2717 void gfc_simplify_iterator_var (gfc_expr *);
2718 gfc_try gfc_expand_constructor (gfc_expr *);
2719 int gfc_constant_ac (gfc_expr *);
2720 int gfc_expanded_ac (gfc_expr *);
2721 gfc_try gfc_resolve_character_array_constructor (gfc_expr *);
2722 gfc_try gfc_resolve_array_constructor (gfc_expr *);
2723 gfc_try gfc_check_constructor_type (gfc_expr *);
2724 gfc_try gfc_check_iter_variable (gfc_expr *);
2725 gfc_try gfc_check_constructor (gfc_expr *, gfc_try (*)(gfc_expr *));
2726 gfc_try gfc_array_size (gfc_expr *, mpz_t *);
2727 gfc_try gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
2728 gfc_try gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
2729 gfc_array_ref *gfc_find_array_ref (gfc_expr *);
2730 tree gfc_conv_array_initializer (tree type, gfc_expr *);
2731 gfc_try spec_size (gfc_array_spec *, mpz_t *);
2732 gfc_try spec_dimen_size (gfc_array_spec *, int, mpz_t *);
2733 int gfc_is_compile_time_shape (gfc_array_spec *);
2734
2735 gfc_try gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *);
2736
2737
2738 /* interface.c -- FIXME: some of these should be in symbol.c */
2739 void gfc_free_interface (gfc_interface *);
2740 int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
2741 int gfc_compare_types (gfc_typespec *, gfc_typespec *);
2742 int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int,
2743                             char *, int);
2744 void gfc_check_interfaces (gfc_namespace *);
2745 void gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *);
2746 void gfc_ppc_use (gfc_component *, gfc_actual_arglist **, locus *);
2747 gfc_symbol *gfc_search_interface (gfc_interface *, int,
2748                                   gfc_actual_arglist **);
2749 gfc_try gfc_extend_expr (gfc_expr *, bool *);
2750 void gfc_free_formal_arglist (gfc_formal_arglist *);
2751 gfc_try gfc_extend_assign (gfc_code *, gfc_namespace *);
2752 gfc_try gfc_add_interface (gfc_symbol *);
2753 gfc_interface *gfc_current_interface_head (void);
2754 void gfc_set_current_interface_head (gfc_interface *);
2755 gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*);
2756 bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*);
2757 bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus);
2758 int gfc_has_vector_subscript (gfc_expr*);
2759
2760 /* io.c */
2761 extern gfc_st_label format_asterisk;
2762
2763 void gfc_free_open (gfc_open *);
2764 gfc_try gfc_resolve_open (gfc_open *);
2765 void gfc_free_close (gfc_close *);
2766 gfc_try gfc_resolve_close (gfc_close *);
2767 void gfc_free_filepos (gfc_filepos *);
2768 gfc_try gfc_resolve_filepos (gfc_filepos *);
2769 void gfc_free_inquire (gfc_inquire *);
2770 gfc_try gfc_resolve_inquire (gfc_inquire *);
2771 void gfc_free_dt (gfc_dt *);
2772 gfc_try gfc_resolve_dt (gfc_dt *, locus *);
2773 void gfc_free_wait (gfc_wait *);
2774 gfc_try gfc_resolve_wait (gfc_wait *);
2775
2776 /* module.c */
2777 void gfc_module_init_2 (void);
2778 void gfc_module_done_2 (void);
2779 void gfc_dump_module (const char *, int);
2780 bool gfc_check_access (gfc_access, gfc_access);
2781 void gfc_free_use_stmts (gfc_use_list *);
2782
2783 /* primary.c */
2784 symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
2785 symbol_attribute gfc_expr_attr (gfc_expr *);
2786 match gfc_match_rvalue (gfc_expr **);
2787 match gfc_match_varspec (gfc_expr*, int, bool, bool);
2788 int gfc_check_digit (char, int);
2789 bool gfc_is_function_return_value (gfc_symbol *, gfc_namespace *);
2790
2791 /* trans.c */
2792 void gfc_generate_code (gfc_namespace *);
2793 void gfc_generate_module_code (gfc_namespace *);
2794
2795 /* bbt.c */
2796 typedef int (*compare_fn) (void *, void *);
2797 void gfc_insert_bbt (void *, void *, compare_fn);
2798 void gfc_delete_bbt (void *, void *, compare_fn);
2799
2800 /* dump-parse-tree.c */
2801 void gfc_dump_parse_tree (gfc_namespace *, FILE *);
2802
2803 /* parse.c */
2804 gfc_try gfc_parse_file (void);
2805 void gfc_global_used (gfc_gsymbol *, locus *);
2806
2807 /* dependency.c */
2808 int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
2809 int gfc_is_data_pointer (gfc_expr *);
2810
2811 /* check.c */
2812 gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
2813
2814 /* class.c */
2815 void gfc_add_component_ref (gfc_expr *, const char *);
2816 gfc_expr *gfc_class_null_initializer (gfc_typespec *);
2817 gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
2818                                 gfc_array_spec **, bool);
2819 gfc_symbol *gfc_find_derived_vtab (gfc_symbol *, bool);
2820 gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, gfc_try*,
2821                                       const char*, bool, locus*);
2822 gfc_symtree* gfc_find_typebound_user_op (gfc_symbol*, gfc_try*,
2823                                          const char*, bool, locus*);
2824 gfc_typebound_proc* gfc_find_typebound_intrinsic_op (gfc_symbol*, gfc_try*,
2825                                                      gfc_intrinsic_op, bool,
2826                                                      locus*);
2827 gfc_symtree* gfc_get_tbp_symtree (gfc_symtree**, const char*);
2828
2829 #define CLASS_DATA(sym) sym->ts.u.derived->components
2830
2831 #endif /* GCC_GFORTRAN_H  */