From a9e373a61a3c416d4a832e8fd128b89f9b709b9c Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 22 Feb 2002 03:21:43 +0000 Subject: [PATCH] Eliminate non-hygienic macros. --- v7/src/compiler/machines/bobcat/instr2.scm | 383 +++++++++++---------- 1 file changed, 197 insertions(+), 186 deletions(-) diff --git a/v7/src/compiler/machines/bobcat/instr2.scm b/v7/src/compiler/machines/bobcat/instr2.scm index 847d13457..3320f680e 100644 --- a/v7/src/compiler/machines/bobcat/instr2.scm +++ b/v7/src/compiler/machines/bobcat/instr2.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: instr2.scm,v 1.20 2001/12/20 21:45:24 cph Exp $ +$Id: instr2.scm,v 1.21 2002/02/22 03:21:43 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 @@ -39,23 +39,25 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ((UL (? expression)) (WORD (32 expression UNSIGNED)))) - + ;;;; BCD Arithmetic (let-syntax ((define-BCD-addition - (lambda (keyword opcode) - `(define-instruction ,keyword - (((D (? ry)) (D (? rx))) - (WORD (4 ,opcode) - (3 rx) - (6 #b100000) - (3 ry))) - - (((@-A (? ry)) (@-A (? rx))) - (WORD (4 ,opcode) - (3 rx) - (6 #b100001) - (3 ry))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((D (? ry)) (D (? rx))) + (WORD (4 ,(caddr form)) + (3 rx) + (6 #b100000) + (3 ry))) + + (((@-A (? ry)) (@-A (? rx))) + (WORD (4 ,(caddr form)) + (3 rx) + (6 #b100001) + (3 ry)))))))) (define-BCD-addition ABCD #b1100) (define-BCD-addition SBCD #b1000)) @@ -67,75 +69,76 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;;;; Binary Arithmetic (let-syntax ((define-binary-addition - (lambda (keyword Qkeyword Xkeyword opcode Qbit Iopcode) - `(BEGIN - (define-instruction ,Qkeyword ;ADDQ/SUBQ - ((B (& (? data)) (? ea ea-all-A)) - (WORD (4 #b0101) - (3 data QUICK) - (1 ,Qbit) - (2 #b00) - (6 ea DESTINATION-EA))) - - (((? s bwl-b) (& (? data)) (? ea ea-all)) - (WORD (4 #b0101) - (3 data QUICK) - (1 ,Qbit) - (2 s) - (6 ea DESTINATION-EA)))) - - (define-instruction ,keyword - (((? s bwl ssym) (& (? data)) (? ea ea-d&a)) ;ADDI/SUBI - (WORD (4 #b0000) - (4 ,Iopcode) - (2 s) - (6 ea DESTINATION-EA)) - (immediate-words data ssym)) - - ((B (? ea ea-all-A) (D (? rx))) - (WORD (4 ,opcode) - (3 rx) - (1 #b0) - (2 #b00) - (6 ea SOURCE-EA 'B))) - - (((? s bwl-b ssym) (? ea ea-all) (D (? rx))) - (WORD (4 ,opcode) - (3 rx) - (1 #b0) - (2 s) - (6 ea SOURCE-EA ssym))) - - (((? s bwl) (D (? rx)) (? ea ea-m&a)) - (WORD (4 ,opcode) - (3 rx) - (1 #b1) - (2 s) - (6 ea DESTINATION-EA))) - - (((? s wl ssym) (? ea ea-all) (A (? rx))) ;ADDA/SUBA - (WORD (4 ,opcode) - (3 rx) - (1 s) - (2 #b11) - (6 ea SOURCE-EA ssym)))) - - (define-instruction ,Xkeyword - (((? s bwl) (D (? ry)) (D (? rx))) - (WORD (4 ,opcode) - (3 rx) - (1 #b1) - (2 s) - (3 #b000) - (3 ry))) - - (((? s bwl) (@-A (? ry)) (@-A (? rx))) - (WORD (4 ,opcode) - (3 rx) - (1 #b1) - (2 s) - (3 #b001) - (3 ry)))))))) + (sc-macro-transformer + (lambda (keyword Qkeyword Xkeyword opcode Qbit Iopcode) + `(BEGIN + (DEFINE-INSTRUCTION ,(caddr form) ;ADDQ/SUBQ + ((B (& (? data)) (? ea ea-all-A)) + (WORD (4 #b0101) + (3 data QUICK) + (1 ,(list-ref form 5)) + (2 #b00) + (6 ea DESTINATION-EA))) + + (((? s bwl-b) (& (? data)) (? ea ea-all)) + (WORD (4 #b0101) + (3 data QUICK) + (1 ,(list-ref form 5)) + (2 s) + (6 ea DESTINATION-EA)))) + + (DEFINE-INSTRUCTION ,(cadr form) + (((? s bwl ssym) (& (? data)) (? ea ea-d&a)) ;ADDI/SUBI + (WORD (4 #b0000) + (4 ,(list-ref form 6)) + (2 s) + (6 ea DESTINATION-EA)) + (immediate-words data ssym)) + + ((B (? ea ea-all-A) (D (? rx))) + (WORD (4 ,(list-ref form 4)) + (3 rx) + (1 #b0) + (2 #b00) + (6 ea SOURCE-EA 'B))) + + (((? s bwl-b ssym) (? ea ea-all) (D (? rx))) + (WORD (4 ,(list-ref form 4)) + (3 rx) + (1 #b0) + (2 s) + (6 ea SOURCE-EA ssym))) + + (((? s bwl) (D (? rx)) (? ea ea-m&a)) + (WORD (4 ,(list-ref form 4)) + (3 rx) + (1 #b1) + (2 s) + (6 ea DESTINATION-EA))) + + (((? s wl ssym) (? ea ea-all) (A (? rx))) ;ADDA/SUBA + (WORD (4 ,(list-ref form 4)) + (3 rx) + (1 s) + (2 #b11) + (6 ea SOURCE-EA ssym)))) + + (DEFINE-INSTRUCTION ,(cadddr form) + (((? s bwl) (D (? ry)) (D (? rx))) + (WORD (4 ,(list-ref form 4)) + (3 rx) + (1 #b1) + (2 s) + (3 #b000) + (3 ry))) + + (((? s bwl) (@-A (? ry)) (@-A (? rx))) + (WORD (4 ,(list-ref form 4)) + (3 rx) + (1 #b1) + (2 s) + (3 #b001) + (3 ry))))))))) (define-binary-addition ADD ADDQ ADDX #b1101 #b0 #b0110) (define-binary-addition SUB SUBQ SUBX #b1001 #b1 #b0100)) @@ -185,36 +188,38 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; These are the 68020 versions (let-syntax ((define-mul-and-div - (lambda (keyword word-form-bit long-form-bit) - `(define-instruction ,keyword - (((? sgn us) W (? ea ea-d) (D (? n))) - (WORD (1 #b1) - (1 ,word-form-bit) - (2 #b00) - (3 n) - (1 sgn) - (2 #b11) - (6 ea SOURCE-EA 'W))) - - (((? sgn us) L (? ea ea-d) (D (? q))) - (WORD (9 #b010011000) - (1 ,long-form-bit) - (6 ea SOURCE-EA 'L)) - (EXTENSION-WORD (1 #b0) - (3 q) - (1 sgn) - (8 #b00000000) - (3 q))) - - (((? sgn us) L (? ea ea-d) (D (? r)) (D (? q))) - (WORD (9 #b010011000) - (1 ,long-form-bit) - (6 ea SOURCE-EA 'L)) - (EXTENSION-WORD (1 #b0) - (3 q) - (1 sgn) - (8 #b10000000) - (3 r))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? sgn us) W (? ea ea-d) (D (? n))) + (WORD (1 #b1) + (1 ,(caddr form)) + (2 #b00) + (3 n) + (1 sgn) + (2 #b11) + (6 ea SOURCE-EA 'W))) + + (((? sgn us) L (? ea ea-d) (D (? q))) + (WORD (9 #b010011000) + (1 ,(cadddr form)) + (6 ea SOURCE-EA 'L)) + (EXTENSION-WORD (1 #b0) + (3 q) + (1 sgn) + (8 #b00000000) + (3 q))) + + (((? sgn us) L (? ea ea-d) (D (? r)) (D (? q))) + (WORD (9 #b010011000) + (1 ,(cadddr form)) + (6 ea SOURCE-EA 'L)) + (EXTENSION-WORD (1 #b0) + (3 q) + (1 sgn) + (8 #b10000000) + (3 r)))))))) (define-mul-and-div MUL #b1 #b0) (define-mul-and-div DIV #b0 #b1)) @@ -285,35 +290,37 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;;;; Bitwise Logical (let-syntax ((define-bitwise-logical - (lambda (keyword opcode Iopcode) - `(define-instruction ,keyword - (((? s bwl ssym) (? ea ea-d) (D (? rx))) - (WORD (4 ,opcode) - (3 rx) - (1 #b0) - (2 s) - (6 ea SOURCE-EA ssym))) - - (((? s bwl) (D (? rx)) (? ea ea-m&a)) - (WORD (4 ,opcode) - (3 rx) - (1 #b1) - (2 s) - (6 ea DESTINATION-EA))) - - (((? s bwl ssym) (& (? data)) (? ea ea-d&a)) ;fooI - (WORD (4 #b0000) - (4 ,Iopcode) - (2 s) - (6 ea DESTINATION-EA)) - (immediate-unsigned-words data ssym)) - - (((? s bwl ssym) (& (? data)) (SR)) ;fooI to CCR/SR - (WORD (4 #b0000) - (4 ,Iopcode) - (2 s) - (6 #b111100)) - (immediate-unsigned-words data ssym)))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? s bwl ssym) (? ea ea-d) (D (? rx))) + (WORD (4 ,(caddr form)) + (3 rx) + (1 #b0) + (2 s) + (6 ea SOURCE-EA ssym))) + + (((? s bwl) (D (? rx)) (? ea ea-m&a)) + (WORD (4 ,(caddr form)) + (3 rx) + (1 #b1) + (2 s) + (6 ea DESTINATION-EA))) + + (((? s bwl ssym) (& (? data)) (? ea ea-d&a)) ;fooI + (WORD (4 #b0000) + (4 ,(cadddr form)) + (2 s) + (6 ea DESTINATION-EA)) + (immediate-unsigned-words data ssym)) + + (((? s bwl ssym) (& (? data)) (SR)) ;fooI to CCR/SR + (WORD (4 #b0000) + (4 ,(cadddr form)) + (2 s) + (6 #b111100)) + (immediate-unsigned-words data ssym))))))) (define-bitwise-logical AND #b1100 #b0010) ; and ANDI (define-bitwise-logical OR #b1000 #b0000)) ; and ORI @@ -346,55 +353,59 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;;;; Shift (let-syntax ((define-shift-instruction - (lambda (keyword bits) - `(define-instruction ,keyword - (((? d rl) (? s bwl) (D (? rx)) (D (? ry))) - (WORD (4 #b1110) - (3 rx) - (1 d) - (2 s) - (1 #b1) - (2 ,bits) - (3 ry))) - - (((? d rl) (? s bwl) (& (? data)) (D (? ry))) - (WORD (4 #b1110) - (3 data SHIFT-NUMBER) - (1 d) - (2 s) - (1 #b0) - (2 ,bits) - (3 ry))) - - (((? d rl) (? ea ea-m&a)) - (WORD (5 #b11100) - (2 ,bits) - (1 d) - (2 #b11) - (6 ea DESTINATION-EA))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? d rl) (? s bwl) (D (? rx)) (D (? ry))) + (WORD (4 #b1110) + (3 rx) + (1 d) + (2 s) + (1 #b1) + (2 ,(caddr form)) + (3 ry))) + + (((? d rl) (? s bwl) (& (? data)) (D (? ry))) + (WORD (4 #b1110) + (3 data SHIFT-NUMBER) + (1 d) + (2 s) + (1 #b0) + (2 ,(caddr form)) + (3 ry))) + + (((? d rl) (? ea ea-m&a)) + (WORD (5 #b11100) + (2 ,(caddr form)) + (1 d) + (2 #b11) + (6 ea DESTINATION-EA)))))))) (define-shift-instruction AS #b00) (define-shift-instruction LS #b01) (define-shift-instruction ROX #b10) (define-shift-instruction RO #b11)) - + ;;;; Bit Manipulation (let-syntax ((define-bit-manipulation - (lambda (keyword bits ea-register-target ea-immediate-target) - `(define-instruction ,keyword - (((D (? rx)) (? ea ,ea-register-target)) - (WORD (4 #b0000) - (3 rx) - (1 #b1) - (2 ,bits) - (6 ea DESTINATION-EA))) - - (((& (? bitnum)) (? ea ,ea-immediate-target)) - (WORD (8 #b00001000) - (2 ,bits) - (6 ea DESTINATION-EA)) - (immediate-byte bitnum)))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((D (? rx)) (? ea ,(cadddr form))) + (WORD (4 #b0000) + (3 rx) + (1 #b1) + (2 ,(caddr form)) + (6 ea DESTINATION-EA))) + + (((& (? bitnum)) (? ea ,(list-ref form 4))) + (WORD (8 #b00001000) + (2 ,(caddr form)) + (6 ea DESTINATION-EA)) + (immediate-byte bitnum))))))) (define-bit-manipulation BTST #b00 ea-d ea-d&-&) (define-bit-manipulation BCHG #b01 ea-d&a ea-d&a) (define-bit-manipulation BCLR #b10 ea-d&a ea-d&a) - (define-bit-manipulation BSET #b11 ea-d&a ea-d&a)) + (define-bit-manipulation BSET #b11 ea-d&a ea-d&a)) \ No newline at end of file -- 2.25.1