libgfortran/libgfortran.h

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