https://gcc.gnu.org/g:220599a8b3f14dd8a97aabe6a486a3b677bbe5b1
commit r16-7613-g220599a8b3f14dd8a97aabe6a486a3b677bbe5b1 Author: Jose E. Marchesi <[email protected]> Date: Wed Feb 18 01:23:27 2026 +0100 a68: implementation of L bits_pack in standard prelude Signed-off-by: Jose E. Marchesi <[email protected]> gcc/algol68/ChangeLog * a68-parser-prelude.cc (stand_prelude): Remove definitions for bitpacks. gcc/testsuite/ChangeLog * algol68/compile/warning-hidding-4.a68: Mention bitspack. libga68/ChangeLog * standard.a68.in ({L_}bits_pack): New procedures. Diff: --- gcc/algol68/a68-parser-prelude.cc | 17 +---------------- gcc/testsuite/algol68/compile/warning-hidding-4.a68 | 1 + libga68/standard.a68.in | 18 ++++++++++++++++++ 3 files changed, 20 insertions(+), 16 deletions(-) diff --git a/gcc/algol68/a68-parser-prelude.cc b/gcc/algol68/a68-parser-prelude.cc index e283c2c3f117..46412bc88aa7 100644 --- a/gcc/algol68/a68-parser-prelude.cc +++ b/gcc/algol68/a68-parser-prelude.cc @@ -414,23 +414,8 @@ stand_prelude (void) a68_idf (A68_STD, "errorchar", M_CHAR, a68_lower_errorchar); a68_idf (A68_STD, "nullcharacter", M_CHAR, a68_lower_nullcharacter); a68_idf (A68_STD, "blank", M_CHAR, a68_lower_blank); - /* BITS procedures. */ - MOID_T *m = a68_proc (M_BITS, M_ROW_BOOL, NO_MOID); - a68_idf (A68_STD, "bitspack", m); - /* SHORT BITS procedures. */ - m = a68_proc (M_SHORT_BITS, M_ROW_BOOL, NO_MOID); - a68_idf (A68_STD, "shortbitspack", m); - /* SHORT SHORT BITS procedures. */ - m = a68_proc (M_SHORT_SHORT_BITS, M_ROW_BOOL, NO_MOID); - a68_idf (A68_STD, "shortshortbitspack", m); - /* LONG BITS procedures. */ - m = a68_proc (M_LONG_BITS, M_ROW_BOOL, NO_MOID); - a68_idf (A68_STD, "longbitspack", m); - /* LONG LONG BITS procedures. */ - m = a68_proc (M_LONG_LONG_BITS, M_ROW_BOOL, NO_MOID); - a68_idf (A68_STD, "longlongbitspack", m); /* RNG procedures. */ - m = a68_proc (M_VOID, M_INT, NO_MOID); + MOID_T *m = a68_proc (M_VOID, M_INT, NO_MOID); a68_idf (A68_STD, "firstrandom", m); /* REAL procedures. */ m = A68_MCACHE (proc_real); diff --git a/gcc/testsuite/algol68/compile/warning-hidding-4.a68 b/gcc/testsuite/algol68/compile/warning-hidding-4.a68 index 0078e6a593f9..4478da144ddd 100644 --- a/gcc/testsuite/algol68/compile/warning-hidding-4.a68 +++ b/gcc/testsuite/algol68/compile/warning-hidding-4.a68 @@ -1,5 +1,6 @@ { dg-options "-Whidden-declarations" } begin + int bitspack = 10; { dg-warning "" } op UPB = (int i, union (int,string) v) int: { dg-warning "hides" } (v | (string s): UPB s | 0); UPB "lala" diff --git a/libga68/standard.a68.in b/libga68/standard.a68.in index 630c7e5a2399..1758d8a2fc99 100644 --- a/libga68/standard.a68.in +++ b/libga68/standard.a68.in @@ -25,5 +25,23 @@ module Standard = def + { 10.2.3.8.l L bitspack + ───────────────────── } + + {iter L {short short} {short} {} {long} {long long}} + {iter L_ {short_short_} {short_} {} {long_} {long_long_}} + pub proc {L_}bits_pack = ([]bool a) {L} bits: + if int n = UPB a[@1]; + n <= {L_}bits_width + then {L} bits c := {L} 16r0; + for i to {L_}bits_width + do if i > {L_}bits_width - n + andth a[@1][i - {L_}bits_width + n] + then c := c OR ({L} 2r1 SHL ({L_}bits_width - i)) fi + od; + c + fi; + {reti} + skip fed
