summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--buf.c49
-rw-r--r--buf.h1
-rw-r--r--tests/012/buf.tl140
-rw-r--r--txr.111
4 files changed, 201 insertions, 0 deletions
diff --git a/buf.c b/buf.c
index 0bb21a5c..c8d51cdc 100644
--- a/buf.c
+++ b/buf.c
@@ -1761,6 +1761,54 @@ val buf_zero_p(val buf)
return t;
}
+val buf_count_ones(val buf)
+{
+ val self = lit("buf-count-ones");
+ struct buf *b = buf_handle(buf, self);
+ ucnum l = c_unum(b->len, self), i;
+ ucnum *ucdata = coerce(ucnum *, b->data);
+ ucnum total[2] = { 0, 0 };
+
+ for (i = 0; i < l / sizeof (ucnum); i++) {
+ ucnum d = ucdata[i];
+#if SIZEOF_PTR == 8
+ d = ((d & 0xAAAAAAAAAAAAAAAA) >> 1) + (d & 0x5555555555555555);
+ d = ((d & 0xCCCCCCCCCCCCCCCC) >> 2) + (d & 0x3333333333333333);
+ d = ((d & 0xF0F0F0F0F0F0F0F0) >> 4) + (d & 0x0F0F0F0F0F0F0F0F);
+ d = ((d & 0xFF00FF00FF00FF00) >> 8) + (d & 0x00FF00FF00FF00FF);
+ d = ((d & 0xFFFF0000FFFF0000) >> 16) + (d & 0x0000FFFF0000FFFF);
+ d = ((d & 0xFFFFFFFF00000000) >> 32) + (d & 0x00000000FFFFFFFF);
+#elif SIZEOF_PTR == 4
+ d = ((d & 0xAAAAAAAA) >> 1) + (d & 0x55555555);
+ d = ((d & 0xCCCCCCCC) >> 2) + (d & 0x33333333);
+ d = ((d & 0xF0F0F0F0) >> 4) + (d & 0x0F0F0F0F);
+ d = ((d & 0xFF00FF00) >> 8) + (d & 0x00FF00FF);
+ d = ((d & 0xFFFF0000) >> 16) + (d & 0x0000FFFF);
+#else
+#error portme
+#endif
+ total[1] += d;
+ if (total[1] < d)
+ total[0]++;
+ }
+
+ for (i = l / sizeof (ucnum) * sizeof (ucnum); i < l; i++) {
+ unsigned d = b->data[i];
+
+ d = ((d & 0xAA) >> 1) + (d & 0x55);
+ d = ((d & 0xCC) >> 2) + (d & 0x33);
+ d = ((d & 0xF0) >> 4) + (d & 0x0F);
+
+ total[1] += d;
+ if (total[1] < d)
+ total[0]++;
+ }
+
+ return total[0]
+ ? plus(ash(unum(total[0]), num_fast(8 * SIZEOF_PTR)), unum(total[1]))
+ : unum(total[1]);
+}
+
void buf_init(void)
{
reg_fun(intern(lit("make-buf"), user_package), func_n3o(make_buf, 1));
@@ -1865,6 +1913,7 @@ void buf_init(void)
reg_fun(intern(lit("buf-bitset"), user_package), func_n1(buf_bitset));
reg_fun(intern(lit("buf-bit"), user_package), func_n2(buf_bit));
reg_fun(intern(lit("buf-zero-p"), user_package), func_n1(buf_zero_p));
+ reg_fun(intern(lit("buf-count-ones"), user_package), func_n1(buf_count_ones));
fill_stream_ops(&buf_strm_ops);
}
diff --git a/buf.h b/buf.h
index 2a599339..3782ef25 100644
--- a/buf.h
+++ b/buf.h
@@ -135,5 +135,6 @@ val buf_trunc(val buf, val bits);
val buf_bitset(val buf);
val buf_bit(val buf, val bit);
val buf_zero_p(val buf);
+val buf_count_ones(val buf);
void buf_init(void);
diff --git a/tests/012/buf.tl b/tests/012/buf.tl
index 173522ce..923a945e 100644
--- a/tests/012/buf.tl
+++ b/tests/012/buf.tl
@@ -368,3 +368,143 @@
(buf-zero-p #b'00000000000000000001') nil
(buf-zero-p #b'00000000000000000000') t
(buf-zero-p #b'000000000000000001') nil)
+
+(mtest
+ (buf-count-ones #b'') 0
+ (buf-count-ones #b'00') 0
+ (buf-count-ones #b'80') 1
+ (buf-count-ones #b'40') 1
+ (buf-count-ones #b'20') 1
+ (buf-count-ones #b'10') 1
+ (buf-count-ones #b'08') 1
+ (buf-count-ones #b'04') 1
+ (buf-count-ones #b'02') 1
+ (buf-count-ones #b'01') 1
+ (buf-count-ones #b'c0') 2
+ (buf-count-ones #b'60') 2
+ (buf-count-ones #b'30') 2
+ (buf-count-ones #b'18') 2
+ (buf-count-ones #b'0c') 2
+ (buf-count-ones #b'06') 2
+ (buf-count-ones #b'03') 2
+ (buf-count-ones #b'aa') 4
+ (buf-count-ones #b'55') 4
+ (buf-count-ones #b'ff') 8
+ (buf-count-ones #b'0000') 0
+ (buf-count-ones #b'0080') 1
+ (buf-count-ones #b'0040') 1
+ (buf-count-ones #b'0020') 1
+ (buf-count-ones #b'0010') 1
+ (buf-count-ones #b'0008') 1
+ (buf-count-ones #b'0004') 1
+ (buf-count-ones #b'0002') 1
+ (buf-count-ones #b'0001') 1
+ (buf-count-ones #b'00c0') 2
+ (buf-count-ones #b'0060') 2
+ (buf-count-ones #b'0030') 2
+ (buf-count-ones #b'0018') 2
+ (buf-count-ones #b'000c') 2
+ (buf-count-ones #b'0006') 2
+ (buf-count-ones #b'0003') 2
+ (buf-count-ones #b'00aa') 4
+ (buf-count-ones #b'0055') 4
+ (buf-count-ones #b'00ff') 8
+ (buf-count-ones #b'0000') 0
+ (buf-count-ones #b'ffff0080') 17
+ (buf-count-ones #b'ffff0040') 17
+ (buf-count-ones #b'ffff0020') 17
+ (buf-count-ones #b'ffff0010') 17
+ (buf-count-ones #b'ffff0008') 17
+ (buf-count-ones #b'ffff0004') 17
+ (buf-count-ones #b'ffff0002') 17
+ (buf-count-ones #b'ffff0001') 17
+ (buf-count-ones #b'ffff00c0') 18
+ (buf-count-ones #b'ffff0060') 18
+ (buf-count-ones #b'ffff0030') 18
+ (buf-count-ones #b'ffff0018') 18
+ (buf-count-ones #b'ffff000c') 18
+ (buf-count-ones #b'ffff0006') 18
+ (buf-count-ones #b'ffff0003') 18
+ (buf-count-ones #b'ffff00aa') 20
+ (buf-count-ones #b'ffff0055') 20
+ (buf-count-ones #b'ffff00ff') 24
+ (buf-count-ones #b'aaffff0080') 21
+ (buf-count-ones #b'aaffff0040') 21
+ (buf-count-ones #b'aaffff0020') 21
+ (buf-count-ones #b'aaffff0010') 21
+ (buf-count-ones #b'aaffff0008') 21
+ (buf-count-ones #b'aaffff0004') 21
+ (buf-count-ones #b'aaffff0002') 21
+ (buf-count-ones #b'aaffff0001') 21
+ (buf-count-ones #b'aaffff00c0') 22
+ (buf-count-ones #b'aaffff0060') 22
+ (buf-count-ones #b'aaffff0030') 22
+ (buf-count-ones #b'aaffff0018') 22
+ (buf-count-ones #b'aaffff000c') 22
+ (buf-count-ones #b'aaffff0006') 22
+ (buf-count-ones #b'aaffff0003') 22
+ (buf-count-ones #b'aaffff00aa') 24
+ (buf-count-ones #b'aaffff0055') 24
+ (buf-count-ones #b'aaffff00ff') 28
+ (buf-count-ones #b'5555aaaaffff0080') 33
+ (buf-count-ones #b'5555aaaaffff0040') 33
+ (buf-count-ones #b'5555aaaaffff0020') 33
+ (buf-count-ones #b'5555aaaaffff0010') 33
+ (buf-count-ones #b'5555aaaaffff0008') 33
+ (buf-count-ones #b'5555aaaaffff0004') 33
+ (buf-count-ones #b'5555aaaaffff0002') 33
+ (buf-count-ones #b'5555aaaaffff0001') 33
+ (buf-count-ones #b'5555aaaaffff00c0') 34
+ (buf-count-ones #b'5555aaaaffff0060') 34
+ (buf-count-ones #b'5555aaaaffff0030') 34
+ (buf-count-ones #b'5555aaaaffff0018') 34
+ (buf-count-ones #b'5555aaaaffff000c') 34
+ (buf-count-ones #b'5555aaaaffff0006') 34
+ (buf-count-ones #b'5555aaaaffff0003') 34
+ (buf-count-ones #b'5555aaaaffff00aa') 36
+ (buf-count-ones #b'5555aaaaffff0055') 36
+ (buf-count-ones #b'5555aaaaffff00ff') 40
+ (buf-count-ones #b'fe5555aaaaffff0080') 40
+ (buf-count-ones #b'fe5555aaaaffff0040') 40
+ (buf-count-ones #b'fe5555aaaaffff0020') 40
+ (buf-count-ones #b'fe5555aaaaffff0010') 40
+ (buf-count-ones #b'fe5555aaaaffff0008') 40
+ (buf-count-ones #b'fe5555aaaaffff0004') 40
+ (buf-count-ones #b'fe5555aaaaffff0002') 40
+ (buf-count-ones #b'fe5555aaaaffff0001') 40
+ (buf-count-ones #b'fe5555aaaaffff00c0') 41
+ (buf-count-ones #b'fe5555aaaaffff0060') 41
+ (buf-count-ones #b'fe5555aaaaffff0030') 41
+ (buf-count-ones #b'fe5555aaaaffff0018') 41
+ (buf-count-ones #b'fe5555aaaaffff000c') 41
+ (buf-count-ones #b'fe5555aaaaffff0006') 41
+ (buf-count-ones #b'fe5555aaaaffff0003') 41
+ (buf-count-ones #b'fe5555aaaaffff00aa') 43
+ (buf-count-ones #b'fe5555aaaaffff0055') 43
+ (buf-count-ones #b'fe5555aaaaffff00ff') 47)
+
+(each-prod ((i 0..128))
+ (mvtest
+ (buf-count-ones (buf-ash #b'01' i)) 1
+ (buf-count-ones (buf-ash #b'03' i)) 2
+ (buf-count-ones (buf-ash #b'05' i)) 2
+ (buf-count-ones (buf-ash #b'09' i)) 2
+ (buf-count-ones (buf-ash #b'11' i)) 2
+ (buf-count-ones (buf-ash #b'07' i)) 3
+ (buf-count-ones (buf-ash #b'0B' i)) 3
+ (buf-count-ones (buf-ash #b'0D' i)) 3
+ (buf-count-ones (buf-ash #b'0F' i)) 4
+ (buf-count-ones (buf-ash #b'1B' i)) 4
+ (buf-count-ones (buf-ash #b'1B' i)) 4
+ (buf-count-ones (buf-ash #b'17' i)) 4
+ (buf-count-ones (buf-ash #b'1F' i)) 5
+ (buf-count-ones (buf-ash #b'2F' i)) 5
+ (buf-count-ones (buf-ash #b'37' i)) 5
+ (buf-count-ones (buf-ash #b'3D' i)) 5
+ (buf-count-ones (buf-ash #b'3F' i)) 6
+ (buf-count-ones (buf-ash #b'5F' i)) 6
+ (buf-count-ones (buf-ash #b'6F' i)) 6
+ (buf-count-ones (buf-ash #b'77' i)) 6
+ (buf-count-ones (buf-ash #b'7B' i)) 6
+ (buf-count-ones (buf-ash #b'7D' i)) 6
+ (buf-count-ones (buf-ash #b'7f' i)) 7))
diff --git a/txr.1 b/txr.1
index df6c3aaa..a2338dea 100644
--- a/txr.1
+++ b/txr.1
@@ -30486,6 +30486,17 @@ does not contain any bytes that are nonzero, otherwise
An empty buffer satisfies this condition.
+.coNP Function @ buf-count-ones
+.synb
+.mets (buf-count-ones << buf )
+.syne
+.desc
+The
+.code buf-count-ones
+function returns a non-negative integer indicating the number of
+occurrences of the bit value 1 in
+.metn buf .
+
.coNP Functions @ buf-compress and @ buf-decompress
.synb
.mets (buf-compress < buf <> [ level ])
generated by cgit v1.2.3 (git 2.25.1) at 2025-07-15 20:45:12 +0000