path: root/gcc/algol68/a68-low-bits.cc

/* Lowering routines for all things related to BITS values.
   Copyright (C) 2025 Jose E. Marchesi.

   Written by Jose E. Marchesi.

   GCC is free software; you can redistribute it and/or modify it
   under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 3, or (at your option)
   any later version.

   GCC is distributed in the hope that it will be useful, but WITHOUT
   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
   License for more details.

   You should have received a copy of the GNU General Public License
   along with GCC; see the file COPYING3.  If not see
   <http://www.gnu.org/licenses/>.  */

#define INCLUDE_MEMORY
#include "config.h"
#include "system.h"
#include "coretypes.h"

#include "tree.h"
#include "fold-const.h"
#include "diagnostic.h"
#include "langhooks.h"
#include "tm.h"
#include "function.h"
#include "cgraph.h"
#include "toplev.h"
#include "varasm.h"
#include "predict.h"
#include "stor-layout.h"
#include "tree-iterator.h"
#include "stringpool.h"
#include "print-tree.h"
#include "gimplify.h"
#include "dumpfile.h"
#include "convert.h"

#include "a68.h"

/* Return a tree with the yielind of SKIP for the given BITS mode.  */

tree
a68_get_bits_skip_tree (MOID_T *m)
{
  tree type;

  if (m == M_BITS)
    type = a68_bits_type;
  else if (m == M_LONG_BITS)
    type = a68_long_bits_type;
  else if (m == M_LONG_LONG_BITS)
    type = a68_long_long_bits_type;
  else if (m == M_SHORT_BITS)
    type = a68_short_bits_type;
  else if (m == M_SHORT_SHORT_BITS)
    type = a68_short_short_bits_type;
  else
    gcc_unreachable ();

  return build_int_cst (type, 0);
}

/* Given a BITS type, compute the number of bits that fit in a value of that
   type.  The result is an INT.  */

tree
a68_bits_width (tree type)
{
  return fold_convert (a68_int_type, TYPE_SIZE (type));
}

/* Given a BITS type, compute the maximum value that can be expressed with that
   type.  */

tree
a68_bits_maxbits (tree type)
{
  return fold_convert (type, TYPE_MAX_VALUE (type));
}

/* Given a SIZETY INT value VAL, compute and return a SIZETY BITS reflecting
   its constituent bits.

   In strict Algol 68 the BIN of a negative value is BITS (SKIP).

   In GNU 68 the BIN of a negative value is the constituent bits of the two's
   complement of the value.  */

tree
a68_bits_bin (MOID_T *m, tree val)
{
  tree type = CTYPE (m);

  if (OPTION_STRICT (&A68_JOB))
    return a68_get_bits_skip_tree (m);
  else
    return fold_convert (type, val);
}

/* Given a SIZETY BITS value BITS, compute and return the corresponding SIZETY
   INT.

   In strict Algol 68 the ABS of a BITS value reflecting a bit pattern that
   would correspond a negative integral value is INT (SKIP).

   In GNU 68 the ABS of a BITS value reflecting a bit pattern that would
   correspond a negative integral value is that negative integral value.  */

tree
a68_bits_abs (MOID_T *m, tree bits)
{
  tree type = CTYPE (m);

  if (OPTION_STRICT (&A68_JOB))
    {
      tree integral_val = save_expr (fold_convert (type, bits));
      return fold_build3 (COND_EXPR,
			  type,
			  fold_build2 (LT_EXPR, type, integral_val,
				       build_int_cst (type, 0)),
			  a68_get_int_skip_tree (m),
			  integral_val);
    }
  else
    return fold_convert (type, bits);
}

/* Given a SIZETY BITS value BITS, shorten it into a SIZETY BITS whose tree
   type is TYPE.  */

tree
a68_bits_shorten (tree type, tree bits)
{
  /* This will truncate at the left, which is what is intended.  */
  return fold_convert (type, bits);
}

/* Given a SIZETY BITS value BITS, length it into a SIZETY BITS whose tree type
   is TYPE.  */

tree
a68_bits_leng (tree type, tree bits)
{
  /* This will add zeroes to the left, which is what is intended.  */
  return fold_convert (type, bits);
}

/* Given a SIZETY BITS value BITS, compute and return a new SIZETY BITS whose
   bits are the logical negation of the bits of BITS.  */

tree
a68_bits_not (tree bits)
{
  return fold_build1 (BIT_NOT_EXPR, TREE_TYPE (bits), bits);
}

/* Given two SIZETY BITS values BITS1 and BITS2, compute and return a new
   SIZETY BITS whose bits are the `and' of the bits of BITS1 and
   BITS2.  */

tree
a68_bits_and (tree bits1, tree bits2)
{
  return fold_build2 (BIT_AND_EXPR, TREE_TYPE (bits1), bits1, bits2);
}

/* Given two SIZETY BITS values BITS1 and BITS2, compute and return a new
   SIZETY BITS whose bits are the inclusive-or of the bits of BITS1 and
   BITS2.  */

tree
a68_bits_ior (tree bits1, tree bits2)
{
  return fold_build2 (BIT_IOR_EXPR, TREE_TYPE (bits1), bits1, bits2);
}

/* Given two SIZETY BITS values BITS1 and BITS2, compute and return a new
   SIZETY BITS whose bits are the exclusive-or of the bits of BITS1 and
   BITS2.  */

tree
a68_bits_xor (tree bits1, tree bits2)
{
  return fold_build2 (BIT_XOR_EXPR, TREE_TYPE (bits1), bits1, bits2);
}

/* Given a position POS of mode INT and a BITS of mode SIZETY BITS, return a
   BOOL reflecting the state of the bit occupying the position POS in BITS.

   If POS is out of range a run-time error is emitted.  */

tree
a68_bits_elem (NODE_T *p, tree pos, tree bits)
{
  pos = save_expr (pos);
  tree one = build_int_cst (TREE_TYPE (bits), 1);

  tree shift = fold_build2 (MINUS_EXPR, bitsizetype,
			    TYPE_SIZE (TREE_TYPE (bits)),
			    fold_convert (bitsizetype, pos));
  tree elem = fold_build2 (EQ_EXPR,
			   a68_bool_type,
			   fold_build2 (BIT_AND_EXPR,
					TREE_TYPE (bits),
					fold_build2 (RSHIFT_EXPR,
						     TREE_TYPE (bits),
						     bits, shift),
					one),
			   one);

  /* Do bounds checking if requested.  */
  if (OPTION_BOUNDS_CHECKING (&A68_JOB))
    {
      unsigned int lineno = NUMBER (LINE (INFO (p)));
      const char *filename_str = FILENAME (LINE (INFO (p)));
      tree filename = build_string_literal (strlen (filename_str) + 1,
					    filename_str);
      tree call = a68_build_libcall (A68_LIBCALL_BITSBOUNDSERROR,
				     void_type_node, 3,
				     filename,
				     build_int_cst (unsigned_type_node, lineno),
				     fold_convert (ssizetype, pos));
      tree check = fold_build2 (TRUTH_AND_EXPR, integer_type_node,
				fold_build2 (GT_EXPR, integer_type_node,
					     pos, fold_convert (TREE_TYPE (pos), integer_zero_node)),
				fold_build2 (LE_EXPR, integer_type_node,
					     fold_convert (bitsizetype, pos),
					     TYPE_SIZE (TREE_TYPE (bits))));

      check = fold_build2_loc (a68_get_node_location (p),
			       TRUTH_ORIF_EXPR,
			       ssizetype,
			       check,
			       fold_build2 (COMPOUND_EXPR, a68_bool_type,
					    call, boolean_false_node));
      elem = fold_build2 (COMPOUND_EXPR, a68_bool_type,
			  check, elem);
    }

  return elem;
}

/* Given two SIZETY BITS values BITS1 and BITS2, return a BOOL value indicating
   whether all the bits set in BITS1 are also set in BITS2.  */

tree
a68_bits_subset (tree bits1, tree bits2)
{
  /* We compute this operation with `A | B == B' as specified by the Report */
  bits2 = save_expr (bits2);
  return fold_build2 (EQ_EXPR, a68_bool_type,
		      fold_build2 (BIT_IOR_EXPR, TREE_TYPE (bits1), bits1, bits2),
		      bits2);
}

/* Rotate the bits in BITS SHIFT bits to the left if SHIFT is positive, or ABS
   (SHIFT) bits to the right if SHIFT is negative.

   A run-time error is raised if the count overflows the BITS value.  */

tree
a68_bits_shift (tree shift, tree bits)
{
  shift = save_expr (shift);
  bits = save_expr (bits);
  return fold_build3 (COND_EXPR,
		      TREE_TYPE (bits),
		      fold_build2 (GE_EXPR, TREE_TYPE (shift),
				   shift, build_int_cst (TREE_TYPE (shift), 0)),
		      fold_build2 (LSHIFT_EXPR, TREE_TYPE (bits),
				   bits, shift),
		      fold_build2 (RSHIFT_EXPR, TREE_TYPE (bits),
				   bits,
				   fold_build1 (ABS_EXPR, TREE_TYPE (shift), shift)));
}

/* Given two bits values, build an expression that calculates whether A = B.  */

tree
a68_bits_eq (tree a, tree b, location_t loc)
{
  return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b);
}

/* Given two bits values, build an expression that calculates whether A /=
   B.  */

tree
a68_bits_ne (tree a, tree b, location_t loc)
{
  return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b);
}