OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgfortran/] [libgfortran.h] - Blame information for rev 790

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.