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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [gcc-interface/] [misc.c] - Blame information for rev 281

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
/****************************************************************************
2
 *                                                                          *
3
 *                         GNAT COMPILER COMPONENTS                         *
4
 *                                                                          *
5
 *                                 M I S C                                  *
6
 *                                                                          *
7
 *                           C Implementation File                          *
8
 *                                                                          *
9
 *          Copyright (C) 1992-2009, 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
/* This file contains parts of the compiler that are required for interfacing
27
   with GCC but otherwise do nothing and parts of Gigi that need to know
28
   about RTL.  */
29
 
30
#include "config.h"
31
#include "system.h"
32
#include "coretypes.h"
33
#include "tm.h"
34
#include "tree.h"
35
#include "diagnostic.h"
36
#include "target.h"
37
#include "expr.h"
38
#include "libfuncs.h"
39
#include "ggc.h"
40
#include "flags.h"
41
#include "debug.h"
42
#include "cgraph.h"
43
#include "optabs.h"
44
#include "toplev.h"
45
#include "except.h"
46
#include "langhooks.h"
47
#include "langhooks-def.h"
48
#include "opts.h"
49
#include "options.h"
50
#include "tree-inline.h"
51
 
52
#include "ada.h"
53
#include "adadecode.h"
54
#include "types.h"
55
#include "atree.h"
56
#include "elists.h"
57
#include "namet.h"
58
#include "nlists.h"
59
#include "stringt.h"
60
#include "uintp.h"
61
#include "fe.h"
62
#include "sinfo.h"
63
#include "einfo.h"
64
#include "ada-tree.h"
65
#include "gigi.h"
66
 
67
static bool gnat_init                   (void);
68
static unsigned int gnat_init_options   (unsigned int, const char **);
69
static int gnat_handle_option           (size_t, const char *, int);
70
static bool gnat_post_options           (const char **);
71
static alias_set_type gnat_get_alias_set (tree);
72
static void gnat_print_decl             (FILE *, tree, int);
73
static void gnat_print_type             (FILE *, tree, int);
74
static const char *gnat_printable_name  (tree, int);
75
static const char *gnat_dwarf_name      (tree, int);
76
static tree gnat_return_tree            (tree);
77
static int gnat_eh_type_covers          (tree, tree);
78
static void gnat_parse_file             (int);
79
static void internal_error_function     (const char *, va_list *);
80
static tree gnat_type_max_size          (const_tree);
81
static void gnat_get_subrange_bounds    (const_tree, tree *, tree *);
82
static tree gnat_eh_personality         (void);
83
 
84
/* Definitions for our language-specific hooks.  */
85
 
86
#undef  LANG_HOOKS_NAME
87
#define LANG_HOOKS_NAME                 "GNU Ada"
88
#undef  LANG_HOOKS_IDENTIFIER_SIZE
89
#define LANG_HOOKS_IDENTIFIER_SIZE      sizeof (struct tree_identifier)
90
#undef  LANG_HOOKS_INIT
91
#define LANG_HOOKS_INIT                 gnat_init
92
#undef  LANG_HOOKS_INIT_OPTIONS
93
#define LANG_HOOKS_INIT_OPTIONS         gnat_init_options
94
#undef  LANG_HOOKS_HANDLE_OPTION
95
#define LANG_HOOKS_HANDLE_OPTION        gnat_handle_option
96
#undef  LANG_HOOKS_POST_OPTIONS
97
#define LANG_HOOKS_POST_OPTIONS         gnat_post_options
98
#undef  LANG_HOOKS_PARSE_FILE
99
#define LANG_HOOKS_PARSE_FILE           gnat_parse_file
100
#undef  LANG_HOOKS_HASH_TYPES
101
#define LANG_HOOKS_HASH_TYPES           false
102
#undef  LANG_HOOKS_GETDECLS
103
#define LANG_HOOKS_GETDECLS             lhd_return_null_tree_v
104
#undef  LANG_HOOKS_PUSHDECL
105
#define LANG_HOOKS_PUSHDECL             gnat_return_tree
106
#undef  LANG_HOOKS_WRITE_GLOBALS
107
#define LANG_HOOKS_WRITE_GLOBALS        gnat_write_global_declarations
108
#undef  LANG_HOOKS_GET_ALIAS_SET
109
#define LANG_HOOKS_GET_ALIAS_SET        gnat_get_alias_set
110
#undef  LANG_HOOKS_PRINT_DECL
111
#define LANG_HOOKS_PRINT_DECL           gnat_print_decl
112
#undef  LANG_HOOKS_PRINT_TYPE
113
#define LANG_HOOKS_PRINT_TYPE           gnat_print_type
114
#undef  LANG_HOOKS_TYPE_MAX_SIZE
115
#define LANG_HOOKS_TYPE_MAX_SIZE        gnat_type_max_size
116
#undef  LANG_HOOKS_DECL_PRINTABLE_NAME
117
#define LANG_HOOKS_DECL_PRINTABLE_NAME  gnat_printable_name
118
#undef  LANG_HOOKS_DWARF_NAME
119
#define LANG_HOOKS_DWARF_NAME           gnat_dwarf_name
120
#undef  LANG_HOOKS_GIMPLIFY_EXPR
121
#define LANG_HOOKS_GIMPLIFY_EXPR        gnat_gimplify_expr
122
#undef  LANG_HOOKS_TYPE_FOR_MODE
123
#define LANG_HOOKS_TYPE_FOR_MODE        gnat_type_for_mode
124
#undef  LANG_HOOKS_TYPE_FOR_SIZE
125
#define LANG_HOOKS_TYPE_FOR_SIZE        gnat_type_for_size
126
#undef  LANG_HOOKS_TYPES_COMPATIBLE_P
127
#define LANG_HOOKS_TYPES_COMPATIBLE_P   gnat_types_compatible_p
128
#undef  LANG_HOOKS_GET_SUBRANGE_BOUNDS
129
#define LANG_HOOKS_GET_SUBRANGE_BOUNDS  gnat_get_subrange_bounds
130
#undef  LANG_HOOKS_ATTRIBUTE_TABLE
131
#define LANG_HOOKS_ATTRIBUTE_TABLE      gnat_internal_attribute_table
132
#undef  LANG_HOOKS_BUILTIN_FUNCTION
133
#define LANG_HOOKS_BUILTIN_FUNCTION     gnat_builtin_function
134
#undef  LANG_HOOKS_EH_PERSONALITY
135
#define LANG_HOOKS_EH_PERSONALITY       gnat_eh_personality
136
 
137
struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
138
 
139
/* How much we want of our DWARF extensions.  Some of our dwarf+ extensions
140
   are incompatible with regular GDB versions, so we must make sure to only
141
   produce them on explicit request.  This is eventually reflected into the
142
   use_gnu_debug_info_extensions common flag for later processing.  */
143
static int gnat_dwarf_extensions = 0;
144
 
145
/* Command-line argc and argv.  These variables are global
146
   since they are imported in back_end.adb.  */
147
unsigned int save_argc;
148
const char **save_argv;
149
 
150
/* GNAT argc and argv.  */
151
extern int gnat_argc;
152
extern char **gnat_argv;
153
 
154
/* Declare functions we use as part of startup.  */
155
extern void __gnat_initialize           (void *);
156
extern void __gnat_install_SEH_handler  (void *);
157
extern void adainit                     (void);
158
extern void _ada_gnat1drv               (void);
159
 
160
/* The parser for the language.  For us, we process the GNAT tree.  */
161
 
162
static void
163
gnat_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
164
{
165
  int seh[2];
166
 
167
  /* Call the target specific initializations.  */
168
  __gnat_initialize (NULL);
169
 
170
  /* ??? Call the SEH initialization routine.  This is to workaround
171
  a bootstrap path problem.  The call below should be removed at some
172
  point and the SEH pointer passed to __gnat_initialize() above.  */
173
  __gnat_install_SEH_handler((void *)seh);
174
 
175
  /* Call the front-end elaboration procedures.  */
176
  adainit ();
177
 
178
  /* Call the front end.  */
179
  _ada_gnat1drv ();
180
}
181
 
182
/* Decode all the language specific options that cannot be decoded by GCC.
183
   The option decoding phase of GCC calls this routine on the flags that
184
   it cannot decode.  Return the number of consecutive arguments from ARGV
185
   that have been successfully decoded or 0 on failure.  */
186
 
187
static int
188
gnat_handle_option (size_t scode, const char *arg, int value)
189
{
190
  const struct cl_option *option = &cl_options[scode];
191
  enum opt_code code = (enum opt_code) scode;
192
  char *q;
193
 
194
  if (arg == NULL && (option->flags & (CL_JOINED | CL_SEPARATE)))
195
    {
196
      error ("missing argument to \"-%s\"", option->opt_text);
197
      return 1;
198
    }
199
 
200
  switch (code)
201
    {
202
    case OPT_I:
203
      q = XNEWVEC (char, sizeof("-I") + strlen (arg));
204
      strcpy (q, "-I");
205
      strcat (q, arg);
206
      gnat_argv[gnat_argc] = q;
207
      gnat_argc++;
208
      break;
209
 
210
    case OPT_Wall:
211
      warn_unused = value;
212
 
213
      /* We save the value of warn_uninitialized, since if they put
214
         -Wuninitialized on the command line, we need to generate a
215
         warning about not using it without also specifying -O.  */
216
      if (warn_uninitialized != 1)
217
        warn_uninitialized = (value ? 2 : 0);
218
      break;
219
 
220
      /* These are used in the GCC Makefile.  */
221
    case OPT_Wmissing_prototypes:
222
    case OPT_Wstrict_prototypes:
223
    case OPT_Wwrite_strings:
224
    case OPT_Wlong_long:
225
    case OPT_Wvariadic_macros:
226
    case OPT_Wold_style_definition:
227
    case OPT_Wmissing_format_attribute:
228
    case OPT_Woverlength_strings:
229
      break;
230
 
231
      /* This is handled by the front-end.  */
232
    case OPT_nostdinc:
233
      break;
234
 
235
    case OPT_nostdlib:
236
      gnat_argv[gnat_argc] = xstrdup ("-nostdlib");
237
      gnat_argc++;
238
      break;
239
 
240
    case OPT_feliminate_unused_debug_types:
241
      /* We arrange for post_option to be able to only set the corresponding
242
         flag to 1 when explicitly requested by the user.  We expect the
243
         default flag value to be either 0 or positive, and expose a positive
244
         -f as a negative value to post_option.  */
245
      flag_eliminate_unused_debug_types = -value;
246
      break;
247
 
248
    case OPT_fRTS_:
249
      gnat_argv[gnat_argc] = xstrdup ("-fRTS");
250
      gnat_argc++;
251
      break;
252
 
253
    case OPT_gant:
254
      warning (0, "%<-gnat%> misspelled as %<-gant%>");
255
 
256
      /* ... fall through ... */
257
 
258
    case OPT_gnat:
259
      /* Recopy the switches without the 'gnat' prefix.  */
260
      gnat_argv[gnat_argc] = XNEWVEC (char, strlen (arg) + 2);
261
      gnat_argv[gnat_argc][0] = '-';
262
      strcpy (gnat_argv[gnat_argc] + 1, arg);
263
      gnat_argc++;
264
      break;
265
 
266
    case OPT_gnatO:
267
      gnat_argv[gnat_argc] = xstrdup ("-O");
268
      gnat_argc++;
269
      gnat_argv[gnat_argc] = xstrdup (arg);
270
      gnat_argc++;
271
      break;
272
 
273
    case OPT_gdwarfplus:
274
      gnat_dwarf_extensions = 1;
275
      break;
276
 
277
    default:
278
      gcc_unreachable ();
279
    }
280
 
281
  return 1;
282
}
283
 
284
/* Initialize for option processing.  */
285
 
286
static unsigned int
287
gnat_init_options (unsigned int argc, const char **argv)
288
{
289
  /* Initialize gnat_argv with save_argv size.  */
290
  gnat_argv = (char **) xmalloc ((argc + 1) * sizeof (argv[0]));
291
  gnat_argv[0] = xstrdup (argv[0]);     /* name of the command */
292
  gnat_argc = 1;
293
 
294
  save_argc = argc;
295
  save_argv = argv;
296
 
297
  /* Uninitialized really means uninitialized in Ada.  */
298
  flag_zero_initialized_in_bss = 0;
299
 
300
  return CL_Ada;
301
}
302
 
303
/* Post-switch processing.  */
304
 
305
bool
306
gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
307
{
308
  /* Excess precision other than "fast" requires front-end
309
     support.  */
310
  if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD
311
      && TARGET_FLT_EVAL_METHOD_NON_DEFAULT)
312
    sorry ("-fexcess-precision=standard for Ada");
313
  flag_excess_precision_cmdline = EXCESS_PRECISION_FAST;
314
 
315
  /* ??? The warning machinery is outsmarted by Ada.  */
316
  warn_unused_parameter = 0;
317
 
318
  /* No psABI change warnings for Ada.  */
319
  warn_psabi = 0;
320
 
321
  /* Force eliminate_unused_debug_types to 0 unless an explicit positive
322
     -f has been passed.  This forces the default to 0 for Ada, which might
323
     differ from the common default.  */
324
  if (flag_eliminate_unused_debug_types < 0)
325
    flag_eliminate_unused_debug_types = 1;
326
  else
327
    flag_eliminate_unused_debug_types = 0;
328
 
329
  /* Reflect the explicit request of DWARF extensions into the common
330
     flag for use by later passes.  */
331
  if (write_symbols == DWARF2_DEBUG)
332
    use_gnu_debug_info_extensions = gnat_dwarf_extensions > 0;
333
 
334
  return false;
335
}
336
 
337
/* Here is the function to handle the compiler error processing in GCC.  */
338
 
339
static void
340
internal_error_function (const char *msgid, va_list *ap)
341
{
342
  text_info tinfo;
343
  char *buffer, *p, *loc;
344
  String_Template temp, temp_loc;
345
  Fat_Pointer fp, fp_loc;
346
  expanded_location s;
347
 
348
  /* Reset the pretty-printer.  */
349
  pp_clear_output_area (global_dc->printer);
350
 
351
  /* Format the message into the pretty-printer.  */
352
  tinfo.format_spec = msgid;
353
  tinfo.args_ptr = ap;
354
  tinfo.err_no = errno;
355
  pp_format_verbatim (global_dc->printer, &tinfo);
356
 
357
  /* Extract a (writable) pointer to the formatted text.  */
358
  buffer = xstrdup (pp_formatted_text (global_dc->printer));
359
 
360
  /* Go up to the first newline.  */
361
  for (p = buffer; *p; p++)
362
    if (*p == '\n')
363
      {
364
        *p = '\0';
365
        break;
366
      }
367
 
368
  temp.Low_Bound = 1;
369
  temp.High_Bound = p - buffer;
370
  fp.Bounds = &temp;
371
  fp.Array = buffer;
372
 
373
  s = expand_location (input_location);
374
  if (flag_show_column && s.column != 0)
375
    asprintf (&loc, "%s:%d:%d", s.file, s.line, s.column);
376
  else
377
    asprintf (&loc, "%s:%d", s.file, s.line);
378
  temp_loc.Low_Bound = 1;
379
  temp_loc.High_Bound = strlen (loc);
380
  fp_loc.Bounds = &temp_loc;
381
  fp_loc.Array = loc;
382
 
383
  Current_Error_Node = error_gnat_node;
384
  Compiler_Abort (fp, -1, fp_loc);
385
}
386
 
387
/* Perform all the initialization steps that are language-specific.  */
388
 
389
static bool
390
gnat_init (void)
391
{
392
  /* Performs whatever initialization steps needed by the language-dependent
393
     lexical analyzer.  */
394
  gnat_init_decl_processing ();
395
 
396
  /* Add the input filename as the last argument.  */
397
  if (main_input_filename)
398
    {
399
      gnat_argv[gnat_argc] = xstrdup (main_input_filename);
400
      gnat_argc++;
401
      gnat_argv[gnat_argc] = NULL;
402
    }
403
 
404
  global_dc->internal_error = &internal_error_function;
405
 
406
  /* Show that REFERENCE_TYPEs are internal and should be Pmode.  */
407
  internal_reference_types ();
408
 
409
  return true;
410
}
411
 
412
/* If we are using the GCC mechanism to process exception handling, we
413
   have to register the personality routine for Ada and to initialize
414
   various language dependent hooks.  */
415
 
416
void
417
gnat_init_gcc_eh (void)
418
{
419
#ifdef DWARF2_UNWIND_INFO
420
  /* lang_dependent_init already called dwarf2out_frame_init if true.  */
421
  int dwarf2out_frame_initialized = dwarf2out_do_frame ();
422
#endif
423
 
424
  /* We shouldn't do anything if the No_Exceptions_Handler pragma is set,
425
     though. This could for instance lead to the emission of tables with
426
     references to symbols (such as the Ada eh personality routine) within
427
     libraries we won't link against.  */
428
  if (No_Exception_Handlers_Set ())
429
    return;
430
 
431
  /* Tell GCC we are handling cleanup actions through exception propagation.
432
     This opens possibilities that we don't take advantage of yet, but is
433
     nonetheless necessary to ensure that fixup code gets assigned to the
434
     right exception regions.  */
435
  using_eh_for_cleanups ();
436
 
437
  lang_eh_type_covers = gnat_eh_type_covers;
438
 
439
  /* Turn on -fexceptions and -fnon-call-exceptions. The first one triggers
440
     the generation of the necessary exception runtime tables. The second one
441
     is useful for two reasons: 1/ we map some asynchronous signals like SEGV
442
     to exceptions, so we need to ensure that the insns which can lead to such
443
     signals are correctly attached to the exception region they pertain to,
444
     2/ Some calls to pure subprograms are handled as libcall blocks and then
445
     marked as "cannot trap" if the flag is not set (see emit_libcall_block).
446
     We should not let this be since it is possible for such calls to actually
447
     raise in Ada.  */
448
  flag_exceptions = 1;
449
  flag_non_call_exceptions = 1;
450
 
451
  init_eh ();
452
#ifdef DWARF2_UNWIND_INFO
453
  if (!dwarf2out_frame_initialized && dwarf2out_do_frame ())
454
    dwarf2out_frame_init ();
455
#endif
456
}
457
 
458
/* Print language-specific items in declaration NODE.  */
459
 
460
static void
461
gnat_print_decl (FILE *file, tree node, int indent)
462
{
463
  switch (TREE_CODE (node))
464
    {
465
    case CONST_DECL:
466
      print_node (file, "corresponding var",
467
                  DECL_CONST_CORRESPONDING_VAR (node), indent + 4);
468
      break;
469
 
470
    case FIELD_DECL:
471
      print_node (file, "original field", DECL_ORIGINAL_FIELD (node),
472
                  indent + 4);
473
      break;
474
 
475
    case VAR_DECL:
476
      print_node (file, "renamed object", DECL_RENAMED_OBJECT (node),
477
                  indent + 4);
478
      break;
479
 
480
    default:
481
      break;
482
    }
483
}
484
 
485
/* Print language-specific items in type NODE.  */
486
 
487
static void
488
gnat_print_type (FILE *file, tree node, int indent)
489
{
490
  switch (TREE_CODE (node))
491
    {
492
    case FUNCTION_TYPE:
493
      print_node (file, "ci/co list", TYPE_CI_CO_LIST (node), indent + 4);
494
      break;
495
 
496
    case INTEGER_TYPE:
497
      if (TYPE_MODULAR_P (node))
498
        print_node_brief (file, "modulus", TYPE_MODULUS (node), indent + 4);
499
      else if (TYPE_HAS_ACTUAL_BOUNDS_P (node))
500
        print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node),
501
                    indent + 4);
502
      else if (TYPE_VAX_FLOATING_POINT_P (node))
503
        ;
504
      else
505
        print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4);
506
 
507
      /* ... fall through ... */
508
 
509
    case ENUMERAL_TYPE:
510
    case BOOLEAN_TYPE:
511
      print_node_brief (file, "RM size", TYPE_RM_SIZE (node), indent + 4);
512
 
513
      /* ... fall through ... */
514
 
515
    case REAL_TYPE:
516
      print_node_brief (file, "RM min", TYPE_RM_MIN_VALUE (node), indent + 4);
517
      print_node_brief (file, "RM max", TYPE_RM_MAX_VALUE (node), indent + 4);
518
      break;
519
 
520
    case ARRAY_TYPE:
521
      print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4);
522
      break;
523
 
524
    case VECTOR_TYPE:
525
      print_node (file,"representative array",
526
                  TYPE_REPRESENTATIVE_ARRAY (node), indent + 4);
527
      break;
528
 
529
    case RECORD_TYPE:
530
      if (TYPE_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node))
531
        print_node (file, "unconstrained array",
532
                    TYPE_UNCONSTRAINED_ARRAY (node), indent + 4);
533
      else
534
        print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
535
      break;
536
 
537
    case UNION_TYPE:
538
    case QUAL_UNION_TYPE:
539
      print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
540
      break;
541
 
542
    default:
543
      break;
544
    }
545
}
546
 
547
/* Return the name to be printed for DECL.  */
548
 
549
static const char *
550
gnat_printable_name (tree decl, int verbosity)
551
{
552
  const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl));
553
  char *ada_name = (char *) ggc_alloc (strlen (coded_name) * 2 + 60);
554
 
555
  __gnat_decode (coded_name, ada_name, 0);
556
 
557
  if (verbosity == 2 && !DECL_IS_BUILTIN (decl))
558
    {
559
      Set_Identifier_Casing (ada_name, DECL_SOURCE_FILE (decl));
560
      return ggc_strdup (Name_Buffer);
561
    }
562
 
563
  return ada_name;
564
}
565
 
566
/* Return the name to be used in DWARF debug info for DECL.  */
567
 
568
static const char *
569
gnat_dwarf_name (tree decl, int verbosity ATTRIBUTE_UNUSED)
570
{
571
  gcc_assert (DECL_P (decl));
572
  return (const char *) IDENTIFIER_POINTER (DECL_NAME (decl));
573
}
574
 
575
/* Do nothing (return the tree node passed).  */
576
 
577
static tree
578
gnat_return_tree (tree t)
579
{
580
  return t;
581
}
582
 
583
/* Return true if type A catches type B. Callback for flow analysis from
584
   the exception handling part of the back-end.  */
585
 
586
static int
587
gnat_eh_type_covers (tree a, tree b)
588
{
589
  /* a catches b if they represent the same exception id or if a
590
     is an "others".
591
 
592
     ??? integer_zero_node for "others" is hardwired in too many places
593
     currently.  */
594
  return (a == b || a == integer_zero_node);
595
}
596
 
597
/* Get the alias set corresponding to a type or expression.  */
598
 
599
static alias_set_type
600
gnat_get_alias_set (tree type)
601
{
602
  /* If this is a padding type, use the type of the first field.  */
603
  if (TYPE_IS_PADDING_P (type))
604
    return get_alias_set (TREE_TYPE (TYPE_FIELDS (type)));
605
 
606
  /* If the type is an unconstrained array, use the type of the
607
     self-referential array we make.  */
608
  else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
609
    return
610
      get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type)))));
611
 
612
  /* If the type can alias any other types, return the alias set 0.  */
613
  else if (TYPE_P (type)
614
           && TYPE_UNIVERSAL_ALIASING_P (TYPE_MAIN_VARIANT (type)))
615
    return 0;
616
 
617
  return -1;
618
}
619
 
620
/* GNU_TYPE is a type.  Return its maximum size in bytes, if known,
621
   as a constant when possible.  */
622
 
623
static tree
624
gnat_type_max_size (const_tree gnu_type)
625
{
626
  /* First see what we can get from TYPE_SIZE_UNIT, which might not
627
     be constant even for simple expressions if it has already been
628
     elaborated and possibly replaced by a VAR_DECL.  */
629
  tree max_unitsize = max_size (TYPE_SIZE_UNIT (gnu_type), true);
630
 
631
  /* If we don't have a constant, see what we can get from TYPE_ADA_SIZE,
632
     which should stay untouched.  */
633
  if (!host_integerp (max_unitsize, 1)
634
      && (TREE_CODE (gnu_type) == RECORD_TYPE
635
          || TREE_CODE (gnu_type) == UNION_TYPE
636
          || TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
637
      && TYPE_ADA_SIZE (gnu_type))
638
    {
639
      tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true);
640
 
641
      /* If we have succeeded in finding a constant, round it up to the
642
         type's alignment and return the result in units.  */
643
      if (host_integerp (max_adasize, 1))
644
        max_unitsize
645
          = size_binop (CEIL_DIV_EXPR,
646
                        round_up (max_adasize, TYPE_ALIGN (gnu_type)),
647
                        bitsize_unit_node);
648
    }
649
 
650
  return max_unitsize;
651
}
652
 
653
/* GNU_TYPE is a subtype of an integral type.  Set LOWVAL to the low bound
654
   and HIGHVAL to the high bound, respectively.  */
655
 
656
static void
657
gnat_get_subrange_bounds (const_tree gnu_type, tree *lowval, tree *highval)
658
{
659
  *lowval = TYPE_MIN_VALUE (gnu_type);
660
  *highval = TYPE_MAX_VALUE (gnu_type);
661
}
662
 
663
/* GNU_TYPE is a type. Determine if it should be passed by reference by
664
   default.  */
665
 
666
bool
667
default_pass_by_ref (tree gnu_type)
668
{
669
  /* We pass aggregates by reference if they are sufficiently large.  The
670
     choice of constant here is somewhat arbitrary.  We also pass by
671
     reference if the target machine would either pass or return by
672
     reference.  Strictly speaking, we need only check the return if this
673
     is an In Out parameter, but it's probably best to err on the side of
674
     passing more things by reference.  */
675
 
676
  if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, 1))
677
    return true;
678
 
679
  if (targetm.calls.return_in_memory (gnu_type, NULL_TREE))
680
    return true;
681
 
682
  if (AGGREGATE_TYPE_P (gnu_type)
683
      && (!host_integerp (TYPE_SIZE (gnu_type), 1)
684
          || 0 < compare_tree_int (TYPE_SIZE (gnu_type),
685
                                   8 * TYPE_ALIGN (gnu_type))))
686
    return true;
687
 
688
  return false;
689
}
690
 
691
/* GNU_TYPE is the type of a subprogram parameter.  Determine from the type if
692
   it should be passed by reference. */
693
 
694
bool
695
must_pass_by_ref (tree gnu_type)
696
{
697
  /* We pass only unconstrained objects, those required by the language
698
     to be passed by reference, and objects of variable size.  The latter
699
     is more efficient, avoids problems with variable size temporaries,
700
     and does not produce compatibility problems with C, since C does
701
     not have such objects.  */
702
  return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
703
          || (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type))
704
          || (TYPE_SIZE (gnu_type)
705
              && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST));
706
}
707
 
708
/* This function is called by the front end to enumerate all the supported
709
   modes for the machine.  We pass a function which is called back with
710
   the following integer parameters:
711
 
712
   FLOAT_P      nonzero if this represents a floating-point mode
713
   COMPLEX_P    nonzero is this represents a complex mode
714
   COUNT        count of number of items, nonzero for vector mode
715
   PRECISION    number of bits in data representation
716
   MANTISSA     number of bits in mantissa, if FP and known, else zero.
717
   SIZE         number of bits used to store data
718
   ALIGN        number of bits to which mode is aligned.  */
719
 
720
void
721
enumerate_modes (void (*f) (int, int, int, int, int, int, unsigned int))
722
{
723
  int iloop;
724
 
725
  for (iloop = 0; iloop < NUM_MACHINE_MODES; iloop++)
726
    {
727
      enum machine_mode i = (enum machine_mode) iloop;
728
      enum machine_mode j;
729
      bool float_p = 0;
730
      bool complex_p = 0;
731
      bool vector_p = 0;
732
      bool skip_p = 0;
733
      int mantissa = 0;
734
      enum machine_mode inner_mode = i;
735
 
736
      switch (GET_MODE_CLASS (i))
737
        {
738
        case MODE_INT:
739
          break;
740
        case MODE_FLOAT:
741
          float_p = 1;
742
          break;
743
        case MODE_COMPLEX_INT:
744
          complex_p = 1;
745
          inner_mode = GET_MODE_INNER (i);
746
          break;
747
        case MODE_COMPLEX_FLOAT:
748
          float_p = 1;
749
          complex_p = 1;
750
          inner_mode = GET_MODE_INNER (i);
751
          break;
752
        case MODE_VECTOR_INT:
753
          vector_p = 1;
754
          inner_mode = GET_MODE_INNER (i);
755
          break;
756
        case MODE_VECTOR_FLOAT:
757
          float_p = 1;
758
          vector_p = 1;
759
          inner_mode = GET_MODE_INNER (i);
760
          break;
761
        default:
762
          skip_p = 1;
763
        }
764
 
765
      /* Skip this mode if it's one the front end doesn't need to know about
766
         (e.g., the CC modes) or if there is no add insn for that mode (or
767
         any wider mode), meaning it is not supported by the hardware.  If
768
         this a complex or vector mode, we care about the inner mode.  */
769
      for (j = inner_mode; j != VOIDmode; j = GET_MODE_WIDER_MODE (j))
770
        if (optab_handler (add_optab, j)->insn_code != CODE_FOR_nothing)
771
          break;
772
 
773
      if (float_p)
774
        {
775
          const struct real_format *fmt = REAL_MODE_FORMAT (inner_mode);
776
 
777
          mantissa = fmt->p;
778
        }
779
 
780
      if (!skip_p && j != VOIDmode)
781
        (*f) (float_p, complex_p, vector_p ? GET_MODE_NUNITS (i) : 0,
782
              GET_MODE_BITSIZE (i), mantissa,
783
              GET_MODE_SIZE (i) * BITS_PER_UNIT, GET_MODE_ALIGNMENT (i));
784
    }
785
}
786
 
787
/* Return the size of the FP mode with precision PREC.  */
788
 
789
int
790
fp_prec_to_size (int prec)
791
{
792
  enum machine_mode mode;
793
 
794
  for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
795
       mode = GET_MODE_WIDER_MODE (mode))
796
    if (GET_MODE_PRECISION (mode) == prec)
797
      return GET_MODE_BITSIZE (mode);
798
 
799
  gcc_unreachable ();
800
}
801
 
802
/* Return the precision of the FP mode with size SIZE.  */
803
 
804
int
805
fp_size_to_prec (int size)
806
{
807
  enum machine_mode mode;
808
 
809
  for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
810
       mode = GET_MODE_WIDER_MODE (mode))
811
    if (GET_MODE_BITSIZE (mode) == size)
812
      return GET_MODE_PRECISION (mode);
813
 
814
  gcc_unreachable ();
815
}
816
 
817
static GTY(()) tree gnat_eh_personality_decl;
818
 
819
static tree
820
gnat_eh_personality (void)
821
{
822
  if (!gnat_eh_personality_decl)
823
    gnat_eh_personality_decl
824
      = build_personality_function (USING_SJLJ_EXCEPTIONS
825
                                    ? "__gnat_eh_personality_sj"
826
                                    : "__gnat_eh_personality");
827
 
828
  return gnat_eh_personality_decl;
829
}
830
 
831
#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.