libgfortran/libgfortran.h

   1 /* Common declarations for all of libgfortran.
   2    Copyright (C) 2002-2022 Free Software Foundation, Inc.
   3    Contributed by Paul Brook <paul@nowt.org>, and
   4    Andy Vaught <andy@xena.eas.asu.edu>
   5
   6 This file is part of the GNU Fortran runtime library (libgfortran).
   7
   8 Libgfortran is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 Libgfortran is distributed in the hope that it will be useful,
  14 but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 GNU General Public License for more details.
  17
  18 Under Section 7 of GPL version 3, you are granted additional
  19 permissions described in the GCC Runtime Library Exception, version
  20 3.1, as published by the Free Software Foundation.
  21
  22 You should have received a copy of the GNU General Public License and
  23 a copy of the GCC Runtime Library Exception along with this program;
  24 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  25 <http://www.gnu.org/licenses/>.  */
  26
  27 #ifndef LIBGFOR_H
  28 #define LIBGFOR_H
  29
  30 /* Ensure that ANSI conform stdio is used. This needs to be set before
  31    any system header file is included.  */
  32 #if defined __MINGW32__
  33 #  define _POSIX 1
  34 #  define gfc_printf gnu_printf
  35 #else
  36 #  define gfc_printf __printf__
  37 #endif
  38
  39 /* config.h MUST be first because it can affect system headers.  */
  40 #include "config.h"
  41
  42 #include <ctype.h>
  43 #include <stdio.h>
  44 #include <stdlib.h>
  45 #include <stddef.h>
  46 #include <float.h>
  47 #include <stdarg.h>
  48 #include <stdbool.h>
  49
  50 #if HAVE_COMPLEX_H
  51 /* Must appear before math.h on VMS systems.  */
  52 # include <complex.h>
  53 #else
  54 #define complex __complex__
  55 #endif
  56
  57 #include <math.h>
  58
  59 /* If we're support quad-precision floating-point type, include the
  60    header to our support library.  */
  61 #ifdef HAVE_FLOAT128
  62 #  include "quadmath_weak.h"
  63 #endif
  64
  65 #ifdef __MINGW32__
  66 extern float __strtof (const char *, char **);
  67 #define gfc_strtof __strtof
  68 extern double __strtod (const char *, char **);
  69 #define gfc_strtod __strtod
  70 extern long double __strtold (const char *, char **);
  71 #define gfc_strtold __strtold
  72 #else
  73 #define gfc_strtof strtof
  74 #define gfc_strtod strtod
  75 #define gfc_strtold strtold
  76 #endif
  77
  78 #include "../gcc/fortran/libgfortran.h"
  79
  80 #include "c99_protos.h"
  81
  82 #if HAVE_IEEEFP_H
  83 #include <ieeefp.h>
  84 #endif
  85
  86 #include "gstdint.h"
  87
  88 #if HAVE_SYS_TYPES_H
  89 #include <sys/types.h>
  90 #endif
  91
  92 #ifdef HAVE_SYS_UIO_H
  93 #include <sys/uio.h>
  94 #endif
  95
  96 #ifdef __MINGW32__
  97 typedef off64_t gfc_offset;
  98 #else
  99 typedef off_t gfc_offset;
 100 #endif
 101
 102 #ifndef NULL
 103 #define NULL (void *) 0
 104 #endif
 105
 106 #if defined(__powerpc64__) && __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ \
 107     && defined __GLIBC_PREREQ
 108 #if __GLIBC_PREREQ (2, 32)
 109 #define POWER_IEEE128 1
 110 #endif
 111 #endif
 112
 113 /* These functions from <ctype.h> should only be used on values that can be
 114    represented as unsigned char, otherwise the behavior is undefined.
 115    Some targets have a char type that is signed, so we cast the argument
 116    to unsigned char. See:
 117      https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95177
 118      https://wiki.sei.cmu.edu/confluence/x/BNcxBQ
 119  */
 120
 121 #define safe_isalnum(x) isalnum((unsigned char) (x))
 122 #define safe_isdigit(x) isdigit((unsigned char) (x))
 123 #define safe_tolower(x) tolower((unsigned char) (x))
 124 #define safe_toupper(x) toupper((unsigned char) (x))
 125
 126
 127 /* The following macros can be used to annotate conditions which are likely or
 128    unlikely to be true.  Avoid using them when a condition is only slightly
 129    more likely/less unlikely than average to avoid the performance penalties of
 130    branch misprediction. In addition, as __builtin_expect overrides the compiler
 131    heuristic, do not use in conditions where one of the branches ends with a
 132    call to a function with __attribute__((noreturn)): the compiler internal
 133    heuristic will mark this branch as much less likely as unlikely() would
 134    do.  */
 135
 136 #define likely(x)       __builtin_expect(!!(x), 1)
 137 #define unlikely(x)     __builtin_expect(!!(x), 0)
 138
 139 /* This macro can be used to annotate conditions which we know to
 140    be true, so that the compiler can optimize based on the condition.  */
 141
 142 #define GFC_ASSERT(EXPR)                                                \
 143   ((void)(__builtin_expect (!(EXPR), 0) ? __builtin_unreachable (), 0 : 0))
 144
 145 /* Make sure we have ptrdiff_t. */
 146 #ifndef HAVE_PTRDIFF_T
 147 typedef intptr_t ptrdiff_t;
 148 #endif
 149
 150 /* On mingw, work around the buggy Windows snprintf() by using the one
 151    mingw provides, __mingw_snprintf().  We also provide a prototype for
 152    __mingw_snprintf(), because the mingw headers currently don't have one.  */
 153 #if HAVE_MINGW_SNPRINTF
 154 extern int __mingw_snprintf (char *, size_t, const char *, ...)
 155      __attribute__ ((format (gnu_printf, 3, 4)));
 156 #undef snprintf
 157 #define snprintf __mingw_snprintf
 158 /* Fallback to sprintf if target does not have snprintf.  */
 159 #elif !defined(HAVE_SNPRINTF)
 160 #undef snprintf
 161 #define snprintf(str, size, ...) sprintf (str, __VA_ARGS__)
 162 #endif
 163
 164
 165 /* For a library, a standard prefix is a requirement in order to partition
 166    the namespace.  IPREFIX is for symbols intended to be internal to the
 167    library.  */
 168 #define PREFIX(x)       _gfortran_ ## x
 169 #define IPREFIX(x)      _gfortrani_ ## x
 170
 171 /* Magic to rename a symbol at the compiler level.  You continue to refer
 172    to the symbol as OLD in the source, but it'll be named NEW in the asm.  */
 173 #define sym_rename(old, new) sym_rename1(old, __USER_LABEL_PREFIX__, new)
 174 #define sym_rename1(old, ulp, new) sym_rename2(old, ulp, new)
 175 #define sym_rename2(old, ulp, new) extern __typeof(old) old __asm__(#ulp #new)
 176
 177 /* There are several classifications of routines:
 178
 179      (1) Symbols used only within the library,
 180      (2) Symbols to be exported from the library,
 181      (3) Symbols to be exported from the library, but
 182          also used inside the library.
 183
 184    By telling the compiler about these different classifications we can
 185    tightly control the interface seen by the user, and get better code
 186    from the compiler at the same time.
 187
 188    One of the following should be used immediately after the declaration
 189    of each symbol:
 190
 191      internal_proto     Marks a symbol used only within the library,
 192                         and adds IPREFIX to the assembly-level symbol
 193                         name.  The later is important for maintaining
 194                         the namespace partition for the static library.
 195
 196      export_proto       Marks a symbol to be exported, and adds PREFIX
 197                         to the assembly-level symbol name.
 198
 199      export_proto_np    Marks a symbol to be exported without adding PREFIX.
 200
 201      iexport_proto      Marks a function to be exported, but with the
 202                         understanding that it can be used inside as well.
 203
 204      iexport_data_proto Similarly, marks a data symbol to be exported.
 205                         Unfortunately, some systems can't play the hidden
 206                         symbol renaming trick on data symbols, thanks to
 207                         the horribleness of COPY relocations.
 208
 209    If iexport_proto or iexport_data_proto is used, you must also use
 210    iexport or iexport_data after the *definition* of the symbol.  */
 211
 212 #if defined(HAVE_ATTRIBUTE_VISIBILITY)
 213 # define internal_proto(x) \
 214         sym_rename(x, IPREFIX (x)) __attribute__((__visibility__("hidden")))
 215 #else
 216 # define internal_proto(x)      sym_rename(x, IPREFIX(x))
 217 #endif
 218
 219 #if defined(HAVE_ATTRIBUTE_VISIBILITY) && defined(HAVE_ATTRIBUTE_ALIAS)
 220 # define export_proto(x)        sym_rename(x, PREFIX(x))
 221 # define export_proto_np(x)     extern char swallow_semicolon
 222 # define iexport_proto(x)       internal_proto(x)
 223 # define iexport(x)             iexport1(x, IPREFIX(x))
 224 # define iexport1(x,y)          iexport2(x,y)
 225 # define iexport2(x,y) \
 226   extern __typeof(x) PREFIX(x) __attribute__((__alias__(#y), __copy__ (x)))
 227 #else
 228 # define export_proto(x)        sym_rename(x, PREFIX(x))
 229 # define export_proto_np(x)     extern char swallow_semicolon
 230 # define iexport_proto(x)       export_proto(x)
 231 # define iexport(x)             extern char swallow_semicolon
 232 #endif
 233
 234 /* TODO: detect the case when we *can* hide the symbol.  */
 235 #define iexport_data_proto(x)   export_proto(x)
 236 #define iexport_data(x)         extern char swallow_semicolon
 237
 238 /* The only reliable way to get the offset of a field in a struct
 239    in a system independent way is via this macro.  */
 240 #ifndef offsetof
 241 #define offsetof(TYPE, MEMBER)  ((size_t) &((TYPE *) 0)->MEMBER)
 242 #endif
 243
 244 /* The C99 classification macros isfinite, isinf, isnan, isnormal
 245    and signbit are broken or inconsistent on quite a few targets.
 246    So, we use GCC's builtins instead.
 247
 248    Another advantage for GCC's builtins for these type-generic macros
 249    is that it handles floating-point types that the system headers
 250    may not support (like __float128).  */
 251
 252 #undef isnan
 253 #define isnan(x) __builtin_isnan(x)
 254 #undef isfinite
 255 #define isfinite(x) __builtin_isfinite(x)
 256 #undef isinf
 257 #define isinf(x) __builtin_isinf(x)
 258 #undef isnormal
 259 #define isnormal(x) __builtin_isnormal(x)
 260 #undef signbit
 261 #define signbit(x) __builtin_signbit(x)
 262
 263 #include "kinds.h"
 264
 265 /* Define the type used for the current record number for large file I/O.
 266    The size must be consistent with the size defined on the compiler side.  */
 267 #ifdef HAVE_GFC_INTEGER_8
 268 typedef GFC_INTEGER_8 GFC_IO_INT;
 269 #else
 270 #ifdef HAVE_GFC_INTEGER_4
 271 typedef GFC_INTEGER_4 GFC_IO_INT;
 272 #else
 273 #error "GFC_INTEGER_4 should be available for the library to compile".
 274 #endif
 275 #endif
 276
 277 /* The following two definitions must be consistent with the types used
 278    by the compiler.  */
 279 /* The type used of array indices, amongst other things.  */
 280 typedef ptrdiff_t index_type;
 281
 282 /* The type used for the lengths of character variables.  */
 283 typedef size_t gfc_charlen_type;
 284
 285 /* Definitions of CHARACTER data types:
 286      - CHARACTER(KIND=1) corresponds to the C char type,
 287      - CHARACTER(KIND=4) corresponds to an unsigned 32-bit integer.  */
 288 typedef GFC_UINTEGER_4 gfc_char4_t;
 289
 290 /* Byte size of character kinds.  For the kinds currently supported, it's
 291    simply equal to the kind parameter itself.  */
 292 #define GFC_SIZE_OF_CHAR_KIND(kind) (kind)
 293
 294 #define GFOR_POINTER_TO_L1(p, kind) \
 295   ((__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? 1: 0) * (kind - 1) + (GFC_LOGICAL_1 *)(p))
 296
 297 #define GFC_INTEGER_1_HUGE \
 298   (GFC_INTEGER_1)((((GFC_UINTEGER_1)1) << 7) - 1)
 299 #define GFC_INTEGER_2_HUGE \
 300   (GFC_INTEGER_2)((((GFC_UINTEGER_2)1) << 15) - 1)
 301 #define GFC_INTEGER_4_HUGE \
 302   (GFC_INTEGER_4)((((GFC_UINTEGER_4)1) << 31) - 1)
 303 #define GFC_INTEGER_8_HUGE \
 304   (GFC_INTEGER_8)((((GFC_UINTEGER_8)1) << 63) - 1)
 305 #ifdef HAVE_GFC_INTEGER_16
 306 #define GFC_INTEGER_16_HUGE \
 307   (GFC_INTEGER_16)((((GFC_UINTEGER_16)1) << 127) - 1)
 308 #endif
 309
 310 /* M{IN,AX}{LOC,VAL} need also infinities and NaNs if supported.  */
 311
 312 #if __FLT_HAS_INFINITY__
 313 # define GFC_REAL_4_INFINITY __builtin_inff ()
 314 #endif
 315 #if __DBL_HAS_INFINITY__
 316 # define GFC_REAL_8_INFINITY __builtin_inf ()
 317 #endif
 318 #if __LDBL_HAS_INFINITY__
 319 # ifdef HAVE_GFC_REAL_10
 320 #  define GFC_REAL_10_INFINITY __builtin_infl ()
 321 # endif
 322 # ifdef HAVE_GFC_REAL_16
 323 #  ifdef GFC_REAL_16_IS_LONG_DOUBLE
 324 #   define GFC_REAL_16_INFINITY __builtin_infl ()
 325 #  else
 326 #   define GFC_REAL_16_INFINITY __builtin_infq ()
 327 #  endif
 328 # endif
 329 # ifdef HAVE_GFC_REAL_17
 330 #  define GFC_REAL_17_INFINITY __builtin_inff128 ()
 331 # endif
 332 #endif
 333 #if __FLT_HAS_QUIET_NAN__
 334 # define GFC_REAL_4_QUIET_NAN __builtin_nanf ("")
 335 #endif
 336 #if __DBL_HAS_QUIET_NAN__
 337 # define GFC_REAL_8_QUIET_NAN __builtin_nan ("")
 338 #endif
 339 #if __LDBL_HAS_QUIET_NAN__
 340 # ifdef HAVE_GFC_REAL_10
 341 #  define GFC_REAL_10_QUIET_NAN __builtin_nanl ("")
 342 # endif
 343 # ifdef HAVE_GFC_REAL_16
 344 #  ifdef GFC_REAL_16_IS_LONG_DOUBLE
 345 #   define GFC_REAL_16_QUIET_NAN __builtin_nanl ("")
 346 #  else
 347 #   define GFC_REAL_16_QUIET_NAN nanq ("")
 348 #  endif
 349 # endif
 350 # ifdef HAVE_GFC_REAL_17
 351 #  define GFC_REAL_17_QUIET_NAN __builtin_nanf128 ("")
 352 # endif
 353 #endif
 354
 355 typedef struct descriptor_dimension
 356 {
 357   index_type _stride;
 358   index_type lower_bound;
 359   index_type _ubound;
 360 }
 361 descriptor_dimension;
 362
 363 typedef struct dtype_type
 364 {
 365   size_t elem_len;
 366   int version;
 367   signed char rank;
 368   signed char type;
 369   signed short attribute;
 370 }
 371 dtype_type;
 372
 373 #define GFC_ARRAY_DESCRIPTOR(type) \
 374 struct {\
 375   type *base_addr;\
 376   size_t offset;\
 377   dtype_type dtype;\
 378   index_type span;\
 379   descriptor_dimension dim[];\
 380 }
 381
 382 /* Commonly used array descriptor types.  */
 383 typedef GFC_ARRAY_DESCRIPTOR (void) gfc_array_void;
 384 typedef GFC_ARRAY_DESCRIPTOR (char) gfc_array_char;
 385 typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_1) gfc_array_i1;
 386 typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_2) gfc_array_i2;
 387 typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_4) gfc_array_i4;
 388 typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_8) gfc_array_i8;
 389 typedef GFC_ARRAY_DESCRIPTOR (index_type) gfc_array_index_type;
 390 #ifdef HAVE_GFC_INTEGER_16
 391 typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_16) gfc_array_i16;
 392 #endif
 393 typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_4) gfc_array_r4;
 394 typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_8) gfc_array_r8;
 395 #ifdef HAVE_GFC_REAL_10
 396 typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_10) gfc_array_r10;
 397 #endif
 398 #ifdef HAVE_GFC_REAL_16
 399 typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_16) gfc_array_r16;
 400 #endif
 401 #ifdef HAVE_GFC_REAL_17
 402 typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_17) gfc_array_r17;
 403 #endif
 404 typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_4) gfc_array_c4;
 405 typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_8) gfc_array_c8;
 406 #ifdef HAVE_GFC_COMPLEX_10
 407 typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_10) gfc_array_c10;
 408 #endif
 409 #ifdef HAVE_GFC_COMPLEX_16
 410 typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_16) gfc_array_c16;
 411 #endif
 412 #ifdef HAVE_GFC_COMPLEX_17
 413 typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_17) gfc_array_c17;
 414 #endif
 415 typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_1) gfc_array_l1;
 416 typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_2) gfc_array_l2;
 417 typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_4) gfc_array_l4;
 418 typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_8) gfc_array_l8;
 419 #ifdef HAVE_GFC_LOGICAL_16
 420 typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_16) gfc_array_l16;
 421 #endif
 422
 423 typedef GFC_ARRAY_DESCRIPTOR (GFC_UINTEGER_1) gfc_array_s1;
 424 typedef GFC_ARRAY_DESCRIPTOR (GFC_UINTEGER_4) gfc_array_s4;
 425
 426 /* These are for when you actually want to declare a descriptor, as
 427    opposed to a pointer to it.  */
 428
 429 #define GFC_FULL_ARRAY_DESCRIPTOR(r, type) \
 430 struct {\
 431   type *base_addr;\
 432   size_t offset;\
 433   dtype_type dtype;\
 434   index_type span;\
 435   descriptor_dimension dim[r];\
 436 }
 437
 438 typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_full_array_i4;
 439
 440 #define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype.rank)
 441 #define GFC_DESCRIPTOR_TYPE(desc) ((desc)->dtype.type)
 442 #define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype.elem_len)
 443 #define GFC_DESCRIPTOR_DATA(desc) ((desc)->base_addr)
 444 #define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
 445 #define GFC_DESCRIPTOR_SPAN(desc) ((desc)->span)
 446
 447 #define GFC_DIMENSION_LBOUND(dim) ((dim).lower_bound)
 448 #define GFC_DIMENSION_UBOUND(dim) ((dim)._ubound)
 449 #define GFC_DIMENSION_STRIDE(dim) ((dim)._stride)
 450 #define GFC_DIMENSION_EXTENT(dim) ((dim)._ubound + 1 - (dim).lower_bound)
 451 #define GFC_DIMENSION_SET(dim,lb,ub,str) \
 452   do \
 453     { \
 454       (dim).lower_bound = lb;                   \
 455       (dim)._ubound = ub;                       \
 456       (dim)._stride = str;                      \
 457     } while (0)
 458
 459
 460 #define GFC_DESCRIPTOR_LBOUND(desc,i) ((desc)->dim[i].lower_bound)
 461 #define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i]._ubound)
 462 #define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i]._ubound + 1 \
 463                                       - (desc)->dim[i].lower_bound)
 464 #define GFC_DESCRIPTOR_EXTENT_BYTES(desc,i) \
 465   (GFC_DESCRIPTOR_EXTENT(desc,i) * GFC_DESCRIPTOR_SIZE(desc))
 466
 467 #define GFC_DESCRIPTOR_STRIDE(desc,i) ((desc)->dim[i]._stride)
 468 #define GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) \
 469   (GFC_DESCRIPTOR_STRIDE(desc,i) * GFC_DESCRIPTOR_SIZE(desc))
 470
 471 /* Macros to get both the size and the type with a single masking operation  */
 472
 473 #define GFC_DTYPE_SIZE_MASK (-((index_type) 1 << GFC_DTYPE_SIZE_SHIFT))
 474 #define GFC_DTYPE_TYPE_SIZE_MASK (GFC_DTYPE_SIZE_MASK | GFC_DTYPE_TYPE_MASK)
 475
 476 #define GFC_DTYPE_TYPE_SIZE(desc) (( ((desc)->dtype.type << GFC_DTYPE_TYPE_SHIFT) \
 477     | ((desc)->dtype.elem_len << GFC_DTYPE_SIZE_SHIFT) ) & GFC_DTYPE_TYPE_SIZE_MASK)
 478
 479 /* Macros to set size and type information.  */
 480
 481 #define GFC_DTYPE_COPY(a,b) do { (a)->dtype = (b)->dtype; } while(0)
 482 #define GFC_DTYPE_IS_UNSET(a) (unlikely((a)->dtype.elem_len == 0))
 483 #define GFC_DTYPE_CLEAR(a) do { (a)->dtype.elem_len = 0; \
 484                                 (a)->dtype.version = 0; \
 485                                 (a)->dtype.rank = 0; \
 486                                 (a)->dtype.type = 0; \
 487                                 (a)->dtype.attribute = 0; \
 488 } while(0)
 489
 490 #define GFC_DTYPE_INTEGER_1 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
 491    | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
 492 #define GFC_DTYPE_INTEGER_2 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
 493    | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
 494 #define GFC_DTYPE_INTEGER_4 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
 495    | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
 496 #define GFC_DTYPE_INTEGER_8 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
 497    | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
 498 #ifdef HAVE_GFC_INTEGER_16
 499 #define GFC_DTYPE_INTEGER_16 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
 500    | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
 501 #endif
 502
 503 #define GFC_DTYPE_LOGICAL_1 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
 504    | (sizeof(GFC_LOGICAL_1) << GFC_DTYPE_SIZE_SHIFT))
 505 #define GFC_DTYPE_LOGICAL_2 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
 506    | (sizeof(GFC_LOGICAL_2) << GFC_DTYPE_SIZE_SHIFT))
 507 #define GFC_DTYPE_LOGICAL_4 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
 508    | (sizeof(GFC_LOGICAL_4) << GFC_DTYPE_SIZE_SHIFT))
 509 #define GFC_DTYPE_LOGICAL_8 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
 510    | (sizeof(GFC_LOGICAL_8) << GFC_DTYPE_SIZE_SHIFT))
 511 #ifdef HAVE_GFC_LOGICAL_16
 512 #define GFC_DTYPE_LOGICAL_16 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
 513    | (sizeof(GFC_LOGICAL_16) << GFC_DTYPE_SIZE_SHIFT))
 514 #endif
 515
 516 #define GFC_DTYPE_REAL_4 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
 517    | (sizeof(GFC_REAL_4) << GFC_DTYPE_SIZE_SHIFT))
 518 #define GFC_DTYPE_REAL_8 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
 519    | (sizeof(GFC_REAL_8) << GFC_DTYPE_SIZE_SHIFT))
 520 #ifdef HAVE_GFC_REAL_10
 521 #define GFC_DTYPE_REAL_10  ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
 522    | (sizeof(GFC_REAL_10) << GFC_DTYPE_SIZE_SHIFT))
 523 #endif
 524 #ifdef HAVE_GFC_REAL_16
 525 #define GFC_DTYPE_REAL_16 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
 526    | (sizeof(GFC_REAL_16) << GFC_DTYPE_SIZE_SHIFT))
 527 #endif
 528 #ifdef HAVE_GFC_REAL_17
 529 #define GFC_DTYPE_REAL_17 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
 530    | (sizeof(GFC_REAL_17) << GFC_DTYPE_SIZE_SHIFT))
 531 #endif
 532
 533 #define GFC_DTYPE_COMPLEX_4 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
 534    | (sizeof(GFC_COMPLEX_4) << GFC_DTYPE_SIZE_SHIFT))
 535 #define GFC_DTYPE_COMPLEX_8 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
 536    | (sizeof(GFC_COMPLEX_8) << GFC_DTYPE_SIZE_SHIFT))
 537 #ifdef HAVE_GFC_COMPLEX_10
 538 #define GFC_DTYPE_COMPLEX_10 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
 539    | (sizeof(GFC_COMPLEX_10) << GFC_DTYPE_SIZE_SHIFT))
 540 #endif
 541 #ifdef HAVE_GFC_COMPLEX_16
 542 #define GFC_DTYPE_COMPLEX_16 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
 543    | (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT))
 544 #endif
 545 #ifdef HAVE_GFC_COMPLEX_17
 546 #define GFC_DTYPE_COMPLEX_17 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
 547    | (sizeof(GFC_COMPLEX_17) << GFC_DTYPE_SIZE_SHIFT))
 548 #endif
 549
 550 /* Macros to determine the alignment of pointers.  */
 551
 552 #define GFC_UNALIGNED_2(x) (((uintptr_t)(x)) & \
 553                             (__alignof__(GFC_INTEGER_2) - 1))
 554 #define GFC_UNALIGNED_4(x) (((uintptr_t)(x)) & \
 555                             (__alignof__(GFC_INTEGER_4) - 1))
 556 #define GFC_UNALIGNED_8(x) (((uintptr_t)(x)) & \
 557                             (__alignof__(GFC_INTEGER_8) - 1))
 558 #ifdef HAVE_GFC_INTEGER_16
 559 #define GFC_UNALIGNED_16(x) (((uintptr_t)(x)) & \
 560                              (__alignof__(GFC_INTEGER_16) - 1))
 561 #endif
 562
 563 #define GFC_UNALIGNED_C4(x) (((uintptr_t)(x)) & \
 564                              (__alignof__(GFC_COMPLEX_4) - 1))
 565
 566 #define GFC_UNALIGNED_C8(x) (((uintptr_t)(x)) & \
 567                              (__alignof__(GFC_COMPLEX_8) - 1))
 568
 569 /* Runtime library include.  */
 570 #define stringize(x) expand_macro(x)
 571 #define expand_macro(x) # x
 572
 573 /* Runtime options structure.  */
 574
 575 typedef struct
 576 {
 577   int stdin_unit, stdout_unit, stderr_unit, optional_plus;
 578   int locus;
 579
 580   int separator_len;
 581   const char *separator;
 582
 583   int all_unbuffered, unbuffered_preconnected;
 584   int fpe, backtrace;
 585   int unformatted_buffer_size, formatted_buffer_size;
 586 }
 587 options_t;
 588
 589 extern options_t options;
 590 internal_proto(options);
 591
 592 extern void backtrace_handler (int);
 593 internal_proto(backtrace_handler);
 594
 595
 596 /* Compile-time options that will influence the library.  */
 597
 598 typedef struct
 599 {
 600   int warn_std;
 601   int allow_std;
 602   int pedantic;
 603   int convert;
 604   int backtrace;
 605   int sign_zero;
 606   size_t record_marker;
 607   int max_subrecord_length;
 608   int bounds_check;
 609   int fpe_summary;
 610 }
 611 compile_options_t;
 612
 613 extern compile_options_t compile_options;
 614 internal_proto(compile_options);
 615
 616 extern void init_compile_options (void);
 617 internal_proto(init_compile_options);
 618
 619 #define GFC_MAX_SUBRECORD_LENGTH 2147483639   /* 2**31 - 9 */
 620
 621 /* Structure for statement options.  */
 622
 623 typedef struct
 624 {
 625   const char *name;
 626   int value;
 627 }
 628 st_option;
 629
 630
 631 /* This is returned by notification_std to know if, given the flags
 632    that were given (-std=, -pedantic) we should issue an error, a warning
 633    or nothing.  */
 634 typedef enum
 635 { NOTIFICATION_SILENT, NOTIFICATION_WARNING, NOTIFICATION_ERROR }
 636 notification;
 637
 638
 639 /* The filename and line number don't go inside the globals structure.
 640    They are set by the rest of the program and must be linked to.  */
 641
 642 /* Location of the current library call (optional).  */
 643 extern unsigned line;
 644 iexport_data_proto(line);
 645
 646 extern char *filename;
 647 iexport_data_proto(filename);
 648
 649
 650 #define CHARACTER2(name) \
 651               gfc_charlen_type name ## _len; \
 652               char * name
 653
 654 typedef struct st_parameter_common
 655 {
 656   GFC_INTEGER_4 flags;
 657   GFC_INTEGER_4 unit;
 658   const char *filename;
 659   GFC_INTEGER_4 line;
 660   CHARACTER2 (iomsg);
 661   GFC_INTEGER_4 *iostat;
 662 }
 663 st_parameter_common;
 664
 665 #undef CHARACTER2
 666
 667 #define IOPARM_LIBRETURN_MASK           (3 << 0)
 668 #define IOPARM_LIBRETURN_OK             (0 << 0)
 669 #define IOPARM_LIBRETURN_ERROR          (1 << 0)
 670 #define IOPARM_LIBRETURN_END            (2 << 0)
 671 #define IOPARM_LIBRETURN_EOR            (3 << 0)
 672 #define IOPARM_ERR                      (1 << 2)
 673 #define IOPARM_END                      (1 << 3)
 674 #define IOPARM_EOR                      (1 << 4)
 675 #define IOPARM_HAS_IOSTAT               (1 << 5)
 676 #define IOPARM_HAS_IOMSG                (1 << 6)
 677
 678 #define IOPARM_COMMON_MASK              ((1 << 7) - 1)
 679
 680 /* Make sure to keep in sync with io/io.h (st_parameter_open).  */
 681 #define IOPARM_OPEN_HAS_RECL_IN         (1 << 7)
 682 #define IOPARM_OPEN_HAS_FILE            (1 << 8)
 683 #define IOPARM_OPEN_HAS_STATUS          (1 << 9)
 684 #define IOPARM_OPEN_HAS_ACCESS          (1 << 10)
 685 #define IOPARM_OPEN_HAS_FORM            (1 << 11)
 686 #define IOPARM_OPEN_HAS_BLANK           (1 << 12)
 687 #define IOPARM_OPEN_HAS_POSITION        (1 << 13)
 688 #define IOPARM_OPEN_HAS_ACTION          (1 << 14)
 689 #define IOPARM_OPEN_HAS_DELIM           (1 << 15)
 690 #define IOPARM_OPEN_HAS_PAD             (1 << 16)
 691 #define IOPARM_OPEN_HAS_CONVERT         (1 << 17)
 692 #define IOPARM_OPEN_HAS_DECIMAL         (1 << 18)
 693 #define IOPARM_OPEN_HAS_ENCODING        (1 << 19)
 694 #define IOPARM_OPEN_HAS_ROUND           (1 << 20)
 695 #define IOPARM_OPEN_HAS_SIGN            (1 << 21)
 696 #define IOPARM_OPEN_HAS_ASYNCHRONOUS    (1 << 22)
 697 #define IOPARM_OPEN_HAS_NEWUNIT         (1 << 23)
 698 #define IOPARM_OPEN_HAS_READONLY        (1 << 24)
 699 #define IOPARM_OPEN_HAS_CC              (1 << 25)
 700 #define IOPARM_OPEN_HAS_SHARE           (1 << 26)
 701
 702 /* library start function and end macro.  These can be expanded if needed
 703    in the future.  cmp is st_parameter_common *cmp  */
 704
 705 extern void library_start (st_parameter_common *);
 706 internal_proto(library_start);
 707
 708 #define library_end()
 709
 710 /* main.c */
 711
 712 extern void stupid_function_name_for_static_linking (void);
 713 internal_proto(stupid_function_name_for_static_linking);
 714
 715 extern void set_args (int, char **);
 716 iexport_proto(set_args);
 717
 718 extern void get_args (int *, char ***);
 719 internal_proto(get_args);
 720
 721 /* backtrace.c */
 722
 723 extern void show_backtrace (bool);
 724 internal_proto(show_backtrace);
 725
 726
 727 /* error.c */
 728
 729 #if defined(HAVE_GFC_REAL_16)
 730 #define GFC_LARGEST_BUF (sizeof (GFC_REAL_16))
 731 #elif defined(HAVE_GFC_INTEGER_16)
 732 #define GFC_LARGEST_BUF (sizeof (GFC_INTEGER_LARGEST))
 733 #elif defined(HAVE_GFC_REAL_10)
 734 #define GFC_LARGEST_BUF (sizeof (GFC_REAL_10))
 735 #else
 736 #define GFC_LARGEST_BUF (sizeof (GFC_INTEGER_LARGEST))
 737 #endif
 738
 739 #define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 1)
 740 #define GFC_XTOA_BUF_SIZE (GFC_LARGEST_BUF * 2 + 1)
 741 #define GFC_OTOA_BUF_SIZE (GFC_LARGEST_BUF * 3 + 1)
 742 #define GFC_BTOA_BUF_SIZE (GFC_LARGEST_BUF * 8 + 1)
 743
 744 extern _Noreturn void sys_abort (void);
 745 internal_proto(sys_abort);
 746
 747 extern _Noreturn void exit_error (int);
 748 internal_proto(exit_error);
 749
 750 extern ssize_t estr_write (const char *);
 751 internal_proto(estr_write);
 752
 753 #if !defined(HAVE_WRITEV) && !defined(HAVE_SYS_UIO_H)
 754 struct iovec {
 755   void  *iov_base;    /* Starting address */
 756   size_t iov_len;     /* Number of bytes to transfer */
 757 };
 758 #endif
 759
 760 extern ssize_t estr_writev (const struct iovec *iov, int iovcnt);
 761 internal_proto(estr_writev);
 762
 763 extern int st_printf (const char *, ...)
 764   __attribute__((format (gfc_printf, 1, 2)));
 765 internal_proto(st_printf);
 766
 767 extern _Noreturn void os_error (const char *);
 768 iexport_proto(os_error);
 769
 770 extern _Noreturn void os_error_at (const char *, const char *, ...)
 771   __attribute__ ((format (gfc_printf, 2, 3)));
 772 iexport_proto(os_error_at);
 773
 774 extern void show_locus (st_parameter_common *);
 775 internal_proto(show_locus);
 776
 777 extern _Noreturn void runtime_error (const char *, ...)
 778      __attribute__ ((format (gfc_printf, 1, 2)));
 779 iexport_proto(runtime_error);
 780
 781 extern _Noreturn void runtime_error_at (const char *, const char *, ...)
 782      __attribute__ ((format (gfc_printf, 2, 3)));
 783 iexport_proto(runtime_error_at);
 784
 785 extern void runtime_warning_at (const char *, const char *, ...)
 786      __attribute__ ((format (gfc_printf, 2, 3)));
 787 iexport_proto(runtime_warning_at);
 788
 789 extern _Noreturn void internal_error (st_parameter_common *, const char *);
 790 internal_proto(internal_error);
 791
 792 extern const char *translate_error (int);
 793 internal_proto(translate_error);
 794
 795 extern void generate_error (st_parameter_common *, int, const char *);
 796 iexport_proto(generate_error);
 797
 798 extern bool generate_error_common (st_parameter_common *, int, const char *);
 799 iexport_proto(generate_error_common);
 800
 801 extern void generate_warning (st_parameter_common *, const char *);
 802 internal_proto(generate_warning);
 803
 804 extern bool notify_std (st_parameter_common *, int, const char *);
 805 internal_proto(notify_std);
 806
 807 extern notification notification_std(int);
 808 internal_proto(notification_std);
 809
 810 extern char *gf_strerror (int, char *, size_t);
 811 internal_proto(gf_strerror);
 812
 813 /* fpu.c */
 814
 815 extern void set_fpu (void);
 816 internal_proto(set_fpu);
 817
 818 extern int get_fpu_trap_exceptions (void);
 819 internal_proto(get_fpu_trap_exceptions);
 820
 821 extern void set_fpu_trap_exceptions (int, int);
 822 internal_proto(set_fpu_trap_exceptions);
 823
 824 extern int support_fpu_trap (int);
 825 internal_proto(support_fpu_trap);
 826
 827 extern int get_fpu_except_flags (void);
 828 internal_proto(get_fpu_except_flags);
 829
 830 extern void set_fpu_except_flags (int, int);
 831 internal_proto(set_fpu_except_flags);
 832
 833 extern int support_fpu_flag (int);
 834 internal_proto(support_fpu_flag);
 835
 836 extern void set_fpu_rounding_mode (int);
 837 internal_proto(set_fpu_rounding_mode);
 838
 839 extern int get_fpu_rounding_mode (void);
 840 internal_proto(get_fpu_rounding_mode);
 841
 842 extern int support_fpu_rounding_mode (int);
 843 internal_proto(support_fpu_rounding_mode);
 844
 845 extern void get_fpu_state (void *);
 846 internal_proto(get_fpu_state);
 847
 848 extern void set_fpu_state (void *);
 849 internal_proto(set_fpu_state);
 850
 851 extern int get_fpu_underflow_mode (void);
 852 internal_proto(get_fpu_underflow_mode);
 853
 854 extern void set_fpu_underflow_mode (int);
 855 internal_proto(set_fpu_underflow_mode);
 856
 857 extern int support_fpu_underflow_control (int);
 858 internal_proto(support_fpu_underflow_control);
 859
 860 /* memory.c */
 861
 862 extern void *xmalloc (size_t) __attribute__ ((malloc));
 863 internal_proto(xmalloc);
 864
 865 extern void *xmallocarray (size_t, size_t) __attribute__ ((malloc));
 866 internal_proto(xmallocarray);
 867
 868 extern void *xcalloc (size_t, size_t) __attribute__ ((malloc));
 869 internal_proto(xcalloc);
 870
 871 extern void *xrealloc (void *, size_t);
 872 internal_proto(xrealloc);
 873
 874 /* environ.c */
 875
 876 extern void init_variables (void);
 877 internal_proto(init_variables);
 878
 879 unit_convert get_unformatted_convert (int);
 880 internal_proto(get_unformatted_convert);
 881
 882 /* Secure getenv() which returns NULL if running as SUID/SGID.  */
 883 #ifndef HAVE_SECURE_GETENV
 884 #if defined(HAVE_GETUID) && defined(HAVE_GETEUID) \
 885   && defined(HAVE_GETGID) && defined(HAVE_GETEGID)
 886 #define FALLBACK_SECURE_GETENV
 887 extern char *secure_getenv (const char *);
 888 internal_proto(secure_getenv);
 889 #else
 890 #define secure_getenv getenv
 891 #endif
 892 #endif
 893
 894 /* string.c */
 895
 896 extern int find_option (st_parameter_common *, const char *, gfc_charlen_type,
 897                         const st_option *, const char *);
 898 internal_proto(find_option);
 899
 900 extern gfc_charlen_type fstrlen (const char *, gfc_charlen_type);
 901 internal_proto(fstrlen);
 902
 903 extern gfc_charlen_type fstrcpy (char *, gfc_charlen_type, const char *, gfc_charlen_type);
 904 internal_proto(fstrcpy);
 905
 906 extern gfc_charlen_type cf_strcpy (char *, gfc_charlen_type, const char *);
 907 internal_proto(cf_strcpy);
 908
 909 extern gfc_charlen_type string_len_trim (gfc_charlen_type, const char *);
 910 export_proto(string_len_trim);
 911
 912 extern gfc_charlen_type string_len_trim_char4 (gfc_charlen_type,
 913                                                const gfc_char4_t *);
 914 export_proto(string_len_trim_char4);
 915
 916 extern char *fc_strdup(const char *, gfc_charlen_type);
 917 internal_proto(fc_strdup);
 918
 919 extern char *fc_strdup_notrim(const char *, gfc_charlen_type);
 920 internal_proto(fc_strdup_notrim);
 921
 922 extern const char *gfc_itoa(GFC_UINTEGER_LARGEST, char *, size_t);
 923 internal_proto(gfc_itoa);
 924
 925 /* io/intrinsics.c */
 926
 927 extern void flush_all_units (void);
 928 internal_proto(flush_all_units);
 929
 930 /* io.c */
 931
 932 extern void init_units (void);
 933 internal_proto(init_units);
 934
 935 extern void close_units (void);
 936 internal_proto(close_units);
 937
 938 extern int unit_to_fd (int);
 939 internal_proto(unit_to_fd);
 940
 941 extern char * filename_from_unit (int);
 942 internal_proto(filename_from_unit);
 943
 944 /* stop.c */
 945
 946 extern _Noreturn void stop_string (const char *, size_t, bool);
 947 export_proto(stop_string);
 948
 949 /* reshape_packed.c */
 950
 951 extern void reshape_packed (char *, index_type, const char *, index_type,
 952                             const char *, index_type);
 953 internal_proto(reshape_packed);
 954
 955 /* Repacking functions.  These are called internally by internal_pack
 956    and internal_unpack.  */
 957
 958 GFC_INTEGER_1 *internal_pack_1 (gfc_array_i1 *);
 959 internal_proto(internal_pack_1);
 960
 961 GFC_INTEGER_2 *internal_pack_2 (gfc_array_i2 *);
 962 internal_proto(internal_pack_2);
 963
 964 GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *);
 965 internal_proto(internal_pack_4);
 966
 967 GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *);
 968 internal_proto(internal_pack_8);
 969
 970 #if defined HAVE_GFC_INTEGER_16
 971 GFC_INTEGER_16 *internal_pack_16 (gfc_array_i16 *);
 972 internal_proto(internal_pack_16);
 973 #endif
 974
 975 GFC_REAL_4 *internal_pack_r4 (gfc_array_r4 *);
 976 internal_proto(internal_pack_r4);
 977
 978 GFC_REAL_8 *internal_pack_r8 (gfc_array_r8 *);
 979 internal_proto(internal_pack_r8);
 980
 981 #if defined HAVE_GFC_REAL_10
 982 GFC_REAL_10 *internal_pack_r10 (gfc_array_r10 *);
 983 internal_proto(internal_pack_r10);
 984 #endif
 985
 986 #if defined HAVE_GFC_REAL_16
 987 GFC_REAL_16 *internal_pack_r16 (gfc_array_r16 *);
 988 internal_proto(internal_pack_r16);
 989 #endif
 990
 991 #if defined HAVE_GFC_REAL_17
 992 GFC_REAL_17 *internal_pack_r17 (gfc_array_r17 *);
 993 internal_proto(internal_pack_r17);
 994 #endif
 995
 996 GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *);
 997 internal_proto(internal_pack_c4);
 998
 999 GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *);
1000 internal_proto(internal_pack_c8);
1001
1002 #if defined HAVE_GFC_COMPLEX_10
1003 GFC_COMPLEX_10 *internal_pack_c10 (gfc_array_c10 *);
1004 internal_proto(internal_pack_c10);
1005 #endif
1006
1007 #if defined HAVE_GFC_COMPLEX_16
1008 GFC_COMPLEX_16 *internal_pack_c16 (gfc_array_c16 *);
1009 internal_proto(internal_pack_c16);
1010 #endif
1011
1012 #if defined HAVE_GFC_COMPLEX_17
1013 GFC_COMPLEX_17 *internal_pack_c17 (gfc_array_c17 *);
1014 internal_proto(internal_pack_c17);
1015 #endif
1016
1017 extern void internal_unpack_1 (gfc_array_i1 *, const GFC_INTEGER_1 *);
1018 internal_proto(internal_unpack_1);
1019
1020 extern void internal_unpack_2 (gfc_array_i2 *, const GFC_INTEGER_2 *);
1021 internal_proto(internal_unpack_2);
1022
1023 extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *);
1024 internal_proto(internal_unpack_4);
1025
1026 extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *);
1027 internal_proto(internal_unpack_8);
1028
1029 #if defined HAVE_GFC_INTEGER_16
1030 extern void internal_unpack_16 (gfc_array_i16 *, const GFC_INTEGER_16 *);
1031 internal_proto(internal_unpack_16);
1032 #endif
1033
1034 extern void internal_unpack_r4 (gfc_array_r4 *, const GFC_REAL_4 *);
1035 internal_proto(internal_unpack_r4);
1036
1037 extern void internal_unpack_r8 (gfc_array_r8 *, const GFC_REAL_8 *);
1038 internal_proto(internal_unpack_r8);
1039
1040 #if defined HAVE_GFC_REAL_10
1041 extern void internal_unpack_r10 (gfc_array_r10 *, const GFC_REAL_10 *);
1042 internal_proto(internal_unpack_r10);
1043 #endif
1044
1045 #if defined HAVE_GFC_REAL_16
1046 extern void internal_unpack_r16 (gfc_array_r16 *, const GFC_REAL_16 *);
1047 internal_proto(internal_unpack_r16);
1048 #endif
1049
1050 #if defined HAVE_GFC_REAL_17
1051 extern void internal_unpack_r17 (gfc_array_r17 *, const GFC_REAL_17 *);
1052 internal_proto(internal_unpack_r17);
1053 #endif
1054
1055 extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *);
1056 internal_proto(internal_unpack_c4);
1057
1058 extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *);
1059 internal_proto(internal_unpack_c8);
1060
1061 #if defined HAVE_GFC_COMPLEX_10
1062 extern void internal_unpack_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *);
1063 internal_proto(internal_unpack_c10);
1064 #endif
1065
1066 #if defined HAVE_GFC_COMPLEX_16
1067 extern void internal_unpack_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *);
1068 internal_proto(internal_unpack_c16);
1069 #endif
1070
1071 #if defined HAVE_GFC_COMPLEX_17
1072 extern void internal_unpack_c17 (gfc_array_c17 *, const GFC_COMPLEX_17 *);
1073 internal_proto(internal_unpack_c17);
1074 #endif
1075
1076 /* Internal auxiliary functions for the pack intrinsic.  */
1077
1078 extern void pack_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1079                      const gfc_array_l1 *, const gfc_array_i1 *);
1080 internal_proto(pack_i1);
1081
1082 extern void pack_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1083                      const gfc_array_l1 *, const gfc_array_i2 *);
1084 internal_proto(pack_i2);
1085
1086 extern void pack_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1087                      const gfc_array_l1 *, const gfc_array_i4 *);
1088 internal_proto(pack_i4);
1089
1090 extern void pack_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1091                      const gfc_array_l1 *, const gfc_array_i8 *);
1092 internal_proto(pack_i8);
1093
1094 #ifdef HAVE_GFC_INTEGER_16
1095 extern void pack_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1096                      const gfc_array_l1 *, const gfc_array_i16 *);
1097 internal_proto(pack_i16);
1098 #endif
1099
1100 extern void pack_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1101                      const gfc_array_l1 *, const gfc_array_r4 *);
1102 internal_proto(pack_r4);
1103
1104 extern void pack_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1105                      const gfc_array_l1 *, const gfc_array_r8 *);
1106 internal_proto(pack_r8);
1107
1108 #ifdef HAVE_GFC_REAL_10
1109 extern void pack_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1110                      const gfc_array_l1 *, const gfc_array_r10 *);
1111 internal_proto(pack_r10);
1112 #endif
1113
1114 #ifdef HAVE_GFC_REAL_16
1115 extern void pack_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1116                      const gfc_array_l1 *, const gfc_array_r16 *);
1117 internal_proto(pack_r16);
1118 #endif
1119
1120 #ifdef HAVE_GFC_REAL_17
1121 extern void pack_r17 (gfc_array_r17 *, const gfc_array_r17 *,
1122                      const gfc_array_l1 *, const gfc_array_r17 *);
1123 internal_proto(pack_r17);
1124 #endif
1125
1126 extern void pack_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1127                      const gfc_array_l1 *, const gfc_array_c4 *);
1128 internal_proto(pack_c4);
1129
1130 extern void pack_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1131                      const gfc_array_l1 *, const gfc_array_c8 *);
1132 internal_proto(pack_c8);
1133
1134 #ifdef HAVE_GFC_REAL_10
1135 extern void pack_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1136                      const gfc_array_l1 *, const gfc_array_c10 *);
1137 internal_proto(pack_c10);
1138 #endif
1139
1140 #ifdef HAVE_GFC_REAL_16
1141 extern void pack_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1142                      const gfc_array_l1 *, const gfc_array_c16 *);
1143 internal_proto(pack_c16);
1144 #endif
1145
1146 #ifdef HAVE_GFC_REAL_17
1147 extern void pack_c17 (gfc_array_c17 *, const gfc_array_c17 *,
1148                      const gfc_array_l1 *, const gfc_array_c17 *);
1149 internal_proto(pack_c17);
1150 #endif
1151
1152 /* Internal auxiliary functions for the unpack intrinsic.  */
1153
1154 extern void unpack0_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1155                         const gfc_array_l1 *, const GFC_INTEGER_1 *);
1156 internal_proto(unpack0_i1);
1157
1158 extern void unpack0_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1159                         const gfc_array_l1 *, const GFC_INTEGER_2 *);
1160 internal_proto(unpack0_i2);
1161
1162 extern void unpack0_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1163                         const gfc_array_l1 *, const GFC_INTEGER_4 *);
1164 internal_proto(unpack0_i4);
1165
1166 extern void unpack0_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1167                         const gfc_array_l1 *, const GFC_INTEGER_8 *);
1168 internal_proto(unpack0_i8);
1169
1170 #ifdef HAVE_GFC_INTEGER_16
1171
1172 extern void unpack0_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1173                          const gfc_array_l1 *, const GFC_INTEGER_16 *);
1174 internal_proto(unpack0_i16);
1175
1176 #endif
1177
1178 extern void unpack0_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1179                         const gfc_array_l1 *, const GFC_REAL_4 *);
1180 internal_proto(unpack0_r4);
1181
1182 extern void unpack0_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1183                         const gfc_array_l1 *, const GFC_REAL_8 *);
1184 internal_proto(unpack0_r8);
1185
1186 #ifdef HAVE_GFC_REAL_10
1187
1188 extern void unpack0_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1189                          const gfc_array_l1 *, const GFC_REAL_10 *);
1190 internal_proto(unpack0_r10);
1191
1192 #endif
1193
1194 #ifdef HAVE_GFC_REAL_16
1195
1196 extern void unpack0_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1197                          const gfc_array_l1 *, const GFC_REAL_16 *);
1198 internal_proto(unpack0_r16);
1199
1200 #endif
1201
1202 #ifdef HAVE_GFC_REAL_17
1203
1204 extern void unpack0_r17 (gfc_array_r17 *, const gfc_array_r17 *,
1205                          const gfc_array_l1 *, const GFC_REAL_17 *);
1206 internal_proto(unpack0_r17);
1207
1208 #endif
1209
1210 extern void unpack0_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1211                         const gfc_array_l1 *, const GFC_COMPLEX_4 *);
1212 internal_proto(unpack0_c4);
1213
1214 extern void unpack0_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1215                         const gfc_array_l1 *, const GFC_COMPLEX_8 *);
1216 internal_proto(unpack0_c8);
1217
1218 #ifdef HAVE_GFC_COMPLEX_10
1219
1220 extern void unpack0_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1221                          const gfc_array_l1 *mask, const GFC_COMPLEX_10 *);
1222 internal_proto(unpack0_c10);
1223
1224 #endif
1225
1226 #ifdef HAVE_GFC_COMPLEX_16
1227
1228 extern void unpack0_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1229                          const gfc_array_l1 *, const GFC_COMPLEX_16 *);
1230 internal_proto(unpack0_c16);
1231
1232 #endif
1233
1234 #ifdef HAVE_GFC_COMPLEX_17
1235
1236 extern void unpack0_c17 (gfc_array_c17 *, const gfc_array_c17 *,
1237                          const gfc_array_l1 *, const GFC_COMPLEX_17 *);
1238 internal_proto(unpack0_c17);
1239
1240 #endif
1241
1242 extern void unpack1_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1243                         const gfc_array_l1 *, const gfc_array_i1 *);
1244 internal_proto(unpack1_i1);
1245
1246 extern void unpack1_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1247                         const gfc_array_l1 *, const gfc_array_i2 *);
1248 internal_proto(unpack1_i2);
1249
1250 extern void unpack1_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1251                         const gfc_array_l1 *, const gfc_array_i4 *);
1252 internal_proto(unpack1_i4);
1253
1254 extern void unpack1_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1255                         const gfc_array_l1 *, const gfc_array_i8 *);
1256 internal_proto(unpack1_i8);
1257
1258 #ifdef HAVE_GFC_INTEGER_16
1259 extern void unpack1_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1260                          const gfc_array_l1 *, const gfc_array_i16 *);
1261 internal_proto(unpack1_i16);
1262 #endif
1263
1264 extern void unpack1_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1265                         const gfc_array_l1 *, const gfc_array_r4 *);
1266 internal_proto(unpack1_r4);
1267
1268 extern void unpack1_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1269                         const gfc_array_l1 *, const gfc_array_r8 *);
1270 internal_proto(unpack1_r8);
1271
1272 #ifdef HAVE_GFC_REAL_10
1273 extern void unpack1_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1274                          const gfc_array_l1 *, const gfc_array_r10 *);
1275 internal_proto(unpack1_r10);
1276 #endif
1277
1278 #ifdef HAVE_GFC_REAL_16
1279 extern void unpack1_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1280                          const gfc_array_l1 *, const gfc_array_r16 *);
1281 internal_proto(unpack1_r16);
1282 #endif
1283
1284 #ifdef HAVE_GFC_REAL_17
1285 extern void unpack1_r17 (gfc_array_r17 *, const gfc_array_r17 *,
1286                          const gfc_array_l1 *, const gfc_array_r17 *);
1287 internal_proto(unpack1_r17);
1288 #endif
1289
1290 extern void unpack1_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1291                         const gfc_array_l1 *, const gfc_array_c4 *);
1292 internal_proto(unpack1_c4);
1293
1294 extern void unpack1_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1295                         const gfc_array_l1 *, const gfc_array_c8 *);
1296 internal_proto(unpack1_c8);
1297
1298 #ifdef HAVE_GFC_COMPLEX_10
1299 extern void unpack1_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1300                          const gfc_array_l1 *, const gfc_array_c10 *);
1301 internal_proto(unpack1_c10);
1302 #endif
1303
1304 #ifdef HAVE_GFC_COMPLEX_16
1305 extern void unpack1_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1306                          const gfc_array_l1 *, const gfc_array_c16 *);
1307 internal_proto(unpack1_c16);
1308 #endif
1309
1310 #ifdef HAVE_GFC_COMPLEX_17
1311 extern void unpack1_c17 (gfc_array_c17 *, const gfc_array_c17 *,
1312                          const gfc_array_l1 *, const gfc_array_c17 *);
1313 internal_proto(unpack1_c17);
1314 #endif
1315
1316 /* Helper functions for spread.  */
1317
1318 extern void spread_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1319                        const index_type, const index_type);
1320 internal_proto(spread_i1);
1321
1322 extern void spread_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1323                        const index_type, const index_type);
1324 internal_proto(spread_i2);
1325
1326 extern void spread_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1327                        const index_type, const index_type);
1328 internal_proto(spread_i4);
1329
1330 extern void spread_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1331                        const index_type, const index_type);
1332 internal_proto(spread_i8);
1333
1334 #ifdef HAVE_GFC_INTEGER_16
1335 extern void spread_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1336                        const index_type, const index_type);
1337 internal_proto(spread_i16);
1338
1339 #endif
1340
1341 extern void spread_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1342                        const index_type, const index_type);
1343 internal_proto(spread_r4);
1344
1345 extern void spread_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1346                        const index_type, const index_type);
1347 internal_proto(spread_r8);
1348
1349 #ifdef HAVE_GFC_REAL_10
1350 extern void spread_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1351                        const index_type, const index_type);
1352 internal_proto(spread_r10);
1353
1354 #endif
1355
1356 #ifdef HAVE_GFC_REAL_16
1357 extern void spread_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1358                        const index_type, const index_type);
1359 internal_proto(spread_r16);
1360
1361 #endif
1362
1363 #ifdef HAVE_GFC_REAL_17
1364 extern void spread_r17 (gfc_array_r17 *, const gfc_array_r17 *,
1365                        const index_type, const index_type);
1366 internal_proto(spread_r17);
1367
1368 #endif
1369
1370 extern void spread_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1371                        const index_type, const index_type);
1372 internal_proto(spread_c4);
1373
1374 extern void spread_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1375                        const index_type, const index_type);
1376 internal_proto(spread_c8);
1377
1378 #ifdef HAVE_GFC_COMPLEX_10
1379 extern void spread_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1380                        const index_type, const index_type);
1381 internal_proto(spread_c10);
1382
1383 #endif
1384
1385 #ifdef HAVE_GFC_COMPLEX_16
1386 extern void spread_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1387                        const index_type, const index_type);
1388 internal_proto(spread_c16);
1389
1390 #endif
1391
1392 #ifdef HAVE_GFC_COMPLEX_17
1393 extern void spread_c17 (gfc_array_c17 *, const gfc_array_c17 *,
1394                        const index_type, const index_type);
1395 internal_proto(spread_c17);
1396
1397 #endif
1398
1399 extern void spread_scalar_i1 (gfc_array_i1 *, const GFC_INTEGER_1 *,
1400                               const index_type, const index_type);
1401 internal_proto(spread_scalar_i1);
1402
1403 extern void spread_scalar_i2 (gfc_array_i2 *, const GFC_INTEGER_2 *,
1404                               const index_type, const index_type);
1405 internal_proto(spread_scalar_i2);
1406
1407 extern void spread_scalar_i4 (gfc_array_i4 *, const GFC_INTEGER_4 *,
1408                               const index_type, const index_type);
1409 internal_proto(spread_scalar_i4);
1410
1411 extern void spread_scalar_i8 (gfc_array_i8 *, const GFC_INTEGER_8 *,
1412                               const index_type, const index_type);
1413 internal_proto(spread_scalar_i8);
1414
1415 #ifdef HAVE_GFC_INTEGER_16
1416 extern void spread_scalar_i16 (gfc_array_i16 *, const GFC_INTEGER_16 *,
1417                                const index_type, const index_type);
1418 internal_proto(spread_scalar_i16);
1419
1420 #endif
1421
1422 extern void spread_scalar_r4 (gfc_array_r4 *, const GFC_REAL_4 *,
1423                               const index_type, const index_type);
1424 internal_proto(spread_scalar_r4);
1425
1426 extern void spread_scalar_r8 (gfc_array_r8 *, const GFC_REAL_8 *,
1427                               const index_type, const index_type);
1428 internal_proto(spread_scalar_r8);
1429
1430 #ifdef HAVE_GFC_REAL_10
1431 extern void spread_scalar_r10 (gfc_array_r10 *, const GFC_REAL_10 *,
1432                                const index_type, const index_type);
1433 internal_proto(spread_scalar_r10);
1434
1435 #endif
1436
1437 #ifdef HAVE_GFC_REAL_16
1438 extern void spread_scalar_r16 (gfc_array_r16 *, const GFC_REAL_16 *,
1439                                const index_type, const index_type);
1440 internal_proto(spread_scalar_r16);
1441
1442 #endif
1443
1444 #ifdef HAVE_GFC_REAL_17
1445 extern void spread_scalar_r17 (gfc_array_r17 *, const GFC_REAL_17 *,
1446                                const index_type, const index_type);
1447 internal_proto(spread_scalar_r17);
1448
1449 #endif
1450
1451 extern void spread_scalar_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *,
1452                               const index_type, const index_type);
1453 internal_proto(spread_scalar_c4);
1454
1455 extern void spread_scalar_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *,
1456                               const index_type, const index_type);
1457 internal_proto(spread_scalar_c8);
1458
1459 #ifdef HAVE_GFC_COMPLEX_10
1460 extern void spread_scalar_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *,
1461                                const index_type, const index_type);
1462 internal_proto(spread_scalar_c10);
1463
1464 #endif
1465
1466 #ifdef HAVE_GFC_COMPLEX_16
1467 extern void spread_scalar_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *,
1468                                const index_type, const index_type);
1469 internal_proto(spread_scalar_c16);
1470
1471 #endif
1472
1473 #ifdef HAVE_GFC_COMPLEX_17
1474 extern void spread_scalar_c17 (gfc_array_c17 *, const GFC_COMPLEX_17 *,
1475                                const index_type, const index_type);
1476 internal_proto(spread_scalar_c17);
1477
1478 #endif
1479
1480 /* string_intrinsics.c */
1481
1482 extern int compare_string (gfc_charlen_type, const char *,
1483                            gfc_charlen_type, const char *);
1484 iexport_proto(compare_string);
1485
1486 extern int compare_string_char4 (gfc_charlen_type, const gfc_char4_t *,
1487                                  gfc_charlen_type, const gfc_char4_t *);
1488 iexport_proto(compare_string_char4);
1489
1490 extern int memcmp_char4 (const void *, const void *, size_t);
1491 internal_proto(memcmp_char4);
1492
1493
1494 /* random.c */
1495
1496 extern void random_seed_i4 (GFC_INTEGER_4 * size, gfc_array_i4 * put,
1497                             gfc_array_i4 * get);
1498 iexport_proto(random_seed_i4);
1499 extern void random_seed_i8 (GFC_INTEGER_8 * size, gfc_array_i8 * put,
1500                             gfc_array_i8 * get);
1501 iexport_proto(random_seed_i8);
1502
1503 /* size.c */
1504
1505 typedef GFC_ARRAY_DESCRIPTOR (void) array_t;
1506
1507 extern index_type size0 (const array_t * array);
1508 iexport_proto(size0);
1509
1510 /* is_contiguous.c */
1511
1512 extern GFC_LOGICAL_4 is_contiguous0 (const array_t * const restrict array);
1513 iexport_proto(is_contiguous0);
1514
1515 /* bounds.c */
1516
1517 extern void bounds_equal_extents (array_t *, array_t *, const char *,
1518                                   const char *);
1519 internal_proto(bounds_equal_extents);
1520
1521 extern void bounds_reduced_extents (array_t *, array_t *, int, const char *,
1522                              const char *intrinsic);
1523 internal_proto(bounds_reduced_extents);
1524
1525 extern void bounds_iforeach_return (array_t *, array_t *, const char *);
1526 internal_proto(bounds_iforeach_return);
1527
1528 extern void bounds_ifunction_return (array_t *, const index_type *,
1529                                      const char *, const char *);
1530 internal_proto(bounds_ifunction_return);
1531
1532 extern index_type count_0 (const gfc_array_l1 *);
1533
1534 internal_proto(count_0);
1535
1536 /* Internal auxiliary functions for cshift */
1537
1538 void cshift0_i1 (gfc_array_i1 *, const gfc_array_i1 *, ptrdiff_t, int);
1539 internal_proto(cshift0_i1);
1540
1541 void cshift0_i2 (gfc_array_i2 *, const gfc_array_i2 *, ptrdiff_t, int);
1542 internal_proto(cshift0_i2);
1543
1544 void cshift0_i4 (gfc_array_i4 *, const gfc_array_i4 *, ptrdiff_t, int);
1545 internal_proto(cshift0_i4);
1546
1547 void cshift0_i8 (gfc_array_i8 *, const gfc_array_i8 *, ptrdiff_t, int);
1548 internal_proto(cshift0_i8);
1549
1550 #ifdef HAVE_GFC_INTEGER_16
1551 void cshift0_i16 (gfc_array_i16 *, const gfc_array_i16 *, ptrdiff_t, int);
1552 internal_proto(cshift0_i16);
1553 #endif
1554
1555 void cshift0_r4 (gfc_array_r4 *, const gfc_array_r4 *, ptrdiff_t, int);
1556 internal_proto(cshift0_r4);
1557
1558 void cshift0_r8 (gfc_array_r8 *, const gfc_array_r8 *, ptrdiff_t, int);
1559 internal_proto(cshift0_r8);
1560
1561 #ifdef HAVE_GFC_REAL_10
1562 void cshift0_r10 (gfc_array_r10 *, const gfc_array_r10 *, ptrdiff_t, int);
1563 internal_proto(cshift0_r10);
1564 #endif
1565
1566 #ifdef HAVE_GFC_REAL_16
1567 void cshift0_r16 (gfc_array_r16 *, const gfc_array_r16 *, ptrdiff_t, int);
1568 internal_proto(cshift0_r16);
1569 #endif
1570
1571 #ifdef HAVE_GFC_REAL_17
1572 void cshift0_r17 (gfc_array_r17 *, const gfc_array_r17 *, ptrdiff_t, int);
1573 internal_proto(cshift0_r17);
1574 #endif
1575
1576 void cshift0_c4 (gfc_array_c4 *, const gfc_array_c4 *, ptrdiff_t, int);
1577 internal_proto(cshift0_c4);
1578
1579 void cshift0_c8 (gfc_array_c8 *, const gfc_array_c8 *, ptrdiff_t, int);
1580 internal_proto(cshift0_c8);
1581
1582 #ifdef HAVE_GFC_COMPLEX_10
1583 void cshift0_c10 (gfc_array_c10 *, const gfc_array_c10 *, ptrdiff_t, int);
1584 internal_proto(cshift0_c10);
1585 #endif
1586
1587 #ifdef HAVE_GFC_COMPLEX_16
1588 void cshift0_c16 (gfc_array_c16 *, const gfc_array_c16 *, ptrdiff_t, int);
1589 internal_proto(cshift0_c16);
1590 #endif
1591
1592 #ifdef HAVE_GFC_COMPLEX_17
1593 void cshift0_c17 (gfc_array_c17 *, const gfc_array_c17 *, ptrdiff_t, int);
1594 internal_proto(cshift0_c17);
1595 #endif
1596
1597 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_1)
1598 void cshift1_4_i1 (gfc_array_i1 * const restrict,
1599         const gfc_array_i1 * const restrict,
1600         const gfc_array_i4 * const restrict,
1601         const GFC_INTEGER_4 * const restrict);
1602 internal_proto(cshift1_4_i1);
1603 #endif
1604
1605 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_2)
1606 void cshift1_4_i2 (gfc_array_i2 * const restrict,
1607         const gfc_array_i2 * const restrict,
1608         const gfc_array_i4 * const restrict,
1609         const GFC_INTEGER_4 * const restrict);
1610 internal_proto(cshift1_4_i2);
1611 #endif
1612
1613 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
1614 void cshift1_4_i4 (gfc_array_i4 * const restrict,
1615         const gfc_array_i4 * const restrict,
1616         const gfc_array_i4 * const restrict,
1617         const GFC_INTEGER_4 * const restrict);
1618 internal_proto(cshift1_4_i4);
1619 #endif
1620
1621 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
1622 void cshift1_4_i8 (gfc_array_i8 * const restrict,
1623         const gfc_array_i8 * const restrict,
1624         const gfc_array_i4 * const restrict,
1625         const GFC_INTEGER_4 * const restrict);
1626 internal_proto(cshift1_4_i8);
1627 #endif
1628
1629 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
1630 void cshift1_4_i16 (gfc_array_i16 * const restrict,
1631         const gfc_array_i16 * const restrict,
1632         const gfc_array_i4 * const restrict,
1633         const GFC_INTEGER_4 * const restrict);
1634 internal_proto(cshift1_4_i16);
1635 #endif
1636
1637 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_1)
1638 void cshift1_8_i1 (gfc_array_i1 * const restrict,
1639         const gfc_array_i1 * const restrict,
1640         const gfc_array_i8 * const restrict,
1641         const GFC_INTEGER_8 * const restrict);
1642 internal_proto(cshift1_8_i1);
1643 #endif
1644
1645 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_2)
1646 void cshift1_8_i2 (gfc_array_i2 * const restrict,
1647         const gfc_array_i2 * const restrict,
1648         const gfc_array_i8 * const restrict,
1649         const GFC_INTEGER_8 * const restrict);
1650 internal_proto(cshift1_8_i2);
1651 #endif
1652
1653 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4)
1654 void cshift1_8_i4 (gfc_array_i4 * const restrict,
1655         const gfc_array_i4 * const restrict,
1656         const gfc_array_i8 * const restrict,
1657         const GFC_INTEGER_8 * const restrict);
1658 internal_proto(cshift1_8_i4);
1659 #endif
1660
1661 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
1662 void cshift1_8_i8 (gfc_array_i8 * const restrict,
1663         const gfc_array_i8 * const restrict,
1664         const gfc_array_i8 * const restrict,
1665         const GFC_INTEGER_8 * const restrict);
1666 internal_proto(cshift1_8_i8);
1667 #endif
1668
1669 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)
1670 void cshift1_8_i16 (gfc_array_i16 * const restrict,
1671         const gfc_array_i16 * const restrict,
1672         const gfc_array_i8 * const restrict,
1673         const GFC_INTEGER_8 * const restrict);
1674 internal_proto(cshift1_8_i16);
1675 #endif
1676
1677 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_1)
1678 void cshift1_16_i1 (gfc_array_i1 * const restrict,
1679         const gfc_array_i1 * const restrict,
1680         const gfc_array_i16 * const restrict,
1681         const GFC_INTEGER_16 * const restrict);
1682 internal_proto(cshift1_16_i1);
1683 #endif
1684
1685 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_2)
1686 void cshift1_16_i2 (gfc_array_i2 * const restrict,
1687         const gfc_array_i2 * const restrict,
1688         const gfc_array_i16 * const restrict,
1689         const GFC_INTEGER_16 * const restrict);
1690 internal_proto(cshift1_16_i2);
1691 #endif
1692
1693 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4)
1694 void cshift1_16_i4 (gfc_array_i4 * const restrict,
1695         const gfc_array_i4 * const restrict,
1696         const gfc_array_i16 * const restrict,
1697         const GFC_INTEGER_16 * const restrict);
1698 internal_proto(cshift1_16_i4);
1699 #endif
1700
1701 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8)
1702 void cshift1_16_i8 (gfc_array_i8 * const restrict,
1703         const gfc_array_i8 * const restrict,
1704         const gfc_array_i16 * const restrict,
1705         const GFC_INTEGER_16 * const restrict);
1706 internal_proto(cshift1_16_i8);
1707 #endif
1708
1709 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
1710 void cshift1_16_i16 (gfc_array_i16 * const restrict,
1711         const gfc_array_i16 * const restrict,
1712         const gfc_array_i16 * const restrict,
1713         const GFC_INTEGER_16 * const restrict);
1714 internal_proto(cshift1_16_i16);
1715 #endif
1716
1717 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_4)
1718 void cshift1_4_r4 (gfc_array_r4 * const restrict,
1719         const gfc_array_r4 * const restrict,
1720         const gfc_array_i4 * const restrict,
1721         const GFC_INTEGER_4 * const restrict);
1722 internal_proto(cshift1_4_r4);
1723 #endif
1724
1725 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_8)
1726 void cshift1_4_r8 (gfc_array_r8 * const restrict,
1727         const gfc_array_r8 * const restrict,
1728         const gfc_array_i4 * const restrict,
1729         const GFC_INTEGER_4 * const restrict);
1730 internal_proto(cshift1_4_r8);
1731 #endif
1732
1733 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_10)
1734 void cshift1_4_r10 (gfc_array_r10 * const restrict,
1735         const gfc_array_r10 * const restrict,
1736         const gfc_array_i4 * const restrict,
1737         const GFC_INTEGER_4 * const restrict);
1738 internal_proto(cshift1_4_r10);
1739 #endif
1740
1741 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_16)
1742 void cshift1_4_r16 (gfc_array_r16 * const restrict,
1743         const gfc_array_r16 * const restrict,
1744         const gfc_array_i4 * const restrict,
1745         const GFC_INTEGER_4 * const restrict);
1746 internal_proto(cshift1_4_r16);
1747 #endif
1748
1749 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_17)
1750 void cshift1_4_r17 (gfc_array_r17 * const restrict,
1751         const gfc_array_r17 * const restrict,
1752         const gfc_array_i4 * const restrict,
1753         const GFC_INTEGER_4 * const restrict);
1754 internal_proto(cshift1_4_r17);
1755 #endif
1756
1757 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_4)
1758 void cshift1_8_r4 (gfc_array_r4 * const restrict,
1759         const gfc_array_r4 * const restrict,
1760         const gfc_array_i8 * const restrict,
1761         const GFC_INTEGER_8 * const restrict);
1762 internal_proto(cshift1_8_r4);
1763 #endif
1764
1765 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_8)
1766 void cshift1_8_r8 (gfc_array_r8 * const restrict,
1767         const gfc_array_r8 * const restrict,
1768         const gfc_array_i8 * const restrict,
1769         const GFC_INTEGER_8 * const restrict);
1770 internal_proto(cshift1_8_r8);
1771 #endif
1772
1773 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_10)
1774 void cshift1_8_r10 (gfc_array_r10 * const restrict,
1775         const gfc_array_r10 * const restrict,
1776         const gfc_array_i8 * const restrict,
1777         const GFC_INTEGER_8 * const restrict);
1778 internal_proto(cshift1_8_r10);
1779 #endif
1780
1781 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_16)
1782 void cshift1_8_r16 (gfc_array_r16 * const restrict,
1783         const gfc_array_r16 * const restrict,
1784         const gfc_array_i8 * const restrict,
1785         const GFC_INTEGER_8 * const restrict);
1786 internal_proto(cshift1_8_r16);
1787 #endif
1788
1789 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_17)
1790 void cshift1_8_r17 (gfc_array_r17 * const restrict,
1791         const gfc_array_r17 * const restrict,
1792         const gfc_array_i8 * const restrict,
1793         const GFC_INTEGER_8 * const restrict);
1794 internal_proto(cshift1_8_r17);
1795 #endif
1796
1797 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_4)
1798 void cshift1_16_r4 (gfc_array_r4 * const restrict,
1799         const gfc_array_r4 * const restrict,
1800         const gfc_array_i16 * const restrict,
1801         const GFC_INTEGER_16 * const restrict);
1802 internal_proto(cshift1_16_r4);
1803 #endif
1804
1805 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_8)
1806 void cshift1_16_r8 (gfc_array_r8 * const restrict,
1807         const gfc_array_r8 * const restrict,
1808         const gfc_array_i16 * const restrict,
1809         const GFC_INTEGER_16 * const restrict);
1810 internal_proto(cshift1_16_r8);
1811 #endif
1812
1813 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_10)
1814 void cshift1_16_r10 (gfc_array_r10 * const restrict,
1815         const gfc_array_r10 * const restrict,
1816         const gfc_array_i16 * const restrict,
1817         const GFC_INTEGER_16 * const restrict);
1818 internal_proto(cshift1_16_r10);
1819 #endif
1820
1821 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_16)
1822 void cshift1_16_r16 (gfc_array_r16 * const restrict,
1823         const gfc_array_r16 * const restrict,
1824         const gfc_array_i16 * const restrict,
1825         const GFC_INTEGER_16 * const restrict);
1826 internal_proto(cshift1_16_r16);
1827 #endif
1828
1829 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_17)
1830 void cshift1_16_r17 (gfc_array_r17 * const restrict,
1831         const gfc_array_r17 * const restrict,
1832         const gfc_array_i16 * const restrict,
1833         const GFC_INTEGER_16 * const restrict);
1834 internal_proto(cshift1_16_r17);
1835 #endif
1836
1837 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_4)
1838 void cshift1_4_c4 (gfc_array_c4 * const restrict,
1839         const gfc_array_c4 * const restrict,
1840         const gfc_array_i4 * const restrict,
1841         const GFC_INTEGER_4 * const restrict);
1842 internal_proto(cshift1_4_c4);
1843 #endif
1844
1845 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_8)
1846 void cshift1_4_c8 (gfc_array_c8 * const restrict,
1847         const gfc_array_c8 * const restrict,
1848         const gfc_array_i4 * const restrict,
1849         const GFC_INTEGER_4 * const restrict);
1850 internal_proto(cshift1_4_c8);
1851 #endif
1852
1853 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_10)
1854 void cshift1_4_c10 (gfc_array_c10 * const restrict,
1855         const gfc_array_c10 * const restrict,
1856         const gfc_array_i4 * const restrict,
1857         const GFC_INTEGER_4 * const restrict);
1858 internal_proto(cshift1_4_c10);
1859 #endif
1860
1861 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_16)
1862 void cshift1_4_c16 (gfc_array_c16 * const restrict,
1863         const gfc_array_c16 * const restrict,
1864         const gfc_array_i4 * const restrict,
1865         const GFC_INTEGER_4 * const restrict);
1866 internal_proto(cshift1_4_c16);
1867 #endif
1868
1869 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_17)
1870 void cshift1_4_c17 (gfc_array_c17 * const restrict,
1871         const gfc_array_c17 * const restrict,
1872         const gfc_array_i4 * const restrict,
1873         const GFC_INTEGER_4 * const restrict);
1874 internal_proto(cshift1_4_c17);
1875 #endif
1876
1877 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_4)
1878 void cshift1_8_c4 (gfc_array_c4 * const restrict,
1879         const gfc_array_c4 * const restrict,
1880         const gfc_array_i8 * const restrict,
1881         const GFC_INTEGER_8 * const restrict);
1882 internal_proto(cshift1_8_c4);
1883 #endif
1884
1885 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_8)
1886 void cshift1_8_c8 (gfc_array_c8 * const restrict,
1887         const gfc_array_c8 * const restrict,
1888         const gfc_array_i8 * const restrict,
1889         const GFC_INTEGER_8 * const restrict);
1890 internal_proto(cshift1_8_c8);
1891 #endif
1892
1893 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_10)
1894 void cshift1_8_c10 (gfc_array_c10 * const restrict,
1895         const gfc_array_c10 * const restrict,
1896         const gfc_array_i8 * const restrict,
1897         const GFC_INTEGER_8 * const restrict);
1898 internal_proto(cshift1_8_c10);
1899 #endif
1900
1901 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_16)
1902 void cshift1_8_c16 (gfc_array_c16 * const restrict,
1903         const gfc_array_c16 * const restrict,
1904         const gfc_array_i8 * const restrict,
1905         const GFC_INTEGER_8 * const restrict);
1906 internal_proto(cshift1_8_c16);
1907 #endif
1908
1909 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_17)
1910 void cshift1_8_c17 (gfc_array_c17 * const restrict,
1911         const gfc_array_c17 * const restrict,
1912         const gfc_array_i8 * const restrict,
1913         const GFC_INTEGER_8 * const restrict);
1914 internal_proto(cshift1_8_c17);
1915 #endif
1916
1917 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_4)
1918 void cshift1_16_c4 (gfc_array_c4 * const restrict,
1919         const gfc_array_c4 * const restrict,
1920         const gfc_array_i16 * const restrict,
1921         const GFC_INTEGER_16 * const restrict);
1922 internal_proto(cshift1_16_c4);
1923 #endif
1924
1925 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_8)
1926 void cshift1_16_c8 (gfc_array_c8 * const restrict,
1927         const gfc_array_c8 * const restrict,
1928         const gfc_array_i16 * const restrict,
1929         const GFC_INTEGER_16 * const restrict);
1930 internal_proto(cshift1_16_c8);
1931 #endif
1932
1933 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_10)
1934 void cshift1_16_c10 (gfc_array_c10 * const restrict,
1935         const gfc_array_c10 * const restrict,
1936         const gfc_array_i16 * const restrict,
1937         const GFC_INTEGER_16 * const restrict);
1938 internal_proto(cshift1_16_c10);
1939 #endif
1940
1941 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_16)
1942 void cshift1_16_c16 (gfc_array_c16 * const restrict,
1943         const gfc_array_c16 * const restrict,
1944         const gfc_array_i16 * const restrict,
1945         const GFC_INTEGER_16 * const restrict);
1946 internal_proto(cshift1_16_c16);
1947 #endif
1948
1949 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_17)
1950 void cshift1_16_c17 (gfc_array_c17 * const restrict,
1951         const gfc_array_c17 * const restrict,
1952         const gfc_array_i16 * const restrict,
1953         const GFC_INTEGER_16 * const restrict);
1954 internal_proto(cshift1_16_c17);
1955 #endif
1956
1957 /* Prototypes for the POWER __ieee128 functions.  */
1958 #ifdef POWER_IEEE128
1959 extern __float128 __acoshieee128 (__float128)
1960   __attribute__ ((__nothrow__, __leaf__));
1961 extern __float128 __acosieee128 (__float128)
1962   __attribute__ ((__nothrow__, __leaf__));
1963 extern __float128 __asinhieee128 (__float128)
1964   __attribute__ ((__nothrow__, __leaf__));
1965 extern __float128 __asinieee128 (__float128)
1966   __attribute__ ((__nothrow__, __leaf__));
1967 extern __float128 __atan2ieee128 (__float128)
1968   __attribute__ ((__nothrow__, __leaf__));
1969 extern __float128 __atanhieee128 (__float128)
1970   __attribute__ ((__nothrow__, __leaf__));
1971 extern __float128 __atanieee128 (__float128)
1972   __attribute__ ((__nothrow__, __leaf__));
1973 extern __float128 __copysignieee128 (__float128, __float128)
1974   __attribute__ ((__nothrow__, __leaf__));
1975 extern __float128 __coshieee128 (__float128)
1976   __attribute__ ((__nothrow__, __leaf__));
1977 extern __float128 __cosieee128 (__float128)
1978   __attribute__ ((__nothrow__, __leaf__));
1979 extern __float128 __erfcieee128 (__float128)
1980   __attribute__ ((__nothrow__, __leaf__));
1981 extern __float128 __erfieee128 (__float128)
1982   __attribute__ ((__nothrow__, __leaf__));
1983 extern __float128 __expieee128 (__float128)
1984   __attribute__ ((__nothrow__, __leaf__));
1985 extern __float128 __fabsieee128 (__float128)
1986   __attribute__ ((__nothrow__, __leaf__));
1987 extern __float128 __fmaieee128 (__float128, __float128, __float128)
1988   __attribute__ ((__nothrow__, __leaf__));
1989 extern __float128 __fmodieee128 (__float128, __float128)
1990   __attribute__ ((__nothrow__, __leaf__));
1991 extern __float128 __jnieee128 (int, __float128)
1992   __attribute__ ((__nothrow__, __leaf__));
1993 extern __float128 __log10ieee128 (__float128)
1994   __attribute__ ((__nothrow__, __leaf__));
1995 extern __float128 __logieee128 (__float128)
1996   __attribute__ ((__nothrow__, __leaf__));
1997 extern __float128 __powieee128 (__float128)
1998   __attribute__ ((__nothrow__, __leaf__));
1999 extern __float128 __sinhieee128 (__float128)
2000   __attribute__ ((__nothrow__, __leaf__));
2001 extern __float128 __sinieee128 (__float128)
2002   __attribute__ ((__nothrow__, __leaf__));
2003 extern __float128 __sqrtieee128 (__float128)
2004   __attribute__ ((__nothrow__, __leaf__));
2005 extern __float128 __tanhieee128 (__float128)
2006   __attribute__ ((__nothrow__, __leaf__));
2007 extern __float128 __tanieee128 (__float128)
2008   __attribute__ ((__nothrow__, __leaf__));
2009 extern __float128 __ynieee128 (int , __float128)
2010   __attribute__ ((__nothrow__, __leaf__));
2011 extern __float128 __strtoieee128 (const char *, char **)
2012   __attribute__ ((__nothrow__, __leaf__));
2013 extern int __snprintfieee128 (char *, size_t, const char *, ...)
2014   __attribute__ ((__nothrow__));
2015
2016 #endif
2017
2018 /* We always have these.  */
2019
2020 #define HAVE_GFC_UINTEGER_1 1
2021 #define HAVE_GFC_UINTEGER_4 1
2022
2023 #endif  /* LIBGFOR_H  */