Branch data Line data Source code
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 : 608752 : 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 : 608752 : tree id;
85 : 608752 : tree decl;
86 : :
87 : 608752 : m2assert_AssertLocation (location);
88 : 608752 : ASSERT (m2tree_is_type (type), type);
89 : 608752 : ASSERT_BOOL (isglobal);
90 : :
91 : 608752 : id = get_identifier (name);
92 : 608752 : type = m2tree_skip_type_decl (type);
93 : 608752 : decl = build_decl (location, VAR_DECL, id, type);
94 : :
95 : 608752 : DECL_SOURCE_LOCATION (decl) = location;
96 : :
97 : 608752 : DECL_EXTERNAL (decl) = imported;
98 : 608752 : TREE_STATIC (decl) = isglobal;
99 : 608752 : TREE_PUBLIC (decl) = exported || imported;
100 : :
101 : 608752 : gcc_assert ((istemporary == 0) || (istemporary == 1));
102 : :
103 : : /* The variable was not declared by GCC, but by the front end. */
104 : 608752 : DECL_ARTIFICIAL (decl) = istemporary;
105 : : /* If istemporary then we don't want debug info for it. */
106 : 608752 : 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 : 608752 : DECL_NAMELESS (decl) = istemporary;
110 : :
111 : : /* Make the variable writable. */
112 : 608752 : TREE_READONLY (decl) = 0;
113 : :
114 : 608752 : DECL_CONTEXT (decl) = scope;
115 : :
116 : 608752 : if (initial)
117 : 0 : DECL_INITIAL (decl) = initial;
118 : :
119 : 608752 : m2block_pushDecl (decl);
120 : :
121 : 608752 : if (DECL_SIZE (decl) == 0)
122 : 0 : error ("storage size of %qD has not been resolved", decl);
123 : :
124 : 608752 : if ((TREE_PUBLIC (decl) == 0) && DECL_EXTERNAL (decl))
125 : 0 : internal_error ("inconsistent because %qs",
126 : : "PUBLIC_DECL(decl) == 0 && DECL_EXTERNAL(decl) == 1");
127 : :
128 : 608752 : m2block_addDeclExpr (build_stmt (location, DECL_EXPR, decl));
129 : :
130 : 608752 : 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 : 56402 : m2decl_DeclareKnownConstant (location_t location, tree type, tree value)
144 : : {
145 : 56402 : tree id = make_node (IDENTIFIER_NODE); /* Ignore the name of the constant. */
146 : 56402 : tree decl;
147 : :
148 : 56402 : m2assert_AssertLocation (location);
149 : 56402 : m2expr_ConstantExpressionWarning (value);
150 : 56402 : type = m2tree_skip_type_decl (type);
151 : 56402 : layout_type (type);
152 : :
153 : 56402 : decl = build_decl (location, CONST_DECL, id, type);
154 : :
155 : 56402 : value = copy_node (value);
156 : 56402 : TREE_TYPE (value) = type;
157 : 56402 : DECL_INITIAL (decl) = value;
158 : 56402 : TREE_TYPE (decl) = type;
159 : 56402 : decl = m2block_global_constant (decl);
160 : 56402 : 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 : 5198749 : m2decl_BuildParameterDeclaration (location_t location, char *name, tree type,
169 : : bool isreference)
170 : : {
171 : 5198749 : tree parm_decl;
172 : :
173 : 5198749 : m2assert_AssertLocation (location);
174 : 5198749 : ASSERT_BOOL (isreference);
175 : 5198749 : type = m2tree_skip_type_decl (type);
176 : 5198749 : layout_type (type);
177 : 5198749 : if (isreference)
178 : 140245 : type = build_reference_type (type);
179 : :
180 : 5198749 : if (name == NULL)
181 : 100902 : parm_decl = build_decl (location, PARM_DECL, NULL, type);
182 : : else
183 : 5097847 : parm_decl = build_decl (location, PARM_DECL, get_identifier (name), type);
184 : 5198749 : DECL_ARG_TYPE (parm_decl) = type;
185 : 5198749 : if (isreference)
186 : 140245 : TREE_READONLY (parm_decl) = TRUE;
187 : :
188 : 5198749 : param_list = chainon (parm_decl, param_list);
189 : 5198749 : layout_type (type);
190 : 5198749 : param_type_list = tree_cons (NULL_TREE, type, param_type_list);
191 : 5198749 : return parm_decl;
192 : : }
193 : :
194 : : /* BuildStartFunctionDeclaration - initializes global variables ready
195 : : for building a function. */
196 : :
197 : : void
198 : 2389287 : m2decl_BuildStartFunctionDeclaration (bool uses_varargs)
199 : : {
200 : 2389287 : if (uses_varargs)
201 : 15394 : param_type_list = NULL_TREE;
202 : : else
203 : 2373893 : param_type_list = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
204 : 2389287 : param_list = NULL_TREE; /* Ready for when we define a function. */
205 : 2389287 : }
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 : 2389287 : 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 : 2389287 : tree fntype;
218 : 2389287 : tree fndecl;
219 : :
220 : 2389287 : m2assert_AssertLocation (location_begin);
221 : 2389287 : m2assert_AssertLocation (location_end);
222 : 2389287 : ASSERT_BOOL (isexternal);
223 : 2389287 : ASSERT_BOOL (isnested);
224 : 2389287 : ASSERT_BOOL (ispublic);
225 : 2389287 : 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 : 2389287 : if (returntype == NULL_TREE)
229 : 1397495 : returntype = void_type_node;
230 : 991792 : else if (TREE_CODE (returntype) == FUNCTION_TYPE)
231 : 0 : returntype = ptr_type_node;
232 : :
233 : 2389287 : fntype = build_function_type (returntype, param_type_list);
234 : 2389287 : fndecl = build_decl (location_begin, FUNCTION_DECL, get_identifier (name),
235 : : fntype);
236 : :
237 : 2389287 : if (isexternal)
238 : 2235412 : ASSERT_CONDITION (ispublic);
239 : :
240 : 2389287 : DECL_EXTERNAL (fndecl) = isexternal;
241 : 2389287 : TREE_PUBLIC (fndecl) = ispublic;
242 : 2389287 : TREE_STATIC (fndecl) = (!isexternal);
243 : 2389287 : DECL_ARGUMENTS (fndecl) = param_list;
244 : 4778574 : DECL_RESULT (fndecl)
245 : 2389287 : = build_decl (location_end, RESULT_DECL, NULL_TREE, returntype);
246 : 2389287 : DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
247 : 2389287 : TREE_TYPE (fndecl) = fntype;
248 : 2389287 : TREE_THIS_VOLATILE (fndecl) = isnoreturn;
249 : :
250 : 2389287 : DECL_SOURCE_LOCATION (fndecl) = location_begin;
251 : :
252 : : /* Prevent the optimizer from removing it if it is public. */
253 : 2389287 : if (TREE_PUBLIC (fndecl))
254 : 2251512 : gm2_mark_addressable (fndecl);
255 : :
256 : 2389287 : m2block_pushDecl (fndecl);
257 : :
258 : 2389287 : rest_of_decl_compilation (fndecl, 1, 0);
259 : 2389287 : param_list
260 : 2389287 : = NULL_TREE; /* Ready for the next time we call/define a function. */
261 : 2389287 : return fndecl;
262 : : }
263 : :
264 : : /* BuildModuleCtor creates the per module constructor used as part of
265 : : the dynamic linking scaffold. */
266 : :
267 : : void
268 : 16524 : m2decl_BuildModuleCtor (tree module_ctor)
269 : : {
270 : 16524 : decl_init_priority_insert (module_ctor, DEFAULT_INIT_PRIORITY);
271 : 16524 : }
272 : :
273 : : /* DeclareModuleCtor configures the function to be used as a ctor. */
274 : :
275 : : tree
276 : 16524 : m2decl_DeclareModuleCtor (tree decl)
277 : : {
278 : : /* Declare module_ctor (). */
279 : 16524 : TREE_PUBLIC (decl) = 1;
280 : 16524 : DECL_ARTIFICIAL (decl) = 1;
281 : 16524 : DECL_VISIBILITY (decl) = VISIBILITY_DEFAULT;
282 : 16524 : DECL_VISIBILITY_SPECIFIED (decl) = 1;
283 : 16524 : DECL_STATIC_CONSTRUCTOR (decl) = 1;
284 : 16524 : 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 : 540401 : m2decl_BuildConstLiteralNumber (location_t location, const char *str,
293 : : unsigned int base, bool issueError)
294 : : {
295 : 540401 : widest_int wval;
296 : 540401 : tree value;
297 : 540401 : bool overflow = m2expr_OverflowZType (location, str, base, issueError);
298 : 540401 : if (overflow)
299 : 6 : value = m2expr_GetIntegerZero (location);
300 : : else
301 : : {
302 : 540395 : overflow = m2expr_StrToWideInt (location, str, base, wval, issueError);
303 : 540395 : if (overflow)
304 : 0 : value = m2expr_GetIntegerZero (location);
305 : : else
306 : : {
307 : 540395 : value = wide_int_to_tree (m2type_GetM2ZType (), wval);
308 : 540395 : overflow = m2expr_TreeOverflow (value);
309 : : }
310 : : }
311 : 540401 : if (issueError && overflow)
312 : 0 : error_at (location, "constant %qs is too large", str);
313 : 540401 : return m2block_RememberConstant (value);
314 : 540401 : }
315 : :
316 : : /* BuildCStringConstant - creates a string constant given a, string,
317 : : and, length. */
318 : :
319 : : tree
320 : 247319 : m2decl_BuildCStringConstant (const char *string, int length)
321 : : {
322 : 247319 : tree elem, index, type;
323 : :
324 : : /* +1 ensures that we always nul terminate our strings. */
325 : 247319 : elem = build_type_variant (char_type_node, 1, 0);
326 : 247319 : index = build_index_type (build_int_cst (integer_type_node, length + 1));
327 : 247319 : type = build_array_type (elem, index);
328 : 247319 : 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 : 231228 : m2decl_BuildStringConstant (const char *string, int length)
336 : : {
337 : 231228 : tree elem, index, type;
338 : :
339 : 231228 : elem = build_type_variant (char_type_node, 1, 0);
340 : 231228 : index = build_index_type (build_int_cst (integer_type_node, length));
341 : 231228 : type = build_array_type (elem, index);
342 : 231228 : return m2decl_BuildStringConstantType (length, string, type);
343 : : // maybe_wrap_with_location
344 : : }
345 : :
346 : :
347 : : tree
348 : 0 : m2decl_BuildPtrToTypeString (location_t location, const char *string, tree type)
349 : : {
350 : 0 : if ((string == NULL) || (strlen (string) == 0))
351 : 0 : return m2convert_BuildConvert (location, type,
352 : : m2decl_BuildIntegerConstant (0),
353 : 0 : FALSE);
354 : 0 : return build_string_literal (strlen (string), string);
355 : : }
356 : :
357 : :
358 : : /* BuildIntegerConstant - return a tree containing the integer value. */
359 : :
360 : : tree
361 : 4771532 : m2decl_BuildIntegerConstant (int value)
362 : : {
363 : 4771532 : switch (value)
364 : : {
365 : :
366 : 1012571 : case 0:
367 : 1012571 : return integer_zero_node;
368 : 418314 : case 1:
369 : 418314 : return integer_one_node;
370 : :
371 : 3340647 : default:
372 : 3340647 : 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 : 481841 : m2decl_BuildStringConstantType (int length, const char *string, tree type)
381 : : {
382 : 481841 : tree id = build_string (length, string);
383 : :
384 : 481841 : TREE_TYPE (id) = type;
385 : 481841 : TREE_CONSTANT (id) = TRUE;
386 : 481841 : TREE_READONLY (id) = TRUE;
387 : 481841 : TREE_STATIC (id) = TRUE;
388 : :
389 : 481841 : return m2block_RememberConstant (id);
390 : : }
391 : :
392 : : /* GetBitsPerWord - returns the number of bits in a WORD. */
393 : :
394 : : int
395 : 0 : m2decl_GetBitsPerWord (void)
396 : : {
397 : 0 : return BITS_PER_WORD;
398 : : }
399 : :
400 : : /* GetBitsPerInt - returns the number of bits in a INTEGER. */
401 : :
402 : : int
403 : 33634 : m2decl_GetBitsPerInt (void)
404 : : {
405 : 33634 : return INT_TYPE_SIZE;
406 : : }
407 : :
408 : : /* GetBitsPerBitset - returns the number of bits in a BITSET. */
409 : :
410 : : int
411 : 47847 : m2decl_GetBitsPerBitset (void)
412 : : {
413 : 47847 : return SET_WORD_SIZE;
414 : : }
415 : :
416 : : /* GetBitsPerUnit - returns the number of bits in a UNIT. */
417 : :
418 : : int
419 : 0 : m2decl_GetBitsPerUnit (void)
420 : : {
421 : 0 : return BITS_PER_UNIT;
422 : : }
423 : :
424 : : /* m2decl_GetDeclContext - returns the DECL_CONTEXT of tree, t. */
425 : :
426 : : tree
427 : 0 : m2decl_GetDeclContext (tree t)
428 : : {
429 : 0 : return DECL_CONTEXT (t);
430 : : }
431 : :
432 : : #include "gt-m2-m2decl.h"
|
