Eliminate non-hygienic macros.
authorChris Hanson <org/chris-hanson/cph>
Fri, 22 Feb 2002 04:38:10 +0000 (04:38 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 22 Feb 2002 04:38:10 +0000 (04:38 +0000)
v7/src/compiler/machines/spectrum/assmd.scm
v7/src/compiler/machines/spectrum/dassm1.scm
v7/src/compiler/machines/spectrum/dassm2.scm
v7/src/compiler/machines/spectrum/instr1.scm

index ded9e1219caa0ee47c34958e541319c1d4f5a510..b1f885d1e1a91db4a58c3b304645082639c39d3a 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: assmd.scm,v 1.32 2001/12/20 21:45:25 cph Exp $
+$Id: assmd.scm,v 1.33 2002/02/22 04:34:05 cph Exp $
 
-Copyright (c) 1988, 1989, 1990, 1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1988-1990, 1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -24,7 +24,11 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
 (declare (usual-integrations))
 \f
-(let-syntax ((ucode-type (lambda (name) `',(microcode-type name))))
+(let-syntax ((ucode-type
+             (sc-macro-transformer
+              (lambda (form environment)
+                environment
+                (apply microcode-type (cdr form))))))
 
 (define-integrable maximum-padding-length
   ;; Instruction length is always a multiple of 32 bits
index 40107a40daf8a066cfd65740c60a1aea8463f064..494aa2ff6ff2a7e910e061193cdbc1c3b61a02eb 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dassm1.scm,v 4.21 2001/12/20 21:45:25 cph Exp $
+$Id: dassm1.scm,v 4.22 2002/02/22 04:34:49 cph Exp $
 
-Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -135,7 +135,10 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
        (cond ((not (< index end)) 'DONE)
              ((object-type?
                (let-syntax ((ucode-type
-                             (lambda (name) (microcode-type name))))
+                             (sc-macro-transformer
+                              (lambda (form environment)
+                                environment
+                                (apply microcode-type (cdr form))))))
                  (ucode-type linkage-section))
                (system-vector-ref block index))
               (loop (disassembler/write-linkage-section block
index 52d4ed0651065264824dd031bc8e7e8b7ba4c333..96ceb6cef11baac3c1f2d475d4e70e17b67872f4 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dassm2.scm,v 4.22 2001/12/20 21:45:25 cph Exp $
+$Id: dassm2.scm,v 4.23 2002/02/22 04:35:48 cph Exp $
 
-Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -27,10 +27,15 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 \f
 (define (disassembler/read-variable-cache block index)
   (let-syntax ((ucode-type
-               (lambda (name) (microcode-type name)))
+               (sc-macro-transformer
+                (lambda (form environment)
+                  environment
+                  (apply microcode-type (cdr form)))))
               (ucode-primitive
-               (lambda (name arity)
-                 (make-primitive-procedure name arity))))
+               (sc-macro-transformer
+                (lambda (form environment)
+                  environment
+                  (apply make-primitive-procedure (cdr form))))))
     ((ucode-primitive primitive-object-set-type 2)
      (ucode-type quad)
      (system-vector-ref block index))))
@@ -233,10 +238,15 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
                      (unsigned-integer->bit-string 32 address)
                      #*11111100000000000000000000000000)))
        (let-syntax ((ucode-type
-                     (lambda (name) (microcode-type name)))
+                     (sc-macro-transformer
+                      (lambda (form environment)
+                        environment
+                        (apply microcode-type (cdr form)))))
                     (ucode-primitive
-                     (lambda (name arity)
-                       (make-primitive-procedure name arity))))
+                     (sc-macro-transformer
+                      (lambda (form environment)
+                        environment
+                        (apply make-primitive-procedure (cdr form))))))
          ((ucode-primitive primitive-object-set-type 2)
           (ucode-type compiled-entry)
           ((ucode-primitive make-non-pointer-object 1)
index 78e7d72db57480207c94ac0b32fd63a152eb34ab..463e64133fd2c2788c04cd5b1e1564fd47debb52 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: instr1.scm,v 1.5 2001/12/20 21:45:25 cph Exp $
+$Id: instr1.scm,v 1.6 2002/02/22 04:38:10 cph Exp $
 
-Copyright (c) 1987-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1987-1999, 2001, 2002 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -264,16 +264,19 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
        `(,name ,value))))      
 
 (let-syntax ((define-operator
-              (lambda (name handler)
-                `(define ,name
-                   (make-operator ',name ,handler)))))
-
-(define-operator LEFT
-  (lambda (number)
-    (bit-string->signed-integer
-     (bit-substring (signed-integer->bit-string 32 number) 11 32))))
-
-(define-operator RIGHT
-  (lambda (number)
-    (bit-string->unsigned-integer
-     (bit-substring (signed-integer->bit-string 32 number) 0 11)))))
\ No newline at end of file
+              (sc-macro-transformer
+               (lambda (form environment)
+                 `(DEFINE ,(cadr form)
+                    (MAKE-operator ',(cadr form)
+                                   ,(close-syntax (caddr form)
+                                                  environment)))))))
+
+  (define-operator LEFT
+    (lambda (number)
+      (bit-string->signed-integer
+       (bit-substring (signed-integer->bit-string 32 number) 11 32))))
+
+  (define-operator RIGHT
+    (lambda (number)
+      (bit-string->unsigned-integer
+       (bit-substring (signed-integer->bit-string 32 number) 0 11)))))
\ No newline at end of file