Implement variable-setter macro.

diff --git a/src/runtime/host-adapter.scm b/src/runtime/host-adapter.scm
index bff97b3aca58937b4e07e7d748fc46da2e63d006..1093bf104bb439ccee2747322c8bbb7280b17b83 100644 (file)
--- a/src/runtime/host-adapter.scm
+++ b/src/runtime/host-adapter.scm
@@ -74,6 +74,14 @@ USA.
                        ((4) (cadr form))
                        ((8) (caddr form))
                        (else (error "Unsupported bytes-per-object:" bpo)))))))
+             env))
+    (if (unbound? env 'variable-setter)
+       (eval '(define-syntax variable-setter
+                (syntax-rules ()
+                  ((_ identifier)
+                   (lambda (value)
+                     (set! identifier value)
+                     unspecific))))
              env)))
 
   (let ((env (->environment '(runtime microcode-tables))))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 3f76ab59fa443fc846a24c52d633833f9a6f5579..a10f3d553b553133c0e9f749e3d0d33387928ad4 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4772,7 +4772,8 @@ USA.
          select-on-bytes-per-word
          ucode-primitive
          ucode-return-address
-         ucode-type))
+         ucode-type
+         variable-setter))
 
 (define-package (runtime system)
   (files "system")

diff --git a/src/runtime/sysmac.scm b/src/runtime/sysmac.scm
index cd0d0e929cd6f624db286e73cd6e8d2865c75ca3..3c4835b25cb757caf4bd8d6e29ef2be3527083e6 100644 (file)
--- a/src/runtime/sysmac.scm
+++ b/src/runtime/sysmac.scm
@@ -32,7 +32,7 @@ USA.
 (define-syntax define-primitives
   (sc-macro-transformer
    (lambda (form environment)
-     environment
+     (declare (ignore environment))
      (let ((primitive-definition
            (lambda (variable-name primitive-args)
              (let ((primitive
@@ -59,19 +59,19 @@ USA.
 (define-syntax ucode-type
   (sc-macro-transformer
    (lambda (form environment)
-     environment
+     (declare (ignore environment))
      (apply microcode-type (cdr form)))))
 
 (define-syntax ucode-primitive
   (sc-macro-transformer
    (lambda (form environment)
-     environment
+     (declare (ignore environment))
      (apply make-primitive-procedure (cdr form)))))
 
 (define-syntax ucode-return-address
   (sc-macro-transformer
    (lambda (form environment)
-     environment
+     (declare (ignore environment))
      (make-return-address (apply microcode-return (cdr form))))))
 \f
 (define-syntax define-guarantee
@@ -96,7 +96,7 @@ USA.
 (define-syntax define-deferred
   (er-macro-transformer
    (lambda (form rename compare)
-     compare
+     (declare (ignore compare))
      (receive (name value)
         (parse-define-form form rename)
        `(,(rename 'BEGIN)
@@ -109,10 +109,17 @@ USA.
 (define-syntax select-on-bytes-per-word
   (er-macro-transformer
    (lambda (form rename compare)
-     rename compare
-     (syntax-check '(KEYWORD EXPRESSION EXPRESSION) form)
+     (declare (ignore rename compare))
+     (syntax-check '(_ expression expression) form)
      (let ((bpo (bytes-per-object)))
        (case bpo
         ((4) (cadr form))
         ((8) (caddr form))
-        (else (error "Unsupported bytes-per-object:" bpo)))))))
\ No newline at end of file
+        (else (error "Unsupported bytes-per-object:" bpo)))))))
+
+(define-syntax variable-setter
+  (syntax-rules ()
+    ((_ identifier)
+     (lambda (value)
+       (set! identifier value)
+       unspecific))))
\ No newline at end of file