Eliminate non-hygienic macros.

diff --git a/v7/src/compiler/machines/mips/instr1.scm b/v7/src/compiler/machines/mips/instr1.scm
index 869f15d2370c7d64bf90d6543c4db502ddfec6ce..482b29d0297c39f422cd1ed9ae0770f60772f8e6 100644 (file)
--- a/v7/src/compiler/machines/mips/instr1.scm
+++ b/v7/src/compiler/machines/mips/instr1.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: instr1.scm,v 1.8 2001/12/20 21:45:25 cph Exp $
+$Id: instr1.scm,v 1.9 2002/02/22 03:49:17 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
@@ -29,46 +29,48 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 \f
 (let-syntax
     ((arithmetic-immediate-instruction
-      (lambda (keyword opcode special-opcode)
-       `(define-instruction ,keyword
-          (((? destination) (? source) (? immediate))
-           (VARIABLE-WIDTH (evaluated-immediate immediate)
-             ((#x-8000 #x7fff)
-              (LONG (6 ,opcode)
-                    (5 source)
-                    (5 destination)
-                    (16 evaluated-immediate SIGNED)))
-             ((#x8000 #xffff)
-              ;; ORI     1, 0, immediate
-              ;; reg-op  destination, source, 1
-              (LONG (6 13)             ; ORI
-                    (5 0)
-                    (5 1)
-                    (16 evaluated-immediate)
-                    (6 0)              ; reg-op
-                    (5 source)
-                    (5 1)
-                    (5 destination)
-                    (5 0)
-                    (6 ,special-opcode)))
-             ((() ())
-              ;; LUI     1, (top of immediate)
-              ;; ORI     1, 1, (bottom of immediate)
-              ;; reg-op  destination, source, 1
-              (LONG (6 15)             ; LUI
-                    (5 0)
-                    (5 1)
-                    (16 (top-16-bits evaluated-immediate))
-                    (6 13)             ; ORI
-                    (5 1)
-                    (5 1)
-                    (16 (bottom-16-bits evaluated-immediate))
-                    (6 0)              ; reg-op
-                    (5 source)
-                    (5 1)
-                    (5 destination)
-                    (5 0)
-                    (6 ,special-opcode)))))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(DEFINE-INSTRUCTION ,(cadr form)
+           (((? destination) (? source) (? immediate))
+            (VARIABLE-WIDTH (evaluated-immediate immediate)
+              ((#x-8000 #x7fff)
+               (LONG (6 ,(caddr form))
+                     (5 source)
+                     (5 destination)
+                     (16 evaluated-immediate SIGNED)))
+              ((#x8000 #xffff)
+               ;; ORI     1, 0, immediate
+               ;; reg-op  destination, source, 1
+               (LONG (6 13)            ; ORI
+                     (5 0)
+                     (5 1)
+                     (16 evaluated-immediate)
+                     (6 0)             ; reg-op
+                     (5 source)
+                     (5 1)
+                     (5 destination)
+                     (5 0)
+                     (6 ,(cadddr form))))
+              ((() ())
+               ;; LUI     1, (top of immediate)
+               ;; ORI     1, 1, (bottom of immediate)
+               ;; reg-op  destination, source, 1
+               (LONG (6 15)            ; LUI
+                     (5 0)
+                     (5 1)
+                     (16 (top-16-bits evaluated-immediate))
+                     (6 13)            ; ORI
+                     (5 1)
+                     (5 1)
+                     (16 (bottom-16-bits evaluated-immediate))
+                     (6 0)             ; reg-op
+                     (5 source)
+                     (5 1)
+                     (5 destination)
+                     (5 0)
+                     (6 ,(cadddr form)))))))))))
   (arithmetic-immediate-instruction addi 8 32)
   (arithmetic-immediate-instruction addiu 9 33)
   (arithmetic-immediate-instruction slti 10 42)
@@ -76,33 +78,35 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
 (let-syntax
     ((unsigned-immediate-instruction
-      (lambda (keyword opcode special-opcode)
-       `(define-instruction ,keyword
-          (((? destination) (? source) (? immediate))
-           (VARIABLE-WIDTH (evaluated-immediate immediate)
-             ((0 #xffff)
-              (LONG (6 ,opcode)
-                    (5 source)
-                    (5 destination)
-                    (16 evaluated-immediate)))
-             ((() ())
-              ;; LUI     1, (top of immediate)
-              ;; ORI     1, 1, (bottom of immediate)
-              ;; reg-op  destination, source, 1
-              (LONG (6 15)             ; LUI
-                    (5 0)
-                    (5 1)
-                    (16 (top-16-bits evaluated-immediate))
-                    (6 13)             ; ORI
-                    (5 1)
-                    (5 1)
-                    (16 (bottom-16-bits evaluated-immediate))
-                    (6 0)              ; reg-op
-                    (5 source)
-                    (5 1)
-                    (5 destination)
-                    (5 0)
-                    (6 ,special-opcode)))))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(DEFINE-INSTRUCTION ,(cadr form)
+           (((? destination) (? source) (? immediate))
+            (VARIABLE-WIDTH (evaluated-immediate immediate)
+              ((0 #xffff)
+               (LONG (6 ,(caddr form))
+                     (5 source)
+                     (5 destination)
+                     (16 evaluated-immediate)))
+              ((() ())
+               ;; LUI     1, (top of immediate)
+               ;; ORI     1, 1, (bottom of immediate)
+               ;; reg-op  destination, source, 1
+               (LONG (6 15)            ; LUI
+                     (5 0)
+                     (5 1)
+                     (16 (top-16-bits evaluated-immediate))
+                     (6 13)            ; ORI
+                     (5 1)
+                     (5 1)
+                     (16 (bottom-16-bits evaluated-immediate))
+                     (6 0)             ; reg-op
+                     (5 source)
+                     (5 1)
+                     (5 destination)
+                     (5 0)
+                     (6 ,(cadddr form)))))))))))
   (unsigned-immediate-instruction andi 12 36)
   (unsigned-immediate-instruction ori 13 37)
   (unsigned-immediate-instruction xori 14 38))
@@ -143,15 +147,17 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 \f
 (let-syntax
     ((3-operand-instruction
-      (lambda (keyword opcode)
-       `(define-instruction ,keyword
-          (((? destination) (? source-1) (? source-2))
-           (LONG (6 0)
-                 (5 source-1)
-                 (5 source-2)
-                 (5 destination)
-                 (5 0)
-                 (6 ,opcode)))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(DEFINE-INSTRUCTION ,(cadr form)
+           (((? destination) (? source-1) (? source-2))
+            (LONG (6 0)
+                  (5 source-1)
+                  (5 source-2)
+                  (5 destination)
+                  (5 0)
+                  (6 ,(caddr form)))))))))
   (3-operand-instruction add 32)
   (3-operand-instruction addu 33)
   (3-operand-instruction sub 34)
@@ -165,45 +171,50 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
 (let-syntax
     ((shift-instruction
-      (lambda (keyword opcode)
-       `(define-instruction ,keyword
+      (lambda (form environment)
+       environment
+       `(DEFINE-INSTRUCTION ,(cadr form)
           (((? destination) (? source) (? amount))
            (LONG (6 0)
                  (5 0)
                  (5 source)
                  (5 destination)
                  (5 amount)
-                 (6 ,opcode)))))))
+                 (6 ,(caddr form))))))))
   (shift-instruction sll 0)
   (shift-instruction srl 2)
   (shift-instruction sra 3))
 
 (let-syntax
     ((shift-variable-instruction
-      (lambda (keyword opcode)
-       `(define-instruction ,keyword
-          (((? destination) (? source) (? amount))
-           (LONG (6 0)
-                 (5 amount)
-                 (5 source)
-                 (5 destination)
-                 (5 0)
-                 (6 ,opcode)))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(DEFINE-INSTRUCTION ,(cadr form)
+           (((? destination) (? source) (? amount))
+            (LONG (6 0)
+                  (5 amount)
+                  (5 source)
+                  (5 destination)
+                  (5 0)
+                  (6 ,(caddr form)))))))))
   (shift-variable-instruction sllv 4)
   (shift-variable-instruction srlv 6)
   (shift-variable-instruction srav 7))
 \f
 (let-syntax
     ((div/mul-instruction
-      (lambda (keyword opcode)
-       `(define-instruction ,keyword
-          (((? source-1) (? source-2))
-           (LONG (6 0)
-                 (5 source-1)
-                 (5 source-2)
-                 (5 0)
-                 (5 0)
-                 (6 ,opcode)))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(DEFINE-INSTRUCTION ,(cadr form)
+           (((? source-1) (? source-2))
+            (LONG (6 0)
+                  (5 source-1)
+                  (5 source-2)
+                  (5 0)
+                  (5 0)
+                  (6 ,(caddr form)))))))))
   (div/mul-instruction div 26)
   (div/mul-instruction divu 27)
   (div/mul-instruction mult 24)
@@ -211,39 +222,45 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
 (let-syntax
     ((from-hi/lo-instruction
-      (lambda (keyword opcode)
-       `(define-instruction ,keyword
-          (((? destination))
-           (LONG (6 0)
-                 (5 0)
-                 (5 0)
-                 (5 destination)
-                 (5 0)
-                 (6 ,opcode)))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(DEFINE-INSTRUCTION ,(cadr form)
+           (((? destination))
+            (LONG (6 0)
+                  (5 0)
+                  (5 0)
+                  (5 destination)
+                  (5 0)
+                  (6 ,(caddr form)))))))))
   (from-hi/lo-instruction mfhi 16)
   (from-hi/lo-instruction mflo 18))
 #|
 (let-syntax
     ((to-hi/lo-instruction
-      (lambda (keyword opcode)
-       `(define-instruction ,keyword
-          (((? source))
-           (LONG (6 0)
-                 (5 source)
-                 (5 0)
-                 (5 0)
-                 (5 0)
-                 (6 ,opcode)))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(DEFINE-INSTRUCTION ,(cadr form)
+           (((? source))
+            (LONG (6 0)
+                  (5 source)
+                  (5 0)
+                  (5 0)
+                  (5 0)
+                  (6 ,(caddr form)))))))))
   (to-hi/lo-instruction mthi 17)
   (to-hi/lo-instruction mtlo 19))
 
 (let-syntax
     ((jump-instruction
-      (lambda (keyword opcode)
-       `(define-instruction ,keyword
-          (((? address))
-           (LONG (6 ,opcode)
-                 (26 (quotient address 2))))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(DEFINE-INSTRUCTION ,(cadr form)
+           (((? address))
+            (LONG (6 ,(caddr form))
+                  (26 (QUOTIENT address 2)))))))))
   (jump-instruction j 2)
   (jump-instruction jal 3))
 |#
@@ -267,14 +284,16 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 \f
 (let-syntax
     ((move-coprocessor-instruction
-      (lambda (keyword opcode move-op)
-       `(define-instruction ,keyword
-          (((? rt-mci) (? rd-mci))
-           (LONG (6 ,opcode)
-                 (5 ,move-op)
-                 (5 rt-mci)
-                 (5 rd-mci)
-                 (11 0)))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(DEFINE-INSTRUCTION ,(cadr form)
+           (((? rt-mci) (? rd-mci))
+            (LONG (6 ,(caddr form))
+                  (5 ,(cadddr form))
+                  (5 rt-mci)
+                  (5 rd-mci)
+                  (11 0))))))))
   ;; (move-coprocessor-instruction mfc0 16 #x000)
   (move-coprocessor-instruction mfc1 17 #x000)
   ;; (move-coprocessor-instruction mfc2 18 #x000)
@@ -295,12 +314,14 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 #|
 (let-syntax
     ((coprocessor-instruction
-      (lambda (keyword opcode)
-       `(define-instruction ,keyword
-          (((? cofun))
-           (LONG (6 ,opcode)
-                 (1 1)                 ; CO bit
-                 (25 cofun)))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(DEFINE-INSTRUCTION ,(cadr form)
+           (((? cofun))
+            (LONG (6 ,(caddr form))
+                  (1 1)                ; CO bit
+                  (25 cofun))))))))
   (coprocessor-instruction cop0 16)
   (coprocessor-instruction cop1 17)
   (coprocessor-instruction cop2 18)
@@ -308,13 +329,15 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
 (let-syntax
     ((cop0-instruction
-      (lambda (keyword cp0-op)
-       `(define-instruction ,keyword
-          (()
-           (LONG (6 16)
-                 (1 1)                 ; CO
-                 (20 0)
-                 (5 ,cp0-op)))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(DEFINE-INSTRUCTION ,(cadr form)
+           (()
+            (LONG (6 16)
+                  (1 1)                ; CO
+                  (20 0)
+                  (5 ,(caddr form)))))))))
   (cop0-instruction rfe 16)
   (cop0-instruction tlbp 8)
   (cop0-instruction tlbr 1)

diff --git a/v7/src/compiler/machines/mips/instr2a.scm b/v7/src/compiler/machines/mips/instr2a.scm
index 1d917becd22a2e2b37d8488e7ac6835a2fc5adb9..439d2fe8c45f5271853c5a0e5da074b2cf1ec9a8 100644 (file)
--- a/v7/src/compiler/machines/mips/instr2a.scm
+++ b/v7/src/compiler/machines/mips/instr2a.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: instr2a.scm,v 1.6 2001/12/20 21:45:25 cph Exp $
+$Id: instr2a.scm,v 1.7 2002/02/22 03:50:51 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
@@ -28,47 +28,49 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
 (let-syntax
     ((branch
-      (lambda (keyword match-phrase forward reverse)
-       `(define-instruction ,keyword
-          ((,@match-phrase (@PCO (? offset)))
-           (LONG ,@forward
-                 (16 (quotient offset 4) SIGNED)))
-          ((,@match-phrase (@PCR (? label)))
-           (VARIABLE-WIDTH (offset `(/ (- ,label (+ *PC* 4)) 4))
-             ((#x-8000 #x7fff)
-              (LONG ,@forward (16 offset SIGNED)))
-             ((() ())
-              ;;         <reverse> xxx
-              ;;         LUI    $1, left_adj(offset*4 - 12)
-              ;;         BGEZAL $0, yyy
-              ;;         ADDIU  $1, $1, right(offset*4 - 12)
-              ;; yyy:    ADD    $1, $1, $31
-              ;;         JR     $1
-              ;; xxx:
-              (LONG ,@reverse          ; reverse branch to (.+1)+5
-                    (16 5)
-                    (6 15)             ; LUI
-                    (5 0)
-                    (5 1)
-                    (16 (adjusted:high (* (- offset 3) 4)))
-                    (6 1)              ; BGEZAL
-                    (5 0)
-                    (5 17)
-                    (16 1)
-                    (6 9)              ; ADDIU
-                    (5 1)
-                    (5 1)
-                    (16 (adjusted:low (* (- offset 3) 4)) SIGNED)
-                    (6 0)              ; ADD
-                    (5 1)
-                    (5 31)
-                    (5 1)
-                    (5 0)
-                    (6 32)
-                    (6 0)              ; JR
-                    (5 1)
-                    (15 0)
-                    (6 8)))))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(DEFINE-INSTRUCTION ,(cadr form)
+           ((,@(caddr form) (@PCO (? offset)))
+            (LONG ,@(cadddr form)
+                  (16 (quotient offset 4) SIGNED)))
+           ((,@(caddr form) (@PCR (? label)))
+            (VARIABLE-WIDTH (offset `(/ (- ,label (+ *PC* 4)) 4))
+              ((#x-8000 #x7fff)
+               (LONG ,@(cadddr form) (16 offset SIGNED)))
+              ((() ())
+               ;;         <reverse> xxx
+               ;;         LUI    $1, left_adj(offset*4 - 12)
+               ;;         BGEZAL $0, yyy
+               ;;         ADDIU  $1, $1, right(offset*4 - 12)
+               ;; yyy:    ADD    $1, $1, $31
+               ;;         JR     $1
+               ;; xxx:
+               (LONG ,@(list-ref form 4) ; reverse branch to (.+1)+5
+                     (16 5)
+                     (6 15)            ; LUI
+                     (5 0)
+                     (5 1)
+                     (16 (adjusted:high (* (- offset 3) 4)))
+                     (6 1)             ; BGEZAL
+                     (5 0)
+                     (5 17)
+                     (16 1)
+                     (6 9)             ; ADDIU
+                     (5 1)
+                     (5 1)
+                     (16 (adjusted:low (* (- offset 3) 4)) SIGNED)
+                     (6 0)             ; ADD
+                     (5 1)
+                     (5 31)
+                     (5 1)
+                     (5 0)
+                     (6 32)
+                     (6 0)             ; JR
+                     (5 1)
+                     (15 0)
+                     (6 8))))))))))
   (branch beq
          ((? reg1) (? reg2))
          ((6 4) (5 reg1) (5 reg2))

diff --git a/v7/src/compiler/machines/mips/instr2b.scm b/v7/src/compiler/machines/mips/instr2b.scm
index 7272066cba436c157523723fafd5c66c24f90fb0..5ae87f48b33f695f8771800db3b3c5dc35801fb5 100644 (file)
--- a/v7/src/compiler/machines/mips/instr2b.scm
+++ b/v7/src/compiler/machines/mips/instr2b.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: instr2b.scm,v 1.5 2001/12/20 21:45:25 cph Exp $
+$Id: instr2b.scm,v 1.6 2002/02/22 03:52:45 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
@@ -28,33 +28,35 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
 (let-syntax
     ((load/store-instruction
-      (lambda (keyword opcode)
-       `(define-instruction ,keyword
-          (((? source/dest-reg) (OFFSET (? offset-ls) (? base-reg)))
-           (VARIABLE-WIDTH (delta offset-ls)
-              ((#x-8000 #x7fff)
-              (LONG (6 ,opcode)
-                    (5 base-reg)
-                    (5 source/dest-reg)
-                    (16 delta SIGNED)))
-             ((() ())
-              ;; LUI    1,adjusted-left<offset>
-              ;; ADDU   1,1,base-reg
-              ;; LW     source/dest-reg,right<offset>(1)
-              (LONG (6 15)     ; LUI
-                    (5 0)
-                    (5 1)
-                    (16 (adjusted:high delta))
-                    (6 0)      ; ADD
-                    (5 1)
-                    (5 base-reg)
-                    (5 1)
-                    (5 0)
-                    (6 32)
-                    (6 ,opcode); LW
-                    (5 1)
-                    (5 source/dest-reg)
-                    (16 (adjusted:low delta) SIGNED)))))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(DEFINE-INSTRUCTION ,(cadr form)
+           (((? source/dest-reg) (OFFSET (? offset-ls) (? base-reg)))
+            (VARIABLE-WIDTH (delta offset-ls)
+              ((#x-8000 #x7fff)
+               (LONG (6 ,(caddr form))
+                     (5 base-reg)
+                     (5 source/dest-reg)
+                     (16 delta SIGNED)))
+              ((() ())
+               ;; LUI    1,adjusted-left<offset>
+               ;; ADDU   1,1,base-reg
+               ;; LW     source/dest-reg,right<offset>(1)
+               (LONG (6 15)    ; LUI
+                     (5 0)
+                     (5 1)
+                     (16 (adjusted:high delta))
+                     (6 0)     ; ADD
+                     (5 1)
+                     (5 base-reg)
+                     (5 1)
+                     (5 0)
+                     (6 32)
+                     (6 ,(caddr form)); LW
+                     (5 1)
+                     (5 source/dest-reg)
+                     (16 (adjusted:low delta) SIGNED))))))))))
   (load/store-instruction lb 32)
   (load/store-instruction lbu 36)
   (load/store-instruction lh 33)
@@ -75,4 +77,4 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
   ;; (load/store-instruction swc3 59)
   ;; (load/store-instruction swl 42)
   ;; (load/store-instruction swr 46)
-  )
+  )
\ No newline at end of file

diff --git a/v7/src/compiler/machines/mips/instr3.scm b/v7/src/compiler/machines/mips/instr3.scm
index 1693aef42495e8d261dc767d450a8e2b184a5a98..37cac19590fd902864a241e70f86501a81604b15 100644 (file)
--- a/v7/src/compiler/machines/mips/instr3.scm
+++ b/v7/src/compiler/machines/mips/instr3.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: instr3.scm,v 1.4 2001/12/20 21:45:25 cph Exp $
+$Id: instr3.scm,v 1.5 2002/02/22 03:54:22 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
@@ -27,26 +27,28 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 \f
 (let-syntax
     ((three-reg
-      (lambda (keyword function-code)
-       `(BEGIN
-          (DEFINE-INSTRUCTION ,(symbol-append keyword '.S)
-            (((? fd) (? fs) (? ft))
-             (LONG (6 17)
-                   (1 1)
-                   (4 0)               ; single precision
-                   (5 ft)
-                   (5 fs)
-                   (5 fd)
-                   (6 ,function-code))))
-          (DEFINE-INSTRUCTION ,(symbol-append keyword '.D)
-            (((? fd) (? fs) (? ft))
-             (LONG (6 17)
-                   (1 1)
-                   (4 1)               ; double precision
-                   (5 ft)
-                   (5 fs)
-                   (5 fd)
-                   (6 ,function-code))))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(BEGIN
+           (DEFINE-INSTRUCTION ,(symbol-append (cadr form) '.S)
+             (((? fd) (? fs) (? ft))
+              (LONG (6 17)
+                    (1 1)
+                    (4 0)              ; single precision
+                    (5 ft)
+                    (5 fs)
+                    (5 fd)
+                    (6 ,(caddr form)))))
+           (DEFINE-INSTRUCTION ,(symbol-append (cadr form) '.D)
+             (((? fd) (? fs) (? ft))
+              (LONG (6 17)
+                    (1 1)
+                    (4 1)              ; double precision
+                    (5 ft)
+                    (5 fs)
+                    (5 fd)
+                    (6 ,(caddr form))))))))))
 
   (three-reg add 0)
   (three-reg sub 1)
@@ -55,26 +57,28 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 
 (let-syntax
     ((two-reg
-      (lambda (keyword function-code)
-       `(BEGIN
-          (DEFINE-INSTRUCTION ,(symbol-append keyword '.S)
-            (((? fd) (? fs))
-             (LONG (6 17)
-                   (1 1)
-                   (4 0)               ; single precision
-                   (5 0)
-                   (5 fs)
-                   (5 fd)
-                   (6 ,function-code))))
-          (DEFINE-INSTRUCTION ,(symbol-append keyword '.D)
-            (((? fd) (? fs))
-             (LONG (6 17)
-                   (1 1)
-                   (4 1)               ; double precision
-                   (5 0)
-                   (5 fs)
-                   (5 fd)
-                   (6 ,function-code))))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(BEGIN
+           (DEFINE-INSTRUCTION ,(symbol-append (cadr form) '.S)
+             (((? fd) (? fs))
+              (LONG (6 17)
+                    (1 1)
+                    (4 0)              ; single precision
+                    (5 0)
+                    (5 fs)
+                    (5 fd)
+                    (6 ,(caddr form)))))
+           (DEFINE-INSTRUCTION ,(symbol-append (cadr form) '.D)
+             (((? fd) (? fs))
+              (LONG (6 17)
+                    (1 1)
+                    (4 1)              ; double precision
+                    (5 0)
+                    (5 fs)
+                    (5 fd)
+                    (6 ,(caddr form))))))))))
   (two-reg abs 5)
   (two-reg mov 6)
   (two-reg neg 7))
@@ -141,26 +145,28 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 \f
 (let-syntax
     ((compare
-      (lambda (keyword conditions)
-       `(BEGIN
-          (DEFINE-INSTRUCTION ,(symbol-append keyword '.S)
-            (((? fs) (? ft))
-             (LONG (6 17)
-                   (1 1)
-                   (4 0)
-                   (5 ft)
-                   (5 fs)
-                   (5 0)
-                   (6 ,conditions))))
-          (DEFINE-INSTRUCTION ,(symbol-append keyword '.D)
-            (((? fs) (? ft))
-             (LONG (6 17)
-                   (1 1)
-                   (4 1)
-                   (5 ft)
-                   (5 fs)
-                   (5 0)
-                   (6 ,conditions))))))))
+      (sc-macro-transformer
+       (lambda (form environment)
+        environment
+        `(BEGIN
+           (DEFINE-INSTRUCTION ,(symbol-append (cadr form) '.S)
+             (((? fs) (? ft))
+              (LONG (6 17)
+                    (1 1)
+                    (4 0)
+                    (5 ft)
+                    (5 fs)
+                    (5 0)
+                    (6 ,(caddr form)))))
+           (DEFINE-INSTRUCTION ,(symbol-append (cadr form) '.D)
+             (((? fs) (? ft))
+              (LONG (6 17)
+                    (1 1)
+                    (4 1)
+                    (5 ft)
+                    (5 fs)
+                    (5 0)
+                    (6 ,(caddr form))))))))))
   (compare c.f 48)
   (compare c.un 49)
   (compare c.eq 50)

diff --git a/v7/src/compiler/machines/mips/lapgen.scm b/v7/src/compiler/machines/mips/lapgen.scm
index 52fdcc3301357f3a3bba3353d31f4a5e2b4707d4..f80a3b8c58a24b8e4947e44bf386d81989b49a2f 100644 (file)
--- a/v7/src/compiler/machines/mips/lapgen.scm
+++ b/v7/src/compiler/machines/mips/lapgen.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.17 2001/12/20 21:45:25 cph Exp $
+$Id: lapgen.scm,v 1.18 2002/02/22 03:55:30 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
@@ -605,16 +605,18 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 ;;;; Codes and Hooks
 
 (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) (+ index 1)))
+                            '())))))))
   (define-codes #x012
     primitive-apply primitive-lexpr-apply
     apply error lexpr-apply link