From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 6 Jan 2018 21:29:08 +0000 (-0500)
Subject: Implement variable-setter macro.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~415
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=61a425113ca332d19bd11b5375837490c5dd25c8;p=mit-scheme.git

Implement variable-setter macro.
---

diff --git a/src/runtime/host-adapter.scm b/src/runtime/host-adapter.scm
index bff97b3ac..1093bf104 100644
--- 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 3f76ab59f..a10f3d553 100644
--- 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 cd0d0e929..3c4835b25 100644
--- 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))))))
 
 (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