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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [fortran/] [f95-lang.c] - Blame information for rev 308

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

Line No. Rev Author Line
1 285 jeremybenn
/* gfortran backend interface
2
   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2010
3
   Free Software Foundation, Inc.
4
   Contributed by Paul Brook.
5
 
6
This file is part of GCC.
7
 
8
GCC is free software; you can redistribute it and/or modify it under
9
the terms of the GNU General Public License as published by the Free
10
Software Foundation; either version 3, or (at your option) any later
11
version.
12
 
13
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14
WARRANTY; without even the implied warranty of MERCHANTABILITY or
15
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
16
for more details.
17
 
18
You should have received a copy of the GNU General Public License
19
along with GCC; see the file COPYING3.  If not see
20
<http://www.gnu.org/licenses/>.  */
21
 
22
/* f95-lang.c-- GCC backend interface stuff */
23
 
24
/* declare required prototypes: */
25
 
26
#include "config.h"
27
#include "system.h"
28
#include "ansidecl.h"
29
#include "system.h"
30
#include "coretypes.h"
31
#include "tree.h"
32
#include "gimple.h"
33
#include "flags.h"
34
#include "langhooks.h"
35
#include "langhooks-def.h"
36
#include "timevar.h"
37
#include "tm.h"
38
#include "function.h"
39
#include "ggc.h"
40
#include "toplev.h"
41
#include "target.h"
42
#include "debug.h"
43
#include "diagnostic.h"
44
#include "tree-dump.h"
45
#include "cgraph.h"
46
/* For gfc_maybe_initialize_eh.  */
47
#include "libfuncs.h"
48
#include "expr.h"
49
#include "except.h"
50
 
51
#include "gfortran.h"
52
#include "cpp.h"
53
#include "trans.h"
54
#include "trans-types.h"
55
#include "trans-const.h"
56
 
57
/* Language-dependent contents of an identifier.  */
58
 
59
struct GTY(())
60
lang_identifier {
61
  struct tree_identifier common;
62
};
63
 
64
/* The resulting tree type.  */
65
 
66
union GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
67
     chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
68
 
69
lang_tree_node {
70
  union tree_node GTY((tag ("0"),
71
                       desc ("tree_node_structure (&%h)"))) generic;
72
  struct lang_identifier GTY((tag ("1"))) identifier;
73
};
74
 
75
/* Save and restore the variables in this file and elsewhere
76
   that keep track of the progress of compilation of the current function.
77
   Used for nested functions.  */
78
 
79
struct GTY(())
80
language_function {
81
  /* struct gfc_language_function base; */
82
  struct binding_level *binding_level;
83
};
84
 
85
/* We don't have a lex/yacc lexer/parser, but toplev expects these to
86
   exist anyway.  */
87
void yyerror (const char *str);
88
int yylex (void);
89
 
90
static void gfc_init_decl_processing (void);
91
static void gfc_init_builtin_functions (void);
92
 
93
/* Each front end provides its own.  */
94
static bool gfc_init (void);
95
static void gfc_finish (void);
96
static void gfc_print_identifier (FILE *, tree, int);
97
void do_function_end (void);
98
int global_bindings_p (void);
99
static void clear_binding_stack (void);
100
static void gfc_be_parse_file (int);
101
static alias_set_type gfc_get_alias_set (tree);
102
static void gfc_init_ts (void);
103
 
104
#undef LANG_HOOKS_NAME
105
#undef LANG_HOOKS_INIT
106
#undef LANG_HOOKS_FINISH
107
#undef LANG_HOOKS_INIT_OPTIONS
108
#undef LANG_HOOKS_HANDLE_OPTION
109
#undef LANG_HOOKS_POST_OPTIONS
110
#undef LANG_HOOKS_PRINT_IDENTIFIER
111
#undef LANG_HOOKS_PARSE_FILE
112
#undef LANG_HOOKS_MARK_ADDRESSABLE
113
#undef LANG_HOOKS_TYPE_FOR_MODE
114
#undef LANG_HOOKS_TYPE_FOR_SIZE
115
#undef LANG_HOOKS_GET_ALIAS_SET
116
#undef LANG_HOOKS_INIT_TS
117
#undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
118
#undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
119
#undef LANG_HOOKS_OMP_REPORT_DECL
120
#undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
121
#undef LANG_HOOKS_OMP_CLAUSE_COPY_CTOR
122
#undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP
123
#undef LANG_HOOKS_OMP_CLAUSE_DTOR
124
#undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
125
#undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
126
#undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF
127
#undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
128
#undef LANG_HOOKS_BUILTIN_FUNCTION
129
#undef LANG_HOOKS_GET_ARRAY_DESCR_INFO
130
 
131
/* Define lang hooks.  */
132
#define LANG_HOOKS_NAME                 "GNU Fortran"
133
#define LANG_HOOKS_INIT                 gfc_init
134
#define LANG_HOOKS_FINISH               gfc_finish
135
#define LANG_HOOKS_INIT_OPTIONS         gfc_init_options
136
#define LANG_HOOKS_HANDLE_OPTION        gfc_handle_option
137
#define LANG_HOOKS_POST_OPTIONS         gfc_post_options
138
#define LANG_HOOKS_PRINT_IDENTIFIER     gfc_print_identifier
139
#define LANG_HOOKS_PARSE_FILE           gfc_be_parse_file
140
#define LANG_HOOKS_TYPE_FOR_MODE        gfc_type_for_mode
141
#define LANG_HOOKS_TYPE_FOR_SIZE        gfc_type_for_size
142
#define LANG_HOOKS_GET_ALIAS_SET        gfc_get_alias_set
143
#define LANG_HOOKS_INIT_TS              gfc_init_ts
144
#define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE   gfc_omp_privatize_by_reference
145
#define LANG_HOOKS_OMP_PREDETERMINED_SHARING    gfc_omp_predetermined_sharing
146
#define LANG_HOOKS_OMP_REPORT_DECL              gfc_omp_report_decl
147
#define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR      gfc_omp_clause_default_ctor
148
#define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR         gfc_omp_clause_copy_ctor
149
#define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP         gfc_omp_clause_assign_op
150
#define LANG_HOOKS_OMP_CLAUSE_DTOR              gfc_omp_clause_dtor
151
#define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR     gfc_omp_disregard_value_expr
152
#define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE     gfc_omp_private_debug_clause
153
#define LANG_HOOKS_OMP_PRIVATE_OUTER_REF        gfc_omp_private_outer_ref
154
#define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
155
  gfc_omp_firstprivatize_type_sizes
156
#define LANG_HOOKS_BUILTIN_FUNCTION          gfc_builtin_function
157
#define LANG_HOOKS_GET_ARRAY_DESCR_INFO      gfc_get_array_descr_info
158
 
159
struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
160
 
161
#define NULL_BINDING_LEVEL (struct binding_level *) NULL
162
 
163
/* A chain of binding_level structures awaiting reuse.  */
164
 
165
static GTY(()) struct binding_level *free_binding_level;
166
 
167
/* The elements of `ridpointers' are identifier nodes
168
   for the reserved type names and storage classes.
169
   It is indexed by a RID_... value.  */
170
tree *ridpointers = NULL;
171
 
172
/* True means we've initialized exception handling.  */
173
bool gfc_eh_initialized_p;
174
 
175
 
176
/* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
177
   or validate its data type for an `if' or `while' statement or ?..: exp.
178
 
179
   This preparation consists of taking the ordinary
180
   representation of an expression expr and producing a valid tree
181
   boolean expression describing whether expr is nonzero.  We could
182
   simply always do build_binary_op (NE_EXPR, expr, boolean_false_node, 1),
183
   but we optimize comparisons, &&, ||, and !.
184
 
185
   The resulting type should always be `boolean_type_node'.
186
   This is much simpler than the corresponding C version because we have a
187
   distinct boolean type.  */
188
 
189
tree
190
gfc_truthvalue_conversion (tree expr)
191
{
192
  switch (TREE_CODE (TREE_TYPE (expr)))
193
    {
194
    case BOOLEAN_TYPE:
195
      if (TREE_TYPE (expr) == boolean_type_node)
196
        return expr;
197
      else if (COMPARISON_CLASS_P (expr))
198
        {
199
          TREE_TYPE (expr) = boolean_type_node;
200
          return expr;
201
        }
202
      else if (TREE_CODE (expr) == NOP_EXPR)
203
        return fold_build1 (NOP_EXPR,
204
                            boolean_type_node, TREE_OPERAND (expr, 0));
205
      else
206
        return fold_build1 (NOP_EXPR, boolean_type_node, expr);
207
 
208
    case INTEGER_TYPE:
209
      if (TREE_CODE (expr) == INTEGER_CST)
210
        return integer_zerop (expr) ? boolean_false_node : boolean_true_node;
211
      else
212
        return fold_build2 (NE_EXPR, boolean_type_node, expr,
213
                            build_int_cst (TREE_TYPE (expr), 0));
214
 
215
    default:
216
      internal_error ("Unexpected type in truthvalue_conversion");
217
    }
218
}
219
 
220
 
221
static void
222
gfc_create_decls (void)
223
{
224
  /* GCC builtins.  */
225
  gfc_init_builtin_functions ();
226
 
227
  /* Runtime/IO library functions.  */
228
  gfc_build_builtin_function_decls ();
229
 
230
  gfc_init_constants ();
231
}
232
 
233
 
234
static void
235
gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
236
{
237
  int errors;
238
  int warnings;
239
 
240
  gfc_create_decls ();
241
  gfc_parse_file ();
242
  gfc_generate_constructors ();
243
 
244
  /* Tell the frontend about any errors.  */
245
  gfc_get_errors (&warnings, &errors);
246
  errorcount += errors;
247
  warningcount += warnings;
248
 
249
  clear_binding_stack ();
250
}
251
 
252
 
253
/* Initialize everything.  */
254
 
255
static bool
256
gfc_init (void)
257
{
258
  if (!gfc_cpp_enabled ())
259
    {
260
      linemap_add (line_table, LC_ENTER, false, gfc_source_file, 1);
261
      linemap_add (line_table, LC_RENAME, false, "<built-in>", 0);
262
    }
263
  else
264
    gfc_cpp_init_0 ();
265
 
266
  gfc_init_decl_processing ();
267
  gfc_static_ctors = NULL_TREE;
268
 
269
  if (gfc_cpp_enabled ())
270
    gfc_cpp_init ();
271
 
272
  gfc_init_1 ();
273
 
274
  if (gfc_new_file () != SUCCESS)
275
    fatal_error ("can't open input file: %s", gfc_source_file);
276
 
277
  return true;
278
}
279
 
280
 
281
static void
282
gfc_finish (void)
283
{
284
  gfc_cpp_done ();
285
  gfc_done_1 ();
286
  gfc_release_include_path ();
287
  return;
288
}
289
 
290
static void
291
gfc_print_identifier (FILE * file ATTRIBUTE_UNUSED,
292
                      tree node ATTRIBUTE_UNUSED,
293
                      int indent ATTRIBUTE_UNUSED)
294
{
295
  return;
296
}
297
 
298
 
299
/* These functions and variables deal with binding contours.  We only
300
   need these functions for the list of PARM_DECLs, but we leave the
301
   functions more general; these are a simplified version of the
302
   functions from GNAT.  */
303
 
304
/* For each binding contour we allocate a binding_level structure which
305
   records the entities defined or declared in that contour.  Contours
306
   include:
307
 
308
        the global one
309
        one for each subprogram definition
310
        one for each compound statement (declare block)
311
 
312
   Binding contours are used to create GCC tree BLOCK nodes.  */
313
 
314
struct GTY(())
315
binding_level {
316
  /* A chain of ..._DECL nodes for all variables, constants, functions,
317
     parameters and type declarations.  These ..._DECL nodes are chained
318
     through the TREE_CHAIN field. Note that these ..._DECL nodes are stored
319
     in the reverse of the order supplied to be compatible with the
320
     back-end.  */
321
  tree names;
322
  /* For each level (except the global one), a chain of BLOCK nodes for all
323
     the levels that were entered and exited one level down from this one.  */
324
  tree blocks;
325
  /* The binding level containing this one (the enclosing binding level).  */
326
  struct binding_level *level_chain;
327
};
328
 
329
/* The binding level currently in effect.  */
330
static GTY(()) struct binding_level *current_binding_level = NULL;
331
 
332
/* The outermost binding level. This binding level is created when the
333
   compiler is started and it will exist through the entire compilation.  */
334
static GTY(()) struct binding_level *global_binding_level;
335
 
336
/* Binding level structures are initialized by copying this one.  */
337
static struct binding_level clear_binding_level = { NULL, NULL, NULL };
338
 
339
 
340
/* Return nonzero if we are currently in the global binding level.  */
341
 
342
int
343
global_bindings_p (void)
344
{
345
  return current_binding_level == global_binding_level ? -1 : 0;
346
}
347
 
348
tree
349
getdecls (void)
350
{
351
  return current_binding_level->names;
352
}
353
 
354
/* Enter a new binding level. The input parameter is ignored, but has to be
355
   specified for back-end compatibility.  */
356
 
357
void
358
pushlevel (int ignore ATTRIBUTE_UNUSED)
359
{
360
  struct binding_level *newlevel
361
    = (struct binding_level *) ggc_alloc (sizeof (struct binding_level));
362
 
363
  *newlevel = clear_binding_level;
364
 
365
  /* Add this level to the front of the chain (stack) of levels that are
366
     active.  */
367
  newlevel->level_chain = current_binding_level;
368
  current_binding_level = newlevel;
369
}
370
 
371
/* Exit a binding level.
372
   Pop the level off, and restore the state of the identifier-decl mappings
373
   that were in effect when this level was entered.
374
 
375
   If KEEP is nonzero, this level had explicit declarations, so
376
   and create a "block" (a BLOCK node) for the level
377
   to record its declarations and subblocks for symbol table output.
378
 
379
   If FUNCTIONBODY is nonzero, this level is the body of a function,
380
   so create a block as if KEEP were set and also clear out all
381
   label names.
382
 
383
   If REVERSE is nonzero, reverse the order of decls before putting
384
   them into the BLOCK.  */
385
 
386
tree
387
poplevel (int keep, int reverse, int functionbody)
388
{
389
  /* Points to a BLOCK tree node. This is the BLOCK node constructed for the
390
     binding level that we are about to exit and which is returned by this
391
     routine.  */
392
  tree block_node = NULL_TREE;
393
  tree decl_chain;
394
  tree subblock_chain = current_binding_level->blocks;
395
  tree subblock_node;
396
 
397
  /* Reverse the list of XXXX_DECL nodes if desired.  Note that the ..._DECL
398
     nodes chained through the `names' field of current_binding_level are in
399
     reverse order except for PARM_DECL node, which are explicitly stored in
400
     the right order.  */
401
  decl_chain = (reverse) ? nreverse (current_binding_level->names)
402
                         : current_binding_level->names;
403
 
404
  /* If there were any declarations in the current binding level, or if this
405
     binding level is a function body, or if there are any nested blocks then
406
     create a BLOCK node to record them for the life of this function.  */
407
  if (keep || functionbody)
408
    block_node = build_block (keep ? decl_chain : 0, subblock_chain, 0, 0);
409
 
410
  /* Record the BLOCK node just built as the subblock its enclosing scope.  */
411
  for (subblock_node = subblock_chain; subblock_node;
412
       subblock_node = TREE_CHAIN (subblock_node))
413
    BLOCK_SUPERCONTEXT (subblock_node) = block_node;
414
 
415
  /* Clear out the meanings of the local variables of this level.  */
416
 
417
  for (subblock_node = decl_chain; subblock_node;
418
       subblock_node = TREE_CHAIN (subblock_node))
419
    if (DECL_NAME (subblock_node) != 0)
420
      /* If the identifier was used or addressed via a local extern decl,
421
         don't forget that fact.  */
422
      if (DECL_EXTERNAL (subblock_node))
423
        {
424
          if (TREE_USED (subblock_node))
425
            TREE_USED (DECL_NAME (subblock_node)) = 1;
426
          if (TREE_ADDRESSABLE (subblock_node))
427
            TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1;
428
        }
429
 
430
  /* Pop the current level.  */
431
  current_binding_level = current_binding_level->level_chain;
432
 
433
  if (functionbody)
434
    /* This is the top level block of a function. */
435
    DECL_INITIAL (current_function_decl) = block_node;
436
  else if (current_binding_level == global_binding_level)
437
    /* When using gfc_start_block/gfc_finish_block from middle-end hooks,
438
       don't add newly created BLOCKs as subblocks of global_binding_level.  */
439
    ;
440
  else if (block_node)
441
    {
442
      current_binding_level->blocks
443
        = chainon (current_binding_level->blocks, block_node);
444
    }
445
 
446
  /* If we did not make a block for the level just exited, any blocks made for
447
     inner levels (since they cannot be recorded as subblocks in that level)
448
     must be carried forward so they will later become subblocks of something
449
     else.  */
450
  else if (subblock_chain)
451
    current_binding_level->blocks
452
      = chainon (current_binding_level->blocks, subblock_chain);
453
  if (block_node)
454
    TREE_USED (block_node) = 1;
455
 
456
  return block_node;
457
}
458
 
459
 
460
/* Records a ..._DECL node DECL as belonging to the current lexical scope.
461
   Returns the ..._DECL node.  */
462
 
463
tree
464
pushdecl (tree decl)
465
{
466
  /* External objects aren't nested, other objects may be.  */
467
  if ((DECL_EXTERNAL (decl)) || (decl == current_function_decl))
468
    DECL_CONTEXT (decl) = 0;
469
  else
470
    DECL_CONTEXT (decl) = current_function_decl;
471
 
472
  /* Put the declaration on the list.  The list of declarations is in reverse
473
     order. The list will be reversed later if necessary.  This needs to be
474
     this way for compatibility with the back-end.  */
475
 
476
  TREE_CHAIN (decl) = current_binding_level->names;
477
  current_binding_level->names = decl;
478
 
479
  /* For the declaration of a type, set its name if it is not already set.  */
480
 
481
  if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
482
    {
483
      if (DECL_SOURCE_LINE (decl) == 0)
484
        TYPE_NAME (TREE_TYPE (decl)) = decl;
485
      else
486
        TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl);
487
    }
488
 
489
  return decl;
490
}
491
 
492
 
493
/* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL.  */
494
 
495
tree
496
pushdecl_top_level (tree x)
497
{
498
  tree t;
499
  struct binding_level *b = current_binding_level;
500
 
501
  current_binding_level = global_binding_level;
502
  t = pushdecl (x);
503
  current_binding_level = b;
504
  return t;
505
}
506
 
507
 
508
/* Clear the binding stack.  */
509
static void
510
clear_binding_stack (void)
511
{
512
  while (!global_bindings_p ())
513
    poplevel (0, 0, 0);
514
}
515
 
516
 
517
#ifndef CHAR_TYPE_SIZE
518
#define CHAR_TYPE_SIZE BITS_PER_UNIT
519
#endif
520
 
521
#ifndef INT_TYPE_SIZE
522
#define INT_TYPE_SIZE BITS_PER_WORD
523
#endif
524
 
525
#undef SIZE_TYPE
526
#define SIZE_TYPE "long unsigned int"
527
 
528
/* Create tree nodes for the basic scalar types of Fortran 95,
529
   and some nodes representing standard constants (0, 1, (void *) 0).
530
   Initialize the global binding level.
531
   Make definitions for built-in primitive functions.  */
532
static void
533
gfc_init_decl_processing (void)
534
{
535
  current_function_decl = NULL;
536
  current_binding_level = NULL_BINDING_LEVEL;
537
  free_binding_level = NULL_BINDING_LEVEL;
538
 
539
  /* Make the binding_level structure for global names. We move all
540
     variables that are in a COMMON block to this binding level.  */
541
  pushlevel (0);
542
  global_binding_level = current_binding_level;
543
 
544
  /* Build common tree nodes. char_type_node is unsigned because we
545
     only use it for actual characters, not for INTEGER(1). Also, we
546
     want double_type_node to actually have double precision.  */
547
  build_common_tree_nodes (false, false);
548
  /* x86_64 mingw32 has a sizetype of "unsigned long long", most other hosts
549
     have a sizetype of "unsigned long". Therefore choose the correct size
550
     in mostly target independent way.  */
551
  if (TYPE_MODE (long_unsigned_type_node) == ptr_mode)
552
    set_sizetype (long_unsigned_type_node);
553
  else if (TYPE_MODE (long_long_unsigned_type_node) == ptr_mode)
554
    set_sizetype (long_long_unsigned_type_node);
555
  else
556
    set_sizetype (long_unsigned_type_node);
557
  build_common_tree_nodes_2 (0);
558
  void_list_node = build_tree_list (NULL_TREE, void_type_node);
559
 
560
  /* Set up F95 type nodes.  */
561
  gfc_init_kinds ();
562
  gfc_init_types ();
563
}
564
 
565
 
566
/* Return the typed-based alias set for T, which may be an expression
567
   or a type.  Return -1 if we don't do anything special.  */
568
 
569
static alias_set_type
570
gfc_get_alias_set (tree t)
571
{
572
  tree u;
573
 
574
  /* Permit type-punning when accessing an EQUIVALENCEd variable or
575
     mixed type entry master's return value.  */
576
  for (u = t; handled_component_p (u); u = TREE_OPERAND (u, 0))
577
    if (TREE_CODE (u) == COMPONENT_REF
578
        && TREE_CODE (TREE_TYPE (TREE_OPERAND (u, 0))) == UNION_TYPE)
579
      return 0;
580
 
581
  return -1;
582
}
583
 
584
 
585
/* press the big red button - garbage (ggc) collection is on */
586
 
587
int ggc_p = 1;
588
 
589
/* Builtin function initialization.  */
590
 
591
tree
592
gfc_builtin_function (tree decl)
593
{
594
  make_decl_rtl (decl);
595
  pushdecl (decl);
596
  return decl;
597
}
598
 
599
 
600
static void
601
gfc_define_builtin (const char *name,
602
                    tree type,
603
                    int code,
604
                    const char *library_name,
605
                    bool const_p)
606
{
607
  tree decl;
608
 
609
  decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
610
                               library_name, NULL_TREE);
611
  if (const_p)
612
    TREE_READONLY (decl) = 1;
613
  TREE_NOTHROW (decl) = 1;
614
 
615
  built_in_decls[code] = decl;
616
  implicit_built_in_decls[code] = decl;
617
}
618
 
619
 
620
#define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
621
    gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
622
                       BUILT_IN_ ## code ## L, name "l", true); \
623
    gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
624
                        BUILT_IN_ ## code, name, true); \
625
    gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
626
                        BUILT_IN_ ## code ## F, name "f", true);
627
 
628
#define DEFINE_MATH_BUILTIN(code, name, argtype) \
629
    DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
630
 
631
#define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
632
    DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
633
    DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
634
 
635
 
636
/* Create function types for builtin functions.  */
637
 
638
static void
639
build_builtin_fntypes (tree *fntype, tree type)
640
{
641
  tree tmp;
642
 
643
  /* type (*) (type) */
644
  tmp = tree_cons (NULL_TREE, type, void_list_node);
645
  fntype[0] = build_function_type (type, tmp);
646
  /* type (*) (type, type) */
647
  tmp = tree_cons (NULL_TREE, type, tmp);
648
  fntype[1] = build_function_type (type, tmp);
649
  /* type (*) (int, type) */
650
  tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
651
  tmp = tree_cons (NULL_TREE, type, tmp);
652
  fntype[2] = build_function_type (type, tmp);
653
  /* type (*) (void) */
654
  fntype[3] = build_function_type (type, void_list_node);
655
  /* type (*) (type, &int) */
656
  tmp = tree_cons (NULL_TREE, type, void_list_node);
657
  tmp = tree_cons (NULL_TREE, build_pointer_type (integer_type_node), tmp);
658
  fntype[4] = build_function_type (type, tmp);
659
  /* type (*) (type, int) */
660
  tmp = tree_cons (NULL_TREE, type, void_list_node);
661
  tmp = tree_cons (NULL_TREE, integer_type_node, tmp);
662
  fntype[5] = build_function_type (type, tmp);
663
}
664
 
665
 
666
static tree
667
builtin_type_for_size (int size, bool unsignedp)
668
{
669
  tree type = lang_hooks.types.type_for_size (size, unsignedp);
670
  return type ? type : error_mark_node;
671
}
672
 
673
/* Initialization of builtin function nodes.  */
674
 
675
static void
676
gfc_init_builtin_functions (void)
677
{
678
  enum builtin_type
679
  {
680
#define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME,
681
#define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME,
682
#define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME,
683
#define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME,
684
#define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME,
685
#define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME,
686
#define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME,
687
#define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6) NAME,
688
#define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6, ARG7) NAME,
689
#define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME,
690
#define DEF_POINTER_TYPE(NAME, TYPE) NAME,
691
#include "types.def"
692
#undef DEF_PRIMITIVE_TYPE
693
#undef DEF_FUNCTION_TYPE_0
694
#undef DEF_FUNCTION_TYPE_1
695
#undef DEF_FUNCTION_TYPE_2
696
#undef DEF_FUNCTION_TYPE_3
697
#undef DEF_FUNCTION_TYPE_4
698
#undef DEF_FUNCTION_TYPE_5
699
#undef DEF_FUNCTION_TYPE_6
700
#undef DEF_FUNCTION_TYPE_7
701
#undef DEF_FUNCTION_TYPE_VAR_0
702
#undef DEF_POINTER_TYPE
703
    BT_LAST
704
  };
705
  typedef enum builtin_type builtin_type;
706
  enum
707
  {
708
    /* So far we need just these 2 attribute types.  */
709
    ATTR_NOTHROW_LIST,
710
    ATTR_CONST_NOTHROW_LIST
711
  };
712
 
713
  tree mfunc_float[6];
714
  tree mfunc_double[6];
715
  tree mfunc_longdouble[6];
716
  tree mfunc_cfloat[6];
717
  tree mfunc_cdouble[6];
718
  tree mfunc_clongdouble[6];
719
  tree func_cfloat_float, func_float_cfloat;
720
  tree func_cdouble_double, func_double_cdouble;
721
  tree func_clongdouble_longdouble, func_longdouble_clongdouble;
722
  tree func_float_floatp_floatp;
723
  tree func_double_doublep_doublep;
724
  tree func_longdouble_longdoublep_longdoublep;
725
  tree ftype, ptype;
726
  tree tmp, type;
727
  tree builtin_types[(int) BT_LAST + 1];
728
 
729
  build_builtin_fntypes (mfunc_float, float_type_node);
730
  build_builtin_fntypes (mfunc_double, double_type_node);
731
  build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
732
  build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
733
  build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
734
  build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
735
 
736
  tmp = tree_cons (NULL_TREE, complex_float_type_node, void_list_node);
737
  func_cfloat_float = build_function_type (float_type_node, tmp);
738
 
739
  tmp = tree_cons (NULL_TREE, float_type_node, void_list_node);
740
  func_float_cfloat = build_function_type (complex_float_type_node, tmp);
741
 
742
  tmp = tree_cons (NULL_TREE, complex_double_type_node, void_list_node);
743
  func_cdouble_double = build_function_type (double_type_node, tmp);
744
 
745
  tmp = tree_cons (NULL_TREE, double_type_node, void_list_node);
746
  func_double_cdouble = build_function_type (complex_double_type_node, tmp);
747
 
748
  tmp = tree_cons (NULL_TREE, complex_long_double_type_node, void_list_node);
749
  func_clongdouble_longdouble =
750
    build_function_type (long_double_type_node, tmp);
751
 
752
  tmp = tree_cons (NULL_TREE, long_double_type_node, void_list_node);
753
  func_longdouble_clongdouble =
754
    build_function_type (complex_long_double_type_node, tmp);
755
 
756
  ptype = build_pointer_type (float_type_node);
757
  tmp = tree_cons (NULL_TREE, float_type_node,
758
                   tree_cons (NULL_TREE, ptype,
759
                              tree_cons (NULL_TREE, ptype, void_list_node)));
760
  func_float_floatp_floatp =
761
    build_function_type (void_type_node, tmp);
762
 
763
  ptype = build_pointer_type (double_type_node);
764
  tmp = tree_cons (NULL_TREE, double_type_node,
765
                   tree_cons (NULL_TREE, ptype,
766
                              tree_cons (NULL_TREE, ptype, void_list_node)));
767
  func_double_doublep_doublep =
768
    build_function_type (void_type_node, tmp);
769
 
770
  ptype = build_pointer_type (long_double_type_node);
771
  tmp = tree_cons (NULL_TREE, long_double_type_node,
772
                   tree_cons (NULL_TREE, ptype,
773
                              tree_cons (NULL_TREE, ptype, void_list_node)));
774
  func_longdouble_longdoublep_longdoublep =
775
    build_function_type (void_type_node, tmp);
776
 
777
#include "mathbuiltins.def"
778
 
779
  /* We define these separately as the fortran versions have different
780
     semantics (they return an integer type) */
781
  gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0],
782
                      BUILT_IN_ROUNDL, "roundl", true);
783
  gfc_define_builtin ("__builtin_round", mfunc_double[0],
784
                      BUILT_IN_ROUND, "round", true);
785
  gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
786
                      BUILT_IN_ROUNDF, "roundf", true);
787
 
788
  gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
789
                      BUILT_IN_TRUNCL, "truncl", true);
790
  gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
791
                      BUILT_IN_TRUNC, "trunc", true);
792
  gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
793
                      BUILT_IN_TRUNCF, "truncf", true);
794
 
795
  gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble,
796
                      BUILT_IN_CABSL, "cabsl", true);
797
  gfc_define_builtin ("__builtin_cabs", func_cdouble_double,
798
                      BUILT_IN_CABS, "cabs", true);
799
  gfc_define_builtin ("__builtin_cabsf", func_cfloat_float,
800
                      BUILT_IN_CABSF, "cabsf", true);
801
 
802
  gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1],
803
                      BUILT_IN_COPYSIGNL, "copysignl", true);
804
  gfc_define_builtin ("__builtin_copysign", mfunc_double[1],
805
                      BUILT_IN_COPYSIGN, "copysign", true);
806
  gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
807
                      BUILT_IN_COPYSIGNF, "copysignf", true);
808
 
809
  gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1],
810
                      BUILT_IN_NEXTAFTERL, "nextafterl", true);
811
  gfc_define_builtin ("__builtin_nextafter", mfunc_double[1],
812
                      BUILT_IN_NEXTAFTER, "nextafter", true);
813
  gfc_define_builtin ("__builtin_nextafterf", mfunc_float[1],
814
                      BUILT_IN_NEXTAFTERF, "nextafterf", true);
815
 
816
  gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4],
817
                      BUILT_IN_FREXPL, "frexpl", false);
818
  gfc_define_builtin ("__builtin_frexp", mfunc_double[4],
819
                      BUILT_IN_FREXP, "frexp", false);
820
  gfc_define_builtin ("__builtin_frexpf", mfunc_float[4],
821
                      BUILT_IN_FREXPF, "frexpf", false);
822
 
823
  gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0],
824
                      BUILT_IN_FABSL, "fabsl", true);
825
  gfc_define_builtin ("__builtin_fabs", mfunc_double[0],
826
                      BUILT_IN_FABS, "fabs", true);
827
  gfc_define_builtin ("__builtin_fabsf", mfunc_float[0],
828
                      BUILT_IN_FABSF, "fabsf", true);
829
 
830
  gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[5],
831
                      BUILT_IN_SCALBNL, "scalbnl", true);
832
  gfc_define_builtin ("__builtin_scalbn", mfunc_double[5],
833
                      BUILT_IN_SCALBN, "scalbn", true);
834
  gfc_define_builtin ("__builtin_scalbnf", mfunc_float[5],
835
                      BUILT_IN_SCALBNF, "scalbnf", true);
836
 
837
  gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1],
838
                      BUILT_IN_FMODL, "fmodl", true);
839
  gfc_define_builtin ("__builtin_fmod", mfunc_double[1],
840
                      BUILT_IN_FMOD, "fmod", true);
841
  gfc_define_builtin ("__builtin_fmodf", mfunc_float[1],
842
                      BUILT_IN_FMODF, "fmodf", true);
843
 
844
  gfc_define_builtin ("__builtin_huge_vall", mfunc_longdouble[3],
845
                      BUILT_IN_HUGE_VALL, "__builtin_huge_vall", true);
846
  gfc_define_builtin ("__builtin_huge_val", mfunc_double[3],
847
                      BUILT_IN_HUGE_VAL, "__builtin_huge_val", true);
848
  gfc_define_builtin ("__builtin_huge_valf", mfunc_float[3],
849
                      BUILT_IN_HUGE_VALF, "__builtin_huge_valf", true);
850
 
851
  /* lround{f,,l} and llround{f,,l} */
852
  type = tree_cons (NULL_TREE, float_type_node, void_list_node);
853
  tmp = build_function_type (long_integer_type_node, type);
854
  gfc_define_builtin ("__builtin_lroundf", tmp, BUILT_IN_LROUNDF,
855
                      "lroundf", true);
856
  tmp = build_function_type (long_long_integer_type_node, type);
857
  gfc_define_builtin ("__builtin_llroundf", tmp, BUILT_IN_LLROUNDF,
858
                      "llroundf", true);
859
 
860
  type = tree_cons (NULL_TREE, double_type_node, void_list_node);
861
  tmp = build_function_type (long_integer_type_node, type);
862
  gfc_define_builtin ("__builtin_lround", tmp, BUILT_IN_LROUND,
863
                      "lround", true);
864
  tmp = build_function_type (long_long_integer_type_node, type);
865
  gfc_define_builtin ("__builtin_llround", tmp, BUILT_IN_LLROUND,
866
                      "llround", true);
867
 
868
  type = tree_cons (NULL_TREE, long_double_type_node, void_list_node);
869
  tmp = build_function_type (long_integer_type_node, type);
870
  gfc_define_builtin ("__builtin_lroundl", tmp, BUILT_IN_LROUNDL,
871
                      "lroundl", true);
872
  tmp = build_function_type (long_long_integer_type_node, type);
873
  gfc_define_builtin ("__builtin_llroundl", tmp, BUILT_IN_LLROUNDL,
874
                      "llroundl", true);
875
 
876
  /* These are used to implement the ** operator.  */
877
  gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1],
878
                      BUILT_IN_POWL, "powl", true);
879
  gfc_define_builtin ("__builtin_pow", mfunc_double[1],
880
                      BUILT_IN_POW, "pow", true);
881
  gfc_define_builtin ("__builtin_powf", mfunc_float[1],
882
                      BUILT_IN_POWF, "powf", true);
883
  gfc_define_builtin ("__builtin_cpowl", mfunc_clongdouble[1],
884
                      BUILT_IN_CPOWL, "cpowl", true);
885
  gfc_define_builtin ("__builtin_cpow", mfunc_cdouble[1],
886
                      BUILT_IN_CPOW, "cpow", true);
887
  gfc_define_builtin ("__builtin_cpowf", mfunc_cfloat[1],
888
                      BUILT_IN_CPOWF, "cpowf", true);
889
  gfc_define_builtin ("__builtin_powil", mfunc_longdouble[2],
890
                      BUILT_IN_POWIL, "powil", true);
891
  gfc_define_builtin ("__builtin_powi", mfunc_double[2],
892
                      BUILT_IN_POWI, "powi", true);
893
  gfc_define_builtin ("__builtin_powif", mfunc_float[2],
894
                      BUILT_IN_POWIF, "powif", true);
895
 
896
 
897
  if (TARGET_C99_FUNCTIONS)
898
    {
899
      gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0],
900
                          BUILT_IN_CBRTL, "cbrtl", true);
901
      gfc_define_builtin ("__builtin_cbrt", mfunc_double[0],
902
                          BUILT_IN_CBRT, "cbrt", true);
903
      gfc_define_builtin ("__builtin_cbrtf", mfunc_float[0],
904
                          BUILT_IN_CBRTF, "cbrtf", true);
905
      gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble,
906
                          BUILT_IN_CEXPIL, "cexpil", true);
907
      gfc_define_builtin ("__builtin_cexpi", func_double_cdouble,
908
                          BUILT_IN_CEXPI, "cexpi", true);
909
      gfc_define_builtin ("__builtin_cexpif", func_float_cfloat,
910
                          BUILT_IN_CEXPIF, "cexpif", true);
911
    }
912
 
913
  if (TARGET_HAS_SINCOS)
914
    {
915
      gfc_define_builtin ("__builtin_sincosl",
916
                          func_longdouble_longdoublep_longdoublep,
917
                          BUILT_IN_SINCOSL, "sincosl", false);
918
      gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep,
919
                          BUILT_IN_SINCOS, "sincos", false);
920
      gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp,
921
                          BUILT_IN_SINCOSF, "sincosf", false);
922
    }
923
 
924
  /* For LEADZ / TRAILZ.  */
925
  tmp = tree_cons (NULL_TREE, unsigned_type_node, void_list_node);
926
  ftype = build_function_type (integer_type_node, tmp);
927
  gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ,
928
                      "__builtin_clz", true);
929
 
930
  tmp = tree_cons (NULL_TREE, long_unsigned_type_node, void_list_node);
931
  ftype = build_function_type (integer_type_node, tmp);
932
  gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL,
933
                      "__builtin_clzl", true);
934
 
935
  tmp = tree_cons (NULL_TREE, long_long_unsigned_type_node, void_list_node);
936
  ftype = build_function_type (integer_type_node, tmp);
937
  gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL,
938
                      "__builtin_clzll", true);
939
 
940
  tmp = tree_cons (NULL_TREE, unsigned_type_node, void_list_node);
941
  ftype = build_function_type (integer_type_node, tmp);
942
  gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ,
943
                      "__builtin_ctz", true);
944
 
945
  tmp = tree_cons (NULL_TREE, long_unsigned_type_node, void_list_node);
946
  ftype = build_function_type (integer_type_node, tmp);
947
  gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL,
948
                      "__builtin_ctzl", true);
949
 
950
  tmp = tree_cons (NULL_TREE, long_long_unsigned_type_node, void_list_node);
951
  ftype = build_function_type (integer_type_node, tmp);
952
  gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL,
953
                      "__builtin_ctzll", true);
954
 
955
  /* Other builtin functions we use.  */
956
 
957
  tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
958
  tmp = tree_cons (NULL_TREE, long_integer_type_node, tmp);
959
  ftype = build_function_type (long_integer_type_node, tmp);
960
  gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
961
                      "__builtin_expect", true);
962
 
963
  tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
964
  ftype = build_function_type (void_type_node, tmp);
965
  gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE,
966
                      "free", false);
967
 
968
  tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
969
  ftype = build_function_type (pvoid_type_node, tmp);
970
  gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC,
971
                      "malloc", false);
972
  DECL_IS_MALLOC (built_in_decls[BUILT_IN_MALLOC]) = 1;
973
 
974
  tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
975
  tmp = tree_cons (NULL_TREE, size_type_node, tmp);
976
  ftype = build_function_type (pvoid_type_node, tmp);
977
  gfc_define_builtin ("__builtin_realloc", ftype, BUILT_IN_REALLOC,
978
                      "realloc", false);
979
 
980
  tmp = tree_cons (NULL_TREE, void_type_node, void_list_node);
981
  ftype = build_function_type (integer_type_node, tmp);
982
  gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
983
                      "__builtin_isnan", true);
984
 
985
#define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
986
  builtin_types[(int) ENUM] = VALUE;
987
#define DEF_FUNCTION_TYPE_0(ENUM, RETURN)               \
988
  builtin_types[(int) ENUM]                             \
989
    = build_function_type (builtin_types[(int) RETURN], \
990
                           void_list_node);
991
#define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1)                         \
992
  builtin_types[(int) ENUM]                                             \
993
    = build_function_type (builtin_types[(int) RETURN],                 \
994
                           tree_cons (NULL_TREE,                        \
995
                                      builtin_types[(int) ARG1],        \
996
                                      void_list_node));
997
#define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2)   \
998
  builtin_types[(int) ENUM]                             \
999
    = build_function_type                               \
1000
      (builtin_types[(int) RETURN],                     \
1001
       tree_cons (NULL_TREE,                            \
1002
                  builtin_types[(int) ARG1],            \
1003
                  tree_cons (NULL_TREE,                 \
1004
                             builtin_types[(int) ARG2], \
1005
                             void_list_node)));
1006
#define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3)              \
1007
  builtin_types[(int) ENUM]                                              \
1008
    = build_function_type                                                \
1009
      (builtin_types[(int) RETURN],                                      \
1010
       tree_cons (NULL_TREE,                                             \
1011
                  builtin_types[(int) ARG1],                             \
1012
                  tree_cons (NULL_TREE,                                  \
1013
                             builtin_types[(int) ARG2],                  \
1014
                             tree_cons (NULL_TREE,                       \
1015
                                        builtin_types[(int) ARG3],       \
1016
                                        void_list_node))));
1017
#define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4)       \
1018
  builtin_types[(int) ENUM]                                             \
1019
    = build_function_type                                               \
1020
      (builtin_types[(int) RETURN],                                     \
1021
       tree_cons (NULL_TREE,                                            \
1022
                  builtin_types[(int) ARG1],                            \
1023
                  tree_cons (NULL_TREE,                                 \
1024
                             builtin_types[(int) ARG2],                 \
1025
                             tree_cons                                  \
1026
                             (NULL_TREE,                                \
1027
                              builtin_types[(int) ARG3],                \
1028
                              tree_cons (NULL_TREE,                     \
1029
                                         builtin_types[(int) ARG4],     \
1030
                                         void_list_node)))));
1031
#define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \
1032
  builtin_types[(int) ENUM]                                             \
1033
    = build_function_type                                               \
1034
      (builtin_types[(int) RETURN],                                     \
1035
       tree_cons (NULL_TREE,                                            \
1036
                  builtin_types[(int) ARG1],                            \
1037
                  tree_cons (NULL_TREE,                                 \
1038
                             builtin_types[(int) ARG2],                 \
1039
                             tree_cons                                  \
1040
                             (NULL_TREE,                                \
1041
                              builtin_types[(int) ARG3],                \
1042
                              tree_cons (NULL_TREE,                     \
1043
                                         builtin_types[(int) ARG4],     \
1044
                                         tree_cons (NULL_TREE,          \
1045
                                              builtin_types[(int) ARG5],\
1046
                                              void_list_node))))));
1047
#define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1048
                            ARG6)                                       \
1049
  builtin_types[(int) ENUM]                                             \
1050
    = build_function_type                                               \
1051
      (builtin_types[(int) RETURN],                                     \
1052
       tree_cons (NULL_TREE,                                            \
1053
                  builtin_types[(int) ARG1],                            \
1054
                  tree_cons (NULL_TREE,                                 \
1055
                             builtin_types[(int) ARG2],                 \
1056
                             tree_cons                                  \
1057
                             (NULL_TREE,                                \
1058
                              builtin_types[(int) ARG3],                \
1059
                              tree_cons                                 \
1060
                              (NULL_TREE,                               \
1061
                               builtin_types[(int) ARG4],               \
1062
                               tree_cons (NULL_TREE,                    \
1063
                                         builtin_types[(int) ARG5],     \
1064
                                         tree_cons (NULL_TREE,          \
1065
                                              builtin_types[(int) ARG6],\
1066
                                              void_list_node)))))));
1067
#define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1068
                            ARG6, ARG7)                                 \
1069
  builtin_types[(int) ENUM]                                             \
1070
    = build_function_type                                               \
1071
      (builtin_types[(int) RETURN],                                     \
1072
       tree_cons (NULL_TREE,                                            \
1073
                  builtin_types[(int) ARG1],                            \
1074
                  tree_cons (NULL_TREE,                                 \
1075
                             builtin_types[(int) ARG2],                 \
1076
                             tree_cons                                  \
1077
                             (NULL_TREE,                                \
1078
                              builtin_types[(int) ARG3],                \
1079
                              tree_cons                                 \
1080
                              (NULL_TREE,                               \
1081
                               builtin_types[(int) ARG4],               \
1082
                               tree_cons (NULL_TREE,                    \
1083
                                         builtin_types[(int) ARG5],     \
1084
                                         tree_cons (NULL_TREE,          \
1085
                                              builtin_types[(int) ARG6],\
1086
                                         tree_cons (NULL_TREE,          \
1087
                                              builtin_types[(int) ARG6], \
1088
                                              void_list_node))))))));
1089
#define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN)                           \
1090
  builtin_types[(int) ENUM]                                             \
1091
    = build_function_type (builtin_types[(int) RETURN], NULL_TREE);
1092
#define DEF_POINTER_TYPE(ENUM, TYPE)                    \
1093
  builtin_types[(int) ENUM]                             \
1094
    = build_pointer_type (builtin_types[(int) TYPE]);
1095
#include "types.def"
1096
#undef DEF_PRIMITIVE_TYPE
1097
#undef DEF_FUNCTION_TYPE_1
1098
#undef DEF_FUNCTION_TYPE_2
1099
#undef DEF_FUNCTION_TYPE_3
1100
#undef DEF_FUNCTION_TYPE_4
1101
#undef DEF_FUNCTION_TYPE_5
1102
#undef DEF_FUNCTION_TYPE_6
1103
#undef DEF_FUNCTION_TYPE_VAR_0
1104
#undef DEF_POINTER_TYPE
1105
  builtin_types[(int) BT_LAST] = NULL_TREE;
1106
 
1107
  /* Initialize synchronization builtins.  */
1108
#undef DEF_SYNC_BUILTIN
1109
#define DEF_SYNC_BUILTIN(code, name, type, attr) \
1110
    gfc_define_builtin (name, builtin_types[type], code, name, \
1111
                        attr == ATTR_CONST_NOTHROW_LIST);
1112
#include "../sync-builtins.def"
1113
#undef DEF_SYNC_BUILTIN
1114
 
1115
  if (gfc_option.flag_openmp || flag_tree_parallelize_loops)
1116
    {
1117
#undef DEF_GOMP_BUILTIN
1118
#define DEF_GOMP_BUILTIN(code, name, type, attr) \
1119
      gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1120
                          code, name, attr == ATTR_CONST_NOTHROW_LIST);
1121
#include "../omp-builtins.def"
1122
#undef DEF_GOMP_BUILTIN
1123
    }
1124
 
1125
  gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID],
1126
                      BUILT_IN_TRAP, NULL, false);
1127
  TREE_THIS_VOLATILE (built_in_decls[BUILT_IN_TRAP]) = 1;
1128
 
1129
  gfc_define_builtin ("__emutls_get_address",
1130
                      builtin_types[BT_FN_PTR_PTR], BUILT_IN_EMUTLS_GET_ADDRESS,
1131
                      "__emutls_get_address", true);
1132
  gfc_define_builtin ("__emutls_register_common",
1133
                      builtin_types[BT_FN_VOID_PTR_WORD_WORD_PTR],
1134
                      BUILT_IN_EMUTLS_REGISTER_COMMON,
1135
                      "__emutls_register_common", false);
1136
 
1137
  build_common_builtin_nodes ();
1138
  targetm.init_builtins ();
1139
}
1140
 
1141
#undef DEFINE_MATH_BUILTIN_C
1142
#undef DEFINE_MATH_BUILTIN
1143
 
1144
static void
1145
gfc_init_ts (void)
1146
{
1147
  tree_contains_struct[NAMESPACE_DECL][TS_DECL_NON_COMMON] = 1;
1148
  tree_contains_struct[NAMESPACE_DECL][TS_DECL_WITH_VIS] = 1;
1149
  tree_contains_struct[NAMESPACE_DECL][TS_DECL_WRTL] = 1;
1150
  tree_contains_struct[NAMESPACE_DECL][TS_DECL_COMMON] = 1;
1151
  tree_contains_struct[NAMESPACE_DECL][TS_DECL_MINIMAL] = 1;
1152
}
1153
 
1154
void
1155
gfc_maybe_initialize_eh (void)
1156
{
1157
  if (!flag_exceptions || gfc_eh_initialized_p)
1158
    return;
1159
 
1160
  gfc_eh_initialized_p = true;
1161
  using_eh_for_cleanups ();
1162
}
1163
 
1164
 
1165
#include "gt-fortran-f95-lang.h"
1166
#include "gtype-fortran.h"

powered by: WebSVN 2.1.0

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