Line data Source code
1 : /* m2decl.cc provides an interface to GCC decl trees.
2 :
3 : Copyright (C) 2012-2026 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 626610 : 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 626610 : tree id;
85 626610 : tree decl;
86 :
87 626610 : m2assert_AssertLocation (location);
88 626610 : ASSERT (m2tree_is_type (type), type);
89 626610 : ASSERT_BOOL (isglobal);
90 :
91 626610 : id = get_identifier (name);
92 626610 : type = m2tree_skip_type_decl (type);
93 626610 : decl = build_decl (location, VAR_DECL, id, type);
94 :
95 626610 : DECL_SOURCE_LOCATION (decl) = location;
96 :
97 626610 : DECL_EXTERNAL (decl) = imported;
98 626610 : TREE_STATIC (decl) = isglobal;
99 626610 : TREE_PUBLIC (decl) = exported || imported;
100 :
101 626610 : gcc_assert ((istemporary == 0) || (istemporary == 1));
102 :
103 : /* The variable was not declared by GCC, but by the front end. */
104 626610 : DECL_ARTIFICIAL (decl) = istemporary;
105 : /* If istemporary then we don't want debug info for it. */
106 626610 : 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 626610 : DECL_NAMELESS (decl) = istemporary;
110 :
111 : /* Make the variable writable. */
112 626610 : TREE_READONLY (decl) = 0;
113 :
114 626610 : DECL_CONTEXT (decl) = scope;
115 :
116 626610 : if (initial)
117 0 : DECL_INITIAL (decl) = initial;
118 :
119 626610 : m2block_pushDecl (decl);
120 :
121 626610 : if (DECL_SIZE (decl) == 0)
122 0 : error ("storage size of %qD has not been resolved", decl);
123 :
124 626610 : 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 626610 : m2block_addDeclExpr (build_stmt (location, DECL_EXPR, decl));
129 :
130 626610 : 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 65349 : m2decl_DeclareKnownConstant (location_t location, tree type, tree value)
144 : {
145 65349 : tree id = make_node (IDENTIFIER_NODE); /* Ignore the name of the constant. */
146 65349 : tree decl;
147 :
148 65349 : m2assert_AssertLocation (location);
149 65349 : m2expr_ConstantExpressionWarning (value);
150 65349 : type = m2tree_skip_type_decl (type);
151 65349 : layout_type (type);
152 :
153 65349 : decl = build_decl (location, CONST_DECL, id, type);
154 :
155 65349 : value = copy_node (value);
156 65349 : TREE_TYPE (value) = type;
157 65349 : DECL_INITIAL (decl) = value;
158 65349 : TREE_TYPE (decl) = type;
159 65349 : decl = m2block_global_constant (decl);
160 65349 : 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 7544231 : m2decl_BuildParameterDeclaration (location_t location, const char *name, tree type,
169 : bool isreference)
170 : {
171 7544231 : tree parm_decl;
172 :
173 7544231 : m2assert_AssertLocation (location);
174 7544231 : ASSERT_BOOL (isreference);
175 7544231 : type = m2tree_skip_type_decl (type);
176 7544231 : layout_type (type);
177 7544231 : if (isreference)
178 194697 : type = build_reference_type (type);
179 :
180 7544231 : if (name == NULL)
181 89712 : parm_decl = build_decl (location, PARM_DECL, NULL, type);
182 : else
183 7454519 : parm_decl = build_decl (location, PARM_DECL, get_identifier (name), type);
184 7544231 : DECL_ARG_TYPE (parm_decl) = type;
185 7544231 : if (isreference)
186 194697 : TREE_READONLY (parm_decl) = TRUE;
187 :
188 7544231 : param_list = chainon (parm_decl, param_list);
189 7544231 : layout_type (type);
190 7544231 : param_type_list = tree_cons (NULL_TREE, type, param_type_list);
191 7544231 : return parm_decl;
192 : }
193 :
194 : /* BuildStartFunctionDeclaration - initializes global variables ready
195 : for building a function. */
196 :
197 : void
198 3769906 : m2decl_BuildStartFunctionDeclaration (bool uses_varargs)
199 : {
200 3769906 : if (uses_varargs)
201 11236 : param_type_list = NULL_TREE;
202 : else
203 3758670 : param_type_list = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
204 3769906 : param_list = NULL_TREE; /* Ready for when we define a function. */
205 3769906 : }
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 3769906 : 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 3769906 : tree fntype;
218 3769906 : tree fndecl;
219 :
220 3769906 : m2assert_AssertLocation (location_begin);
221 3769906 : m2assert_AssertLocation (location_end);
222 3769906 : ASSERT_BOOL (isexternal);
223 3769906 : ASSERT_BOOL (isnested);
224 3769906 : ASSERT_BOOL (ispublic);
225 3769906 : 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 3769906 : if (returntype == NULL_TREE)
229 1599687 : returntype = void_type_node;
230 2170219 : else if (TREE_CODE (returntype) == FUNCTION_TYPE)
231 0 : returntype = ptr_type_node;
232 :
233 3769906 : fntype = build_function_type (returntype, param_type_list);
234 3769906 : fndecl = build_decl (location_begin, FUNCTION_DECL, get_identifier (name),
235 : fntype);
236 :
237 3769906 : if (isexternal)
238 3628757 : ASSERT_CONDITION (ispublic);
239 :
240 3769906 : DECL_EXTERNAL (fndecl) = isexternal;
241 3769906 : TREE_PUBLIC (fndecl) = ispublic;
242 3769906 : TREE_STATIC (fndecl) = (!isexternal);
243 3769906 : DECL_ARGUMENTS (fndecl) = param_list;
244 7539812 : DECL_RESULT (fndecl)
245 3769906 : = build_decl (location_end, RESULT_DECL, NULL_TREE, returntype);
246 3769906 : DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
247 3769906 : TREE_TYPE (fndecl) = fntype;
248 3769906 : TREE_THIS_VOLATILE (fndecl) = isnoreturn;
249 :
250 3769906 : DECL_SOURCE_LOCATION (fndecl) = location_begin;
251 :
252 : /* Prevent the optimizer from removing it if it is public. */
253 3769906 : if (TREE_PUBLIC (fndecl))
254 3647467 : gm2_mark_addressable (fndecl);
255 :
256 3769906 : m2block_pushDecl (fndecl);
257 :
258 3769906 : rest_of_decl_compilation (fndecl, 1, 0);
259 3769906 : param_list
260 3769906 : = NULL_TREE; /* Ready for the next time we call/define a function. */
261 3769906 : return fndecl;
262 : }
263 :
264 : /* BuildModuleCtor creates the per module constructor used as part of
265 : the dynamic linking scaffold. */
266 :
267 : void
268 14136 : m2decl_BuildModuleCtor (tree module_ctor)
269 : {
270 14136 : decl_init_priority_insert (module_ctor, DEFAULT_INIT_PRIORITY);
271 14136 : }
272 :
273 : /* DeclareModuleCtor configures the function to be used as a ctor. */
274 :
275 : tree
276 14136 : m2decl_DeclareModuleCtor (tree decl)
277 : {
278 : /* Declare module_ctor (). */
279 14136 : TREE_PUBLIC (decl) = 1;
280 14136 : DECL_ARTIFICIAL (decl) = 1;
281 14136 : DECL_VISIBILITY (decl) = VISIBILITY_DEFAULT;
282 14136 : DECL_VISIBILITY_SPECIFIED (decl) = 1;
283 14136 : DECL_STATIC_CONSTRUCTOR (decl) = 1;
284 14136 : 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 603871 : m2decl_BuildConstLiteralNumber (location_t location, const char *str,
293 : unsigned int base, bool issueError)
294 : {
295 603871 : widest_int wval;
296 603871 : tree value;
297 603871 : bool overflow = m2expr_OverflowZType (location, str, base, issueError);
298 603871 : if (overflow)
299 6 : value = m2expr_GetIntegerZero (location);
300 : else
301 : {
302 603865 : overflow = m2expr_StrToWideInt (location, str, base, wval, issueError);
303 603865 : if (overflow)
304 0 : value = m2expr_GetIntegerZero (location);
305 : else
306 : {
307 603865 : value = wide_int_to_tree (m2type_GetM2ZType (), wval);
308 603865 : overflow = m2expr_TreeOverflow (value);
309 : }
310 : }
311 603871 : if (issueError && overflow)
312 0 : error_at (location, "constant %qs is too large", str);
313 603871 : return m2block_RememberConstant (value);
314 603871 : }
315 :
316 : /* BuildCStringConstant - creates a string constant given a, string,
317 : and, length. */
318 :
319 : tree
320 233486 : m2decl_BuildCStringConstant (const char *string, int length)
321 : {
322 233486 : tree elem, index, type;
323 :
324 : /* +1 ensures that we always nul terminate our strings. */
325 233486 : elem = build_type_variant (char_type_node, 1, 0);
326 233486 : index = build_index_type (build_int_cst (integer_type_node, length + 1));
327 233486 : type = build_array_type (elem, index);
328 233486 : 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 222538 : m2decl_BuildStringConstant (const char *string, int length)
336 : {
337 222538 : tree elem, index, type;
338 :
339 222538 : elem = build_type_variant (char_type_node, 1, 0);
340 222538 : index = build_index_type (build_int_cst (integer_type_node, length));
341 222538 : type = build_array_type (elem, index);
342 222538 : 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 6152126 : m2decl_BuildIntegerConstant (int value)
362 : {
363 6152126 : switch (value)
364 : {
365 :
366 1178466 : case 0:
367 1178466 : return integer_zero_node;
368 597053 : case 1:
369 597053 : return integer_one_node;
370 :
371 4376607 : default:
372 4376607 : return m2block_RememberConstant (
373 4376607 : build_int_cst (integer_type_node, value));
374 : }
375 : }
376 :
377 : /* BuildStringConstantType - builds a string constant with a type. */
378 :
379 : tree
380 459336 : m2decl_BuildStringConstantType (int length, const char *string, tree type)
381 : {
382 459336 : tree id = build_string (length, string);
383 :
384 459336 : TREE_TYPE (id) = type;
385 459336 : TREE_CONSTANT (id) = TRUE;
386 459336 : TREE_READONLY (id) = TRUE;
387 459336 : TREE_STATIC (id) = TRUE;
388 :
389 459336 : 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 29904 : m2decl_GetBitsPerInt (void)
404 : {
405 29904 : return INT_TYPE_SIZE;
406 : }
407 :
408 : /* GetBitsPerBitset - returns the number of bits in a BITSET. */
409 :
410 : int
411 95336 : m2decl_GetBitsPerBitset (void)
412 : {
413 95336 : return SET_WORD_SIZE;
414 : }
415 :
416 : /* GetBitsPerUnit - returns the number of bits in a UNIT. */
417 :
418 : int
419 1922 : m2decl_GetBitsPerUnit (void)
420 : {
421 1922 : 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"
|
