#| -*-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
(declare (usual-integrations))
\f
(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
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
() () () () () () () ())) ; 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
#| -*-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
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 &*)
#| -*-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
(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))
(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)
#| -*-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
(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
#| -*-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
\f
(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)
\f
(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)
(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))
#| -*-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
(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))
#| -*-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
(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)
(load/store-instruction stf 36)
(load/store-instruction ltdf 39)
(load/store-instruction stfsr 37)
- )
+ )
\ No newline at end of file
#| -*-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
\f
(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)
(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)
(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)
(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
#| -*-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
;;;; 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
#| -*-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
(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 &*)
#| -*-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
(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))
(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)
projects / mit-scheme.git / commitdiff