More precise value representations for bv-contents, $code

* module/language/cps/utils.scm (compute-var-representations): $code
makes a 'code.  bv-contents makes a 'bv-contents.
* module/language/cps/slot-allocation.scm:
* module/language/cps/hoot/tailify.scm:
* module/system/vm/assembler.scm: Adapt.

module/language/cps/slot-allocation.scm

@@ -54,7 +54,7 @@
   (slots allocation-slots)
 
   ;; A map of VAR to representation.  A representation is 'scm, 'f64,
-  ;; 'u64, or 's64.
+  ;; 'u64, 's64, 'ptr, 'bv-contents, or 'code.
   ;;
   (representations allocation-representations)
 
@@ -706,8 +706,10 @@ are comparable with eqv?.  A tmp slot may be used."
            (#f slot-map)
            (slot
             (let ((desc (match (intmap-ref representations var)
-                          ((or 'u64 'f64 's64 'ptr) slot-desc-live-raw)
-                          ('scm slot-desc-live-scm))))
+                          ((or 'u64 'f64 's64 'ptr 'bv-contents 'code)
+                           slot-desc-live-raw)
+                          ('scm
+                           slot-desc-live-scm))))
               (logior slot-map (ash desc (* 2 slot)))))))
        live-vars 0))
 

module/language/cps/utils.scm

@@ -26,6 +26,7 @@
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
+  #:use-module (system base target)
   #:use-module (language cps)
   #:use-module (language cps intset)
   #:use-module (language cps intmap)
@@ -418,12 +419,13 @@ by a label, respectively."
                                'srsh 'srsh/immediate
                                's8-ref 's16-ref 's32-ref 's64-ref))
               (intmap-add representations var 's64))
-             (($ $primcall (or 'bv-contents
-                               'pointer-ref/immediate
+             (($ $primcall (or 'pointer-ref/immediate
                                'tail-pointer-ref/immediate))
               (intmap-add representations var 'ptr))
+             (($ $primcall 'bv-contents)
+              (intmap-add representations var 'bv-contents))
              (($ $code)
-              (intmap-add representations var 'ptr))
+              (intmap-add representations var 'code))
              (_
               (intmap-add representations var 'scm))))
           (vars

module/system/vm/assembler.scm

@@ -2587,7 +2587,7 @@ procedure with label @var{rw-init}.  @var{rw-init} may be false.  If
                         ((f64) 1)
                         ((u64) 2)
                         ((s64) 3)
-                        ((ptr) 4)
+                        ((ptr code) 4)
                         (else (error "what!" representation)))))
              (put-uleb128 names-port (logior (ash slot 3) tag)))
            (lp definitions))))))