Signed-off-by: Jose E. Marchesi <[email protected]>
gcc/ChangeLog
* algol68/a68-low-posix.cc: New file.
* algol68/a68-low-prelude.cc: Likewise.
---
gcc/algol68/a68-low-posix.cc | 553 ++++++++
gcc/algol68/a68-low-prelude.cc | 2151 ++++++++++++++++++++++++++++++++
2 files changed, 2704 insertions(+)
create mode 100644 gcc/algol68/a68-low-posix.cc
create mode 100644 gcc/algol68/a68-low-prelude.cc
diff --git a/gcc/algol68/a68-low-posix.cc b/gcc/algol68/a68-low-posix.cc
new file mode 100644
index 00000000000..fd30677757c
--- /dev/null
+++ b/gcc/algol68/a68-low-posix.cc
@@ -0,0 +1,553 @@
+/* Lowering routines for the POSIX prelude.
+ 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"
+
+/* Set the exit status of the running process, to be returned to the OS upon
+ exit. */
+
+tree
+a68_posix_setexitstatus (void)
+{
+ return a68_get_libcall (A68_LIBCALL_SET_EXIT_STATUS);
+}
+
+/* Number of command line arguments passed to the program. */
+
+tree
+a68_posix_argc (void)
+{
+ return a68_get_libcall (A68_LIBCALL_POSIX_ARGC);
+}
+
+/* Gets the Nth command line argument passed to the program. If N is out of
+ range the result is an empty string. */
+
+tree
+a68_posix_argv (void)
+{
+ static tree argv_fndecl;
+
+ if (argv_fndecl == NULL_TREE)
+ {
+ argv_fndecl
+ = a68_low_toplevel_func_decl ("argv",
+ build_function_type_list (CTYPE
(M_STRING),
+ a68_int_type,
+ NULL_TREE));
+ announce_function (argv_fndecl);
+
+ tree param = a68_low_func_param (argv_fndecl, "n", a68_int_type);
+ DECL_ARGUMENTS (argv_fndecl) = param;
+
+ a68_push_function_range (argv_fndecl, CTYPE (M_STRING),
+ true /* top_level */);
+
+ a68_push_range (M_STRING);
+ tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0));
+ TREE_ADDRESSABLE (len) = 1;
+
+ tree ptrtochar_type = build_pointer_type (a68_char_type);
+ tree elems = a68_lower_tmpvar ("elems%", ptrtochar_type,
+ a68_build_libcall (A68_LIBCALL_POSIX_ARGV,
+ ptrtochar_type, 2,
+ param,
+ fold_build1 (ADDR_EXPR,
build_pointer_type (sizetype),
+ len)));
+ tree lower_bound = ssize_int (1);
+ tree upper_bound = fold_convert (ssizetype, len);
+ tree elems_size = fold_build2 (MULT_EXPR, sizetype,
+ len,
+ size_in_bytes (a68_char_type));
+ a68_add_stmt (a68_row_value (CTYPE (M_STRING), 1 /* dim */,
+ elems, elems_size,
+ &lower_bound, &upper_bound));
+ tree body = a68_pop_range ();
+ a68_pop_function_range (body);
+ }
+
+ return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (argv_fndecl)),
+ argv_fndecl);
+}
+
+/* Gets the value of an environment variable, or an empty string if the
+ variable is not set. */
+
+tree
+a68_posix_getenv (void)
+{
+ static tree getenv_fndecl;
+
+ if (getenv_fndecl == NULL_TREE)
+ {
+ getenv_fndecl
+ = a68_low_toplevel_func_decl ("getenv",
+ build_function_type_list (CTYPE
(M_STRING),
+ CTYPE
(M_STRING),
+ NULL_TREE));
+ announce_function (getenv_fndecl);
+
+ tree param = a68_low_func_param (getenv_fndecl, "varname", CTYPE
(M_STRING));
+ DECL_ARGUMENTS (getenv_fndecl) = param;
+
+ a68_push_function_range (getenv_fndecl, CTYPE (M_STRING),
+ true /* top_level */);
+
+ a68_push_range (M_STRING);
+
+ tree varname = a68_lower_tmpvar ("varname%", CTYPE (M_STRING),
+ param);
+
+ tree ptrtochar_type = build_pointer_type (a68_char_type);
+ tree convelems = a68_lower_tmpvar ("convelems%", ptrtochar_type,
+ build_int_cst (ptrtochar_type, 0));
+ TREE_ADDRESSABLE (convelems) = 1;
+ tree convelemslen = a68_lower_tmpvar ("convelemslen%", sizetype,
+ size_int (0));
+ TREE_ADDRESSABLE (convelemslen) = 1;
+
+ tree call = a68_build_libcall (A68_LIBCALL_POSIX_GETENV,
+ void_type_node, 5,
+ a68_multiple_elements (varname),
+ a68_multiple_num_elems (varname),
+ a68_multiple_stride (varname,
size_zero_node),
+ fold_build1 (ADDR_EXPR, build_pointer_type
(ptrtochar_type),
+ convelems),
+ fold_build1 (ADDR_EXPR, build_pointer_type
(sizetype),
+ convelemslen));
+ a68_add_stmt (call);
+ tree lower_bound = ssize_int (1);
+ tree upper_bound = fold_convert (ssizetype, convelemslen);
+ tree convelems_size = fold_build2 (MULT_EXPR, sizetype,
+ convelemslen,
+ size_in_bytes (a68_char_type));
+ a68_add_stmt (a68_row_value (CTYPE (M_STRING), 1 /* dim */,
+ convelems, convelems_size,
+ &lower_bound, &upper_bound));
+ tree body = a68_pop_range ();
+ a68_pop_function_range (body);
+ }
+
+ return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE
(getenv_fndecl)),
+ getenv_fndecl);
+}
+
+tree
+a68_posix_putchar (void)
+{
+ return a68_get_libcall (A68_LIBCALL_POSIX_PUTCHAR);
+}
+
+tree
+a68_posix_puts (void)
+{
+ static tree puts_fndecl;
+
+ if (puts_fndecl == NULL_TREE)
+ {
+ puts_fndecl
+ = a68_low_toplevel_func_decl ("puts",
+ build_function_type_list (void_type_node,
+ CTYPE
(M_STRING),
+ NULL_TREE));
+ announce_function (puts_fndecl);
+
+ tree param = a68_low_func_param (puts_fndecl, "str", CTYPE (M_STRING));
+ DECL_ARGUMENTS (puts_fndecl) = param;
+
+ a68_push_function_range (puts_fndecl, void_type_node,
+ true /* top_level */);
+
+ tree call = a68_build_libcall (A68_LIBCALL_POSIX_PUTS,
+ void_type_node, 3,
+ a68_multiple_elements (param),
+ a68_multiple_num_elems (param),
+ a68_multiple_stride (param,
size_zero_node));
+ a68_pop_function_range (call);
+ }
+
+ return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (puts_fndecl)),
+ puts_fndecl);
+}
+
+tree
+a68_posix_fconnect (void)
+{
+ static tree fconnect_fndecl;
+
+ if (fconnect_fndecl == NULL_TREE)
+ {
+ fconnect_fndecl
+ = a68_low_toplevel_func_decl ("fconnect",
+ build_function_type_list (a68_int_type,
+ CTYPE
(M_STRING),
+ a68_bits_type,
+ NULL_TREE));
+ announce_function (fconnect_fndecl);
+
+ tree host = a68_low_func_param (fconnect_fndecl, "host", CTYPE
(M_STRING));
+ tree port = a68_low_func_param (fconnect_fndecl, "port", a68_int_type);
+ DECL_ARGUMENTS (fconnect_fndecl) = chainon (host, port);
+
+ a68_push_function_range (fconnect_fndecl, a68_int_type,
+ true /* top_level */);
+
+
+ tree body = a68_build_libcall (A68_LIBCALL_POSIX_FCONNECT,
+ a68_int_type, 4,
+ a68_multiple_elements (host),
+ a68_multiple_num_elems (host),
+ a68_multiple_stride (host, size_zero_node),
+ port);
+ a68_pop_function_range (body);
+ }
+
+ return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE
(fconnect_fndecl)),
+ fconnect_fndecl);
+}
+
+tree
+a68_posix_fcreate (void)
+{
+ static tree fcreate_fndecl;
+
+ if (fcreate_fndecl == NULL_TREE)
+ {
+ fcreate_fndecl
+ = a68_low_toplevel_func_decl ("fcreate",
+ build_function_type_list (a68_int_type,
+ CTYPE
(M_STRING),
+ a68_bits_type,
+ NULL_TREE));
+ announce_function (fcreate_fndecl);
+
+ tree pathname = a68_low_func_param (fcreate_fndecl, "pathname", CTYPE
(M_STRING));
+ tree mode = a68_low_func_param (fcreate_fndecl, "mode", a68_int_type);
+ DECL_ARGUMENTS (fcreate_fndecl) = chainon (pathname, mode);
+
+ a68_push_function_range (fcreate_fndecl, a68_int_type,
+ true /* top_level */);
+
+
+ tree body = a68_build_libcall (A68_LIBCALL_POSIX_FCREATE,
+ a68_int_type, 4,
+ a68_multiple_elements (pathname),
+ a68_multiple_num_elems (pathname),
+ a68_multiple_stride (pathname,
size_zero_node),
+ mode);
+ a68_pop_function_range (body);
+ }
+
+ return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE
(fcreate_fndecl)),
+ fcreate_fndecl);
+}
+
+tree
+a68_posix_fopen (void)
+{
+ static tree fopen_fndecl;
+
+ if (fopen_fndecl == NULL_TREE)
+ {
+ fopen_fndecl
+ = a68_low_toplevel_func_decl ("fopen",
+ build_function_type_list (a68_int_type,
+ CTYPE
(M_STRING),
+ a68_bits_type,
+ NULL_TREE));
+ announce_function (fopen_fndecl);
+
+ tree pathname = a68_low_func_param (fopen_fndecl, "pathname", CTYPE
(M_STRING));
+ tree flags = a68_low_func_param (fopen_fndecl, "flags", a68_int_type);
+ DECL_ARGUMENTS (fopen_fndecl) = chainon (pathname, flags);
+
+ a68_push_function_range (fopen_fndecl, a68_int_type,
+ true /* top_level */);
+
+
+ tree body = a68_build_libcall (A68_LIBCALL_POSIX_FOPEN,
+ a68_int_type, 4,
+ a68_multiple_elements (pathname),
+ a68_multiple_num_elems (pathname),
+ a68_multiple_stride (pathname,
size_zero_node),
+ flags);
+ a68_pop_function_range (body);
+ }
+
+ return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fopen_fndecl)),
+ fopen_fndecl);
+}
+
+tree
+a68_posix_fclose (void)
+{
+ return a68_get_libcall (A68_LIBCALL_POSIX_FCLOSE);
+}
+
+tree
+a68_posix_fsize (void)
+{
+ return a68_get_libcall (A68_LIBCALL_POSIX_FSIZE);
+}
+
+tree
+a68_posix_errno (void)
+{
+ return a68_get_libcall (A68_LIBCALL_POSIX_ERRNO);
+}
+
+tree
+a68_posix_perror (void)
+{
+ static tree perror_fndecl;
+
+ if (perror_fndecl == NULL_TREE)
+ {
+ perror_fndecl
+ = a68_low_toplevel_func_decl ("perror",
+ build_function_type_list (void_type_node,
+ CTYPE
(M_STRING),
+ NULL_TREE));
+ announce_function (perror_fndecl);
+
+ tree str = a68_low_func_param (perror_fndecl, "str", CTYPE (M_STRING));
+ DECL_ARGUMENTS (perror_fndecl) = str;
+
+ a68_push_function_range (perror_fndecl, void_type_node,
+ true /* top_level */);
+
+ tree body = a68_build_libcall (A68_LIBCALL_POSIX_PERROR,
+ a68_int_type, 3,
+ a68_multiple_elements (str),
+ a68_multiple_num_elems (str),
+ a68_multiple_stride (str, size_zero_node));
+ a68_pop_function_range (body);
+ }
+
+ return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE
(perror_fndecl)),
+ perror_fndecl);
+}
+
+tree
+a68_posix_strerror (void)
+{
+ static tree strerror_fndecl;
+
+ if (strerror_fndecl == NULL_TREE)
+ {
+ strerror_fndecl
+ = a68_low_toplevel_func_decl ("strerror",
+ build_function_type_list (CTYPE
(M_STRING),
+ a68_int_type,
+ NULL_TREE));
+ announce_function (strerror_fndecl);
+
+ tree errnum = a68_low_func_param (strerror_fndecl, "errnum",
a68_int_type);
+ DECL_ARGUMENTS (strerror_fndecl) = errnum;
+
+ a68_push_function_range (strerror_fndecl, CTYPE (M_STRING),
+ true /* top_level */);
+
+ tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0));
+ TREE_ADDRESSABLE (len) = 1;
+
+ tree call = a68_build_libcall (A68_LIBCALL_POSIX_STRERROR,
+ void_type_node, 2,
+ errnum,
+ fold_build1 (ADDR_EXPR, build_pointer_type
(sizetype), len));
+ tree elems = a68_lower_tmpvar ("elems%", build_pointer_type
(a68_char_type), call);
+
+ tree lower_bound = ssize_int (1);
+ 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_value (CTYPE (M_STRING), 1 /* dim */,
+ elems, elems_size,
+ &lower_bound, &upper_bound);
+ a68_pop_function_range (body);
+ }
+
+ return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE
(strerror_fndecl)),
+ strerror_fndecl);
+}
+
+tree
+a68_posix_getchar (void)
+{
+ return a68_get_libcall (A68_LIBCALL_POSIX_GETCHAR);
+}
+
+tree
+a68_posix_fgetc (void)
+{
+ return a68_get_libcall (A68_LIBCALL_POSIX_FGETC);
+}
+
+tree
+a68_posix_fputc (void)
+{
+ return a68_get_libcall (A68_LIBCALL_POSIX_FPUTC);
+}
+
+tree
+a68_posix_fputs (void)
+{
+ static tree fputs_fndecl;
+
+ if (fputs_fndecl == NULL_TREE)
+ {
+ fputs_fndecl
+ = a68_low_toplevel_func_decl ("fputs",
+ build_function_type_list (a68_int_type,
+ a68_int_type,
+ CTYPE
(M_STRING),
+ NULL_TREE));
+ announce_function (fputs_fndecl);
+
+ tree fd = a68_low_func_param (fputs_fndecl, "fd", a68_int_type);
+ tree str = a68_low_func_param (fputs_fndecl, "str", CTYPE (M_STRING));
+ DECL_ARGUMENTS (fputs_fndecl) = chainon (fd, str);
+
+ a68_push_function_range (fputs_fndecl, a68_int_type,
+ true /* top_level */);
+
+
+ tree body = a68_build_libcall (A68_LIBCALL_POSIX_FPUTS,
+ a68_int_type, 4,
+ fd,
+ a68_multiple_elements (str),
+ a68_multiple_num_elems (str),
+ a68_multiple_stride (str, size_zero_node));
+ a68_pop_function_range (body);
+ }
+
+ return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fputs_fndecl)),
+ fputs_fndecl);
+}
+
+tree
+a68_posix_fgets (void)
+{
+ static tree fgets_fndecl;
+
+ if (fgets_fndecl == NULL_TREE)
+ {
+ fgets_fndecl
+ = a68_low_toplevel_func_decl ("fgets",
+ build_function_type_list (CTYPE
(M_REF_STRING),
+ a68_int_type,
+ a68_int_type,
+ NULL_TREE));
+ announce_function (fgets_fndecl);
+
+ tree fd = a68_low_func_param (fgets_fndecl, "fd", a68_int_type);
+ tree n = a68_low_func_param (fgets_fndecl, "n", a68_int_type);
+ DECL_ARGUMENTS (fgets_fndecl) = chainon (fd, n);
+
+ a68_push_function_range (fgets_fndecl, CTYPE (M_REF_STRING),
+ true /* top_level */);
+
+ tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0));
+ TREE_ADDRESSABLE (len) = 1;
+
+ tree call = a68_build_libcall (A68_LIBCALL_POSIX_FGETS,
+ CTYPE (M_REF_STRING), 3,
+ fd, n,
+ fold_build1 (ADDR_EXPR, build_pointer_type
(sizetype), len));
+ tree elems = a68_lower_tmpvar ("elems%", build_pointer_type
(a68_char_type), call);
+
+ tree lower_bound = ssize_int (1);
+ 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 */,
+ elems, elems_size,
+ &lower_bound, &upper_bound);
+ a68_pop_function_range (body);
+ }
+
+ return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fgets_fndecl)),
+ fgets_fndecl);
+}
+
+tree
+a68_posix_gets (void)
+{
+ static tree gets_fndecl;
+
+ if (gets_fndecl == NULL_TREE)
+ {
+ gets_fndecl
+ = a68_low_toplevel_func_decl ("gets",
+ build_function_type_list (CTYPE
(M_REF_STRING),
+ a68_int_type,
+ NULL_TREE));
+ announce_function (gets_fndecl);
+
+ tree n = a68_low_func_param (gets_fndecl, "n", a68_int_type);
+ DECL_ARGUMENTS (gets_fndecl) = n;
+
+ a68_push_function_range (gets_fndecl, CTYPE (M_REF_STRING),
+ true /* top_level */);
+
+ tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0));
+ TREE_ADDRESSABLE (len) = 1;
+
+ tree call = a68_build_libcall (A68_LIBCALL_POSIX_GETS,
+ CTYPE (M_REF_STRING), 2,
+ n, fold_build1 (ADDR_EXPR,
build_pointer_type (sizetype), len));
+ tree elems = a68_lower_tmpvar ("elems%", build_pointer_type
(a68_char_type), call);
+
+ tree lower_bound = ssize_int (1);
+ 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 */,
+ elems, elems_size,
+ &lower_bound, &upper_bound);
+ a68_pop_function_range (body);
+ }
+
+ return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (gets_fndecl)),
+ gets_fndecl);
+}
diff --git a/gcc/algol68/a68-low-prelude.cc b/gcc/algol68/a68-low-prelude.cc
new file mode 100644
index 00000000000..944db198a83
--- /dev/null
+++ b/gcc/algol68/a68-low-prelude.cc
@@ -0,0 +1,2151 @@
+/* Lower Algol 68 pre-defined operators and 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 "convert.h"
+
+#include "a68.h"
+
+/* The following handlers are for lowing the entities defined in
+ a68-parser-prelude.c. */
+
+tree
+a68_lower_unimplemented (NODE_T *p,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ fatal_error (a68_get_node_location (p),
+ "no lowering routine installed for construct. jemarch has been
lazy");
+}
+
+tree
+a68_lower_charabs2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+ return a68_char_abs (op);
+}
+
+tree
+a68_lower_boolabs2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+ return a68_bool_abs (op);
+}
+
+tree
+a68_lower_intabs2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+ return a68_int_abs (op);
+}
+
+tree
+a68_lower_realabs2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+ return a68_real_abs (op);
+}
+
+tree
+a68_lower_confirm2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ /* Used to implement monadic +. */
+ return a68_lower_tree (NEXT (SUB (p)), ctx);
+}
+
+tree
+a68_lower_negate2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ return fold_build1_loc (a68_get_node_location (p),
+ NEGATE_EXPR,
+ CTYPE (MOID (p)),
+ a68_lower_tree (NEXT (SUB (p)), ctx));
+}
+
+/* Lower an ENTIER standard monadic operator. */
+
+tree
+a68_lower_entier2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ NODE_T *op = NEXT (SUB (p));
+ return a68_real_entier (a68_lower_tree (op, ctx), MOID (p), MOID (op));
+}
+
+/* Lower a ROUND standard monadic operator.
+
+ This operator gets a LONGSETY REAL and produces a LONGSETY INT which is the
+ nearest integer to the given real. */
+
+tree
+a68_lower_round2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ NODE_T *op = NEXT (SUB (p));
+ return a68_real_round (a68_lower_tree (op, ctx), MOID (p), MOID (op));
+}
+
+tree
+a68_lower_not2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ return fold_build1_loc (a68_get_node_location (p),
+ TRUTH_NOT_EXPR,
+ CTYPE (MOID (p)),
+ a68_lower_tree (NEXT (SUB (p)), ctx));
+}
+
+tree
+a68_lower_and3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ return fold_build2_loc (a68_get_node_location (p),
+ TRUTH_AND_EXPR,
+ CTYPE (MOID (p)),
+ a68_lower_tree (SUB (p), ctx),
+ a68_lower_tree (NEXT (NEXT (SUB (p))), ctx));
+}
+
+tree
+a68_lower_or3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ return fold_build2_loc (a68_get_node_location (p),
+ TRUTH_OR_EXPR,
+ CTYPE (MOID (p)),
+ a68_lower_tree (SUB (p), ctx),
+ a68_lower_tree (NEXT (NEXT (SUB (p))), ctx));
+}
+
+tree
+a68_lower_xor3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ return fold_build2_loc (a68_get_node_location (p),
+ TRUTH_XOR_EXPR,
+ CTYPE (MOID (p)),
+ a68_lower_tree (SUB (p), ctx),
+ a68_lower_tree (NEXT (NEXT (SUB (p))), ctx));
+}
+
+tree
+a68_lower_plus_int (NODE_T *p, LOW_CTX_T ctx)
+{
+ MOID_T *m = MOID (p);
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_int_plus (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_plus_real (NODE_T *p, LOW_CTX_T ctx)
+{
+ MOID_T *m = MOID (p);
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_real_plus (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_minus_int (NODE_T *p, LOW_CTX_T ctx)
+{
+ MOID_T *m = MOID (p);
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_int_minus (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_minus_real (NODE_T *p, LOW_CTX_T ctx)
+{
+ MOID_T *m = MOID (p);
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_real_minus (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_mult_int (NODE_T *p, LOW_CTX_T ctx)
+{
+ MOID_T *m = MOID (p);
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_int_mult (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_mult_real (NODE_T *p, LOW_CTX_T ctx)
+{
+ MOID_T *m = MOID (p);
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_real_mult (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_multab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree lhs = a68_lower_tree (SUB (p), ctx);
+ lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+ lhs = save_expr (lhs);
+ NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+ tree rhs = a68_lower_tree (rhs_node, ctx);
+ tree operation = fold_build2_loc (a68_get_node_location (p),
+ MULT_EXPR,
+ TREE_TYPE (rhs),
+ a68_low_deref (lhs, SUB (p)),
+ rhs);
+
+ return fold_build2_loc (a68_get_node_location (p),
+ COMPOUND_EXPR,
+ TREE_TYPE (lhs),
+ a68_low_assignation (p, lhs, MOID (SUB (p)),
operation, MOID (rhs_node)),
+ lhs);
+}
+
+tree
+a68_lower_over3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ MOID_T *m = MOID (p);
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_int_div (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_mod3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ MOID_T *m = MOID (p);
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_int_mod (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_div3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ return a68_real_div (MOID (p),
+ a68_lower_tree (SUB (p), ctx),
+ a68_lower_tree (NEXT (NEXT (SUB (p))), ctx),
+ a68_get_node_location (p));
+}
+
+tree
+a68_lower_rdiv3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ return a68_real_div (MOID (p),
+ fold_build1 (FLOAT_EXPR, CTYPE (MOID (p)),
+ a68_lower_tree (SUB (p), ctx)),
+ fold_build1 (FLOAT_EXPR, CTYPE (MOID (p)),
+ a68_lower_tree (NEXT (NEXT (SUB (p))),
ctx)),
+ a68_get_node_location (p));
+}
+
+tree
+a68_lower_int_eq3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_int_eq (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_int_ne3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_int_ne (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_int_lt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_int_lt (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_int_le3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_int_le (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_int_gt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_int_gt (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_int_ge3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_int_ge (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_real_eq3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_real_eq (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_real_ne3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_real_ne (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_real_lt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_real_lt (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_real_le3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_real_le (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_real_gt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_real_gt (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_real_ge3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_real_ge (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_char_eq3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_char_eq (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_char_ne3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_char_ne (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_char_lt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_char_lt (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_char_le3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_char_le (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_char_gt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_char_gt (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_char_ge3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_char_ge (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_bool_eq3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_bool_eq (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_bool_ne3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_bool_ne (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_sign2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+ return a68_int_sign (op);
+}
+
+tree
+a68_lower_realsign2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+ return a68_real_sign (op);
+}
+
+tree
+a68_lower_plusab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree lhs = a68_lower_tree (SUB (p), ctx);
+ lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+ lhs = save_expr (lhs);
+ NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+ tree rhs = a68_lower_tree (rhs_node, ctx);
+ tree operation = fold_build2_loc (a68_get_node_location (p),
+ PLUS_EXPR,
+ TREE_TYPE (rhs),
+ a68_low_deref (lhs, SUB (p)),
+ rhs);
+
+ return fold_build2_loc (a68_get_node_location (p),
+ COMPOUND_EXPR,
+ TREE_TYPE (lhs),
+ a68_low_assignation (p, lhs, MOID (SUB (p)),
operation, MOID (rhs_node)),
+ lhs);
+}
+
+tree
+a68_lower_minusab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree lhs = a68_lower_tree (SUB (p), ctx);
+ lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+ lhs = save_expr (lhs);
+ NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+ tree rhs = a68_lower_tree (rhs_node, ctx);
+ tree operation = fold_build2_loc (a68_get_node_location (p),
+ MINUS_EXPR,
+ TREE_TYPE (rhs),
+ a68_low_deref (lhs, SUB (p)),
+ rhs);
+
+ return fold_build2_loc (a68_get_node_location (p),
+ COMPOUND_EXPR,
+ TREE_TYPE (lhs),
+ a68_low_assignation (p, lhs, MOID (SUB (p)),
operation, MOID (rhs_node)),
+ lhs);
+}
+
+tree
+a68_lower_overab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree lhs = a68_lower_tree (SUB (p), ctx);
+ lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+ lhs = save_expr (lhs);
+ NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+ tree rhs = a68_lower_tree (rhs_node, ctx);
+ tree operation = fold_build2_loc (a68_get_node_location (p),
+ TRUNC_DIV_EXPR,
+ TREE_TYPE (rhs),
+ a68_low_deref (lhs, SUB (p)),
+ rhs);
+
+ return fold_build2_loc (a68_get_node_location (p),
+ COMPOUND_EXPR,
+ TREE_TYPE (lhs),
+ a68_low_assignation (p, lhs, MOID (SUB (p)),
operation, MOID (rhs_node)),
+ lhs);
+}
+
+tree
+a68_lower_modab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree lhs = a68_lower_tree (SUB (p), ctx);
+ lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+ lhs = save_expr (lhs);
+ NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+ tree rhs = a68_lower_tree (rhs_node, ctx);
+ tree operation = fold_build2_loc (a68_get_node_location (p),
+ TRUNC_MOD_EXPR,
+ TREE_TYPE (rhs),
+ a68_low_deref (lhs, SUB (p)),
+ rhs);
+
+ return fold_build2_loc (a68_get_node_location (p),
+ COMPOUND_EXPR,
+ TREE_TYPE (lhs),
+ a68_low_assignation (p, lhs, MOID (SUB (p)),
operation, MOID (rhs_node)),
+ lhs);
+}
+
+tree
+a68_lower_divab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree lhs = a68_lower_tree (SUB (p), ctx);
+ lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+ lhs = save_expr (lhs);
+ NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+ tree rhs = a68_lower_tree (rhs_node, ctx);
+ tree operation = fold_build2_loc (a68_get_node_location (p),
+ RDIV_EXPR,
+ TREE_TYPE (rhs),
+ a68_low_deref (lhs, SUB (p)),
+ rhs);
+
+ return fold_build2_loc (a68_get_node_location (p),
+ COMPOUND_EXPR,
+ TREE_TYPE (lhs),
+ a68_low_assignation (p, lhs, MOID (SUB (p)),
operation, MOID (rhs_node)),
+ lhs);
+}
+
+/* UPB comes in two flavors.
+
+ The unary operator returns the upper bound of the first dimension of the
+ operand multple.
+
+ The binary operator returns the upper bound of the given dimension of the
+ operand multiple. The dimension is one-based. If the specified dimension
+ is out of bounds then an a run-time error is raised. */
+
+static tree
+upb (NODE_T *p, tree boundable, tree dim)
+{
+ boundable = save_expr (boundable);
+ dim = save_expr (dim);
+
+ /* BOUNDABLE can be a multiple or a ROWS. */
+ tree zero_based_dim
+ = save_expr (fold_build2 (MINUS_EXPR, TREE_TYPE (dim), dim,
size_one_node));
+ tree type = TREE_TYPE (boundable);
+ if (A68_ROW_TYPE_P (type))
+ {
+ return fold_build2 (COMPOUND_EXPR, ssizetype,
+ a68_multiple_dim_check (p, boundable, dim),
+ a68_multiple_upper_bound (boundable, zero_based_dim));
+ }
+ else if (A68_ROWS_TYPE_P (type))
+ {
+ return fold_build2 (COMPOUND_EXPR, ssizetype,
+ a68_rows_dim_check (p, boundable, dim),
+ a68_rows_upper_bound (boundable, zero_based_dim));
+ }
+ else
+ gcc_unreachable ();
+}
+
+tree
+a68_lower_upb2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree multiple = a68_lower_tree (NEXT (SUB (p)), ctx);
+ return fold_convert (CTYPE (MOID (p)), upb (p, multiple, size_one_node));
+}
+
+tree
+a68_lower_upb3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree dim = fold_convert (sizetype, a68_lower_tree (SUB (p), ctx));
+ tree multiple = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return fold_convert (CTYPE (MOID (p)), upb (p, multiple, dim));
+}
+
+/* LWB comes in two flavors.
+
+ The unary operator returns the lower bound of the first dimension of the
+ operand multple.
+
+ The binary operator returns the lower bound of the given dimension of the
+ operand multiple. The dimension is one-based. If the specified dimension
+ is out of bounds then an a run-time error is raised. */
+
+static tree
+lwb (NODE_T *p, tree boundable, tree dim)
+{
+ boundable = save_expr (boundable);
+ dim = save_expr (dim);
+
+ /* BOUNDABLE can be a multiple or an union whose all alternatives yield a
+ multiple. */
+ tree zero_based_dim
+ = save_expr (fold_build2 (MINUS_EXPR, TREE_TYPE (dim), dim,
size_one_node));
+ tree type = TREE_TYPE (boundable);
+ if (A68_ROW_TYPE_P (type))
+ {
+ return fold_build2 (COMPOUND_EXPR, ssizetype,
+ a68_multiple_dim_check (p, boundable, dim),
+ a68_multiple_lower_bound (boundable, zero_based_dim));
+ }
+ else if (A68_ROWS_TYPE_P (type))
+ {
+ return fold_build2 (COMPOUND_EXPR, ssizetype,
+ a68_rows_dim_check (p, boundable, dim),
+ a68_rows_lower_bound (boundable, zero_based_dim));
+ }
+ else
+ gcc_unreachable ();
+}
+
+tree
+a68_lower_lwb2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree multiple = a68_lower_tree (NEXT (SUB (p)), ctx);
+ return fold_convert (CTYPE (MOID (p)), lwb (p, multiple, size_one_node));
+}
+
+tree
+a68_lower_lwb3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree dim = fold_convert (sizetype, a68_lower_tree (SUB (p), ctx));
+ tree multiple = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return fold_convert (CTYPE (MOID (p)), lwb (p, multiple, dim));
+}
+
+/* ELEMS comes in two flavors.
+
+ The unary operator returns the number of elements in the first dimension of
+ the operand multple.
+
+ DIM must be a size.
+
+ The binary operator returns the number of elements in the given dimension
of the
+ operand multiple. The dimension is one-based. If the specified dimension
+ is out of bounds then an a run-time error is raised. */
+
+static tree
+elems (NODE_T *p, tree boundable, tree dim)
+{
+ dim = save_expr (dim);
+
+ /* BOUNDABLE can be a multiple or a ROWS. */
+ tree type = TREE_TYPE (boundable);
+
+ /* Make DIM zero-based. */
+ tree dim_minus_one
+ = fold_build2 (MINUS_EXPR, TREE_TYPE (dim), dim, size_one_node);
+
+ boundable = save_expr (boundable);
+ tree upper_bound = NULL_TREE;
+ tree lower_bound = NULL_TREE;
+ tree check_dimension = NULL_TREE;
+ if (A68_ROW_TYPE_P (type))
+ {
+ upper_bound = a68_multiple_upper_bound (boundable, dim_minus_one);
+ lower_bound = a68_multiple_lower_bound (boundable, dim_minus_one);
+ check_dimension = a68_multiple_dim_check (p, boundable, dim);
+ }
+ else if (A68_ROWS_TYPE_P (type))
+ {
+ upper_bound = a68_rows_upper_bound (boundable, dim_minus_one);
+ lower_bound = a68_rows_lower_bound (boundable, dim_minus_one);
+ check_dimension = a68_rows_dim_check (p, boundable, dim);
+ }
+ else
+ gcc_unreachable ();
+
+ upper_bound = save_expr (upper_bound);
+ lower_bound = save_expr (lower_bound);
+
+ tree non_flat = fold_build2 (PLUS_EXPR,
+ sizetype,
+ fold_convert (sizetype,
+ fold_build2 (MINUS_EXPR, ssizetype,
+ upper_bound,
lower_bound)),
+ size_one_node);
+
+ tree elems = fold_build3 (COND_EXPR, sizetype,
+ fold_build2 (LT_EXPR, boolean_type_node,
+ upper_bound, lower_bound),
+ size_zero_node,
+ non_flat);
+
+ if (OPTION_BOUNDS_CHECKING (&A68_JOB))
+ elems = fold_build2 (COMPOUND_EXPR, sizetype,
+ check_dimension,
+ elems);
+
+ return elems;
+}
+
+tree
+a68_lower_elems2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree multiple = a68_lower_tree (NEXT (SUB (p)), ctx);
+ return fold_convert (CTYPE (MOID (p)), elems (p, multiple, size_one_node));
+}
+
+tree
+a68_lower_elems3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree dim = fold_convert (sizetype, a68_lower_tree (SUB (p), ctx));
+ tree multiple = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return fold_convert (CTYPE (MOID (p)), elems (p, multiple, dim));
+}
+
+tree
+a68_lower_pow_int (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_int_pow (MOID (p), op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_pow_real (NODE_T *p, LOW_CTX_T ctx)
+{
+ MOID_T *mode = MOID (p);
+ MOID_T *op1_mode = MOID (SUB (p));
+ MOID_T *op2_mode = MOID (NEXT (NEXT (SUB (p))));
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_real_pow (mode, op1_mode, op2_mode,
+ op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_odd2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ NODE_T *op = NEXT (SUB (p));
+
+ return fold_build2_loc (a68_get_node_location (p),
+ EQ_EXPR,
+ a68_bool_type,
+ fold_build2 (BIT_AND_EXPR,
+ CTYPE (MOID (op)),
+ a68_lower_tree (op, ctx),
+ build_int_cst (CTYPE (MOID (op)), 1)),
+ build_int_cst (CTYPE (MOID (op)), 1));
+}
+
+tree
+a68_lower_string_eq3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ tree cmp = a68_string_cmp (op1, op2);
+
+ return fold_build2_loc (a68_get_node_location (p),
+ EQ_EXPR,
+ a68_bool_type,
+ cmp,
+ build_int_cst (a68_int_type, 0));
+}
+
+tree
+a68_lower_string_ne3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ tree cmp = a68_string_cmp (op1, op2);
+
+ return fold_build2_loc (a68_get_node_location (p),
+ NE_EXPR,
+ a68_bool_type,
+ cmp,
+ build_int_cst (a68_int_type, 0));
+}
+
+tree
+a68_lower_string_lt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ tree cmp = a68_string_cmp (op1, op2);
+
+ return fold_build2_loc (a68_get_node_location (p),
+ LT_EXPR,
+ a68_bool_type,
+ cmp,
+ build_int_cst (a68_int_type, 0));
+}
+
+tree
+a68_lower_string_le3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ tree cmp = a68_string_cmp (op1, op2);
+
+ return fold_build2_loc (a68_get_node_location (p),
+ LE_EXPR,
+ a68_bool_type,
+ cmp,
+ build_int_cst (a68_int_type, 0));
+}
+
+tree
+a68_lower_string_gt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ tree cmp = a68_string_cmp (op1, op2);
+
+ return fold_build2_loc (a68_get_node_location (p),
+ GT_EXPR,
+ a68_bool_type,
+ cmp,
+ build_int_cst (a68_int_type, 0));
+}
+
+tree
+a68_lower_string_ge3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ tree cmp = a68_string_cmp (op1, op2);
+
+ return fold_build2_loc (a68_get_node_location (p),
+ GE_EXPR,
+ a68_bool_type,
+ cmp,
+ build_int_cst (a68_int_type, 0));
+}
+
+tree
+a68_lower_string_plus3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ return a68_string_concat (a68_lower_tree (SUB (p), ctx),
+ a68_lower_tree (NEXT (NEXT (SUB (p))), ctx));
+}
+
+tree
+a68_lower_string_plusab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree lhs = a68_lower_tree (SUB (p), ctx);
+ lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+ lhs = save_expr (lhs);
+ NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+ tree rhs = a68_lower_tree (rhs_node, ctx);
+ tree operation = a68_string_concat (a68_low_deref (lhs, SUB (p)), rhs);
+
+ return fold_build2_loc (a68_get_node_location (p),
+ COMPOUND_EXPR,
+ TREE_TYPE (lhs),
+ a68_low_assignation (p, lhs, MOID (SUB (p)),
operation, MOID (rhs_node)),
+ lhs);
+}
+
+tree
+a68_lower_string_plusto3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ NODE_T *lhs_node = NEXT (NEXT (SUB (p)));
+ tree lhs = a68_lower_tree (lhs_node, ctx);
+ lhs = a68_consolidate_ref (MOID (lhs_node), lhs);
+ lhs = save_expr (lhs);
+ MOID_T *lhs_mode = MOID (lhs_node);
+ NODE_T *rhs_node = SUB (p);
+ tree rhs = a68_lower_tree (rhs_node, ctx);
+ tree operation = a68_string_concat (rhs, a68_low_deref (lhs, NEXT (NEXT (SUB
(p)))));
+
+ return fold_build2_loc (a68_get_node_location (p),
+ COMPOUND_EXPR,
+ TREE_TYPE (lhs),
+ a68_low_assignation (p, lhs, lhs_mode,
+ operation, MOID (rhs_node)),
+ lhs);
+}
+
+tree
+a68_lower_repr2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ NODE_T *op = NEXT (SUB (p));
+ return a68_char_repr (op, a68_lower_tree (op, ctx));
+}
+
+tree
+a68_lower_char_plus3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+ return a68_string_concat (a68_string_from_char (op1),
+ a68_string_from_char (op2));
+}
+
+tree
+a68_lower_char_mult3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ NODE_T *n1 = SUB (p);
+ NODE_T *n2 = NEXT (NEXT (SUB (p)));
+
+ if (MOID (n1) == M_INT)
+ {
+ gcc_assert (MOID (n2) == M_STRING || MOID (n2) == M_ROW_CHAR);
+ return a68_string_mult (a68_string_from_char (a68_lower_tree (n2, ctx)),
+ a68_lower_tree (n1, ctx));
+ }
+ else
+ {
+ gcc_assert (MOID (n1) == M_CHAR);
+ gcc_assert (MOID (n2) == M_INT);
+ return a68_string_mult (a68_string_from_char (a68_lower_tree (n1, ctx)),
+ a68_lower_tree (n2, ctx));
+ }
+}
+
+tree
+a68_lower_string_mult3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ NODE_T *n1 = SUB (p);
+ NODE_T *n2 = NEXT (NEXT (SUB (p)));
+
+ if (MOID (n1) == M_INT)
+ {
+ gcc_assert (MOID (n2) == M_STRING || MOID (n2) == M_ROW_CHAR);
+ return a68_string_mult (a68_lower_tree (n2, ctx),
+ a68_lower_tree (n1, ctx));
+ }
+ else
+ {
+ gcc_assert (MOID (n1) == M_STRING || MOID (n1) == M_ROW_CHAR);
+ gcc_assert (MOID (n2) == M_INT);
+ return a68_string_mult (a68_lower_tree (n1, ctx),
+ a68_lower_tree (n2, ctx));
+ }
+}
+
+tree
+a68_lower_string_multab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree lhs = a68_lower_tree (SUB (p), ctx);
+ lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+ lhs = save_expr (lhs);
+ NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+ tree rhs = a68_lower_tree (rhs_node, ctx);
+ tree operation = a68_string_mult (a68_low_deref (lhs, SUB (p)), rhs);
+
+ return fold_build2_loc (a68_get_node_location (p),
+ COMPOUND_EXPR,
+ TREE_TYPE (lhs),
+ a68_low_assignation (p, lhs, MOID (SUB (p)),
operation, MOID (rhs_node)),
+ lhs);
+}
+
+/* SIZETY BITS operators. */
+
+tree
+a68_lower_bin2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+ return a68_bits_bin (MOID (p), op);
+}
+
+tree
+a68_lower_bitabs2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+ return a68_bits_abs (MOID (p), op);
+}
+
+tree
+a68_lower_bitleng2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+ return a68_bits_leng (CTYPE (MOID (p)), op);
+}
+
+tree
+a68_lower_bitshorten2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+ return a68_bits_shorten (CTYPE (MOID (p)), op);
+}
+
+tree
+a68_lower_bitnot2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+ return a68_bits_not (op);
+}
+
+tree
+a68_lower_bitand3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_bits_and (op1, op2);
+}
+
+tree
+a68_lower_bitior3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_bits_ior (op1, op2);
+}
+
+tree
+a68_lower_bitxor3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_bits_xor (op1, op2);
+}
+
+tree
+a68_lower_shl3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree bits = a68_lower_tree (SUB (p), ctx);
+ tree shift = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_bits_shift (shift, bits);
+}
+
+tree
+a68_lower_shr3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree bits = a68_lower_tree (SUB (p), ctx);
+ tree shift = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_bits_shift (fold_build1 (NEGATE_EXPR,
+ TREE_TYPE (shift), shift),
+ bits);
+}
+
+tree
+a68_lower_bitelem3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree pos = a68_lower_tree (SUB (p), ctx);
+ tree bits = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_bits_elem (p, pos, bits);
+}
+
+tree
+a68_lower_bit_eq3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_bits_eq (op1, op2);
+}
+
+tree
+a68_lower_bit_ne3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_bits_ne (op1, op2);
+}
+
+tree
+a68_lower_bit_le3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_bits_subset (op1, op2);
+}
+
+tree
+a68_lower_bit_ge3 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ return a68_bits_subset (op2, op1);
+}
+
+/* Environment enquiries. */
+
+tree
+a68_lower_maxint (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return a68_int_maxval (CTYPE (MOID (p)));
+}
+
+tree
+a68_lower_minint (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return a68_int_minval (CTYPE (MOID (p)));
+}
+
+tree
+a68_lower_maxbits (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return a68_bits_maxbits (CTYPE (MOID (p)));
+}
+
+tree
+a68_lower_maxreal (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return a68_real_maxval (CTYPE (MOID (p)));
+}
+
+tree
+a68_lower_minreal (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return a68_real_minval (CTYPE (MOID (p)));
+}
+
+tree
+a68_lower_smallreal (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return a68_real_smallval (CTYPE (MOID (p)));
+}
+
+tree
+a68_lower_bitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ return a68_bits_width (a68_bits_type);
+}
+
+tree
+a68_lower_longbitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ return a68_bits_width (a68_long_bits_type);
+}
+
+tree
+a68_lower_longlongbitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ return a68_bits_width (a68_long_long_bits_type);
+}
+
+tree
+a68_lower_shortbitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ return a68_bits_width (a68_short_bits_type);
+}
+
+tree
+a68_lower_shortshortbitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ return a68_bits_width (a68_short_short_bits_type);
+}
+
+tree
+a68_lower_intwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return a68_int_width (a68_int_type);
+}
+
+tree
+a68_lower_longintwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ return a68_int_width (a68_long_int_type);
+}
+
+tree
+a68_lower_longlongintwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ return a68_int_width (a68_long_long_int_type);
+}
+
+tree
+a68_lower_shortintwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ return a68_int_width (a68_short_int_type);
+}
+
+tree
+a68_lower_shortshortintwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ return a68_int_width (a68_short_short_int_type);
+}
+
+tree
+a68_lower_realwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ return a68_real_width (a68_real_type);
+}
+
+tree
+a68_lower_longrealwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ return a68_real_width (a68_long_real_type);
+}
+
+tree
+a68_lower_longlongrealwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ return a68_real_width (a68_long_long_real_type);
+}
+
+tree
+a68_lower_expwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return a68_real_exp_width (a68_real_type);
+}
+
+tree
+a68_lower_longexpwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ return a68_real_exp_width (a68_long_real_type);
+}
+
+tree
+a68_lower_longlongexpwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ return a68_real_exp_width (a68_long_long_real_type);
+}
+
+tree
+a68_lower_pi (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return a68_real_pi (CTYPE (MOID (p)));
+}
+
+tree
+a68_lower_nullcharacter (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ static tree null_character = NULL_TREE;
+
+ if (null_character == NULL_TREE)
+ null_character = build_int_cst (a68_char_type, 0);
+ return null_character;
+}
+
+tree
+a68_lower_flip (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ static tree flip = NULL_TREE;
+
+ if (flip == NULL_TREE)
+ flip = build_int_cst (a68_char_type, 84); /* T */
+ return flip;
+}
+
+tree
+a68_lower_invalidchar (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ static tree invalidchar = NULL_TREE;
+
+ if (invalidchar == NULL_TREE)
+ invalidchar = build_int_cst (a68_char_type, 0xfffd);
+ return invalidchar;
+}
+
+tree
+a68_lower_flop (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ static tree flop = NULL_TREE;
+
+ if (flop == NULL_TREE)
+ flop = build_int_cst (a68_char_type, 70); /* F */
+ return flop;
+}
+
+tree
+a68_lower_errorchar (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ static tree errorchar = NULL_TREE;
+
+ if (errorchar == NULL_TREE)
+ errorchar = build_int_cst (a68_char_type, 42); /* * */
+ return errorchar;
+}
+
+tree
+a68_lower_blank (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ static tree blank = NULL_TREE;
+
+ if (blank == NULL_TREE)
+ blank = build_int_cst (a68_char_type, 32);
+ return blank;
+}
+
+tree
+a68_lower_intlengths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ HOST_WIDE_INT int_size = int_size_in_bytes (a68_int_type);
+ HOST_WIDE_INT long_int_size = int_size_in_bytes (a68_long_int_type);
+ HOST_WIDE_INT long_long_int_size = int_size_in_bytes
(a68_long_long_int_type);
+
+ gcc_assert (int_size != -1);
+ gcc_assert (long_int_size != -1);
+ gcc_assert (long_long_int_size != -1);
+
+ int lengths = 1;
+ if (long_long_int_size != long_int_size)
+ lengths++;
+ if (long_int_size != int_size)
+ lengths++;
+
+ return build_int_cst (CTYPE (MOID (p)), lengths);
+}
+
+tree
+a68_lower_intshorths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ HOST_WIDE_INT int_size = int_size_in_bytes (a68_int_type);
+ HOST_WIDE_INT short_int_size = int_size_in_bytes (a68_short_int_type);
+ HOST_WIDE_INT short_short_int_size = int_size_in_bytes
(a68_short_short_int_type);
+
+ gcc_assert (int_size != -1);
+ gcc_assert (short_int_size != -1);
+ gcc_assert (short_short_int_size != -1);
+
+ int shorths = 1;
+ if (short_short_int_size != short_int_size)
+ shorths++;
+ if (short_int_size != int_size)
+ shorths++;
+
+ return build_int_cst (CTYPE (MOID (p)), shorths);
+}
+
+tree
+a68_lower_bitslengths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ HOST_WIDE_INT bits_size = int_size_in_bytes (a68_bits_type);
+ HOST_WIDE_INT long_bits_size = int_size_in_bytes (a68_long_bits_type);
+ HOST_WIDE_INT long_long_bits_size = int_size_in_bytes
(a68_long_long_bits_type);
+
+ gcc_assert (bits_size != -1);
+ gcc_assert (long_bits_size != -1);
+ gcc_assert (long_long_bits_size != -1);
+
+ int lengths = 1;
+ if (long_long_bits_size != long_bits_size)
+ lengths++;
+ if (long_bits_size != bits_size)
+ lengths++;
+
+ return build_int_cst (CTYPE (MOID (p)), lengths);
+}
+
+tree
+a68_lower_bitsshorths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ HOST_WIDE_INT bits_size = int_size_in_bytes (a68_bits_type);
+ HOST_WIDE_INT short_bits_size = int_size_in_bytes (a68_short_bits_type);
+ HOST_WIDE_INT short_short_bits_size = int_size_in_bytes
(a68_short_short_bits_type);
+
+ gcc_assert (bits_size != -1);
+ gcc_assert (short_bits_size != -1);
+ gcc_assert (short_short_bits_size != -1);
+
+ int shorths = 1;
+ if (short_short_bits_size != short_bits_size)
+ shorths++;
+ if (short_bits_size != bits_size)
+ shorths++;
+
+ return build_int_cst (CTYPE (MOID (p)), shorths);
+}
+
+tree
+a68_lower_reallengths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ HOST_WIDE_INT real_size = int_size_in_bytes (a68_real_type);
+ HOST_WIDE_INT long_real_size = int_size_in_bytes (a68_long_real_type);
+ HOST_WIDE_INT long_long_real_size = int_size_in_bytes
(a68_long_long_real_type);
+
+ gcc_assert (real_size != -1);
+ gcc_assert (long_real_size != -1);
+ gcc_assert (long_long_real_size != -1);
+
+ int lengths = 1;
+ if (long_long_real_size != long_real_size)
+ lengths++;
+ if (long_real_size != real_size)
+ lengths++;
+
+ return build_int_cst (CTYPE (MOID (p)), lengths);
+}
+
+tree
+a68_lower_realshorths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return build_int_cst (CTYPE (MOID (p)), 1);
+}
+
+tree
+a68_lower_infinity (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return build_real (CTYPE (MOID (p)), dconstinf);
+}
+
+tree
+a68_lower_minusinfinity (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return build_real (CTYPE (MOID (p)), dconstninf);
+}
+
+tree
+a68_lower_maxabschar (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return a68_char_max ();
+}
+
+tree
+a68_lower_sqrt (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_sqrt (a68_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_sqrt (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_sqrt (a68_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_long_sqrt (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_sqrt (a68_long_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_tan (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_tan (a68_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_tan (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_tan (a68_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_long_tan (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_tan (a68_long_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_sin (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_sin (a68_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_sin (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_sin (a68_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_long_sin (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_sin (a68_long_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_cos (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_cos (a68_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_cos (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_cos (a68_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_long_cos (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_cos (a68_long_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_acos (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_acos (a68_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_acos (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_acos (a68_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_long_acos (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_acos (a68_long_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_asin (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_asin (a68_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_asin (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_asin (a68_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_long_asin (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_asin (a68_long_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_atan (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_atan (a68_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_atan (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_atan (a68_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_long_atan (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_atan (a68_long_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_ln (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_ln (a68_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_ln (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_ln (a68_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_long_ln (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_ln (a68_long_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_log (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_log (a68_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_log (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_log (a68_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_long_log (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_log (a68_long_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_exp (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_exp (a68_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_exp (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_exp (a68_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_long_long_exp (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_real_exp (a68_long_long_real_type);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_reali (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ tree t = a68_complex_i (M_COMPLEX, op1, op2);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_longreali (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ tree t = a68_complex_i (M_LONG_COMPLEX, op1, op2);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_longlongreali (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ tree t = a68_complex_i (M_LONG_LONG_COMPLEX, op1, op2);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_inti (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ tree t = a68_complex_i (M_COMPLEX,
+ convert_to_real (a68_real_type, op1),
+ convert_to_real (a68_real_type, op2));
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_longinti (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ tree t= a68_complex_i (M_LONG_COMPLEX,
+ convert_to_real (a68_long_real_type, op1),
+ convert_to_real (a68_long_real_type, op2));
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_longlonginti (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op1 = a68_lower_tree (SUB (p), ctx);
+ tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+ tree t = a68_complex_i (M_LONG_LONG_COMPLEX,
+ convert_to_real (a68_long_long_real_type, op1),
+ convert_to_real (a68_long_long_real_type, op2));
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_re2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+ tree t = a68_complex_re (op);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_im2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+ tree t = a68_complex_im (op);
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_conj2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+ return a68_complex_conj (MOID (p), op);
+}
+
+tree
+a68_lower_shortenint2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ return a68_int_shorten (MOID (p), MOID (NEXT (SUB (p))),
+ a68_lower_tree (NEXT (SUB (p)), ctx));
+}
+
+tree
+a68_lower_lengint2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ return a68_int_leng (MOID (p), MOID (NEXT (SUB (p))),
+ a68_lower_tree (NEXT (SUB (p)), ctx));
+}
+
+tree
+a68_lower_shortenreal2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ return a68_real_shorten (MOID (p), MOID (NEXT (SUB (p))),
+ a68_lower_tree (NEXT (SUB (p)), ctx));
+}
+
+tree
+a68_lower_lengreal2 (NODE_T *p, LOW_CTX_T ctx)
+{
+ return a68_real_leng (MOID (p), MOID (NEXT (SUB (p))),
+ a68_lower_tree (NEXT (SUB (p)), ctx));
+}
+
+tree
+a68_lower_random (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return a68_get_libcall (A68_LIBCALL_RANDOM);
+}
+
+tree
+a68_lower_longrandom (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ /* Note we dont build a call because this will get deprocedured in case it is
+ actually called. */
+ return a68_get_libcall (A68_LIBCALL_LONGRANDOM);
+}
+
+tree
+a68_lower_longlongrandom (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ return a68_get_libcall (A68_LIBCALL_LONGLONGRANDOM);
+}
+
+/********* POSIX prelude. ***************/
+
+tree
+a68_lower_setexitstatus (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_setexitstatus ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixargc (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx
ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_argc ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixargv (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_argv ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixgetenv (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_getenv ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixputchar (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_putchar ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixputs (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_puts ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixfconnect (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_fconnect ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixfopen (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_fopen ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixfcreate (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_fcreate ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixfclose (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_fclose ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixfsize (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_fsize ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixstdinfiledes (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return build_int_cst (a68_int_type, 0);
+}
+
+tree
+a68_lower_posixstdoutfiledes (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return build_int_cst (a68_int_type, 1);
+}
+
+tree
+a68_lower_posixstderrfiledes (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ return build_int_cst (a68_int_type, 2);
+}
+
+tree
+a68_lower_posixfileodefault (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ /* Please keep in sync with libga68/ga68-posix.c */
+ return build_int_cst (a68_bits_type, 0x0);
+}
+
+tree
+a68_lower_posixfileordwr (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ /* Please keep in sync with libga68/ga68-posix.c */
+ return build_int_cst (a68_bits_type, 0x3);
+}
+
+tree
+a68_lower_posixfileordonly (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ /* Please keep in sync with libga68/ga68-posix.c */
+ return build_int_cst (a68_bits_type, 0x1);
+}
+
+tree
+a68_lower_posixfileowronly (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ /* Please keep in sync with libga68/ga68-posix.c */
+ return build_int_cst (a68_bits_type, 0x2);
+}
+
+tree
+a68_lower_posixfileotrunc (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ /* Please keep in sync with libga68/ga68-posix.c */
+ return build_int_cst (a68_bits_type, 0x4);
+}
+
+tree
+a68_lower_posixerrno (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_errno ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixperror (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_perror ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixstrerror (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_strerror ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixfputc (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_fputc ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixfputs (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_fputs ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixgetchar (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_getchar ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+
+tree
+a68_lower_posixfgetc (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_fgetc ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixgets (NODE_T *p ATTRIBUTE_UNUSED,
+ LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_gets ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
+
+tree
+a68_lower_posixfgets (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ tree t = a68_posix_fgets ();
+ if (CAN_HAVE_LOCATION_P (t))
+ SET_EXPR_LOCATION (t, a68_get_node_location (p));
+ return t;
+}
--
2.30.2
