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