[PATCH RFC] algol68: Add allocation function for leaf objects
Pietro Monteiro
pietro@sociotechnical.xyz
Sun Jan 11 23:32:58 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 adds a
function for the run-time library that wraps GC_malloc_atomic and uses
it when allocating strings. This new function is made available to
the front end where it is used to allocate integral or float types.
gcc/algol68/ChangeLog:
* a68-low-runtime.def (MALLOC_LEAF): Add definition for
_libga68_malloc_leaf.
* a68-low.cc (a68_lower_malloc): Use _libga68_malloc_leaf for
integral and float types. And _libga68_malloc for all others.
libga68/ChangeLog:
* ga68-alloc.c (_libga68_malloc_leaf): New function.
* ga68-posix.c (_libga68_posixfgets): Use _libga68_malloc_leaf
instead of _libga68_malloc.
* ga68-unistr.c (_libga68_u32_to_u8): Likewise.
(_libga68_u8_to_u32): Likewise.
* ga68.h (_libga68_malloc_leaf): New prototype.
* ga68.map: Add _libga68_malloc_leaf to the global map.
Signed-off-by: Pietro Monteiro <pietro@sociotechnical.xyz>
---
gcc/algol68/a68-low-runtime.def | 1 +
gcc/algol68/a68-low.cc | 6 +++++-
libga68/ga68-alloc.c | 15 +++++++++++++++
libga68/ga68-posix.c | 4 ++--
libga68/ga68-unistr.c | 8 ++++----
libga68/ga68.h | 1 +
libga68/ga68.map | 1 +
7 files changed, 29 insertions(+), 7 deletions(-)
diff --git a/gcc/algol68/a68-low-runtime.def b/gcc/algol68/a68-low-runtime.def
index ecb8553238d..326e4d00bc9 100644
--- a/gcc/algol68/a68-low-runtime.def
+++ b/gcc/algol68/a68-low-runtime.def
@@ -43,6 +43,7 @@ along with GCC; see the file COPYING3. If not see
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_LEAF, "_libga68_malloc_leaf", RT(VOIDPTR), P1(SIZE), 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.cc b/gcc/algol68/a68-low.cc
index ac603ef13e7..0e0ff67141a 100644
--- a/gcc/algol68/a68-low.cc
+++ b/gcc/algol68/a68-low.cc
@@ -1127,8 +1127,12 @@ a68_lower_alloca (tree type, tree size)
tree
a68_lower_malloc (tree type, tree size)
{
+ /* TODO: test arrays, structs and unions for pointers. */
+ a68_libcall_fn libcall = (ANY_INTEGRAL_TYPE_P (type) || FLOAT_TYPE_P (type))
+ ? A68_LIBCALL_MALLOC_LEAF
+ : A68_LIBCALL_MALLOC;
return fold_convert (build_pointer_type (type),
- a68_build_libcall (A68_LIBCALL_MALLOC, ptr_type_node,
+ a68_build_libcall (libcall, ptr_type_node,
1, size));
}
diff --git a/libga68/ga68-alloc.c b/libga68/ga68-alloc.c
index 1a0b25a098c..df8a8956c52 100644
--- a/libga68/ga68-alloc.c
+++ b/libga68/ga68-alloc.c
@@ -80,6 +80,15 @@ _libga68_malloc (size_t size)
return res;
}
+void *
+_libga68_malloc_leaf (size_t size)
+{
+ void *res = (void *) GC_MALLOC_ATOMIC (size);
+ if (!res)
+ _libga68_abort ("Virtual memory exhausted\n");
+ return res;
+}
+
#else
void
@@ -112,4 +121,10 @@ _libga68_malloc (size_t size)
return res;
}
+void *
+_libga68_malloc_leaf (size_t size)
+{
+ return _libga68_malloc (size);
+}
+
#endif /* !LIBGA68_WITH_GC */
diff --git a/libga68/ga68-posix.c b/libga68/ga68-posix.c
index a671dd61d16..b6fba202497 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_leaf (nchars * sizeof (uint32_t));
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_leaf (allocated);
do
{
uc = _libga68_posixfgetc (fd);
diff --git a/libga68/ga68-unistr.c b/libga68/ga68-unistr.c
index 2cdf732a6b2..2a71313c181 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_leaf (allocated * sizeof (uint8_t));
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_leaf (1);
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_leaf (allocated * sizeof (uint32_t));
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_leaf (1);
}
}
else if (result != resultbuf && length < allocated)
diff --git a/libga68/ga68.h b/libga68/ga68.h
index 008ce05282a..8d1cf20c162 100644
--- a/libga68/ga68.h
+++ b/libga68/ga68.h
@@ -70,6 +70,7 @@ void _libga68_bounds_mismatch (const char *filename, unsigned int lineno,
void _libga68_init_heap (void) GA68_HIDDEN;
void *_libga68_malloc (size_t size);
+void *_libga68_malloc_leaf (size_t size);
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;
diff --git a/libga68/ga68.map b/libga68/ga68.map
index 6917e7905ae..6ee93228358 100644
--- a/libga68/ga68.map
+++ b/libga68/ga68.map
@@ -11,7 +11,8 @@ LIBGA68_2.0 {
_libga68_longrandom;
_libga68_lower_bound;
_libga68_malloc;
+ _libga68_malloc_leaf;
_libga68_posixargc;
_libga68_posixargv;
_libga68_posixclose;
--
2.43.0
More information about the Algol68
mailing list