[PATCH RFC v2] algol68: Add allocation function for leaf objects
Pietro Monteiro
pietro@sociotechnical.xyz
Tue Jan 13 04:29:57 GMT 2026
Boehm GC has a malloc_atomic function that doesn't clear the new
allocation and doesn't scan it for pointers. This patch changes
libga68's malloc function to call GC_malloc_atomic if we're allocating
memory for a leaf object.
It also changes the front end to use leaf allocations for modes that
are not refs ands that don't have rows.
gcc/algol68/ChangeLog:
* a68-low-clauses.cc (a68_lower_collateral_clause): Update
call to a68_lower_alloca.
* a68-low-coercions.cc (a68_lower_widening): Likewise.
* a68-low-generator.cc (allocator_t): Adjust typedef.
(fill_in_buffer): Adjust call to allocator.
(gen_mode): Likewise.
* a68-low-multiples.cc (a68_row_malloc): Adjust call to a68_lower_malloc.
* a68-low-posix.cc (a68_posix_fgets): Likewise.
(a68_posix_gets): Likewise.
* a68-low-runtime.cc (enum a68_libcall_type): Add entry for boolean.
(get_libcall_type): Handle boolean libcall type.
* a68-low-runtime.def (MALLOC): Adjust parameters of _libga68_malloc.
* a68-low-strings.cc (a68_string_concat): Adjust call to
a68_lower_malloc.
(a68_string_from_char): Likewise.
* a68-low-units.cc (a68_lower_slice): Likewise.
* a68-low.cc (a68_low_dup): Adjust calls to a68_lower_malloc
and a68_lower_alloca.
(a68_lower_alloca): Change type parameter to MOID_T from tree.
(a68_lower_malloc): Likewise. Set leaf argument of
_libga68_malloc to true if the MOID is not a REF and doesn't
have ROWS and to false otherwise.
* a68.h (a68_row_malloc): Update prototype.
(a68_lower_alloca): Likewise.
(a68_lower_malloc): Likewise.
libga68/ChangeLog:
* ga68-alloc.c (_libga68_malloc): Add `leaf' parameter and
call GC_MALLOC_ATOMIC if leaf is true or GC_MALLOC if not.
* ga68-posix.c (_libga68_posixfgets): Adjust calls to _libga68_malloc.
* ga68-unistr.c (_libga68_u32_to_u8): Likewise.
(_libga68_u8_to_u32): Likewise.
* ga68.h (_libga68_malloc): Update prototype.
Signed-off-by: Pietro Monteiro <pietro@sociotechnical.xyz>
---
gcc/algol68/a68-low-clauses.cc | 3 ++-
gcc/algol68/a68-low-coercions.cc | 2 +-
gcc/algol68/a68-low-generator.cc | 6 +++---
gcc/algol68/a68-low-multiples.cc | 5 +++--
gcc/algol68/a68-low-posix.cc | 4 ++--
gcc/algol68/a68-low-runtime.cc | 3 +++
gcc/algol68/a68-low-runtime.def | 2 +-
gcc/algol68/a68-low-strings.cc | 4 ++--
gcc/algol68/a68-low-units.cc | 2 +-
gcc/algol68/a68-low.cc | 16 +++++++++++-----
gcc/algol68/a68.h | 8 ++++----
libga68/ga68-alloc.c | 12 +++++++++---
libga68/ga68-posix.c | 4 ++--
libga68/ga68-unistr.c | 8 ++++----
libga68/ga68.h | 2 +-
15 files changed, 49 insertions(+), 32 deletions(-)
diff --git a/gcc/algol68/a68-low-clauses.cc b/gcc/algol68/a68-low-clauses.cc
index 20ab22929bc..26607d7f422 100644
--- a/gcc/algol68/a68-low-clauses.cc
+++ b/gcc/algol68/a68-low-clauses.cc
@@ -1246,6 +1246,7 @@ a68_lower_collateral_clause (NODE_T *p ATTRIBUTE_UNUSED,
tree sub_multiple_elements = a68_multiple_elements (sub_multiple);
tree elements_pointer_type = TREE_TYPE (sub_multiple_elements);
tree elements_type = TREE_TYPE (elements_pointer_type);
+ MOID_T *elements_moid = a68_type_moid (elements_type);
multiple_elements_size = fold_build2 (MULT_EXPR, sizetype,
size_int (num_units),
size_in_bytes (elements_type));
@@ -1254,7 +1255,7 @@ a68_lower_collateral_clause (NODE_T *p ATTRIBUTE_UNUSED,
a68_multiple_num_elems (sub_multiple));
multiple_elements = a68_lower_tmpvar ("multiple_elements%",
elements_pointer_type,
- a68_lower_alloca (elements_type,
+ a68_lower_alloca (elements_moid,
multiple_elements_size));
/* We can also now calculate the bounds of the new multiple.
diff --git a/gcc/algol68/a68-low-coercions.cc b/gcc/algol68/a68-low-coercions.cc
index b9e1acee9ce..3941917223f 100644
--- a/gcc/algol68/a68-low-coercions.cc
+++ b/gcc/algol68/a68-low-coercions.cc
@@ -350,7 +350,7 @@ a68_lower_widening (NODE_T *p, LOW_CTX_T ctx)
/* First allocate space for the elements. */
tree elements = a68_lower_tmpvar ("elements%",
pointer_to_bool_type,
- a68_lower_alloca (a68_bool_type,
+ a68_lower_alloca (M_BOOL,
fold_build2 (MULT_EXPR,
sizetype,
size_int (bits_size),
diff --git a/gcc/algol68/a68-low-generator.cc b/gcc/algol68/a68-low-generator.cc
index 5c4d65569b3..e321b7d5ec2 100644
--- a/gcc/algol68/a68-low-generator.cc
+++ b/gcc/algol68/a68-low-generator.cc
@@ -43,7 +43,7 @@
#include "a68.h"
-typedef tree (*allocator_t) (tree, tree);
+typedef tree (*allocator_t) (MOID_T*, tree);
/* Lower to code that fill in BOUNDS and elements pointers in the given buffer
pointed by BUFFER at offset OFFSET according to the mode MODE, and evals to
@@ -205,7 +205,7 @@ fill_in_buffer (tree buffer, tree offset, tree_stmt_iterator *bounds, MOID_T *m,
MOID_T *elem_mode = SUB (m);
tree elem_size = fold_convert (sizetype, size_in_bytes (CTYPE (elem_mode)));
tree elems_size = save_expr (fold_build2 (MULT_EXPR, sizetype, elem_size, num_elems));
- tree elemsptr = (*allocator) (CTYPE (elem_mode), elems_size);
+ tree elemsptr = (*allocator) (elem_mode, elems_size);
elemsptr = save_expr (elemsptr);
/* And initialize them. */
@@ -337,7 +337,7 @@ static tree
gen_mode (MOID_T *m, tree_stmt_iterator *bounds, allocator_t allocator)
{
/* Allocate space for the value and fill it. */
- tree buffer = (*allocator) (CTYPE (m), size_in_bytes (CTYPE (m)));
+ tree buffer = (*allocator) (m, size_in_bytes (CTYPE (m)));
buffer = save_expr (buffer);
return fill_in_buffer (buffer, size_zero_node, bounds, m, allocator);
}
diff --git a/gcc/algol68/a68-low-multiples.cc b/gcc/algol68/a68-low-multiples.cc
index 572162e30ac..bcaa4c28074 100644
--- a/gcc/algol68/a68-low-multiples.cc
+++ b/gcc/algol68/a68-low-multiples.cc
@@ -1074,16 +1074,17 @@ a68_multiple_bounds_check_equal (NODE_T *p, tree m1, tree m2)
*LOWER_BOUND and *UPPER_BOUND are the bounds for the DIM dimensions. */
tree
-a68_row_malloc (tree type, int dim, tree elems, tree elems_size,
+a68_row_malloc (MOID_T *m, int dim, tree elems, tree elems_size,
tree *lower_bound, tree *upper_bound)
{
+ tree type = CTYPE (m);
tree ptr_to_type = build_pointer_type (type);
a68_push_range (NULL);
/* Allocate space for the descriptor. */
tree ptr_to_multiple = a68_lower_tmpvar ("ptr_to_multiple%", ptr_to_type,
- a68_lower_malloc (type, size_in_bytes (type)));
+ a68_lower_malloc (m, size_in_bytes (type)));
tree multiple = a68_row_value (type, dim,
elems, elems_size,
lower_bound, upper_bound);
diff --git a/gcc/algol68/a68-low-posix.cc b/gcc/algol68/a68-low-posix.cc
index 1a9d5eb1b63..c0fd947fdb4 100644
--- a/gcc/algol68/a68-low-posix.cc
+++ b/gcc/algol68/a68-low-posix.cc
@@ -503,7 +503,7 @@ a68_posix_fgets (void)
tree upper_bound = fold_convert (ssizetype, len);
tree elems_size = fold_build2 (MULT_EXPR, sizetype,
len, size_in_bytes (a68_char_type));
- tree body = a68_row_malloc (CTYPE (M_STRING), 1 /* dim */,
+ tree body = a68_row_malloc (M_STRING, 1 /* dim */,
elems, elems_size,
&lower_bound, &upper_bound);
a68_pop_function_range (body);
@@ -545,7 +545,7 @@ a68_posix_gets (void)
tree upper_bound = fold_convert (ssizetype, len);
tree elems_size = fold_build2 (MULT_EXPR, sizetype,
len, size_in_bytes (a68_char_type));
- tree body = a68_row_malloc (CTYPE (M_STRING), 1 /* dim */,
+ tree body = a68_row_malloc (M_STRING, 1 /* dim */,
elems, elems_size,
&lower_bound, &upper_bound);
a68_pop_function_range (body);
diff --git a/gcc/algol68/a68-low-runtime.cc b/gcc/algol68/a68-low-runtime.cc
index 190c16a9d15..6f6467ae023 100644
--- a/gcc/algol68/a68-low-runtime.cc
+++ b/gcc/algol68/a68-low-runtime.cc
@@ -65,6 +65,7 @@ enum a68_libcall_type
LCT_FLOAT,
LCT_DOUBLE,
LCT_LONGDOUBLE,
+ LCT_BOOL,
LCT_END
};
@@ -115,6 +116,8 @@ get_libcall_type (a68_libcall_type type)
libcall_types[type] = double_type_node;
else if (type == LCT_LONGDOUBLE)
libcall_types[type] = long_double_type_node;
+ else if (type == LCT_BOOL)
+ libcall_types[type] = boolean_type_node;
else
gcc_unreachable ();
diff --git a/gcc/algol68/a68-low-runtime.def b/gcc/algol68/a68-low-runtime.def
index ecb8553238d..7c00ce0506e 100644
--- a/gcc/algol68/a68-low-runtime.def
+++ b/gcc/algol68/a68-low-runtime.def
@@ -42,7 +42,7 @@ along with GCC; see the file COPYING3. If not see
Used for declaring functions that are called by generated code. */
DEF_A68_RUNTIME (ASSERT, "_libga68_assert", RT(VOID), P2(CONSTCHARPTR, UINT), ECF_NORETURN)
-DEF_A68_RUNTIME (MALLOC, "_libga68_malloc", RT(VOIDPTR), P1(SIZE), ECF_NOTHROW | ECF_LEAF | ECF_MALLOC)
+DEF_A68_RUNTIME (MALLOC, "_libga68_malloc", RT(VOIDPTR), P2(SIZE, BOOL), ECF_NOTHROW | ECF_LEAF | ECF_MALLOC)
DEF_A68_RUNTIME (DEREFNIL, "_libga68_derefnil", RT(VOID), P2(CONSTCHARPTR, UINT), ECF_NORETURN)
DEF_A68_RUNTIME (UNREACHABLE, "_libga68_unreachable", RT(VOID), P2(CONSTCHARPTR, UINT), ECF_NORETURN)
DEF_A68_RUNTIME (INVALIDCHARERROR, "_libga68_invalidcharerror", RT(VOID), P3(CONSTCHARPTR,UINT,INT), ECF_NORETURN)
diff --git a/gcc/algol68/a68-low-strings.cc b/gcc/algol68/a68-low-strings.cc
index f5822037e33..5af83bf944d 100644
--- a/gcc/algol68/a68-low-strings.cc
+++ b/gcc/algol68/a68-low-strings.cc
@@ -149,7 +149,7 @@ a68_string_concat (tree str1, tree str2)
size_in_bytes (a68_char_type),
num_elems);
tree elements = a68_lower_tmpvar ("elements%", char_pointer_type,
- a68_lower_malloc (a68_char_type, elements_size));
+ a68_lower_malloc (M_CHAR, elements_size));
/* Copy elements. */
tree to_index = a68_lower_tmpvar ("to_index%", sizetype, size_zero_node);
@@ -234,7 +234,7 @@ a68_string_from_char (tree c)
a68_push_range (M_STRING);
tree elements = a68_lower_tmpvar ("elements%", char_pointer_type,
- a68_lower_malloc (a68_char_type,
+ a68_lower_malloc (M_CHAR,
size_one_node));
a68_add_stmt (fold_build2 (MODIFY_EXPR,
void_type_node,
diff --git a/gcc/algol68/a68-low-units.cc b/gcc/algol68/a68-low-units.cc
index 9802468873b..caaa5bb27ac 100644
--- a/gcc/algol68/a68-low-units.cc
+++ b/gcc/algol68/a68-low-units.cc
@@ -778,7 +778,7 @@ a68_lower_slice (NODE_T *p, LOW_CTX_T ctx)
{
tree ptrtype = CTYPE (orig_sliced_multiple_mode);
tree slice_addr = fold_build1 (ADDR_EXPR, ptrtype, slice);
- tree alloc = a68_lower_malloc (ptrtype, size_in_bytes (TREE_TYPE (slice)));
+ tree alloc = a68_lower_malloc (orig_sliced_multiple_mode, size_in_bytes (TREE_TYPE (slice)));
alloc = save_expr (alloc);
tree copy = a68_lower_memcpy (alloc, slice_addr, size_in_bytes (TREE_TYPE (slice)));
diff --git a/gcc/algol68/a68-low.cc b/gcc/algol68/a68-low.cc
index ac603ef13e7..09b512a9359 100644
--- a/gcc/algol68/a68-low.cc
+++ b/gcc/algol68/a68-low.cc
@@ -741,12 +741,14 @@ a68_low_dup (tree expr, bool use_heap)
tree element_pointer_type = TREE_TYPE (elements);
tree element_type = TREE_TYPE (element_pointer_type);
tree new_elements_size = save_expr (a68_multiple_elements_size (expr));
+ tree new_elements_type = TREE_TYPE (TREE_TYPE (elements));
+ MOID_T *new_elements_moid = a68_type_moid (new_elements_type);
tree new_elements = a68_lower_tmpvar ("new_elements%",
TREE_TYPE (elements),
(use_heap
- ? a68_lower_malloc (TREE_TYPE (TREE_TYPE (elements)),
+ ? a68_lower_malloc (new_elements_moid,
new_elements_size)
- : a68_lower_alloca (TREE_TYPE (TREE_TYPE (elements)),
+ : a68_lower_alloca (new_elements_moid,
new_elements_size)));
/* Then copy the elements.
@@ -1110,8 +1112,9 @@ a68_lower_memcpy (tree dst, tree src, tree size)
pointer to it. */
tree
-a68_lower_alloca (tree type, tree size)
+a68_lower_alloca (MOID_T *m, tree size)
{
+ tree type = CTYPE (m);
tree call = builtin_decl_explicit (BUILT_IN_ALLOCA_WITH_ALIGN);
call = build_call_expr_loc (UNKNOWN_LOCATION, call, 2,
size,
@@ -1125,11 +1128,14 @@ a68_lower_alloca (tree type, tree size)
pointer to it. */
tree
-a68_lower_malloc (tree type, tree size)
+a68_lower_malloc (MOID_T *m, tree size)
{
+ tree type = CTYPE (m);
+ bool is_leaf = (!IS_REF (m) && !HAS_ROWS (m)) ? true : false;
+ tree leaf = constant_boolean_node (is_leaf, boolean_type_node);
return fold_convert (build_pointer_type (type),
a68_build_libcall (A68_LIBCALL_MALLOC, ptr_type_node,
- 1, size));
+ 2, size, leaf));
}
/* Build code for a temporary variable named NAME, of type TYPE and initialized
diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h
index 7c6d51bd064..34090d12c05 100644
--- a/gcc/algol68/a68.h
+++ b/gcc/algol68/a68.h
@@ -699,9 +699,9 @@ tree a68_row_value (tree type, size_t dim,
tree *lower_bound, tree *upper_bound);
tree a68_row_value_raw (tree type, tree descriptor,
tree elements, tree elements_size);
-tree a68_row_malloc (tree type, int dim,
+tree a68_row_malloc (MOID_T *m, int dim,
tree elements, tree elements_size,
- tree *lower_bound, tree *upper_bound);
+ tree *lower_bound, tree *upper_bound);
tree a68_multiple_slice (NODE_T *p, tree multiple, bool slicing_name,
int num_indexes, tree *indexes);
tree a68_multiple_copy_elems (MOID_T *to_mode, tree to, tree from);
@@ -815,8 +815,8 @@ tree a68_get_skip_tree (MOID_T *m);
tree a68_get_empty (void);
void a68_ref_counts (tree exp, MOID_T *m, int *num_refs, int *num_pointers);
tree a68_consolidate_ref (MOID_T *m, tree expr);
-tree a68_lower_alloca (tree type, tree size);
-tree a68_lower_malloc (tree type, tree size);
+tree a68_lower_alloca (MOID_T *m, tree size);
+tree a68_lower_malloc (MOID_T *m, tree size);
tree a68_checked_indirect_ref (NODE_T *p, tree exp, MOID_T *exp_mode);
tree a68_low_deref (tree exp, NODE_T *p);
tree a68_low_dup (tree exp, bool use_heap = false);
diff --git a/libga68/ga68-alloc.c b/libga68/ga68-alloc.c
index 1a0b25a098c..07704c0b9ef 100644
--- a/libga68/ga68-alloc.c
+++ b/libga68/ga68-alloc.c
@@ -72,9 +72,15 @@ _libga68_realloc_unchecked (void *ptr, size_t size)
}
void *
-_libga68_malloc (size_t size)
+_libga68_malloc (size_t size, bool leaf)
{
- void *res = (void *) GC_MALLOC (size);
+ void *res;
+
+ if (leaf)
+ res = (void *) GC_MALLOC_ATOMIC (size);
+ else
+ res = (void *) GC_MALLOC (size);
+
if (!res)
_libga68_abort ("Virtual memory exhausted\n");
return res;
@@ -104,7 +110,7 @@ _libga68_realloc_unchecked (void *ptr, size_t size)
}
void *
-_libga68_malloc (size_t size)
+_libga68_malloc (size_t size, bool leaf __attribute__ ((unused)))
{
void *res = (void *) malloc (size);
if (!res)
diff --git a/libga68/ga68-posix.c b/libga68/ga68-posix.c
index a671dd61d16..50517c4d280 100644
--- a/libga68/ga68-posix.c
+++ b/libga68/ga68-posix.c
@@ -322,7 +322,7 @@ _libga68_posixfgets (int fd, int nchars, size_t *len)
if (nchars > 0)
{
/* Read exactly nchar or until EOF. */
- res = _libga68_malloc (nchars * sizeof (uint32_t));
+ res = _libga68_malloc (nchars * sizeof (uint32_t), true /* leaf */);
do
{
uc = _libga68_posixfgetc (fd);
@@ -336,7 +336,7 @@ _libga68_posixfgets (int fd, int nchars, size_t *len)
{
/* Read until newline or EOF. */
size_t allocated = 80 * sizeof (uint32_t);
- res = _libga68_malloc (allocated);
+ res = _libga68_malloc (allocated, true /* leaf */);
do
{
uc = _libga68_posixfgetc (fd);
diff --git a/libga68/ga68-unistr.c b/libga68/ga68-unistr.c
index 2cdf732a6b2..66d7eda0399 100644
--- a/libga68/ga68-unistr.c
+++ b/libga68/ga68-unistr.c
@@ -363,7 +363,7 @@ _libga68_u32_to_u8 (const uint32_t *s, size_t n, size_t stride,
if (length + 6 > allocated)
allocated = length + 6;
if (result == resultbuf || result == NULL)
- memory = (uint8_t *) _libga68_malloc (allocated * sizeof (uint8_t));
+ memory = (uint8_t *) _libga68_malloc (allocated * sizeof (uint8_t), true /* leaf */);
else
memory =
(uint8_t *) _libga68_realloc (result, allocated * sizeof (uint8_t));
@@ -384,7 +384,7 @@ _libga68_u32_to_u8 (const uint32_t *s, size_t n, size_t stride,
if (result == NULL)
{
/* Return a non-NULL value. NULL means error. */
- result = (uint8_t *) _libga68_malloc (1);
+ result = (uint8_t *) _libga68_malloc (1, true /* leaf */);
if (result == NULL)
{
errno = ENOMEM;
@@ -580,7 +580,7 @@ _libga68_u8_to_u32 (const uint8_t *s, size_t n, uint32_t *resultbuf, size_t *len
if (length + 1 > allocated)
allocated = length + 1;
if (result == resultbuf || result == NULL)
- memory = (uint32_t *) _libga68_malloc (allocated * sizeof (uint32_t));
+ memory = (uint32_t *) _libga68_malloc (allocated * sizeof (uint32_t), true /* leaf */);
else
memory =
(uint32_t *) _libga68_realloc (result, allocated * sizeof (uint32_t));
@@ -598,7 +598,7 @@ _libga68_u8_to_u32 (const uint8_t *s, size_t n, uint32_t *resultbuf, size_t *len
if (result == NULL)
{
/* Return a non-NULL value. NULL means error. */
- result = (uint32_t *) _libga68_malloc (1);
+ result = (uint32_t *) _libga68_malloc (1, true /* leaf */);
}
}
else if (result != resultbuf && length < allocated)
diff --git a/libga68/ga68.h b/libga68/ga68.h
index 008ce05282a..18e6394d51d 100644
--- a/libga68/ga68.h
+++ b/libga68/ga68.h
@@ -69,7 +69,7 @@ void _libga68_bounds_mismatch (const char *filename, unsigned int lineno,
/* ga68-alloc.c */
void _libga68_init_heap (void) GA68_HIDDEN;
-void *_libga68_malloc (size_t size);
+void *_libga68_malloc (size_t size, bool leaf);
void *_libga68_malloc_internal (size_t size) GA68_HIDDEN;
void *_libga68_realloc (void *ptr, size_t size) GA68_HIDDEN;
void *_libga68_realloc_unchecked (void *ptr, size_t size) GA68_HIDDEN;
--
2.43.0
More information about the Algol68
mailing list