Implement bytes-per-object.

diff --git a/src/compiler/machines/x86-64/rulflo.scm b/src/compiler/machines/x86-64/rulflo.scm
index 55351a84b8f1ae850ecdfd51a7a2f02bda9595cc..d38bbfa1783d3b4d86e81960c396bf5a68897584 100644 (file)
--- 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 fdfb248786014863c38cbf80943ecfadfa0109c8..48783b21fe2024cfd85296e615dd965c850a1247 100644 (file)
--- 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 f0d7112672ccb886caab433fbd76cfc215529280..c7c8ea97e57e7d615452f93f2ab346cfed4d8488 100644 (file)
--- 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 496d9c3b9a7443b57dbb97f731fb500a81d38a5b..7972420513092b6a11f1155944d3bd466e4cc634 100644 (file)
--- 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 68cd9428a6161bb35983f05dbe50b24eaba992ea..774e12c4a04e4872e4041edb527966a37f6d2a1d 100644 (file)
--- 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 1069c179ed1c6c1ab4852c5e3399081cd82cbb94..b47301de52ffaa49789bb2f519057a42e67339d9 100644 (file)
--- 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 9c0b93aa03144f6f5a4c6bc4a3a96bef0e027063..f31af4396e443e6a6b9ddcd6f260b7afc07703c2 100644 (file)
--- 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