Eliminate non-hygienic macros.

diff --git a/v7/src/compiler/machines/C/lapgen.scm b/v7/src/compiler/machines/C/lapgen.scm
index e502984aca2ef9e8ebb2693a96d0f7d8079072eb..f848ed4bb82b9dc5d90920f1cba5a2a21db2c3f8 100644 (file)
--- a/v7/src/compiler/machines/C/lapgen.scm
+++ b/v7/src/compiler/machines/C/lapgen.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.13 2001/12/20 21:45:24 cph Exp $
+$Id: lapgen.scm,v 1.14 2002/02/16 06:32: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
@@ -579,16 +579,18 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
                                operator))))
 
 (let-syntax ((define-codes
-              (lambda (start . names)
-                (define (loop names index)
-                  (if (null? names)
-                      '()
-                      (cons `(DEFINE-INTEGRABLE
-                               ,(symbol-append 'CODE:COMPILER-
-                                               (car names))
-                               ,index)
-                            (loop (cdr names) (1+ index)))))
-                `(BEGIN ,@(loop names start)))))
+              (sc-macro-transformer
+               (lambda (form environment)
+                 environment
+                 `(BEGIN
+                    ,@(let loop ((names (cddr form)) (index (cadr form)))
+                        (if (pair? names)
+                            (cons `(DEFINE-INTEGRABLE
+                                     ,(symbol-append 'CODE:COMPILER-
+                                                     (car names))
+                                     ,index)
+                                  (loop (cdr names) (1+ index)))
+                            `())))))))
   (define-codes #x012
     primitive-apply primitive-lexpr-apply
     apply error lexpr-apply link

diff --git a/v7/src/compiler/machines/C/rules3.scm b/v7/src/compiler/machines/C/rules3.scm
index e93da6c480591b2a328433f0cf75ba4ab03972e1..edc08fb64abacb735218822a59b5279c9596002c 100644 (file)
--- a/v7/src/compiler/machines/C/rules3.scm
+++ b/v7/src/compiler/machines/C/rules3.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: rules3.scm,v 1.10 2001/12/20 21:45:24 cph Exp $
+$Id: rules3.scm,v 1.11 2002/02/16 06:34:31 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
@@ -166,15 +166,18 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
 (let-syntax
     ((define-special-primitive-invocation
-       (lambda (name)
-        `(DEFINE-RULE STATEMENT
-           (INVOCATION:SPECIAL-PRIMITIVE
-            (? FRAME-SIZE)
-            (? CONTINUATION)
-            ,(make-primitive-procedure name true))
-           FRAME-SIZE CONTINUATION
-           (invoke-special-primitive
-            ,(symbol-append 'CODE:COMPILER- name))))))
+       (sc-macro-transformer
+       (lambda (form environment)
+         (let ((name (cadr form)))
+           `(DEFINE-RULE STATEMENT
+              (INVOCATION:SPECIAL-PRIMITIVE
+               (? FRAME-SIZE)
+               (? CONTINUATION)
+               ,(make-primitive-procedure name #t))
+              FRAME-SIZE CONTINUATION
+              (INVOKE-SPECIAL-PRIMITIVE
+               ,(close-syntax (symbol-append 'CODE:COMPILER- name)
+                              environment))))))))
   (define-special-primitive-invocation &+)
   (define-special-primitive-invocation &-)
   (define-special-primitive-invocation &*)

diff --git a/v7/src/compiler/machines/C/rulfix.scm b/v7/src/compiler/machines/C/rulfix.scm
index 47056597953b6a279d034951fb3d53bcdae3fdc6..60213b5f51c7774a2408fe781eb1bc086097e948 100644 (file)
--- a/v7/src/compiler/machines/C/rulfix.scm
+++ b/v7/src/compiler/machines/C/rulfix.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: rulfix.scm,v 1.4 2001/12/20 21:45:24 cph Exp $
+$Id: rulfix.scm,v 1.5 2002/02/16 06:37:29 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
@@ -165,12 +165,15 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 \f
 (let-syntax
     ((binary-fixnum
-      (lambda (name instr)
-       `(define-arithmetic-method ',name fixnum-methods/2-args
-          (lambda (tgt src1 src2 overflow?)
-            (if overflow? (no-overflow-branches!))
-            (LAP ,',tgt " = (" ,',src1 ,instr ,',src2 ");\n\t"))))))   
-
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        (let ((name (cadr form))
+              (instr (caddr form)))
+          `(DEFINE-ARITHMETIC-METHOD ',name FIXNUM-METHODS/2-ARGS
+             (LAMBDA (TGT SRC1 SRC2 OVERFLOW?)
+               (IF OVERFLOW? (NO-OVERFLOW-BRANCHES!))
+               (LAP ,',tgt " = (" ,',src1 ,instr ,',src2 ");\n\t"))))))))
   (binary-fixnum FIXNUM-AND    " & ")
   (binary-fixnum FIXNUM-OR     " | ")
   (binary-fixnum FIXNUM-XOR    " ^ ")
@@ -178,13 +181,16 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
 (let-syntax
     ((binary-fixnum
-      (lambda (name instr)
-       `(define-arithmetic-method ',name fixnum-methods/2-args
-          (lambda (tgt src1 src2 overflow?)
-            (if overflow? (no-overflow-branches!))
-            (LAP ,',tgt
-                 " = (" ,instr " (" ,',src1 ", " ,',src2 "));\n\t"))))))
-
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        (let ((name (cadr form))
+              (instr (caddr form)))
+          `(DEFINE-ARITHMETIC-METHOD ',name FIXNUM-METHODS/2-ARGS
+             (LAMBDA (TGT SRC1 SRC2 OVERFLOW?)
+               (IF OVERFLOW? (NO-OVERFLOW-BRANCHES!))
+               (LAP ,',tgt
+                    " = (" ,instr " (" ,',src1 ", " ,',src2 "));\n\t"))))))))
   (binary-fixnum FIXNUM-REMAINDER "FIXNUM_REMAINDER")
   (binary-fixnum FIXNUM-LSH "FIXNUM_LSH"))
 
@@ -410,14 +416,17 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
 (let-syntax
     ((binary-fixnum
-      (lambda (name instr)
-       `(define-arithmetic-method ',name
-          fixnum-methods/2-args/register*constant
-          (lambda (tgt src1 constant overflow?)
-            (if overflow? (no-overflow-branches!))
-            (LAP ,',tgt " = (" ,',src1 ,instr ,',(longify constant)
-                 ");\n\t"))))))
-
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        (let ((name (cadr form))
+              (instr (caddr form)))
+          `(DEFINE-ARITHMETIC-METHOD ',name
+             FIXNUM-METHODS/2-ARGS/REGISTER*CONSTANT
+             (LAMBDA (TGT SRC1 CONSTANT OVERFLOW?)
+               (IF OVERFLOW? (NO-OVERFLOW-BRANCHES!))
+               (LAP ,',tgt " = (" ,',src1 ,instr ,',(longify constant)
+                    ");\n\t"))))))))
   (binary-fixnum FIXNUM-AND    " & ")
   (binary-fixnum FIXNUM-OR     " | ")
   (binary-fixnum FIXNUM-XOR    " ^ ")

diff --git a/v7/src/compiler/machines/C/rulflo.scm b/v7/src/compiler/machines/C/rulflo.scm
index d453001269b93fb799aadad5b9b2feeaf00cbd92..9fac0b98f2b1256531a4247a75996f08b511274d 100644 (file)
--- a/v7/src/compiler/machines/C/rulflo.scm
+++ b/v7/src/compiler/machines/C/rulflo.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: rulflo.scm,v 1.6 2001/12/20 21:45:24 cph Exp $
+$Id: rulflo.scm,v 1.7 2002/02/16 06:38:35 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
@@ -191,11 +191,13 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
 (let-syntax
     ((define-flonum-operation
-       (lambda (primitive-name opcode)
-        `(define-arithmetic-method ',primitive-name flonum-methods/2-args
-           (lambda (target source1 source2)
-             (LAP ,',target " = (" ,',source1 ,opcode ,',source2
-                  ");\n\t"))))))
+       (sc-macro-transformer
+       (lambda (form environment)
+         environment
+         `(DEFINE-ARITHMETIC-METHOD ',(cadr form) FLONUM-METHODS/2-ARGS
+            (LAMBDA (TARGET SOURCE1 SOURCE2)
+              (LAP ,',target " = (" ,',source1 ,(caddr form) ,',source2
+                   ");\n\t")))))))
   (define-flonum-operation flonum-add " + ")
   (define-flonum-operation flonum-subtract " - ")
   (define-flonum-operation flonum-multiply " * ")

diff --git a/v7/src/compiler/machines/alpha/assmd.scm b/v7/src/compiler/machines/alpha/assmd.scm
index 8aa6f6a0da5a2c4777224f56f3d379d16098356c..6a0decca97d6ccca61d0b1604930b67b2ae97e3c 100644 (file)
--- a/v7/src/compiler/machines/alpha/assmd.scm
+++ b/v7/src/compiler/machines/alpha/assmd.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: assmd.scm,v 1.3 2001/12/20 21:46:10 cph Exp $
+$Id: assmd.scm,v 1.4 2002/02/16 06:39: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
@@ -25,7 +25,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

diff --git a/v7/src/compiler/machines/alpha/dassm1.scm b/v7/src/compiler/machines/alpha/dassm1.scm
index 30676ded068c148f4525be947ed0642f742ab350..bad5b21a8f6ac47441a3a030c4ababf17e317ff3 100644 (file)
--- a/v7/src/compiler/machines/alpha/dassm1.scm
+++ b/v7/src/compiler/machines/alpha/dassm1.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dassm1.scm,v 1.3 2001/12/20 21:45:24 cph Exp $
+$Id: dassm1.scm,v 1.4 2002/02/16 06:42:16 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
@@ -148,9 +148,11 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
       (let loop ((index (compiled-code-block/constants-start block)))
        (cond ((not (< index end)) 'DONE)
              ((object-type?
-               (let-syntax ((ucode-type
-                             (lambda (name) (microcode-type name))))
-                 (ucode-type linkage-section))
+               ((sc-macro-transformer
+                 (lambda (form environment)
+                   environment
+                   (apply microcode-type (cdr form))))
+                linkage-section)
                (system-vector-ref block index))
               (loop (disassembler/write-linkage-section block
                                                         symbol-table

diff --git a/v7/src/compiler/machines/alpha/dassm2.scm b/v7/src/compiler/machines/alpha/dassm2.scm
index f6d960ed0e5ec79c3109041c8dc629209cd429cf..424b22fec8d49870bbfe76c767826b9cdc6e2db9 100644 (file)
--- a/v7/src/compiler/machines/alpha/dassm2.scm
+++ b/v7/src/compiler/machines/alpha/dassm2.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dassm2.scm,v 1.3 2001/12/20 21:45:24 cph Exp $
+$Id: dassm2.scm,v 1.4 2002/02/16 06:43:11 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
@@ -32,10 +32,15 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 (set! disassembler/read-variable-cache
       (lambda (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)))))