From 72e4cca1293df07a3ea2b212c5cf0a4f250538de Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 11 Apr 2017 21:20:41 -0700
Subject: [PATCH] Implement bytes-per-object.

---
 src/compiler/machines/x86-64/rulflo.scm | 4 +---
 src/edwin/string.scm                    | 2 +-
 src/edwin/undo.scm                      | 2 +-
 src/edwin/utils.scm                     | 2 +-
 src/runtime/boot.scm                    | 5 ++++-
 src/runtime/load.scm                    | 2 +-
 src/runtime/runtime.pkg                 | 1 +
 7 files changed, 10 insertions(+), 8 deletions(-)

diff --git a/src/compiler/machines/x86-64/rulflo.scm b/src/compiler/machines/x86-64/rulflo.scm
index 55351a84b..d38bbfa17 100644
--- a/src/compiler/machines/x86-64/rulflo.scm
+++ b/src/compiler/machines/x86-64/rulflo.scm
@@ -391,8 +391,6 @@ USA.
    (let ((bit-string (make-bit-string 64 #f)))
      ;; Skip the manifest preceding the flonum data.  Is there a
      ;; better way to express this?
-     (let* ((bytes-per-object (vector-ref (gc-space-status) 0))
-            (bits-per-object (* 8 bytes-per-object))
-            (flonum-data-offset-in-bits bits-per-object))
+     (let ((flonum-data-offset-in-bits (* 8 (bytes-per-object))))
        (read-bits! flonum flonum-data-offset-in-bits bit-string))
      bit-string)))
diff --git a/src/edwin/string.scm b/src/edwin/string.scm
index fdfb24878..48783b21f 100644
--- a/src/edwin/string.scm
+++ b/src/edwin/string.scm
@@ -186,7 +186,7 @@ USA.
 	 1))
 
 (define %octets->words-shift
-  (let ((chars-per-word (vector-ref (gc-space-status) 0)))
+  (let ((chars-per-word (bytes-per-object)))
     (case chars-per-word
       ((4) -2)
       ((8) -3)
diff --git a/src/edwin/undo.scm b/src/edwin/undo.scm
index f0d711267..c7c8ea97e 100644
--- a/src/edwin/undo.scm
+++ b/src/edwin/undo.scm
@@ -178,7 +178,7 @@ which includes both the saved text and other data."
   ;; the editor does not exist or is not running.  It would actually
   ;; prefer to be run *before* the GC, but that's not possible now.
   (if edwin-editor
-      (let ((bytes/word (vector-ref (gc-space-status) 0)))
+      (let ((bytes/word (bytes-per-object)))
 	(let ((words->bytes
 	       (lambda (words)
 		 (round (/ words bytes/word)))))
diff --git a/src/edwin/utils.scm b/src/edwin/utils.scm
index 496d9c3b9..797242051 100644
--- a/src/edwin/utils.scm
+++ b/src/edwin/utils.scm
@@ -73,7 +73,7 @@ USA.
      ;; This is written as a macro so that the shift will be a constant
      ;; in the compiled code.
      ;; It does not work when cross-compiled!
-     (let ((chars-per-word (vector-ref (gc-space-status) 0)))
+     (let ((chars-per-word (bytes-per-object)))
        (case chars-per-word
 	 ((4) -2)
 	 ((8) -3)
diff --git a/src/runtime/boot.scm b/src/runtime/boot.scm
index 68cd9428a..774e12c4a 100644
--- a/src/runtime/boot.scm
+++ b/src/runtime/boot.scm
@@ -130,9 +130,12 @@ USA.
 (define (object-constant? object)
   ((ucode-primitive constant?) object))
 
-(define (gc-space-status)
+(define-integrable (gc-space-status)
   ((ucode-primitive gc-space-status)))
 
+(define (bytes-per-object)
+  (vector-ref (gc-space-status) 0))
+
 (define (object-pure? object)
   object
   #f)
diff --git a/src/runtime/load.scm b/src/runtime/load.scm
index 1069c179e..b47301de5 100644
--- a/src/runtime/load.scm
+++ b/src/runtime/load.scm
@@ -205,7 +205,7 @@ USA.
   (and (file-regular? pathname)
        (call-with-legacy-binary-input-file pathname
 	 (lambda (port)
-	   (let ((n (vector-ref (gc-space-status) 0)))
+	   (let ((n (bytes-per-object)))
 	     (let ((marker (make-legacy-string n)))
 	       (and (eqv? (read-string! marker port) n)
 		    (let loop ((i 0))
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 9c0b93aa0..f31af4396 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -136,6 +136,7 @@ USA.
   (parent (runtime))
   (export ()
 	  bracketed-unparser-method
+	  bytes-per-object
 	  default-object
 	  default-object?
 	  gc-space-status
-- 
2.25.1