Signed-off-by: Jose E. Marchesi <[email protected]>
gcc/ChangeLog
* algol68/a68-low-bits.cc: New file.
* algol68/a68-low-bools.cc: Likewise.
* algol68/a68-low-chars.cc: Likewise.
* algol68/a68-low-complex.cc: Likewise.
* algol68/a68-low-ints.cc: Likewise.
* algol68/a68-low-procs.cc: Likewise.
* algol68/a68-low-reals.cc: Likewise.
* algol68/a68-low-refs.cc: Likewise.
* algol68/a68-low-strings.cc: Likewise.
---
gcc/algol68/a68-low-bits.cc | 297 ++++++++++++++++
gcc/algol68/a68-low-bools.cc | 77 ++++
gcc/algol68/a68-low-chars.cc | 170 +++++++++
gcc/algol68/a68-low-complex.cc | 141 ++++++++
gcc/algol68/a68-low-ints.cc | 327 +++++++++++++++++
gcc/algol68/a68-low-procs.cc | 52 +++
gcc/algol68/a68-low-reals.cc | 620 +++++++++++++++++++++++++++++++++
gcc/algol68/a68-low-refs.cc | 52 +++
gcc/algol68/a68-low-strings.cc | 390 +++++++++++++++++++++
9 files changed, 2126 insertions(+)
create mode 100644 gcc/algol68/a68-low-bits.cc
create mode 100644 gcc/algol68/a68-low-bools.cc
create mode 100644 gcc/algol68/a68-low-chars.cc
create mode 100644 gcc/algol68/a68-low-complex.cc
create mode 100644 gcc/algol68/a68-low-ints.cc
create mode 100644 gcc/algol68/a68-low-procs.cc
create mode 100644 gcc/algol68/a68-low-reals.cc
create mode 100644 gcc/algol68/a68-low-refs.cc
create mode 100644 gcc/algol68/a68-low-strings.cc
diff --git a/gcc/algol68/a68-low-bits.cc b/gcc/algol68/a68-low-bits.cc
new file mode 100644
index 00000000000..465969f9ade
--- /dev/null
+++ b/gcc/algol68/a68-low-bits.cc
@@ -0,0 +1,297 @@
+/* Lowering routines for all things related to BITS values.
+ Copyright (C) 2025 Jose E. Marchesi.
+
+ Written by Jose E. Marchesi.
+
+ GCC is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ GCC is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+ License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GCC; see the file COPYING3. If not see
+ <http://www.gnu.org/licenses/>. */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with the yielind of SKIP for the given BITS mode. */
+
+tree
+a68_get_bits_skip_tree (MOID_T *m)
+{
+ tree type;
+
+ if (m == M_BITS)
+ type = a68_bits_type;
+ else if (m == M_LONG_BITS)
+ type = a68_long_bits_type;
+ else if (m == M_LONG_LONG_BITS)
+ type = a68_long_long_bits_type;
+ else if (m == M_SHORT_BITS)
+ type = a68_short_bits_type;
+ else if (m == M_SHORT_SHORT_BITS)
+ type = a68_short_short_bits_type;
+ else
+ gcc_unreachable ();
+
+ return build_int_cst (type, 0);
+}
+
+/* Given a BITS type, compute the number of bits that fit in a value of that
+ type. The result is an INT. */
+
+tree
+a68_bits_width (tree type)
+{
+ return fold_convert (a68_int_type, TYPE_SIZE (type));
+}
+
+/* Given a BITS type, compute the maximum value that can be expressed with that
+ type. */
+
+tree
+a68_bits_maxbits (tree type)
+{
+ return fold_convert (type, TYPE_MAX_VALUE (type));
+}
+
+/* Given a SIZETY INT value VAL, compute and return a SIZETY BITS reflecting
+ its constituent bits.
+
+ In strict Algol 68 the BIN of a negative value is BITS (SKIP).
+
+ In GNU 68 the BIN of a negative value is the constituent bits of the two's
+ complement of the value. */
+
+tree
+a68_bits_bin (MOID_T *m, tree val)
+{
+ tree type = CTYPE (m);
+
+ if (OPTION_STRICT (&A68_JOB))
+ return a68_get_bits_skip_tree (m);
+ else
+ return fold_convert (type, val);
+}
+
+/* Given a SIZETY BITS value BITS, compute and return the corresponding SIZETY
+ INT.
+
+ In strict Algol 68 the ABS of a BITS value reflecting a bit pattern that
+ would correspond a negative integral value is INT (SKIP).
+
+ In GNU 68 the ABS of a BITS value reflecting a bit pattern that would
+ correspond a negative integral value is that negative integral value. */
+
+tree
+a68_bits_abs (MOID_T *m, tree bits)
+{
+ tree type = CTYPE (m);
+
+ if (OPTION_STRICT (&A68_JOB))
+ {
+ tree integral_val = save_expr (fold_convert (type, bits));
+ return fold_build3 (COND_EXPR,
+ type,
+ fold_build2 (LT_EXPR, type, integral_val,
+ build_int_cst (type, 0)),
+ a68_get_int_skip_tree (m),
+ integral_val);
+ }
+ else
+ return fold_convert (type, bits);
+}
+
+/* Given a SIZETY BITS value BITS, shorten it into a SIZETY BITS whose tree
+ type is TYPE. */
+
+tree
+a68_bits_shorten (tree type, tree bits)
+{
+ /* This will truncate at the left, which is what is intended. */
+ return fold_convert (type, bits);
+}
+
+/* Given a SIZETY BITS value BITS, length it into a SIZETY BITS whose tree type
+ is TYPE. */
+
+tree
+a68_bits_leng (tree type, tree bits)
+{
+ /* This will add zeroes to the left, which is what is intended. */
+ return fold_convert (type, bits);
+}
+
+/* Given a SIZETY BITS value BITS, compute and return a new SIZETY BITS whose
+ bits are the logical negation of the bits of BITS. */
+
+tree
+a68_bits_not (tree bits)
+{
+ return fold_build1 (BIT_NOT_EXPR, TREE_TYPE (bits), bits);
+}
+
+/* Given two SIZETY BITS values BITS1 and BITS2, compute and return a new
+ SIZETY BITS whose bits are the `and' of the bits of BITS1 and
+ BITS2. */
+
+tree
+a68_bits_and (tree bits1, tree bits2)
+{
+ return fold_build2 (BIT_AND_EXPR, TREE_TYPE (bits1), bits1, bits2);
+}
+
+/* Given two SIZETY BITS values BITS1 and BITS2, compute and return a new
+ SIZETY BITS whose bits are the inclusive-or of the bits of BITS1 and
+ BITS2. */
+
+tree
+a68_bits_ior (tree bits1, tree bits2)
+{
+ return fold_build2 (BIT_IOR_EXPR, TREE_TYPE (bits1), bits1, bits2);
+}
+
+/* Given two SIZETY BITS values BITS1 and BITS2, compute and return a new
+ SIZETY BITS whose bits are the exclusive-or of the bits of BITS1 and
+ BITS2. */
+
+tree
+a68_bits_xor (tree bits1, tree bits2)
+{
+ return fold_build2 (BIT_XOR_EXPR, TREE_TYPE (bits1), bits1, bits2);
+}
+
+/* Given a position POS of mode INT and a BITS of mode SIZETY BITS, return a
+ BOOL reflecting the state of the bit occupying the position POS in BITS.
+
+ If POS is out of range a run-time error is emitted. */
+
+tree
+a68_bits_elem (NODE_T *p, tree pos, tree bits)
+{
+ pos = save_expr (pos);
+ tree one = build_int_cst (TREE_TYPE (bits), 1);
+
+ tree shift = fold_build2 (MINUS_EXPR, bitsizetype,
+ TYPE_SIZE (TREE_TYPE (bits)),
+ fold_convert (bitsizetype, pos));
+ tree elem = fold_build2 (EQ_EXPR,
+ a68_bool_type,
+ fold_build2 (BIT_AND_EXPR,
+ TREE_TYPE (bits),
+ fold_build2 (RSHIFT_EXPR,
+ TREE_TYPE (bits),
+ bits, shift),
+ one),
+ one);
+
+ /* Do bounds checking if requested. */
+ if (OPTION_BOUNDS_CHECKING (&A68_JOB))
+ {
+ unsigned int lineno = NUMBER (LINE (INFO (p)));
+ const char *filename_str = FILENAME (LINE (INFO (p)));
+ tree filename = build_string_literal (strlen (filename_str) + 1,
+ filename_str);
+ tree call = a68_build_libcall (A68_LIBCALL_BITSBOUNDSERROR,
+ void_type_node, 3,
+ filename,
+ build_int_cst (unsigned_type_node, lineno),
+ fold_convert (ssizetype, pos));
+ tree check = fold_build2 (TRUTH_AND_EXPR, integer_type_node,
+ fold_build2 (GT_EXPR, integer_type_node,
+ pos, fold_convert (TREE_TYPE
(pos), integer_zero_node)),
+ fold_build2 (LE_EXPR, integer_type_node,
+ fold_convert (bitsizetype, pos),
+ TYPE_SIZE (TREE_TYPE (bits))));
+
+ check = fold_build2_loc (a68_get_node_location (p),
+ TRUTH_ORIF_EXPR,
+ ssizetype,
+ check,
+ fold_build2 (COMPOUND_EXPR, a68_bool_type,
+ call, boolean_false_node));
+ elem = fold_build2 (COMPOUND_EXPR, a68_bool_type,
+ check, elem);
+ }
+
+ return elem;
+}
+
+/* Given two SIZETY BITS values BITS1 and BITS2, return a BOOL value indicating
+ whether all the bits set in BITS1 are also set in BITS2. */
+
+tree
+a68_bits_subset (tree bits1, tree bits2)
+{
+ /* We compute this operation with `A | B == B' as specified by the Report */
+ bits2 = save_expr (bits2);
+ return fold_build2 (EQ_EXPR, a68_bool_type,
+ fold_build2 (BIT_IOR_EXPR, TREE_TYPE (bits1), bits1,
bits2),
+ bits2);
+}
+
+/* Rotate the bits in BITS SHIFT bits to the left if SHIFT is positive, or ABS
+ (SHIFT) bits to the right if SHIFT is negative.
+
+ A run-time error is raised if the count overflows the BITS value. */
+
+tree
+a68_bits_shift (tree shift, tree bits)
+{
+ shift = save_expr (shift);
+ bits = save_expr (bits);
+ return fold_build3 (COND_EXPR,
+ TREE_TYPE (bits),
+ fold_build2 (GE_EXPR, TREE_TYPE (shift),
+ shift, build_int_cst (TREE_TYPE (shift), 0)),
+ fold_build2 (LSHIFT_EXPR, TREE_TYPE (bits),
+ bits, shift),
+ fold_build2 (RSHIFT_EXPR, TREE_TYPE (bits),
+ bits,
+ fold_build1 (ABS_EXPR, TREE_TYPE (shift),
shift)));
+}
+
+/* Given two bits values, build an expression that calculates whether A = B.
*/
+
+tree
+a68_bits_eq (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two bits values, build an expression that calculates whether A /=
+ B. */
+
+tree
+a68_bits_ne (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b);
+}
diff --git a/gcc/algol68/a68-low-bools.cc b/gcc/algol68/a68-low-bools.cc
new file mode 100644
index 00000000000..000e919407d
--- /dev/null
+++ b/gcc/algol68/a68-low-bools.cc
@@ -0,0 +1,77 @@
+/* Lowering routines for all things related to BOOL values.
+ Copyright (C) 2025 Jose E. Marchesi.
+
+ Written by Jose E. Marchesi.
+
+ GCC is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ GCC is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+ License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GCC; see the file COPYING3. If not see
+ <http://www.gnu.org/licenses/>. */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with the yielind of SKIP of a BOOL mode. */
+
+tree
+a68_get_bool_skip_tree (void)
+{
+ return build_int_cst (a68_bool_type, 0);
+}
+
+/* The absolute value of a BOOL is a non-zero INT for TRUE and zero for
+ FALSE. */
+
+tree
+a68_bool_abs (tree val)
+{
+ return fold_convert (a68_int_type, val);
+}
+
+/* Given two boolean values, build an expression that calculates whether A =
B. */
+
+tree
+a68_bool_eq (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two boolean values, build an expression that calculates whether A /=
+ B. */
+
+tree
+a68_bool_ne (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b);
+}
diff --git a/gcc/algol68/a68-low-chars.cc b/gcc/algol68/a68-low-chars.cc
new file mode 100644
index 00000000000..24449347555
--- /dev/null
+++ b/gcc/algol68/a68-low-chars.cc
@@ -0,0 +1,170 @@
+/* Lowering routines for all things related to STRINGs.
+ Copyright (C) 2025 Jose E. Marchesi.
+
+ Written by Jose E. Marchesi.
+
+ GCC is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ GCC is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+ License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GCC; see the file COPYING3. If not see
+ <http://www.gnu.org/licenses/>. */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with the yielind of SKIP of a CHAR mode. */
+
+tree
+a68_get_char_skip_tree (void)
+{
+ return build_int_cst (a68_char_type, ' ');
+}
+
+/* Return the maximum valid character code that can be stored in a CHAR. */
+tree
+a68_char_max (void)
+{
+ /* 0x10FFFF is the maximum valid code point in Unicode. */
+ return build_int_cst (a68_char_type, 0x10FFFF);
+}
+
+/* Given an integral value, if it denotes a char code build the corresponding
+ CHAR. Otherwise raise a run-time error. */
+
+tree
+a68_char_repr (NODE_T *p, tree val)
+{
+ /* UCS-4 (UTF-32) encodes the Unicode code points using the identity
+ function. Valid code points are in the ranges [U+0000,U+D7FF] and
+ [U+E000,U+10FFFF]. */
+
+ tree c = save_expr (val);
+ tree val_type = TREE_TYPE (val);
+
+ /* (c >= 0 && c < 0xd800) */
+ tree range1 = fold_build2 (TRUTH_AND_EXPR, integer_type_node,
+ fold_build2 (GE_EXPR, integer_type_node,
+ c, fold_convert (val_type,
integer_zero_node)),
+ fold_build2 (LT_EXPR, integer_type_node,
+ c, build_int_cst (val_type, 0xd800)));
+ /* (c >= 0xe000 && c < 0x110000) */
+ tree range2 = fold_build2 (TRUTH_AND_EXPR, integer_type_node,
+ fold_build2 (GE_EXPR, integer_type_node,
+ c, build_int_cst (val_type, 0xe000)),
+ fold_build2 (LT_EXPR, integer_type_node,
+ c, build_int_cst (val_type,
0x110000)));
+ tree notvalid = fold_build1 (TRUTH_NOT_EXPR,
+ integer_type_node,
+ fold_build2 (TRUTH_OR_EXPR, integer_type_node,
+ range1, range2));
+
+ /* Call to the runtime run-time error handler. */
+ unsigned int lineno = NUMBER (LINE (INFO (p)));
+ const char *filename_str = FILENAME (LINE (INFO (p)));
+ tree filename = build_string_literal (strlen (filename_str) + 1,
+ filename_str);
+ tree call = a68_build_libcall (A68_LIBCALL_INVALIDCHARERROR,
+ void_type_node, 3,
+ filename,
+ build_int_cst (unsigned_type_node, lineno),
+ fold_convert (a68_int_type, c));
+
+ /* Return the REPR of the given integer value, or raise run-time error. */
+ return fold_build2 (COMPOUND_EXPR, a68_char_type,
+ fold_build3 (COND_EXPR, integer_type_node,
+ notvalid,
+ call, integer_zero_node),
+ fold_convert (a68_char_type, c));
+}
+
+/* the ABS of a CHAR is an INT containing an unique value for each permissable
+ char value. */
+
+tree
+a68_char_abs (tree val)
+{
+ return fold_convert (a68_int_type, val);
+}
+
+/* Given two characters, build an expression that calculates whether A = B. */
+
+tree
+a68_char_eq (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two characters, build an expression that calculates whether A /=
+ B. */
+
+tree
+a68_char_ne (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two characters, build an expression that calculates
+ whether A < B. */
+
+tree
+a68_char_lt (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, LT_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two characters, build an expression that calculates
+ whether A <= B. */
+
+tree
+a68_char_le (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, LE_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two characters, build an expression that calculates
+ whether A > B. */
+
+tree
+a68_char_gt (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, GT_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two characters, build an expression that calculates
+ whether A >= B. */
+
+tree
+a68_char_ge (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, GE_EXPR, boolean_type_node, a, b);
+}
diff --git a/gcc/algol68/a68-low-complex.cc b/gcc/algol68/a68-low-complex.cc
new file mode 100644
index 00000000000..aed1c3c3dab
--- /dev/null
+++ b/gcc/algol68/a68-low-complex.cc
@@ -0,0 +1,141 @@
+/* Lowering routines for all things related to COMPL values.
+ Copyright (C) 2025 Jose E. Marchesi.
+
+ Written by Jose E. Marchesi.
+
+ GCC is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ GCC is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+ License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GCC; see the file COPYING3. If not see
+ <http://www.gnu.org/licenses/>. */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Build a new COMPL value with real part RE and imaginary part IM, of mode
+ MODE. */
+
+tree
+a68_complex_i (MOID_T *mode, tree re, tree im)
+{
+ tree compl_type = CTYPE (mode);
+
+ tree re_field = TYPE_FIELDS (compl_type);
+ tree im_field = TREE_CHAIN (re_field);
+ return build_constructor_va (CTYPE (mode), 2,
+ re_field, re,
+ im_field, im);
+}
+
+/* Given a COMPL value Z, get its real part. */
+
+tree
+a68_complex_re (tree z)
+{
+ tree re_field = TYPE_FIELDS (TREE_TYPE (z));
+ return fold_build3 (COMPONENT_REF, TREE_TYPE (re_field),
+ z, re_field, NULL_TREE);
+}
+
+tree
+a68_complex_im (tree z)
+{
+ tree im_field = TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (z)));
+ return fold_build3 (COMPONENT_REF, TREE_TYPE (im_field),
+ z, im_field, NULL_TREE);
+}
+
+/* Return the conjugate of the given complex Z of mode MODE. */
+
+tree
+a68_complex_conj (MOID_T *mode, tree z)
+{
+ tree re_field = TYPE_FIELDS (TREE_TYPE (z));
+ tree complex_type = build_complex_type (TREE_TYPE (re_field), false /* named
*/);
+
+ z = save_expr (z);
+ tree complex = fold_build2 (COMPLEX_EXPR, complex_type,
+ a68_complex_re (z), a68_complex_im (z));
+ tree conj = fold_build1 (CONJ_EXPR, TREE_TYPE (complex), complex);
+
+ return a68_complex_i (mode,
+ fold_build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (z)),
conj),
+ fold_build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (z)),
conj));
+}
+
+/* Widen a real R to a complex of mode MODE. */
+
+tree
+a68_complex_widen_from_real (MOID_T *mode, tree r)
+{
+ tree compl_type = CTYPE (mode);
+ gcc_assert (compl_type != NULL_TREE);
+
+ /* Sanity check. */
+ if (mode == M_COMPLEX)
+ gcc_assert (TREE_TYPE (r) == a68_real_type);
+ else if (mode == M_LONG_COMPLEX)
+ gcc_assert (TREE_TYPE (r) == a68_long_real_type);
+ else if (mode == M_LONG_LONG_COMPLEX)
+ gcc_assert (TREE_TYPE (r) == a68_long_long_real_type);
+ else
+ gcc_unreachable ();
+
+ a68_push_range (mode);
+ tree res = a68_lower_tmpvar ("compl%", compl_type,
+ a68_get_skip_tree (mode));
+
+ /* Look for the "re" field. */
+ tree field_id = a68_get_mangled_identifier ("re");
+ tree field = NULL_TREE;
+ for (tree f = TYPE_FIELDS (compl_type); f; f = DECL_CHAIN (f))
+ {
+ if (field_id == DECL_NAME (f))
+ {
+ field = f;
+ break;
+ }
+ }
+ gcc_assert (field != NULL_TREE);
+
+ /* Set it to the given real value. */
+ a68_add_stmt (fold_build2 (MODIFY_EXPR,
+ TREE_TYPE (r),
+ fold_build3 (COMPONENT_REF,
+ TREE_TYPE (field),
+ res, field,
+ NULL_TREE),
+ r));
+ a68_add_stmt (res);
+ return a68_pop_range ();
+}
diff --git a/gcc/algol68/a68-low-ints.cc b/gcc/algol68/a68-low-ints.cc
new file mode 100644
index 00000000000..d119de9a56b
--- /dev/null
+++ b/gcc/algol68/a68-low-ints.cc
@@ -0,0 +1,327 @@
+/* Lowering routines for all things related to INT values.
+ Copyright (C) 2025 Jose E. Marchesi.
+
+ Written by Jose E. Marchesi.
+
+ GCC is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ GCC is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+ License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GCC; see the file COPYING3. If not see
+ <http://www.gnu.org/licenses/>. */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with the yielind of SKIP for the given integral mode. */
+
+tree
+a68_get_int_skip_tree (MOID_T *m)
+{
+ tree type;
+
+ if (m == M_INT)
+ type = a68_int_type;
+ else if (m == M_LONG_INT)
+ type = a68_long_int_type;
+ else if (m == M_LONG_LONG_INT)
+ type = a68_long_long_int_type;
+ else if (m == M_SHORT_INT)
+ type = a68_short_int_type;
+ else if (m == M_SHORT_SHORT_INT)
+ type = a68_short_short_int_type;
+ else
+ gcc_unreachable ();
+
+ return build_int_cst (type, 0);
+}
+
+/* Given an integral type, build the maximum value expressable in that
+ type. */
+
+tree
+a68_int_maxval (tree type)
+{
+ return fold_convert (type, TYPE_MAX_VALUE (type));
+}
+
+/* Given an integral type, build the minimum value expressable in that
+ type. */
+
+tree
+a68_int_minval (tree type)
+{
+ return fold_convert (type, TYPE_MIN_VALUE (type));
+}
+
+/* Given an integral type, build an INT with the number of decimal digits
+ required to represent a value of that typ, not including sign. */
+
+tree
+a68_int_width (tree type)
+{
+ /* Note that log10 (2) is ~ 0.3.
+ Thanks to Andrew Pinski for suggesting using this expression. */
+ return fold_build2 (PLUS_EXPR, a68_int_type,
+ build_int_cst (a68_int_type, 1),
+ fold_build2 (TRUNC_DIV_EXPR,
+ a68_int_type,
+ fold_build2 (MULT_EXPR, a68_int_type,
+ build_int_cst (a68_int_type,
TYPE_PRECISION (type)),
+ build_int_cst (a68_int_type,
3)),
+ build_int_cst (a68_int_type, 10)));
+}
+
+/* Given an integer value VAL, return -1 if it is less than zero, 0 if it is
+ zero and +1 if it is bigger than zero. The built value is always of mode
+ M_INT. */
+
+tree
+a68_int_sign (tree val)
+{
+ tree zero = build_int_cst (TREE_TYPE (val), 0);
+ return fold_build3 (COND_EXPR,
+ a68_int_type,
+ fold_build2 (EQ_EXPR, integer_type_node, val, zero),
+ build_int_cst (a68_int_type, 0),
+ fold_build3 (COND_EXPR,
+ a68_int_type,
+ fold_build2 (GT_EXPR, integer_type_node,
val, zero),
+ build_int_cst (a68_int_type, 1),
+ build_int_cst (a68_int_type, -1)));
+}
+
+/* Absolute value of an integer. */
+
+tree
+a68_int_abs (tree val)
+{
+ return fold_build1 (ABS_EXPR, TREE_TYPE (val), val);
+}
+
+/* Build the integral value lengthened from the value of VAL, from mode
+ FROM_MODE to mode TO_MODE. */
+
+tree
+a68_int_leng (MOID_T *to_mode, MOID_T *from_mode ATTRIBUTE_UNUSED, tree val)
+{
+ /* Lengthening can be done by just a cast. */
+ return fold_convert (CTYPE (to_mode), val);
+}
+
+/* Build the integral value that can be lengthened to the value of VAL, from
+ mode FROM_MODE to mode TO_MODE.
+
+ If VAL cannot be represented in TO_MODE because it is bigger than the most
+ positive value representable in TO_MODE, then it is truncated to that value.
+
+ Likewise, if VAL cannot be represented in TO_MODE because it is less than
+ the most negative value representable in TO_MODE, then it is truncated to
+ that value. */
+
+tree
+a68_int_shorten (MOID_T *to_mode, MOID_T *from_mode ATTRIBUTE_UNUSED, tree val)
+{
+ tree most_positive_value = fold_convert (CTYPE (from_mode),
+ a68_int_maxval (CTYPE (to_mode)));
+ tree most_negative_value = fold_convert (CTYPE (from_mode),
+ a68_int_minval (CTYPE (to_mode)));
+
+ val = save_expr (val);
+ most_positive_value = save_expr (most_positive_value);
+ most_negative_value = save_expr (most_negative_value);
+ return fold_build3 (COND_EXPR, CTYPE (to_mode),
+ fold_build2 (GT_EXPR, a68_bool_type, val,
most_positive_value),
+ fold_convert (CTYPE (to_mode), most_positive_value),
+ fold_build3 (COND_EXPR, CTYPE (to_mode),
+ fold_build2 (LT_EXPR, a68_bool_type, val,
most_negative_value),
+ fold_convert (CTYPE (to_mode),
most_negative_value),
+ fold_convert (CTYPE (to_mode), val)));
+}
+
+/* Given two integral values of mode M, build an expression that calculates the
+ addition of A and B. */
+
+tree
+a68_int_plus (MOID_T *m, tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, PLUS_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates the
+ subtraction of A by B. */
+
+tree
+a68_int_minus (MOID_T *m, tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, MINUS_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates the
+ multiplication of A by B. */
+
+tree
+a68_int_mult (MOID_T *m, tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, MULT_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates the
+ division of A by B. */
+
+tree
+a68_int_div (MOID_T *m, tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, TRUNC_DIV_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates
+ whether A = B. */
+
+tree
+a68_int_eq (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates
+ whether A /= B. */
+
+tree
+a68_int_ne (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates
+ whether A < B. */
+
+tree
+a68_int_lt (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, LT_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates
+ whether A <= B. */
+
+tree
+a68_int_le (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, LE_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates
+ whether A > B. */
+
+tree
+a68_int_gt (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, GT_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates
+ whether A >= B. */
+
+tree
+a68_int_ge (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, GE_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two integral values of mode M, build and expression that calculates
the
+ modulus as specified by the Revised Report:
+
+ OP MOD = (L INT a, b) L INT:
+ (INT r = a - a % b * b; r < 0 | r + ABS b | r)
+*/
+
+tree
+a68_int_mod (MOID_T *m, tree a, tree b, location_t loc)
+{
+ a = save_expr (a);
+ b = save_expr (b);
+ tree r = a68_int_minus (m, a, a68_int_mult (m, a68_int_div (m, a, b), b));
+
+ r = save_expr (r);
+ return fold_build3_loc (loc, COND_EXPR, CTYPE (m),
+ a68_int_lt (r, build_int_cst (CTYPE (m), 0)),
+ a68_int_plus (m, r, a68_int_abs (b)),
+ r);
+}
+
+/* Given two integral values values, the first of mode M an the second of mode
+ INT, build an expression that calculates the exponentiation of A by B, as
+ specified by the Revised Report:
+
+ OP ** = (L INT a, INT b) L INT:
+ (b >= 0 | L INT p := L 1; TO b DO p := p * a OD; p)
+*/
+
+tree
+a68_int_pow (MOID_T *m, tree a, tree b, location_t loc)
+{
+ tree zero = build_int_cst (CTYPE (m), 0);
+ tree one = build_int_cst (CTYPE (m), 1);
+
+ a = save_expr (a);
+ b = save_expr (fold_convert (CTYPE (m), b));
+
+ a68_push_range (m);
+ tree index = a68_lower_tmpvar ("index%", CTYPE (m), zero);
+ tree p = a68_lower_tmpvar ("p%", CTYPE (m), one);
+
+ /* Begin of loop body. */
+ a68_push_range (NULL);
+ {
+ /* if (index == b) break; */
+ a68_add_stmt (fold_build1 (EXIT_EXPR,
+ void_type_node,
+ fold_build2 (EQ_EXPR, CTYPE (m),
+ index, b)));
+ a68_add_stmt (fold_build2 (MODIFY_EXPR, CTYPE (m),
+ p, a68_int_mult (m, p, a)));
+
+ /* index++ */
+ a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, CTYPE (m),
+ index, one));
+ }
+ tree loop_body = a68_pop_range ();
+ a68_add_stmt (fold_build1 (LOOP_EXPR,
+ void_type_node,
+ loop_body));
+ a68_add_stmt (p);
+ tree calculate_p = a68_pop_range ();
+ return fold_build3_loc (loc, COND_EXPR, CTYPE (m),
+ a68_int_ge (b, zero),
+ calculate_p, zero);
+}
diff --git a/gcc/algol68/a68-low-procs.cc b/gcc/algol68/a68-low-procs.cc
new file mode 100644
index 00000000000..cc43d52aa6b
--- /dev/null
+++ b/gcc/algol68/a68-low-procs.cc
@@ -0,0 +1,52 @@
+/* Lowering routines for all things related to procedures.
+ Copyright (C) 2025 Jose E. Marchesi.
+
+ Written by Jose E. Marchesi.
+
+ GCC is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ GCC is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+ License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GCC; see the file COPYING3. If not see
+ <http://www.gnu.org/licenses/>. */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with the yielding of SKIP for the given procedure mode. */
+
+tree
+a68_get_proc_skip_tree (MOID_T *m)
+{
+ /* A SKIP for a procecure mode lowers to a NULL pointer to a function. */
+ return build_int_cst (CTYPE (m), 0);
+}
diff --git a/gcc/algol68/a68-low-reals.cc b/gcc/algol68/a68-low-reals.cc
new file mode 100644
index 00000000000..ab0064a4855
--- /dev/null
+++ b/gcc/algol68/a68-low-reals.cc
@@ -0,0 +1,620 @@
+/* Lowering routines for all things related to REAL values.
+ Copyright (C) 2025 Jose E. Marchesi.
+
+ Written by Jose E. Marchesi.
+
+ GCC is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ GCC is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+ License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GCC; see the file COPYING3. If not see
+ <http://www.gnu.org/licenses/>. */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "math.h" /* For log10 */
+
+#include "a68.h"
+
+tree
+a68_get_real_skip_tree (MOID_T *m)
+{
+ tree int_type = NULL_TREE;
+ tree real_type = NULL_TREE;
+
+ if (m == M_REAL)
+ {
+ int_type = a68_int_type;
+ real_type = a68_real_type;
+ }
+ else if (m == M_LONG_REAL)
+ {
+ int_type = a68_long_int_type;
+ real_type = a68_long_real_type;
+ }
+ else if (m == M_LONG_LONG_REAL)
+ {
+ int_type = a68_long_long_int_type;
+ real_type = a68_long_long_real_type;
+ }
+ else
+ gcc_unreachable ();
+
+ return build_real_from_int_cst (real_type,
+ build_int_cst (int_type, 0));
+}
+
+static tree
+addr_of_builtin_decl (enum built_in_function fncode)
+{
+ tree builtin = builtin_decl_explicit (fncode);
+ return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (builtin)),
builtin);
+}
+
+/* Build PI for the given real type. */
+
+tree
+a68_real_pi (tree type)
+{
+ return build_real (type, dconst_pi ());
+}
+
+/* Given a real type, build the maximum value expresssable with that type. */
+
+tree
+a68_real_maxval (tree type)
+{
+ REAL_VALUE_TYPE max;
+ real_maxval (&max, 0, TYPE_MODE (type));
+ return build_real (type, max);
+}
+
+/* Given a real type, build the minimum value expressable with that type. */
+
+tree
+a68_real_minval (tree type)
+{
+ REAL_VALUE_TYPE min;
+ real_maxval (&min, 1, TYPE_MODE (type));
+ return build_real (type, min);
+}
+
+/* Given a real type, build the smallest value which can be meaningfully added
+ to or substracted from 1. */
+
+tree
+a68_real_smallval (tree type)
+{
+ /* The smallest real value which can be meaningfully added to or subtracted
+ from 1. */
+ const machine_mode mode = TYPE_MODE (type);
+ const struct real_format *fmt = REAL_MODE_FORMAT (mode);
+
+ char buf[128];
+ if (fmt->pnan < fmt->p)
+ snprintf (buf, sizeof (buf), "0x1p%d", fmt->emin - fmt->p);
+ else
+ snprintf (buf, sizeof (buf), "0x1p%d", 1 - fmt->p);
+
+ REAL_VALUE_TYPE res;
+ real_from_string (&res, buf);
+ return build_real (type, res);
+}
+
+/* Given a real type, build an INT with the number of decimal digits required
+ to represent a mantissa, such that a real is not reglected in comparison
+ with 1, not including sign. */
+
+tree
+a68_real_width (tree type)
+{
+ const machine_mode mode = TYPE_MODE (type);
+ const struct real_format *fmt = REAL_MODE_FORMAT (mode);
+ return build_int_cst (a68_int_type, fmt->p);
+}
+
+/* Given a real type, build an INT with the number of decimal digits required
+ to represent a decimal exponent, such that a real can be correctly
+ represented, not including sign. */
+
+tree
+a68_real_exp_width (tree type ATTRIBUTE_UNUSED)
+{
+ const machine_mode mode = TYPE_MODE (type);
+ const struct real_format *fmt = REAL_MODE_FORMAT (mode);
+ const double log10_2 = .30102999566398119521;
+ double log10_b = log10_2;
+ int max_10_exp = fmt->emax * log10_b;
+
+ return build_int_cst (a68_int_type, 1 + log10 (max_10_exp));
+}
+
+/* Given a real value VAL, return -1 if it is less than zero, 0 if it is zero
+ and +1 if it is bigger than zero. The built value is always of mode
+ M_INT. */
+
+tree
+a68_real_sign (tree val)
+{
+ tree zero = build_real (TREE_TYPE (val), dconst0);
+ return fold_build3 (COND_EXPR,
+ a68_int_type,
+ build2 (EQ_EXPR, integer_type_node, val, zero),
+ build_int_cst (a68_int_type, 0),
+ fold_build3 (COND_EXPR,
+ a68_int_type,
+ fold_build2 (GT_EXPR, integer_type_node,
val, zero),
+ build_int_cst (a68_int_type, 1),
+ build_int_cst (a68_int_type, -1)));
+}
+
+/* Absolute value of a real value. */
+
+tree
+a68_real_abs (tree val)
+{
+ return fold_build1 (ABS_EXPR, TREE_TYPE (val), val);
+}
+
+tree
+a68_real_sqrt (tree type)
+{
+ enum built_in_function builtin;
+
+ if (type == float_type_node)
+ builtin = BUILT_IN_SQRTF;
+ else if (type == double_type_node)
+ builtin = BUILT_IN_SQRT;
+ else if (type == long_double_type_node)
+ builtin = BUILT_IN_SQRTL;
+ else
+ gcc_unreachable ();
+
+ return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_tan (tree type)
+{
+ enum built_in_function builtin;
+
+ if (type == float_type_node)
+ builtin = BUILT_IN_TANF;
+ else if (type == double_type_node)
+ builtin = BUILT_IN_TAN;
+ else if (type == long_double_type_node)
+ builtin = BUILT_IN_TANL;
+ else
+ gcc_unreachable ();
+
+ return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_sin (tree type)
+{
+ enum built_in_function builtin;
+
+ if (type == float_type_node)
+ builtin = BUILT_IN_SINF;
+ else if (type == double_type_node)
+ builtin = BUILT_IN_SIN;
+ else if (type == long_double_type_node)
+ builtin = BUILT_IN_SINL;
+ else
+ gcc_unreachable ();
+
+ return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_cos (tree type)
+{
+ enum built_in_function builtin;
+
+ if (type == float_type_node)
+ builtin = BUILT_IN_COSF;
+ else if (type == double_type_node)
+ builtin = BUILT_IN_COS;
+ else if (type == long_double_type_node)
+ builtin = BUILT_IN_COSL;
+ else
+ gcc_unreachable ();
+
+ return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_acos (tree type)
+{
+ enum built_in_function builtin;
+
+ if (type == float_type_node)
+ builtin = BUILT_IN_ACOSF;
+ else if (type == double_type_node)
+ builtin = BUILT_IN_ACOS;
+ else if (type == long_double_type_node)
+ builtin = BUILT_IN_ACOSL;
+ else
+ gcc_unreachable ();
+
+ return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_asin (tree type)
+{
+ enum built_in_function builtin;
+
+ if (type == float_type_node)
+ builtin = BUILT_IN_ASINF;
+ else if (type == double_type_node)
+ builtin = BUILT_IN_ASIN;
+ else if (type == long_double_type_node)
+ builtin = BUILT_IN_ASINL;
+ else
+ gcc_unreachable ();
+
+ return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_atan (tree type)
+{
+ enum built_in_function builtin;
+
+ if (type == float_type_node)
+ builtin = BUILT_IN_ATANF;
+ else if (type == double_type_node)
+ builtin = BUILT_IN_ATAN;
+ else if (type == long_double_type_node)
+ builtin = BUILT_IN_ATANL;
+ else
+ gcc_unreachable ();
+
+ return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_ln (tree type)
+{
+ enum built_in_function builtin;
+
+ if (type == float_type_node)
+ builtin = BUILT_IN_LOGF;
+ else if (type == double_type_node)
+ builtin = BUILT_IN_LOG;
+ else if (type == long_double_type_node)
+ builtin = BUILT_IN_LOGL;
+ else
+ gcc_unreachable ();
+
+ return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_log (tree type)
+{
+ enum built_in_function builtin;
+
+ if (type == float_type_node)
+ builtin = BUILT_IN_LOG10F;
+ else if (type == double_type_node)
+ builtin = BUILT_IN_LOG10;
+ else if (type == long_double_type_node)
+ builtin = BUILT_IN_LOG10L;
+ else
+ gcc_unreachable ();
+
+ return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_exp (tree type)
+{
+ enum built_in_function builtin;
+
+ if (type == float_type_node)
+ builtin = BUILT_IN_EXPF;
+ else if (type == double_type_node)
+ builtin = BUILT_IN_EXP;
+ else if (type == long_double_type_node)
+ builtin = BUILT_IN_EXPL;
+ else
+ gcc_unreachable ();
+
+ return addr_of_builtin_decl (builtin);
+}
+
+/* Build the real value lengthened from the value of VAL, from mode
+ FROM_MODE to mode TO_MODE. */
+
+tree
+a68_real_leng (MOID_T *to_mode, MOID_T *from_mode ATTRIBUTE_UNUSED, tree val)
+{
+ /* Lengthening can be done by just a conversion. */
+ return fold_convert (CTYPE (to_mode), val);
+}
+
+/* Build the real value that can be lengthened to the value of VAL, from mode
+ FROM_MODE to mode TO_MODE.
+
+ If VAL cannot be represented in TO_MODE because it is bigger than the most
+ positive value representable in TO_MODE, then it is truncated to that value.
+
+ Likewise, if VAL cannot be represented in TO_MODE because it is less than
+ the most negative value representable in TO_MODE, then it is truncated to
+ that value. */
+
+tree
+a68_real_shorten (MOID_T *to_mode, MOID_T *from_mode ATTRIBUTE_UNUSED, tree
val)
+{
+ tree most_positive_value = fold_convert (CTYPE (from_mode),
+ a68_real_maxval (CTYPE (to_mode)));
+ tree most_negative_value = fold_convert (CTYPE (from_mode),
+ a68_real_minval (CTYPE (to_mode)));
+
+ val = save_expr (val);
+ most_positive_value = save_expr (most_positive_value);
+ most_negative_value = save_expr (most_negative_value);
+ return fold_build3 (COND_EXPR, CTYPE (to_mode),
+ fold_build2 (GT_EXPR, a68_bool_type, val,
most_positive_value),
+ fold_convert (CTYPE (to_mode), most_positive_value),
+ fold_build3 (COND_EXPR, CTYPE (to_mode),
+ fold_build2 (LT_EXPR, a68_bool_type, val,
most_negative_value),
+ fold_convert (CTYPE (to_mode),
most_negative_value),
+ fold_convert (CTYPE (to_mode), val)));
+}
+
+/* Given a real expression VAL of mode MODE, produce an integral value which is
+ equal to the given real, or the next integer below (more negative than) the
+ given real. */
+
+tree
+a68_real_entier (tree val, MOID_T *to_mode, MOID_T *from_mode)
+{
+ tree fn = NULL_TREE;
+ tree to_type = CTYPE (to_mode);
+
+ if (from_mode == M_REAL)
+ {
+ if (to_type == integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_IFLOORF);
+ else if (to_type == long_integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_LFLOORF);
+ else if (to_type == long_long_integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_LLFLOORF);
+ else
+ gcc_unreachable ();
+ }
+ else if (from_mode == M_LONG_REAL)
+ {
+ if (to_type == integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_IFLOOR);
+ else if (to_type == long_integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_LFLOOR);
+ else if (to_type == long_long_integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_LLFLOOR);
+ else
+ gcc_unreachable ();
+ }
+ else if (from_mode == M_LONG_LONG_REAL)
+ {
+ if (to_type == integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_IFLOORL);
+ else if (to_type == long_integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_LFLOORL);
+ else if (to_type == long_long_integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_LLFLOORL);
+ else
+ gcc_unreachable ();
+ }
+ else
+ gcc_unreachable ();
+
+ return build_call_expr_loc (UNKNOWN_LOCATION, fn, 1, val);
+}
+
+/* Given a real expression VAL of mode MODE, produce an integral value which is
+ the nearest integer to the given real. */
+
+tree
+a68_real_round (tree val, MOID_T *to_mode, MOID_T *from_mode)
+{
+ tree fn = NULL_TREE;
+ tree to_type = CTYPE (to_mode);
+
+ if (from_mode == M_REAL)
+ {
+ if (to_type == integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_IROUNDF);
+ else if (to_type == long_integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_LROUNDF);
+ else if (to_type == long_long_integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_LLROUNDF);
+ else
+ gcc_unreachable ();
+ }
+ else if (from_mode == M_LONG_REAL)
+ {
+ if (to_type == integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_IROUND);
+ else if (to_type == long_integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_LROUND);
+ else if (to_type == long_long_integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_LLROUND);
+ else
+ gcc_unreachable ();
+ }
+ else if (from_mode == M_LONG_LONG_REAL)
+ {
+ if (to_type == integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_IROUNDL);
+ else if (to_type == long_integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_LROUNDL);
+ else if (to_type == long_long_integer_type_node)
+ fn = builtin_decl_explicit (BUILT_IN_LLROUNDL);
+ else
+ gcc_unreachable ();
+ }
+ else
+ gcc_unreachable ();
+
+ return build_call_expr_loc (UNKNOWN_LOCATION, fn, 1, val);
+}
+
+
+/* Given two real values of mode M, build an expression that calculates the
+ addition of A and B. */
+
+tree
+a68_real_plus (MOID_T *m, tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, PLUS_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates the
+ subtraction of A by B. */
+
+tree
+a68_real_minus (MOID_T *m, tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, MINUS_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates the
+ multiplication of A by B. */
+
+tree
+a68_real_mult (MOID_T *m, tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, MULT_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates the
+ division of A by B. */
+
+tree
+a68_real_div (MOID_T *m, tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, RDIV_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates whether
+ A = B. */
+
+tree
+a68_real_eq (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates whether
+ A /= B. */
+
+tree
+a68_real_ne (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates whether
+ A < B. */
+
+tree
+a68_real_lt (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, LT_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates
+ whether A <= B. */
+
+tree
+a68_real_le (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, LE_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates whether
+ A > B. */
+
+tree
+a68_real_gt (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, GT_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates whether
+ A >= B. */
+
+tree
+a68_real_ge (tree a, tree b, location_t loc)
+{
+ return fold_build2_loc (loc, GE_EXPR, boolean_type_node, a, b);
+}
+
+/* Exponentiation involving real values.
+
+ REAL <- REAL, REAL
+ REAL <- REAL, INT
+ LONG REAL <- LONG REAL, LONG REAL
+ LONG REAL <- LONG REAL, INT
+ LONG LONG REAL <- LONG LONG REAL, LONG LONG REAL
+ LONG LONG REAL <- LONG LONG REAL, INT */
+
+tree
+a68_real_pow (MOID_T *m, MOID_T *a_mode, MOID_T *b_mode,
+ tree a, tree b, location_t loc)
+{
+ enum built_in_function built_in;
+ if (m == M_REAL)
+ {
+ gcc_assert (a_mode == M_REAL);
+ built_in = b_mode == M_REAL ? BUILT_IN_POWF : BUILT_IN_POWIF;
+ }
+ else if (m == M_LONG_REAL)
+ {
+ gcc_assert (a_mode == M_LONG_REAL);
+ built_in = b_mode == M_LONG_REAL ? BUILT_IN_POW : BUILT_IN_POWI;
+ }
+ else if (m == M_LONG_LONG_REAL)
+ {
+ gcc_assert (a_mode == M_LONG_LONG_REAL);
+ built_in = b_mode == M_LONG_LONG_REAL ? BUILT_IN_POWL : BUILT_IN_POWIL;
+ }
+ else
+ gcc_unreachable ();
+
+ tree call = builtin_decl_explicit (built_in);
+ gcc_assert (call != NULL_TREE);
+ return build_call_expr_loc (loc, call, 2, a, b);
+}
diff --git a/gcc/algol68/a68-low-refs.cc b/gcc/algol68/a68-low-refs.cc
new file mode 100644
index 00000000000..ba9987b57ed
--- /dev/null
+++ b/gcc/algol68/a68-low-refs.cc
@@ -0,0 +1,52 @@
+/* Lowering routines for all things related to names.
+ Copyright (C) 2025 Jose E. Marchesi.
+
+ Written by Jose E. Marchesi.
+
+ GCC is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ GCC is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+ License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GCC; see the file COPYING3. If not see
+ <http://www.gnu.org/licenses/>. */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with the yielding of SKIP for the given name mode. */
+
+tree
+a68_get_ref_skip_tree (MOID_T *m)
+{
+ /* Build a NULL pointer. */
+ return build_int_cst (CTYPE (m), 0);
+}
diff --git a/gcc/algol68/a68-low-strings.cc b/gcc/algol68/a68-low-strings.cc
new file mode 100644
index 00000000000..f9fdd56febd
--- /dev/null
+++ b/gcc/algol68/a68-low-strings.cc
@@ -0,0 +1,390 @@
+/* Lowering routines for all things related to STRINGs.
+ Copyright (C) 2025 Jose E. Marchesi.
+
+ Written by Jose E. Marchesi.
+
+ GCC is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ GCC is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+ License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GCC; see the file COPYING3. If not see
+ <http://www.gnu.org/licenses/>. */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with the yielding of SKIP for M_STRING. */
+
+tree
+a68_get_string_skip_tree (void)
+{
+ return a68_get_multiple_skip_tree (M_FLEX_ROW_CHAR);
+}
+
+/* Copy chars from STR to ELEMENTS starting at TO_INDEX chars in ELEMENTS. */
+
+static void
+copy_string (tree elements, tree to_index, tree str)
+{
+ tree char_pointer_type = build_pointer_type (a68_char_type);
+ tree num_elems
+ = a68_lower_tmpvar ("num_elems%", sizetype, a68_multiple_num_elems (str));
+
+ tree from_index
+ = a68_lower_tmpvar ("from_index%", sizetype, size_zero_node);
+ tree from_offset
+ = a68_lower_tmpvar ("from_offset%", sizetype, size_zero_node);
+
+ /* Begin of loop body. */
+ a68_push_range (NULL);
+ {
+ /* if (from_index == num_elems) break; */
+ a68_add_stmt (fold_build1 (EXIT_EXPR, void_type_node,
+ fold_build2 (GE_EXPR, sizetype,
+ from_index, num_elems)));
+
+ /* *(elements + to_index) = *(elements + from_index) */
+ tree to_offset = fold_build2 (MULT_EXPR, sizetype,
+ to_index, size_in_bytes (a68_char_type));
+ a68_add_stmt (fold_build2 (MODIFY_EXPR,
+ void_type_node,
+ fold_build2 (MEM_REF, a68_char_type,
+ fold_build2 (POINTER_PLUS_EXPR,
+ char_pointer_type,
+ elements, to_offset),
+ fold_convert (char_pointer_type,
+ integer_zero_node)),
+ fold_build2 (MEM_REF, a68_char_type,
+ fold_build2 (POINTER_PLUS_EXPR,
+ char_pointer_type,
+ a68_multiple_elements
(str),
+ from_offset),
+ fold_convert (char_pointer_type,
+ integer_zero_node))));
+
+ /* from_offset = from_offset + stride */
+ a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node,
+ from_offset,
+ fold_build2 (PLUS_EXPR, sizetype,
+ from_offset,
+ a68_multiple_stride (str,
size_zero_node))));
+ /* to_index = to_index + 1 */
+ a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, sizetype, to_index,
size_one_node));
+
+ /* from_index = from_index + 1 */
+ a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, sizetype, from_index,
size_one_node));
+ }
+
+ /* End of loop body. */
+ tree loop_body = a68_pop_range ();
+ a68_add_stmt (fold_build1 (LOOP_EXPR,
+ void_type_node,
+ loop_body));
+}
+
+/* Given two STRINGs STR1 and STR2, allocate a new string on the stack with a
+ copy of the concatenated characters of the given string. */
+
+tree
+a68_string_concat (tree str1, tree str2)
+{
+ tree char_pointer_type = build_pointer_type (a68_char_type);
+ static tree string_concat_fndecl;
+
+ if (string_concat_fndecl == NULL_TREE)
+ {
+ string_concat_fndecl
+ = a68_low_toplevel_func_decl ("string_concat",
+ build_function_type_list
(char_pointer_type,
+ TREE_TYPE
(str1),
+ TREE_TYPE
(str2),
+ NULL_TREE));
+ announce_function (string_concat_fndecl);
+
+ tree s1 = a68_low_func_param (string_concat_fndecl, "s1", TREE_TYPE
(str1));
+ tree s2 = a68_low_func_param (string_concat_fndecl, "s2", TREE_TYPE
(str2));
+ DECL_ARGUMENTS (string_concat_fndecl) = chainon (s1, s2);
+
+ a68_push_function_range (string_concat_fndecl, char_pointer_type,
+ true /* top_level */);
+
+ tree n1 = a68_lower_tmpvar ("n1%", sizetype, a68_multiple_num_elems
(s1));
+ tree n2 = a68_lower_tmpvar ("n2%", sizetype, a68_multiple_num_elems
(s2));
+ tree num_elems = a68_lower_tmpvar ("num_elems%", sizetype,
+ fold_build2 (PLUS_EXPR, sizetype, n1,
n2));
+
+ /* First allocate memory for the result string. We need enough space to
+ hold the elements of both strings with a stride of 1S. */
+ tree char_pointer_type = build_pointer_type (a68_char_type);
+ tree elements_size = fold_build2 (MULT_EXPR, sizetype,
+ 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));
+
+ /* Copy elements. */
+ tree to_index = a68_lower_tmpvar ("to_index%", sizetype, size_zero_node);
+ copy_string (elements, to_index, s1);
+ copy_string (elements, to_index, s2);
+ a68_pop_function_range (elements);
+ }
+
+ /* Build the resulting multiple. */
+ str1 = save_expr (str1);
+ str2 = save_expr (str2);
+ tree n1 = a68_multiple_num_elems (str1);
+ tree n2 = a68_multiple_num_elems (str2);
+ tree num_elems = save_expr (fold_build2 (PLUS_EXPR, sizetype, n1, n2));
+ tree elements_size = fold_build2 (MULT_EXPR, sizetype,
+ size_in_bytes (a68_char_type),
+ num_elems);
+ tree lower_bound = ssize_int (1);
+ tree upper_bound = fold_convert (ssizetype, num_elems);
+ tree elements = build_call_nary (char_pointer_type,
+ fold_build1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE
(string_concat_fndecl)),
+ string_concat_fndecl),
+ 2, str1, str2);
+ return a68_row_value (CTYPE (M_STRING), 1 /* dim */,
+ elements, elements_size,
+ &lower_bound, &upper_bound);
+}
+
+/* Given a STRING STR and an INT FACTOR, return STRING concatenated to itself
+ FACTOR - 1 times.
+
+ Negative values of FACTOR are interpreted as zero. */
+
+tree
+a68_string_mult (tree str, tree factor)
+{
+ a68_push_range (M_STRING);
+
+ str = save_expr (str);
+ tree ssize_one_node = ssize_int (1);
+ tree res = a68_lower_tmpvar ("res%", CTYPE (M_STRING), str);
+ tree index = a68_lower_tmpvar ("index%", ssizetype, ssize_one_node);
+
+ /* Begin of loop body. */
+ a68_push_range (NULL);
+
+ /* if (index == FACTOR) break; */
+ a68_add_stmt (fold_build1 (EXIT_EXPR,
+ void_type_node,
+ fold_build2 (GE_EXPR, ssizetype,
+ index,
+ fold_convert (ssizetype, factor))));
+
+ /* res += str */
+ a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (res),
+ res,
+ a68_string_concat (res, str)));
+
+ /* index++ */
+ a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR,
+ ssizetype,
+ index, ssize_one_node));
+ tree loop_body = a68_pop_range ();
+ /* End of loop body. */
+ a68_add_stmt (fold_build1 (LOOP_EXPR,
+ void_type_node,
+ loop_body));
+ a68_add_stmt (res);
+ return a68_pop_range ();
+}
+
+/* Given a CHAR C, build a string whose contents are just that CHAR. */
+
+tree
+a68_string_from_char (tree c)
+{
+ tree lower_bound = ssize_int (1);
+ tree upper_bound = lower_bound;
+ tree char_pointer_type = build_pointer_type (a68_char_type);
+
+ a68_push_range (M_STRING);
+
+ tree elements = a68_lower_tmpvar ("elements%", char_pointer_type,
+ a68_lower_malloc (a68_char_type,
+ size_one_node));
+ a68_add_stmt (fold_build2 (MODIFY_EXPR,
+ void_type_node,
+ fold_build1 (INDIRECT_REF, a68_char_type,
elements),
+ c));
+ a68_add_stmt (a68_row_value (CTYPE (M_STRING), 1 /* dim */,
+ elements,
+ size_in_bytes (a68_char_type),
+ &lower_bound, &upper_bound));
+ return a68_pop_range ();
+}
+
+/* Compare the two given strings lexicographically and return -1 (less than), 0
+ (equal to) or 1 (bigger than) reflecting the result of the comparison. */
+
+tree
+a68_string_cmp (tree s1, tree s2)
+{
+ s1 = save_expr (s1);
+ tree s1_elems = a68_multiple_elements (s1);
+ tree s1_len = a68_multiple_num_elems (s1);
+ tree s1_stride = a68_multiple_stride (s1, size_zero_node);
+
+ s2 = save_expr (s2);
+ tree s2_elems = a68_multiple_elements (s2);
+ tree s2_len = a68_multiple_num_elems (s2);
+ tree s2_stride = a68_multiple_stride (s2, size_zero_node);
+
+ return a68_build_libcall (A68_LIBCALL_U32_CMP2,
+ a68_int_type, 6,
+ s1_elems, s1_len, s1_stride,
+ s2_elems, s2_len, s2_stride);
+}
+
+/* Return a newly allocated UTF-8 string resulting from processing the string
+ breaks in STR. This function assumes the passed string is well-formed (the
+ scanner is in charge of seeing that is true) and just ICEs if it is not. */
+
+char *
+a68_string_process_breaks (const char *str)
+{
+ size_t len = 0;
+ char *res = NULL;
+
+ /* First calculate the size of the resulting string. */
+ for (const char *p = str; *p != '\0';)
+ {
+ if (*p == '\'')
+ {
+ switch (p[1])
+ {
+ case '\'':
+ case 'n':
+ case 'f':
+ case 'r':
+ case 't':
+ len += 1;
+ p += 2;
+ break;
+ case '(':
+ p += 2;
+ while (1)
+ {
+ if (p[0] == ')')
+ {
+ p++;
+ break;
+ }
+ else if (p[0] == ',' || ISSPACE (p[0]))
+ {
+ p++;
+ continue;
+ }
+
+ /* An Unicode codepoint encoded in UTF-8 occupies at most six
+ octets. */
+ len += 6;
+ p += (p[0] == 'u' ? 5 : 9);
+ }
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ }
+ else
+ {
+ len += 1;
+ p += 1;
+ }
+ }
+
+ /* Now and allocate it, adding space for a trailing NULL. */
+ res = (char *) xmalloc (len + 1);
+
+ /* Finally fill it with the result of expanding all the string breaks. */
+ size_t offset = 0;
+ for (const char *p = str; *p != '\0';)
+ {
+ if (*p == '\'')
+ {
+ switch (p[1])
+ {
+ case '\'': res[offset] = '\''; p += 2; offset += 1; break;
+ case 'n': res[offset] = '\n'; p += 2; offset += 1; break;
+ case 't': res[offset] = '\t'; p += 2; offset += 1; break;
+ case 'r': res[offset] = '\r'; p += 2; offset += 1; break;
+ case 'f': res[offset] = '\f'; p += 2; offset += 1; break;
+ case '(':
+ {
+ p += 2;
+ while (1)
+ {
+ if (p[0] == ')')
+ {
+ p++;
+ break;
+ }
+ else if (p[0] == ',' || ISSPACE (p[0]))
+ {
+ p++;
+ continue;
+ }
+
+ /* Skip the u or U. */
+ gcc_assert (p[0] == 'u' || p[0] == 'U');
+ p++;
+
+ char *end;
+ int64_t codepoint = strtol (p, &end, 16);
+ gcc_assert (end > p);
+ p = end;
+ /* Append the UTF-8 encoding of the obtained codepoint to
+ the `res' string. */
+ int n = a68_u8_uctomb ((uint8_t *) res + offset, codepoint,
6);
+ gcc_assert (n > 0);
+ offset += n;
+ }
+ break;
+ }
+ default: gcc_unreachable ();
+ }
+ }
+ else
+ {
+ res[offset] = *p;
+ offset += 1;
+ p += 1;
+ }
+ }
+ res[offset] = '\0';
+
+ return res;
+}
--
2.30.2
