Switch unboxed-fields bitmask to be a Scheme integer

Requires a full rebuild!!

* libguile/struct.h (SCM_VTABLE_UNBOXED_FIELDS):
(SCM_VTABLE_FIELD_IS_UNBOXED): Use logbit? to determine if a field is
unboxed.
* module/language/cps/guile-vm/lower-primcalls.scm
(vtable-has-unboxed-fields?): Just check against SCM_INUM0.
(vtable-field-boxed?): Likewise, the bitmask is an integer.
* libguile/struct.c (set_vtable_access_fields): Set UNBOXED_FIELDS
bitmask as integer.

module/language/cps/guile-vm/lower-primcalls.scm

@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2023 Free Software Foundation, Inc.
+;; Copyright (C) 2023, 2025 Free Software Foundation, Inc.
 
 ;;; This library is free software; you can redistribute it and/or modify it
 ;;; under the terms of the GNU Lesser General Public License as published by
@@ -298,31 +298,13 @@
                                                                nfields (vtable))
   (define vtable-index-unboxed-fields 6) ; FIXME: pull from struct.h
   (define vtable-offset-unboxed-fields (1+ vtable-index-unboxed-fields))
-  (define (check-any-unboxed cps ptr word)
-    (if (< (* word 32) nfields)
-        (with-cps cps
-          (letv idx bits)
-          (let$ checkboxed (check-any-unboxed ptr (1+ word)))
-          (letk kcheckboxed ($kargs () () ,checkboxed))
-          (letk kcheck
-                ($kargs ('bits) (bits)
-                  ($branch kt kcheckboxed src 'u64-imm-= 0 (bits))))
-          (letk kword
-                ($kargs ('idx) (idx)
-                  ($continue kcheck src
-                    ($primcall 'u32-ref 'bitmask (vtable ptr idx)))))
-          (build-term
-            ($continue kword src
-              ($primcall 'load-u64 word ()))))
-        (with-cps cps
-          (build-term ($continue kf src ($values ()))))))
   (with-cps cps
-    (letv ptr)
-    (let$ checkboxed (check-any-unboxed ptr 0))
-    (letk kcheckboxed ($kargs ('ptr) (ptr) ,checkboxed))
+    (letv fields)
+    (letk kcheckboxed ($kargs ('fields) (fields)
+                        ($branch kt kf src 'eq-constant? 0 (fields))))
     (build-term
       ($continue kcheckboxed src
-        ($primcall 'pointer-ref/immediate
+        ($primcall 'scm-ref/immediate
                    `(struct . ,vtable-offset-unboxed-fields)
                    (vtable))))))
 
@@ -342,30 +324,65 @@
       ($continue ktag src
         ($primcall 'allocate-words/immediate `(struct . ,nwords) ())))))
 
-;; precondition: vtable is vtable, idx less than vtable size
+;; precondition: vtable is vtable
 (define-branching-primcall-lowerer (vtable-field-boxed? cps kf kt src idx (vtable))
   (define vtable-index-unboxed-fields 6) ; FIXME: pull from struct.h
   (define vtable-offset-unboxed-fields (1+ vtable-index-unboxed-fields))
+  (define (some-fields-boxed cps fields)
+    (cond
+     ((< idx 8)
+      (with-cps cps
+        (letv u64 res)
+        (letk ktest
+              ($kargs ('res) (res)
+                ($branch kf kt src 'u64-imm-= 0 (res))))
+        (letk ku64
+              ($kargs ('u64) (u64)
+                ($continue ktest src
+                  ($primcall 'ulogand/immediate (ash 1 idx) (u64)))))
+        (build-term
+          ($continue ku64 src
+            ($primcall 'scm->u64/truncate #f (fields))))))
+     ((< idx 64)
+      (with-cps cps
+        (letv pat u64 res)
+        (letk ktest
+              ($kargs ('res) (res)
+                ($branch kf kt src 'u64-imm-= 0 (res))))
+        (letk kpat
+              ($kargs ('pat) (pat)
+                ($continue ktest src
+                  ($primcall 'ulogand #f (u64 pat)))))
+        (letk ku64
+              ($kargs ('u64) (u64)
+                ($continue kpat src
+                  ($primcall 'load-u64 (ash 1 idx) ()))))
+        (build-term
+          ($continue ku64 src
+            ($primcall 'scm->u64/truncate #f (fields))))))
+     (else
+      (with-cps cps
+        (letv pat res)
+        (letk ktest
+              ($kargs ('res) (res)
+                ($branch kf kt src 'eq-constant? 0 (res))))
+        (letk kpat
+              ($kargs ('pat) (pat)
+                ($continue ktest src
+                  ($primcall 'logand #f (fields pat)))))
+        (build-term
+          ($continue kpat src ($const (ash 1 idx))))))))
   (with-cps cps
-    (letv ptr word bits res)
-    (letk ktest
-          ($kargs ('res) (res)
-            ($branch kf kt src 'u64-imm-= 0 (res))))
-    (letk kbits
-          ($kargs ('bits) (bits)
-            ($continue ktest src
-              ($primcall 'ulogand/immediate (ash 1 (logand idx 31)) (bits)))))
-    (letk kword
-          ($kargs ('word) (word)
-            ($continue kbits src
-              ($primcall 'u32-ref 'bitmask (vtable ptr word)))))
-    (letk kptr
-          ($kargs ('ptr) (ptr)
-            ($continue kword src
-              ($primcall 'load-u64 (ash idx -5) ()))))
+    (letv fields)
+    (let$ test (some-fields-boxed fields))
+    (letk kcheck
+          ($kargs () () ,test))
+    (letk kfields
+          ($kargs ('fields) (fields)
+            ($branch kcheck kt src 'eq-constant? 0 (fields))))
     (build-term
-      ($continue kptr src
-        ($primcall 'pointer-ref/immediate
+      ($continue kfields src
+        ($primcall 'scm-ref/immediate
                    `(struct . ,vtable-offset-unboxed-fields)
                    (vtable))))))