gcc/m2/gm2-gcc/m2decl.cc

   1 /* m2decl.cc provides an interface to GCC decl trees.
   2
   3 Copyright (C) 2012-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius@glam.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Modula-2; see the file COPYING3.  If not see
  20 <http://www.gnu.org/licenses/>.  */
  21
  22 #include "gcc-consolidation.h"
  23
  24 #include "../gm2-lang.h"
  25 #include "../m2-tree.h"
  26
  27 #define m2decl_c
  28 #include "m2assert.h"
  29 #include "m2block.h"
  30 #include "m2decl.h"
  31 #include "m2expr.h"
  32 #include "m2tree.h"
  33 #include "m2treelib.h"
  34 #include "m2type.h"
  35 #include "m2convert.h"
  36
  37 extern GTY (()) tree current_function_decl;
  38
  39 /* Used in BuildStartFunctionType.  */
  40 static GTY (()) tree param_type_list;
  41 static GTY (()) tree param_list = NULL_TREE; /* Ready for the next time we
  42                                                 call/define a function.  */
  43 #if 0
  44 tree
  45 m2decl_DeclareM2linkStaticInitialization (location_t location,
  46                                           int ScaffoldStatic)
  47 {
  48   m2block_pushGlobalScope ();
  49   /* Generate: int M2LINK_StaticInitialization = ScaffoldStatic;  */
  50   tree init = m2decl_BuildIntegerConstant (ScaffoldStatic);
  51   tree static_init = m2decl_DeclareKnownVariable (location, "m2pim_M2LINK_StaticInitialization",
  52                                                   integer_type_node,
  53                                                   TRUE, FALSE, FALSE, TRUE, NULL_TREE, init);
  54   m2block_popGlobalScope ();
  55   return static_init;
  56 }
  57
  58
  59 tree
  60 m2decl_DeclareM2linkForcedModuleInitOrder (location_t location,
  61                                            const char *RuntimeOverride)
  62 {
  63   m2block_pushGlobalScope ();
  64   /* Generate: const char *ForcedModuleInitOrder = RuntimeOverride;  */
  65   tree ptr_to_char = build_pointer_type (char_type_node);
  66   TYPE_READONLY (ptr_to_char) = TRUE;
  67   tree init = m2decl_BuildPtrToTypeString (location, RuntimeOverride, ptr_to_char);
  68   tree forced_order = m2decl_DeclareKnownVariable (location, "m2pim_M2LINK_ForcedModuleInitOrder",
  69                                                    ptr_to_char,
  70                                                    TRUE, FALSE, FALSE, TRUE, NULL_TREE, init);
  71   m2block_popGlobalScope ();
  72   return forced_order;
  73 }
  74 #endif
  75
  76
  77 /* DeclareKnownVariable declares a variable to GCC.  */
  78
  79 tree
  80 m2decl_DeclareKnownVariable (location_t location, const char *name, tree type,
  81                              bool exported, bool imported, bool istemporary,
  82                              bool isglobal, tree scope, tree initial)
  83 {
  84   tree id;
  85   tree decl;
  86
  87   m2assert_AssertLocation (location);
  88   ASSERT (m2tree_is_type (type), type);
  89   ASSERT_BOOL (isglobal);
  90
  91   id = get_identifier (name);
  92   type = m2tree_skip_type_decl (type);
  93   decl = build_decl (location, VAR_DECL, id, type);
  94
  95   DECL_SOURCE_LOCATION (decl) = location;
  96
  97   DECL_EXTERNAL (decl) = imported;
  98   TREE_STATIC (decl) = isglobal;
  99   TREE_PUBLIC (decl) = exported || imported;
 100
 101   gcc_assert ((istemporary == 0) || (istemporary == 1));
 102
 103   /* The variable was not declared by GCC, but by the front end.  */
 104   DECL_ARTIFICIAL (decl) = istemporary;
 105   /* If istemporary then we don't want debug info for it.  */
 106   DECL_IGNORED_P (decl) = istemporary;
 107   /* If istemporary we don't want even the fancy names of those printed in
 108      -fdump-final-insns= dumps.  */
 109   DECL_NAMELESS (decl) = istemporary;
 110
 111   /* Make the variable writable.  */
 112   TREE_READONLY (decl) = 0;
 113
 114   DECL_CONTEXT (decl) = scope;
 115
 116   if (initial)
 117     DECL_INITIAL (decl) = initial;
 118
 119   m2block_pushDecl (decl);
 120
 121   if (DECL_SIZE (decl) == 0)
 122     error ("storage size of %qD has not been resolved", decl);
 123
 124   if ((TREE_PUBLIC (decl) == 0) && DECL_EXTERNAL (decl))
 125     internal_error ("inconsistent because %qs",
 126                     "PUBLIC_DECL(decl) == 0 && DECL_EXTERNAL(decl) == 1");
 127
 128   m2block_addDeclExpr (build_stmt (location, DECL_EXPR, decl));
 129
 130   return decl;
 131 }
 132
 133 /* DeclareKnownConstant - given a constant, value, of, type, create a
 134    constant in the GCC symbol table.  Note that the name of the
 135    constant is not used as _all_ constants are declared in the global
 136    scope.  The front end deals with scoping rules - here we declare
 137    all constants with no names in the global scope.  This allows
 138    M2SubExp and constant folding routines the liberty of operating
 139    with quadruples which all assume constants can always be
 140    referenced.  */
 141
 142 tree
 143 m2decl_DeclareKnownConstant (location_t location, tree type, tree value)
 144 {
 145   tree id = make_node (IDENTIFIER_NODE); /* Ignore the name of the constant. */
 146   tree decl;
 147
 148   m2assert_AssertLocation (location);
 149   m2expr_ConstantExpressionWarning (value);
 150   type = m2tree_skip_type_decl (type);
 151   layout_type (type);
 152
 153   decl = build_decl (location, CONST_DECL, id, type);
 154
 155   value = copy_node (value);
 156   TREE_TYPE (value) = type;
 157   DECL_INITIAL (decl) = value;
 158   TREE_TYPE (decl) = type;
 159   decl = m2block_global_constant (decl);
 160   return decl;
 161 }
 162
 163 /* BuildParameterDeclaration - creates and returns one parameter
 164    from, name, and, type.  It appends this parameter to the internal
 165    param_type_list.  */
 166
 167 tree
 168 m2decl_BuildParameterDeclaration (location_t location, char *name, tree type,
 169                                   bool isreference)
 170 {
 171   tree parm_decl;
 172
 173   m2assert_AssertLocation (location);
 174   ASSERT_BOOL (isreference);
 175   type = m2tree_skip_type_decl (type);
 176   layout_type (type);
 177   if (isreference)
 178     type = build_reference_type (type);
 179
 180   if (name == NULL)
 181     parm_decl = build_decl (location, PARM_DECL, NULL, type);
 182   else
 183     parm_decl = build_decl (location, PARM_DECL, get_identifier (name), type);
 184   DECL_ARG_TYPE (parm_decl) = type;
 185   if (isreference)
 186     TREE_READONLY (parm_decl) = TRUE;
 187
 188   param_list = chainon (parm_decl, param_list);
 189   layout_type (type);
 190   param_type_list = tree_cons (NULL_TREE, type, param_type_list);
 191   return parm_decl;
 192 }
 193
 194 /* BuildStartFunctionDeclaration - initializes global variables ready
 195    for building a function.  */
 196
 197 void
 198 m2decl_BuildStartFunctionDeclaration (bool uses_varargs)
 199 {
 200   if (uses_varargs)
 201     param_type_list = NULL_TREE;
 202   else
 203     param_type_list = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
 204   param_list = NULL_TREE; /* Ready for when we define a function.  */
 205 }
 206
 207 /* BuildEndFunctionDeclaration - build a function which will return a
 208    value of returntype.  The arguments have been created by
 209    BuildParameterDeclaration.  */
 210
 211 tree
 212 m2decl_BuildEndFunctionDeclaration (location_t location_begin,
 213                                     location_t location_end, const char *name,
 214                                     tree returntype, bool isexternal,
 215                                     bool isnested, bool ispublic, bool isnoreturn)
 216 {
 217   tree fntype;
 218   tree fndecl;
 219
 220   m2assert_AssertLocation (location_begin);
 221   m2assert_AssertLocation (location_end);
 222   ASSERT_BOOL (isexternal);
 223   ASSERT_BOOL (isnested);
 224   ASSERT_BOOL (ispublic);
 225   returntype = m2tree_skip_type_decl (returntype);
 226   /* The function type depends on the return type and type of args,
 227      both of which we have created in BuildParameterDeclaration */
 228   if (returntype == NULL_TREE)
 229     returntype = void_type_node;
 230   else if (TREE_CODE (returntype) == FUNCTION_TYPE)
 231     returntype = ptr_type_node;
 232
 233   fntype = build_function_type (returntype, param_type_list);
 234   fndecl = build_decl (location_begin, FUNCTION_DECL, get_identifier (name),
 235                        fntype);
 236
 237   if (isexternal)
 238     ASSERT_CONDITION (ispublic);
 239
 240   DECL_EXTERNAL (fndecl) = isexternal;
 241   TREE_PUBLIC (fndecl) = ispublic;
 242   TREE_STATIC (fndecl) = (!isexternal);
 243   DECL_ARGUMENTS (fndecl) = param_list;
 244   DECL_RESULT (fndecl)
 245       = build_decl (location_end, RESULT_DECL, NULL_TREE, returntype);
 246   DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
 247   TREE_TYPE (fndecl) = fntype;
 248   TREE_THIS_VOLATILE (fndecl) = isnoreturn;
 249
 250   DECL_SOURCE_LOCATION (fndecl) = location_begin;
 251
 252   /* Prevent the optimizer from removing it if it is public.  */
 253   if (TREE_PUBLIC (fndecl))
 254     gm2_mark_addressable (fndecl);
 255
 256   m2block_pushDecl (fndecl);
 257
 258   rest_of_decl_compilation (fndecl, 1, 0);
 259   param_list
 260       = NULL_TREE; /* Ready for the next time we call/define a function.  */
 261   return fndecl;
 262 }
 263
 264 /* BuildModuleCtor creates the per module constructor used as part of
 265    the dynamic linking scaffold.  */
 266
 267 void
 268 m2decl_BuildModuleCtor (tree module_ctor)
 269 {
 270   decl_init_priority_insert (module_ctor, DEFAULT_INIT_PRIORITY);
 271 }
 272
 273 /* DeclareModuleCtor configures the function to be used as a ctor.  */
 274
 275 tree
 276 m2decl_DeclareModuleCtor (tree decl)
 277 {
 278   /* Declare module_ctor ().  */
 279   TREE_PUBLIC (decl) = 1;
 280   DECL_ARTIFICIAL (decl) = 1;
 281   DECL_VISIBILITY (decl) = VISIBILITY_DEFAULT;
 282   DECL_VISIBILITY_SPECIFIED (decl) = 1;
 283   DECL_STATIC_CONSTRUCTOR (decl) = 1;
 284   return decl;
 285 }
 286
 287 /* BuildConstLiteralNumber - returns a GCC TREE built from the
 288    string, str.  It assumes that, str, represents a legal number in
 289    Modula-2.  It always returns a positive value.  */
 290
 291 tree
 292 m2decl_BuildConstLiteralNumber (location_t location, const char *str,
 293                                 unsigned int base, bool issueError)
 294 {
 295   widest_int wval;
 296   tree value;
 297   bool overflow = m2expr_OverflowZType (location, str, base, issueError);
 298   if (overflow)
 299     value = m2expr_GetIntegerZero (location);
 300   else
 301     {
 302       overflow = m2expr_StrToWideInt (location, str, base, wval, issueError);
 303       if (overflow)
 304         value = m2expr_GetIntegerZero (location);
 305       else
 306         {
 307           value = wide_int_to_tree (m2type_GetM2ZType (), wval);
 308           overflow = m2expr_TreeOverflow (value);
 309         }
 310     }
 311   if (issueError && overflow)
 312     error_at (location, "constant %qs is too large", str);
 313   return m2block_RememberConstant (value);
 314 }
 315
 316 /* BuildCStringConstant - creates a string constant given a, string,
 317    and, length.  */
 318
 319 tree
 320 m2decl_BuildCStringConstant (const char *string, int length)
 321 {
 322   tree elem, index, type;
 323
 324   /* +1 ensures that we always nul terminate our strings.  */
 325   elem = build_type_variant (char_type_node, 1, 0);
 326   index = build_index_type (build_int_cst (integer_type_node, length + 1));
 327   type = build_array_type (elem, index);
 328   return m2decl_BuildStringConstantType (length + 1, string, type);
 329 }
 330
 331 /* BuildStringConstant - creates a string constant given a, string,
 332    and, length.  */
 333
 334 tree
 335 m2decl_BuildStringConstant (const char *string, int length)
 336 {
 337   tree elem, index, type;
 338
 339   elem = build_type_variant (char_type_node, 1, 0);
 340   index = build_index_type (build_int_cst (integer_type_node, length));
 341   type = build_array_type (elem, index);
 342   return m2decl_BuildStringConstantType (length, string, type);
 343   // maybe_wrap_with_location
 344 }
 345
 346
 347 tree
 348 m2decl_BuildPtrToTypeString (location_t location, const char *string, tree type)
 349 {
 350   if ((string == NULL) || (strlen (string) == 0))
 351     return m2convert_BuildConvert (location, type,
 352                                    m2decl_BuildIntegerConstant (0),
 353                                    FALSE);
 354   return build_string_literal (strlen (string), string);
 355 }
 356
 357
 358 /* BuildIntegerConstant - return a tree containing the integer value.  */
 359
 360 tree
 361 m2decl_BuildIntegerConstant (int value)
 362 {
 363   switch (value)
 364     {
 365
 366     case 0:
 367       return integer_zero_node;
 368     case 1:
 369       return integer_one_node;
 370
 371     default:
 372       return m2block_RememberConstant (
 373           build_int_cst (integer_type_node, value));
 374     }
 375 }
 376
 377 /* BuildStringConstantType - builds a string constant with a type.  */
 378
 379 tree
 380 m2decl_BuildStringConstantType (int length, const char *string, tree type)
 381 {
 382   tree id = build_string (length, string);
 383
 384   TREE_TYPE (id) = type;
 385   TREE_CONSTANT (id) = TRUE;
 386   TREE_READONLY (id) = TRUE;
 387   TREE_STATIC (id) = TRUE;
 388
 389   return m2block_RememberConstant (id);
 390 }
 391
 392 /* GetBitsPerWord - returns the number of bits in a WORD.  */
 393
 394 int
 395 m2decl_GetBitsPerWord (void)
 396 {
 397   return BITS_PER_WORD;
 398 }
 399
 400 /* GetBitsPerInt - returns the number of bits in a INTEGER.  */
 401
 402 int
 403 m2decl_GetBitsPerInt (void)
 404 {
 405   return INT_TYPE_SIZE;
 406 }
 407
 408 /* GetBitsPerBitset - returns the number of bits in a BITSET.  */
 409
 410 int
 411 m2decl_GetBitsPerBitset (void)
 412 {
 413   return SET_WORD_SIZE;
 414 }
 415
 416 /* GetBitsPerUnit - returns the number of bits in a UNIT.  */
 417
 418 int
 419 m2decl_GetBitsPerUnit (void)
 420 {
 421   return BITS_PER_UNIT;
 422 }
 423
 424 /* m2decl_GetDeclContext - returns the DECL_CONTEXT of tree, t.  */
 425
 426 tree
 427 m2decl_GetDeclContext (tree t)
 428 {
 429   return DECL_CONTEXT (t);
 430 }
 431
 432 #include "gt-m2-m2decl.h"