libgfortran/libgfortran.h

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