Eliminate non-hygienic macros.
authorChris Hanson <org/chris-hanson/cph>
Tue, 12 Feb 2002 00:29:16 +0000 (00:29 +0000)
committerChris Hanson <org/chris-hanson/cph>
Tue, 12 Feb 2002 00:29:16 +0000 (00:29 +0000)
v7/src/compiler/base/pmpars.scm
v7/src/compiler/machines/i386/dassm2.scm
v7/src/compiler/machines/i386/dassm3.scm
v7/src/compiler/machines/i386/insmac.scm

index 526351fa366356b94323c4c0bb176267ba77dad8..40456e2b9932bfde0dbc375d867b879ec22f8e13 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: pmpars.scm,v 1.5 2002/02/12 00:25:30 cph Exp $
+$Id: pmpars.scm,v 1.6 2002/02/12 00:29:16 cph Exp $
 
-Copyright (c) 1988, 1999 Massachusetts Institute of Technology
+Copyright (c) 1988, 1999, 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
index c2c03a2f471d9c9b623a51d1d26b37966032ab0b..b71c41313a4d4f9467ebad99301554455b8f06b3 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dassm2.scm,v 1.11 2001/12/23 17:20:58 cph Exp $
+$Id: dassm2.scm,v 1.12 2002/02/12 00:26:37 cph Exp $
 
-Copyright (c) 1992-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1992-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,12 +27,15 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 \f
 (define (disassembler/read-variable-cache block index)
   (let-syntax ((ucode-type
-               (non-hygienic-macro-transformer
-                (lambda (name) (microcode-type name))))
+               (sc-macro-transformer
+                (lambda (form environment)
+                  environment
+                  (apply microcode-type (cdr form)))))
               (ucode-primitive
-               (non-hygienic-macro-transformer
-                (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))))
@@ -187,12 +190,15 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
   (with-absolutely-no-interrupts
    (lambda ()
      (let-syntax ((ucode-type
-                  (non-hygienic-macro-transformer
-                   (lambda (name) (microcode-type name))))
+                  (sc-macro-transformer
+                   (lambda (form environment)
+                     environment
+                     (apply microcode-type (cdr form)))))
                  (ucode-primitive
-                  (non-hygienic-macro-transformer
-                   (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 3365a87064cc383b4a115d7c32595cceb5bd3238..1af57f4184948f548b7303a24972904ed22b6b28 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dassm3.scm,v 1.9 2001/12/23 17:20:58 cph Exp $
+$Id: dassm3.scm,v 1.10 2002/02/12 00:26:42 cph Exp $
 
-Copyright (c) 1992, 1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1992, 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
@@ -440,9 +440,11 @@ USA.
 (define decode-fp
   (let-syntax
       ((IN
-       (non-hygienic-macro-transformer
-        (lambda (body . bindings)
-          `(LET ,bindings ,body)))))
+       (rsc-macro-transformer
+        (lambda (form environment)
+          `(,(close-syntax 'LET environment)
+            ,(cddr form)
+            ,(cadr form))))))
     (IN
      (lambda (opcode-byte)
        (let* ((next (next-unsigned-byte))
index 28d5458bc5c234662fcd687900b1aee5d3538bd6..cbeec60d80c9966f378c48bcfed76c910ad06a8a 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: insmac.scm,v 1.13 2001/12/23 17:20:58 cph Exp $
+$Id: insmac.scm,v 1.14 2002/02/12 00:26:46 cph Exp $
 
-Copyright (c) 1992, 1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1992, 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
@@ -25,14 +25,16 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 (declare (usual-integrations))
 \f
 (define-syntax define-trivial-instruction
-  (non-hygienic-macro-transformer
-   (lambda (mnemonic opcode . extra)
-     `(DEFINE-INSTRUCTION ,mnemonic
-       (()
-        (BYTE (8 ,opcode))
-        ,@(map (lambda (extra)
-                 `(BYTE (8 ,extra)))
-               extra))))))
+  (sc-macro-transformer
+   (lambda (form environment)
+     (if (syntax-match? '(IDENTIFIER DATUM * DATUM) (cdr form))
+        `(DEFINE-INSTRUCTION ,(cadr form)
+           (()
+            (BYTE (8 ,(close-syntax (caddr form) environment)))
+            ,@(map (lambda (extra)
+                     `(BYTE (8 ,(close-syntax extra environment))))
+                   (cdddr form))))
+        (ill-formed-syntax form)))))
 
 ;;;; Effective addressing
 
@@ -40,23 +42,22 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
   'EA-DATABASE)
 
 (define-syntax define-ea-database
-  (non-hygienic-macro-transformer
-   (lambda rules
+  (sc-macro-transformer
+   (lambda (form environment)
      `(DEFINE ,ea-database-name
-       ,(compile-database rules
-                          (lambda (pattern actions)
-                            (let ((keyword (car pattern))
-                                  (categories (car actions))
-                                  (mode (cadr actions))
-                                  (register (caddr actions))
-                                  (tail (cdddr actions)))
-                              (declare (integrate keyword value))
-                              `(MAKE-EFFECTIVE-ADDRESS
-                                ',keyword
-                                ',categories
-                                ,(integer-syntaxer mode 'UNSIGNED 2)
-                                ,(integer-syntaxer register 'UNSIGNED 3)
-                                ,(process-tail tail false)))))))))
+       ,(compile-database (cdr form) environment
+          (lambda (pattern actions)
+            (let ((keyword (car pattern))
+                  (categories (car actions))
+                  (mode (cadr actions))
+                  (register (caddr actions))
+                  (tail (cdddr actions)))
+              `(MAKE-EFFECTIVE-ADDRESS
+                ',keyword
+                ',categories
+                ,(integer-syntaxer mode 'UNSIGNED 2)
+                ,(integer-syntaxer register 'UNSIGNED 3)
+                ,(process-tail tail #f)))))))))
 
 (define (process-tail tail early?)
   (if (null? tail)
@@ -66,19 +67,19 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 ;; This one is necessary to distinguish between r/mW mW, etc.
 
 (define-syntax define-ea-transformer
-  (non-hygienic-macro-transformer
-   (lambda (name #!optional restriction)
-     (if (default-object? restriction)
-        `(DEFINE (,name EXPRESSION)
+  (sc-macro-transformer
+   (lambda (form environment)
+     environment
+     (if (syntax-match? '(IDENTIFIER ? SYMBOL) (cdr form))
+        `(DEFINE (,(cadr form) EXPRESSION)
            (LET ((MATCH-RESULT (PATTERN-LOOKUP ,ea-database-name EXPRESSION)))
              (AND MATCH-RESULT
-                  (MATCH-RESULT))))
-        `(DEFINE (,name EXPRESSION)
-           (LET ((MATCH-RESULT (PATTERN-LOOKUP ,ea-database-name EXPRESSION)))
-             (AND MATCH-RESULT
-                  (LET ((EA (MATCH-RESULT)))
-                    (AND (MEMQ ',restriction (EA/CATEGORIES EA))
-                         EA)))))))))
+                  ,(if (pair? (cddr form))
+                       `(LET ((EA (MATCH-RESULT)))
+                          (AND (MEMQ ',(caddr form) (EA/CATEGORIES EA))
+                               EA))
+                       `(MATCH-RESULT)))))
+        (ill-formed-syntax form)))))
 \f
 ;; *** We can't really handle switching these right now. ***