Add optimizer and backend support for gc-pointer-ref

* module/language/cps/compile-bytecode.scm (compile-function):
* module/language/cps/cse.scm (compute-equivalent-subexpressions):
* module/language/cps/effects-analysis.scm:
* module/language/cps/reify-primitives.scm (reify-primitives):
* module/language/cps/slot-allocation.scm (compute-var-representations):
* module/language/cps/specialize-primcalls.scm (specialize-primcalls):
* module/language/cps/types.scm (gc-pointer-ref/immediate):
  (gc-pointer-set!/immediate):
* module/system/vm/assembler.scm: Add support for pointer-ref.

module/language/cps/compile-bytecode.scm

@@ -170,6 +170,8 @@
                        (from-sp (slot idx))))
         (($ $primcall 'word-ref/immediate (annotation . idx) (obj))
          (emit-word-ref/immediate asm (from-sp dst) (from-sp (slot obj)) idx))
+        (($ $primcall 'gc-pointer-ref/immediate (annotation . idx) (obj))
+         (emit-gc-pointer-ref/immediate asm (from-sp dst) (from-sp (slot obj)) idx))
         (($ $primcall 'struct-ref/immediate idx (struct))
          (emit-struct-ref/immediate asm (from-sp dst) (from-sp (slot struct))
                                     idx))
@@ -313,6 +315,9 @@
         (($ $primcall 'word-set!/immediate (annotation . idx) (obj val))
          (emit-word-set!/immediate asm (from-sp (slot obj)) idx
                                    (from-sp (slot val))))
+        (($ $primcall 'gc-pointer-set!/immediate (annotation . idx) (obj val))
+         (emit-gc-pointer-set!/immediate asm (from-sp (slot obj)) idx
+                                         (from-sp (slot val))))
         (($ $primcall 'free-set! idx (closure value))
          (emit-free-set! asm (from-sp (slot closure)) (from-sp (slot value))
                          idx))

module/language/cps/cse.scm

@@ -256,6 +256,7 @@ false.  It could be that both true and false proofs are available."
            ((scm-set!/immediate p s x)       (x <- scm-ref/immediate p s))
            ((word-set! p s i x)              (x <- word-ref p s i))
            ((word-set!/immediate p s x)      (x <- word-ref/immediate p s))
+           ((gc-pointer-set!/immediate p s x) (x <- gc-pointer-ref/immediate p s))
 
            ((s <- allocate-struct #f v n)    (v <- struct-vtable #f s))
            ((s <- allocate-struct/immediate n v) (v <- struct-vtable #f s))

module/language/cps/effects-analysis.scm

@@ -378,6 +378,15 @@ the LABELS that are clobbered by the effects of LABEL."
   ((word-set! obj idx val)         (&read-object
                                     (annotation->memory-kind param)))
   ((word-set!/immediate obj val)   (match param
+                                     ((ann . idx)
+                                      (&write-field
+                                       (annotation->memory-kind ann) idx))))
+  ((gc-pointer-ref/immediate obj)  (match param
+                                     ((ann . idx)
+                                      (&read-field
+                                       (annotation->memory-kind ann) idx))))
+  ((gc-pointer-set!/immediate obj val)
+                                   (match param
                                      ((ann . idx)
                                       (&write-field
                                        (annotation->memory-kind ann) idx)))))

module/language/cps/reify-primitives.scm

@@ -337,6 +337,7 @@
                            (setk label ($kargs names vars
                                          ($continue kop src
                                            ($primcall 'load-u64 n ())))))))))
+                 ;; Assume gc-pointer-ref/immediate is within u8 range.
                  (((or 'word-ref/immediate 'scm-ref/immediate) obj)
                   (match param
                     ((ann . idx)

module/language/cps/slot-allocation.scm

@@ -765,6 +765,8 @@ are comparable with eqv?.  A tmp slot may be used."
                                'srsh 'srsh/immediate
                                'bv-s8-ref 'bv-s16-ref 'bv-s32-ref 'bv-s64-ref))
               (intmap-add representations var 's64))
+             (($ $primcall (or 'gc-pointer-ref/immediate))
+              (intmap-add representations var 'gcptr))
              (_
               (intmap-add representations var 'scm))))
           (vars

module/language/cps/specialize-primcalls.scm

@@ -127,6 +127,8 @@
         (('allocate-words (? uint? n)) (allocate-words/immediate n ()))
         (('scm-ref o (? uint? i)) (scm-ref/immediate i (o)))
         (('scm-set! o (? uint? i) x) (scm-set!/immediate i (o x)))
+        ;; Assume gc-pointer-ref/immediate can always be emitted
+        ;; directly.
         (('word-ref o (? uint? i)) (word-ref/immediate i (o)))
         (('word-set! o (? uint? i) x) (word-set!/immediate i (o x)))
         (('add x (? num? y)) (add/immediate y (x)))

module/language/cps/types.scm

@@ -783,6 +783,17 @@ minimum, and maximum."
     ((annotation . idx)
      (restrict! obj (annotation->type annotation) (1+ idx) +inf.0))))
 
+(define-type-inferrer/param (gc-pointer-ref/immediate param obj result)
+  (match param
+    ((annotation . idx)
+     (restrict! obj (annotation->type annotation) (1+ idx) +inf.0)
+     (define! result &other-heap-object -inf.0 +inf.0))))
+
+(define-type-inferrer/param (gc-pointer-set!/immediate param obj word)
+  (match param
+    ((annotation . idx)
+     (restrict! obj (annotation->type annotation) (1+ idx) +inf.0))))
+
 
 
 ;;;

module/system/vm/assembler.scm

@@ -155,6 +155,9 @@
             emit-word-ref/immediate
             emit-word-set!/immediate
 
+            emit-gc-pointer-ref/immediate
+            emit-gc-pointer-set!/immediate
+
             emit-call
             emit-call-label
             emit-tail-call