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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [gcc-interface/] [misc.c] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
/****************************************************************************
2
 *                                                                          *
3
 *                         GNAT COMPILER COMPONENTS                         *
4
 *                                                                          *
5
 *                                 M I S C                                  *
6
 *                                                                          *
7
 *                           C Implementation File                          *
8
 *                                                                          *
9
 *          Copyright (C) 1992-2012, Free Software Foundation, Inc.         *
10
 *                                                                          *
11
 * GNAT is free software;  you can  redistribute it  and/or modify it under *
12
 * terms of the  GNU General Public License as published  by the Free Soft- *
13
 * ware  Foundation;  either version 3,  or (at your option) any later ver- *
14
 * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
15
 * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
16
 * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
17
 * for  more details.  You should have  received  a copy of the GNU General *
18
 * Public License  distributed  with GNAT;  see file  COPYING3.  If not see *
19
 * <http://www.gnu.org/licenses/>.                                          *
20
 *                                                                          *
21
 * GNAT was originally developed  by the GNAT team at  New York University. *
22
 * Extensive contributions were provided by Ada Core Technologies Inc.      *
23
 *                                                                          *
24
 ****************************************************************************/
25
 
26
#include "config.h"
27
#include "system.h"
28
#include "coretypes.h"
29
#include "tm.h"
30
#include "tree.h"
31
#include "diagnostic.h"
32
#include "target.h"
33
#include "ggc.h"
34
#include "flags.h"
35
#include "debug.h"
36
#include "toplev.h"
37
#include "langhooks.h"
38
#include "langhooks-def.h"
39
#include "opts.h"
40
#include "options.h"
41
#include "plugin.h"
42
#include "real.h"
43
#include "function.h"   /* For pass_by_reference.  */
44
 
45
#include "ada.h"
46
#include "adadecode.h"
47
#include "types.h"
48
#include "atree.h"
49
#include "elists.h"
50
#include "namet.h"
51
#include "nlists.h"
52
#include "stringt.h"
53
#include "uintp.h"
54
#include "fe.h"
55
#include "sinfo.h"
56
#include "einfo.h"
57
#include "ada-tree.h"
58
#include "gigi.h"
59
 
60
/* This symbol needs to be defined for the front-end.  */
61
void *callgraph_info_file = NULL;
62
 
63
/* Command-line argc and argv.  These variables are global since they are
64
   imported in back_end.adb.  */
65
unsigned int save_argc;
66
const char **save_argv;
67
 
68
/* GNAT argc and argv.  */
69
extern int gnat_argc;
70
extern char **gnat_argv;
71
 
72
#ifdef __cplusplus
73
extern "C" {
74
#endif
75
 
76
/* Declare functions we use as part of startup.  */
77
extern void __gnat_initialize (void *);
78
extern void __gnat_install_SEH_handler (void *);
79
extern void adainit (void);
80
extern void _ada_gnat1drv (void);
81
 
82
#ifdef __cplusplus
83
}
84
#endif
85
 
86
/* The parser for the language.  For us, we process the GNAT tree.  */
87
 
88
static void
89
gnat_parse_file (void)
90
{
91
  int seh[2];
92
 
93
  /* Call the target specific initializations.  */
94
  __gnat_initialize (NULL);
95
 
96
  /* ??? Call the SEH initialization routine.  This is to workaround
97
  a bootstrap path problem.  The call below should be removed at some
98
  point and the SEH pointer passed to __gnat_initialize() above.  */
99
  __gnat_install_SEH_handler((void *)seh);
100
 
101
  /* Call the front-end elaboration procedures.  */
102
  adainit ();
103
 
104
  /* Call the front end.  */
105
  _ada_gnat1drv ();
106
}
107
 
108
/* Decode all the language specific options that cannot be decoded by GCC.
109
   The option decoding phase of GCC calls this routine on the flags that
110
   are marked as Ada-specific.  Return true on success or false on failure.  */
111
 
112
static bool
113
gnat_handle_option (size_t scode, const char *arg ATTRIBUTE_UNUSED, int value,
114
                    int kind ATTRIBUTE_UNUSED, location_t loc ATTRIBUTE_UNUSED,
115
                    const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
116
{
117
  enum opt_code code = (enum opt_code) scode;
118
 
119
  switch (code)
120
    {
121
    case OPT_Wall:
122
      warn_unused = value;
123
      warn_uninitialized = value;
124
      warn_maybe_uninitialized = value;
125
      break;
126
 
127
    case OPT_gant:
128
      warning (0, "%<-gnat%> misspelled as %<-gant%>");
129
 
130
      /* ... fall through ... */
131
 
132
    case OPT_gnat:
133
    case OPT_gnatO:
134
    case OPT_fRTS_:
135
    case OPT_I:
136
    case OPT_nostdinc:
137
    case OPT_nostdlib:
138
      /* These are handled by the front-end.  */
139
      break;
140
 
141
    default:
142
      gcc_unreachable ();
143
    }
144
 
145
  return true;
146
}
147
 
148
/* Return language mask for option processing.  */
149
 
150
static unsigned int
151
gnat_option_lang_mask (void)
152
{
153
  return CL_Ada;
154
}
155
 
156
/* Initialize options structure OPTS.  */
157
 
158
static void
159
gnat_init_options_struct (struct gcc_options *opts)
160
{
161
  /* Uninitialized really means uninitialized in Ada.  */
162
  opts->x_flag_zero_initialized_in_bss = 0;
163
}
164
 
165
/* Initialize for option processing.  */
166
 
167
static void
168
gnat_init_options (unsigned int decoded_options_count,
169
                   struct cl_decoded_option *decoded_options)
170
{
171
  /* Reconstruct an argv array for use of back_end.adb.
172
 
173
     ??? back_end.adb should not rely on this; instead, it should work with
174
     decoded options without such reparsing, to ensure consistency in how
175
     options are decoded.  */
176
  unsigned int i;
177
 
178
  save_argv = XNEWVEC (const char *, 2 * decoded_options_count + 1);
179
  save_argc = 0;
180
  for (i = 0; i < decoded_options_count; i++)
181
    {
182
      size_t num_elements = decoded_options[i].canonical_option_num_elements;
183
 
184
      if (decoded_options[i].errors
185
          || decoded_options[i].opt_index == OPT_SPECIAL_unknown
186
          || num_elements == 0)
187
        continue;
188
 
189
      /* Deal with -I- specially since it must be a single switch.  */
190
      if (decoded_options[i].opt_index == OPT_I
191
          && num_elements == 2
192
          && decoded_options[i].canonical_option[1][0] == '-'
193
          && decoded_options[i].canonical_option[1][1] == '\0')
194
        save_argv[save_argc++] = "-I-";
195
      else
196
        {
197
          gcc_assert (num_elements >= 1 && num_elements <= 2);
198
          save_argv[save_argc++] = decoded_options[i].canonical_option[0];
199
          if (num_elements >= 2)
200
            save_argv[save_argc++] = decoded_options[i].canonical_option[1];
201
        }
202
    }
203
  save_argv[save_argc] = NULL;
204
 
205
  gnat_argv = (char **) xmalloc (sizeof (save_argv[0]));
206
  gnat_argv[0] = xstrdup (save_argv[0]);     /* name of the command */
207
  gnat_argc = 1;
208
}
209
 
210
/* Ada code requires variables for these settings rather than elements
211
   of the global_options structure.  */
212
#undef optimize
213
#undef optimize_size
214
#undef flag_compare_debug
215
#undef flag_stack_check
216
int optimize;
217
int optimize_size;
218
int flag_compare_debug;
219
enum stack_check_type flag_stack_check = NO_STACK_CHECK;
220
 
221
/* Post-switch processing.  */
222
 
223
static bool
224
gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
225
{
226
  /* Excess precision other than "fast" requires front-end support.  */
227
  if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD
228
      && TARGET_FLT_EVAL_METHOD_NON_DEFAULT)
229
    sorry ("-fexcess-precision=standard for Ada");
230
  flag_excess_precision_cmdline = EXCESS_PRECISION_FAST;
231
 
232
  /* ??? The warning machinery is outsmarted by Ada.  */
233
  warn_unused_parameter = 0;
234
 
235
  /* No psABI change warnings for Ada.  */
236
  warn_psabi = 0;
237
 
238
  optimize = global_options.x_optimize;
239
  optimize_size = global_options.x_optimize_size;
240
  flag_compare_debug = global_options.x_flag_compare_debug;
241
  flag_stack_check = global_options.x_flag_stack_check;
242
 
243
  return false;
244
}
245
 
246
/* Here is the function to handle the compiler error processing in GCC.  */
247
 
248
static void
249
internal_error_function (diagnostic_context *context,
250
                         const char *msgid, va_list *ap)
251
{
252
  text_info tinfo;
253
  char *buffer, *p, *loc;
254
  String_Template temp, temp_loc;
255
  Fat_Pointer fp, fp_loc;
256
  expanded_location s;
257
 
258
  /* Warn if plugins present.  */
259
  warn_if_plugins ();
260
 
261
  /* Reset the pretty-printer.  */
262
  pp_clear_output_area (context->printer);
263
 
264
  /* Format the message into the pretty-printer.  */
265
  tinfo.format_spec = msgid;
266
  tinfo.args_ptr = ap;
267
  tinfo.err_no = errno;
268
  pp_format_verbatim (context->printer, &tinfo);
269
 
270
  /* Extract a (writable) pointer to the formatted text.  */
271
  buffer = xstrdup (pp_formatted_text (context->printer));
272
 
273
  /* Go up to the first newline.  */
274
  for (p = buffer; *p; p++)
275
    if (*p == '\n')
276
      {
277
        *p = '\0';
278
        break;
279
      }
280
 
281
  temp.Low_Bound = 1;
282
  temp.High_Bound = p - buffer;
283
  fp.Bounds = &temp;
284
  fp.Array = buffer;
285
 
286
  s = expand_location (input_location);
287
  if (context->show_column && s.column != 0)
288
    asprintf (&loc, "%s:%d:%d", s.file, s.line, s.column);
289
  else
290
    asprintf (&loc, "%s:%d", s.file, s.line);
291
  temp_loc.Low_Bound = 1;
292
  temp_loc.High_Bound = strlen (loc);
293
  fp_loc.Bounds = &temp_loc;
294
  fp_loc.Array = loc;
295
 
296
  Current_Error_Node = error_gnat_node;
297
  Compiler_Abort (fp, -1, fp_loc);
298
}
299
 
300
/* Perform all the initialization steps that are language-specific.  */
301
 
302
static bool
303
gnat_init (void)
304
{
305
  /* Do little here, most of the standard declarations are set up after the
306
     front-end has been run.  Use the same `char' as C, this doesn't really
307
     matter since we'll use the explicit `unsigned char' for Character.  */
308
  build_common_tree_nodes (flag_signed_char, false);
309
 
310
  /* In Ada, we use an unsigned 8-bit type for the default boolean type.  */
311
  boolean_type_node = make_unsigned_type (8);
312
  TREE_SET_CODE (boolean_type_node, BOOLEAN_TYPE);
313
  SET_TYPE_RM_MAX_VALUE (boolean_type_node,
314
                         build_int_cst (boolean_type_node, 1));
315
  SET_TYPE_RM_SIZE (boolean_type_node, bitsize_int (1));
316
  boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
317
  boolean_false_node = TYPE_MIN_VALUE (boolean_type_node);
318
 
319
  sbitsize_one_node = sbitsize_int (1);
320
  sbitsize_unit_node = sbitsize_int (BITS_PER_UNIT);
321
 
322
  ptr_void_type_node = build_pointer_type (void_type_node);
323
 
324
  /* Show that REFERENCE_TYPEs are internal and should be Pmode.  */
325
  internal_reference_types ();
326
 
327
  /* Register our internal error function.  */
328
  global_dc->internal_error = &internal_error_function;
329
 
330
  return true;
331
}
332
 
333
/* If we are using the GCC mechanism to process exception handling, we
334
   have to register the personality routine for Ada and to initialize
335
   various language dependent hooks.  */
336
 
337
void
338
gnat_init_gcc_eh (void)
339
{
340
  /* We shouldn't do anything if the No_Exceptions_Handler pragma is set,
341
     though. This could for instance lead to the emission of tables with
342
     references to symbols (such as the Ada eh personality routine) within
343
     libraries we won't link against.  */
344
  if (No_Exception_Handlers_Set ())
345
    return;
346
 
347
  /* Tell GCC we are handling cleanup actions through exception propagation.
348
     This opens possibilities that we don't take advantage of yet, but is
349
     nonetheless necessary to ensure that fixup code gets assigned to the
350
     right exception regions.  */
351
  using_eh_for_cleanups ();
352
 
353
  /* Turn on -fexceptions and -fnon-call-exceptions.  The first one triggers
354
     the generation of the necessary exception tables.  The second one is
355
     useful for two reasons: 1/ we map some asynchronous signals like SEGV to
356
     exceptions, so we need to ensure that the insns which can lead to such
357
     signals are correctly attached to the exception region they pertain to,
358
     2/ Some calls to pure subprograms are handled as libcall blocks and then
359
     marked as "cannot trap" if the flag is not set (see emit_libcall_block).
360
     We should not let this be since it is possible for such calls to actually
361
     raise in Ada.  */
362
  flag_exceptions = 1;
363
  flag_non_call_exceptions = 1;
364
 
365
  init_eh ();
366
}
367
 
368
/* Print language-specific items in declaration NODE.  */
369
 
370
static void
371
gnat_print_decl (FILE *file, tree node, int indent)
372
{
373
  switch (TREE_CODE (node))
374
    {
375
    case CONST_DECL:
376
      print_node (file, "corresponding var",
377
                  DECL_CONST_CORRESPONDING_VAR (node), indent + 4);
378
      break;
379
 
380
    case FIELD_DECL:
381
      print_node (file, "original field", DECL_ORIGINAL_FIELD (node),
382
                  indent + 4);
383
      break;
384
 
385
    case VAR_DECL:
386
      if (DECL_LOOP_PARM_P (node))
387
        print_node (file, "induction var", DECL_INDUCTION_VAR (node),
388
                    indent + 4);
389
      else
390
        print_node (file, "renamed object", DECL_RENAMED_OBJECT (node),
391
                    indent + 4);
392
      break;
393
 
394
    default:
395
      break;
396
    }
397
}
398
 
399
/* Print language-specific items in type NODE.  */
400
 
401
static void
402
gnat_print_type (FILE *file, tree node, int indent)
403
{
404
  switch (TREE_CODE (node))
405
    {
406
    case FUNCTION_TYPE:
407
      print_node (file, "ci/co list", TYPE_CI_CO_LIST (node), indent + 4);
408
      break;
409
 
410
    case INTEGER_TYPE:
411
      if (TYPE_MODULAR_P (node))
412
        print_node_brief (file, "modulus", TYPE_MODULUS (node), indent + 4);
413
      else if (TYPE_HAS_ACTUAL_BOUNDS_P (node))
414
        print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node),
415
                    indent + 4);
416
      else if (TYPE_VAX_FLOATING_POINT_P (node))
417
        ;
418
      else
419
        print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4);
420
 
421
      /* ... fall through ... */
422
 
423
    case ENUMERAL_TYPE:
424
    case BOOLEAN_TYPE:
425
      print_node_brief (file, "RM size", TYPE_RM_SIZE (node), indent + 4);
426
 
427
      /* ... fall through ... */
428
 
429
    case REAL_TYPE:
430
      print_node_brief (file, "RM min", TYPE_RM_MIN_VALUE (node), indent + 4);
431
      print_node_brief (file, "RM max", TYPE_RM_MAX_VALUE (node), indent + 4);
432
      break;
433
 
434
    case ARRAY_TYPE:
435
      print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4);
436
      break;
437
 
438
    case VECTOR_TYPE:
439
      print_node (file,"representative array",
440
                  TYPE_REPRESENTATIVE_ARRAY (node), indent + 4);
441
      break;
442
 
443
    case RECORD_TYPE:
444
      if (TYPE_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node))
445
        print_node (file, "unconstrained array",
446
                    TYPE_UNCONSTRAINED_ARRAY (node), indent + 4);
447
      else
448
        print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
449
      break;
450
 
451
    case UNION_TYPE:
452
    case QUAL_UNION_TYPE:
453
      print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
454
      break;
455
 
456
    default:
457
      break;
458
    }
459
}
460
 
461
/* Return the name to be printed for DECL.  */
462
 
463
static const char *
464
gnat_printable_name (tree decl, int verbosity)
465
{
466
  const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl));
467
  char *ada_name = (char *) ggc_alloc_atomic (strlen (coded_name) * 2 + 60);
468
 
469
  __gnat_decode (coded_name, ada_name, 0);
470
 
471
  if (verbosity == 2 && !DECL_IS_BUILTIN (decl))
472
    {
473
      Set_Identifier_Casing (ada_name, DECL_SOURCE_FILE (decl));
474
      return ggc_strdup (Name_Buffer);
475
    }
476
 
477
  return ada_name;
478
}
479
 
480
/* Return the name to be used in DWARF debug info for DECL.  */
481
 
482
static const char *
483
gnat_dwarf_name (tree decl, int verbosity ATTRIBUTE_UNUSED)
484
{
485
  gcc_assert (DECL_P (decl));
486
  return (const char *) IDENTIFIER_POINTER (DECL_NAME (decl));
487
}
488
 
489
/* Return the descriptive type associated with TYPE, if any.  */
490
 
491
static tree
492
gnat_descriptive_type (const_tree type)
493
{
494
  if (TYPE_STUB_DECL (type))
495
    return DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type));
496
  else
497
    return NULL_TREE;
498
}
499
 
500
/* Return true if types T1 and T2 are identical for type hashing purposes.
501
   Called only after doing all language independent checks.  At present,
502
   this function is only called when both types are FUNCTION_TYPE.  */
503
 
504
static bool
505
gnat_type_hash_eq (const_tree t1, const_tree t2)
506
{
507
  gcc_assert (TREE_CODE (t1) == FUNCTION_TYPE);
508
  return fntype_same_flags_p (t1, TYPE_CI_CO_LIST (t2),
509
                              TYPE_RETURN_UNCONSTRAINED_P (t2),
510
                              TYPE_RETURN_BY_DIRECT_REF_P (t2),
511
                              TREE_ADDRESSABLE (t2));
512
}
513
 
514
/* Do nothing (return the tree node passed).  */
515
 
516
static tree
517
gnat_return_tree (tree t)
518
{
519
  return t;
520
}
521
 
522
/* Get the alias set corresponding to a type or expression.  */
523
 
524
static alias_set_type
525
gnat_get_alias_set (tree type)
526
{
527
  /* If this is a padding type, use the type of the first field.  */
528
  if (TYPE_IS_PADDING_P (type))
529
    return get_alias_set (TREE_TYPE (TYPE_FIELDS (type)));
530
 
531
  /* If the type is an unconstrained array, use the type of the
532
     self-referential array we make.  */
533
  else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
534
    return
535
      get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type)))));
536
 
537
  /* If the type can alias any other types, return the alias set 0.  */
538
  else if (TYPE_P (type)
539
           && TYPE_UNIVERSAL_ALIASING_P (TYPE_MAIN_VARIANT (type)))
540
    return 0;
541
 
542
  return -1;
543
}
544
 
545
/* GNU_TYPE is a type.  Return its maximum size in bytes, if known,
546
   as a constant when possible.  */
547
 
548
static tree
549
gnat_type_max_size (const_tree gnu_type)
550
{
551
  /* First see what we can get from TYPE_SIZE_UNIT, which might not
552
     be constant even for simple expressions if it has already been
553
     elaborated and possibly replaced by a VAR_DECL.  */
554
  tree max_unitsize = max_size (TYPE_SIZE_UNIT (gnu_type), true);
555
 
556
  /* If we don't have a constant, see what we can get from TYPE_ADA_SIZE,
557
     which should stay untouched.  */
558
  if (!host_integerp (max_unitsize, 1)
559
      && RECORD_OR_UNION_TYPE_P (gnu_type)
560
      && !TYPE_FAT_POINTER_P (gnu_type)
561
      && TYPE_ADA_SIZE (gnu_type))
562
    {
563
      tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true);
564
 
565
      /* If we have succeeded in finding a constant, round it up to the
566
         type's alignment and return the result in units.  */
567
      if (host_integerp (max_adasize, 1))
568
        max_unitsize
569
          = size_binop (CEIL_DIV_EXPR,
570
                        round_up (max_adasize, TYPE_ALIGN (gnu_type)),
571
                        bitsize_unit_node);
572
    }
573
 
574
  return max_unitsize;
575
}
576
 
577
/* GNU_TYPE is a subtype of an integral type.  Set LOWVAL to the low bound
578
   and HIGHVAL to the high bound, respectively.  */
579
 
580
static void
581
gnat_get_subrange_bounds (const_tree gnu_type, tree *lowval, tree *highval)
582
{
583
  *lowval = TYPE_MIN_VALUE (gnu_type);
584
  *highval = TYPE_MAX_VALUE (gnu_type);
585
}
586
 
587
/* GNU_TYPE is the type of a subprogram parameter.  Determine if it should be
588
   passed by reference by default.  */
589
 
590
bool
591
default_pass_by_ref (tree gnu_type)
592
{
593
  /* We pass aggregates by reference if they are sufficiently large.  The
594
     choice of constant here is somewhat arbitrary.  We also pass by
595
     reference if the target machine would either pass or return by
596
     reference.  Strictly speaking, we need only check the return if this
597
     is an In Out parameter, but it's probably best to err on the side of
598
     passing more things by reference.  */
599
 
600
  if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, true))
601
    return true;
602
 
603
  if (targetm.calls.return_in_memory (gnu_type, NULL_TREE))
604
    return true;
605
 
606
  if (AGGREGATE_TYPE_P (gnu_type)
607
      && (!host_integerp (TYPE_SIZE (gnu_type), 1)
608
          || 0 < compare_tree_int (TYPE_SIZE (gnu_type),
609
                                   8 * TYPE_ALIGN (gnu_type))))
610
    return true;
611
 
612
  return false;
613
}
614
 
615
/* GNU_TYPE is the type of a subprogram parameter.  Determine if it must be
616
   passed by reference.  */
617
 
618
bool
619
must_pass_by_ref (tree gnu_type)
620
{
621
  /* We pass only unconstrained objects, those required by the language
622
     to be passed by reference, and objects of variable size.  The latter
623
     is more efficient, avoids problems with variable size temporaries,
624
     and does not produce compatibility problems with C, since C does
625
     not have such objects.  */
626
  return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
627
          || TYPE_IS_BY_REFERENCE_P (gnu_type)
628
          || (TYPE_SIZE (gnu_type)
629
              && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST));
630
}
631
 
632
/* This function is called by the front-end to enumerate all the supported
633
   modes for the machine, as well as some predefined C types.  F is a function
634
   which is called back with the parameters as listed below, first a string,
635
   then six ints.  The name is any arbitrary null-terminated string and has
636
   no particular significance, except for the case of predefined C types, where
637
   it should be the name of the C type.  For integer types, only signed types
638
   should be listed, unsigned versions are assumed.  The order of types should
639
   be in order of preference, with the smallest/cheapest types first.
640
 
641
   In particular, C predefined types should be listed before other types,
642
   binary floating point types before decimal ones, and narrower/cheaper
643
   type versions before more expensive ones.  In type selection the first
644
   matching variant will be used.
645
 
646
   NAME         pointer to first char of type name
647
   DIGS         number of decimal digits for floating-point modes, else 0
648
   COMPLEX_P    nonzero is this represents a complex mode
649
   COUNT        count of number of items, nonzero for vector mode
650
   FLOAT_REP    Float_Rep_Kind for FP, otherwise undefined
651
   SIZE         number of bits used to store data
652
   ALIGN        number of bits to which mode is aligned.  */
653
 
654
void
655
enumerate_modes (void (*f) (const char *, int, int, int, int, int, int))
656
{
657
  const tree c_types[]
658
    = { float_type_node, double_type_node, long_double_type_node };
659
  const char *const c_names[]
660
    = { "float", "double", "long double" };
661
  int iloop;
662
 
663
  for (iloop = 0; iloop < NUM_MACHINE_MODES; iloop++)
664
    {
665
      enum machine_mode i = (enum machine_mode) iloop;
666
      enum machine_mode inner_mode = i;
667
      bool float_p = false;
668
      bool complex_p = false;
669
      bool vector_p = false;
670
      bool skip_p = false;
671
      int digs = 0;
672
      unsigned int nameloop;
673
      Float_Rep_Kind float_rep = IEEE_Binary; /* Until proven otherwise */
674
 
675
      switch (GET_MODE_CLASS (i))
676
        {
677
        case MODE_INT:
678
          break;
679
        case MODE_FLOAT:
680
          float_p = true;
681
          break;
682
        case MODE_COMPLEX_INT:
683
          complex_p = true;
684
          inner_mode = GET_MODE_INNER (i);
685
          break;
686
        case MODE_COMPLEX_FLOAT:
687
          float_p = true;
688
          complex_p = true;
689
          inner_mode = GET_MODE_INNER (i);
690
          break;
691
        case MODE_VECTOR_INT:
692
          vector_p = true;
693
          inner_mode = GET_MODE_INNER (i);
694
          break;
695
        case MODE_VECTOR_FLOAT:
696
          float_p = true;
697
          vector_p = true;
698
          inner_mode = GET_MODE_INNER (i);
699
          break;
700
        default:
701
          skip_p = true;
702
        }
703
 
704
      if (float_p)
705
        {
706
          const struct real_format *fmt = REAL_MODE_FORMAT (inner_mode);
707
 
708
          /* ??? Cope with the ghost XFmode of the ARM port.  */
709
          if (!fmt)
710
            continue;
711
 
712
          if (fmt->b == 2)
713
            digs = (fmt->p - 1) * 1233 / 4096; /* scale by log (2) */
714
 
715
          else if (fmt->b == 10)
716
            digs = fmt->p;
717
 
718
          else
719
            gcc_unreachable();
720
 
721
          if (fmt == &vax_f_format
722
              || fmt == &vax_d_format
723
              || fmt == &vax_g_format)
724
            float_rep = VAX_Native;
725
        }
726
 
727
      /* First register any C types for this mode that the front end
728
         may need to know about, unless the mode should be skipped.  */
729
 
730
      if (!skip_p)
731
        for (nameloop = 0; nameloop < ARRAY_SIZE (c_types); nameloop++)
732
          {
733
            tree typ = c_types[nameloop];
734
            const char *nam = c_names[nameloop];
735
 
736
            if (TYPE_MODE (typ) == i)
737
              {
738
                f (nam, digs, complex_p,
739
                   vector_p ? GET_MODE_NUNITS (i) : 0, float_rep,
740
                   TYPE_PRECISION (typ), TYPE_ALIGN (typ));
741
                skip_p = true;
742
              }
743
          }
744
 
745
      /* If no predefined C types were found, register the mode itself.  */
746
 
747
      if (!skip_p)
748
        f (GET_MODE_NAME (i), digs, complex_p,
749
           vector_p ? GET_MODE_NUNITS (i) : 0, float_rep,
750
           GET_MODE_PRECISION (i), GET_MODE_ALIGNMENT (i));
751
    }
752
}
753
 
754
/* Return the size of the FP mode with precision PREC.  */
755
 
756
int
757
fp_prec_to_size (int prec)
758
{
759
  enum machine_mode mode;
760
 
761
  for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
762
       mode = GET_MODE_WIDER_MODE (mode))
763
    if (GET_MODE_PRECISION (mode) == prec)
764
      return GET_MODE_BITSIZE (mode);
765
 
766
  gcc_unreachable ();
767
}
768
 
769
/* Return the precision of the FP mode with size SIZE.  */
770
 
771
int
772
fp_size_to_prec (int size)
773
{
774
  enum machine_mode mode;
775
 
776
  for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
777
       mode = GET_MODE_WIDER_MODE (mode))
778
    if (GET_MODE_BITSIZE (mode) == size)
779
      return GET_MODE_PRECISION (mode);
780
 
781
  gcc_unreachable ();
782
}
783
 
784
static GTY(()) tree gnat_eh_personality_decl;
785
 
786
/* Return the GNAT personality function decl.  */
787
 
788
static tree
789
gnat_eh_personality (void)
790
{
791
  if (!gnat_eh_personality_decl)
792
    gnat_eh_personality_decl = build_personality_function ("gnat");
793
  return gnat_eh_personality_decl;
794
}
795
 
796
/* Initialize language-specific bits of tree_contains_struct.  */
797
 
798
static void
799
gnat_init_ts (void)
800
{
801
  MARK_TS_COMMON (UNCONSTRAINED_ARRAY_TYPE);
802
 
803
  MARK_TS_TYPED (UNCONSTRAINED_ARRAY_REF);
804
  MARK_TS_TYPED (NULL_EXPR);
805
  MARK_TS_TYPED (PLUS_NOMOD_EXPR);
806
  MARK_TS_TYPED (MINUS_NOMOD_EXPR);
807
  MARK_TS_TYPED (ATTR_ADDR_EXPR);
808
  MARK_TS_TYPED (STMT_STMT);
809
  MARK_TS_TYPED (LOOP_STMT);
810
  MARK_TS_TYPED (EXIT_STMT);
811
}
812
 
813
/* Definitions for our language-specific hooks.  */
814
 
815
#undef  LANG_HOOKS_NAME
816
#define LANG_HOOKS_NAME                 "GNU Ada"
817
#undef  LANG_HOOKS_IDENTIFIER_SIZE
818
#define LANG_HOOKS_IDENTIFIER_SIZE      sizeof (struct tree_identifier)
819
#undef  LANG_HOOKS_INIT
820
#define LANG_HOOKS_INIT                 gnat_init
821
#undef  LANG_HOOKS_OPTION_LANG_MASK
822
#define LANG_HOOKS_OPTION_LANG_MASK     gnat_option_lang_mask
823
#undef  LANG_HOOKS_INIT_OPTIONS_STRUCT
824
#define LANG_HOOKS_INIT_OPTIONS_STRUCT  gnat_init_options_struct
825
#undef  LANG_HOOKS_INIT_OPTIONS
826
#define LANG_HOOKS_INIT_OPTIONS         gnat_init_options
827
#undef  LANG_HOOKS_HANDLE_OPTION
828
#define LANG_HOOKS_HANDLE_OPTION        gnat_handle_option
829
#undef  LANG_HOOKS_POST_OPTIONS
830
#define LANG_HOOKS_POST_OPTIONS         gnat_post_options
831
#undef  LANG_HOOKS_PARSE_FILE
832
#define LANG_HOOKS_PARSE_FILE           gnat_parse_file
833
#undef  LANG_HOOKS_TYPE_HASH_EQ
834
#define LANG_HOOKS_TYPE_HASH_EQ         gnat_type_hash_eq
835
#undef  LANG_HOOKS_GETDECLS
836
#define LANG_HOOKS_GETDECLS             lhd_return_null_tree_v
837
#undef  LANG_HOOKS_PUSHDECL
838
#define LANG_HOOKS_PUSHDECL             gnat_return_tree
839
#undef  LANG_HOOKS_WRITE_GLOBALS
840
#define LANG_HOOKS_WRITE_GLOBALS        gnat_write_global_declarations
841
#undef  LANG_HOOKS_GET_ALIAS_SET
842
#define LANG_HOOKS_GET_ALIAS_SET        gnat_get_alias_set
843
#undef  LANG_HOOKS_PRINT_DECL
844
#define LANG_HOOKS_PRINT_DECL           gnat_print_decl
845
#undef  LANG_HOOKS_PRINT_TYPE
846
#define LANG_HOOKS_PRINT_TYPE           gnat_print_type
847
#undef  LANG_HOOKS_TYPE_MAX_SIZE
848
#define LANG_HOOKS_TYPE_MAX_SIZE        gnat_type_max_size
849
#undef  LANG_HOOKS_DECL_PRINTABLE_NAME
850
#define LANG_HOOKS_DECL_PRINTABLE_NAME  gnat_printable_name
851
#undef  LANG_HOOKS_DWARF_NAME
852
#define LANG_HOOKS_DWARF_NAME           gnat_dwarf_name
853
#undef  LANG_HOOKS_GIMPLIFY_EXPR
854
#define LANG_HOOKS_GIMPLIFY_EXPR        gnat_gimplify_expr
855
#undef  LANG_HOOKS_TYPE_FOR_MODE
856
#define LANG_HOOKS_TYPE_FOR_MODE        gnat_type_for_mode
857
#undef  LANG_HOOKS_TYPE_FOR_SIZE
858
#define LANG_HOOKS_TYPE_FOR_SIZE        gnat_type_for_size
859
#undef  LANG_HOOKS_TYPES_COMPATIBLE_P
860
#define LANG_HOOKS_TYPES_COMPATIBLE_P   gnat_types_compatible_p
861
#undef  LANG_HOOKS_GET_SUBRANGE_BOUNDS
862
#define LANG_HOOKS_GET_SUBRANGE_BOUNDS  gnat_get_subrange_bounds
863
#undef  LANG_HOOKS_DESCRIPTIVE_TYPE
864
#define LANG_HOOKS_DESCRIPTIVE_TYPE     gnat_descriptive_type
865
#undef  LANG_HOOKS_ATTRIBUTE_TABLE
866
#define LANG_HOOKS_ATTRIBUTE_TABLE      gnat_internal_attribute_table
867
#undef  LANG_HOOKS_BUILTIN_FUNCTION
868
#define LANG_HOOKS_BUILTIN_FUNCTION     gnat_builtin_function
869
#undef  LANG_HOOKS_EH_PERSONALITY
870
#define LANG_HOOKS_EH_PERSONALITY       gnat_eh_personality
871
#undef  LANG_HOOKS_DEEP_UNSHARING
872
#define LANG_HOOKS_DEEP_UNSHARING       true
873
#undef  LANG_HOOKS_INIT_TS
874
#define LANG_HOOKS_INIT_TS              gnat_init_ts
875
 
876
struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
877
 
878
#include "gt-ada-misc.h"

powered by: WebSVN 2.1.0

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