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
  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 (gnu_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_xtoa (GFC_UINTEGER_LARGEST, char *, size_t);
 639 internal_proto(gfc_xtoa);
 640
 641 extern void os_error (const char *) __attribute__ ((noreturn));
 642 iexport_proto(os_error);
 643
 644 extern void show_locus (st_parameter_common *);
 645 internal_proto(show_locus);
 646
 647 extern void runtime_error (const char *, ...)
 648      __attribute__ ((noreturn, format (printf, 1, 2)));
 649 iexport_proto(runtime_error);
 650
 651 extern void runtime_error_at (const char *, const char *, ...)
 652      __attribute__ ((noreturn, format (printf, 2, 3)));
 653 iexport_proto(runtime_error_at);
 654
 655 extern void runtime_warning_at (const char *, const char *, ...)
 656      __attribute__ ((format (printf, 2, 3)));
 657 iexport_proto(runtime_warning_at);
 658
 659 extern void internal_error (st_parameter_common *, const char *)
 660   __attribute__ ((noreturn));
 661 internal_proto(internal_error);
 662
 663 extern const char *get_oserror (void);
 664 internal_proto(get_oserror);
 665
 666 extern const char *translate_error (int);
 667 internal_proto(translate_error);
 668
 669 extern void generate_error (st_parameter_common *, int, const char *);
 670 iexport_proto(generate_error);
 671
 672 extern try notify_std (st_parameter_common *, int, const char *);
 673 internal_proto(notify_std);
 674
 675 extern notification notification_std(int);
 676 internal_proto(notification_std);
 677
 678 /* fpu.c */
 679
 680 extern void set_fpu (void);
 681 internal_proto(set_fpu);
 682
 683 /* memory.c */
 684
 685 extern void *get_mem (size_t) __attribute__ ((malloc));
 686 internal_proto(get_mem);
 687
 688 extern void free_mem (void *);
 689 internal_proto(free_mem);
 690
 691 extern void *internal_malloc_size (size_t) __attribute__ ((malloc));
 692 internal_proto(internal_malloc_size);
 693
 694 /* environ.c */
 695
 696 extern int check_buffered (int);
 697 internal_proto(check_buffered);
 698
 699 extern void init_variables (void);
 700 internal_proto(init_variables);
 701
 702 extern void show_variables (void);
 703 internal_proto(show_variables);
 704
 705 unit_convert get_unformatted_convert (int);
 706 internal_proto(get_unformatted_convert);
 707
 708 /* string.c */
 709
 710 extern int find_option (st_parameter_common *, const char *, gfc_charlen_type,
 711                         const st_option *, const char *);
 712 internal_proto(find_option);
 713
 714 extern gfc_charlen_type fstrlen (const char *, gfc_charlen_type);
 715 internal_proto(fstrlen);
 716
 717 extern gfc_charlen_type fstrcpy (char *, gfc_charlen_type, const char *, gfc_charlen_type);
 718 internal_proto(fstrcpy);
 719
 720 extern gfc_charlen_type cf_strcpy (char *, gfc_charlen_type, const char *);
 721 internal_proto(cf_strcpy);
 722
 723 /* io/intrinsics.c */
 724
 725 extern void flush_all_units (void);
 726 internal_proto(flush_all_units);
 727
 728 /* io.c */
 729
 730 extern void init_units (void);
 731 internal_proto(init_units);
 732
 733 extern void close_units (void);
 734 internal_proto(close_units);
 735
 736 extern int unit_to_fd (int);
 737 internal_proto(unit_to_fd);
 738
 739 extern int st_printf (const char *, ...)
 740   __attribute__ ((format (printf, 1, 2)));
 741 internal_proto(st_printf);
 742
 743 extern int st_vprintf (const char *, va_list);
 744 internal_proto(st_vprintf);
 745
 746 extern char * filename_from_unit (int);
 747 internal_proto(filename_from_unit);
 748
 749 /* stop.c */
 750
 751 extern void stop_numeric (GFC_INTEGER_4) __attribute__ ((noreturn));
 752 iexport_proto(stop_numeric);
 753
 754 /* reshape_packed.c */
 755
 756 extern void reshape_packed (char *, index_type, const char *, index_type,
 757                             const char *, index_type);
 758 internal_proto(reshape_packed);
 759
 760 /* Repacking functions.  These are called internally by internal_pack
 761    and internal_unpack.  */
 762
 763 GFC_INTEGER_1 *internal_pack_1 (gfc_array_i1 *);
 764 internal_proto(internal_pack_1);
 765
 766 GFC_INTEGER_2 *internal_pack_2 (gfc_array_i2 *);
 767 internal_proto(internal_pack_2);
 768
 769 GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *);
 770 internal_proto(internal_pack_4);
 771
 772 GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *);
 773 internal_proto(internal_pack_8);
 774
 775 #if defined HAVE_GFC_INTEGER_16
 776 GFC_INTEGER_16 *internal_pack_16 (gfc_array_i16 *);
 777 internal_proto(internal_pack_16);
 778 #endif
 779
 780 GFC_REAL_4 *internal_pack_r4 (gfc_array_r4 *);
 781 internal_proto(internal_pack_r4);
 782
 783 GFC_REAL_8 *internal_pack_r8 (gfc_array_r8 *);
 784 internal_proto(internal_pack_r8);
 785
 786 #if defined HAVE_GFC_REAL_10
 787 GFC_REAL_10 *internal_pack_r10 (gfc_array_r10 *);
 788 internal_proto(internal_pack_r10);
 789 #endif
 790
 791 #if defined HAVE_GFC_REAL_16
 792 GFC_REAL_16 *internal_pack_r16 (gfc_array_r16 *);
 793 internal_proto(internal_pack_r16);
 794 #endif
 795
 796 GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *);
 797 internal_proto(internal_pack_c4);
 798
 799 GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *);
 800 internal_proto(internal_pack_c8);
 801
 802 #if defined HAVE_GFC_COMPLEX_10
 803 GFC_COMPLEX_10 *internal_pack_c10 (gfc_array_c10 *);
 804 internal_proto(internal_pack_c10);
 805 #endif
 806
 807 #if defined HAVE_GFC_COMPLEX_16
 808 GFC_COMPLEX_16 *internal_pack_c16 (gfc_array_c16 *);
 809 internal_proto(internal_pack_c16);
 810 #endif
 811
 812 extern void internal_unpack_1 (gfc_array_i1 *, const GFC_INTEGER_1 *);
 813 internal_proto(internal_unpack_1);
 814
 815 extern void internal_unpack_2 (gfc_array_i2 *, const GFC_INTEGER_2 *);
 816 internal_proto(internal_unpack_2);
 817
 818 extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *);
 819 internal_proto(internal_unpack_4);
 820
 821 extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *);
 822 internal_proto(internal_unpack_8);
 823
 824 #if defined HAVE_GFC_INTEGER_16
 825 extern void internal_unpack_16 (gfc_array_i16 *, const GFC_INTEGER_16 *);
 826 internal_proto(internal_unpack_16);
 827 #endif
 828
 829 extern void internal_unpack_r4 (gfc_array_r4 *, const GFC_REAL_4 *);
 830 internal_proto(internal_unpack_r4);
 831
 832 extern void internal_unpack_r8 (gfc_array_r8 *, const GFC_REAL_8 *);
 833 internal_proto(internal_unpack_r8);
 834
 835 #if defined HAVE_GFC_REAL_10
 836 extern void internal_unpack_r10 (gfc_array_r10 *, const GFC_REAL_10 *);
 837 internal_proto(internal_unpack_r10);
 838 #endif
 839
 840 #if defined HAVE_GFC_REAL_16
 841 extern void internal_unpack_r16 (gfc_array_r16 *, const GFC_REAL_16 *);
 842 internal_proto(internal_unpack_r16);
 843 #endif
 844
 845 extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *);
 846 internal_proto(internal_unpack_c4);
 847
 848 extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *);
 849 internal_proto(internal_unpack_c8);
 850
 851 #if defined HAVE_GFC_COMPLEX_10
 852 extern void internal_unpack_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *);
 853 internal_proto(internal_unpack_c10);
 854 #endif
 855
 856 #if defined HAVE_GFC_COMPLEX_16
 857 extern void internal_unpack_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *);
 858 internal_proto(internal_unpack_c16);
 859 #endif
 860
 861 /* Internal auxiliary functions for the pack intrinsic.  */
 862
 863 extern void pack_i1 (gfc_array_i1 *, const gfc_array_i1 *,
 864                      const gfc_array_l1 *, const gfc_array_i1 *);
 865 internal_proto(pack_i1);
 866
 867 extern void pack_i2 (gfc_array_i2 *, const gfc_array_i2 *,
 868                      const gfc_array_l1 *, const gfc_array_i2 *);
 869 internal_proto(pack_i2);
 870
 871 extern void pack_i4 (gfc_array_i4 *, const gfc_array_i4 *,
 872                      const gfc_array_l1 *, const gfc_array_i4 *);
 873 internal_proto(pack_i4);
 874
 875 extern void pack_i8 (gfc_array_i8 *, const gfc_array_i8 *,
 876                      const gfc_array_l1 *, const gfc_array_i8 *);
 877 internal_proto(pack_i8);
 878
 879 #ifdef HAVE_GFC_INTEGER_16
 880 extern void pack_i16 (gfc_array_i16 *, const gfc_array_i16 *,
 881                      const gfc_array_l1 *, const gfc_array_i16 *);
 882 internal_proto(pack_i16);
 883 #endif
 884
 885 extern void pack_r4 (gfc_array_r4 *, const gfc_array_r4 *,
 886                      const gfc_array_l1 *, const gfc_array_r4 *);
 887 internal_proto(pack_r4);
 888
 889 extern void pack_r8 (gfc_array_r8 *, const gfc_array_r8 *,
 890                      const gfc_array_l1 *, const gfc_array_r8 *);
 891 internal_proto(pack_r8);
 892
 893 #ifdef HAVE_GFC_REAL_10
 894 extern void pack_r10 (gfc_array_r10 *, const gfc_array_r10 *,
 895                      const gfc_array_l1 *, const gfc_array_r10 *);
 896 internal_proto(pack_r10);
 897 #endif
 898
 899 #ifdef HAVE_GFC_REAL_16
 900 extern void pack_r16 (gfc_array_r16 *, const gfc_array_r16 *,
 901                      const gfc_array_l1 *, const gfc_array_r16 *);
 902 internal_proto(pack_r16);
 903 #endif
 904
 905 extern void pack_c4 (gfc_array_c4 *, const gfc_array_c4 *,
 906                      const gfc_array_l1 *, const gfc_array_c4 *);
 907 internal_proto(pack_c4);
 908
 909 extern void pack_c8 (gfc_array_c8 *, const gfc_array_c8 *,
 910                      const gfc_array_l1 *, const gfc_array_c8 *);
 911 internal_proto(pack_c8);
 912
 913 #ifdef HAVE_GFC_REAL_10
 914 extern void pack_c10 (gfc_array_c10 *, const gfc_array_c10 *,
 915                      const gfc_array_l1 *, const gfc_array_c10 *);
 916 internal_proto(pack_c10);
 917 #endif
 918
 919 #ifdef HAVE_GFC_REAL_16
 920 extern void pack_c16 (gfc_array_c16 *, const gfc_array_c16 *,
 921                      const gfc_array_l1 *, const gfc_array_c16 *);
 922 internal_proto(pack_c16);
 923 #endif
 924
 925 /* Internal auxiliary functions for the unpack intrinsic.  */
 926
 927 extern void unpack0_i1 (gfc_array_i1 *, const gfc_array_i1 *,
 928                         const gfc_array_l1 *, const GFC_INTEGER_1 *);
 929 internal_proto(unpack0_i1);
 930
 931 extern void unpack0_i2 (gfc_array_i2 *, const gfc_array_i2 *,
 932                         const gfc_array_l1 *, const GFC_INTEGER_2 *);
 933 internal_proto(unpack0_i2);
 934
 935 extern void unpack0_i4 (gfc_array_i4 *, const gfc_array_i4 *,
 936                         const gfc_array_l1 *, const GFC_INTEGER_4 *);
 937 internal_proto(unpack0_i4);
 938
 939 extern void unpack0_i8 (gfc_array_i8 *, const gfc_array_i8 *,
 940                         const gfc_array_l1 *, const GFC_INTEGER_8 *);
 941 internal_proto(unpack0_i8);
 942
 943 #ifdef HAVE_GFC_INTEGER_16
 944
 945 extern void unpack0_i16 (gfc_array_i16 *, const gfc_array_i16 *,
 946                          const gfc_array_l1 *, const GFC_INTEGER_16 *);
 947 internal_proto(unpack0_i16);
 948
 949 #endif
 950
 951 extern void unpack0_r4 (gfc_array_r4 *, const gfc_array_r4 *,
 952                         const gfc_array_l1 *, const GFC_REAL_4 *);
 953 internal_proto(unpack0_r4);
 954
 955 extern void unpack0_r8 (gfc_array_r8 *, const gfc_array_r8 *,
 956                         const gfc_array_l1 *, const GFC_REAL_8 *);
 957 internal_proto(unpack0_r8);
 958
 959 #ifdef HAVE_GFC_REAL_10
 960
 961 extern void unpack0_r10 (gfc_array_r10 *, const gfc_array_r10 *,
 962                          const gfc_array_l1 *, const GFC_REAL_10 *);
 963 internal_proto(unpack0_r10);
 964
 965 #endif
 966
 967 #ifdef HAVE_GFC_REAL_16
 968
 969 extern void unpack0_r16 (gfc_array_r16 *, const gfc_array_r16 *,
 970                          const gfc_array_l1 *, const GFC_REAL_16 *);
 971 internal_proto(unpack0_r16);
 972
 973 #endif
 974
 975 extern void unpack0_c4 (gfc_array_c4 *, const gfc_array_c4 *,
 976                         const gfc_array_l1 *, const GFC_COMPLEX_4 *);
 977 internal_proto(unpack0_c4);
 978
 979 extern void unpack0_c8 (gfc_array_c8 *, const gfc_array_c8 *,
 980                         const gfc_array_l1 *, const GFC_COMPLEX_8 *);
 981 internal_proto(unpack0_c8);
 982
 983 #ifdef HAVE_GFC_COMPLEX_10
 984
 985 extern void unpack0_c10 (gfc_array_c10 *, const gfc_array_c10 *,
 986                          const gfc_array_l1 *mask, const GFC_COMPLEX_10 *);
 987 internal_proto(unpack0_c10);
 988
 989 #endif
 990
 991 #ifdef HAVE_GFC_COMPLEX_16
 992
 993 extern void unpack0_c16 (gfc_array_c16 *, const gfc_array_c16 *,
 994                          const gfc_array_l1 *, const GFC_COMPLEX_16 *);
 995 internal_proto(unpack0_c16);
 996
 997 #endif
 998
 999 extern void unpack1_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1000                         const gfc_array_l1 *, const gfc_array_i1 *);
1001 internal_proto(unpack1_i1);
1002
1003 extern void unpack1_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1004                         const gfc_array_l1 *, const gfc_array_i2 *);
1005 internal_proto(unpack1_i2);
1006
1007 extern void unpack1_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1008                         const gfc_array_l1 *, const gfc_array_i4 *);
1009 internal_proto(unpack1_i4);
1010
1011 extern void unpack1_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1012                         const gfc_array_l1 *, const gfc_array_i8 *);
1013 internal_proto(unpack1_i8);
1014
1015 #ifdef HAVE_GFC_INTEGER_16
1016 extern void unpack1_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1017                          const gfc_array_l1 *, const gfc_array_i16 *);
1018 internal_proto(unpack1_i16);
1019 #endif
1020
1021 extern void unpack1_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1022                         const gfc_array_l1 *, const gfc_array_r4 *);
1023 internal_proto(unpack1_r4);
1024
1025 extern void unpack1_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1026                         const gfc_array_l1 *, const gfc_array_r8 *);
1027 internal_proto(unpack1_r8);
1028
1029 #ifdef HAVE_GFC_REAL_10
1030 extern void unpack1_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1031                          const gfc_array_l1 *, const gfc_array_r10 *);
1032 internal_proto(unpack1_r10);
1033 #endif
1034
1035 #ifdef HAVE_GFC_REAL_16
1036 extern void unpack1_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1037                          const gfc_array_l1 *, const gfc_array_r16 *);
1038 internal_proto(unpack1_r16);
1039 #endif
1040
1041 extern void unpack1_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1042                         const gfc_array_l1 *, const gfc_array_c4 *);
1043 internal_proto(unpack1_c4);
1044
1045 extern void unpack1_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1046                         const gfc_array_l1 *, const gfc_array_c8 *);
1047 internal_proto(unpack1_c8);
1048
1049 #ifdef HAVE_GFC_COMPLEX_10
1050 extern void unpack1_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1051                          const gfc_array_l1 *, const gfc_array_c10 *);
1052 internal_proto(unpack1_c10);
1053 #endif
1054
1055 #ifdef HAVE_GFC_COMPLEX_16
1056 extern void unpack1_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1057                          const gfc_array_l1 *, const gfc_array_c16 *);
1058 internal_proto(unpack1_c16);
1059 #endif
1060
1061 /* Helper functions for spread.  */
1062
1063 extern void spread_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1064                        const index_type, const index_type);
1065 internal_proto(spread_i1);
1066
1067 extern void spread_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1068                        const index_type, const index_type);
1069 internal_proto(spread_i2);
1070
1071 extern void spread_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1072                        const index_type, const index_type);
1073 internal_proto(spread_i4);
1074
1075 extern void spread_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1076                        const index_type, const index_type);
1077 internal_proto(spread_i8);
1078
1079 #ifdef HAVE_GFC_INTEGER_16
1080 extern void spread_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1081                        const index_type, const index_type);
1082 internal_proto(spread_i16);
1083
1084 #endif
1085
1086 extern void spread_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1087                        const index_type, const index_type);
1088 internal_proto(spread_r4);
1089
1090 extern void spread_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1091                        const index_type, const index_type);
1092 internal_proto(spread_r8);
1093
1094 #ifdef HAVE_GFC_REAL_10
1095 extern void spread_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1096                        const index_type, const index_type);
1097 internal_proto(spread_r10);
1098
1099 #endif
1100
1101 #ifdef HAVE_GFC_REAL_16
1102 extern void spread_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1103                        const index_type, const index_type);
1104 internal_proto(spread_r16);
1105
1106 #endif
1107
1108 extern void spread_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1109                        const index_type, const index_type);
1110 internal_proto(spread_c4);
1111
1112 extern void spread_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1113                        const index_type, const index_type);
1114 internal_proto(spread_c8);
1115
1116 #ifdef HAVE_GFC_COMPLEX_10
1117 extern void spread_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1118                        const index_type, const index_type);
1119 internal_proto(spread_c10);
1120
1121 #endif
1122
1123 #ifdef HAVE_GFC_COMPLEX_16
1124 extern void spread_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1125                        const index_type, const index_type);
1126 internal_proto(spread_c16);
1127
1128 #endif
1129
1130 extern void spread_scalar_i1 (gfc_array_i1 *, const GFC_INTEGER_1 *,
1131                               const index_type, const index_type);
1132 internal_proto(spread_scalar_i1);
1133
1134 extern void spread_scalar_i2 (gfc_array_i2 *, const GFC_INTEGER_2 *,
1135                               const index_type, const index_type);
1136 internal_proto(spread_scalar_i2);
1137
1138 extern void spread_scalar_i4 (gfc_array_i4 *, const GFC_INTEGER_4 *,
1139                               const index_type, const index_type);
1140 internal_proto(spread_scalar_i4);
1141
1142 extern void spread_scalar_i8 (gfc_array_i8 *, const GFC_INTEGER_8 *,
1143                               const index_type, const index_type);
1144 internal_proto(spread_scalar_i8);
1145
1146 #ifdef HAVE_GFC_INTEGER_16
1147 extern void spread_scalar_i16 (gfc_array_i16 *, const GFC_INTEGER_16 *,
1148                                const index_type, const index_type);
1149 internal_proto(spread_scalar_i16);
1150
1151 #endif
1152
1153 extern void spread_scalar_r4 (gfc_array_r4 *, const GFC_REAL_4 *,
1154                               const index_type, const index_type);
1155 internal_proto(spread_scalar_r4);
1156
1157 extern void spread_scalar_r8 (gfc_array_r8 *, const GFC_REAL_8 *,
1158                               const index_type, const index_type);
1159 internal_proto(spread_scalar_r8);
1160
1161 #ifdef HAVE_GFC_REAL_10
1162 extern void spread_scalar_r10 (gfc_array_r10 *, const GFC_REAL_10 *,
1163                                const index_type, const index_type);
1164 internal_proto(spread_scalar_r10);
1165
1166 #endif
1167
1168 #ifdef HAVE_GFC_REAL_16
1169 extern void spread_scalar_r16 (gfc_array_r16 *, const GFC_REAL_16 *,
1170                                const index_type, const index_type);
1171 internal_proto(spread_scalar_r16);
1172
1173 #endif
1174
1175 extern void spread_scalar_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *,
1176                               const index_type, const index_type);
1177 internal_proto(spread_scalar_c4);
1178
1179 extern void spread_scalar_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *,
1180                               const index_type, const index_type);
1181 internal_proto(spread_scalar_c8);
1182
1183 #ifdef HAVE_GFC_COMPLEX_10
1184 extern void spread_scalar_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *,
1185                                const index_type, const index_type);
1186 internal_proto(spread_scalar_c10);
1187
1188 #endif
1189
1190 #ifdef HAVE_GFC_COMPLEX_16
1191 extern void spread_scalar_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *,
1192                                const index_type, const index_type);
1193 internal_proto(spread_scalar_c16);
1194
1195 #endif
1196
1197 /* string_intrinsics.c */
1198
1199 extern int compare_string (gfc_charlen_type, const char *,
1200                            gfc_charlen_type, const char *);
1201 iexport_proto(compare_string);
1202
1203 extern int compare_string_char4 (gfc_charlen_type, const gfc_char4_t *,
1204                                  gfc_charlen_type, const gfc_char4_t *);
1205 iexport_proto(compare_string_char4);
1206
1207 /* random.c */
1208
1209 extern void random_seed_i4 (GFC_INTEGER_4 * size, gfc_array_i4 * put,
1210                             gfc_array_i4 * get);
1211 iexport_proto(random_seed_i4);
1212 extern void random_seed_i8 (GFC_INTEGER_8 * size, gfc_array_i8 * put,
1213                             gfc_array_i8 * get);
1214 iexport_proto(random_seed_i8);
1215
1216 /* size.c */
1217
1218 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) array_t;
1219
1220 extern index_type size0 (const array_t * array);
1221 iexport_proto(size0);
1222
1223 /* Internal auxiliary functions for cshift */
1224
1225 void cshift0_i1 (gfc_array_i1 *, const gfc_array_i1 *, ssize_t, int);
1226 internal_proto(cshift0_i1);
1227
1228 void cshift0_i2 (gfc_array_i2 *, const gfc_array_i2 *, ssize_t, int);
1229 internal_proto(cshift0_i2);
1230
1231 void cshift0_i4 (gfc_array_i4 *, const gfc_array_i4 *, ssize_t, int);
1232 internal_proto(cshift0_i4);
1233
1234 void cshift0_i8 (gfc_array_i8 *, const gfc_array_i8 *, ssize_t, int);
1235 internal_proto(cshift0_i8);
1236
1237 #ifdef HAVE_GFC_INTEGER_16
1238 void cshift0_i16 (gfc_array_i16 *, const gfc_array_i16 *, ssize_t, int);
1239 internal_proto(cshift0_i16);
1240 #endif
1241
1242 void cshift0_r4 (gfc_array_r4 *, const gfc_array_r4 *, ssize_t, int);
1243 internal_proto(cshift0_r4);
1244
1245 void cshift0_r8 (gfc_array_r8 *, const gfc_array_r8 *, ssize_t, int);
1246 internal_proto(cshift0_r8);
1247
1248 #ifdef HAVE_GFC_REAL_10
1249 void cshift0_r10 (gfc_array_r10 *, const gfc_array_r10 *, ssize_t, int);
1250 internal_proto(cshift0_r10);
1251 #endif
1252
1253 #ifdef HAVE_GFC_REAL_16
1254 void cshift0_r16 (gfc_array_r16 *, const gfc_array_r16 *, ssize_t, int);
1255 internal_proto(cshift0_r16);
1256 #endif
1257
1258 void cshift0_c4 (gfc_array_c4 *, const gfc_array_c4 *, ssize_t, int);
1259 internal_proto(cshift0_c4);
1260
1261 void cshift0_c8 (gfc_array_c8 *, const gfc_array_c8 *, ssize_t, int);
1262 internal_proto(cshift0_c8);
1263
1264 #ifdef HAVE_GFC_COMPLEX_10
1265 void cshift0_c10 (gfc_array_c10 *, const gfc_array_c10 *, ssize_t, int);
1266 internal_proto(cshift0_c10);
1267 #endif
1268
1269 #ifdef HAVE_GFC_COMPLEX_16
1270 void cshift0_c16 (gfc_array_c16 *, const gfc_array_c16 *, ssize_t, int);
1271 internal_proto(cshift0_c16);
1272 #endif
1273
1274 #endif  /* LIBGFOR_H  */