https://gcc.gnu.org/g:d27b9ed9c7508bac187776e21a675a8b537a7282
commit r16-5755-gd27b9ed9c7508bac187776e21a675a8b537a7282 Author: Jose E. Marchesi <[email protected]> Date: Sat Oct 11 19:52:33 2025 +0200 a68: low: standard prelude Signed-off-by: Jose E. Marchesi <[email protected]> gcc/ChangeLog * algol68/a68-low-posix.cc: New file. * algol68/a68-low-prelude.cc: Likewise. Diff: --- gcc/algol68/a68-low-posix.cc | 559 ++++++++++ gcc/algol68/a68-low-prelude.cc | 2193 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 2752 insertions(+) diff --git a/gcc/algol68/a68-low-posix.cc b/gcc/algol68/a68-low-posix.cc new file mode 100644 index 000000000000..6b6ae76cf375 --- /dev/null +++ b/gcc/algol68/a68-low-posix.cc @@ -0,0 +1,559 @@ +/* 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_lseek (void) +{ + return a68_get_libcall (A68_LIBCALL_POSIX_LSEEK); +} + +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 000000000000..55c0895bec52 --- /dev/null +++ b/gcc/algol68/a68-low-prelude.cc @@ -0,0 +1,2193 @@ +/* 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_eofchar (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + static tree eofchar = NULL_TREE; + + if (eofchar == NULL_TREE) + eofchar = build_int_cst (a68_char_type, -1); + return eofchar; +} + +tree +a68_lower_replacementchar (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + static tree replacementchar = NULL_TREE; + + if (replacementchar == NULL_TREE) + replacementchar = build_int_cst (a68_char_type, 0xfffd); + return replacementchar; +} + +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_posixlseek (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_lseek (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixseekcur (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return build_int_cst (a68_int_type, 0); +} + +tree +a68_lower_posixseekend (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return build_int_cst (a68_int_type, 1); +} + +tree +a68_lower_posixseekset (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return build_int_cst (a68_int_type, 2); +} + +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, 0x99999999); +} + +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, 0x2); +} + +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, 0x0); +} + +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, 0x1); +} + +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, 0x8); +} + +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; +}
