From e62e81ebec6f230a5987b08ed6da3c42c2b69c88 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 22 Feb 2002 04:16:20 +0000 Subject: [PATCH] Eliminate non-hygienic macros. --- v7/src/compiler/machines/mips/mips.scm | 40 +++---- v7/src/compiler/machines/mips/rules3.scm | 38 ++++--- v7/src/compiler/machines/mips/rulflo.scm | 24 +++-- v7/src/compiler/machines/sparc/assmd.scm | 10 +- v7/src/compiler/machines/sparc/instr1.scm | 118 +++++++++++---------- v7/src/compiler/machines/sparc/instr2a.scm | 116 ++++++++++---------- v7/src/compiler/machines/sparc/instr2b.scm | 74 ++++++------- v7/src/compiler/machines/sparc/instr3.scm | 69 ++++++------ v7/src/compiler/machines/sparc/lapgen.scm | 26 ++--- v7/src/compiler/machines/sparc/rules3.scm | 31 +++--- v7/src/compiler/machines/sparc/rulflo.scm | 24 +++-- 11 files changed, 303 insertions(+), 267 deletions(-) diff --git a/v7/src/compiler/machines/mips/mips.scm b/v7/src/compiler/machines/mips/mips.scm index 44c9dd628..0f4d64889 100644 --- a/v7/src/compiler/machines/mips/mips.scm +++ b/v7/src/compiler/machines/mips/mips.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: mips.scm,v 1.3 2001/12/20 21:45:25 cph Exp $ +$Id: mips.scm,v 1.4 2002/02/22 04:01:40 cph Exp $ -Copyright (c) 1987, 1989, 1990, 1999, 2001 Massachusetts Institute of Technology +Copyright (c) 1987, 1989-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 @@ -25,22 +25,22 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (declare (usual-integrations)) (let-syntax - ((opcodes (lambda (suffix names) - (let loop ((value 0) - (names names) - (result '())) - (cond ((null? names) `(BEGIN ,@result)) - ((null? (car names)) (loop (+ value 1) (cdr names) result)) - (else - (loop (+ value 1) (cdr names) - (cons - `(define-integrable - ,(string->symbol - (string-append (symbol->string (car names)) suffix)) - ,value) - result)))))))) + ((opcodes + (sc-macro-transformer + (lambda (form environment) + environment + `(BEGIN + ,@(let loop ((names (caddr form)) (value 0)) + (if (pair? names) + (if (symbol? (car names)) + (cons `(DEFINE-INTEGRABLE + ,(symbol-append (car names) (cadr form)) + ,value) + (loop (cdr names) (+ value 1))) + (loop (cdr names) (+ value 1))) + '()))))))) ; OP CODES - (opcodes "-op" + (opcodes '-OP (special bcond j jal beq bne blez bgtz ; 0 - 7 addi addiu slti sltiu andi ori xori lui ; 8 - 15 cop0 cop1 cop2 cop3 () () () () ; 16 - 23 @@ -51,7 +51,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA swc0 swc1 swc2 swc3 () () () ())) ; 56 - 63 ; Special Function Codes - (opcodes "-funct" + (opcodes '-FUNCT (sll () srl sra sllv () srlv srav ; 0 - 7 jr jalr () () syscall break () () ; 8 - 15 mfhi mthi mflo mtlo () () () () ; 16 - 23 @@ -62,14 +62,14 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA () () () () () () () ())) ; 56 - 63 ; Condition codes for BCOND - (opcodes "-cond" + (opcodes '-COND (bltz bgez () () () () () () ; 0 - 7 () () () () () () () () ; 8 - 15 bltzal bgezal () () () () () () ; 16 - 23 () () () () () () () ())) ; 24 - 31 ; Floating point function codes for use with COP1 instruction - (opcodes "f-op" + (opcodes 'F-OP (add sub mul div () abs mov neg ; 0 - 7 () () () () () () () () ; 8 - 15 () () () () () () () () ; 16 - 23 diff --git a/v7/src/compiler/machines/mips/rules3.scm b/v7/src/compiler/machines/mips/rules3.scm index 03c68c953..78a37b42e 100644 --- a/v7/src/compiler/machines/mips/rules3.scm +++ b/v7/src/compiler/machines/mips/rules3.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: rules3.scm,v 1.19 2001/12/20 21:45:25 cph Exp $ +$Id: rules3.scm,v 1.20 2002/02/22 04:03:44 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 @@ -177,23 +177,29 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA code:compiler-primitive-lexpr-apply))) (else ;; Unknown primitive arity. Go through apply. - (LAP ,@(load-immediate regnum:third-arg frame-size #F) - ,@(invoke-interface code:compiler-apply)))))))))) + (LAP ,@(load-immediate regnum:third-arg + frame-size + #F) + ,@(invoke-interface + code:compiler-apply)))))))))) (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 - ,(list 'LAP - (list 'UNQUOTE-SPLICING '(CLEAR-MAP!)) - (list 'UNQUOTE-SPLICING - `(INVOKE-INTERFACE - ,(symbol-append 'CODE:COMPILER- name)))))))) + (sc-macro-transformer + (lambda (form environment) + `(DEFINE-RULE STATEMENT + (INVOCATION:SPECIAL-PRIMITIVE + (? FRAME-SIZE) + (? CONTINUATION) + ,(make-primitive-procedure (cadr form) #t)) + FRAME-SIZE CONTINUATION + ,(list 'LAP + (list 'UNQUOTE-SPLICING '(CLEAR-MAP!)) + (list 'UNQUOTE-SPLICING + `(INVOKE-INTERFACE + ,(close-syntax (symbol-append 'CODE:COMPILER- + (cadr form)) + environment))))))))) (define-special-primitive-invocation &+) (define-special-primitive-invocation &-) (define-special-primitive-invocation &*) diff --git a/v7/src/compiler/machines/mips/rulflo.scm b/v7/src/compiler/machines/mips/rulflo.scm index 432927d86..be1fb3a1f 100644 --- a/v7/src/compiler/machines/mips/rulflo.scm +++ b/v7/src/compiler/machines/mips/rulflo.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: rulflo.scm,v 1.9 2001/12/20 21:45:25 cph Exp $ +$Id: rulflo.scm,v 1.10 2002/02/22 04:05:25 cph Exp $ -Copyright (c) 1989-1999, 2001 Massachusetts Institute of Technology +Copyright (c) 1989-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 @@ -155,10 +155,12 @@ 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/1-arg - (lambda (target source) - (LAP (,opcode ,',target ,',source))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-ARITHMETIC-METHOD ',(cadr form) FLONUM-METHODS/1-ARG + (LAMBDA (TARGET SOURCE) + (LAP (,(caddr form) ,',TARGET ,',SOURCE)))))))) (define-flonum-operation flonum-abs ABS.D) (define-flonum-operation flonum-negate NEG.D)) @@ -183,10 +185,12 @@ 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 (,opcode ,',target ,',source1 ,',source2))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-ARITHMETIC-METHOD ',(cadr form) FLONUM-METHODS/2-ARGS + (LAMBDA (TARGET SOURCE1 SOURCE2) + (LAP (,(caddr form) ,',TARGET ,',SOURCE1 ,',SOURCE2)))))))) (define-flonum-operation flonum-add ADD.D) (define-flonum-operation flonum-subtract SUB.D) (define-flonum-operation flonum-multiply MUL.D) diff --git a/v7/src/compiler/machines/sparc/assmd.scm b/v7/src/compiler/machines/sparc/assmd.scm index 28cd07f05..b04f55c59 100644 --- a/v7/src/compiler/machines/sparc/assmd.scm +++ b/v7/src/compiler/machines/sparc/assmd.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: assmd.scm,v 1.3 2001/12/20 21:45:25 cph Exp $ +$Id: assmd.scm,v 1.4 2002/02/22 04:06:54 cph Exp $ -Copyright (c) 1988-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)) -(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/sparc/instr1.scm b/v7/src/compiler/machines/sparc/instr1.scm index b4a374580..c9d385c42 100644 --- a/v7/src/compiler/machines/sparc/instr1.scm +++ b/v7/src/compiler/machines/sparc/instr1.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: instr1.scm,v 1.3 2001/12/20 21:45:25 cph Exp $ +$Id: instr1.scm,v 1.4 2002/02/22 04:08:15 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,38 +29,40 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (let-syntax ((arithmetic-immediate-instruction - (lambda (keyword opcode) - `(define-instruction ,keyword - (((? destination) (? source) (? immediate)) - (VARIABLE-WIDTH (evaluated-immediate immediate) - ((#x-2000 #x1fff) - (LONG (2 2) - (5 destination) - (6 ,opcode) - (5 source) - (1 1) - (13 evaluated-immediate SIGNED))) - ((() ()) - ;; SETHI $1, top(immediate) - ;; OR $1, bottom(immediate) - ;; reg-op $destination, $source, $1 - (LONG (2 0) - (5 1) - (3 4) - (22 evaluated-immediate) ; SETHI - (2 2) - (5 1) - (6 2) - (5 1) - (1 1) - (13 evaluated-immediate SIGNED) ; OR - (2 0) - (5 destination) - (6 ,opcode) - (5 source) - (1 0) - (8 0) - (5 1))))))))) ; reg-op + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? destination) (? source) (? immediate)) + (VARIABLE-WIDTH (evaluated-immediate immediate) + ((#x-2000 #x1fff) + (LONG (2 2) + (5 destination) + (6 ,(caddr form)) + (5 source) + (1 1) + (13 evaluated-immediate SIGNED))) + ((() ()) + ;; SETHI $1, top(immediate) + ;; OR $1, bottom(immediate) + ;; reg-op $destination, $source, $1 + (LONG (2 0) + (5 1) + (3 4) + (22 evaluated-immediate) ; SETHI + (2 2) + (5 1) + (6 2) + (5 1) + (1 1) + (13 evaluated-immediate SIGNED) ; OR + (2 0) + (5 destination) + (6 ,(caddr form)) + (5 source) + (1 0) + (8 0) + (5 1)))))))))) ; reg-op (arithmetic-immediate-instruction addi 0) (arithmetic-immediate-instruction addcci 16) (arithmetic-immediate-instruction addxi 8) @@ -127,17 +129,19 @@ 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 (2 2) - (5 destination) - (6 ,opcode) - (5 source-1) - (1 0) - (8 0) - (5 source-2) - )))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? destination) (? source-1) (? source-2)) + (LONG (2 2) + (5 destination) + (6 ,(caddr form)) + (5 source-1) + (1 0) + (8 0) + (5 source-2) + ))))))) (3-operand-instruction add 0) (3-operand-instruction addcc 16) (3-operand-instruction addx 8) @@ -173,17 +177,19 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (let-syntax ((shift-instruction-immediate - (lambda (keyword opcode) - `(define-instruction ,keyword - (((? destination) (? source) (? amount)) - (LONG (2 2) - (5 destination) - (6 ,opcode) - (5 source) - (1 1) - (8 0) - (5 amount) - )))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? destination) (? source) (? amount)) + (LONG (2 2) + (5 destination) + (6 ,(caddr form)) + (5 source) + (1 1) + (8 0) + (5 amount) + ))))))) (shift-instruction-immediate sll 37) (shift-instruction-immediate srl 38) (shift-instruction-immediate sra 39)) diff --git a/v7/src/compiler/machines/sparc/instr2a.scm b/v7/src/compiler/machines/sparc/instr2a.scm index 5de090155..8f0c90fd9 100644 --- a/v7/src/compiler/machines/sparc/instr2a.scm +++ b/v7/src/compiler/machines/sparc/instr2a.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: instr2a.scm,v 1.3 2001/12/20 21:45:25 cph Exp $ +$Id: instr2a.scm,v 1.4 2002/02/22 04:09:27 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,61 +28,63 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (let-syntax ((branch - (lambda (keyword annul condition) - `(define-instruction ,keyword - (((@PCO (? offset))) - (LONG (2 0) - ,annul - ,condition - (3 2) - (22 (quotient offset 4) SIGNED))) - (((@PCR (? label))) - (VARIABLE-WIDTH (offset `(/ (- ,label (+ *PC* 0)) 4)) - ((#x-400000 #x3fffff) - (LONG (2 0) - ,annul - ,condition - (3 2) - (22 offset SIGNED))) - ((() ()) - ;; B??a condition, yyy - ;; JMPL xxx, $0 - ;; yyy: SETHI $1, high(offset) - ;; OR $1, $1, low(offset) - ;; JMPL $1,$0 - ;; xxx: fall through - (LONG (2 0) - (1 1) ; set anull bit, the JMPL is cancelled - ; on a taken branch - ,condition - (3 2) - (22 2 SIGNED) ; B??condition, yyy - (2 2) - (5 0) - (6 #x38) - (5 0) - (1 1) - (13 16 SIGNED) ; JMPL xxx, $0 - (2 0) - (5 1) - (3 4) - (22 (high-bits (* offset 4)) SIGNED) - ; SETHI $1, high22(offset) - (2 2) - (5 1) - (6 2) - (5 1) - (1 1) - (13 (low-bits (* offset 4)) SIGNED) - ; OR $1, $1, low10(offset) - (2 2) - (5 0) - (6 #x38) - (5 1) - (1 0) - (8 0) - (5 0) ; JMPL $1,$0 - )))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((@PCO (? offset))) + (LONG (2 0) + ,(caddr form) + ,(cadddr form) + (3 2) + (22 (quotient offset 4) SIGNED))) + (((@PCR (? label))) + (VARIABLE-WIDTH (offset `(/ (- ,label (+ *PC* 0)) 4)) + ((#x-400000 #x3fffff) + (LONG (2 0) + ,(caddr form) + ,(cadddr form) + (3 2) + (22 offset SIGNED))) + ((() ()) + ;; B??a condition, yyy + ;; JMPL xxx, $0 + ;; yyy: SETHI $1, high(offset) + ;; OR $1, $1, low(offset) + ;; JMPL $1,$0 + ;; xxx: fall through + (LONG (2 0) + (1 1) ; set anull bit, the JMPL is cancelled + ; on a taken branch + ,(cadddr form) + (3 2) + (22 2 SIGNED) ; B??condition, yyy + (2 2) + (5 0) + (6 #x38) + (5 0) + (1 1) + (13 16 SIGNED) ; JMPL xxx, $0 + (2 0) + (5 1) + (3 4) + (22 (high-bits (* offset 4)) SIGNED) + ; SETHI $1, high22(offset) + (2 2) + (5 1) + (6 2) + (5 1) + (1 1) + (13 (low-bits (* offset 4)) SIGNED) + ; OR $1, $1, low10(offset) + (2 2) + (5 0) + (6 #x38) + (5 1) + (1 0) + (8 0) + (5 0) ; JMPL $1,$0 + ))))))))) (branch ba (1 0) (4 8)) (branch bn (1 0) (4 0)) (branch bne (1 0) (4 9)) diff --git a/v7/src/compiler/machines/sparc/instr2b.scm b/v7/src/compiler/machines/sparc/instr2b.scm index a68029a65..f6049b51d 100644 --- a/v7/src/compiler/machines/sparc/instr2b.scm +++ b/v7/src/compiler/machines/sparc/instr2b.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: instr2b.scm,v 1.3 2001/12/20 21:45:25 cph Exp $ +$Id: instr2b.scm,v 1.4 2002/02/22 04:10:12 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,40 +28,42 @@ 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-fff #xfff) - (LONG (2 3) - (5 source/dest-reg) - (6 ,opcode) - (5 base-reg) - (1 1) - (13 delta SIGNED))) - ((() ()) - ;; SETHI 1, %hi(offset) - ;; OR 1, 1, %lo(offset) - ;; LD source/dest-reg,1,base-reg - (LONG (2 0) ; SETHI - (5 1) - (3 4) - (22 (high-bits delta)) - - (2 2) ; OR - (5 1) - (6 2) - (5 1) - (1 1) - (13 (low-bits delta)) + (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-fff #xfff) + (LONG (2 3) + (5 source/dest-reg) + (6 ,(caddr form)) + (5 base-reg) + (1 1) + (13 delta SIGNED))) + ((() ()) + ;; SETHI 1, %hi(offset) + ;; OR 1, 1, %lo(offset) + ;; LD source/dest-reg,1,base-reg + (LONG (2 0) ; SETHI + (5 1) + (3 4) + (22 (high-bits delta)) - (2 3) ; LD - (5 source/dest-reg) - (6 ,opcode) - (5 1) - (1 0) - (8 0) - (5 base-reg))))))))) + (2 2) ; OR + (5 1) + (6 2) + (5 1) + (1 1) + (13 (low-bits delta)) + + (2 3) ; LD + (5 source/dest-reg) + (6 ,(caddr form)) + (5 1) + (1 0) + (8 0) + (5 base-reg)))))))))) (load/store-instruction ldsb 9) (load/store-instruction ldsh 10) (load/store-instruction ldub 1) @@ -78,4 +80,4 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (load/store-instruction stf 36) (load/store-instruction ltdf 39) (load/store-instruction stfsr 37) - ) + ) \ No newline at end of file diff --git a/v7/src/compiler/machines/sparc/instr3.scm b/v7/src/compiler/machines/sparc/instr3.scm index 14d96da6a..a9a7cf119 100644 --- a/v7/src/compiler/machines/sparc/instr3.scm +++ b/v7/src/compiler/machines/sparc/instr3.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: instr3.scm,v 1.3 2001/12/20 21:45:25 cph Exp $ +$Id: instr3.scm,v 1.4 2002/02/22 04:12:12 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 @@ -26,15 +26,17 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (let-syntax ((float-instruction-3 - (lambda (keyword major minor) - `(define-instruction ,keyword - (((? destination) (? source1) (? source2)) - (LONG (2 2) - (5 destination) - (6 ,major) - (5 source1) - (9 ,minor) - (5 source2))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? destination) (? source1) (? source2)) + (LONG (2 2) + (5 destination) + (6 ,(caddr form)) + (5 source1) + (9 ,(cadddr form)) + (5 source2)))))))) (float-instruction-3 fadds 52 65) (float-instruction-3 faddd 52 66) (float-instruction-3 faddq 52 67) @@ -52,15 +54,17 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (let-syntax ((float-instruction-cmp - (lambda (keyword major minor) - `(define-instruction ,keyword - (((? source1) (? source2)) - (LONG (2 2) - (5 0) - (6 ,major) - (5 source1) - (9 ,minor) - (5 source2))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? source1) (? source2)) + (LONG (2 2) + (5 0) + (6 ,(caddr form)) + (5 source1) + (9 ,(cadddr form)) + (5 source2)))))))) (float-instruction-cmp fcmps 53 #x51) (float-instruction-cmp fcmpd 53 #x52) (float-instruction-cmp fcmpq 53 #x53) @@ -70,15 +74,17 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (let-syntax ((float-instruction-2 - (lambda (keyword major minor) - `(define-instruction ,keyword - (((? destination) (? source)) - (LONG (2 2) - (5 destination) - (6 ,major) - (5 0) - (9 ,minor) - (5 source))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? destination) (? source)) + (LONG (2 2) + (5 destination) + (6 ,(caddr form)) + (5 0) + (9 ,(cadddr form)) + (5 source)))))))) (float-instruction-2 fsqrts #x34 #x29) (float-instruction-2 fsqrtd #x34 #x2a) (float-instruction-2 fsqrtq #x34 #x2b) @@ -102,7 +108,4 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (float-instruction-2 fstod #x34 #xce) (float-instruction-2 fstod #x34 #xc7) - (float-instruction-2 fstod #x34 #xcb)) - - - \ No newline at end of file + (float-instruction-2 fstod #x34 #xcb)) \ No newline at end of file diff --git a/v7/src/compiler/machines/sparc/lapgen.scm b/v7/src/compiler/machines/sparc/lapgen.scm index 670b0efc5..5e8b30226 100644 --- a/v7/src/compiler/machines/sparc/lapgen.scm +++ b/v7/src/compiler/machines/sparc/lapgen.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: lapgen.scm,v 1.4 2001/12/20 21:45:25 cph Exp $ +$Id: lapgen.scm,v 1.5 2002/02/22 04:13:20 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 @@ -599,16 +599,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 diff --git a/v7/src/compiler/machines/sparc/rules3.scm b/v7/src/compiler/machines/sparc/rules3.scm index d58ce9fae..e5d5c1f63 100644 --- a/v7/src/compiler/machines/sparc/rules3.scm +++ b/v7/src/compiler/machines/sparc/rules3.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: rules3.scm,v 1.3 2001/12/20 21:45:25 cph Exp $ +$Id: rules3.scm,v 1.4 2002/02/22 04:15:02 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 @@ -158,18 +158,21 @@ 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 - ,(list 'LAP - (list 'UNQUOTE-SPLICING '(CLEAR-MAP!)) - (list 'UNQUOTE-SPLICING - `(INVOKE-INTERFACE - ,(symbol-append 'CODE:COMPILER- name)))))))) + (sc-macro-transformer + (lambda (form environment) + `(DEFINE-RULE STATEMENT + (INVOCATION:SPECIAL-PRIMITIVE + (? FRAME-SIZE) + (? CONTINUATION) + ,(make-primitive-procedure (cadr form) #t)) + FRAME-SIZE CONTINUATION + ,(list 'LAP + (list 'UNQUOTE-SPLICING '(CLEAR-MAP!)) + (list 'UNQUOTE-SPLICING + `(INVOKE-INTERFACE + ,(close-syntax (symbol-append 'CODE:COMPILER- + (cadr form)) + environment))))))))) (define-special-primitive-invocation &+) (define-special-primitive-invocation &-) (define-special-primitive-invocation &*) diff --git a/v7/src/compiler/machines/sparc/rulflo.scm b/v7/src/compiler/machines/sparc/rulflo.scm index e474b0185..ec41550ca 100644 --- a/v7/src/compiler/machines/sparc/rulflo.scm +++ b/v7/src/compiler/machines/sparc/rulflo.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: rulflo.scm,v 1.3 2001/12/20 21:45:25 cph Exp $ +$Id: rulflo.scm,v 1.4 2002/02/22 04:16:20 cph Exp $ -Copyright (c) 1989-1999, 2001 Massachusetts Institute of Technology +Copyright (c) 1989-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 @@ -82,10 +82,12 @@ 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/1-arg - (lambda (target source) - (LAP (,opcode ,',target ,',source))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-ARITHMETIC-METHOD ',(cadr form) FLONUM-METHODS/1-ARG + (LAMBDA (TARGET SOURCE) + (LAP (,(caddr form) ,',TARGET ,',SOURCE)))))))) (define-flonum-operation flonum-abs ABS.D) (define-flonum-operation flonum-negate NEG.D)) @@ -110,10 +112,12 @@ 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 (,opcode ,',target ,',source1 ,',source2))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-ARITHMETIC-METHOD ',(cadr form) FLONUM-METHODS/2-ARGS + (LAMBDA (TARGET SOURCE1 SOURCE2) + (LAP (,(caddr form) ,',TARGET ,',SOURCE1 ,',SOURCE2)))))))) (define-flonum-operation flonum-add ADD.D) (define-flonum-operation flonum-subtract SUB.D) (define-flonum-operation flonum-multiply MUL.D) -- 2.25.1