libgfortran/libgfortran.h

   1 /* Common declarations for all of libgfortran.
   2    Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
   3    Free Software Foundation, Inc.
   4    Contributed by Paul Brook <paul@nowt.org>, and
   5    Andy Vaught <andy@xena.eas.asu.edu>
   6
   7 This file is part of the GNU Fortran 95 runtime library (libgfortran).
   8
   9 Libgfortran is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 3, or (at your option)
  12 any later version.
  13
  14 Libgfortran is distributed in the hope that it will be useful,
  15 but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 GNU General Public License for more details.
  18
  19 Under Section 7 of GPL version 3, you are granted additional
  20 permissions described in the GCC Runtime Library Exception, version
  21 3.1, as published by the Free Software Foundation.
  22
  23 You should have received a copy of the GNU General Public License and
  24 a copy of the GCC Runtime Library Exception along with this program;
  25 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  26 <http://www.gnu.org/licenses/>.  */
  27
  28 #ifndef LIBGFOR_H
  29 #define LIBGFOR_H
  30
  31 /* config.h MUST be first because it can affect system headers.  */
  32 #include "config.h"
  33
  34 #include <stdio.h>
  35 #include <math.h>
  36 #include <stddef.h>
  37 #include <float.h>
  38 #include <stdarg.h>
  39
  40 #if HAVE_COMPLEX_H
  41 # include <complex.h>
  42 #else
  43 #define complex __complex__
  44 #endif
  45
  46 #include "../gcc/fortran/libgfortran.h"
  47
  48 #include "c99_protos.h"
  49
  50 #if HAVE_IEEEFP_H
  51 #include <ieeefp.h>
  52 #endif
  53
  54 #include "gstdint.h"
  55
  56 #if HAVE_SYS_TYPES_H
  57 #include <sys/types.h>
  58 #endif
  59
  60 #ifdef __MINGW32__
  61 typedef off64_t gfc_offset;
  62 #else
  63 typedef off_t gfc_offset;
  64 #endif
  65
  66 #ifndef NULL
  67 #define NULL (void *) 0
  68 #endif
  69
  70 #ifndef __GNUC__
  71 #define __attribute__(x)
  72 #define likely(x)       (x)
  73 #define unlikely(x)     (x)
  74 #else
  75 #define likely(x)       __builtin_expect(!!(x), 1)
  76 #define unlikely(x)     __builtin_expect(!!(x), 0)
  77 #endif
  78
  79
  80 /* We use intptr_t and uintptr_t, which may not be always defined in
  81    system headers.  */
  82
  83 #ifndef HAVE_INTPTR_T
  84 #if __SIZEOF_POINTER__ == __SIZEOF_LONG__
  85 #define intptr_t long
  86 #elif __SIZEOF_POINTER__ == __SIZEOF_LONG_LONG__
  87 #define intptr_t long long
  88 #elif __SIZEOF_POINTER__ == __SIZEOF_INT__
  89 #define intptr_t int
  90 #elif __SIZEOF_POINTER__ == __SIZEOF_SHORT__
  91 #define intptr_t short
  92 #else
  93 #error "Pointer type with unexpected size"
  94 #endif
  95 #endif
  96
  97 #ifndef HAVE_UINTPTR_T
  98 #if __SIZEOF_POINTER__ == __SIZEOF_LONG__
  99 #define uintptr_t unsigned long
 100 #elif __SIZEOF_POINTER__ == __SIZEOF_LONG_LONG__
 101 #define uintptr_t unsigned long long
 102 #elif __SIZEOF_POINTER__ == __SIZEOF_INT__
 103 #define uintptr_t unsigned int
 104 #elif __SIZEOF_POINTER__ == __SIZEOF_SHORT__
 105 #define uintptr_t unsigned short
 106 #else
 107 #error "Pointer type with unexpected size"
 108 #endif
 109 #endif
 110
 111
 112 /* On mingw, work around the buggy Windows snprintf() by using the one
 113    mingw provides, __mingw_snprintf().  We also provide a prototype for
 114    __mingw_snprintf(), because the mingw headers currently don't have one.  */
 115 #if HAVE_MINGW_SNPRINTF
 116 extern int __mingw_snprintf (char *, size_t, const char *, ...)
 117      __attribute__ ((format (gnu_printf, 3, 4)));
 118 #undef snprintf
 119 #define snprintf __mingw_snprintf
 120 #endif
 121
 122
 123 /* For a library, a standard prefix is a requirement in order to partition
 124    the namespace.  IPREFIX is for symbols intended to be internal to the
 125    library.  */
 126 #define PREFIX(x)       _gfortran_ ## x
 127 #define IPREFIX(x)      _gfortrani_ ## x
 128
 129 /* Magic to rename a symbol at the compiler level.  You continue to refer
 130    to the symbol as OLD in the source, but it'll be named NEW in the asm.  */
 131 #define sym_rename(old, new) sym_rename1(old, __USER_LABEL_PREFIX__, new)
 132 #define sym_rename1(old, ulp, new) sym_rename2(old, ulp, new)
 133 #define sym_rename2(old, ulp, new) extern __typeof(old) old __asm__(#ulp #new)
 134
 135 /* There are several classifications of routines:
 136
 137      (1) Symbols used only within the library,
 138      (2) Symbols to be exported from the library,
 139      (3) Symbols to be exported from the library, but
 140          also used inside the library.
 141
 142    By telling the compiler about these different classifications we can
 143    tightly control the interface seen by the user, and get better code
 144    from the compiler at the same time.
 145
 146    One of the following should be used immediately after the declaration
 147    of each symbol:
 148
 149      internal_proto     Marks a symbol used only within the library,
 150                         and adds IPREFIX to the assembly-level symbol
 151                         name.  The later is important for maintaining
 152                         the namespace partition for the static library.
 153
 154      export_proto       Marks a symbol to be exported, and adds PREFIX
 155                         to the assembly-level symbol name.
 156
 157      export_proto_np    Marks a symbol to be exported without adding PREFIX.
 158
 159      iexport_proto      Marks a function to be exported, but with the
 160                         understanding that it can be used inside as well.
 161
 162      iexport_data_proto Similarly, marks a data symbol to be exported.
 163                         Unfortunately, some systems can't play the hidden
 164                         symbol renaming trick on data symbols, thanks to
 165                         the horribleness of COPY relocations.
 166
 167    If iexport_proto or iexport_data_proto is used, you must also use
 168    iexport or iexport_data after the *definition* of the symbol.  */
 169
 170 #if defined(HAVE_ATTRIBUTE_VISIBILITY)
 171 # define internal_proto(x) \
 172         sym_rename(x, IPREFIX (x)) __attribute__((__visibility__("hidden")))
 173 #else
 174 # define internal_proto(x)      sym_rename(x, IPREFIX(x))
 175 #endif
 176
 177 #if defined(HAVE_ATTRIBUTE_VISIBILITY) && defined(HAVE_ATTRIBUTE_ALIAS)
 178 # define export_proto(x)        sym_rename(x, PREFIX(x))
 179 # define export_proto_np(x)     extern char swallow_semicolon
 180 # define iexport_proto(x)       internal_proto(x)
 181 # define iexport(x)             iexport1(x, IPREFIX(x))
 182 # define iexport1(x,y)          iexport2(x,y)
 183 # define iexport2(x,y) \
 184         extern __typeof(x) PREFIX(x) __attribute__((__alias__(#y)))
 185 #else
 186 # define export_proto(x)        sym_rename(x, PREFIX(x))
 187 # define export_proto_np(x)     extern char swallow_semicolon
 188 # define iexport_proto(x)       export_proto(x)
 189 # define iexport(x)             extern char swallow_semicolon
 190 #endif
 191
 192 /* TODO: detect the case when we *can* hide the symbol.  */
 193 #define iexport_data_proto(x)   export_proto(x)
 194 #define iexport_data(x)         extern char swallow_semicolon
 195
 196 /* The only reliable way to get the offset of a field in a struct
 197    in a system independent way is via this macro.  */
 198 #ifndef offsetof
 199 #define offsetof(TYPE, MEMBER)  ((size_t) &((TYPE *) 0)->MEMBER)
 200 #endif
 201
 202 /* The isfinite macro is only available with C99, but some non-C99
 203    systems still provide fpclassify, and there is a `finite' function
 204    in BSD.
 205
 206    Also, isfinite is broken on Cygwin.
 207
 208    When isfinite is not available, try to use one of the
 209    alternatives, or bail out.  */
 210
 211 #if defined(HAVE_BROKEN_ISFINITE) || defined(__CYGWIN__)
 212 #undef isfinite
 213 #endif
 214
 215 #if defined(HAVE_BROKEN_ISNAN)
 216 #undef isnan
 217 #endif
 218
 219 #if defined(HAVE_BROKEN_FPCLASSIFY)
 220 #undef fpclassify
 221 #endif
 222
 223 #if !defined(isfinite)
 224 #if !defined(fpclassify)
 225 #define isfinite(x) ((x) - (x) == 0)
 226 #else
 227 #define isfinite(x) (fpclassify(x) != FP_NAN && fpclassify(x) != FP_INFINITE)
 228 #endif /* !defined(fpclassify) */
 229 #endif /* !defined(isfinite)  */
 230
 231 #if !defined(isnan)
 232 #if !defined(fpclassify)
 233 #define isnan(x) ((x) != (x))
 234 #else
 235 #define isnan(x) (fpclassify(x) == FP_NAN)
 236 #endif /* !defined(fpclassify) */
 237 #endif /* !defined(isfinite)  */
 238
 239 /* TODO: find the C99 version of these an move into above ifdef.  */
 240 #define REALPART(z) (__real__(z))
 241 #define IMAGPART(z) (__imag__(z))
 242 #define COMPLEX_ASSIGN(z_, r_, i_) {__real__(z_) = (r_); __imag__(z_) = (i_);}
 243
 244 #include "kinds.h"
 245
 246 /* Define the type used for the current record number for large file I/O.
 247    The size must be consistent with the size defined on the compiler side.  */
 248 #ifdef HAVE_GFC_INTEGER_8
 249 typedef GFC_INTEGER_8 GFC_IO_INT;
 250 #else
 251 #ifdef HAVE_GFC_INTEGER_4
 252 typedef GFC_INTEGER_4 GFC_IO_INT;
 253 #else
 254 #error "GFC_INTEGER_4 should be available for the library to compile".
 255 #endif
 256 #endif
 257
 258 /* The following two definitions must be consistent with the types used
 259    by the compiler.  */
 260 /* The type used of array indices, amongst other things.  */
 261 typedef ssize_t index_type;
 262
 263 /* The type used for the lengths of character variables.  */
 264 typedef GFC_INTEGER_4 gfc_charlen_type;
 265
 266 /* Definitions of CHARACTER data types:
 267      - CHARACTER(KIND=1) corresponds to the C char type,
 268      - CHARACTER(KIND=4) corresponds to an unsigned 32-bit integer.  */
 269 typedef GFC_UINTEGER_4 gfc_char4_t;
 270
 271 /* Byte size of character kinds.  For the kinds currently supported, it's
 272    simply equal to the kind parameter itself.  */
 273 #define GFC_SIZE_OF_CHAR_KIND(kind) (kind)
 274
 275 /* This will be 0 on little-endian machines and one on big-endian machines.  */
 276 extern int big_endian;
 277 internal_proto(big_endian);
 278
 279 #define GFOR_POINTER_TO_L1(p, kind) \
 280   (big_endian * (kind - 1) + (GFC_LOGICAL_1 *)(p))
 281
 282 #define GFC_INTEGER_1_HUGE \
 283   (GFC_INTEGER_1)((((GFC_UINTEGER_1)1) << 7) - 1)
 284 #define GFC_INTEGER_2_HUGE \
 285   (GFC_INTEGER_2)((((GFC_UINTEGER_2)1) << 15) - 1)
 286 #define GFC_INTEGER_4_HUGE \
 287   (GFC_INTEGER_4)((((GFC_UINTEGER_4)1) << 31) - 1)
 288 #define GFC_INTEGER_8_HUGE \
 289   (GFC_INTEGER_8)((((GFC_UINTEGER_8)1) << 63) - 1)
 290 #ifdef HAVE_GFC_INTEGER_16
 291 #define GFC_INTEGER_16_HUGE \
 292   (GFC_INTEGER_16)((((GFC_UINTEGER_16)1) << 127) - 1)
 293 #endif
 294
 295 /* M{IN,AX}{LOC,VAL} need also infinities and NaNs if supported.  */
 296
 297 #ifdef __FLT_HAS_INFINITY__
 298 # define GFC_REAL_4_INFINITY __builtin_inff ()
 299 #endif
 300 #ifdef __DBL_HAS_INFINITY__
 301 # define GFC_REAL_8_INFINITY __builtin_inf ()
 302 #endif
 303 #ifdef __LDBL_HAS_INFINITY__
 304 # ifdef HAVE_GFC_REAL_10
 305 #  define GFC_REAL_10_INFINITY __builtin_infl ()
 306 # endif
 307 # ifdef HAVE_GFC_REAL_16
 308 #  define GFC_REAL_16_INFINITY __builtin_infl ()
 309 # endif
 310 #endif
 311 #ifdef __FLT_HAS_QUIET_NAN__
 312 # define GFC_REAL_4_QUIET_NAN __builtin_nanf ("")
 313 #endif
 314 #ifdef __DBL_HAS_QUIET_NAN__
 315 # define GFC_REAL_8_QUIET_NAN __builtin_nan ("")
 316 #endif
 317 #ifdef __LDBL_HAS_QUIET_NAN__
 318 # ifdef HAVE_GFC_REAL_10
 319 #  define GFC_REAL_10_QUIET_NAN __builtin_nanl ("")
 320 # endif
 321 # ifdef HAVE_GFC_REAL_16
 322 #  define GFC_REAL_16_QUIET_NAN __builtin_nanl ("")
 323 # endif
 324 #endif
 325
 326 typedef struct descriptor_dimension
 327 {
 328   index_type _stride;
 329   index_type _lbound;
 330   index_type _ubound;
 331 }
 332
 333 descriptor_dimension;
 334
 335 #define GFC_ARRAY_DESCRIPTOR(r, type) \
 336 struct {\
 337   type *data;\
 338   size_t offset;\
 339   index_type dtype;\
 340   descriptor_dimension dim[r];\
 341 }
 342
 343 /* Commonly used array descriptor types.  */
 344 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) gfc_array_void;
 345 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, char) gfc_array_char;
 346 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_1) gfc_array_i1;
 347 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_2) gfc_array_i2;
 348 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_array_i4;
 349 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_8) gfc_array_i8;
 350 #ifdef HAVE_GFC_INTEGER_16
 351 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_16) gfc_array_i16;
 352 #endif
 353 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_4) gfc_array_r4;
 354 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_8) gfc_array_r8;
 355 #ifdef HAVE_GFC_REAL_10
 356 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_10) gfc_array_r10;
 357 #endif
 358 #ifdef HAVE_GFC_REAL_16
 359 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_16) gfc_array_r16;
 360 #endif
 361 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_4) gfc_array_c4;
 362 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_8) gfc_array_c8;
 363 #ifdef HAVE_GFC_COMPLEX_10
 364 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_10) gfc_array_c10;
 365 #endif
 366 #ifdef HAVE_GFC_COMPLEX_16
 367 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_16) gfc_array_c16;
 368 #endif
 369 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_1) gfc_array_l1;
 370 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_2) gfc_array_l2;
 371 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_4) gfc_array_l4;
 372 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_8) gfc_array_l8;
 373 #ifdef HAVE_GFC_LOGICAL_16
 374 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
 375 #endif
 376
 377
 378 #define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype & GFC_DTYPE_RANK_MASK)
 379 #define GFC_DESCRIPTOR_TYPE(desc) (((desc)->dtype & GFC_DTYPE_TYPE_MASK) \
 380                                    >> GFC_DTYPE_TYPE_SHIFT)
 381 #define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype >> GFC_DTYPE_SIZE_SHIFT)
 382 #define GFC_DESCRIPTOR_DATA(desc) ((desc)->data)
 383 #define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
 384
 385 #define GFC_DIMENSION_LBOUND(dim) ((dim)._lbound)
 386 #define GFC_DIMENSION_UBOUND(dim) ((dim)._ubound)
 387 #define GFC_DIMENSION_STRIDE(dim) ((dim)._stride)
 388 #define GFC_DIMENSION_EXTENT(dim) ((dim)._ubound + 1 - (dim)._lbound)
 389 #define GFC_DIMENSION_SET(dim,lb,ub,str) \
 390   do \
 391     { \
 392       (dim)._lbound = lb;                       \
 393       (dim)._ubound = ub;                       \
 394       (dim)._stride = str;                      \
 395     } while (0)
 396
 397
 398 #define GFC_DESCRIPTOR_LBOUND(desc,i) ((desc)->dim[i]._lbound)
 399 #define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i]._ubound)
 400 #define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i]._ubound + 1 \
 401                                       - (desc)->dim[i]._lbound)
 402 #define GFC_DESCRIPTOR_EXTENT_BYTES(desc,i) \
 403   (GFC_DESCRIPTOR_EXTENT(desc,i) * GFC_DESCRIPTOR_SIZE(desc))
 404
 405 #define GFC_DESCRIPTOR_STRIDE(desc,i) ((desc)->dim[i]._stride)
 406 #define GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) \
 407   (GFC_DESCRIPTOR_STRIDE(desc,i) * GFC_DESCRIPTOR_SIZE(desc))
 408
 409 /* Macros to get both the size and the type with a single masking operation  */
 410
 411 #define GFC_DTYPE_SIZE_MASK \
 412   ((~((index_type) 0) >> GFC_DTYPE_SIZE_SHIFT) << GFC_DTYPE_SIZE_SHIFT)
 413 #define GFC_DTYPE_TYPE_SIZE_MASK (GFC_DTYPE_SIZE_MASK | GFC_DTYPE_TYPE_MASK)
 414
 415 #define GFC_DTYPE_TYPE_SIZE(desc) ((desc)->dtype & GFC_DTYPE_TYPE_SIZE_MASK)
 416
 417 #define GFC_DTYPE_INTEGER_1 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
 418    | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
 419 #define GFC_DTYPE_INTEGER_2 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
 420    | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
 421 #define GFC_DTYPE_INTEGER_4 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
 422    | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
 423 #define GFC_DTYPE_INTEGER_8 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
 424    | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
 425 #ifdef HAVE_GFC_INTEGER_16
 426 #define GFC_DTYPE_INTEGER_16 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
 427    | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
 428 #endif
 429
 430 #define GFC_DTYPE_LOGICAL_1 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
 431    | (sizeof(GFC_LOGICAL_1) << GFC_DTYPE_SIZE_SHIFT))
 432 #define GFC_DTYPE_LOGICAL_2 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
 433    | (sizeof(GFC_LOGICAL_2) << GFC_DTYPE_SIZE_SHIFT))
 434 #define GFC_DTYPE_LOGICAL_4 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
 435    | (sizeof(GFC_LOGICAL_4) << GFC_DTYPE_SIZE_SHIFT))
 436 #define GFC_DTYPE_LOGICAL_8 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
 437    | (sizeof(GFC_LOGICAL_8) << GFC_DTYPE_SIZE_SHIFT))
 438 #ifdef HAVE_GFC_LOGICAL_16
 439 #define GFC_DTYPE_LOGICAL_16 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
 440    | (sizeof(GFC_LOGICAL_16) << GFC_DTYPE_SIZE_SHIFT))
 441 #endif
 442
 443 #define GFC_DTYPE_REAL_4 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
 444    | (sizeof(GFC_REAL_4) << GFC_DTYPE_SIZE_SHIFT))
 445 #define GFC_DTYPE_REAL_8 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
 446    | (sizeof(GFC_REAL_8) << GFC_DTYPE_SIZE_SHIFT))
 447 #ifdef HAVE_GFC_REAL_10
 448 #define GFC_DTYPE_REAL_10  ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
 449    | (sizeof(GFC_REAL_10) << GFC_DTYPE_SIZE_SHIFT))
 450 #endif
 451 #ifdef HAVE_GFC_REAL_16
 452 #define GFC_DTYPE_REAL_16 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
 453    | (sizeof(GFC_REAL_16) << GFC_DTYPE_SIZE_SHIFT))
 454 #endif
 455
 456 #define GFC_DTYPE_COMPLEX_4 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
 457    | (sizeof(GFC_COMPLEX_4) << GFC_DTYPE_SIZE_SHIFT))
 458 #define GFC_DTYPE_COMPLEX_8 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
 459    | (sizeof(GFC_COMPLEX_8) << GFC_DTYPE_SIZE_SHIFT))
 460 #ifdef HAVE_GFC_COMPLEX_10
 461 #define GFC_DTYPE_COMPLEX_10 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
 462    | (sizeof(GFC_COMPLEX_10) << GFC_DTYPE_SIZE_SHIFT))
 463 #endif
 464 #ifdef HAVE_GFC_COMPLEX_16
 465 #define GFC_DTYPE_COMPLEX_16 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
 466    | (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT))
 467 #endif
 468
 469 #define GFC_DTYPE_DERIVED_1 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
 470    | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
 471 #define GFC_DTYPE_DERIVED_2 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
 472    | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
 473 #define GFC_DTYPE_DERIVED_4 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
 474    | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
 475 #define GFC_DTYPE_DERIVED_8 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
 476    | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
 477 #ifdef HAVE_GFC_INTEGER_16
 478 #define GFC_DTYPE_DERIVED_16 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
 479    | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
 480 #endif
 481
 482 /* Macros to determine the alignment of pointers.  */
 483
 484 #define GFC_UNALIGNED_2(x) (((uintptr_t)(x)) & \
 485                             (__alignof__(GFC_INTEGER_2) - 1))
 486 #define GFC_UNALIGNED_4(x) (((uintptr_t)(x)) & \
 487                             (__alignof__(GFC_INTEGER_4) - 1))
 488 #define GFC_UNALIGNED_8(x) (((uintptr_t)(x)) & \
 489                             (__alignof__(GFC_INTEGER_8) - 1))
 490 #ifdef HAVE_GFC_INTEGER_16
 491 #define GFC_UNALIGNED_16(x) (((uintptr_t)(x)) & \
 492                              (__alignof__(GFC_INTEGER_16) - 1))
 493 #endif
 494
 495 #define GFC_UNALIGNED_C4(x) (((uintptr_t)(x)) & \
 496                              (__alignof__(GFC_COMPLEX_4) - 1))
 497
 498 #define GFC_UNALIGNED_C8(x) (((uintptr_t)(x)) & \
 499                              (__alignof__(GFC_COMPLEX_8) - 1))
 500
 501 /* Runtime library include.  */
 502 #define stringize(x) expand_macro(x)
 503 #define expand_macro(x) # x
 504
 505 /* Runtime options structure.  */
 506
 507 typedef struct
 508 {
 509   int stdin_unit, stdout_unit, stderr_unit, optional_plus;
 510   int locus;
 511
 512   int separator_len;
 513   const char *separator;
 514
 515   int use_stderr, all_unbuffered, unbuffered_preconnected, default_recl;
 516   int fpe, dump_core, backtrace;
 517 }
 518 options_t;
 519
 520 extern options_t options;
 521 internal_proto(options);
 522
 523 extern void handler (int);
 524 internal_proto(handler);
 525
 526
 527 /* Compile-time options that will influence the library.  */
 528
 529 typedef struct
 530 {
 531   int warn_std;
 532   int allow_std;
 533   int pedantic;
 534   int convert;
 535   int dump_core;
 536   int backtrace;
 537   int sign_zero;
 538   size_t record_marker;
 539   int max_subrecord_length;
 540   int bounds_check;
 541   int range_check;
 542 }
 543 compile_options_t;
 544
 545 extern compile_options_t compile_options;
 546 internal_proto(compile_options);
 547
 548 extern void init_compile_options (void);
 549 internal_proto(init_compile_options);
 550
 551 #define GFC_MAX_SUBRECORD_LENGTH 2147483639   /* 2**31 - 9 */
 552
 553 /* Structure for statement options.  */
 554
 555 typedef struct
 556 {
 557   const char *name;
 558   int value;
 559 }
 560 st_option;
 561
 562
 563 /* This is returned by notification_std to know if, given the flags
 564    that were given (-std=, -pedantic) we should issue an error, a warning
 565    or nothing.  */
 566 typedef enum
 567 { SILENT, WARNING, ERROR }
 568 notification;
 569
 570 /* This is returned by notify_std and several io functions.  */
 571 typedef enum
 572 { SUCCESS = 1, FAILURE }
 573 try;
 574
 575 /* The filename and line number don't go inside the globals structure.
 576    They are set by the rest of the program and must be linked to.  */
 577
 578 /* Location of the current library call (optional).  */
 579 extern unsigned line;
 580 iexport_data_proto(line);
 581
 582 extern char *filename;
 583 iexport_data_proto(filename);
 584
 585 /* Avoid conflicting prototypes of alloca() in system headers by using
 586    GCC's builtin alloca().  */
 587 #define gfc_alloca(x)  __builtin_alloca(x)
 588
 589
 590 /* Directory for creating temporary files.  Only used when none of the
 591    following environment variables exist: GFORTRAN_TMPDIR, TMP and TEMP.  */
 592 #define DEFAULT_TEMPDIR "/tmp"
 593
 594 /* The default value of record length for preconnected units is defined
 595    here. This value can be overriden by an environment variable.
 596    Default value is 1 Gb.  */
 597 #define DEFAULT_RECL 1073741824
 598
 599
 600 #define CHARACTER2(name) \
 601               gfc_charlen_type name ## _len; \
 602               char * name
 603
 604 typedef struct st_parameter_common
 605 {
 606   GFC_INTEGER_4 flags;
 607   GFC_INTEGER_4 unit;
 608   const char *filename;
 609   GFC_INTEGER_4 line;
 610   CHARACTER2 (iomsg);
 611   GFC_INTEGER_4 *iostat;
 612 }
 613 st_parameter_common;
 614
 615 #undef CHARACTER2
 616
 617 #define IOPARM_LIBRETURN_MASK           (3 << 0)
 618 #define IOPARM_LIBRETURN_OK             (0 << 0)
 619 #define IOPARM_LIBRETURN_ERROR          (1 << 0)
 620 #define IOPARM_LIBRETURN_END            (2 << 0)
 621 #define IOPARM_LIBRETURN_EOR            (3 << 0)
 622 #define IOPARM_ERR                      (1 << 2)
 623 #define IOPARM_END                      (1 << 3)
 624 #define IOPARM_EOR                      (1 << 4)
 625 #define IOPARM_HAS_IOSTAT               (1 << 5)
 626 #define IOPARM_HAS_IOMSG                (1 << 6)
 627
 628 #define IOPARM_COMMON_MASK              ((1 << 7) - 1)
 629
 630 #define IOPARM_OPEN_HAS_RECL_IN         (1 << 7)
 631 #define IOPARM_OPEN_HAS_FILE            (1 << 8)
 632 #define IOPARM_OPEN_HAS_STATUS          (1 << 9)
 633 #define IOPARM_OPEN_HAS_ACCESS          (1 << 10)
 634 #define IOPARM_OPEN_HAS_FORM            (1 << 11)
 635 #define IOPARM_OPEN_HAS_BLANK           (1 << 12)
 636 #define IOPARM_OPEN_HAS_POSITION        (1 << 13)
 637 #define IOPARM_OPEN_HAS_ACTION          (1 << 14)
 638 #define IOPARM_OPEN_HAS_DELIM           (1 << 15)
 639 #define IOPARM_OPEN_HAS_PAD             (1 << 16)
 640 #define IOPARM_OPEN_HAS_CONVERT         (1 << 17)
 641 #define IOPARM_OPEN_HAS_DECIMAL         (1 << 18)
 642 #define IOPARM_OPEN_HAS_ENCODING        (1 << 19)
 643 #define IOPARM_OPEN_HAS_ROUND           (1 << 20)
 644 #define IOPARM_OPEN_HAS_SIGN            (1 << 21)
 645 #define IOPARM_OPEN_HAS_ASYNCHRONOUS    (1 << 22)
 646 #define IOPARM_OPEN_HAS_NEWUNIT         (1 << 23)
 647
 648 /* library start function and end macro.  These can be expanded if needed
 649    in the future.  cmp is st_parameter_common *cmp  */
 650
 651 extern void library_start (st_parameter_common *);
 652 internal_proto(library_start);
 653
 654 #define library_end()
 655
 656 /* main.c */
 657
 658 extern void stupid_function_name_for_static_linking (void);
 659 internal_proto(stupid_function_name_for_static_linking);
 660
 661 extern void set_args (int, char **);
 662 iexport_proto(set_args);
 663
 664 extern void get_args (int *, char ***);
 665 internal_proto(get_args);
 666
 667 extern void store_exe_path (const char *);
 668 export_proto(store_exe_path);
 669
 670 extern char * full_exe_path (void);
 671 internal_proto(full_exe_path);
 672
 673 /* backtrace.c */
 674
 675 extern void show_backtrace (void);
 676 internal_proto(show_backtrace);
 677
 678 /* error.c */
 679
 680 #if defined(HAVE_GFC_REAL_16)
 681 #define GFC_LARGEST_BUF (sizeof (GFC_REAL_16))
 682 #elif defined(HAVE_GFC_REAL_10)
 683 #define GFC_LARGEST_BUF (sizeof (GFC_REAL_10))
 684 #else
 685 #define GFC_LARGEST_BUF (sizeof (GFC_INTEGER_LARGEST))
 686 #endif
 687
 688 #define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 2)
 689 #define GFC_XTOA_BUF_SIZE (GFC_LARGEST_BUF * 2 + 1)
 690 #define GFC_OTOA_BUF_SIZE (GFC_LARGEST_BUF * 3 + 1)
 691 #define GFC_BTOA_BUF_SIZE (GFC_LARGEST_BUF * 8 + 1)
 692
 693 extern void sys_exit (int) __attribute__ ((noreturn));
 694 internal_proto(sys_exit);
 695
 696 extern const char *gfc_xtoa (GFC_UINTEGER_LARGEST, char *, size_t);
 697 internal_proto(gfc_xtoa);
 698
 699 extern void os_error (const char *) __attribute__ ((noreturn));
 700 iexport_proto(os_error);
 701
 702 extern void show_locus (st_parameter_common *);
 703 internal_proto(show_locus);
 704
 705 extern void runtime_error (const char *, ...)
 706      __attribute__ ((noreturn, format (printf, 1, 2)));
 707 iexport_proto(runtime_error);
 708
 709 extern void runtime_error_at (const char *, const char *, ...)
 710      __attribute__ ((noreturn, format (printf, 2, 3)));
 711 iexport_proto(runtime_error_at);
 712
 713 extern void runtime_warning_at (const char *, const char *, ...)
 714      __attribute__ ((format (printf, 2, 3)));
 715 iexport_proto(runtime_warning_at);
 716
 717 extern void internal_error (st_parameter_common *, const char *)
 718   __attribute__ ((noreturn));
 719 internal_proto(internal_error);
 720
 721 extern const char *get_oserror (void);
 722 internal_proto(get_oserror);
 723
 724 extern const char *translate_error (int);
 725 internal_proto(translate_error);
 726
 727 extern void generate_error (st_parameter_common *, int, const char *);
 728 iexport_proto(generate_error);
 729
 730 extern try notify_std (st_parameter_common *, int, const char *);
 731 internal_proto(notify_std);
 732
 733 extern notification notification_std(int);
 734 internal_proto(notification_std);
 735
 736 /* fpu.c */
 737
 738 extern void set_fpu (void);
 739 internal_proto(set_fpu);
 740
 741 /* memory.c */
 742
 743 extern void *get_mem (size_t) __attribute__ ((malloc));
 744 internal_proto(get_mem);
 745
 746 extern void free_mem (void *);
 747 internal_proto(free_mem);
 748
 749 extern void *internal_malloc_size (size_t) __attribute__ ((malloc));
 750 internal_proto(internal_malloc_size);
 751
 752 /* environ.c */
 753
 754 extern int check_buffered (int);
 755 internal_proto(check_buffered);
 756
 757 extern void init_variables (void);
 758 internal_proto(init_variables);
 759
 760 extern void show_variables (void);
 761 internal_proto(show_variables);
 762
 763 unit_convert get_unformatted_convert (int);
 764 internal_proto(get_unformatted_convert);
 765
 766 /* string.c */
 767
 768 extern int find_option (st_parameter_common *, const char *, gfc_charlen_type,
 769                         const st_option *, const char *);
 770 internal_proto(find_option);
 771
 772 extern gfc_charlen_type fstrlen (const char *, gfc_charlen_type);
 773 internal_proto(fstrlen);
 774
 775 extern gfc_charlen_type fstrcpy (char *, gfc_charlen_type, const char *, gfc_charlen_type);
 776 internal_proto(fstrcpy);
 777
 778 extern gfc_charlen_type cf_strcpy (char *, gfc_charlen_type, const char *);
 779 internal_proto(cf_strcpy);
 780
 781 /* io/intrinsics.c */
 782
 783 extern void flush_all_units (void);
 784 internal_proto(flush_all_units);
 785
 786 /* io.c */
 787
 788 extern void init_units (void);
 789 internal_proto(init_units);
 790
 791 extern void close_units (void);
 792 internal_proto(close_units);
 793
 794 extern int unit_to_fd (int);
 795 internal_proto(unit_to_fd);
 796
 797 extern int st_printf (const char *, ...)
 798   __attribute__ ((format (printf, 1, 2)));
 799 internal_proto(st_printf);
 800
 801 extern int st_vprintf (const char *, va_list);
 802 internal_proto(st_vprintf);
 803
 804 extern char * filename_from_unit (int);
 805 internal_proto(filename_from_unit);
 806
 807 /* stop.c */
 808
 809 extern void stop_numeric (GFC_INTEGER_4) __attribute__ ((noreturn));
 810 iexport_proto(stop_numeric);
 811
 812 /* reshape_packed.c */
 813
 814 extern void reshape_packed (char *, index_type, const char *, index_type,
 815                             const char *, index_type);
 816 internal_proto(reshape_packed);
 817
 818 /* Repacking functions.  These are called internally by internal_pack
 819    and internal_unpack.  */
 820
 821 GFC_INTEGER_1 *internal_pack_1 (gfc_array_i1 *);
 822 internal_proto(internal_pack_1);
 823
 824 GFC_INTEGER_2 *internal_pack_2 (gfc_array_i2 *);
 825 internal_proto(internal_pack_2);
 826
 827 GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *);
 828 internal_proto(internal_pack_4);
 829
 830 GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *);
 831 internal_proto(internal_pack_8);
 832
 833 #if defined HAVE_GFC_INTEGER_16
 834 GFC_INTEGER_16 *internal_pack_16 (gfc_array_i16 *);
 835 internal_proto(internal_pack_16);
 836 #endif
 837
 838 GFC_REAL_4 *internal_pack_r4 (gfc_array_r4 *);
 839 internal_proto(internal_pack_r4);
 840
 841 GFC_REAL_8 *internal_pack_r8 (gfc_array_r8 *);
 842 internal_proto(internal_pack_r8);
 843
 844 #if defined HAVE_GFC_REAL_10
 845 GFC_REAL_10 *internal_pack_r10 (gfc_array_r10 *);
 846 internal_proto(internal_pack_r10);
 847 #endif
 848
 849 #if defined HAVE_GFC_REAL_16
 850 GFC_REAL_16 *internal_pack_r16 (gfc_array_r16 *);
 851 internal_proto(internal_pack_r16);
 852 #endif
 853
 854 GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *);
 855 internal_proto(internal_pack_c4);
 856
 857 GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *);
 858 internal_proto(internal_pack_c8);
 859
 860 #if defined HAVE_GFC_COMPLEX_10
 861 GFC_COMPLEX_10 *internal_pack_c10 (gfc_array_c10 *);
 862 internal_proto(internal_pack_c10);
 863 #endif
 864
 865 #if defined HAVE_GFC_COMPLEX_16
 866 GFC_COMPLEX_16 *internal_pack_c16 (gfc_array_c16 *);
 867 internal_proto(internal_pack_c16);
 868 #endif
 869
 870 extern void internal_unpack_1 (gfc_array_i1 *, const GFC_INTEGER_1 *);
 871 internal_proto(internal_unpack_1);
 872
 873 extern void internal_unpack_2 (gfc_array_i2 *, const GFC_INTEGER_2 *);
 874 internal_proto(internal_unpack_2);
 875
 876 extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *);
 877 internal_proto(internal_unpack_4);
 878
 879 extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *);
 880 internal_proto(internal_unpack_8);
 881
 882 #if defined HAVE_GFC_INTEGER_16
 883 extern void internal_unpack_16 (gfc_array_i16 *, const GFC_INTEGER_16 *);
 884 internal_proto(internal_unpack_16);
 885 #endif
 886
 887 extern void internal_unpack_r4 (gfc_array_r4 *, const GFC_REAL_4 *);
 888 internal_proto(internal_unpack_r4);
 889
 890 extern void internal_unpack_r8 (gfc_array_r8 *, const GFC_REAL_8 *);
 891 internal_proto(internal_unpack_r8);
 892
 893 #if defined HAVE_GFC_REAL_10
 894 extern void internal_unpack_r10 (gfc_array_r10 *, const GFC_REAL_10 *);
 895 internal_proto(internal_unpack_r10);
 896 #endif
 897
 898 #if defined HAVE_GFC_REAL_16
 899 extern void internal_unpack_r16 (gfc_array_r16 *, const GFC_REAL_16 *);
 900 internal_proto(internal_unpack_r16);
 901 #endif
 902
 903 extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *);
 904 internal_proto(internal_unpack_c4);
 905
 906 extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *);
 907 internal_proto(internal_unpack_c8);
 908
 909 #if defined HAVE_GFC_COMPLEX_10
 910 extern void internal_unpack_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *);
 911 internal_proto(internal_unpack_c10);
 912 #endif
 913
 914 #if defined HAVE_GFC_COMPLEX_16
 915 extern void internal_unpack_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *);
 916 internal_proto(internal_unpack_c16);
 917 #endif
 918
 919 /* Internal auxiliary functions for the pack intrinsic.  */
 920
 921 extern void pack_i1 (gfc_array_i1 *, const gfc_array_i1 *,
 922                      const gfc_array_l1 *, const gfc_array_i1 *);
 923 internal_proto(pack_i1);
 924
 925 extern void pack_i2 (gfc_array_i2 *, const gfc_array_i2 *,
 926                      const gfc_array_l1 *, const gfc_array_i2 *);
 927 internal_proto(pack_i2);
 928
 929 extern void pack_i4 (gfc_array_i4 *, const gfc_array_i4 *,
 930                      const gfc_array_l1 *, const gfc_array_i4 *);
 931 internal_proto(pack_i4);
 932
 933 extern void pack_i8 (gfc_array_i8 *, const gfc_array_i8 *,
 934                      const gfc_array_l1 *, const gfc_array_i8 *);
 935 internal_proto(pack_i8);
 936
 937 #ifdef HAVE_GFC_INTEGER_16
 938 extern void pack_i16 (gfc_array_i16 *, const gfc_array_i16 *,
 939                      const gfc_array_l1 *, const gfc_array_i16 *);
 940 internal_proto(pack_i16);
 941 #endif
 942
 943 extern void pack_r4 (gfc_array_r4 *, const gfc_array_r4 *,
 944                      const gfc_array_l1 *, const gfc_array_r4 *);
 945 internal_proto(pack_r4);
 946
 947 extern void pack_r8 (gfc_array_r8 *, const gfc_array_r8 *,
 948                      const gfc_array_l1 *, const gfc_array_r8 *);
 949 internal_proto(pack_r8);
 950
 951 #ifdef HAVE_GFC_REAL_10
 952 extern void pack_r10 (gfc_array_r10 *, const gfc_array_r10 *,
 953                      const gfc_array_l1 *, const gfc_array_r10 *);
 954 internal_proto(pack_r10);
 955 #endif
 956
 957 #ifdef HAVE_GFC_REAL_16
 958 extern void pack_r16 (gfc_array_r16 *, const gfc_array_r16 *,
 959                      const gfc_array_l1 *, const gfc_array_r16 *);
 960 internal_proto(pack_r16);
 961 #endif
 962
 963 extern void pack_c4 (gfc_array_c4 *, const gfc_array_c4 *,
 964                      const gfc_array_l1 *, const gfc_array_c4 *);
 965 internal_proto(pack_c4);
 966
 967 extern void pack_c8 (gfc_array_c8 *, const gfc_array_c8 *,
 968                      const gfc_array_l1 *, const gfc_array_c8 *);
 969 internal_proto(pack_c8);
 970
 971 #ifdef HAVE_GFC_REAL_10
 972 extern void pack_c10 (gfc_array_c10 *, const gfc_array_c10 *,
 973                      const gfc_array_l1 *, const gfc_array_c10 *);
 974 internal_proto(pack_c10);
 975 #endif
 976
 977 #ifdef HAVE_GFC_REAL_16
 978 extern void pack_c16 (gfc_array_c16 *, const gfc_array_c16 *,
 979                      const gfc_array_l1 *, const gfc_array_c16 *);
 980 internal_proto(pack_c16);
 981 #endif
 982
 983 /* Internal auxiliary functions for the unpack intrinsic.  */
 984
 985 extern void unpack0_i1 (gfc_array_i1 *, const gfc_array_i1 *,
 986                         const gfc_array_l1 *, const GFC_INTEGER_1 *);
 987 internal_proto(unpack0_i1);
 988
 989 extern void unpack0_i2 (gfc_array_i2 *, const gfc_array_i2 *,
 990                         const gfc_array_l1 *, const GFC_INTEGER_2 *);
 991 internal_proto(unpack0_i2);
 992
 993 extern void unpack0_i4 (gfc_array_i4 *, const gfc_array_i4 *,
 994                         const gfc_array_l1 *, const GFC_INTEGER_4 *);
 995 internal_proto(unpack0_i4);
 996
 997 extern void unpack0_i8 (gfc_array_i8 *, const gfc_array_i8 *,
 998                         const gfc_array_l1 *, const GFC_INTEGER_8 *);
 999 internal_proto(unpack0_i8);
1000
1001 #ifdef HAVE_GFC_INTEGER_16
1002
1003 extern void unpack0_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1004                          const gfc_array_l1 *, const GFC_INTEGER_16 *);
1005 internal_proto(unpack0_i16);
1006
1007 #endif
1008
1009 extern void unpack0_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1010                         const gfc_array_l1 *, const GFC_REAL_4 *);
1011 internal_proto(unpack0_r4);
1012
1013 extern void unpack0_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1014                         const gfc_array_l1 *, const GFC_REAL_8 *);
1015 internal_proto(unpack0_r8);
1016
1017 #ifdef HAVE_GFC_REAL_10
1018
1019 extern void unpack0_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1020                          const gfc_array_l1 *, const GFC_REAL_10 *);
1021 internal_proto(unpack0_r10);
1022
1023 #endif
1024
1025 #ifdef HAVE_GFC_REAL_16
1026
1027 extern void unpack0_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1028                          const gfc_array_l1 *, const GFC_REAL_16 *);
1029 internal_proto(unpack0_r16);
1030
1031 #endif
1032
1033 extern void unpack0_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1034                         const gfc_array_l1 *, const GFC_COMPLEX_4 *);
1035 internal_proto(unpack0_c4);
1036
1037 extern void unpack0_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1038                         const gfc_array_l1 *, const GFC_COMPLEX_8 *);
1039 internal_proto(unpack0_c8);
1040
1041 #ifdef HAVE_GFC_COMPLEX_10
1042
1043 extern void unpack0_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1044                          const gfc_array_l1 *mask, const GFC_COMPLEX_10 *);
1045 internal_proto(unpack0_c10);
1046
1047 #endif
1048
1049 #ifdef HAVE_GFC_COMPLEX_16
1050
1051 extern void unpack0_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1052                          const gfc_array_l1 *, const GFC_COMPLEX_16 *);
1053 internal_proto(unpack0_c16);
1054
1055 #endif
1056
1057 extern void unpack1_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1058                         const gfc_array_l1 *, const gfc_array_i1 *);
1059 internal_proto(unpack1_i1);
1060
1061 extern void unpack1_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1062                         const gfc_array_l1 *, const gfc_array_i2 *);
1063 internal_proto(unpack1_i2);
1064
1065 extern void unpack1_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1066                         const gfc_array_l1 *, const gfc_array_i4 *);
1067 internal_proto(unpack1_i4);
1068
1069 extern void unpack1_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1070                         const gfc_array_l1 *, const gfc_array_i8 *);
1071 internal_proto(unpack1_i8);
1072
1073 #ifdef HAVE_GFC_INTEGER_16
1074 extern void unpack1_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1075                          const gfc_array_l1 *, const gfc_array_i16 *);
1076 internal_proto(unpack1_i16);
1077 #endif
1078
1079 extern void unpack1_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1080                         const gfc_array_l1 *, const gfc_array_r4 *);
1081 internal_proto(unpack1_r4);
1082
1083 extern void unpack1_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1084                         const gfc_array_l1 *, const gfc_array_r8 *);
1085 internal_proto(unpack1_r8);
1086
1087 #ifdef HAVE_GFC_REAL_10
1088 extern void unpack1_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1089                          const gfc_array_l1 *, const gfc_array_r10 *);
1090 internal_proto(unpack1_r10);
1091 #endif
1092
1093 #ifdef HAVE_GFC_REAL_16
1094 extern void unpack1_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1095                          const gfc_array_l1 *, const gfc_array_r16 *);
1096 internal_proto(unpack1_r16);
1097 #endif
1098
1099 extern void unpack1_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1100                         const gfc_array_l1 *, const gfc_array_c4 *);
1101 internal_proto(unpack1_c4);
1102
1103 extern void unpack1_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1104                         const gfc_array_l1 *, const gfc_array_c8 *);
1105 internal_proto(unpack1_c8);
1106
1107 #ifdef HAVE_GFC_COMPLEX_10
1108 extern void unpack1_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1109                          const gfc_array_l1 *, const gfc_array_c10 *);
1110 internal_proto(unpack1_c10);
1111 #endif
1112
1113 #ifdef HAVE_GFC_COMPLEX_16
1114 extern void unpack1_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1115                          const gfc_array_l1 *, const gfc_array_c16 *);
1116 internal_proto(unpack1_c16);
1117 #endif
1118
1119 /* Helper functions for spread.  */
1120
1121 extern void spread_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1122                        const index_type, const index_type);
1123 internal_proto(spread_i1);
1124
1125 extern void spread_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1126                        const index_type, const index_type);
1127 internal_proto(spread_i2);
1128
1129 extern void spread_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1130                        const index_type, const index_type);
1131 internal_proto(spread_i4);
1132
1133 extern void spread_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1134                        const index_type, const index_type);
1135 internal_proto(spread_i8);
1136
1137 #ifdef HAVE_GFC_INTEGER_16
1138 extern void spread_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1139                        const index_type, const index_type);
1140 internal_proto(spread_i16);
1141
1142 #endif
1143
1144 extern void spread_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1145                        const index_type, const index_type);
1146 internal_proto(spread_r4);
1147
1148 extern void spread_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1149                        const index_type, const index_type);
1150 internal_proto(spread_r8);
1151
1152 #ifdef HAVE_GFC_REAL_10
1153 extern void spread_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1154                        const index_type, const index_type);
1155 internal_proto(spread_r10);
1156
1157 #endif
1158
1159 #ifdef HAVE_GFC_REAL_16
1160 extern void spread_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1161                        const index_type, const index_type);
1162 internal_proto(spread_r16);
1163
1164 #endif
1165
1166 extern void spread_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1167                        const index_type, const index_type);
1168 internal_proto(spread_c4);
1169
1170 extern void spread_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1171                        const index_type, const index_type);
1172 internal_proto(spread_c8);
1173
1174 #ifdef HAVE_GFC_COMPLEX_10
1175 extern void spread_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1176                        const index_type, const index_type);
1177 internal_proto(spread_c10);
1178
1179 #endif
1180
1181 #ifdef HAVE_GFC_COMPLEX_16
1182 extern void spread_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1183                        const index_type, const index_type);
1184 internal_proto(spread_c16);
1185
1186 #endif
1187
1188 extern void spread_scalar_i1 (gfc_array_i1 *, const GFC_INTEGER_1 *,
1189                               const index_type, const index_type);
1190 internal_proto(spread_scalar_i1);
1191
1192 extern void spread_scalar_i2 (gfc_array_i2 *, const GFC_INTEGER_2 *,
1193                               const index_type, const index_type);
1194 internal_proto(spread_scalar_i2);
1195
1196 extern void spread_scalar_i4 (gfc_array_i4 *, const GFC_INTEGER_4 *,
1197                               const index_type, const index_type);
1198 internal_proto(spread_scalar_i4);
1199
1200 extern void spread_scalar_i8 (gfc_array_i8 *, const GFC_INTEGER_8 *,
1201                               const index_type, const index_type);
1202 internal_proto(spread_scalar_i8);
1203
1204 #ifdef HAVE_GFC_INTEGER_16
1205 extern void spread_scalar_i16 (gfc_array_i16 *, const GFC_INTEGER_16 *,
1206                                const index_type, const index_type);
1207 internal_proto(spread_scalar_i16);
1208
1209 #endif
1210
1211 extern void spread_scalar_r4 (gfc_array_r4 *, const GFC_REAL_4 *,
1212                               const index_type, const index_type);
1213 internal_proto(spread_scalar_r4);
1214
1215 extern void spread_scalar_r8 (gfc_array_r8 *, const GFC_REAL_8 *,
1216                               const index_type, const index_type);
1217 internal_proto(spread_scalar_r8);
1218
1219 #ifdef HAVE_GFC_REAL_10
1220 extern void spread_scalar_r10 (gfc_array_r10 *, const GFC_REAL_10 *,
1221                                const index_type, const index_type);
1222 internal_proto(spread_scalar_r10);
1223
1224 #endif
1225
1226 #ifdef HAVE_GFC_REAL_16
1227 extern void spread_scalar_r16 (gfc_array_r16 *, const GFC_REAL_16 *,
1228                                const index_type, const index_type);
1229 internal_proto(spread_scalar_r16);
1230
1231 #endif
1232
1233 extern void spread_scalar_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *,
1234                               const index_type, const index_type);
1235 internal_proto(spread_scalar_c4);
1236
1237 extern void spread_scalar_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *,
1238                               const index_type, const index_type);
1239 internal_proto(spread_scalar_c8);
1240
1241 #ifdef HAVE_GFC_COMPLEX_10
1242 extern void spread_scalar_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *,
1243                                const index_type, const index_type);
1244 internal_proto(spread_scalar_c10);
1245
1246 #endif
1247
1248 #ifdef HAVE_GFC_COMPLEX_16
1249 extern void spread_scalar_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *,
1250                                const index_type, const index_type);
1251 internal_proto(spread_scalar_c16);
1252
1253 #endif
1254
1255 /* string_intrinsics.c */
1256
1257 extern int compare_string (gfc_charlen_type, const char *,
1258                            gfc_charlen_type, const char *);
1259 iexport_proto(compare_string);
1260
1261 extern int compare_string_char4 (gfc_charlen_type, const gfc_char4_t *,
1262                                  gfc_charlen_type, const gfc_char4_t *);
1263 iexport_proto(compare_string_char4);
1264
1265 /* random.c */
1266
1267 extern void random_seed_i4 (GFC_INTEGER_4 * size, gfc_array_i4 * put,
1268                             gfc_array_i4 * get);
1269 iexport_proto(random_seed_i4);
1270 extern void random_seed_i8 (GFC_INTEGER_8 * size, gfc_array_i8 * put,
1271                             gfc_array_i8 * get);
1272 iexport_proto(random_seed_i8);
1273
1274 /* size.c */
1275
1276 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) array_t;
1277
1278 extern index_type size0 (const array_t * array);
1279 iexport_proto(size0);
1280
1281 /* bounds.c */
1282
1283 extern void bounds_equal_extents (array_t *, array_t *, const char *,
1284                                   const char *);
1285 internal_proto(bounds_equal_extents);
1286
1287 extern void bounds_reduced_extents (array_t *, array_t *, int, const char *,
1288                              const char *intrinsic);
1289 internal_proto(bounds_reduced_extents);
1290
1291 extern void bounds_iforeach_return (array_t *, array_t *, const char *);
1292 internal_proto(bounds_iforeach_return);
1293
1294 extern void bounds_ifunction_return (array_t *, const index_type *,
1295                                      const char *, const char *);
1296 internal_proto(bounds_ifunction_return);
1297
1298 extern index_type count_0 (const gfc_array_l1 *);
1299
1300 internal_proto(count_0);
1301
1302 /* Internal auxiliary functions for cshift */
1303
1304 void cshift0_i1 (gfc_array_i1 *, const gfc_array_i1 *, ssize_t, int);
1305 internal_proto(cshift0_i1);
1306
1307 void cshift0_i2 (gfc_array_i2 *, const gfc_array_i2 *, ssize_t, int);
1308 internal_proto(cshift0_i2);
1309
1310 void cshift0_i4 (gfc_array_i4 *, const gfc_array_i4 *, ssize_t, int);
1311 internal_proto(cshift0_i4);
1312
1313 void cshift0_i8 (gfc_array_i8 *, const gfc_array_i8 *, ssize_t, int);
1314 internal_proto(cshift0_i8);
1315
1316 #ifdef HAVE_GFC_INTEGER_16
1317 void cshift0_i16 (gfc_array_i16 *, const gfc_array_i16 *, ssize_t, int);
1318 internal_proto(cshift0_i16);
1319 #endif
1320
1321 void cshift0_r4 (gfc_array_r4 *, const gfc_array_r4 *, ssize_t, int);
1322 internal_proto(cshift0_r4);
1323
1324 void cshift0_r8 (gfc_array_r8 *, const gfc_array_r8 *, ssize_t, int);
1325 internal_proto(cshift0_r8);
1326
1327 #ifdef HAVE_GFC_REAL_10
1328 void cshift0_r10 (gfc_array_r10 *, const gfc_array_r10 *, ssize_t, int);
1329 internal_proto(cshift0_r10);
1330 #endif
1331
1332 #ifdef HAVE_GFC_REAL_16
1333 void cshift0_r16 (gfc_array_r16 *, const gfc_array_r16 *, ssize_t, int);
1334 internal_proto(cshift0_r16);
1335 #endif
1336
1337 void cshift0_c4 (gfc_array_c4 *, const gfc_array_c4 *, ssize_t, int);
1338 internal_proto(cshift0_c4);
1339
1340 void cshift0_c8 (gfc_array_c8 *, const gfc_array_c8 *, ssize_t, int);
1341 internal_proto(cshift0_c8);
1342
1343 #ifdef HAVE_GFC_COMPLEX_10
1344 void cshift0_c10 (gfc_array_c10 *, const gfc_array_c10 *, ssize_t, int);
1345 internal_proto(cshift0_c10);
1346 #endif
1347
1348 #ifdef HAVE_GFC_COMPLEX_16
1349 void cshift0_c16 (gfc_array_c16 *, const gfc_array_c16 *, ssize_t, int);
1350 internal_proto(cshift0_c16);
1351 #endif
1352
1353 #endif  /* LIBGFOR_H  */