libgfortran/libgfortran.h

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