[COMMITTED] algol68: handle negative values in ABS
Jose E. Marchesi
jemarch@gnu.org
Fri Mar 14 14:14:34 GMT 2025
---
gcc/algol68/a68-low-bits.cc | 34 +++++++++++----
gcc/algol68/ga68.texi | 43 ++++++++++++++-----
.../algol68/execute/abs-int-negative-1.a68 | 5 +++
.../algol68/execute/abs-int-negative-1.x | 4 ++
.../execute/abs-int-negative-gnu-1.a68 | 5 +++
.../algol68/execute/abs-int-negative-gnu-1.x | 4 ++
6 files changed, 77 insertions(+), 18 deletions(-)
create mode 100644 gcc/testsuite/algol68/execute/abs-int-negative-1.a68
create mode 100644 gcc/testsuite/algol68/execute/abs-int-negative-1.x
create mode 100644 gcc/testsuite/algol68/execute/abs-int-negative-gnu-1.a68
create mode 100644 gcc/testsuite/algol68/execute/abs-int-negative-gnu-1.x
diff --git a/gcc/algol68/a68-low-bits.cc b/gcc/algol68/a68-low-bits.cc
index 37a9e7b80af..736ce9a757c 100644
--- a/gcc/algol68/a68-low-bits.cc
+++ b/gcc/algol68/a68-low-bits.cc
@@ -61,28 +61,46 @@ a68_bits_maxbits (tree type)
}
/* Given a SIZETY INT value VAL, compute and return a SIZETY BITS reflecting
- its constituent bits. */
+ 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 (tree type, tree val)
{
if (OPTION_STRICT (&A68_JOB))
- /* BIN of a negative value is INT (SKIP). */
- return a68_get_skip_tree (a68_type_moid (type));
+ return a68_get_int_skip_tree (type);
else
- /* BIN of a negative value is the constituent bits of the two's complement
- of the value. */
return fold_convert (type, val);
}
/* Given a SIZETY BITS value BITS, compute and return the corresponding SIZETY
- INT. */
+ 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 (tree type, tree bits)
{
- /* XXX if no extensions allowed, check and error on negative numbers. */
- return fold_convert (type, bits);
+ 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 (type),
+ integral_val);
+ }
+ else
+ return fold_convert (type, bits);
}
/* Given a SIZETY BITS value BITS, shorten it into a SIZETY BITS whose tree
diff --git a/gcc/algol68/ga68.texi b/gcc/algol68/ga68.texi
index 3c417e0c522..793bccb13d9 100644
--- a/gcc/algol68/ga68.texi
+++ b/gcc/algol68/ga68.texi
@@ -1966,8 +1966,8 @@ enabled by default. To disable them the user can select the strict
Algol 68 standard by passing the option @option{-std=algol68} when
invoking the compiler.
-@node @code{@B{bin}} of negative integral values
-@section @code{@B{bin}} of negative integral values
+@node @code{@B{bin}} and @code{@B{abs}} of negative integral values
+@section @code{@B{bin}} and @code{@B{abs}} of negative integral values
The @code{@B{bin}} operator gets an integral value and yields a
@code{@B{bits}} value that reflects the internal bits of the integral
@@ -1984,17 +1984,40 @@ standard prelude, are:
@B{fi};
@end example
+The @code{@B{abs}} operator performs the inverse operation of
+@code{@B{bits}}. Given a @code{L @B{bits}} value, it yields the
+@code{L @B{int}} value whose bits representation is the bits value.
+The semantics of this operator, as defined in the Algol 68 prelude,
+are:
+
+@example
+@B{op} @B{abs} = (L @B{bits} a) L @B{int}:
+@B{begin} L @B{int} c := L 0;
+ @B{for} i @B{to} L bits width
+ @B{do} c := L 2 * c + K @B{abs} (L F @B{of} a)[i] @B{od};
+ c
+@B{end}
+@end example
+
@noindent
Note how the @code{@B{bin}} of a negative integral value is not
defined: the implicit else-part of the conditional yields
-@code{@B{skip}}, which is defined as any integral value. The GNU
-Algol 68 compiler always yields zero for an integral @code{@B{skip}},
-but strict Algol 68 programs must not rely on this.
-
-When GNU extensions are enabled the @code{@B{bin}} of a negative value
-yields the two's complement bit pattern of the value rather than zero.
-Therefore, @code{@B{bin} - @B{short} @B{short} 2} yields
-@code{2r11111110}.
+@code{@B{skip}}, which is defined as any bits value in that context.
+Note also how @code{@B{abs}} doesn't make any provision to check
+whether the resulting value is positive: it assumes it is so.
+
+The GNU Algol 68 compiler, when working in strict Algol 68 mode
+(@option{-std=algol68}), makes @code{@B{bin}} to always yield @code{L
+@B{bits} (@B{skip})} when given a negative value, as mandated by the
+report. But the skip value is always the bits representation of zero,
+@i{i.e.} 2r0. Strict Algol 68 programs, however, must not rely on
+this.
+
+When GNU extensions are enabled (@option{-std=gnu68}) the
+@code{@B{bin}} of a negative value yields the two's complement bit
+pattern of the value rather than zero. Therefore, @code{@B{bin} -
+@B{short} @B{short} 2} yields @code{2r11111110}. And @code{@B{abs}
+@B{short} @B{short} 2r11111110} yields -2.
@include gpl_v3.texi
@include fdl.texi
diff --git a/gcc/testsuite/algol68/execute/abs-int-negative-1.a68 b/gcc/testsuite/algol68/execute/abs-int-negative-1.a68
new file mode 100644
index 00000000000..9c4fba9a54f
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/abs-int-negative-1.a68
@@ -0,0 +1,5 @@
+PROGRAM
+BEGIN SHORT SHORT BITS b = BIN - SHORT SHORT 2;
+ ASSERT (ABS b = SHORT SHORT INT (SKIP));
+ 0
+END
diff --git a/gcc/testsuite/algol68/execute/abs-int-negative-1.x b/gcc/testsuite/algol68/execute/abs-int-negative-1.x
new file mode 100644
index 00000000000..5d1bfa57cb1
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/abs-int-negative-1.x
@@ -0,0 +1,4 @@
+set algol68_compile_args "-std=algol68"
+
+# carry on..
+return false
diff --git a/gcc/testsuite/algol68/execute/abs-int-negative-gnu-1.a68 b/gcc/testsuite/algol68/execute/abs-int-negative-gnu-1.a68
new file mode 100644
index 00000000000..792375b9c8a
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/abs-int-negative-gnu-1.a68
@@ -0,0 +1,5 @@
+PROGRAM
+BEGIN SHORT SHORT BITS b = BIN - SHORT SHORT 2;
+ ASSERT (ABS b = - SHORT SHORT 2);
+ 0
+END
diff --git a/gcc/testsuite/algol68/execute/abs-int-negative-gnu-1.x b/gcc/testsuite/algol68/execute/abs-int-negative-gnu-1.x
new file mode 100644
index 00000000000..009b66d2f99
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/abs-int-negative-gnu-1.x
@@ -0,0 +1,4 @@
+set algol68_compile_args "-std=gnu68"
+
+# carry on..
+return false
--
2.30.2
More information about the Algol68
mailing list