libgfortran/libgfortran.h

   1 /* Common declarations for all of libgfortran.
   2    Copyright (C) 2002-2024 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 #if defined(HAVE_FLOAT128) && !defined(USE_IEC_60559)
  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 #define GFC_UINTEGER_1_HUGE ((GFC_UINTEGER_1) -1)
 311 #define GFC_UINTEGER_2_HUGE ((GFC_UINTEGER_2) -1)
 312 #define GFC_UINTEGER_4_HUGE ((GFC_UINTEGER_4) -1)
 313 #define GFC_UINTEGER_8_HUGE ((GFC_UINTEGER_8) -1)
 314 #ifdef HAVE_GFC_UINTEGER_16
 315 #define GFC_UINTEGER_16_HUGE ((GFC_UINTEGER_16) -1)
 316 #endif
 317
 318
 319 /* M{IN,AX}{LOC,VAL} need also infinities and NaNs if supported.  */
 320
 321 #if __FLT_HAS_INFINITY__
 322 # define GFC_REAL_4_INFINITY __builtin_inff ()
 323 #endif
 324 #if __DBL_HAS_INFINITY__
 325 # define GFC_REAL_8_INFINITY __builtin_inf ()
 326 #endif
 327 #if __LDBL_HAS_INFINITY__
 328 # ifdef HAVE_GFC_REAL_10
 329 #  define GFC_REAL_10_INFINITY __builtin_infl ()
 330 # endif
 331 # ifdef HAVE_GFC_REAL_16
 332 #  ifdef GFC_REAL_16_IS_LONG_DOUBLE
 333 #   define GFC_REAL_16_INFINITY __builtin_infl ()
 334 #  elif defined GFC_REAL_16_USE_IEC_60559
 335 #   define GFC_REAL_16_INFINITY __builtin_inff128 ()
 336 #  else
 337 #   define GFC_REAL_16_INFINITY __builtin_infq ()
 338 #  endif
 339 # endif
 340 # ifdef HAVE_GFC_REAL_17
 341 #  define GFC_REAL_17_INFINITY __builtin_inff128 ()
 342 # endif
 343 #endif
 344 #if __FLT_HAS_QUIET_NAN__
 345 # define GFC_REAL_4_QUIET_NAN __builtin_nanf ("")
 346 #endif
 347 #if __DBL_HAS_QUIET_NAN__
 348 # define GFC_REAL_8_QUIET_NAN __builtin_nan ("")
 349 #endif
 350 #if __LDBL_HAS_QUIET_NAN__
 351 # ifdef HAVE_GFC_REAL_10
 352 #  define GFC_REAL_10_QUIET_NAN __builtin_nanl ("")
 353 # endif
 354 # ifdef HAVE_GFC_REAL_16
 355 #  ifdef GFC_REAL_16_IS_LONG_DOUBLE
 356 #   define GFC_REAL_16_QUIET_NAN __builtin_nanl ("")
 357 #  elif defined GFC_REAL_16_USE_IEC_60559
 358 #   define GFC_REAL_16_QUIET_NAN __builtin_nanf128 ("")
 359 #  else
 360 #   define GFC_REAL_16_QUIET_NAN nanq ("")
 361 #  endif
 362 # endif
 363 # ifdef HAVE_GFC_REAL_17
 364 #  define GFC_REAL_17_QUIET_NAN __builtin_nanf128 ("")
 365 # endif
 366 #endif
 367
 368 typedef struct descriptor_dimension
 369 {
 370   index_type _stride;
 371   index_type lower_bound;
 372   index_type _ubound;
 373 }
 374 descriptor_dimension;
 375
 376 typedef struct dtype_type
 377 {
 378   size_t elem_len;
 379   int version;
 380   signed char rank;
 381   signed char type;
 382   signed short attribute;
 383 }
 384 dtype_type;
 385
 386 #define GFC_ARRAY_DESCRIPTOR(type) \
 387 struct {\
 388   type *base_addr;\
 389   size_t offset;\
 390   dtype_type dtype;\
 391   index_type span;\
 392   descriptor_dimension dim[];\
 393 }
 394
 395 /* Commonly used array descriptor types.  */
 396 typedef GFC_ARRAY_DESCRIPTOR (void) gfc_array_void;
 397 typedef GFC_ARRAY_DESCRIPTOR (char) gfc_array_char;
 398 typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_1) gfc_array_i1;
 399 typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_2) gfc_array_i2;
 400 typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_4) gfc_array_i4;
 401 typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_8) gfc_array_i8;
 402 typedef GFC_ARRAY_DESCRIPTOR (index_type) gfc_array_index_type;
 403 #ifdef HAVE_GFC_INTEGER_16
 404 typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_16) gfc_array_i16;
 405 #endif
 406 typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_4) gfc_array_r4;
 407 typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_8) gfc_array_r8;
 408 #ifdef HAVE_GFC_REAL_10
 409 typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_10) gfc_array_r10;
 410 #endif
 411 #ifdef HAVE_GFC_REAL_16
 412 typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_16) gfc_array_r16;
 413 #endif
 414 #ifdef HAVE_GFC_REAL_17
 415 typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_17) gfc_array_r17;
 416 #endif
 417 typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_4) gfc_array_c4;
 418 typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_8) gfc_array_c8;
 419 #ifdef HAVE_GFC_COMPLEX_10
 420 typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_10) gfc_array_c10;
 421 #endif
 422 #ifdef HAVE_GFC_COMPLEX_16
 423 typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_16) gfc_array_c16;
 424 #endif
 425 #ifdef HAVE_GFC_COMPLEX_17
 426 typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_17) gfc_array_c17;
 427 #endif
 428 typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_1) gfc_array_l1;
 429 typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_2) gfc_array_l2;
 430 typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_4) gfc_array_l4;
 431 typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_8) gfc_array_l8;
 432 #ifdef HAVE_GFC_LOGICAL_16
 433 typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_16) gfc_array_l16;
 434 #endif
 435
 436 typedef GFC_ARRAY_DESCRIPTOR (GFC_UINTEGER_1) gfc_array_s1;
 437 typedef GFC_ARRAY_DESCRIPTOR (GFC_UINTEGER_4) gfc_array_s4;
 438
 439 /* These are for when you actually want to declare a descriptor, as
 440    opposed to a pointer to it.  */
 441
 442 #define GFC_FULL_ARRAY_DESCRIPTOR(r, type) \
 443 struct {\
 444   type *base_addr;\
 445   size_t offset;\
 446   dtype_type dtype;\
 447   index_type span;\
 448   descriptor_dimension dim[r];\
 449 }
 450
 451 typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_full_array_i4;
 452
 453 #define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype.rank)
 454 #define GFC_DESCRIPTOR_TYPE(desc) ((desc)->dtype.type)
 455 #define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype.elem_len)
 456 #define GFC_DESCRIPTOR_DATA(desc) ((desc)->base_addr)
 457 #define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
 458 #define GFC_DESCRIPTOR_SPAN(desc) ((desc)->span)
 459
 460 #define GFC_DIMENSION_LBOUND(dim) ((dim).lower_bound)
 461 #define GFC_DIMENSION_UBOUND(dim) ((dim)._ubound)
 462 #define GFC_DIMENSION_STRIDE(dim) ((dim)._stride)
 463 #define GFC_DIMENSION_EXTENT(dim) ((dim)._ubound + 1 - (dim).lower_bound)
 464 #define GFC_DIMENSION_SET(dim,lb,ub,str) \
 465   do \
 466     { \
 467       (dim).lower_bound = lb;                   \
 468       (dim)._ubound = ub;                       \
 469       (dim)._stride = str;                      \
 470     } while (0)
 471
 472
 473 #define GFC_DESCRIPTOR_LBOUND(desc,i) ((desc)->dim[i].lower_bound)
 474 #define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i]._ubound)
 475 #define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i]._ubound + 1 \
 476                                       - (desc)->dim[i].lower_bound)
 477 #define GFC_DESCRIPTOR_EXTENT_BYTES(desc,i) \
 478   (GFC_DESCRIPTOR_EXTENT(desc,i) * GFC_DESCRIPTOR_SIZE(desc))
 479
 480 #define GFC_DESCRIPTOR_STRIDE(desc,i) ((desc)->dim[i]._stride)
 481 #define GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) \
 482   (GFC_DESCRIPTOR_STRIDE(desc,i) * GFC_DESCRIPTOR_SIZE(desc))
 483
 484 /* Macros to get both the size and the type with a single masking operation  */
 485
 486 #define GFC_DTYPE_SIZE_MASK (-((index_type) 1 << GFC_DTYPE_SIZE_SHIFT))
 487 #define GFC_DTYPE_TYPE_SIZE_MASK (GFC_DTYPE_SIZE_MASK | GFC_DTYPE_TYPE_MASK)
 488
 489 #define GFC_DTYPE_TYPE_SIZE(desc) (( ((desc)->dtype.type << GFC_DTYPE_TYPE_SHIFT) \
 490     | ((desc)->dtype.elem_len << GFC_DTYPE_SIZE_SHIFT) ) & GFC_DTYPE_TYPE_SIZE_MASK)
 491
 492 /* Macros to set size and type information.  */
 493
 494 #define GFC_DTYPE_COPY(a,b) do { (a)->dtype = (b)->dtype; } while(0)
 495 #define GFC_DTYPE_IS_UNSET(a) (unlikely((a)->dtype.elem_len == 0))
 496 #define GFC_DTYPE_CLEAR(a) do { (a)->dtype.elem_len = 0; \
 497                                 (a)->dtype.version = 0; \
 498                                 (a)->dtype.rank = 0; \
 499                                 (a)->dtype.type = 0; \
 500                                 (a)->dtype.attribute = 0; \
 501 } while(0)
 502
 503 #define GFC_DTYPE_INTEGER_1 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
 504    | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
 505 #define GFC_DTYPE_INTEGER_2 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
 506    | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
 507 #define GFC_DTYPE_INTEGER_4 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
 508    | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
 509 #define GFC_DTYPE_INTEGER_8 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
 510    | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
 511 #ifdef HAVE_GFC_INTEGER_16
 512 #define GFC_DTYPE_INTEGER_16 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
 513    | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
 514 #endif
 515
 516 #define GFC_DTYPE_LOGICAL_1 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
 517    | (sizeof(GFC_LOGICAL_1) << GFC_DTYPE_SIZE_SHIFT))
 518 #define GFC_DTYPE_LOGICAL_2 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
 519    | (sizeof(GFC_LOGICAL_2) << GFC_DTYPE_SIZE_SHIFT))
 520 #define GFC_DTYPE_LOGICAL_4 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
 521    | (sizeof(GFC_LOGICAL_4) << GFC_DTYPE_SIZE_SHIFT))
 522 #define GFC_DTYPE_LOGICAL_8 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
 523    | (sizeof(GFC_LOGICAL_8) << GFC_DTYPE_SIZE_SHIFT))
 524 #ifdef HAVE_GFC_LOGICAL_16
 525 #define GFC_DTYPE_LOGICAL_16 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
 526    | (sizeof(GFC_LOGICAL_16) << GFC_DTYPE_SIZE_SHIFT))
 527 #endif
 528
 529 #define GFC_DTYPE_REAL_4 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
 530    | (sizeof(GFC_REAL_4) << GFC_DTYPE_SIZE_SHIFT))
 531 #define GFC_DTYPE_REAL_8 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
 532    | (sizeof(GFC_REAL_8) << GFC_DTYPE_SIZE_SHIFT))
 533 #ifdef HAVE_GFC_REAL_10
 534 #define GFC_DTYPE_REAL_10  ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
 535    | (sizeof(GFC_REAL_10) << GFC_DTYPE_SIZE_SHIFT))
 536 #endif
 537 #ifdef HAVE_GFC_REAL_16
 538 #define GFC_DTYPE_REAL_16 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
 539    | (sizeof(GFC_REAL_16) << GFC_DTYPE_SIZE_SHIFT))
 540 #endif
 541 #ifdef HAVE_GFC_REAL_17
 542 #define GFC_DTYPE_REAL_17 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
 543    | (sizeof(GFC_REAL_17) << GFC_DTYPE_SIZE_SHIFT))
 544 #endif
 545
 546 #define GFC_DTYPE_COMPLEX_4 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
 547    | (sizeof(GFC_COMPLEX_4) << GFC_DTYPE_SIZE_SHIFT))
 548 #define GFC_DTYPE_COMPLEX_8 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
 549    | (sizeof(GFC_COMPLEX_8) << GFC_DTYPE_SIZE_SHIFT))
 550 #ifdef HAVE_GFC_COMPLEX_10
 551 #define GFC_DTYPE_COMPLEX_10 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
 552    | (sizeof(GFC_COMPLEX_10) << GFC_DTYPE_SIZE_SHIFT))
 553 #endif
 554 #ifdef HAVE_GFC_COMPLEX_16
 555 #define GFC_DTYPE_COMPLEX_16 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
 556    | (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT))
 557 #endif
 558 #ifdef HAVE_GFC_COMPLEX_17
 559 #define GFC_DTYPE_COMPLEX_17 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
 560    | (sizeof(GFC_COMPLEX_17) << GFC_DTYPE_SIZE_SHIFT))
 561 #endif
 562
 563 /* Macros to determine the alignment of pointers.  */
 564
 565 #define GFC_UNALIGNED_2(x) (((uintptr_t)(x)) & \
 566                             (__alignof__(GFC_INTEGER_2) - 1))
 567 #define GFC_UNALIGNED_4(x) (((uintptr_t)(x)) & \
 568                             (__alignof__(GFC_INTEGER_4) - 1))
 569 #define GFC_UNALIGNED_8(x) (((uintptr_t)(x)) & \
 570                             (__alignof__(GFC_INTEGER_8) - 1))
 571 #ifdef HAVE_GFC_INTEGER_16
 572 #define GFC_UNALIGNED_16(x) (((uintptr_t)(x)) & \
 573                              (__alignof__(GFC_INTEGER_16) - 1))
 574 #endif
 575
 576 #define GFC_UNALIGNED_C4(x) (((uintptr_t)(x)) & \
 577                              (__alignof__(GFC_COMPLEX_4) - 1))
 578
 579 #define GFC_UNALIGNED_C8(x) (((uintptr_t)(x)) & \
 580                              (__alignof__(GFC_COMPLEX_8) - 1))
 581
 582 /* Generic vtab structure.  */
 583 typedef struct
 584 {
 585   GFC_INTEGER_4 _hash;
 586   size_t _size;
 587   struct gfc_vtype_generic_t *_extends;
 588   void *_def_init;
 589   void (*_copy) (const void *, void *);
 590   void *(*_final);
 591   void (*_deallocate) (void *);
 592 } gfc_vtype_generic_t;
 593
 594 /* Generic class structure.  */
 595 #define GFC_CLASS_T(type) \
 596   struct \
 597   { \
 598     type _data; \
 599     gfc_vtype_generic_t *_vptr; \
 600     size_t _len; \
 601   }
 602
 603 typedef GFC_CLASS_T (GFC_ARRAY_DESCRIPTOR (void)) gfc_class_array_t;
 604
 605 /* Runtime library include.  */
 606 #define stringize(x) expand_macro(x)
 607 #define expand_macro(x) # x
 608
 609 /* Runtime options structure.  */
 610
 611 typedef struct
 612 {
 613   int stdin_unit, stdout_unit, stderr_unit, optional_plus;
 614   int locus;
 615
 616   int separator_len;
 617   const char *separator;
 618
 619   int all_unbuffered, unbuffered_preconnected;
 620   int fpe, backtrace;
 621   int unformatted_buffer_size, formatted_buffer_size;
 622 }
 623 options_t;
 624
 625 extern options_t options;
 626 internal_proto(options);
 627
 628 extern void backtrace_handler (int);
 629 internal_proto(backtrace_handler);
 630
 631
 632 /* Compile-time options that will influence the library.  */
 633
 634 typedef struct
 635 {
 636   int warn_std;
 637   int allow_std;
 638   int pedantic;
 639   int convert;
 640   int backtrace;
 641   int sign_zero;
 642   size_t record_marker;
 643   int max_subrecord_length;
 644   int bounds_check;
 645   int fpe_summary;
 646 }
 647 compile_options_t;
 648
 649 extern compile_options_t compile_options;
 650 internal_proto(compile_options);
 651
 652 extern void init_compile_options (void);
 653 internal_proto(init_compile_options);
 654
 655 #define GFC_MAX_SUBRECORD_LENGTH 2147483639   /* 2**31 - 9 */
 656
 657 /* Structure for statement options.  */
 658
 659 typedef struct
 660 {
 661   const char *name;
 662   int value;
 663 }
 664 st_option;
 665
 666
 667 /* This is returned by notification_std to know if, given the flags
 668    that were given (-std=, -pedantic) we should issue an error, a warning
 669    or nothing.  */
 670 typedef enum
 671 { NOTIFICATION_SILENT, NOTIFICATION_WARNING, NOTIFICATION_ERROR }
 672 notification;
 673
 674
 675 /* The filename and line number don't go inside the globals structure.
 676    They are set by the rest of the program and must be linked to.  */
 677
 678 /* Location of the current library call (optional).  */
 679 extern unsigned line;
 680 iexport_data_proto(line);
 681
 682 extern char *filename;
 683 iexport_data_proto(filename);
 684
 685
 686 #define CHARACTER2(name) \
 687               gfc_charlen_type name ## _len; \
 688               char * name
 689
 690 typedef struct st_parameter_common
 691 {
 692   GFC_INTEGER_4 flags;
 693   GFC_INTEGER_4 unit;
 694   const char *filename;
 695   GFC_INTEGER_4 line;
 696   CHARACTER2 (iomsg);
 697   GFC_INTEGER_4 *iostat;
 698 }
 699 st_parameter_common;
 700
 701 #undef CHARACTER2
 702
 703 #define IOPARM_LIBRETURN_MASK           (3 << 0)
 704 #define IOPARM_LIBRETURN_OK             (0 << 0)
 705 #define IOPARM_LIBRETURN_ERROR          (1 << 0)
 706 #define IOPARM_LIBRETURN_END            (2 << 0)
 707 #define IOPARM_LIBRETURN_EOR            (3 << 0)
 708 #define IOPARM_ERR                      (1 << 2)
 709 #define IOPARM_END                      (1 << 3)
 710 #define IOPARM_EOR                      (1 << 4)
 711 #define IOPARM_HAS_IOSTAT               (1 << 5)
 712 #define IOPARM_HAS_IOMSG                (1 << 6)
 713
 714 #define IOPARM_COMMON_MASK              ((1 << 7) - 1)
 715
 716 /* Make sure to keep in sync with io/io.h (st_parameter_open).  */
 717 #define IOPARM_OPEN_HAS_RECL_IN         (1 << 7)
 718 #define IOPARM_OPEN_HAS_FILE            (1 << 8)
 719 #define IOPARM_OPEN_HAS_STATUS          (1 << 9)
 720 #define IOPARM_OPEN_HAS_ACCESS          (1 << 10)
 721 #define IOPARM_OPEN_HAS_FORM            (1 << 11)
 722 #define IOPARM_OPEN_HAS_BLANK           (1 << 12)
 723 #define IOPARM_OPEN_HAS_POSITION        (1 << 13)
 724 #define IOPARM_OPEN_HAS_ACTION          (1 << 14)
 725 #define IOPARM_OPEN_HAS_DELIM           (1 << 15)
 726 #define IOPARM_OPEN_HAS_PAD             (1 << 16)
 727 #define IOPARM_OPEN_HAS_CONVERT         (1 << 17)
 728 #define IOPARM_OPEN_HAS_DECIMAL         (1 << 18)
 729 #define IOPARM_OPEN_HAS_ENCODING        (1 << 19)
 730 #define IOPARM_OPEN_HAS_ROUND           (1 << 20)
 731 #define IOPARM_OPEN_HAS_SIGN            (1 << 21)
 732 #define IOPARM_OPEN_HAS_ASYNCHRONOUS    (1 << 22)
 733 #define IOPARM_OPEN_HAS_NEWUNIT         (1 << 23)
 734 #define IOPARM_OPEN_HAS_READONLY        (1 << 24)
 735 #define IOPARM_OPEN_HAS_CC              (1 << 25)
 736 #define IOPARM_OPEN_HAS_SHARE           (1 << 26)
 737
 738 /* library start function and end macro.  These can be expanded if needed
 739    in the future.  cmp is st_parameter_common *cmp  */
 740
 741 extern void library_start (st_parameter_common *);
 742 internal_proto(library_start);
 743
 744 #define library_end()
 745
 746 /* main.c */
 747
 748 extern void stupid_function_name_for_static_linking (void);
 749 internal_proto(stupid_function_name_for_static_linking);
 750
 751 extern void set_args (int, char **);
 752 iexport_proto(set_args);
 753
 754 extern void get_args (int *, char ***);
 755 internal_proto(get_args);
 756
 757 /* backtrace.c */
 758
 759 extern void show_backtrace (bool);
 760 internal_proto(show_backtrace);
 761
 762
 763 /* error.c */
 764
 765 #if defined(HAVE_GFC_REAL_16)
 766 #define GFC_LARGEST_BUF (sizeof (GFC_REAL_16))
 767 #elif defined(HAVE_GFC_INTEGER_16)
 768 #define GFC_LARGEST_BUF (sizeof (GFC_INTEGER_LARGEST))
 769 #elif defined(HAVE_GFC_REAL_10)
 770 #define GFC_LARGEST_BUF (sizeof (GFC_REAL_10))
 771 #else
 772 #define GFC_LARGEST_BUF (sizeof (GFC_INTEGER_LARGEST))
 773 #endif
 774
 775 #define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 1)
 776 #define GFC_XTOA_BUF_SIZE (GFC_LARGEST_BUF * 2 + 1)
 777 #define GFC_OTOA_BUF_SIZE (GFC_LARGEST_BUF * 3 + 1)
 778 #define GFC_BTOA_BUF_SIZE (GFC_LARGEST_BUF * 8 + 1)
 779
 780 extern _Noreturn void sys_abort (void);
 781 internal_proto(sys_abort);
 782
 783 extern _Noreturn void exit_error (int);
 784 internal_proto(exit_error);
 785
 786 extern ssize_t estr_write (const char *);
 787 internal_proto(estr_write);
 788
 789 #if !defined(HAVE_WRITEV) && !defined(HAVE_SYS_UIO_H)
 790 struct iovec {
 791   void  *iov_base;    /* Starting address */
 792   size_t iov_len;     /* Number of bytes to transfer */
 793 };
 794 #endif
 795
 796 extern ssize_t estr_writev (const struct iovec *iov, int iovcnt);
 797 internal_proto(estr_writev);
 798
 799 extern int st_printf (const char *, ...)
 800   __attribute__((format (gfc_printf, 1, 2)));
 801 internal_proto(st_printf);
 802
 803 extern _Noreturn void os_error (const char *);
 804 iexport_proto(os_error);
 805
 806 extern _Noreturn void os_error_at (const char *, const char *, ...)
 807   __attribute__ ((format (gfc_printf, 2, 3)));
 808 iexport_proto(os_error_at);
 809
 810 extern void show_locus (st_parameter_common *);
 811 internal_proto(show_locus);
 812
 813 extern _Noreturn void runtime_error (const char *, ...)
 814      __attribute__ ((format (gfc_printf, 1, 2)));
 815 iexport_proto(runtime_error);
 816
 817 extern _Noreturn void runtime_error_at (const char *, const char *, ...)
 818      __attribute__ ((format (gfc_printf, 2, 3)));
 819 iexport_proto(runtime_error_at);
 820
 821 extern void runtime_warning_at (const char *, const char *, ...)
 822      __attribute__ ((format (gfc_printf, 2, 3)));
 823 iexport_proto(runtime_warning_at);
 824
 825 extern _Noreturn void internal_error (st_parameter_common *, const char *);
 826 internal_proto(internal_error);
 827
 828 extern const char *translate_error (int);
 829 internal_proto(translate_error);
 830
 831 extern void generate_error (st_parameter_common *, int, const char *);
 832 iexport_proto(generate_error);
 833
 834 extern bool generate_error_common (st_parameter_common *, int, const char *);
 835 iexport_proto(generate_error_common);
 836
 837 extern void generate_warning (st_parameter_common *, const char *);
 838 internal_proto(generate_warning);
 839
 840 extern bool notify_std (st_parameter_common *, int, const char *);
 841 internal_proto(notify_std);
 842
 843 extern notification notification_std(int);
 844 internal_proto(notification_std);
 845
 846 extern char *gf_strerror (int, char *, size_t);
 847 internal_proto(gf_strerror);
 848
 849 /* fpu.c */
 850
 851 extern void set_fpu (void);
 852 internal_proto(set_fpu);
 853
 854 extern int get_fpu_trap_exceptions (void);
 855 internal_proto(get_fpu_trap_exceptions);
 856
 857 extern void set_fpu_trap_exceptions (int, int);
 858 internal_proto(set_fpu_trap_exceptions);
 859
 860 extern int support_fpu_trap (int);
 861 internal_proto(support_fpu_trap);
 862
 863 extern int get_fpu_except_flags (void);
 864 internal_proto(get_fpu_except_flags);
 865
 866 extern void set_fpu_except_flags (int, int);
 867 internal_proto(set_fpu_except_flags);
 868
 869 extern int support_fpu_flag (int);
 870 internal_proto(support_fpu_flag);
 871
 872 extern void set_fpu_rounding_mode (int);
 873 internal_proto(set_fpu_rounding_mode);
 874
 875 extern int get_fpu_rounding_mode (void);
 876 internal_proto(get_fpu_rounding_mode);
 877
 878 extern int support_fpu_rounding_mode (int);
 879 internal_proto(support_fpu_rounding_mode);
 880
 881 extern void get_fpu_state (void *);
 882 internal_proto(get_fpu_state);
 883
 884 extern void set_fpu_state (void *);
 885 internal_proto(set_fpu_state);
 886
 887 extern int get_fpu_underflow_mode (void);
 888 internal_proto(get_fpu_underflow_mode);
 889
 890 extern void set_fpu_underflow_mode (int);
 891 internal_proto(set_fpu_underflow_mode);
 892
 893 extern int support_fpu_underflow_control (int);
 894 internal_proto(support_fpu_underflow_control);
 895
 896 /* memory.c */
 897
 898 extern void *xmalloc (size_t) __attribute__ ((malloc));
 899 internal_proto(xmalloc);
 900
 901 extern void *xmallocarray (size_t, size_t) __attribute__ ((malloc));
 902 internal_proto(xmallocarray);
 903
 904 extern void *xcalloc (size_t, size_t) __attribute__ ((malloc));
 905 internal_proto(xcalloc);
 906
 907 extern void *xrealloc (void *, size_t);
 908 internal_proto(xrealloc);
 909
 910 /* environ.c */
 911
 912 extern void init_variables (void);
 913 internal_proto(init_variables);
 914
 915 unit_convert get_unformatted_convert (int);
 916 internal_proto(get_unformatted_convert);
 917
 918 /* Secure getenv() which returns NULL if running as SUID/SGID.  */
 919 #ifndef HAVE_SECURE_GETENV
 920 #if defined(HAVE_GETUID) && defined(HAVE_GETEUID) \
 921   && defined(HAVE_GETGID) && defined(HAVE_GETEGID)
 922 #define FALLBACK_SECURE_GETENV
 923 extern char *secure_getenv (const char *);
 924 internal_proto(secure_getenv);
 925 #else
 926 #define secure_getenv getenv
 927 #endif
 928 #endif
 929
 930 /* string.c */
 931
 932 extern int find_option (st_parameter_common *, const char *, gfc_charlen_type,
 933                         const st_option *, const char *);
 934 internal_proto(find_option);
 935
 936 extern gfc_charlen_type fstrlen (const char *, gfc_charlen_type);
 937 internal_proto(fstrlen);
 938
 939 extern gfc_charlen_type fstrcpy (char *, gfc_charlen_type, const char *, gfc_charlen_type);
 940 internal_proto(fstrcpy);
 941
 942 extern gfc_charlen_type cf_strcpy (char *, gfc_charlen_type, const char *);
 943 internal_proto(cf_strcpy);
 944
 945 extern gfc_charlen_type string_len_trim (gfc_charlen_type, const char *);
 946 export_proto(string_len_trim);
 947
 948 extern gfc_charlen_type string_len_trim_char4 (gfc_charlen_type,
 949                                                const gfc_char4_t *);
 950 export_proto(string_len_trim_char4);
 951
 952 extern char *fc_strdup(const char *, gfc_charlen_type);
 953 internal_proto(fc_strdup);
 954
 955 extern char *fc_strdup_notrim(const char *, gfc_charlen_type);
 956 internal_proto(fc_strdup_notrim);
 957
 958 extern const char *gfc_itoa(GFC_UINTEGER_LARGEST, char *, size_t);
 959 internal_proto(gfc_itoa);
 960
 961 /* io/intrinsics.c */
 962
 963 extern void flush_all_units (void);
 964 internal_proto(flush_all_units);
 965
 966 /* io.c */
 967
 968 extern void init_units (void);
 969 internal_proto(init_units);
 970
 971 extern void close_units (void);
 972 internal_proto(close_units);
 973
 974 extern int unit_to_fd (int);
 975 internal_proto(unit_to_fd);
 976
 977 extern char * filename_from_unit (int);
 978 internal_proto(filename_from_unit);
 979
 980 /* stop.c */
 981
 982 extern _Noreturn void stop_string (const char *, size_t, bool);
 983 export_proto(stop_string);
 984
 985 /* reshape_packed.c */
 986
 987 extern void reshape_packed (char *, index_type, const char *, index_type,
 988                             const char *, index_type);
 989 internal_proto(reshape_packed);
 990
 991 /* Repacking functions.  These are called internally by internal_pack
 992    and internal_unpack.  */
 993
 994 GFC_INTEGER_1 *internal_pack_1 (gfc_array_i1 *);
 995 internal_proto(internal_pack_1);
 996
 997 GFC_INTEGER_2 *internal_pack_2 (gfc_array_i2 *);
 998 internal_proto(internal_pack_2);
 999
1000 GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *);
1001 internal_proto(internal_pack_4);
1002
1003 GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *);
1004 internal_proto(internal_pack_8);
1005
1006 #if defined HAVE_GFC_INTEGER_16
1007 GFC_INTEGER_16 *internal_pack_16 (gfc_array_i16 *);
1008 internal_proto(internal_pack_16);
1009 #endif
1010
1011 GFC_REAL_4 *internal_pack_r4 (gfc_array_r4 *);
1012 internal_proto(internal_pack_r4);
1013
1014 GFC_REAL_8 *internal_pack_r8 (gfc_array_r8 *);
1015 internal_proto(internal_pack_r8);
1016
1017 #if defined HAVE_GFC_REAL_10
1018 GFC_REAL_10 *internal_pack_r10 (gfc_array_r10 *);
1019 internal_proto(internal_pack_r10);
1020 #endif
1021
1022 #if defined HAVE_GFC_REAL_16
1023 GFC_REAL_16 *internal_pack_r16 (gfc_array_r16 *);
1024 internal_proto(internal_pack_r16);
1025 #endif
1026
1027 #if defined HAVE_GFC_REAL_17
1028 GFC_REAL_17 *internal_pack_r17 (gfc_array_r17 *);
1029 internal_proto(internal_pack_r17);
1030 #endif
1031
1032 GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *);
1033 internal_proto(internal_pack_c4);
1034
1035 GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *);
1036 internal_proto(internal_pack_c8);
1037
1038 #if defined HAVE_GFC_COMPLEX_10
1039 GFC_COMPLEX_10 *internal_pack_c10 (gfc_array_c10 *);
1040 internal_proto(internal_pack_c10);
1041 #endif
1042
1043 #if defined HAVE_GFC_COMPLEX_16
1044 GFC_COMPLEX_16 *internal_pack_c16 (gfc_array_c16 *);
1045 internal_proto(internal_pack_c16);
1046 #endif
1047
1048 #if defined HAVE_GFC_COMPLEX_17
1049 GFC_COMPLEX_17 *internal_pack_c17 (gfc_array_c17 *);
1050 internal_proto(internal_pack_c17);
1051 #endif
1052
1053 extern void internal_unpack_1 (gfc_array_i1 *, const GFC_INTEGER_1 *);
1054 internal_proto(internal_unpack_1);
1055
1056 extern void internal_unpack_2 (gfc_array_i2 *, const GFC_INTEGER_2 *);
1057 internal_proto(internal_unpack_2);
1058
1059 extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *);
1060 internal_proto(internal_unpack_4);
1061
1062 extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *);
1063 internal_proto(internal_unpack_8);
1064
1065 #if defined HAVE_GFC_INTEGER_16
1066 extern void internal_unpack_16 (gfc_array_i16 *, const GFC_INTEGER_16 *);
1067 internal_proto(internal_unpack_16);
1068 #endif
1069
1070 extern void internal_unpack_r4 (gfc_array_r4 *, const GFC_REAL_4 *);
1071 internal_proto(internal_unpack_r4);
1072
1073 extern void internal_unpack_r8 (gfc_array_r8 *, const GFC_REAL_8 *);
1074 internal_proto(internal_unpack_r8);
1075
1076 #if defined HAVE_GFC_REAL_10
1077 extern void internal_unpack_r10 (gfc_array_r10 *, const GFC_REAL_10 *);
1078 internal_proto(internal_unpack_r10);
1079 #endif
1080
1081 #if defined HAVE_GFC_REAL_16
1082 extern void internal_unpack_r16 (gfc_array_r16 *, const GFC_REAL_16 *);
1083 internal_proto(internal_unpack_r16);
1084 #endif
1085
1086 #if defined HAVE_GFC_REAL_17
1087 extern void internal_unpack_r17 (gfc_array_r17 *, const GFC_REAL_17 *);
1088 internal_proto(internal_unpack_r17);
1089 #endif
1090
1091 extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *);
1092 internal_proto(internal_unpack_c4);
1093
1094 extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *);
1095 internal_proto(internal_unpack_c8);
1096
1097 #if defined HAVE_GFC_COMPLEX_10
1098 extern void internal_unpack_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *);
1099 internal_proto(internal_unpack_c10);
1100 #endif
1101
1102 #if defined HAVE_GFC_COMPLEX_16
1103 extern void internal_unpack_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *);
1104 internal_proto(internal_unpack_c16);
1105 #endif
1106
1107 #if defined HAVE_GFC_COMPLEX_17
1108 extern void internal_unpack_c17 (gfc_array_c17 *, const GFC_COMPLEX_17 *);
1109 internal_proto(internal_unpack_c17);
1110 #endif
1111
1112 /* Internal auxiliary functions for the pack intrinsic.  */
1113
1114 extern void pack_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1115                      const gfc_array_l1 *, const gfc_array_i1 *);
1116 internal_proto(pack_i1);
1117
1118 extern void pack_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1119                      const gfc_array_l1 *, const gfc_array_i2 *);
1120 internal_proto(pack_i2);
1121
1122 extern void pack_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1123                      const gfc_array_l1 *, const gfc_array_i4 *);
1124 internal_proto(pack_i4);
1125
1126 extern void pack_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1127                      const gfc_array_l1 *, const gfc_array_i8 *);
1128 internal_proto(pack_i8);
1129
1130 #ifdef HAVE_GFC_INTEGER_16
1131 extern void pack_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1132                      const gfc_array_l1 *, const gfc_array_i16 *);
1133 internal_proto(pack_i16);
1134 #endif
1135
1136 extern void pack_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1137                      const gfc_array_l1 *, const gfc_array_r4 *);
1138 internal_proto(pack_r4);
1139
1140 extern void pack_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1141                      const gfc_array_l1 *, const gfc_array_r8 *);
1142 internal_proto(pack_r8);
1143
1144 #ifdef HAVE_GFC_REAL_10
1145 extern void pack_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1146                      const gfc_array_l1 *, const gfc_array_r10 *);
1147 internal_proto(pack_r10);
1148 #endif
1149
1150 #ifdef HAVE_GFC_REAL_16
1151 extern void pack_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1152                      const gfc_array_l1 *, const gfc_array_r16 *);
1153 internal_proto(pack_r16);
1154 #endif
1155
1156 #ifdef HAVE_GFC_REAL_17
1157 extern void pack_r17 (gfc_array_r17 *, const gfc_array_r17 *,
1158                      const gfc_array_l1 *, const gfc_array_r17 *);
1159 internal_proto(pack_r17);
1160 #endif
1161
1162 extern void pack_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1163                      const gfc_array_l1 *, const gfc_array_c4 *);
1164 internal_proto(pack_c4);
1165
1166 extern void pack_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1167                      const gfc_array_l1 *, const gfc_array_c8 *);
1168 internal_proto(pack_c8);
1169
1170 #ifdef HAVE_GFC_REAL_10
1171 extern void pack_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1172                      const gfc_array_l1 *, const gfc_array_c10 *);
1173 internal_proto(pack_c10);
1174 #endif
1175
1176 #ifdef HAVE_GFC_REAL_16
1177 extern void pack_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1178                      const gfc_array_l1 *, const gfc_array_c16 *);
1179 internal_proto(pack_c16);
1180 #endif
1181
1182 #ifdef HAVE_GFC_REAL_17
1183 extern void pack_c17 (gfc_array_c17 *, const gfc_array_c17 *,
1184                      const gfc_array_l1 *, const gfc_array_c17 *);
1185 internal_proto(pack_c17);
1186 #endif
1187
1188 /* Internal auxiliary functions for the unpack intrinsic.  */
1189
1190 extern void unpack0_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1191                         const gfc_array_l1 *, const GFC_INTEGER_1 *);
1192 internal_proto(unpack0_i1);
1193
1194 extern void unpack0_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1195                         const gfc_array_l1 *, const GFC_INTEGER_2 *);
1196 internal_proto(unpack0_i2);
1197
1198 extern void unpack0_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1199                         const gfc_array_l1 *, const GFC_INTEGER_4 *);
1200 internal_proto(unpack0_i4);
1201
1202 extern void unpack0_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1203                         const gfc_array_l1 *, const GFC_INTEGER_8 *);
1204 internal_proto(unpack0_i8);
1205
1206 #ifdef HAVE_GFC_INTEGER_16
1207
1208 extern void unpack0_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1209                          const gfc_array_l1 *, const GFC_INTEGER_16 *);
1210 internal_proto(unpack0_i16);
1211
1212 #endif
1213
1214 extern void unpack0_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1215                         const gfc_array_l1 *, const GFC_REAL_4 *);
1216 internal_proto(unpack0_r4);
1217
1218 extern void unpack0_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1219                         const gfc_array_l1 *, const GFC_REAL_8 *);
1220 internal_proto(unpack0_r8);
1221
1222 #ifdef HAVE_GFC_REAL_10
1223
1224 extern void unpack0_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1225                          const gfc_array_l1 *, const GFC_REAL_10 *);
1226 internal_proto(unpack0_r10);
1227
1228 #endif
1229
1230 #ifdef HAVE_GFC_REAL_16
1231
1232 extern void unpack0_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1233                          const gfc_array_l1 *, const GFC_REAL_16 *);
1234 internal_proto(unpack0_r16);
1235
1236 #endif
1237
1238 #ifdef HAVE_GFC_REAL_17
1239
1240 extern void unpack0_r17 (gfc_array_r17 *, const gfc_array_r17 *,
1241                          const gfc_array_l1 *, const GFC_REAL_17 *);
1242 internal_proto(unpack0_r17);
1243
1244 #endif
1245
1246 extern void unpack0_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1247                         const gfc_array_l1 *, const GFC_COMPLEX_4 *);
1248 internal_proto(unpack0_c4);
1249
1250 extern void unpack0_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1251                         const gfc_array_l1 *, const GFC_COMPLEX_8 *);
1252 internal_proto(unpack0_c8);
1253
1254 #ifdef HAVE_GFC_COMPLEX_10
1255
1256 extern void unpack0_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1257                          const gfc_array_l1 *mask, const GFC_COMPLEX_10 *);
1258 internal_proto(unpack0_c10);
1259
1260 #endif
1261
1262 #ifdef HAVE_GFC_COMPLEX_16
1263
1264 extern void unpack0_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1265                          const gfc_array_l1 *, const GFC_COMPLEX_16 *);
1266 internal_proto(unpack0_c16);
1267
1268 #endif
1269
1270 #ifdef HAVE_GFC_COMPLEX_17
1271
1272 extern void unpack0_c17 (gfc_array_c17 *, const gfc_array_c17 *,
1273                          const gfc_array_l1 *, const GFC_COMPLEX_17 *);
1274 internal_proto(unpack0_c17);
1275
1276 #endif
1277
1278 extern void unpack1_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1279                         const gfc_array_l1 *, const gfc_array_i1 *);
1280 internal_proto(unpack1_i1);
1281
1282 extern void unpack1_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1283                         const gfc_array_l1 *, const gfc_array_i2 *);
1284 internal_proto(unpack1_i2);
1285
1286 extern void unpack1_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1287                         const gfc_array_l1 *, const gfc_array_i4 *);
1288 internal_proto(unpack1_i4);
1289
1290 extern void unpack1_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1291                         const gfc_array_l1 *, const gfc_array_i8 *);
1292 internal_proto(unpack1_i8);
1293
1294 #ifdef HAVE_GFC_INTEGER_16
1295 extern void unpack1_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1296                          const gfc_array_l1 *, const gfc_array_i16 *);
1297 internal_proto(unpack1_i16);
1298 #endif
1299
1300 extern void unpack1_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1301                         const gfc_array_l1 *, const gfc_array_r4 *);
1302 internal_proto(unpack1_r4);
1303
1304 extern void unpack1_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1305                         const gfc_array_l1 *, const gfc_array_r8 *);
1306 internal_proto(unpack1_r8);
1307
1308 #ifdef HAVE_GFC_REAL_10
1309 extern void unpack1_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1310                          const gfc_array_l1 *, const gfc_array_r10 *);
1311 internal_proto(unpack1_r10);
1312 #endif
1313
1314 #ifdef HAVE_GFC_REAL_16
1315 extern void unpack1_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1316                          const gfc_array_l1 *, const gfc_array_r16 *);
1317 internal_proto(unpack1_r16);
1318 #endif
1319
1320 #ifdef HAVE_GFC_REAL_17
1321 extern void unpack1_r17 (gfc_array_r17 *, const gfc_array_r17 *,
1322                          const gfc_array_l1 *, const gfc_array_r17 *);
1323 internal_proto(unpack1_r17);
1324 #endif
1325
1326 extern void unpack1_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1327                         const gfc_array_l1 *, const gfc_array_c4 *);
1328 internal_proto(unpack1_c4);
1329
1330 extern void unpack1_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1331                         const gfc_array_l1 *, const gfc_array_c8 *);
1332 internal_proto(unpack1_c8);
1333
1334 #ifdef HAVE_GFC_COMPLEX_10
1335 extern void unpack1_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1336                          const gfc_array_l1 *, const gfc_array_c10 *);
1337 internal_proto(unpack1_c10);
1338 #endif
1339
1340 #ifdef HAVE_GFC_COMPLEX_16
1341 extern void unpack1_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1342                          const gfc_array_l1 *, const gfc_array_c16 *);
1343 internal_proto(unpack1_c16);
1344 #endif
1345
1346 #ifdef HAVE_GFC_COMPLEX_17
1347 extern void unpack1_c17 (gfc_array_c17 *, const gfc_array_c17 *,
1348                          const gfc_array_l1 *, const gfc_array_c17 *);
1349 internal_proto(unpack1_c17);
1350 #endif
1351
1352 /* Helper functions for spread.  */
1353
1354 extern void spread_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1355                        const index_type, const index_type);
1356 internal_proto(spread_i1);
1357
1358 extern void spread_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1359                        const index_type, const index_type);
1360 internal_proto(spread_i2);
1361
1362 extern void spread_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1363                        const index_type, const index_type);
1364 internal_proto(spread_i4);
1365
1366 extern void spread_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1367                        const index_type, const index_type);
1368 internal_proto(spread_i8);
1369
1370 #ifdef HAVE_GFC_INTEGER_16
1371 extern void spread_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1372                        const index_type, const index_type);
1373 internal_proto(spread_i16);
1374
1375 #endif
1376
1377 extern void spread_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1378                        const index_type, const index_type);
1379 internal_proto(spread_r4);
1380
1381 extern void spread_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1382                        const index_type, const index_type);
1383 internal_proto(spread_r8);
1384
1385 #ifdef HAVE_GFC_REAL_10
1386 extern void spread_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1387                        const index_type, const index_type);
1388 internal_proto(spread_r10);
1389
1390 #endif
1391
1392 #ifdef HAVE_GFC_REAL_16
1393 extern void spread_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1394                        const index_type, const index_type);
1395 internal_proto(spread_r16);
1396
1397 #endif
1398
1399 #ifdef HAVE_GFC_REAL_17
1400 extern void spread_r17 (gfc_array_r17 *, const gfc_array_r17 *,
1401                        const index_type, const index_type);
1402 internal_proto(spread_r17);
1403
1404 #endif
1405
1406 extern void spread_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1407                        const index_type, const index_type);
1408 internal_proto(spread_c4);
1409
1410 extern void spread_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1411                        const index_type, const index_type);
1412 internal_proto(spread_c8);
1413
1414 #ifdef HAVE_GFC_COMPLEX_10
1415 extern void spread_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1416                        const index_type, const index_type);
1417 internal_proto(spread_c10);
1418
1419 #endif
1420
1421 #ifdef HAVE_GFC_COMPLEX_16
1422 extern void spread_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1423                        const index_type, const index_type);
1424 internal_proto(spread_c16);
1425
1426 #endif
1427
1428 #ifdef HAVE_GFC_COMPLEX_17
1429 extern void spread_c17 (gfc_array_c17 *, const gfc_array_c17 *,
1430                        const index_type, const index_type);
1431 internal_proto(spread_c17);
1432
1433 #endif
1434
1435 extern void spread_scalar_i1 (gfc_array_i1 *, const GFC_INTEGER_1 *,
1436                               const index_type, const index_type);
1437 internal_proto(spread_scalar_i1);
1438
1439 extern void spread_scalar_i2 (gfc_array_i2 *, const GFC_INTEGER_2 *,
1440                               const index_type, const index_type);
1441 internal_proto(spread_scalar_i2);
1442
1443 extern void spread_scalar_i4 (gfc_array_i4 *, const GFC_INTEGER_4 *,
1444                               const index_type, const index_type);
1445 internal_proto(spread_scalar_i4);
1446
1447 extern void spread_scalar_i8 (gfc_array_i8 *, const GFC_INTEGER_8 *,
1448                               const index_type, const index_type);
1449 internal_proto(spread_scalar_i8);
1450
1451 #ifdef HAVE_GFC_INTEGER_16
1452 extern void spread_scalar_i16 (gfc_array_i16 *, const GFC_INTEGER_16 *,
1453                                const index_type, const index_type);
1454 internal_proto(spread_scalar_i16);
1455
1456 #endif
1457
1458 extern void spread_scalar_r4 (gfc_array_r4 *, const GFC_REAL_4 *,
1459                               const index_type, const index_type);
1460 internal_proto(spread_scalar_r4);
1461
1462 extern void spread_scalar_r8 (gfc_array_r8 *, const GFC_REAL_8 *,
1463                               const index_type, const index_type);
1464 internal_proto(spread_scalar_r8);
1465
1466 #ifdef HAVE_GFC_REAL_10
1467 extern void spread_scalar_r10 (gfc_array_r10 *, const GFC_REAL_10 *,
1468                                const index_type, const index_type);
1469 internal_proto(spread_scalar_r10);
1470
1471 #endif
1472
1473 #ifdef HAVE_GFC_REAL_16
1474 extern void spread_scalar_r16 (gfc_array_r16 *, const GFC_REAL_16 *,
1475                                const index_type, const index_type);
1476 internal_proto(spread_scalar_r16);
1477
1478 #endif
1479
1480 #ifdef HAVE_GFC_REAL_17
1481 extern void spread_scalar_r17 (gfc_array_r17 *, const GFC_REAL_17 *,
1482                                const index_type, const index_type);
1483 internal_proto(spread_scalar_r17);
1484
1485 #endif
1486
1487 extern void spread_scalar_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *,
1488                               const index_type, const index_type);
1489 internal_proto(spread_scalar_c4);
1490
1491 extern void spread_scalar_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *,
1492                               const index_type, const index_type);
1493 internal_proto(spread_scalar_c8);
1494
1495 #ifdef HAVE_GFC_COMPLEX_10
1496 extern void spread_scalar_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *,
1497                                const index_type, const index_type);
1498 internal_proto(spread_scalar_c10);
1499
1500 #endif
1501
1502 #ifdef HAVE_GFC_COMPLEX_16
1503 extern void spread_scalar_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *,
1504                                const index_type, const index_type);
1505 internal_proto(spread_scalar_c16);
1506
1507 #endif
1508
1509 #ifdef HAVE_GFC_COMPLEX_17
1510 extern void spread_scalar_c17 (gfc_array_c17 *, const GFC_COMPLEX_17 *,
1511                                const index_type, const index_type);
1512 internal_proto(spread_scalar_c17);
1513
1514 #endif
1515
1516 /* string_intrinsics.c */
1517
1518 extern int compare_string (gfc_charlen_type, const char *,
1519                            gfc_charlen_type, const char *);
1520 iexport_proto(compare_string);
1521
1522 extern int compare_string_char4 (gfc_charlen_type, const gfc_char4_t *,
1523                                  gfc_charlen_type, const gfc_char4_t *);
1524 iexport_proto(compare_string_char4);
1525
1526 extern int memcmp_char4 (const void *, const void *, size_t);
1527 internal_proto(memcmp_char4);
1528
1529
1530 /* random.c */
1531
1532 extern void random_seed_i4 (GFC_INTEGER_4 * size, gfc_array_i4 * put,
1533                             gfc_array_i4 * get);
1534 iexport_proto(random_seed_i4);
1535 extern void random_seed_i8 (GFC_INTEGER_8 * size, gfc_array_i8 * put,
1536                             gfc_array_i8 * get);
1537 iexport_proto(random_seed_i8);
1538
1539 /* size.c */
1540
1541 typedef GFC_ARRAY_DESCRIPTOR (void) array_t;
1542
1543 extern index_type size0 (const array_t * array);
1544 iexport_proto(size0);
1545
1546 /* is_contiguous.c */
1547
1548 extern GFC_LOGICAL_4 is_contiguous0 (const array_t * const restrict array);
1549 iexport_proto(is_contiguous0);
1550
1551 /* bounds.c */
1552
1553 extern void bounds_equal_extents (array_t *, array_t *, const char *,
1554                                   const char *);
1555 internal_proto(bounds_equal_extents);
1556
1557 extern void bounds_reduced_extents (array_t *, array_t *, int, const char *,
1558                              const char *intrinsic);
1559 internal_proto(bounds_reduced_extents);
1560
1561 extern void bounds_iforeach_return (array_t *, array_t *, const char *);
1562 internal_proto(bounds_iforeach_return);
1563
1564 extern void bounds_ifunction_return (array_t *, const index_type *,
1565                                      const char *, const char *);
1566 internal_proto(bounds_ifunction_return);
1567
1568 extern index_type count_0 (const gfc_array_l1 *);
1569
1570 internal_proto(count_0);
1571
1572 /* Internal auxiliary functions for cshift */
1573
1574 void cshift0_i1 (gfc_array_i1 *, const gfc_array_i1 *, ptrdiff_t, int);
1575 internal_proto(cshift0_i1);
1576
1577 void cshift0_i2 (gfc_array_i2 *, const gfc_array_i2 *, ptrdiff_t, int);
1578 internal_proto(cshift0_i2);
1579
1580 void cshift0_i4 (gfc_array_i4 *, const gfc_array_i4 *, ptrdiff_t, int);
1581 internal_proto(cshift0_i4);
1582
1583 void cshift0_i8 (gfc_array_i8 *, const gfc_array_i8 *, ptrdiff_t, int);
1584 internal_proto(cshift0_i8);
1585
1586 #ifdef HAVE_GFC_INTEGER_16
1587 void cshift0_i16 (gfc_array_i16 *, const gfc_array_i16 *, ptrdiff_t, int);
1588 internal_proto(cshift0_i16);
1589 #endif
1590
1591 void cshift0_r4 (gfc_array_r4 *, const gfc_array_r4 *, ptrdiff_t, int);
1592 internal_proto(cshift0_r4);
1593
1594 void cshift0_r8 (gfc_array_r8 *, const gfc_array_r8 *, ptrdiff_t, int);
1595 internal_proto(cshift0_r8);
1596
1597 #ifdef HAVE_GFC_REAL_10
1598 void cshift0_r10 (gfc_array_r10 *, const gfc_array_r10 *, ptrdiff_t, int);
1599 internal_proto(cshift0_r10);
1600 #endif
1601
1602 #ifdef HAVE_GFC_REAL_16
1603 void cshift0_r16 (gfc_array_r16 *, const gfc_array_r16 *, ptrdiff_t, int);
1604 internal_proto(cshift0_r16);
1605 #endif
1606
1607 #ifdef HAVE_GFC_REAL_17
1608 void cshift0_r17 (gfc_array_r17 *, const gfc_array_r17 *, ptrdiff_t, int);
1609 internal_proto(cshift0_r17);
1610 #endif
1611
1612 void cshift0_c4 (gfc_array_c4 *, const gfc_array_c4 *, ptrdiff_t, int);
1613 internal_proto(cshift0_c4);
1614
1615 void cshift0_c8 (gfc_array_c8 *, const gfc_array_c8 *, ptrdiff_t, int);
1616 internal_proto(cshift0_c8);
1617
1618 #ifdef HAVE_GFC_COMPLEX_10
1619 void cshift0_c10 (gfc_array_c10 *, const gfc_array_c10 *, ptrdiff_t, int);
1620 internal_proto(cshift0_c10);
1621 #endif
1622
1623 #ifdef HAVE_GFC_COMPLEX_16
1624 void cshift0_c16 (gfc_array_c16 *, const gfc_array_c16 *, ptrdiff_t, int);
1625 internal_proto(cshift0_c16);
1626 #endif
1627
1628 #ifdef HAVE_GFC_COMPLEX_17
1629 void cshift0_c17 (gfc_array_c17 *, const gfc_array_c17 *, ptrdiff_t, int);
1630 internal_proto(cshift0_c17);
1631 #endif
1632
1633 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_1)
1634 void cshift1_4_i1 (gfc_array_i1 * const restrict,
1635         const gfc_array_i1 * const restrict,
1636         const gfc_array_i4 * const restrict,
1637         const GFC_INTEGER_4 * const restrict);
1638 internal_proto(cshift1_4_i1);
1639 #endif
1640
1641 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_2)
1642 void cshift1_4_i2 (gfc_array_i2 * const restrict,
1643         const gfc_array_i2 * const restrict,
1644         const gfc_array_i4 * const restrict,
1645         const GFC_INTEGER_4 * const restrict);
1646 internal_proto(cshift1_4_i2);
1647 #endif
1648
1649 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
1650 void cshift1_4_i4 (gfc_array_i4 * const restrict,
1651         const gfc_array_i4 * const restrict,
1652         const gfc_array_i4 * const restrict,
1653         const GFC_INTEGER_4 * const restrict);
1654 internal_proto(cshift1_4_i4);
1655 #endif
1656
1657 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
1658 void cshift1_4_i8 (gfc_array_i8 * const restrict,
1659         const gfc_array_i8 * const restrict,
1660         const gfc_array_i4 * const restrict,
1661         const GFC_INTEGER_4 * const restrict);
1662 internal_proto(cshift1_4_i8);
1663 #endif
1664
1665 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
1666 void cshift1_4_i16 (gfc_array_i16 * const restrict,
1667         const gfc_array_i16 * const restrict,
1668         const gfc_array_i4 * const restrict,
1669         const GFC_INTEGER_4 * const restrict);
1670 internal_proto(cshift1_4_i16);
1671 #endif
1672
1673 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_1)
1674 void cshift1_8_i1 (gfc_array_i1 * const restrict,
1675         const gfc_array_i1 * const restrict,
1676         const gfc_array_i8 * const restrict,
1677         const GFC_INTEGER_8 * const restrict);
1678 internal_proto(cshift1_8_i1);
1679 #endif
1680
1681 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_2)
1682 void cshift1_8_i2 (gfc_array_i2 * const restrict,
1683         const gfc_array_i2 * const restrict,
1684         const gfc_array_i8 * const restrict,
1685         const GFC_INTEGER_8 * const restrict);
1686 internal_proto(cshift1_8_i2);
1687 #endif
1688
1689 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4)
1690 void cshift1_8_i4 (gfc_array_i4 * const restrict,
1691         const gfc_array_i4 * const restrict,
1692         const gfc_array_i8 * const restrict,
1693         const GFC_INTEGER_8 * const restrict);
1694 internal_proto(cshift1_8_i4);
1695 #endif
1696
1697 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
1698 void cshift1_8_i8 (gfc_array_i8 * const restrict,
1699         const gfc_array_i8 * const restrict,
1700         const gfc_array_i8 * const restrict,
1701         const GFC_INTEGER_8 * const restrict);
1702 internal_proto(cshift1_8_i8);
1703 #endif
1704
1705 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)
1706 void cshift1_8_i16 (gfc_array_i16 * const restrict,
1707         const gfc_array_i16 * const restrict,
1708         const gfc_array_i8 * const restrict,
1709         const GFC_INTEGER_8 * const restrict);
1710 internal_proto(cshift1_8_i16);
1711 #endif
1712
1713 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_1)
1714 void cshift1_16_i1 (gfc_array_i1 * const restrict,
1715         const gfc_array_i1 * const restrict,
1716         const gfc_array_i16 * const restrict,
1717         const GFC_INTEGER_16 * const restrict);
1718 internal_proto(cshift1_16_i1);
1719 #endif
1720
1721 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_2)
1722 void cshift1_16_i2 (gfc_array_i2 * const restrict,
1723         const gfc_array_i2 * const restrict,
1724         const gfc_array_i16 * const restrict,
1725         const GFC_INTEGER_16 * const restrict);
1726 internal_proto(cshift1_16_i2);
1727 #endif
1728
1729 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4)
1730 void cshift1_16_i4 (gfc_array_i4 * const restrict,
1731         const gfc_array_i4 * const restrict,
1732         const gfc_array_i16 * const restrict,
1733         const GFC_INTEGER_16 * const restrict);
1734 internal_proto(cshift1_16_i4);
1735 #endif
1736
1737 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8)
1738 void cshift1_16_i8 (gfc_array_i8 * const restrict,
1739         const gfc_array_i8 * const restrict,
1740         const gfc_array_i16 * const restrict,
1741         const GFC_INTEGER_16 * const restrict);
1742 internal_proto(cshift1_16_i8);
1743 #endif
1744
1745 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
1746 void cshift1_16_i16 (gfc_array_i16 * const restrict,
1747         const gfc_array_i16 * const restrict,
1748         const gfc_array_i16 * const restrict,
1749         const GFC_INTEGER_16 * const restrict);
1750 internal_proto(cshift1_16_i16);
1751 #endif
1752
1753 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_4)
1754 void cshift1_4_r4 (gfc_array_r4 * const restrict,
1755         const gfc_array_r4 * const restrict,
1756         const gfc_array_i4 * const restrict,
1757         const GFC_INTEGER_4 * const restrict);
1758 internal_proto(cshift1_4_r4);
1759 #endif
1760
1761 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_8)
1762 void cshift1_4_r8 (gfc_array_r8 * const restrict,
1763         const gfc_array_r8 * const restrict,
1764         const gfc_array_i4 * const restrict,
1765         const GFC_INTEGER_4 * const restrict);
1766 internal_proto(cshift1_4_r8);
1767 #endif
1768
1769 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_10)
1770 void cshift1_4_r10 (gfc_array_r10 * const restrict,
1771         const gfc_array_r10 * const restrict,
1772         const gfc_array_i4 * const restrict,
1773         const GFC_INTEGER_4 * const restrict);
1774 internal_proto(cshift1_4_r10);
1775 #endif
1776
1777 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_16)
1778 void cshift1_4_r16 (gfc_array_r16 * const restrict,
1779         const gfc_array_r16 * const restrict,
1780         const gfc_array_i4 * const restrict,
1781         const GFC_INTEGER_4 * const restrict);
1782 internal_proto(cshift1_4_r16);
1783 #endif
1784
1785 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_17)
1786 void cshift1_4_r17 (gfc_array_r17 * const restrict,
1787         const gfc_array_r17 * const restrict,
1788         const gfc_array_i4 * const restrict,
1789         const GFC_INTEGER_4 * const restrict);
1790 internal_proto(cshift1_4_r17);
1791 #endif
1792
1793 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_4)
1794 void cshift1_8_r4 (gfc_array_r4 * const restrict,
1795         const gfc_array_r4 * const restrict,
1796         const gfc_array_i8 * const restrict,
1797         const GFC_INTEGER_8 * const restrict);
1798 internal_proto(cshift1_8_r4);
1799 #endif
1800
1801 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_8)
1802 void cshift1_8_r8 (gfc_array_r8 * const restrict,
1803         const gfc_array_r8 * const restrict,
1804         const gfc_array_i8 * const restrict,
1805         const GFC_INTEGER_8 * const restrict);
1806 internal_proto(cshift1_8_r8);
1807 #endif
1808
1809 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_10)
1810 void cshift1_8_r10 (gfc_array_r10 * const restrict,
1811         const gfc_array_r10 * const restrict,
1812         const gfc_array_i8 * const restrict,
1813         const GFC_INTEGER_8 * const restrict);
1814 internal_proto(cshift1_8_r10);
1815 #endif
1816
1817 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_16)
1818 void cshift1_8_r16 (gfc_array_r16 * const restrict,
1819         const gfc_array_r16 * const restrict,
1820         const gfc_array_i8 * const restrict,
1821         const GFC_INTEGER_8 * const restrict);
1822 internal_proto(cshift1_8_r16);
1823 #endif
1824
1825 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_17)
1826 void cshift1_8_r17 (gfc_array_r17 * const restrict,
1827         const gfc_array_r17 * const restrict,
1828         const gfc_array_i8 * const restrict,
1829         const GFC_INTEGER_8 * const restrict);
1830 internal_proto(cshift1_8_r17);
1831 #endif
1832
1833 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_4)
1834 void cshift1_16_r4 (gfc_array_r4 * const restrict,
1835         const gfc_array_r4 * const restrict,
1836         const gfc_array_i16 * const restrict,
1837         const GFC_INTEGER_16 * const restrict);
1838 internal_proto(cshift1_16_r4);
1839 #endif
1840
1841 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_8)
1842 void cshift1_16_r8 (gfc_array_r8 * const restrict,
1843         const gfc_array_r8 * const restrict,
1844         const gfc_array_i16 * const restrict,
1845         const GFC_INTEGER_16 * const restrict);
1846 internal_proto(cshift1_16_r8);
1847 #endif
1848
1849 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_10)
1850 void cshift1_16_r10 (gfc_array_r10 * const restrict,
1851         const gfc_array_r10 * const restrict,
1852         const gfc_array_i16 * const restrict,
1853         const GFC_INTEGER_16 * const restrict);
1854 internal_proto(cshift1_16_r10);
1855 #endif
1856
1857 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_16)
1858 void cshift1_16_r16 (gfc_array_r16 * const restrict,
1859         const gfc_array_r16 * const restrict,
1860         const gfc_array_i16 * const restrict,
1861         const GFC_INTEGER_16 * const restrict);
1862 internal_proto(cshift1_16_r16);
1863 #endif
1864
1865 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_17)
1866 void cshift1_16_r17 (gfc_array_r17 * const restrict,
1867         const gfc_array_r17 * const restrict,
1868         const gfc_array_i16 * const restrict,
1869         const GFC_INTEGER_16 * const restrict);
1870 internal_proto(cshift1_16_r17);
1871 #endif
1872
1873 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_4)
1874 void cshift1_4_c4 (gfc_array_c4 * const restrict,
1875         const gfc_array_c4 * const restrict,
1876         const gfc_array_i4 * const restrict,
1877         const GFC_INTEGER_4 * const restrict);
1878 internal_proto(cshift1_4_c4);
1879 #endif
1880
1881 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_8)
1882 void cshift1_4_c8 (gfc_array_c8 * const restrict,
1883         const gfc_array_c8 * const restrict,
1884         const gfc_array_i4 * const restrict,
1885         const GFC_INTEGER_4 * const restrict);
1886 internal_proto(cshift1_4_c8);
1887 #endif
1888
1889 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_10)
1890 void cshift1_4_c10 (gfc_array_c10 * const restrict,
1891         const gfc_array_c10 * const restrict,
1892         const gfc_array_i4 * const restrict,
1893         const GFC_INTEGER_4 * const restrict);
1894 internal_proto(cshift1_4_c10);
1895 #endif
1896
1897 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_16)
1898 void cshift1_4_c16 (gfc_array_c16 * const restrict,
1899         const gfc_array_c16 * const restrict,
1900         const gfc_array_i4 * const restrict,
1901         const GFC_INTEGER_4 * const restrict);
1902 internal_proto(cshift1_4_c16);
1903 #endif
1904
1905 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_17)
1906 void cshift1_4_c17 (gfc_array_c17 * const restrict,
1907         const gfc_array_c17 * const restrict,
1908         const gfc_array_i4 * const restrict,
1909         const GFC_INTEGER_4 * const restrict);
1910 internal_proto(cshift1_4_c17);
1911 #endif
1912
1913 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_4)
1914 void cshift1_8_c4 (gfc_array_c4 * const restrict,
1915         const gfc_array_c4 * const restrict,
1916         const gfc_array_i8 * const restrict,
1917         const GFC_INTEGER_8 * const restrict);
1918 internal_proto(cshift1_8_c4);
1919 #endif
1920
1921 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_8)
1922 void cshift1_8_c8 (gfc_array_c8 * const restrict,
1923         const gfc_array_c8 * const restrict,
1924         const gfc_array_i8 * const restrict,
1925         const GFC_INTEGER_8 * const restrict);
1926 internal_proto(cshift1_8_c8);
1927 #endif
1928
1929 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_10)
1930 void cshift1_8_c10 (gfc_array_c10 * const restrict,
1931         const gfc_array_c10 * const restrict,
1932         const gfc_array_i8 * const restrict,
1933         const GFC_INTEGER_8 * const restrict);
1934 internal_proto(cshift1_8_c10);
1935 #endif
1936
1937 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_16)
1938 void cshift1_8_c16 (gfc_array_c16 * const restrict,
1939         const gfc_array_c16 * const restrict,
1940         const gfc_array_i8 * const restrict,
1941         const GFC_INTEGER_8 * const restrict);
1942 internal_proto(cshift1_8_c16);
1943 #endif
1944
1945 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_17)
1946 void cshift1_8_c17 (gfc_array_c17 * const restrict,
1947         const gfc_array_c17 * const restrict,
1948         const gfc_array_i8 * const restrict,
1949         const GFC_INTEGER_8 * const restrict);
1950 internal_proto(cshift1_8_c17);
1951 #endif
1952
1953 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_4)
1954 void cshift1_16_c4 (gfc_array_c4 * const restrict,
1955         const gfc_array_c4 * const restrict,
1956         const gfc_array_i16 * const restrict,
1957         const GFC_INTEGER_16 * const restrict);
1958 internal_proto(cshift1_16_c4);
1959 #endif
1960
1961 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_8)
1962 void cshift1_16_c8 (gfc_array_c8 * const restrict,
1963         const gfc_array_c8 * const restrict,
1964         const gfc_array_i16 * const restrict,
1965         const GFC_INTEGER_16 * const restrict);
1966 internal_proto(cshift1_16_c8);
1967 #endif
1968
1969 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_10)
1970 void cshift1_16_c10 (gfc_array_c10 * const restrict,
1971         const gfc_array_c10 * const restrict,
1972         const gfc_array_i16 * const restrict,
1973         const GFC_INTEGER_16 * const restrict);
1974 internal_proto(cshift1_16_c10);
1975 #endif
1976
1977 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_16)
1978 void cshift1_16_c16 (gfc_array_c16 * const restrict,
1979         const gfc_array_c16 * const restrict,
1980         const gfc_array_i16 * const restrict,
1981         const GFC_INTEGER_16 * const restrict);
1982 internal_proto(cshift1_16_c16);
1983 #endif
1984
1985 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_17)
1986 void cshift1_16_c17 (gfc_array_c17 * const restrict,
1987         const gfc_array_c17 * const restrict,
1988         const gfc_array_i16 * const restrict,
1989         const GFC_INTEGER_16 * const restrict);
1990 internal_proto(cshift1_16_c17);
1991 #endif
1992
1993 /* Prototypes for the POWER __ieee128 functions.  */
1994 #ifdef POWER_IEEE128
1995 extern _Float128 __acoshieee128 (_Float128)
1996   __attribute__ ((__nothrow__, __leaf__));
1997 extern _Float128 __acosieee128 (_Float128)
1998   __attribute__ ((__nothrow__, __leaf__));
1999 extern _Float128 __asinhieee128 (_Float128)
2000   __attribute__ ((__nothrow__, __leaf__));
2001 extern _Float128 __asinieee128 (_Float128)
2002   __attribute__ ((__nothrow__, __leaf__));
2003 extern _Float128 __atan2ieee128 (_Float128)
2004   __attribute__ ((__nothrow__, __leaf__));
2005 extern _Float128 __atanhieee128 (_Float128)
2006   __attribute__ ((__nothrow__, __leaf__));
2007 extern _Float128 __atanieee128 (_Float128)
2008   __attribute__ ((__nothrow__, __leaf__));
2009 extern _Float128 __copysignieee128 (_Float128, _Float128)
2010   __attribute__ ((__nothrow__, __leaf__));
2011 extern _Float128 __coshieee128 (_Float128)
2012   __attribute__ ((__nothrow__, __leaf__));
2013 extern _Float128 __cosieee128 (_Float128)
2014   __attribute__ ((__nothrow__, __leaf__));
2015 extern _Float128 __erfcieee128 (_Float128)
2016   __attribute__ ((__nothrow__, __leaf__));
2017 extern _Float128 __erfieee128 (_Float128)
2018   __attribute__ ((__nothrow__, __leaf__));
2019 extern _Float128 __expieee128 (_Float128)
2020   __attribute__ ((__nothrow__, __leaf__));
2021 extern _Float128 __fabsieee128 (_Float128)
2022   __attribute__ ((__nothrow__, __leaf__));
2023 extern _Float128 __fmaieee128 (_Float128, _Float128, _Float128)
2024   __attribute__ ((__nothrow__, __leaf__));
2025 extern _Float128 __fmodieee128 (_Float128, _Float128)
2026   __attribute__ ((__nothrow__, __leaf__));
2027 extern _Float128 __jnieee128 (int, _Float128)
2028   __attribute__ ((__nothrow__, __leaf__));
2029 extern _Float128 __log10ieee128 (_Float128)
2030   __attribute__ ((__nothrow__, __leaf__));
2031 extern _Float128 __logieee128 (_Float128)
2032   __attribute__ ((__nothrow__, __leaf__));
2033 extern _Float128 __powieee128 (_Float128)
2034   __attribute__ ((__nothrow__, __leaf__));
2035 extern _Float128 __sinhieee128 (_Float128)
2036   __attribute__ ((__nothrow__, __leaf__));
2037 extern _Float128 __sinieee128 (_Float128)
2038   __attribute__ ((__nothrow__, __leaf__));
2039 extern _Float128 __sqrtieee128 (_Float128)
2040   __attribute__ ((__nothrow__, __leaf__));
2041 extern _Float128 __tanhieee128 (_Float128)
2042   __attribute__ ((__nothrow__, __leaf__));
2043 extern _Float128 __tanieee128 (_Float128)
2044   __attribute__ ((__nothrow__, __leaf__));
2045 extern _Float128 __ynieee128 (int , _Float128)
2046   __attribute__ ((__nothrow__, __leaf__));
2047 extern _Float128 __strtoieee128 (const char *, char **)
2048   __attribute__ ((__nothrow__, __leaf__));
2049 extern int __snprintfieee128 (char *, size_t, const char *, ...)
2050   __attribute__ ((__nothrow__));
2051
2052 #endif
2053
2054 #endif  /* LIBGFOR_H  */