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