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