From: Chris Hanson Date: Fri, 22 Feb 2002 03:55:30 +0000 (+0000) Subject: Eliminate non-hygienic macros. X-Git-Tag: 20090517-FFI~2222 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=72520d98a92cb7e0a2a9702bb65387dc3958585a;p=mit-scheme.git Eliminate non-hygienic macros. --- diff --git a/v7/src/compiler/machines/mips/instr1.scm b/v7/src/compiler/machines/mips/instr1.scm index 869f15d23..482b29d02 100644 --- 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 (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 (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)) (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 (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 1d917becd..439d2fe8c 100644 --- 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))) - ((() ()) - ;; 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))) + ((() ()) + ;; 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 7272066cb..5ae87f48b 100644 --- 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 - ;; ADDU 1,1,base-reg - ;; LW source/dest-reg,right(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 + ;; ADDU 1,1,base-reg + ;; LW source/dest-reg,right(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 1693aef42..37cac1959 100644 --- 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 (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 (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 52fdcc330..f80a3b8c5 100644 --- 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