#| -*-Scheme-*-
-$Id: instr1.scm,v 1.5 2001/12/20 21:45:24 cph Exp $
+$Id: instr1.scm,v 1.6 2002/02/22 02:57:23 cph Exp $
-Copyright (c) 1992-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1992-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
((memory-format-instruction
- (lambda (keyword opcode)
- `(define-instruction ,keyword
- (((? destination) (OFFSET (? offset) (? base)))
- (VARIABLE-WIDTH (offset offset)
- ((#x-8000 #x7FFF)
- (LONG (6 ,opcode)
- (5 destination)
- (5 base)
- (16 offset SIGNED)))
- ((#x-80000000 #x7FFFFFFF)
- ;; LDAH temp, left[offset](base)
- ;; LDx/STx destination, right[offset](temp)
- (LONG (6 #x09) ; LDAH
- (5 regnum:volatile-scratch) ; destination = temp
- (5 base) ; base
- (16 (adjusted:high offset) SIGNED)
- (6 ,opcode) ; LDx/STx
- (5 destination) ; destination
- (5 regnum:volatile-scratch) ; base = temp
- (16 (adjusted:low offset) SIGNED)))))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (((? destination) (OFFSET (? offset) (? base)))
+ (VARIABLE-WIDTH (offset offset)
+ ((#x-8000 #x7FFF)
+ (LONG (6 ,(caddr form))
+ (5 destination)
+ (5 base)
+ (16 offset SIGNED)))
+ ((#x-80000000 #x7FFFFFFF)
+ ;; LDAH temp, left[offset](base)
+ ;; LDx/STx destination, right[offset](temp)
+ (LONG (6 #x09) ; LDAH
+ (5 regnum:volatile-scratch) ; destination = temp
+ (5 base) ; base
+ (16 (adjusted:high offset) SIGNED)
+ (6 ,(caddr form)) ; LDx/STx
+ (5 destination) ; destination
+ (5 regnum:volatile-scratch) ; base = temp
+ (16 (adjusted:low offset) SIGNED))))))))))
(memory-format-instruction LDA #x08) ; Load Address
(memory-format-instruction LDAH #x09) ; Load Address High
(memory-format-instruction LDF #x20) ; Load F floating from memory
(5 destination)
(5 regnum:zero)
(16 constant SIGNED))))
-
+\f
(define-instruction COPY
(((? source) (? destination))
(LONG (6 #x11) ; Arithmetic/Logical
(let-syntax
((special-memory-instruction
- (lambda (keyword functioncode)
- `(define-instruction ,keyword
- (()
- (LONG (6 #x18)
- (5 #x0)
- (5 #x0)
- (16 ,functioncode))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (()
+ (LONG (6 #x18)
+ (5 #x0)
+ (5 #x0)
+ (16 ,(caddr form))))))))
(special-memory-instruction-Ra
- (lambda (keyword functioncode)
- `(define-instruction ,keyword
- (((? Ra))
- (LONG (6 #x18)
- (5 Ra)
- (5 #x0)
- (16 ,functioncode))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (((? Ra))
+ (LONG (6 #x18)
+ (5 Ra)
+ (5 #x0)
+ (16 ,(caddr form))))))))
(special-memory-instruction-Rb
- (lambda (keyword functioncode)
- `(define-instruction ,keyword
- (((? Rb))
- (LONG (6 #x18)
- (5 #x0)
- (5 Rb)
- (16 ,functioncode)))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (((? Rb))
+ (LONG (6 #x18)
+ (5 #x0)
+ (5 Rb)
+ (16 ,(caddr form)))))))))
(special-memory-instruction DRAINT #x0000) ; Drain instruction pipe
(special-memory-instruction-Rb FETCH #x8000) ; Prefetch data
(special-memory-instruction-Rb FETCH_M #xA000); Prefetch data, modify intent
(special-memory-instruction-Ra RPCC #xC000) ; Read process cycle counter
(special-memory-instruction-Ra RS #xF000) ; Read and set (VAX converter)
(special-memory-instruction TRAPB #x0000) ; Trap barrier
-)
+ )
\f
(let-syntax
((operate-format
- (lambda (keyword opcode functioncode)
- `(define-instruction ,keyword
- (((? source-1) (& (? constant)) (? destination))
- (LONG (6 ,opcode)
- (5 source-1)
- (8 constant UNSIGNED)
- (1 1) ; Must be one
- (7 ,functioncode)
- (5 destination)))
- (((? source-1) (? source-2) (? destination))
- (LONG (6 ,opcode)
- (5 source-1)
- (5 source-2)
- (3 0) ; Should be zero
- (1 0) ; Must be zero
- (7 ,functioncode)
- (5 destination)))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (((? source-1) (& (? constant)) (? destination))
+ (LONG (6 ,(caddr form))
+ (5 source-1)
+ (8 constant UNSIGNED)
+ (1 1) ; Must be one
+ (7 ,(cadddr form))
+ (5 destination)))
+ (((? source-1) (? source-2) (? destination))
+ (LONG (6 ,(caddr form))
+ (5 source-1)
+ (5 source-2)
+ (3 0) ; Should be zero
+ (1 0) ; Must be zero
+ (7 ,(cadddr form))
+ (5 destination))))))))
(operate-format ADDL #x10 #x00) ; Add longword
(operate-format ADDLV #x10 #x40) ; Add longword, enable oflow trap
(operate-format ADDQ #x10 #x20) ; Add quadword
(operate-format XOR #x11 #x40) ; Logical difference (xor)
(operate-format ZAP #x12 #x30) ; Zero bytes
(operate-format ZAPNOT #x12 #x31) ; Zero bytes not
-)
-
+ )
+\f
(let-syntax
((pal-format
- (lambda (keyword functioncode)
- `(define-instruction ,keyword
- (()
- (LONG (6 0)
- (26 ,functioncode)))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (()
+ (LONG (6 0)
+ (26 ,(caddr form)))))))))
(pal-format BPT #x0080) ; Initiate program debugging
(pal-format BUGCHK #x0081) ; Initiate program exception
;; Privileged PALcode instructions.
(pal-format HALT #x0000)
-)
-\f
+ )
+
;;;; Assembler pseudo-ops
(define-instruction EXTERNAL-LABEL
(define-instruction UWORD
;; Directly insert 32 bit word into output stream
(((? expression))
- (LONG (32 expression UNSIGNED))))
+ (LONG (32 expression UNSIGNED))))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: instr2.scm,v 1.3 2001/12/20 21:45:24 cph Exp $
+$Id: instr2.scm,v 1.4 2002/02/22 03:01:31 cph Exp $
-Copyright (c) 1992-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1992-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
-; Unconditional jump instructions
+;;; Unconditional jump instructions
+
(let-syntax
((memory-branch
- (lambda (keyword hint)
- `(define-instruction ,keyword
- (((? link-register) (? base))
- (LONG (6 #x1a)
- (5 link-register)
- (5 base)
- (2 ,hint)
- (14 0 SIGNED)))
- (((? base))
- (LONG (6 #x1a)
- (5 regnum:came-from)
- (5 base)
- (2 ,hint)
- (14 0 SIGNED)))
- (((? link-register) (? base) (@PCR (? probable-target)))
- (LONG (6 #x1a)
- (5 link-register)
- (5 base)
- (2 ,hint)
- (14 `(/ (remainder (- ,probable-target (+ *PC* 4))
- #x10000)
- 4)
- SIGNED)))
- (((? link-register) (? base) (@PCO (? probable-target-address)))
- (LONG (6 #x1a)
- (5 link-register)
- (5 base)
- (2 ,hint)
- (14 `(/ (remainder ,probable-target-address
- #x10000)
- 4)
- SIGNED)))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (((? link-register) (? base))
+ (LONG (6 #x1a)
+ (5 link-register)
+ (5 base)
+ (2 ,(caddr form))
+ (14 0 SIGNED)))
+ (((? base))
+ (LONG (6 #x1a)
+ (5 regnum:came-from)
+ (5 base)
+ (2 ,(caddr form))
+ (14 0 SIGNED)))
+ (((? link-register) (? base) (@PCR (? probable-target)))
+ (LONG (6 #x1a)
+ (5 link-register)
+ (5 base)
+ (2 ,(caddr form))
+ (14 `(/ (remainder (- ,probable-target (+ *PC* 4))
+ #x10000)
+ 4)
+ SIGNED)))
+ (((? link-register) (? base) (@PCO (? probable-target-address)))
+ (LONG (6 #x1a)
+ (5 link-register)
+ (5 base)
+ (2 ,(caddr form))
+ (14 `(/ (remainder ,probable-target-address
+ #x10000)
+ 4)
+ SIGNED))))))))
(memory-branch JMP #x0)
(memory-branch JSR #x1)
(memory-branch RET #x2)
(memory-branch COROUTINE #x3))
-
-; Conditional branch instructions
+\f
+;;; Conditional branch instructions
(let-syntax
((branch
- (lambda (keyword opcode reverse-op)
- `(define-instruction ,keyword
- (((? reg) (@PCO (? offset)))
- (LONG (6 ,opcode)
- (5 reg)
- (21 (quotient offset 4) SIGNED)))
- (((? reg) (@PCR (? label)))
- (VARIABLE-WIDTH (offset `(/ (- ,label (+ *PC* 4)) 4))
- ((#x-100000 #xFFFFF)
- (LONG (6 ,opcode)
- (5 reg)
- (21 offset SIGNED)))
- ((#x-1FFFFFFE #x20000001)
- ;; -1: <reverse> xxx
- ;; 0: LDAH temp, left[4*(offset-2)](R31)
- ;; +1: BR link, yyy
- ;; 2: yyy: ADDQ temp, link, temp
- ;; 3: LDA temp, right[4*(offset-2)](temp)
- ;; 4: JMP came_from, temp, hint
- ;; 5: xxx:
- (LONG (6 ,reverse-op) ; reverse branch to (.+1)+4
- (5 reg) ; register
- (21 5 SIGNED) ; offset = +5 instructions
- (6 #x09) ; LDAH
- (5 regnum:assembler-temp) ; destination = temp
- (5 31) ; base = zero
- (16 (adjusted:high (* (- offset 2) 4)) SIGNED)
- (6 #x30) ; BR
- (5 26) ; return address to link
- (21 0 SIGNED) ; (.+4) + 0
- (6 #x10) ; ADDQ
- (5 regnum:assembler-temp) ; source = temp
- (5 26) ; source = link
- (3 0) ; should be 0
- (1 0) ; must be 0
- (7 #x20) ; function=ADDQ
- (5 regnum:assembler-temp) ; destination = temp
- (6 #x08) ; LDA
- (5 regnum:assembler-temp) ; destination = temp
- (5 regnum:assembler-temp) ; base = temp
- (16 (adjusted:low (* (- offset 2) 4)) SIGNED)
- (6 #x1a) ; JMP
- (5 regnum:assembler-temp) ; return address to "came from"
- (5 regnum:assembler-temp) ; base = temp
- (2 #x0) ; jump hint
- (14 (/ (adjusted:low (* (- offset 5) 4)) 4)
- SIGNED)))))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (((? reg) (@PCO (? offset)))
+ (LONG (6 ,(caddr form))
+ (5 reg)
+ (21 (quotient offset 4) SIGNED)))
+ (((? reg) (@PCR (? label)))
+ (VARIABLE-WIDTH (offset `(/ (- ,label (+ *PC* 4)) 4))
+ ((#x-100000 #xFFFFF)
+ (LONG (6 ,(caddr form))
+ (5 reg)
+ (21 offset SIGNED)))
+ ((#x-1FFFFFFE #x20000001)
+ ;; -1: <reverse> xxx
+ ;; 0: LDAH temp, left[4*(offset-2)](R31)
+ ;; +1: BR link, yyy
+ ;; 2: yyy: ADDQ temp, link, temp
+ ;; 3: LDA temp, right[4*(offset-2)](temp)
+ ;; 4: JMP came_from, temp, hint
+ ;; 5: xxx:
+ (LONG (6 ,(cadddr form)) ; reverse branch to (.+1)+4
+ (5 reg) ; register
+ (21 5 SIGNED) ; offset = +5 instructions
+ (6 #x09) ; LDAH
+ (5 regnum:assembler-temp) ; destination = temp
+ (5 31) ; base = zero
+ (16 (adjusted:high (* (- offset 2) 4)) SIGNED)
+ (6 #x30) ; BR
+ (5 26) ; return address to link
+ (21 0 SIGNED) ; (.+4) + 0
+ (6 #x10) ; ADDQ
+ (5 regnum:assembler-temp) ; source = temp
+ (5 26) ; source = link
+ (3 0) ; should be 0
+ (1 0) ; must be 0
+ (7 #x20) ; function=ADDQ
+ (5 regnum:assembler-temp) ; destination = temp
+ (6 #x08) ; LDA
+ (5 regnum:assembler-temp) ; destination = temp
+ (5 regnum:assembler-temp) ; base = temp
+ (16 (adjusted:low (* (- offset 2) 4)) SIGNED)
+ (6 #x1a) ; JMP
+ (5 regnum:assembler-temp) ; return address to "came from"
+ (5 regnum:assembler-temp) ; base = temp
+ (2 #x0) ; jump hint
+ (14 (/ (adjusted:low (* (- offset 5) 4)) 4)
+ SIGNED))))))))))
(branch beq #x39 #x3d)
(branch bge #x3e #x3a)
(branch bgt #x3f #x3b)
(branch fble #x33 #x37)
(branch fblt #x32 #x36)
(branch fbne #x35 #x31))
-
-; Unconditional branch instructions
+\f
+;;; Unconditional branch instructions
(let-syntax
((unconditional-branch
- (lambda (keyword opcode hint)
- `(define-instruction ,keyword
- (((? reg) (@PCO (? offset)))
- (LONG (6 ,opcode)
- (5 reg)
- (21 (quotient offset 4) SIGNED)))
- (((? reg) (@PCR (? label)))
- (VARIABLE-WIDTH (offset `(/ (- ,label (+ *PC* 4)) 4))
- ((#x-100000 #xFFFFF)
- (LONG (6 ,opcode)
- (5 reg)
- (21 offset SIGNED)))
- ((#x-1FFFFFFF #x20000000)
- ;; -1: LDAH temp, left[4*(offset-1)](R31)
- ;; 0: BR link, yyy
- ;; 1: yyy: ADDQ temp, link, temp
- ;; 2: LDA temp, right[4*(offset-1)](temp)
- ;; 3: JMP came_from, temp, hint
- ;; 4: xxx:
- (LONG (6 #x09) ; LDAH
- (5 regnum:assembler-temp) ; destination = temp
- (5 31) ; base = zero
- (16 (adjusted:high (* (- offset 1) 4)) SIGNED)
- (6 #x30) ; BR
- (5 26) ; return address to link
- (21 0 SIGNED) ; (.+4) + 0
- (6 #x10) ; ADDQ
- (5 regnum:assembler-temp) ; source = temp
- (5 26) ; source = link
- (3 0) ; should be 0
- (1 0) ; must be 0
- (7 #x20) ; function=ADDQ
- (5 regnum:assembler-temp) ; destination = temp
- (6 #x08) ; LDA
- (5 regnum:assembler-temp) ; destination = temp
- (5 regnum:assembler-temp) ; base = temp
- (16 (adjusted:low (* (- offset 1) 4)) SIGNED)
- (6 #x1a) ; JMP
- (5 reg) ; return address register
- (5 regnum:assembler-temp) ; base = temp
- (2 ,hint) ; jump hint
- (14 (/ (adjusted:low (* (- offset 4) 4)) 4) SIGNED)))))
- (((? reg) (OFFSET (? offset) (@PCR (? label))))
- (VARIABLE-WIDTH (offset `(/ (- (+ ,offset ,label)
- (+ *PC* 4))
- 4))
- ((#x-100000 #xFFFFF)
- (LONG (6 ,opcode)
- (5 reg)
- (21 offset SIGNED)))
- ((#x-1FFFFFFF #x20000000)
- ;; -1: LDAH temp, left[4*(offset-1)](R31)
- ;; 0: BR link, yyy
- ;; 1: yyy: ADDQ temp, link, temp
- ;; 2: LDQ temp, right[4*(offset-1)]
- ;; 2: JMP came_from, temp, hint
- (LONG (6 #x09) ; LDAH
- (5 regnum:assembler-temp) ; destination = temp
- (5 31) ; base = zero
- (16 (adjusted:high (* (- offset 1) 4)) SIGNED)
- (6 #x30) ; BR
- (5 26) ; return address to link
- (21 0 SIGNED) ; (.+4) + 0
- (6 #x10) ; ADDQ
- (5 regnum:assembler-temp) ; source = temp
- (5 26) ; source = link
- (3 0) ; should be 0
- (1 0) ; must be 0
- (7 #x20) ; function=ADDQ
- (5 regnum:assembler-temp) ; destination = temp
- (6 #x08) ; LDA
- (5 regnum:assembler-temp) ; destination = temp
- (5 regnum:assembler-temp) ; base = temp
- (16 (adjusted:low (* (- offset 1) 4)) SIGNED)
- (6 #x1a) ; JMP
- (5 reg) ; return address register
- (5 regnum:assembler-temp) ; base = temp
- (2 ,hint) ; jump hint
- (14 (/ (adjusted:low (* (- offset 4) 4)) 4)
- SIGNED)))))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (((? reg) (@PCO (? offset)))
+ (LONG (6 ,(caddr form))
+ (5 reg)
+ (21 (quotient offset 4) SIGNED)))
+ (((? reg) (@PCR (? label)))
+ (VARIABLE-WIDTH (offset `(/ (- ,label (+ *PC* 4)) 4))
+ ((#x-100000 #xFFFFF)
+ (LONG (6 ,(caddr form))
+ (5 reg)
+ (21 offset SIGNED)))
+ ((#x-1FFFFFFF #x20000000)
+ ;; -1: LDAH temp, left[4*(offset-1)](R31)
+ ;; 0: BR link, yyy
+ ;; 1: yyy: ADDQ temp, link, temp
+ ;; 2: LDA temp, right[4*(offset-1)](temp)
+ ;; 3: JMP came_from, temp, hint
+ ;; 4: xxx:
+ (LONG (6 #x09) ; LDAH
+ (5 regnum:assembler-temp) ; destination = temp
+ (5 31) ; base = zero
+ (16 (adjusted:high (* (- offset 1) 4)) SIGNED)
+ (6 #x30) ; BR
+ (5 26) ; return address to link
+ (21 0 SIGNED) ; (.+4) + 0
+ (6 #x10) ; ADDQ
+ (5 regnum:assembler-temp) ; source = temp
+ (5 26) ; source = link
+ (3 0) ; should be 0
+ (1 0) ; must be 0
+ (7 #x20) ; function=ADDQ
+ (5 regnum:assembler-temp) ; destination = temp
+ (6 #x08) ; LDA
+ (5 regnum:assembler-temp) ; destination = temp
+ (5 regnum:assembler-temp) ; base = temp
+ (16 (adjusted:low (* (- offset 1) 4)) SIGNED)
+ (6 #x1a) ; JMP
+ (5 reg) ; return address register
+ (5 regnum:assembler-temp) ; base = temp
+ (2 ,(cadddr form)) ; jump hint
+ (14 (/ (adjusted:low (* (- offset 4) 4)) 4) SIGNED)))))
+ (((? reg) (OFFSET (? offset) (@PCR (? label))))
+ (VARIABLE-WIDTH (offset `(/ (- (+ ,offset ,label)
+ (+ *PC* 4))
+ 4))
+ ((#x-100000 #xFFFFF)
+ (LONG (6 ,(caddr form))
+ (5 reg)
+ (21 offset SIGNED)))
+ ((#x-1FFFFFFF #x20000000)
+ ;; -1: LDAH temp, left[4*(offset-1)](R31)
+ ;; 0: BR link, yyy
+ ;; 1: yyy: ADDQ temp, link, temp
+ ;; 2: LDQ temp, right[4*(offset-1)]
+ ;; 2: JMP came_from, temp, hint
+ (LONG (6 #x09) ; LDAH
+ (5 regnum:assembler-temp) ; destination = temp
+ (5 31) ; base = zero
+ (16 (adjusted:high (* (- offset 1) 4)) SIGNED)
+ (6 #x30) ; BR
+ (5 26) ; return address to link
+ (21 0 SIGNED) ; (.+4) + 0
+ (6 #x10) ; ADDQ
+ (5 regnum:assembler-temp) ; source = temp
+ (5 26) ; source = link
+ (3 0) ; should be 0
+ (1 0) ; must be 0
+ (7 #x20) ; function=ADDQ
+ (5 regnum:assembler-temp) ; destination = temp
+ (6 #x08) ; LDA
+ (5 regnum:assembler-temp) ; destination = temp
+ (5 regnum:assembler-temp) ; base = temp
+ (16 (adjusted:low (* (- offset 1) 4)) SIGNED)
+ (6 #x1a) ; JMP
+ (5 reg) ; return address register
+ (5 regnum:assembler-temp) ; base = temp
+ (2 ,(cadddr form)) ; jump hint
+ (14 (/ (adjusted:low (* (- offset 4) 4)) 4)
+ SIGNED))))))))))
(unconditional-branch br #x30 #x0)
- (unconditional-branch bsr #x34 #x1))
+ (unconditional-branch bsr #x34 #x1))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: instr3.scm,v 1.3 2001/12/20 21:45:24 cph Exp $
+$Id: instr3.scm,v 1.4 2002/02/22 03:03:31 cph Exp $
-Copyright (c) 1992-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1992-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
((floating-operate
- (lambda (keyword function-code)
- `(define-instruction ,keyword
- (((? src-1) (? src-2) (? dest))
- (LONG (6 #x17) ; Opcode
- (5 src-1)
- (5 src-2)
- (11 ,function-code)
- (5 dest)))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (((? src-1) (? src-2) (? dest))
+ (LONG (6 #x17) ; Opcode
+ (5 src-1)
+ (5 src-2)
+ (11 ,(caddr form))
+ (5 dest))))))))
(floating-operate CPYS #x20)
(floating-operate CPYSE #x22)
(floating-operate CPYSN #x21)
(floating-operate FCMOVNE #x2b)
(floating-operate MF_FPCR #x25)
(floating-operate MT_FPCR #x24))
-
+\f
(let-syntax
((ieee
- (lambda (keyword function-code)
- `(define-instruction ,keyword
- (((? src-1) (? src-2) (? dest))
- (LONG (6 #x16) ; Opcode
- (5 src-1)
- (5 src-2)
- (11 ,function-code)
- (5 dest)))
- ((/ (? qualifier) (? src-1) (? src-2) (? dest))
- (LONG (6 #x16) ; Opcode
- (5 src-1)
- (5 src-2)
- (11 (+ ,function-code (encode-fp-qualifier qualifier)))
- (5 dest)))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (((? src-1) (? src-2) (? dest))
+ (LONG (6 #x16) ; Opcode
+ (5 src-1)
+ (5 src-2)
+ (11 ,(caddr form))
+ (5 dest)))
+ ((/ (? qualifier) (? src-1) (? src-2) (? dest))
+ (LONG (6 #x16) ; Opcode
+ (5 src-1)
+ (5 src-2)
+ (11 (+ ,(caddr form) (encode-fp-qualifier qualifier)))
+ (5 dest))))))))
(ieee ADDS #x80)
(ieee ADDT #xA0)
(ieee CMPTEQ #xA5)
(let-syntax
((vax
- (lambda (keyword function-code)
- `(define-instruction ,keyword
- (((? src-1) (? src-2) (? dest))
- (LONG (6 #x15) ; Opcode
- (5 src-1)
- (5 src-2)
- (11 ,function-code)
- (5 dest)))
- ((/ (? qualifier) (? src-1) (? src-2) (? dest))
- (LONG (6 #x15) ; Opcode
- (5 src-1)
- (5 src-2)
- (11 (+ ,function-code (encode-fp-qualifier qualifier)))
- (5 dest)))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+ (((? src-1) (? src-2) (? dest))
+ (LONG (6 #x15) ; Opcode
+ (5 src-1)
+ (5 src-2)
+ (11 ,(caddr form))
+ (5 dest)))
+ ((/ (? qualifier) (? src-1) (? src-2) (? dest))
+ (LONG (6 #x15) ; Opcode
+ (5 src-1)
+ (5 src-2)
+ (11 (+ ,(caddr form) (encode-fp-qualifier qualifier)))
+ (5 dest))))))))
(vax ADDF #x80)
(vax ADDG #xa0)
(vax CMPGEQ #xa5)
(vax MULF #xb2)
(vax MULG #x81)
(vax SUBF #x81)
- (vax SUBG #xa1))
+ (vax SUBG #xa1))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: lapgen.scm,v 1.8 2001/12/20 21:45:24 cph Exp $
+$Id: lapgen.scm,v 1.9 2002/02/22 03:06:43 cph Exp $
-Copyright (c) 1992-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1992-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
set! define lookup-apply))
(let-syntax ((define-codes
- (lambda (start . names)
- (define (loop names offset)
- (if (null? names)
- '()
- (cons `(DEFINE-INTEGRABLE
- ,(symbol-append 'ASSEMBLY-HOOK:
- (car names))
- ,offset)
- (loop (cdr names) (+ 16 offset)))))
- `(BEGIN ,@(loop names start)))))
+ (sc-macro-transformer
+ (lambda (start . names)
+ `(BEGIN
+ ,@(let loop ((names (cddr form)) (offset (cadr form)))
+ (if (pair? names)
+ (cons `(DEFINE-INTEGRABLE
+ ,(symbol-append 'ASSEMBLY-HOOK:
+ (car names))
+ ,offset)
+ (loop (cdr names) (+ offset 16)))
+ '())))))))
(define-codes #x0
long-jump
allocate-closure))
(define (invoke-assembly-hook which-hook)
- (LAP (LDA ,regnum:assembler-temp
- (OFFSET ,which-hook ,regnum:closure-hook))
- (JSR ,regnum:assembler-temp ,regnum:assembler-temp
- (@PCO ,which-hook))))
+ (LAP (LDA ,regnum:assembler-temp (OFFSET ,which-hook ,regnum:closure-hook))
+ (JSR ,regnum:assembler-temp ,regnum:assembler-temp (@PCO ,which-hook))))
(define-integrable (link-to-interface code)
;; Jump, with link in regnum:first-arg, to link_to_interface
(LAP (MOVEI ,regnum:interface-index (& ,code))
(JMP ,regnum:first-arg ,regnum:scheme-to-interface-jsr)))
-#| ;; Not actually needed ...
-(define-integrable (link-to-trampoline code)
- ;; Jump, with link in 31, to trampoline_to_interface
- (LAP (LDA ,regnum:assembler-temp (OFFSET -96xxx ,regnum:scheme-to-interface))
- (MOVEI ,regnum:interface-index (& ,code))
- (JMP ,regnum:linkage ,regnum:assembler-temp)))
-|#
-
(define-integrable (invoke-interface code)
;; Jump to scheme-to-interface
(LAP (MOVEI ,regnum:interface-index (& ,code))
,@load-regs
,@(clear-map!)))))
-
(define (pre-lapgen-analysis rgraphs)
rgraphs
unspecific)
\ No newline at end of file
#| -*-Scheme-*-
-$Id: rules3.scm,v 1.9 2001/12/20 21:45:24 cph Exp $
+$Id: rules3.scm,v 1.10 2002/02/22 03:07:58 cph Exp $
-Copyright (c) 1992-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1992-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.5 2001/12/20 21:45:24 cph Exp $
+$Id: rulflo.scm,v 1.6 2002/02/22 03:10:15 cph Exp $
-Copyright (c) 1992-1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1992-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/2-args
- (lambda (target source1 source2)
- (LAP (,opcode ,',source1 ,',source2 ,',target)))))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-ARITHMETIC-METHOD ',(cadr form) FLONUM-METHODS/2-ARGS
+ (LAMBDA (TARGET SOURCE1 SOURCE2)
+ (LAP (,(caddr form) ,',SOURCE1 ,',SOURCE2 ,',TARGET))))))))
(define-flonum-operation flonum-add ADDT)
(define-flonum-operation flonum-subtract SUBT)
(define-flonum-operation flonum-multiply MULT)
#| -*-Scheme-*-
-$Id: assmd.scm,v 1.38 2001/12/20 21:45:24 cph Exp $
+$Id: assmd.scm,v 1.39 2002/02/22 03:11:37 cph Exp $
-Copyright (c) 1988, 1989, 1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1988-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
(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 16 bits
#| -*-Scheme-*-
-$Id: dassm1.scm,v 4.21 2001/12/20 21:45:24 cph Exp $
+$Id: dassm1.scm,v 4.22 2002/02/22 03:12:39 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
(cond ((not (< index end)) 'DONE)
((object-type?
(let-syntax ((ucode-type
- (lambda (name) (microcode-type name))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (apply microcode-type (cdr form))))))
(ucode-type linkage-section))
(system-vector-ref block index))
(loop (disassembler/write-linkage-section block
#| -*-Scheme-*-
-$Id: dassm2.scm,v 4.24 2001/12/20 21:45:24 cph Exp $
+$Id: dassm2.scm,v 4.25 2002/02/22 03:13:42 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
\f
(define (disassembler/read-variable-cache block index)
(let-syntax ((ucode-type
- (lambda (name) (microcode-type name)))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (apply microcode-type (cdr form)))))
(ucode-primitive
- (lambda (name arity)
- (make-primitive-procedure name arity))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (apply make-primitive-procedure (cdr form))))))
((ucode-primitive primitive-object-set-type 2)
(ucode-type quad)
(system-vector-ref block index))))
(with-absolutely-no-interrupts
(lambda ()
(let-syntax ((ucode-type
- (lambda (name) (microcode-type name)))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (apply microcode-type (cdr form)))))
(ucode-primitive
- (lambda (name arity)
- (make-primitive-procedure name arity))))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (apply make-primitive-procedure (cdr form))))))
((ucode-primitive primitive-object-set-type 2)
(ucode-type compiled-entry)
((ucode-primitive make-non-pointer-object 1)
#| -*-Scheme-*-
-$Id: flinstr1.scm,v 1.3 2001/12/20 21:45:24 cph Exp $
+$Id: flinstr1.scm,v 1.4 2002/02/22 03:14:49 cph Exp $
-Copyright (c) 1988, 1989, 1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1988-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
\f
(let-syntax
((define-unary-flop
- (lambda (name bits)
- `(define-instruction ,name
-
- (((? type float-source-format)
- (? source ea-d)
- (? destination float-reg))
- (WORD (4 #b1111)
- (3 FPC)
- (3 #b000)
- (6 source SOURCE-EA 'L))
- (EXTENSION-WORD (3 #b010)
- (3 type)
- (3 destination)
- (7 ,bits)))
-
- (((? source float-reg) (? destination float-reg))
- (WORD (4 #b1111)
- (3 FPC)
- (3 #b000)
- (6 #b000000))
- (EXTENSION-WORD (3 #b000)
- (3 source)
- (3 destination)
- (7 ,bits)))
-
- (((? reg float-reg))
- (WORD (4 #b1111)
- (3 FPC)
- (3 #b000)
- (6 #b000000))
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
+
+ (((? type float-source-format)
+ (? source ea-d)
+ (? destination float-reg))
+ (WORD (4 #b1111)
+ (3 FPC)
+ (3 #b000)
+ (6 source SOURCE-EA 'L))
+ (EXTENSION-WORD (3 #b010)
+ (3 type)
+ (3 destination)
+ (7 ,(caddr form))))
+
+ (((? source float-reg) (? destination float-reg))
+ (WORD (4 #b1111)
+ (3 FPC)
+ (3 #b000)
+ (6 #b000000))
+ (EXTENSION-WORD (3 #b000)
+ (3 source)
+ (3 destination)
+ (7 ,(caddr form))))
+
+ (((? reg float-reg))
+ (WORD (4 #b1111)
+ (3 FPC)
+ (3 #b000)
+ (6 #b000000))
(EXTENSION-WORD (3 #b000)
(3 reg)
(3 reg)
- (7 ,bits)))))))
-
+ (7 ,(caddr form)))))))))
(define-unary-flop FABS #b0011000)
(define-unary-flop FACOS #b0011100)
(define-unary-flop FASIN #b0001100)
#| -*-Scheme-*-
-$Id: flinstr2.scm,v 1.3 2001/12/20 21:45:24 cph Exp $
+$Id: flinstr2.scm,v 1.4 2002/02/22 03:15:47 cph Exp $
-Copyright (c) 1988, 1989, 1999, 2001 Massachusetts Institute of Technology
+Copyright (c) 1988-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
\f
(let-syntax
((define-binary-flop
- (lambda (name bits)
- `(define-instruction ,name
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ `(DEFINE-INSTRUCTION ,(cadr form)
- (((? type float-source-format)
- (? source ea-d)
- (? destination float-reg))
- (WORD (4 #b1111)
- (3 FPC)
- (3 #b000)
- (6 source SOURCE-EA 'L))
- (EXTENSION-WORD (3 #b010)
- (3 type)
- (3 destination)
- (7 ,bits)))
-
- (((? source float-reg) (? destination float-reg))
- (WORD (4 #b1111)
- (3 FPC)
- (3 #b000)
- (6 #b000000))
- (EXTENSION-WORD (3 #b000)
- (3 source)
- (3 destination)
- (7 ,bits)))))))
+ (((? type float-source-format)
+ (? source ea-d)
+ (? destination float-reg))
+ (WORD (4 #b1111)
+ (3 FPC)
+ (3 #b000)
+ (6 source SOURCE-EA 'L))
+ (EXTENSION-WORD (3 #b010)
+ (3 type)
+ (3 destination)
+ (7 ,(caddr form))))
+ (((? source float-reg) (? destination float-reg))
+ (WORD (4 #b1111)
+ (3 FPC)
+ (3 #b000)
+ (6 #b000000))
+ (EXTENSION-WORD (3 #b000)
+ (3 source)
+ (3 destination)
+ (7 ,(caddr form)))))))))
(define-binary-flop FADD #b0100010)
(define-binary-flop FCMP #b0111000)
(define-binary-flop FDIV #b0100000)
projects / mit-scheme.git / commitdiff