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