libgfortran/libgfortran.h

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