]> 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
2009-05-31 Jerry DeLisle <jvdelisle@gcc.gnu.org>
[thirdparty/gcc.git] / libgfortran / libgfortran.h
CommitLineData
56c15991 1/* Common declarations for all of libgfortran.
e2b80761 2 Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
84d33b91 3 Free Software Foundation, Inc.
4ee9c684 4 Contributed by Paul Brook <paul@nowt.org>, and
5 Andy Vaught <andy@xena.eas.asu.edu>
6
b417ea8c 7This file is part of the GNU Fortran 95 runtime library (libgfortran).
4ee9c684 8
6bc9506f 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.
4ee9c684 13
b417ea8c 14Libgfortran is distributed in the hope that it will be useful,
4ee9c684 15but WITHOUT ANY WARRANTY; without even the implied warranty of
16MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6bc9506f 17GNU General Public License for more details.
4ee9c684 18
6bc9506f 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.
b417ea8c 22
6bc9506f 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/>. */
4ee9c684 27
28#ifndef LIBGFOR_H
29#define LIBGFOR_H
30
52a2cc79 31/* config.h MUST be first because it can affect system headers. */
32#include "config.h"
33
5a037dbd 34#include <stdio.h>
4ee9c684 35#include <math.h>
36#include <stddef.h>
0ee93d57 37#include <float.h>
d17a1468 38#include <stdarg.h>
4ee9c684 39
4ee9c684 40#if HAVE_COMPLEX_H
41# include <complex.h>
42#else
43#define complex __complex__
44#endif
45
18f0b7df 46#include "../gcc/fortran/libgfortran.h"
47
d213114b 48#include "c99_protos.h"
49
334f03a1 50#if HAVE_IEEEFP_H
51#include <ieeefp.h>
52#endif
53
56c15991 54#include "gstdint.h"
c436f700 55
4ee9c684 56#if HAVE_SYS_TYPES_H
57#include <sys/types.h>
58#endif
b093181d 59typedef off_t gfc_offset;
4ee9c684 60
61#ifndef NULL
62#define NULL (void *) 0
63#endif
64
65#ifndef __GNUC__
66#define __attribute__(x)
c7fb575f 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)
4ee9c684 72#endif
73
76c0a846 74
ed3634f6 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
3b99ec70 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
c7fb575f 111extern int __mingw_snprintf (char *, size_t, const char *, ...)
802c1d15 112 __attribute__ ((format (gnu_printf, 3, 4)));
3b99ec70 113#undef snprintf
114#define snprintf __mingw_snprintf
115#endif
116
117
7b6cb5bd 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)
888d4c42 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)))
7b6cb5bd 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
4ee9c684 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
fd48ced8 204/* The isfinite macro is only available with C99, but some non-C99
205 systems still provide fpclassify, and there is a `finite' function
b1c49a11 206 in BSD.
207
208 Also, isfinite is broken on Cygwin.
209
210 When isfinite is not available, try to use one of the
fd48ced8 211 alternatives, or bail out. */
839904a0 212
213#if defined(HAVE_BROKEN_ISFINITE) || defined(__CYGWIN__)
b1c49a11 214#undef isfinite
839904a0 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
c14474b7 229#define isfinite(x) (fpclassify(x) != FP_NAN && fpclassify(x) != FP_INFINITE)
839904a0 230#endif /* !defined(fpclassify) */
231#endif /* !defined(isfinite) */
232
233#if !defined(isnan)
234#if !defined(fpclassify)
235#define isnan(x) ((x) != (x))
fd48ced8 236#else
839904a0 237#define isnan(x) (fpclassify(x) == FP_NAN)
238#endif /* !defined(fpclassify) */
fd48ced8 239#endif /* !defined(isfinite) */
240
4ee9c684 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
14c3c235 246#include "kinds.h"
4ee9c684 247
2185ae8c 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
4d8ee55b 251typedef GFC_INTEGER_8 GFC_IO_INT;
2185ae8c 252#else
253#ifdef HAVE_GFC_INTEGER_4
4d8ee55b 254typedef GFC_INTEGER_4 GFC_IO_INT;
2185ae8c 255#else
256#error "GFC_INTEGER_4 should be available for the library to compile".
257#endif
258#endif
259
b496d698 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. */
077620f0 263typedef ssize_t index_type;
9267538e 264
9ad09405 265/* The type used for the lengths of character variables. */
266typedef GFC_INTEGER_4 gfc_charlen_type;
4ee9c684 267
9267538e 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
4ee9c684 277/* This will be 0 on little-endian machines and one on big-endian machines. */
1316e8f0 278extern int big_endian;
279internal_proto(big_endian);
4ee9c684 280
7ed8f627 281#define GFOR_POINTER_TO_L1(p, kind) \
1316e8f0 282 (big_endian * (kind - 1) + (GFC_LOGICAL_1 *)(p))
4ee9c684 283
dd765455 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)
4ee9c684 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)
920e54ef 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
4ee9c684 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;\
93830de1 309 size_t offset;\
4ee9c684 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;
dd765455 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;
4ee9c684 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;
920e54ef 321#ifdef HAVE_GFC_INTEGER_16
322typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_16) gfc_array_i16;
323#endif
4ee9c684 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;
920e54ef 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
4ee9c684 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;
920e54ef 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
7ed8f627 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;
4ee9c684 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;
920e54ef 344#ifdef HAVE_GFC_LOGICAL_16
345typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
346#endif
4ee9c684 347
4ee9c684 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
b74d1e69 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
ed3634f6 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
95f15c5b 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
4ee9c684 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{
ff81ee3b 456 int stdin_unit, stdout_unit, stderr_unit, optional_plus;
4ee9c684 457 int locus;
458
459 int separator_len;
460 const char *separator;
461
3e45a719 462 int use_stderr, all_unbuffered, unbuffered_preconnected, default_recl;
ed825f1d 463 int fpe, dump_core, backtrace;
4ee9c684 464}
465options_t;
466
4ee9c684 467extern options_t options;
7b6cb5bd 468internal_proto(options);
4ee9c684 469
c7987dcf 470extern void handler (int);
471internal_proto(handler);
472
4ee9c684 473
64fc3c4c 474/* Compile-time options that will influence the library. */
475
476typedef struct
477{
478 int warn_std;
479 int allow_std;
7833ddd7 480 int pedantic;
15774a8b 481 int convert;
b7fcd3f9 482 int dump_core;
99798ba4 483 int backtrace;
d4862c77 484 int sign_zero;
f23886ab 485 size_t record_marker;
bbaaa7b1 486 int max_subrecord_length;
7e5f0027 487 int bounds_check;
6cbaf559 488 int range_check;
64fc3c4c 489}
490compile_options_t;
491
492extern compile_options_t compile_options;
493internal_proto(compile_options);
494
da6b28c3 495extern void init_compile_options (void);
496internal_proto(init_compile_options);
64fc3c4c 497
bbaaa7b1 498#define GFC_MAX_SUBRECORD_LENGTH 2147483639 /* 2**31 - 9 */
64fc3c4c 499
4ee9c684 500/* Structure for statement options. */
501
502typedef struct
503{
504 const char *name;
505 int value;
506}
507st_option;
508
64fc3c4c 509
158f58e7 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
02183b45 517/* This is returned by notify_std and several io functions. */
518typedef enum
519{ SUCCESS = 1, FAILURE }
520try;
521
4ee9c684 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
7b6cb5bd 525/* Location of the current library call (optional). */
526extern unsigned line;
527iexport_data_proto(line);
4ee9c684 528
4ee9c684 529extern char *filename;
7b6cb5bd 530iexport_data_proto(filename);
4ee9c684 531
2b573e69 532/* Avoid conflicting prototypes of alloca() in system headers by using
533 GCC's builtin alloca(). */
2b573e69 534#define gfc_alloca(x) __builtin_alloca(x)
535
4ee9c684 536
18f0b7df 537/* Directory for creating temporary files. Only used when none of the
538 following environment variables exist: GFORTRAN_TMPDIR, TMP and TEMP. */
76c0a846 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
76c0a846 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)
84d33b91 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)
76c0a846 593
13f02ebc 594/* library start function and end macro. These can be expanded if needed
595 in the future. cmp is st_parameter_common *cmp */
76875ccb 596
76c0a846 597extern void library_start (st_parameter_common *);
7b6cb5bd 598internal_proto(library_start);
4ee9c684 599
60c514ba 600#define library_end()
4ee9c684 601
13f02ebc 602/* main.c */
603
604extern void stupid_function_name_for_static_linking (void);
605internal_proto(stupid_function_name_for_static_linking);
606
7b6cb5bd 607extern void set_args (int, char **);
608export_proto(set_args);
4ee9c684 609
7b6cb5bd 610extern void get_args (int *, char ***);
611internal_proto(get_args);
4ee9c684 612
82a6565e 613extern void store_exe_path (const char *);
614export_proto(store_exe_path);
615
99798ba4 616extern char * full_exe_path (void);
617internal_proto(full_exe_path);
618
619/* backtrace.c */
620
621extern void show_backtrace (void);
622internal_proto(show_backtrace);
623
4ee9c684 624/* error.c */
4ee9c684 625
556d0269 626#define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 2)
627#define GFC_XTOA_BUF_SIZE (sizeof (GFC_UINTEGER_LARGEST) * 2 + 1)
628#define GFC_OTOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 1)
629#define GFC_BTOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 8 + 1)
630
b7fcd3f9 631extern void sys_exit (int) __attribute__ ((noreturn));
632internal_proto(sys_exit);
633
e2b80761 634extern const char *gfc_xtoa (GFC_UINTEGER_LARGEST, char *, size_t);
635internal_proto(gfc_xtoa);
4ee9c684 636
7b6cb5bd 637extern void os_error (const char *) __attribute__ ((noreturn));
9915365e 638iexport_proto(os_error);
4ee9c684 639
76c0a846 640extern void show_locus (st_parameter_common *);
7b6cb5bd 641internal_proto(show_locus);
4ee9c684 642
5a037dbd 643extern void runtime_error (const char *, ...)
644 __attribute__ ((noreturn, format (printf, 1, 2)));
7b6cb5bd 645iexport_proto(runtime_error);
4ee9c684 646
399aecc1 647extern void runtime_error_at (const char *, const char *, ...)
648 __attribute__ ((noreturn, format (printf, 2, 3)));
13f02ebc 649iexport_proto(runtime_error_at);
650
c7fb575f 651extern void runtime_warning_at (const char *, const char *, ...)
652 __attribute__ ((format (printf, 2, 3)));
da6ffc6d 653iexport_proto(runtime_warning_at);
654
76c0a846 655extern void internal_error (st_parameter_common *, const char *)
60c514ba 656 __attribute__ ((noreturn));
7b6cb5bd 657internal_proto(internal_error);
4ee9c684 658
7b6cb5bd 659extern const char *get_oserror (void);
660internal_proto(get_oserror);
4ee9c684 661
7b6cb5bd 662extern const char *translate_error (int);
663internal_proto(translate_error);
4ee9c684 664
76c0a846 665extern void generate_error (st_parameter_common *, int, const char *);
13f02ebc 666iexport_proto(generate_error);
4ee9c684 667
76c0a846 668extern try notify_std (st_parameter_common *, int, const char *);
02183b45 669internal_proto(notify_std);
670
76c0a846 671extern notification notification_std(int);
672internal_proto(notification_std);
673
8c84a5de 674/* fpu.c */
675
676extern void set_fpu (void);
677internal_proto(set_fpu);
678
4ee9c684 679/* memory.c */
680
7b6cb5bd 681extern void *get_mem (size_t) __attribute__ ((malloc));
682internal_proto(get_mem);
4ee9c684 683
7b6cb5bd 684extern void free_mem (void *);
685internal_proto(free_mem);
4ee9c684 686
f66be06b 687extern void *internal_malloc_size (size_t) __attribute__ ((malloc));
7b6cb5bd 688internal_proto(internal_malloc_size);
4ee9c684 689
4ee9c684 690/* environ.c */
691
7b6cb5bd 692extern int check_buffered (int);
693internal_proto(check_buffered);
4ee9c684 694
7b6cb5bd 695extern void init_variables (void);
696internal_proto(init_variables);
4ee9c684 697
7b6cb5bd 698extern void show_variables (void);
699internal_proto(show_variables);
4ee9c684 700
76c0a846 701unit_convert get_unformatted_convert (int);
702internal_proto(get_unformatted_convert);
703
4ee9c684 704/* string.c */
705
a9b0b7c8 706extern int find_option (st_parameter_common *, const char *, gfc_charlen_type,
60c514ba 707 const st_option *, const char *);
7b6cb5bd 708internal_proto(find_option);
4ee9c684 709
a9b0b7c8 710extern gfc_charlen_type fstrlen (const char *, gfc_charlen_type);
7b6cb5bd 711internal_proto(fstrlen);
4ee9c684 712
a9b0b7c8 713extern gfc_charlen_type fstrcpy (char *, gfc_charlen_type, const char *, gfc_charlen_type);
7b6cb5bd 714internal_proto(fstrcpy);
4ee9c684 715
a9b0b7c8 716extern gfc_charlen_type cf_strcpy (char *, gfc_charlen_type, const char *);
7b6cb5bd 717internal_proto(cf_strcpy);
4ee9c684 718
b03ffb00 719/* io/intrinsics.c */
720
721extern void flush_all_units (void);
722internal_proto(flush_all_units);
723
4ee9c684 724/* io.c */
725
7b6cb5bd 726extern void init_units (void);
727internal_proto(init_units);
4ee9c684 728
7b6cb5bd 729extern void close_units (void);
730internal_proto(close_units);
4ee9c684 731
e4f69ae3 732extern int unit_to_fd (int);
733internal_proto(unit_to_fd);
734
76c0a846 735extern int st_printf (const char *, ...)
736 __attribute__ ((format (printf, 1, 2)));
737internal_proto(st_printf);
738
5a037dbd 739extern int st_vprintf (const char *, va_list);
740internal_proto(st_vprintf);
741
f7f911de 742extern char * filename_from_unit (int);
743internal_proto(filename_from_unit);
744
4ee9c684 745/* stop.c */
7b6cb5bd 746
3a12a488 747extern void stop_numeric (GFC_INTEGER_4) __attribute__ ((noreturn));
7b6cb5bd 748iexport_proto(stop_numeric);
4ee9c684 749
750/* reshape_packed.c */
4ee9c684 751
7b6cb5bd 752extern void reshape_packed (char *, index_type, const char *, index_type,
753 const char *, index_type);
754internal_proto(reshape_packed);
4ee9c684 755
98380129 756/* Repacking functions. These are called internally by internal_pack
757 and internal_unpack. */
758
759GFC_INTEGER_1 *internal_pack_1 (gfc_array_i1 *);
760internal_proto(internal_pack_1);
761
762GFC_INTEGER_2 *internal_pack_2 (gfc_array_i2 *);
763internal_proto(internal_pack_2);
4ee9c684 764
4ee9c684 765GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *);
7b6cb5bd 766internal_proto(internal_pack_4);
4ee9c684 767
4ee9c684 768GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *);
7b6cb5bd 769internal_proto(internal_pack_8);
4ee9c684 770
cdc35053 771#if defined HAVE_GFC_INTEGER_16
e23ab77f 772GFC_INTEGER_16 *internal_pack_16 (gfc_array_i16 *);
773internal_proto(internal_pack_16);
cdc35053 774#endif
e23ab77f 775
98380129 776GFC_REAL_4 *internal_pack_r4 (gfc_array_r4 *);
777internal_proto(internal_pack_r4);
778
779GFC_REAL_8 *internal_pack_r8 (gfc_array_r8 *);
780internal_proto(internal_pack_r8);
781
782#if defined HAVE_GFC_REAL_10
783GFC_REAL_10 *internal_pack_r10 (gfc_array_r10 *);
784internal_proto(internal_pack_r10);
785#endif
786
787#if defined HAVE_GFC_REAL_16
788GFC_REAL_16 *internal_pack_r16 (gfc_array_r16 *);
789internal_proto(internal_pack_r16);
790#endif
791
f27ef643 792GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *);
793internal_proto(internal_pack_c4);
794
795GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *);
796internal_proto(internal_pack_c8);
797
cdc35053 798#if defined HAVE_GFC_COMPLEX_10
e23ab77f 799GFC_COMPLEX_10 *internal_pack_c10 (gfc_array_c10 *);
800internal_proto(internal_pack_c10);
cdc35053 801#endif
e23ab77f 802
98380129 803#if defined HAVE_GFC_COMPLEX_16
804GFC_COMPLEX_16 *internal_pack_c16 (gfc_array_c16 *);
805internal_proto(internal_pack_c16);
806#endif
807
808extern void internal_unpack_1 (gfc_array_i1 *, const GFC_INTEGER_1 *);
809internal_proto(internal_unpack_1);
810
811extern void internal_unpack_2 (gfc_array_i2 *, const GFC_INTEGER_2 *);
812internal_proto(internal_unpack_2);
813
7b6cb5bd 814extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *);
815internal_proto(internal_unpack_4);
4ee9c684 816
7b6cb5bd 817extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *);
818internal_proto(internal_unpack_8);
8db86b90 819
cdc35053 820#if defined HAVE_GFC_INTEGER_16
e23ab77f 821extern void internal_unpack_16 (gfc_array_i16 *, const GFC_INTEGER_16 *);
822internal_proto(internal_unpack_16);
cdc35053 823#endif
e23ab77f 824
98380129 825extern void internal_unpack_r4 (gfc_array_r4 *, const GFC_REAL_4 *);
826internal_proto(internal_unpack_r4);
827
828extern void internal_unpack_r8 (gfc_array_r8 *, const GFC_REAL_8 *);
829internal_proto(internal_unpack_r8);
830
831#if defined HAVE_GFC_REAL_10
832extern void internal_unpack_r10 (gfc_array_r10 *, const GFC_REAL_10 *);
833internal_proto(internal_unpack_r10);
834#endif
835
836#if defined HAVE_GFC_REAL_16
837extern void internal_unpack_r16 (gfc_array_r16 *, const GFC_REAL_16 *);
838internal_proto(internal_unpack_r16);
839#endif
840
f27ef643 841extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *);
842internal_proto(internal_unpack_c4);
843
844extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *);
845internal_proto(internal_unpack_c8);
846
cdc35053 847#if defined HAVE_GFC_COMPLEX_10
e23ab77f 848extern void internal_unpack_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *);
849internal_proto(internal_unpack_c10);
cdc35053 850#endif
e23ab77f 851
b362cebe 852#if defined HAVE_GFC_COMPLEX_16
853extern void internal_unpack_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *);
854internal_proto(internal_unpack_c16);
855#endif
856
0c279ba7 857/* Internal auxiliary functions for the pack intrinsic. */
858
859extern void pack_i1 (gfc_array_i1 *, const gfc_array_i1 *,
860 const gfc_array_l1 *, const gfc_array_i1 *);
861internal_proto(pack_i1);
862
863extern void pack_i2 (gfc_array_i2 *, const gfc_array_i2 *,
864 const gfc_array_l1 *, const gfc_array_i2 *);
865internal_proto(pack_i2);
866
867extern void pack_i4 (gfc_array_i4 *, const gfc_array_i4 *,
868 const gfc_array_l1 *, const gfc_array_i4 *);
869internal_proto(pack_i4);
870
871extern void pack_i8 (gfc_array_i8 *, const gfc_array_i8 *,
872 const gfc_array_l1 *, const gfc_array_i8 *);
873internal_proto(pack_i8);
874
875#ifdef HAVE_GFC_INTEGER_16
876extern void pack_i16 (gfc_array_i16 *, const gfc_array_i16 *,
877 const gfc_array_l1 *, const gfc_array_i16 *);
878internal_proto(pack_i16);
879#endif
880
881extern void pack_r4 (gfc_array_r4 *, const gfc_array_r4 *,
882 const gfc_array_l1 *, const gfc_array_r4 *);
883internal_proto(pack_r4);
884
885extern void pack_r8 (gfc_array_r8 *, const gfc_array_r8 *,
886 const gfc_array_l1 *, const gfc_array_r8 *);
887internal_proto(pack_r8);
888
889#ifdef HAVE_GFC_REAL_10
890extern void pack_r10 (gfc_array_r10 *, const gfc_array_r10 *,
891 const gfc_array_l1 *, const gfc_array_r10 *);
892internal_proto(pack_r10);
893#endif
894
895#ifdef HAVE_GFC_REAL_16
896extern void pack_r16 (gfc_array_r16 *, const gfc_array_r16 *,
897 const gfc_array_l1 *, const gfc_array_r16 *);
898internal_proto(pack_r16);
899#endif
900
901extern void pack_c4 (gfc_array_c4 *, const gfc_array_c4 *,
902 const gfc_array_l1 *, const gfc_array_c4 *);
903internal_proto(pack_c4);
904
905extern void pack_c8 (gfc_array_c8 *, const gfc_array_c8 *,
906 const gfc_array_l1 *, const gfc_array_c8 *);
907internal_proto(pack_c8);
908
909#ifdef HAVE_GFC_REAL_10
910extern void pack_c10 (gfc_array_c10 *, const gfc_array_c10 *,
911 const gfc_array_l1 *, const gfc_array_c10 *);
912internal_proto(pack_c10);
913#endif
914
915#ifdef HAVE_GFC_REAL_16
916extern void pack_c16 (gfc_array_c16 *, const gfc_array_c16 *,
917 const gfc_array_l1 *, const gfc_array_c16 *);
918internal_proto(pack_c16);
919#endif
920
d3a07078 921/* Internal auxiliary functions for the unpack intrinsic. */
922
923extern void unpack0_i1 (gfc_array_i1 *, const gfc_array_i1 *,
924 const gfc_array_l1 *, const GFC_INTEGER_1 *);
925internal_proto(unpack0_i1);
926
927extern void unpack0_i2 (gfc_array_i2 *, const gfc_array_i2 *,
928 const gfc_array_l1 *, const GFC_INTEGER_2 *);
929internal_proto(unpack0_i2);
930
931extern void unpack0_i4 (gfc_array_i4 *, const gfc_array_i4 *,
932 const gfc_array_l1 *, const GFC_INTEGER_4 *);
933internal_proto(unpack0_i4);
934
935extern void unpack0_i8 (gfc_array_i8 *, const gfc_array_i8 *,
936 const gfc_array_l1 *, const GFC_INTEGER_8 *);
937internal_proto(unpack0_i8);
938
939#ifdef HAVE_GFC_INTEGER_16
940
941extern void unpack0_i16 (gfc_array_i16 *, const gfc_array_i16 *,
942 const gfc_array_l1 *, const GFC_INTEGER_16 *);
943internal_proto(unpack0_i16);
944
945#endif
946
947extern void unpack0_r4 (gfc_array_r4 *, const gfc_array_r4 *,
948 const gfc_array_l1 *, const GFC_REAL_4 *);
949internal_proto(unpack0_r4);
950
951extern void unpack0_r8 (gfc_array_r8 *, const gfc_array_r8 *,
952 const gfc_array_l1 *, const GFC_REAL_8 *);
953internal_proto(unpack0_r8);
954
955#ifdef HAVE_GFC_REAL_10
956
957extern void unpack0_r10 (gfc_array_r10 *, const gfc_array_r10 *,
958 const gfc_array_l1 *, const GFC_REAL_10 *);
959internal_proto(unpack0_r10);
960
961#endif
962
963#ifdef HAVE_GFC_REAL_16
964
965extern void unpack0_r16 (gfc_array_r16 *, const gfc_array_r16 *,
966 const gfc_array_l1 *, const GFC_REAL_16 *);
967internal_proto(unpack0_r16);
968
969#endif
970
971extern void unpack0_c4 (gfc_array_c4 *, const gfc_array_c4 *,
972 const gfc_array_l1 *, const GFC_COMPLEX_4 *);
973internal_proto(unpack0_c4);
974
975extern void unpack0_c8 (gfc_array_c8 *, const gfc_array_c8 *,
976 const gfc_array_l1 *, const GFC_COMPLEX_8 *);
977internal_proto(unpack0_c8);
978
979#ifdef HAVE_GFC_COMPLEX_10
980
981extern void unpack0_c10 (gfc_array_c10 *, const gfc_array_c10 *,
982 const gfc_array_l1 *mask, const GFC_COMPLEX_10 *);
983internal_proto(unpack0_c10);
984
985#endif
986
987#ifdef HAVE_GFC_COMPLEX_16
988
989extern void unpack0_c16 (gfc_array_c16 *, const gfc_array_c16 *,
990 const gfc_array_l1 *, const GFC_COMPLEX_16 *);
991internal_proto(unpack0_c16);
992
993#endif
994
995extern void unpack1_i1 (gfc_array_i1 *, const gfc_array_i1 *,
996 const gfc_array_l1 *, const gfc_array_i1 *);
997internal_proto(unpack1_i1);
998
999extern void unpack1_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1000 const gfc_array_l1 *, const gfc_array_i2 *);
1001internal_proto(unpack1_i2);
1002
1003extern void unpack1_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1004 const gfc_array_l1 *, const gfc_array_i4 *);
1005internal_proto(unpack1_i4);
1006
1007extern void unpack1_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1008 const gfc_array_l1 *, const gfc_array_i8 *);
1009internal_proto(unpack1_i8);
1010
1011#ifdef HAVE_GFC_INTEGER_16
1012extern void unpack1_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1013 const gfc_array_l1 *, const gfc_array_i16 *);
1014internal_proto(unpack1_i16);
1015#endif
1016
1017extern void unpack1_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1018 const gfc_array_l1 *, const gfc_array_r4 *);
1019internal_proto(unpack1_r4);
1020
1021extern void unpack1_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1022 const gfc_array_l1 *, const gfc_array_r8 *);
1023internal_proto(unpack1_r8);
1024
1025#ifdef HAVE_GFC_REAL_10
1026extern void unpack1_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1027 const gfc_array_l1 *, const gfc_array_r10 *);
1028internal_proto(unpack1_r10);
1029#endif
1030
1031#ifdef HAVE_GFC_REAL_16
1032extern void unpack1_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1033 const gfc_array_l1 *, const gfc_array_r16 *);
1034internal_proto(unpack1_r16);
1035#endif
1036
1037extern void unpack1_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1038 const gfc_array_l1 *, const gfc_array_c4 *);
1039internal_proto(unpack1_c4);
1040
1041extern void unpack1_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1042 const gfc_array_l1 *, const gfc_array_c8 *);
1043internal_proto(unpack1_c8);
1044
1045#ifdef HAVE_GFC_COMPLEX_10
1046extern void unpack1_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1047 const gfc_array_l1 *, const gfc_array_c10 *);
1048internal_proto(unpack1_c10);
1049#endif
1050
1051#ifdef HAVE_GFC_COMPLEX_16
1052extern void unpack1_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1053 const gfc_array_l1 *, const gfc_array_c16 *);
1054internal_proto(unpack1_c16);
1055#endif
1056
b74d1e69 1057/* Helper functions for spread. */
1058
1059extern void spread_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1060 const index_type, const index_type);
1061internal_proto(spread_i1);
1062
1063extern void spread_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1064 const index_type, const index_type);
1065internal_proto(spread_i2);
1066
1067extern void spread_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1068 const index_type, const index_type);
1069internal_proto(spread_i4);
1070
1071extern void spread_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1072 const index_type, const index_type);
1073internal_proto(spread_i8);
1074
1075#ifdef HAVE_GFC_INTEGER_16
1076extern void spread_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1077 const index_type, const index_type);
1078internal_proto(spread_i16);
1079
1080#endif
1081
1082extern void spread_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1083 const index_type, const index_type);
1084internal_proto(spread_r4);
1085
1086extern void spread_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1087 const index_type, const index_type);
1088internal_proto(spread_r8);
1089
1090#ifdef HAVE_GFC_REAL_10
1091extern void spread_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1092 const index_type, const index_type);
1093internal_proto(spread_r10);
1094
1095#endif
1096
1097#ifdef HAVE_GFC_REAL_16
1098extern void spread_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1099 const index_type, const index_type);
1100internal_proto(spread_r16);
1101
1102#endif
1103
1104extern void spread_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1105 const index_type, const index_type);
1106internal_proto(spread_c4);
1107
1108extern void spread_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1109 const index_type, const index_type);
1110internal_proto(spread_c8);
1111
1112#ifdef HAVE_GFC_COMPLEX_10
1113extern void spread_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1114 const index_type, const index_type);
1115internal_proto(spread_c10);
1116
1117#endif
1118
1119#ifdef HAVE_GFC_COMPLEX_16
1120extern void spread_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1121 const index_type, const index_type);
1122internal_proto(spread_c16);
1123
1124#endif
1125
1126extern void spread_scalar_i1 (gfc_array_i1 *, const GFC_INTEGER_1 *,
1127 const index_type, const index_type);
1128internal_proto(spread_scalar_i1);
1129
1130extern void spread_scalar_i2 (gfc_array_i2 *, const GFC_INTEGER_2 *,
1131 const index_type, const index_type);
1132internal_proto(spread_scalar_i2);
1133
1134extern void spread_scalar_i4 (gfc_array_i4 *, const GFC_INTEGER_4 *,
1135 const index_type, const index_type);
1136internal_proto(spread_scalar_i4);
1137
1138extern void spread_scalar_i8 (gfc_array_i8 *, const GFC_INTEGER_8 *,
1139 const index_type, const index_type);
1140internal_proto(spread_scalar_i8);
1141
1142#ifdef HAVE_GFC_INTEGER_16
1143extern void spread_scalar_i16 (gfc_array_i16 *, const GFC_INTEGER_16 *,
1144 const index_type, const index_type);
1145internal_proto(spread_scalar_i16);
1146
1147#endif
1148
1149extern void spread_scalar_r4 (gfc_array_r4 *, const GFC_REAL_4 *,
1150 const index_type, const index_type);
1151internal_proto(spread_scalar_r4);
1152
1153extern void spread_scalar_r8 (gfc_array_r8 *, const GFC_REAL_8 *,
1154 const index_type, const index_type);
1155internal_proto(spread_scalar_r8);
1156
1157#ifdef HAVE_GFC_REAL_10
1158extern void spread_scalar_r10 (gfc_array_r10 *, const GFC_REAL_10 *,
1159 const index_type, const index_type);
1160internal_proto(spread_scalar_r10);
1161
1162#endif
1163
1164#ifdef HAVE_GFC_REAL_16
1165extern void spread_scalar_r16 (gfc_array_r16 *, const GFC_REAL_16 *,
1166 const index_type, const index_type);
1167internal_proto(spread_scalar_r16);
1168
1169#endif
1170
1171extern void spread_scalar_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *,
1172 const index_type, const index_type);
1173internal_proto(spread_scalar_c4);
1174
1175extern void spread_scalar_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *,
1176 const index_type, const index_type);
1177internal_proto(spread_scalar_c8);
1178
1179#ifdef HAVE_GFC_COMPLEX_10
1180extern void spread_scalar_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *,
1181 const index_type, const index_type);
1182internal_proto(spread_scalar_c10);
1183
1184#endif
1185
1186#ifdef HAVE_GFC_COMPLEX_16
1187extern void spread_scalar_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *,
1188 const index_type, const index_type);
1189internal_proto(spread_scalar_c16);
1190
1191#endif
1192
4ee9c684 1193/* string_intrinsics.c */
1194
9267538e 1195extern int compare_string (gfc_charlen_type, const char *,
1196 gfc_charlen_type, const char *);
7b6cb5bd 1197iexport_proto(compare_string);
4ee9c684 1198
9267538e 1199extern int compare_string_char4 (gfc_charlen_type, const gfc_char4_t *,
1200 gfc_charlen_type, const gfc_char4_t *);
1201iexport_proto(compare_string_char4);
1202
d694eb47 1203/* random.c */
1204
3d3b790d 1205extern void random_seed_i4 (GFC_INTEGER_4 * size, gfc_array_i4 * put,
1206 gfc_array_i4 * get);
1207iexport_proto(random_seed_i4);
1208extern void random_seed_i8 (GFC_INTEGER_8 * size, gfc_array_i8 * put,
1209 gfc_array_i8 * get);
1210iexport_proto(random_seed_i8);
d694eb47 1211
5fcc57ce 1212/* size.c */
1213
1214typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) array_t;
1215
7b6cb5bd 1216extern index_type size0 (const array_t * array);
1217iexport_proto(size0);
5fcc57ce 1218
95f15c5b 1219/* Internal auxiliary functions for cshift */
1220
1221void cshift0_i1 (gfc_array_i1 *, const gfc_array_i1 *, ssize_t, int);
1222internal_proto(cshift0_i1);
1223
1224void cshift0_i2 (gfc_array_i2 *, const gfc_array_i2 *, ssize_t, int);
1225internal_proto(cshift0_i2);
1226
1227void cshift0_i4 (gfc_array_i4 *, const gfc_array_i4 *, ssize_t, int);
1228internal_proto(cshift0_i4);
1229
1230void cshift0_i8 (gfc_array_i8 *, const gfc_array_i8 *, ssize_t, int);
1231internal_proto(cshift0_i8);
1232
1233#ifdef HAVE_GFC_INTEGER_16
1234void cshift0_i16 (gfc_array_i16 *, const gfc_array_i16 *, ssize_t, int);
1235internal_proto(cshift0_i16);
1236#endif
1237
1238void cshift0_r4 (gfc_array_r4 *, const gfc_array_r4 *, ssize_t, int);
1239internal_proto(cshift0_r4);
1240
1241void cshift0_r8 (gfc_array_r8 *, const gfc_array_r8 *, ssize_t, int);
1242internal_proto(cshift0_r8);
1243
1244#ifdef HAVE_GFC_REAL_10
1245void cshift0_r10 (gfc_array_r10 *, const gfc_array_r10 *, ssize_t, int);
1246internal_proto(cshift0_r10);
1247#endif
1248
1249#ifdef HAVE_GFC_REAL_16
1250void cshift0_r16 (gfc_array_r16 *, const gfc_array_r16 *, ssize_t, int);
1251internal_proto(cshift0_r16);
1252#endif
1253
1254void cshift0_c4 (gfc_array_c4 *, const gfc_array_c4 *, ssize_t, int);
1255internal_proto(cshift0_c4);
1256
1257void cshift0_c8 (gfc_array_c8 *, const gfc_array_c8 *, ssize_t, int);
1258internal_proto(cshift0_c8);
1259
1260#ifdef HAVE_GFC_COMPLEX_10
1261void cshift0_c10 (gfc_array_c10 *, const gfc_array_c10 *, ssize_t, int);
1262internal_proto(cshift0_c10);
1263#endif
1264
1265#ifdef HAVE_GFC_COMPLEX_16
1266void cshift0_c16 (gfc_array_c16 *, const gfc_array_c16 *, ssize_t, int);
1267internal_proto(cshift0_c16);
1268#endif
1269
fd48ced8 1270#endif /* LIBGFOR_H */
Mirror of https://gcc.gnu.org/git/gcc.git