From b9b3885e76583c8212021a021db461564134afd9 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sat, 16 Feb 2002 03:37:50 +0000 Subject: [PATCH] Eliminate non-hygienic macros. --- v7/src/compiler/machines/spectrum/instr2.scm | 1168 +++++++++--------- v7/src/compiler/machines/vax/dsyn.scm | 101 +- v7/src/compiler/machines/vax/insmac.scm | 11 +- v7/src/compiler/machines/vax/instr1.scm | 13 +- v7/src/compiler/machines/vax/instr2.scm | 232 ++-- 5 files changed, 786 insertions(+), 739 deletions(-) diff --git a/v7/src/compiler/machines/spectrum/instr2.scm b/v7/src/compiler/machines/spectrum/instr2.scm index 8727c69c2..ad673bfe7 100644 --- a/v7/src/compiler/machines/spectrum/instr2.scm +++ b/v7/src/compiler/machines/spectrum/instr2.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: instr2.scm,v 1.10 2001/12/23 17:20:58 cph Exp $ +$Id: instr2.scm,v 1.11 2002/02/16 03:36:59 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 @@ -31,124 +31,132 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;;; The long forms of many of the following instructions use register ;;; 1 -- this may be inappropriate for assembly-language programs, but ;;; is OK for the output of the compiler. + (let-syntax ((long-load - (lambda (keyword opcode) - `(define-instruction ,keyword - ((() (OFFSET (? offset) (? space) (? base)) (? reg)) - (VARIABLE-WIDTH (disp offset) - ((#x-2000 #x1FFF) - (LONG (6 ,opcode) - (5 base) - (5 reg) - (2 space) - (14 disp RIGHT-SIGNED))) - ((() ()) - (LONG - ;; (ADDIL () L$,offset ,base) - (6 #x0A) - (5 base) - (21 (quotient disp #x800) ASSEMBLE21:X) - ;; (LDW () (OFFSET R$,offset ,space 1) ,reg) - (6 ,opcode) - (5 1) - (5 reg) - (2 space) - (14 (remainder disp #x800) RIGHT-SIGNED)))))))) - - (long-store - (lambda (keyword opcode) - `(define-instruction ,keyword - ((() (? reg) (OFFSET (? offset) (? space) (? base))) - (VARIABLE-WIDTH (disp offset) - ((#x-2000 #x1FFF) - (LONG (6 ,opcode) - (5 base) - (5 reg) - (2 space) - (14 disp RIGHT-SIGNED))) - ((() ()) - (LONG - ;; (ADDIL () L$,offset ,base) - (6 #x0A) - (5 base) - (21 (quotient disp #x800) ASSEMBLE21:X) - ;; (STW () ,reg (OFFSET R$,offset ,space 1)) - (6 ,opcode) - (5 1) - (5 reg) - (2 space) - (14 (remainder disp #x800) RIGHT-SIGNED)))))))) - - (load-offset - (lambda (keyword opcode) - `(define-instruction ,keyword - ((() (OFFSET (? offset) 0 (? base)) (? reg)) - (VARIABLE-WIDTH (disp offset) - ((#x-2000 #x1FFF) - (LONG (6 ,opcode) - (5 base) - (5 reg) - (2 #b00) - (14 disp RIGHT-SIGNED))) - ((() ()) - (LONG - ;; (ADDIL () L$,offset ,base) - (6 #x0A) - (5 base) - (21 (quotient disp #x800) ASSEMBLE21:X) - ;; (LDO () (OFFSET R$,offset 0 1) ,reg) - (6 ,opcode) - (5 1) - (5 reg) - (2 #b00) - (14 (remainder disp #x800) RIGHT-SIGNED)))))))) - - (load-immediate - (lambda (keyword opcode) - `(define-instruction ,keyword - ((() (? offset) (? reg)) - (VARIABLE-WIDTH (disp offset) - ((#x-2000 #x1FFF) - (LONG (6 ,opcode) - (5 0) - (5 reg) - (2 #b00) - (14 disp RIGHT-SIGNED))) - ((() ()) - (LONG - ;; (LDIL () L$,offset ,base) - (6 #x08) - (5 reg) - (21 (quotient disp #x800) ASSEMBLE21:X) - ;; (LDO () (OFFSET R$,offset 0 ,reg) ,reg) - (6 ,opcode) - (5 reg) - (5 reg) - (2 #b00) - (14 (remainder disp #x800) RIGHT-SIGNED)))))))) - - (left-immediate - (lambda (keyword opcode) - `(define-instruction ,keyword - ((() (? immed-21) (? reg)) - (LONG (6 ,opcode) - (5 reg) - (21 immed-21 ASSEMBLE21:X))))))) - - (long-load LDW #x12) - (long-load LDWM #x13) - (long-load LDH #x11) - (long-load LDB #x10) - - (long-store STW #x1a) - (long-store STWM #x1b) - (long-store STH #x19) - (long-store STB #x18) - - (load-offset LDO #x0d) - (load-immediate LDI #x0d) ; pseudo-op (LDO complt (OFFSET displ 0) reg) - - (left-immediate LDIL #x08) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + ((() (OFFSET (? offset) (? space) (? base)) (? reg)) + (VARIABLE-WIDTH (disp offset) + ((#x-2000 #x1FFF) + (LONG (6 ,(caddr form)) + (5 base) + (5 reg) + (2 space) + (14 disp RIGHT-SIGNED))) + ((() ()) + (LONG + ;; (ADDIL () L$,offset ,base) + (6 #x0A) + (5 base) + (21 (quotient disp #x800) ASSEMBLE21:X) + ;; (LDW () (OFFSET R$,offset ,space 1) ,reg) + (6 ,(caddr form)) + (5 1) + (5 reg) + (2 space) + (14 (remainder disp #x800) RIGHT-SIGNED)))))))))) + (long-load LDW #x12) + (long-load LDWM #x13) + (long-load LDH #x11) + (long-load LDB #x10)) + +(let-syntax ((long-store + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + ((() (? reg) (OFFSET (? offset) (? space) (? base))) + (VARIABLE-WIDTH (disp offset) + ((#x-2000 #x1FFF) + (LONG (6 ,(caddr form)) + (5 base) + (5 reg) + (2 space) + (14 disp RIGHT-SIGNED))) + ((() ()) + (LONG + ;; (ADDIL () L$,offset ,base) + (6 #x0A) + (5 base) + (21 (quotient disp #x800) ASSEMBLE21:X) + ;; (STW () ,reg (OFFSET R$,offset ,space 1)) + (6 ,(caddr form)) + (5 1) + (5 reg) + (2 space) + (14 (remainder disp #x800) RIGHT-SIGNED)))))))))) + (long-store STW #x1a) + (long-store STWM #x1b) + (long-store STH #x19) + (long-store STB #x18)) + +(let-syntax ((load-offset + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + ((() (OFFSET (? offset) 0 (? base)) (? reg)) + (VARIABLE-WIDTH (disp offset) + ((#x-2000 #x1FFF) + (LONG (6 ,(caddr form)) + (5 base) + (5 reg) + (2 #b00) + (14 disp RIGHT-SIGNED))) + ((() ()) + (LONG + ;; (ADDIL () L$,offset ,base) + (6 #x0A) + (5 base) + (21 (quotient disp #x800) ASSEMBLE21:X) + ;; (LDO () (OFFSET R$,offset 0 1) ,reg) + (6 ,(caddr form)) + (5 1) + (5 reg) + (2 #b00) + (14 (remainder disp #x800) RIGHT-SIGNED)))))))))) + (load-offset LDO #x0d)) + +(let-syntax ((load-immediate + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + ((() (? offset) (? reg)) + (VARIABLE-WIDTH (disp offset) + ((#x-2000 #x1FFF) + (LONG (6 ,(caddr form)) + (5 0) + (5 reg) + (2 #b00) + (14 disp RIGHT-SIGNED))) + ((() ()) + (LONG + ;; (LDIL () L$,offset ,base) + (6 #x08) + (5 reg) + (21 (quotient disp #x800) ASSEMBLE21:X) + ;; (LDO () (OFFSET R$,offset 0 ,reg) ,reg) + (6 ,(caddr form)) + (5 reg) + (5 reg) + (2 #b00) + (14 (remainder disp #x800) RIGHT-SIGNED)))))))))) + ;; pseudo-op (LDO complt (OFFSET displ 0) reg) + (load-immediate LDI #x0d)) + +(let-syntax ((left-immediate + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + ((() (? immed-21) (? reg)) + (LONG (6 ,(caddr form)) + (5 reg) + (21 immed-21 ASSEMBLE21:X)))))))) + (left-immediate LDIL #x08) (left-immediate ADDIL #x0a)) ;; In the following, the middle completer field (2 bits) appears to be zero, @@ -156,157 +164,167 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; cache instructions. (let-syntax ((indexed-load - (lambda (keyword opcode extn) - `(define-instruction ,keyword - (((? compl complx) (INDEX (? index-reg) (? space) (? base)) - (? reg)) - (LONG (6 ,opcode) - (5 base) - (5 index-reg) - (2 space) - (1 (vector-ref compl 0)) - (1 #b0) - (2 (vector-ref compl 1)) - (4 ,extn) - (1 (vector-ref compl 2)) - (5 reg)))))) - - (indexed-store - (lambda (keyword opcode extn) - `(define-instruction ,keyword - (((? compl complx) (? reg) - (INDEX (? index-reg) (? space) (? base))) - (LONG (6 ,opcode) - (5 base) - (5 index-reg) - (2 space) - (1 (vector-ref compl 0)) - (1 #b0) - (2 (vector-ref compl 1)) - (4 ,extn) - (1 (vector-ref compl 2)) - (5 reg)))))) - - (indexed-d-cache - (lambda (keyword extn) - `(define-instruction ,keyword - (((? compl m-val) (INDEX (? index-reg) (? space) (? base))) - (LONG (6 #x01) - (5 base) - (5 index-reg) - (2 space) - (8 ,extn) - (1 compl) - (5 #x0)))))) - - (indexed-i-cache - (lambda (keyword extn) - `(define-instruction ,keyword - (((? compl m-val) - (INDEX (? index-reg) (? space sr3) (? base))) - (LONG (6 #x01) - (5 base) - (5 index-reg) - (3 space) - (7 ,extn) - (1 compl) - (5 #x0))))))) - - (indexed-load LDWX #x03 #x2) - (indexed-load LDHX #x03 #x1) - (indexed-load LDBX #x03 #x0) - (indexed-load LDCWX #x03 #x7) - (indexed-load FLDWX #x09 #x0) - (indexed-load FLDDX #x0B #x0) - + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? compl complx) (INDEX (? index-reg) (? space) (? base)) + (? reg)) + (LONG (6 ,(caddr form)) + (5 base) + (5 index-reg) + (2 space) + (1 (vector-ref compl 0)) + (1 #b0) + (2 (vector-ref compl 1)) + (4 ,(cadddr form)) + (1 (vector-ref compl 2)) + (5 reg)))))))) + (indexed-load LDWX #x03 #x2) + (indexed-load LDHX #x03 #x1) + (indexed-load LDBX #x03 #x0) + (indexed-load LDCWX #x03 #x7) + (indexed-load FLDWX #x09 #x0) + (indexed-load FLDDX #x0B #x0)) + +(let-syntax ((indexed-store + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? compl complx) (? reg) + (INDEX (? index-reg) (? space) + (? base))) + (LONG (6 ,(caddr form)) + (5 base) + (5 index-reg) + (2 space) + (1 (vector-ref compl 0)) + (1 #b0) + (2 (vector-ref compl 1)) + (4 ,(cadddr form)) + (1 (vector-ref compl 2)) + (5 reg)))))))) (indexed-store FSTWX #x09 #x8) - (indexed-store FSTDX #x0b #x8) - - (indexed-d-cache PDC #x4e) - (indexed-d-cache FDC #x4a) - (indexed-i-cache FIC #x0a) - (indexed-d-cache FDCE #x4b) - (indexed-i-cache FICE #x0b)) + (indexed-store FSTDX #x0b #x8)) +(let-syntax ((indexed-d-cache + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? compl m-val) (INDEX (? index-reg) (? space) (? base))) + (LONG (6 #x01) + (5 base) + (5 index-reg) + (2 space) + (8 ,(caddr form)) + (1 compl) + (5 #x0)))))))) + (indexed-d-cache PDC #x4e) + (indexed-d-cache FDC #x4a) + (indexed-d-cache FDCE #x4b)) + +(let-syntax ((indexed-i-cache + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? compl m-val) + (INDEX (? index-reg) (? space sr3) (? base))) + (LONG (6 #x01) + (5 base) + (5 index-reg) + (3 space) + (7 ,(caddr form)) + (1 compl) + (5 #x0)))))))) + (indexed-i-cache FIC #x0a) + (indexed-i-cache FICE #x0b)) + (let-syntax ((scalr-short-load - (lambda (keyword extn) - `(define-instruction ,keyword - (((? compl compls) (OFFSET (? offset) (? space) (? base)) - (? reg)) - (LONG (6 #x03) - (5 base) - (5 offset RIGHT-SIGNED) - (2 space) - (1 (vector-ref compl 0)) - (1 #b1) - (2 (vector-ref compl 1)) - (4 ,extn) - (1 (vector-ref compl 2)) - (5 reg)))))) - - (scalr-short-store - (lambda (keyword extn) - `(define-instruction ,keyword - (((? compl compls) (? reg) - (OFFSET (? offset) (? space) (? base))) - (LONG (6 #x03) - (5 base) - (5 reg) - (2 space) - (1 (vector-ref compl 0)) - (1 #b1) - (2 (vector-ref compl 1)) - (4 ,extn) - (1 (vector-ref compl 2)) - (5 offset RIGHT-SIGNED)))))) - - (float-short-load - (lambda (keyword opcode extn) - `(define-instruction ,keyword - (((? compl compls) (OFFSET (? offset) (? space) (? base)) - (? reg)) - (LONG (6 ,opcode) - (5 base) - (5 offset RIGHT-SIGNED) - (2 space) - (1 (vector-ref compl 0)) - (1 #b1) - (2 (vector-ref compl 1)) - (4 ,extn) - (1 (vector-ref compl 2)) - (5 reg)))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? compl compls) (OFFSET (? offset) (? space) (? base)) + (? reg)) + (LONG (6 #x03) + (5 base) + (5 offset RIGHT-SIGNED) + (2 space) + (1 (vector-ref compl 0)) + (1 #b1) + (2 (vector-ref compl 1)) + (4 ,(caddr form)) + (1 (vector-ref compl 2)) + (5 reg)))))))) + (scalr-short-load LDWS #x02) + (scalr-short-load LDHS #x01) + (scalr-short-load LDBS #x00) + (scalr-short-load LDCWS #x07)) + +(let-syntax ((scalr-short-store + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? compl compls) (? reg) + (OFFSET (? offset) (? space) (? base))) + (LONG (6 #x03) + (5 base) + (5 reg) + (2 space) + (1 (vector-ref compl 0)) + (1 #b1) + (2 (vector-ref compl 1)) + (4 ,(caddr form)) + (1 (vector-ref compl 2)) + (5 offset RIGHT-SIGNED)))))))) + (scalr-short-store STWS #x0a) + (scalr-short-store STHS #x09) + (scalr-short-store STBS #x08) + (scalr-short-store STBYS #x0c)) - (float-short-store - (lambda (keyword opcode extn) - `(define-instruction ,keyword - (((? compl compls) (? reg) - (OFFSET (? offset) (? space) (? base))) - (LONG (6 ,opcode) - (5 base) - (5 offset RIGHT-SIGNED) - (2 space) - (1 (vector-ref compl 0)) - (1 #b1) - (2 (vector-ref compl 1)) - (4 ,extn) - (1 (vector-ref compl 2)) - (5 reg))))))) - - (scalr-short-load LDWS #x02) - (scalr-short-load LDHS #x01) - (scalr-short-load LDBS #x00) - (scalr-short-load LDCWS #x07) - - (scalr-short-store STWS #x0a) - (scalr-short-store STHS #x09) - (scalr-short-store STBS #x08) - (scalr-short-store STBYS #x0c) - - (float-short-load FLDWS #x09 #x00) - (float-short-load FLDDS #x0b #x00) - - (float-short-store FSTWS #x09 #x08) - (float-short-store FSTDS #x0b #x08)) +(let-syntax ((float-short-load + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? compl compls) (OFFSET (? offset) (? space) (? base)) + (? reg)) + (LONG (6 ,(caddr form)) + (5 base) + (5 offset RIGHT-SIGNED) + (2 space) + (1 (vector-ref compl 0)) + (1 #b1) + (2 (vector-ref compl 1)) + (4 ,(cadddr form)) + (1 (vector-ref compl 2)) + (5 reg)))))))) + (float-short-load FLDWS #x09 #x00) + (float-short-load FLDDS #x0b #x00)) + +(let-syntax ((float-short-store + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + (((? compl compls) (? reg) + (OFFSET (? offset) (? space) (? base))) + (LONG (6 ,(caddr form)) + (5 base) + (5 offset RIGHT-SIGNED) + (2 space) + (1 (vector-ref compl 0)) + (1 #b1) + (2 (vector-ref compl 1)) + (4 ,(cadddr form)) + (1 (vector-ref compl 2)) + (5 reg)))))))) + (float-short-store FSTWS #x09 #x08) + (float-short-store FSTDS #x0b #x08)) ;;;; Control transfer instructions @@ -315,131 +333,139 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;;; They should be eventually (by using an LDIL,LDI,BLR sequence, for example). (let-syntax ((branch&link - (lambda (keyword extn) - `(define-instruction ,keyword - ((() (? reg) (@PCR (? label))) - (LONG (6 #x3a) - (5 reg) - (5 label PC-REL ASSEMBLE17:X) - (3 ,extn) - (11 label PC-REL ASSEMBLE17:Y) - (1 0) - (1 label PC-REL ASSEMBLE17:Z))) - - (((N) (? reg) (@PCR (? label))) - (LONG (6 #x3a) - (5 reg) - (5 label PC-REL ASSEMBLE17:X) - (3 ,extn) - (11 label PC-REL ASSEMBLE17:Y) - (1 1) - (1 label PC-REL ASSEMBLE17:Z))) - - ((() (? reg) (@PCO (? offset))) - (LONG (6 #x3a) - (5 reg) - (5 offset ASSEMBLE17:X) - (3 ,extn) - (11 offset ASSEMBLE17:Y) - (1 0) - (1 offset ASSEMBLE17:Z))) - - (((N) (? reg) (@PCO (? offset))) - (LONG (6 #x3a) - (5 reg) - (5 offset ASSEMBLE17:X) - (3 ,extn) - (11 offset ASSEMBLE17:Y) - (1 1) - (1 offset ASSEMBLE17:Z)))))) - - (branch - (lambda (keyword extn) - `(define-instruction ,keyword - ((() (@PCR (? l))) - (LONG (6 #x3a) - (5 #b00000) - (5 l PC-REL ASSEMBLE17:X) - (3 #b000) - (11 l PC-REL ASSEMBLE17:Y) - (1 0) - (1 l PC-REL ASSEMBLE17:Z))) - - (((N) (@PCR (? l))) - (LONG (6 #x3a) - (5 #b00000) - (5 l PC-REL ASSEMBLE17:X) - (3 #b000) - (11 l PC-REL ASSEMBLE17:Y) - (1 1) - (1 l PC-REL ASSEMBLE17:Z))) - - ((() (@PCO (? offset))) - (LONG (6 #x3a) - (5 #b00000) - (5 offset ASSEMBLE17:X) - (3 #b000) - (11 offset ASSEMBLE17:Y) - (1 0) - (1 offset ASSEMBLE17:Z))) - - (((N) (@PCO (? offset))) - (LONG (6 #x3a) - (5 #b00000) - (5 offset ASSEMBLE17:X) - (3 #b000) - (11 offset ASSEMBLE17:Y) - (1 1) - (1 offset ASSEMBLE17:Z))))))) - - (branch B 0) ; pseudo-op (BL complt 0 displ) - (branch&link BL 0) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + ((() (? reg) (@PCR (? label))) + (LONG (6 #x3a) + (5 reg) + (5 label PC-REL ASSEMBLE17:X) + (3 ,(caddr form)) + (11 label PC-REL ASSEMBLE17:Y) + (1 0) + (1 label PC-REL ASSEMBLE17:Z))) + + (((N) (? reg) (@PCR (? label))) + (LONG (6 #x3a) + (5 reg) + (5 label PC-REL ASSEMBLE17:X) + (3 ,(caddr form)) + (11 label PC-REL ASSEMBLE17:Y) + (1 1) + (1 label PC-REL ASSEMBLE17:Z))) + + ((() (? reg) (@PCO (? offset))) + (LONG (6 #x3a) + (5 reg) + (5 offset ASSEMBLE17:X) + (3 ,(caddr form)) + (11 offset ASSEMBLE17:Y) + (1 0) + (1 offset ASSEMBLE17:Z))) + + (((N) (? reg) (@PCO (? offset))) + (LONG (6 #x3a) + (5 reg) + (5 offset ASSEMBLE17:X) + (3 ,(caddr form)) + (11 offset ASSEMBLE17:Y) + (1 1) + (1 offset ASSEMBLE17:Z)))))))) + (branch&link BL 0) (branch&link GATE 1)) +(let-syntax ((branch + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + ((() (@PCR (? l))) + (LONG (6 #x3a) + (5 #b00000) + (5 l PC-REL ASSEMBLE17:X) + (3 #b000) + (11 l PC-REL ASSEMBLE17:Y) + (1 0) + (1 l PC-REL ASSEMBLE17:Z))) + + (((N) (@PCR (? l))) + (LONG (6 #x3a) + (5 #b00000) + (5 l PC-REL ASSEMBLE17:X) + (3 #b000) + (11 l PC-REL ASSEMBLE17:Y) + (1 1) + (1 l PC-REL ASSEMBLE17:Z))) + + ((() (@PCO (? offset))) + (LONG (6 #x3a) + (5 #b00000) + (5 offset ASSEMBLE17:X) + (3 #b000) + (11 offset ASSEMBLE17:Y) + (1 0) + (1 offset ASSEMBLE17:Z))) + + (((N) (@PCO (? offset))) + (LONG (6 #x3a) + (5 #b00000) + (5 offset ASSEMBLE17:X) + (3 #b000) + (11 offset ASSEMBLE17:Y) + (1 1) + (1 offset ASSEMBLE17:Z)))))))) + ;; pseudo-op (BL complt 0 displ) + (branch B 0)) + (let-syntax ((BV&BLR - (lambda (keyword extn) - `(define-instruction ,keyword - ((() (? offset-reg) (? reg)) - (LONG (6 #x3a) - (5 reg) - (5 offset-reg) - (3 ,extn) - (11 #b00000000000) - (1 0) - (1 #b0))) - - (((N) (? offset-reg) (? reg)) - (LONG (6 #x3a) - (5 reg) - (5 offset-reg) - (3 ,extn) - (11 #b00000000000) - (1 1) - (1 #b0)))))) - - (BE&BLE - (lambda (keyword opcode) - `(define-instruction ,keyword - ((() (OFFSET (? offset) (? space sr3) (? base))) - (LONG (6 ,opcode) - (5 base) - (5 offset ASSEMBLE17:X) - (3 space) - (11 offset ASSEMBLE17:Y) - (1 0) - (1 offset ASSEMBLE17:Z))) - - (((N) (OFFSET (? offset) (? space sr3) (? base))) - (LONG (6 ,opcode) - (5 base) - (5 offset ASSEMBLE17:X) - (3 space) - (11 offset ASSEMBLE17:Y) - (1 1) - (1 offset ASSEMBLE17:Z))))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + ((() (? offset-reg) (? reg)) + (LONG (6 #x3a) + (5 reg) + (5 offset-reg) + (3 ,(caddr form)) + (11 #b00000000000) + (1 0) + (1 #b0))) + + (((N) (? offset-reg) (? reg)) + (LONG (6 #x3a) + (5 reg) + (5 offset-reg) + (3 ,(caddr form)) + (11 #b00000000000) + (1 1) + (1 #b0)))))))) (BV&BLR BLR 2) - (BV&BLR BV 6) - (BE&BLE BE #x38) + (BV&BLR BV 6)) + +(let-syntax ((BE&BLE + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + ((() (OFFSET (? offset) (? space sr3) (? base))) + (LONG (6 ,(caddr form)) + (5 base) + (5 offset ASSEMBLE17:X) + (3 space) + (11 offset ASSEMBLE17:Y) + (1 0) + (1 offset ASSEMBLE17:Z))) + + (((N) (OFFSET (? offset) (? space sr3) (? base))) + (LONG (6 ,(caddr form)) + (5 base) + (5 offset ASSEMBLE17:X) + (3 space) + (11 offset ASSEMBLE17:Y) + (1 1) + (1 offset ASSEMBLE17:Z)))))))) + (BE&BLE BE #x38) (BE&BLE BLE #x39)) ;;;; Conditional branch instructions @@ -494,74 +520,77 @@ branch-extend-nullify in instr1. (let-syntax ((defccbranch - (lambda (keyword completer opcode1 opcode2 opr1) - `(define-instruction ,keyword - (((? compl ,completer) (? ,(car opr1)) (? reg-2) (@PCO (? offset))) - (LONG (6 ,opcode1) - (5 reg-2) - (5 ,@opr1) - (3 (cadr compl)) - (11 offset ASSEMBLE12:X) - (1 (car compl)) - (1 offset ASSEMBLE12:Y))) - - (((? compl ,completer) (? ,(car opr1)) (? reg-2) (@PCR (? l))) - (VARIABLE-WIDTH - (disp `(- ,l (+ *PC* 8))) - ((#x-2000 #x1FFF) - (LONG (6 ,opcode1) - (5 reg-2) - (5 ,@opr1) - (3 (cadr compl)) - (11 disp ASSEMBLE12:X) - (1 (car compl)) - (1 disp ASSEMBLE12:Y))) - - ((() ()) - ;; See page comment above. - (LONG (6 ,opcode2) ; COMBF - (5 reg-2) - (5 ,@opr1) - (3 (cadr compl)) - (11 (branch-extend-pco disp (car compl)) ASSEMBLE12:X) - (1 1) - (1 (branch-extend-pco disp (car compl)) ASSEMBLE12:Y) - - (6 #x3a) ; B - (5 0) - (5 (branch-extend-disp disp) ASSEMBLE17:X) - (3 0) - (11 (branch-extend-disp disp) ASSEMBLE17:Y) - (1 (branch-extend-nullify disp (car compl))) - (1 (branch-extend-disp disp) ASSEMBLE17:Z))))))))) - - (define-syntax defcond - (non-hygienic-macro-transformer - (lambda (name opcode1 opcode2 opr1) - `(defccbranch ,name complaltfb ,opcode1 ,opcode2 ,opr1)))) - - (define-syntax defpseudo - (non-hygienic-macro-transformer - (lambda (name opcode opr1) - `(defccbranch ,name complalb - (TF-adjust ,opcode (cdr compl)) - (TF-adjust-inverted ,opcode (cdr compl)) - ,opr1)))) - - (defcond COMBT #x20 #x22 (reg-1)) - (defcond COMBF #x22 #x20 (reg-1)) - (defcond ADDBT #x28 #x2a (reg-1)) - (defcond ADDBF #x2a #x28 (reg-1)) - - (defcond COMIBT #X21 #x23 (immed-5 right-signed)) - (defcond COMIBF #X23 #x21 (immed-5 right-signed)) - (defcond ADDIBT #X29 #x2b (immed-5 right-signed)) - (defcond ADDIBF #X2b #x29 (immed-5 right-signed)) - - (defpseudo COMB #X20 (reg-1)) - (defpseudo ADDB #X28 (reg-1)) - (defpseudo COMIB #X21 (immed-5 right-signed)) - (defpseudo ADDIB #x29 (immed-5 right-signed))) + (sc-macro-transformer + (lambda (form environment) + environment + (let ((completer (list-ref form 2)) + (opcode1 (list-ref form 3)) + (opcode2 (list-ref form 4)) + (opr1 (list-ref form 5))) + `(DEFINE-INSTRUCTION ,(cadr form) + (((? compl ,completer) (? ,(car opr1)) (? reg-2) + (@PCO (? offset))) + (LONG (6 ,opcode1) + (5 reg-2) + (5 ,@opr1) + (3 (cadr compl)) + (11 offset ASSEMBLE12:X) + (1 (car compl)) + (1 offset ASSEMBLE12:Y))) + (((? compl ,completer) (? ,(car opr1)) (? reg-2) (@PCR (? l))) + (VARIABLE-WIDTH + (disp `(- ,l (+ *PC* 8))) + ((#x-2000 #x1FFF) + (LONG (6 ,opcode1) + (5 reg-2) + (5 ,@opr1) + (3 (cadr compl)) + (11 disp ASSEMBLE12:X) + (1 (car compl)) + (1 disp ASSEMBLE12:Y))) + ((() ()) + ;; See page comment above. + (LONG (6 ,opcode2) ; COMBF + (5 reg-2) + (5 ,@opr1) + (3 (cadr compl)) + (11 (branch-extend-pco disp (car compl)) ASSEMBLE12:X) + (1 1) + (1 (branch-extend-pco disp (car compl)) ASSEMBLE12:Y) + (6 #x3a) ; B + (5 0) + (5 (branch-extend-disp disp) ASSEMBLE17:X) + (3 0) + (11 (branch-extend-disp disp) ASSEMBLE17:Y) + (1 (branch-extend-nullify disp (car compl))) + (1 (branch-extend-disp disp) ASSEMBLE17:Z))))))))))) + (let-syntax + ((defcond + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFCCBRANCH ,(cadr form) COMPLALTFB ,@(cddr form)))))) + (defcond COMBT #x20 #x22 (reg-1)) + (defcond COMBF #x22 #x20 (reg-1)) + (defcond ADDBT #x28 #x2a (reg-1)) + (defcond ADDBF #x2a #x28 (reg-1)) + (defcond COMIBT #x21 #x23 (immed-5 right-signed)) + (defcond COMIBF #x23 #x21 (immed-5 right-signed)) + (defcond ADDIBT #x29 #x2b (immed-5 right-signed)) + (defcond ADDIBF #x2b #x29 (immed-5 right-signed))) + (let-syntax + ((defpseudo + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFCCBRANCH ,(cadr form) COMPLALB + (TF-ADJUST ,(caddr form) (CDR COMPL)) + (TF-ADJUST-INVERTED ,(caddr form) (CDR COMPL)) + ,(cadddr form)))))) + (defpseudo COMB #x20 (reg-1)) + (defpseudo ADDB #x28 (reg-1)) + (defpseudo COMIB #x21 (immed-5 right-signed)) + (defpseudo ADDIB #x29 (immed-5 right-signed)))) ;;;; Pseudo branch instructions. @@ -598,125 +627,126 @@ Note: Only those currently used by the code generator are implemented. (let-syntax ((defccbranch - (lambda (keyword completer opcode1 opcode2 opr1) - `(define-instruction ,keyword - ;; No @PCO form. - ;; This is a pseudo-instruction used by the code-generator - (((? compl ,completer) (? ,(car opr1)) (? reg-2) (@PCR (? l))) - (VARIABLE-WIDTH - (disp `(- ,l (+ *PC* 8))) - ((0 #x1FFF) - ;; Forward branch. Nullify. - (LONG (6 ,opcode1) ; COMB,cc,n - (5 reg-2) - (5 ,@opr1) - (3 (car compl)) - (11 disp ASSEMBLE12:X) - (1 1) - (1 disp ASSEMBLE12:Y))) - - ((#x-2000 -1) - ;; Backward branch. No nullification, insert NOP. - (LONG (6 ,opcode1) ; COMB,cc - (5 reg-2) - (5 ,@opr1) - (3 (car compl)) - (11 disp ASSEMBLE12:X) - (1 0) - (1 disp ASSEMBLE12:Y) - - (6 #x02) ; NOP (OR 0 0 0) - (10 #b0000000000) - (3 0) - (1 0) - (7 #x12) - (5 #b00000))) - - ((() ()) - (LONG (6 ,opcode2) ; COMB!,n - (5 reg-2) - (5 ,@opr1) - (3 (car compl)) - (11 0 ASSEMBLE12:X) - (1 1) - (1 0 ASSEMBLE12:Y) - - (6 #x3a) ; B,n - (5 0) - (5 (branch-extend-disp disp) ASSEMBLE17:X) - (3 0) - (11 (branch-extend-disp disp) ASSEMBLE17:Y) - (1 1) - (1 (branch-extend-disp disp) ASSEMBLE17:Z))))))))) - - (define-syntax defcond - (non-hygienic-macro-transformer - (lambda (name opcode1 opcode2 opr1) - `(defccbranch ,name complaltf ,opcode1 ,opcode2 ,opr1)))) - - (define-syntax defpseudo - (non-hygienic-macro-transformer - (lambda (name opcode opr1) - `(defccbranch ,name complal - (TF-adjust ,opcode compl) - (TF-adjust-inverted ,opcode compl) - ,opr1)))) - - (defcond COMIBTN #X21 #x23 (immed-5 right-signed)) - (defcond COMIBFN #X23 #x21 (immed-5 right-signed)) - - (defpseudo COMBN #X20 (reg-1))) + (sc-macro-transformer + (lambda (form environment) + environment + (let ((completer (list-ref form 2)) + (opcode1 (list-ref form 3)) + (opcode2 (list-ref form 4)) + (opr1 (list-ref form 5))) + `(DEFINE-INSTRUCTION ,(cadr form) + ;; No @PCO form. + ;; This is a pseudo-instruction used by the code-generator + (((? compl ,completer) (? ,(car opr1)) (? reg-2) (@PCR (? l))) + (VARIABLE-WIDTH + (disp `(- ,l (+ *PC* 8))) + ((0 #x1FFF) + ;; Forward branch. Nullify. + (LONG (6 ,opcode1) ; COMB,cc,n + (5 reg-2) + (5 ,@opr1) + (3 (car compl)) + (11 disp ASSEMBLE12:X) + (1 1) + (1 disp ASSEMBLE12:Y))) + ((#x-2000 -1) + ;; Backward branch. No nullification, insert NOP. + (LONG (6 ,opcode1) ; COMB,cc + (5 reg-2) + (5 ,@opr1) + (3 (car compl)) + (11 disp ASSEMBLE12:X) + (1 0) + (1 disp ASSEMBLE12:Y) + (6 #x02) ; NOP (OR 0 0 0) + (10 #b0000000000) + (3 0) + (1 0) + (7 #x12) + (5 #b00000))) + ((() ()) + (LONG (6 ,opcode2) ; COMB!,n + (5 reg-2) + (5 ,@opr1) + (3 (car compl)) + (11 0 ASSEMBLE12:X) + (1 1) + (1 0 ASSEMBLE12:Y) + (6 #x3a) ; B,n + (5 0) + (5 (branch-extend-disp disp) ASSEMBLE17:X) + (3 0) + (11 (branch-extend-disp disp) ASSEMBLE17:Y) + (1 1) + (1 (branch-extend-disp disp) ASSEMBLE17:Z))))))))))) + (let-syntax ((defcond + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFCCBRANCH ,(cadr form) COMPLALTF ,@(cddr form)))))) + (defcond COMIBTN #x21 #x23 (immed-5 right-signed)) + (defcond COMIBFN #x23 #x21 (immed-5 right-signed))) + (let-syntax ((defpseudo + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFCCBRANCH ,(cadr form) COMPLAL + (TF-adjust ,(caddr form) COMPL) + (TF-ADJUST-INVERTED ,(caddr form) COMPL) + ,(cadddr form)))))) + (defpseudo COMBN #x20 (reg-1)))) ;;;; Miscellaneous control (let-syntax ((defmovb&bb - (lambda (name opcode opr1 opr2 field2) - `(define-instruction ,name - (((? compl compledb) (? ,(car opr1)) ,@opr2 (@PCO (? offset))) - (LONG (6 ,opcode) - (5 ,field2) - (5 ,@opr1) - (3 (cdr compl)) - (11 offset ASSEMBLE12:X) - (1 (car compl)) - (1 offset ASSEMBLE12:Y))) - - (((? compl compledb) (? ,(car opr1)) ,@opr2 (@PCR (? l))) - (VARIABLE-WIDTH - (disp `(- ,l (+ *PC* 8))) - ((#x-2000 #x1FFF) - (LONG (6 ,opcode) - (5 ,field2) - (5 ,@opr1) - (3 (cdr compl)) - (11 l PC-REL ASSEMBLE12:X) - (1 (car compl)) - (1 l PC-REL ASSEMBLE12:Y))) - - ((() ()) - ;; See page comment above. - (LONG (6 ,opcode) ; MOVB - (5 ,field2) - (5 ,@opr1) - (3 (branch-extend-edcc (cdr compl))) - (11 (branch-extend-pco disp (car compl)) ASSEMBLE12:X) - (1 1) - (1 (branch-extend-pco disp (car compl)) ASSEMBLE12:Y) - - (6 #x3a) ; B - (5 0) - (5 (branch-extend-disp disp) ASSEMBLE17:X) - (3 0) - (11 (branch-extend-disp disp) ASSEMBLE17:Y) - (1 (branch-extend-nullify disp (car compl))) - (1 (branch-extend-disp disp) ASSEMBLE17:Z))))))))) - - - (defmovb&bb BVB #x30 (reg) () #b00000) - (defmovb&bb BB #x31 (reg) ((? pos)) pos) - (defmovb&bb MOVB #x32 (reg-1) ((? reg-2)) reg-2) - (defmovb&bb MOVIB #x33 (immed-5 right-signed) ((? reg-2)) reg-2)) + (sc-macro-transformer + (lambda (form environment) + environment + (let ((opcode (list-ref form 2)) + (opr1 (list-ref form 3)) + (opr2 (list-ref form 4)) + (field2 (list-ref form 5))) + `(DEFINE-INSTRUCTION ,(cadr form) + (((? compl compledb) (? ,(car opr1)) ,@opr2 (@PCO (? offset))) + (LONG (6 ,opcode) + (5 ,field2) + (5 ,@opr1) + (3 (cdr compl)) + (11 offset ASSEMBLE12:X) + (1 (car compl)) + (1 offset ASSEMBLE12:Y))) + (((? compl compledb) (? ,(car opr1)) ,@opr2 (@PCR (? l))) + (VARIABLE-WIDTH + (disp `(- ,l (+ *PC* 8))) + ((#x-2000 #x1FFF) + (LONG (6 ,opcode) + (5 ,field2) + (5 ,@opr1) + (3 (cdr compl)) + (11 l PC-REL ASSEMBLE12:X) + (1 (car compl)) + (1 l PC-REL ASSEMBLE12:Y))) + ((() ()) + ;; See page comment above. + (LONG (6 ,opcode) ; MOVB + (5 ,field2) + (5 ,@opr1) + (3 (branch-extend-edcc (cdr compl))) + (11 (branch-extend-pco disp (car compl)) ASSEMBLE12:X) + (1 1) + (1 (branch-extend-pco disp (car compl)) ASSEMBLE12:Y) + (6 #x3a) ; B + (5 0) + (5 (branch-extend-disp disp) ASSEMBLE17:X) + (3 0) + (11 (branch-extend-disp disp) ASSEMBLE17:Y) + (1 (branch-extend-nullify disp (car compl))) + (1 (branch-extend-disp disp) ASSEMBLE17:Z))))))))))) + (defmovb&bb BVB #x30 (reg) () #b00000) + (defmovb&bb BB #x31 (reg) ((? pos)) pos) + (defmovb&bb MOVB #x32 (reg-1) ((? reg-2)) reg-2) + (defmovb&bb MOVIB #x33 (immed-5 right-signed) ((? reg-2)) reg-2)) ;;;; Assembler pseudo-ops diff --git a/v7/src/compiler/machines/vax/dsyn.scm b/v7/src/compiler/machines/vax/dsyn.scm index 13acadc20..7a16f21ec 100644 --- a/v7/src/compiler/machines/vax/dsyn.scm +++ b/v7/src/compiler/machines/vax/dsyn.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: dsyn.scm,v 1.11 2001/12/23 17:20:58 cph Exp $ +$Id: dsyn.scm,v 1.12 2002/02/16 03:37:50 cph Exp $ -Copyright (c) 1987, 1989, 1999, 2001 Massachusetts Institute of Technology +Copyright (c) 1987, 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 @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +02111-1307, USA. |# ;;;; VAX Disassembler instruction definition syntax @@ -35,62 +36,74 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. '(BYTE WORD LONG BUG B BR BSB)) (define-syntax define-instruction - (non-hygienic-macro-transformer - (lambda (name . patterns) - (if (memq name instructions-disassembled-specially) - ''() - `(begin ,@(map (lambda (pattern) - (process-instruction-definition name pattern)) - patterns)))))) + (rsc-macro-transformer + (lambda (form environment) + (if (syntax-match? '(SYMBOL * DATUM) (cdr form)) + (if (memq (cadr form) instructions-disassembled-specially) + `'() + `(,(close-syntax 'BEGIN environment) + ,@(map (lambda (pattern) + (process-instruction-definition (cadr form) + pattern + environment)) + (cddr form)))) + (ill-formed-syntax form))))) -(define (process-instruction-definition name pattern) +(define (process-instruction-definition name pattern environment) (let ((prefix (cons name (find-pattern-prefix (car pattern)))) (opcode-field (cadr pattern)) (operands (cddr pattern))) (if (not (eq? (car opcode-field) 'BYTE)) - (error "process-instruciton-definition: unhandled opcode kind" - opcode-field)) + (error "Unhandled opcode kind:" opcode-field)) (let ((opcode (cadadr opcode-field))) (case (caadr opcode-field) ;size in bits ((8) - `(define-standard-instruction ,opcode - ,(make-instruction-parser prefix operands))) + `(,(close-syntax 'DEFINE-STANDARD-INSTRUCTION environment) + ,opcode + ,(make-instruction-parser prefix operands environment))) ((16) (let ((low (remainder opcode 256)) (high (quotient opcode 256))) (if (not (= low #xFD)) - (error "process-instruction-definition: unhandled extension" - opcode)) - `(define-extended-instruction ,high - ,(make-instruction-parser prefix operands)))) + (error "Unhandled extension:" opcode)) + `(,(close-syntax 'DEFINE-EXTENDED-INSTRUCTION environment) + ,high + ,(make-instruction-parser prefix operands environment)))) (else - (error "process-instruction-definition: bad opcode size" - (caadr opcode-field))))))) + (error "Bad opcode size:" (caadr opcode-field))))))) (define (find-pattern-prefix pattern) ; KLUDGE - (if (or (null? pattern) - (and (pair? (car pattern)) (eq? (caar pattern) '?))) - '() - (cons (car pattern) (find-pattern-prefix (cdr pattern))))) + (if (and (pair? pattern) + (not (and (pair? (car pattern)) + (eq? (caar pattern) '?)))) + (cons (car pattern) (find-pattern-prefix (cdr pattern))) + '())) -(define (make-instruction-parser prefix operands) - `(lambda () - (append ',prefix - ,(process-operands operands)))) +(define (make-instruction-parser prefix operands environment) + `(,(close-syntax 'LAMBDA environment) + () + (,(close-syntax 'APPEND environment) + ',prefix + ,(process-operands operands environment)))) -;; A let* is used below to force the order of evaluation. +;; A let is used below to force the order of evaluation. -(define (process-operands operands) - (if (null? operands) - ''() - `(let* ((this ,(let ((operand (car operands))) - (case (car operand) - ((OPERAND) - `(decode-operand ',(cadr operand))) - ((DISPLACEMENT) - `(decode-displacement ,(caadr operand))) - (else - (error "process-operand: Unknown operand kind" - operand))))) - (rest ,(process-operands (cdr operands)))) - (cons this rest)))) \ No newline at end of file +(define (process-operands operands environment) + (if (pair? operands) + (let ((temp (make-synthetic-identifier 'TEMP))) + `(,(close-syntax 'LET environment) + ((,temp + ,(let ((operand (car operands))) + (case (car operand) + ((OPERAND) + `(,(close-syntax 'DECODE-OPERAND environment) + ',(cadr operand))) + ((DISPLACEMENT) + `(,(close-syntax 'DECODE-DISPLACEMENT environment) + ,(caadr operand))) + (else + (error "Unknown operand kind:" operand)))))) + (,(close-syntax 'CONS environment) + ,temp + ,(process-operands (cdr operands) environment)))) + `'())) \ No newline at end of file diff --git a/v7/src/compiler/machines/vax/insmac.scm b/v7/src/compiler/machines/vax/insmac.scm index 930cc7fa6..ee2cd0a8f 100644 --- a/v7/src/compiler/machines/vax/insmac.scm +++ b/v7/src/compiler/machines/vax/insmac.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: insmac.scm,v 1.16 2002/02/14 22:03:32 cph Exp $ +$Id: insmac.scm,v 1.17 2002/02/16 03:36:04 cph Exp $ Copyright (c) 1987, 1989, 1999, 2001, 2002 Massachusetts Institute of Technology @@ -72,6 +72,15 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (rsc-macro-transformer (lambda (form environment) `(,(close-syntax 'DEFINE environment) ,@(cdr form))))) + +(define-syntax define-trivial-instruction + (sc-macro-transformer + (lambda (form environment) + (if (syntax-match? '(SYMBOL EXPRESSION) (cdr form)) + `(DEFINE-INSTRUCTION ,(cadr form) + (() + (BYTE (8 ,(close-syntax (caddr form) environment))))) + (ill-formed-syntax form))))) (define (parse-instruction opcode tail early? environment) (process-fields (cons opcode tail) early? environment)) diff --git a/v7/src/compiler/machines/vax/instr1.scm b/v7/src/compiler/machines/vax/instr1.scm index d049876ef..9232d8ee5 100644 --- a/v7/src/compiler/machines/vax/instr1.scm +++ b/v7/src/compiler/machines/vax/instr1.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: instr1.scm,v 1.9 2001/12/23 17:20:58 cph Exp $ +$Id: instr1.scm,v 1.10 2002/02/16 03:35:26 cph Exp $ -Copyright (c) 1987, 1989, 1999, 2001 Massachusetts Institute of Technology +Copyright (c) 1987, 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 @@ -56,15 +56,6 @@ opcodes are |# -;; Utility - -(define-syntax define-trivial-instruction - (non-hygienic-macro-transformer - (lambda (mnemonic opcode) - `(DEFINE-INSTRUCTION ,mnemonic - (() - (BYTE (8 ,opcode))))))) - ;; Pseudo ops (define-instruction BYTE diff --git a/v7/src/compiler/machines/vax/instr2.scm b/v7/src/compiler/machines/vax/instr2.scm index 699957cd8..c7bf29944 100644 --- a/v7/src/compiler/machines/vax/instr2.scm +++ b/v7/src/compiler/machines/vax/instr2.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: instr2.scm,v 1.10 2002/02/16 03:32:20 cph Exp $ +$Id: instr2.scm,v 1.11 2002/02/16 03:34:42 cph Exp $ Copyright (c) 1987, 1989, 1999, 2001, 2002 Massachusetts Institute of Technology @@ -330,84 +330,86 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (let-syntax ((define-arithmetic - (lambda (name digit) - `(define-instruction ,name - ((B (? op ea-r-b) (? res ea-m-b)) - (BYTE (8 ,(+ #x80 digit))) - (OPERAND B op) - (OPERAND B res)) - - ((B (? op1 ea-r-b) (? op2 ea-r-b) (? res ea-w-b)) - (BYTE (8 ,(+ #x81 digit))) - (OPERAND B op1) - (OPERAND B op2) - (OPERAND B res)) - - ((W (? op ea-r-w) (? res ea-m-w)) - (BYTE (8 ,(+ #xA0 digit))) - (OPERAND W op) - (OPERAND W res)) - - ((W (? op1 ea-r-w) (? op2 ea-r-w) (? res ea-w-w)) - (BYTE (8 ,(+ #xA1 digit))) - (OPERAND W op1) - (OPERAND W op2) - (OPERAND W res)) - - ((L (? op ea-r-l) (? res ea-m-l)) - (BYTE (8 ,(+ #xC0 digit))) - (OPERAND L op) - (OPERAND L res)) - - ((L (? op1 ea-r-l) (? op2 ea-r-l) (? res ea-w-l)) - (BYTE (8 ,(+ #xC1 digit))) - (OPERAND L op1) - (OPERAND L op2) - (OPERAND L res)) - - ((F (? op ea-r-f) (? res ea-m-f)) - (BYTE (8 ,(+ #x40 digit))) - (OPERAND F op) - (OPERAND F res)) - - ((F (? op1 ea-r-f) (? op2 ea-r-f) (? res ea-w-f)) - (BYTE (8 ,(+ #x41 digit))) - (OPERAND F op1) - (OPERAND F op2) - (OPERAND F res)) - - ((D (? op ea-r-d) (? res ea-m-d)) - (BYTE (8 ,(+ #x60 digit))) - (OPERAND D op) - (OPERAND D res)) - - ((D (? op1 ea-r-d) (? op2 ea-r-d) (? res ea-w-d)) - (BYTE (8 ,(+ #x61 digit))) - (OPERAND D op1) - (OPERAND D op2) - (OPERAND D res)) - - ((G (? op ea-r-g) (? res ea-m-g)) - (BYTE (16 ,(+ #x40FD (* digit #x100)))) - (OPERAND G op) - (OPERAND G res)) - - ((G (? op1 ea-r-g) (? op2 ea-r-g) (? res ea-w-g)) - (BYTE (16 ,(+ #x41FD (* digit #x100)))) - (OPERAND G op1) - (OPERAND G op2) - (OPERAND G res)) - - ((H (? op ea-r-h) (? res ea-m-h)) - (BYTE (16 ,(+ #x60FD (* digit #x100)))) - (OPERAND H op) - (OPERAND H res)) - - ((H (? op1 ea-r-h) (? op2 ea-r-h) (? res ea-w-h)) - (BYTE (16 ,(+ #x61FD (* digit #x100)))) - (OPERAND H op1) - (OPERAND H op2) - (OPERAND H res)))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + ((B (? op ea-r-b) (? res ea-m-b)) + (BYTE (8 ,(+ #x80 (caddr form)))) + (OPERAND B op) + (OPERAND B res)) + + ((B (? op1 ea-r-b) (? op2 ea-r-b) (? res ea-w-b)) + (BYTE (8 ,(+ #x81 (caddr form)))) + (OPERAND B op1) + (OPERAND B op2) + (OPERAND B res)) + + ((W (? op ea-r-w) (? res ea-m-w)) + (BYTE (8 ,(+ #xA0 (caddr form)))) + (OPERAND W op) + (OPERAND W res)) + + ((W (? op1 ea-r-w) (? op2 ea-r-w) (? res ea-w-w)) + (BYTE (8 ,(+ #xA1 (caddr form)))) + (OPERAND W op1) + (OPERAND W op2) + (OPERAND W res)) + + ((L (? op ea-r-l) (? res ea-m-l)) + (BYTE (8 ,(+ #xC0 (caddr form)))) + (OPERAND L op) + (OPERAND L res)) + + ((L (? op1 ea-r-l) (? op2 ea-r-l) (? res ea-w-l)) + (BYTE (8 ,(+ #xC1 (caddr form)))) + (OPERAND L op1) + (OPERAND L op2) + (OPERAND L res)) + + ((F (? op ea-r-f) (? res ea-m-f)) + (BYTE (8 ,(+ #x40 (caddr form)))) + (OPERAND F op) + (OPERAND F res)) + + ((F (? op1 ea-r-f) (? op2 ea-r-f) (? res ea-w-f)) + (BYTE (8 ,(+ #x41 (caddr form)))) + (OPERAND F op1) + (OPERAND F op2) + (OPERAND F res)) + + ((D (? op ea-r-d) (? res ea-m-d)) + (BYTE (8 ,(+ #x60 (caddr form)))) + (OPERAND D op) + (OPERAND D res)) + + ((D (? op1 ea-r-d) (? op2 ea-r-d) (? res ea-w-d)) + (BYTE (8 ,(+ #x61 (caddr form)))) + (OPERAND D op1) + (OPERAND D op2) + (OPERAND D res)) + + ((G (? op ea-r-g) (? res ea-m-g)) + (BYTE (16 ,(+ #x40FD (* (caddr form) #x100)))) + (OPERAND G op) + (OPERAND G res)) + + ((G (? op1 ea-r-g) (? op2 ea-r-g) (? res ea-w-g)) + (BYTE (16 ,(+ #x41FD (* (caddr form) #x100)))) + (OPERAND G op1) + (OPERAND G op2) + (OPERAND G res)) + + ((H (? op ea-r-h) (? res ea-m-h)) + (BYTE (16 ,(+ #x60FD (* (caddr form) #x100)))) + (OPERAND H op) + (OPERAND H res)) + + ((H (? op1 ea-r-h) (? op2 ea-r-h) (? res ea-w-h)) + (BYTE (16 ,(+ #x61FD (* (caddr form) #x100)))) + (OPERAND H op1) + (OPERAND H op2) + (OPERAND H res))))))) (define-arithmetic ADD #x0) (define-arithmetic SUB #x2) @@ -529,41 +531,43 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (let-syntax ((define-bitwise - (lambda (name opcode) - `(define-instruction ,name - ((B (? mask ea-r-b) (? dst ea-m-b)) - (BYTE (8 ,(+ #x80 opcode))) - (OPERAND B mask) - (OPERAND B dst)) - - ((B (? mask ea-r-b) (? src ea-r-b) (? dst ea-w-b)) - (BYTE (8 ,(+ #x81 opcode))) - (OPERAND B mask) - (OPERAND B src) - (OPERAND B dst)) - - ((W (? mask ea-r-w) (? dst ea-m-w)) - (BYTE (8 ,(+ #xA0 opcode))) - (OPERAND W mask) - (OPERAND W dst)) - - ((W (? mask ea-r-w) (? src ea-r-w) (? dst ea-w-w)) - (BYTE (8 ,(+ #xA1 opcode))) - (OPERAND W mask) - (OPERAND W src) - (OPERAND W dst)) - - ((L (? mask ea-r-l) (? dst ea-m-l)) - (BYTE (8 ,(+ #xC0 opcode))) - (OPERAND L mask) - (OPERAND L dst)) - - ((L (? mask ea-r-l) (? src ea-r-l) (? dst ea-w-l)) - (BYTE (8 ,(+ #xC1 opcode))) - (OPERAND L mask) - (OPERAND L src) - (OPERAND L dst)))))) + (sc-macro-transformer + (lambda (form environment) + environment + `(DEFINE-INSTRUCTION ,(cadr form) + ((B (? mask ea-r-b) (? dst ea-m-b)) + (BYTE (8 ,(+ #x80 (caddr form)))) + (OPERAND B mask) + (OPERAND B dst)) + + ((B (? mask ea-r-b) (? src ea-r-b) (? dst ea-w-b)) + (BYTE (8 ,(+ #x81 (caddr form)))) + (OPERAND B mask) + (OPERAND B src) + (OPERAND B dst)) + + ((W (? mask ea-r-w) (? dst ea-m-w)) + (BYTE (8 ,(+ #xA0 (caddr form)))) + (OPERAND W mask) + (OPERAND W dst)) + + ((W (? mask ea-r-w) (? src ea-r-w) (? dst ea-w-w)) + (BYTE (8 ,(+ #xA1 (caddr form)))) + (OPERAND W mask) + (OPERAND W src) + (OPERAND W dst)) + + ((L (? mask ea-r-l) (? dst ea-m-l)) + (BYTE (8 ,(+ #xC0 (caddr form)))) + (OPERAND L mask) + (OPERAND L dst)) + + ((L (? mask ea-r-l) (? src ea-r-l) (? dst ea-w-l)) + (BYTE (8 ,(+ #xC1 (caddr form)))) + (OPERAND L mask) + (OPERAND L src) + (OPERAND L dst))))))) (define-bitwise BIS #x8) (define-bitwise BIC #xA) - (define-bitwise XOR #xC)) + (define-bitwise XOR #xC)) \ No newline at end of file -- 2.25.1