#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/insmac.scm,v 1.7 1987/08/22 22:10:08 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/insmac.scm,v 1.8 1987/08/22 22:44:15 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
`(MAKE-EFFECTIVE-ADDRESS
',keyword
',categories
- ,(process-fields value))))))))
+ ,(process-fields value false))))))))
(syntax-table-define assembler-syntax-table 'DEFINE-EA-TRANSFORMER
(macro (name category type)
(macro (name value)
`(define ,name ,value)))
\f
-(define ea-value-operator 'EA-VALUE)
-
(define (parse-instruction opcode tail early?)
- (if early?
- (fluid-let ((ea-value-operator 'EA-VALUE-EARLY))
- (process-fields (cons opcode tail)))
- (process-fields (cons opcode tail))))
+ (process-fields (cons opcode tail) early?))
-(define (process-fields fields)
+(define (process-fields fields early?)
(if (and (null? (cdr fields))
(eq? (caar fields) 'VARIABLE-WIDTH))
- (expand-variable-width (car fields))
+ (expand-variable-width (car fields)
+ (if early? 'EA-VALUE-EARLY 'EA-VALUE))
(expand-fields fields
+ (if early? 'EA-VALUE-EARLY 'EA-VALUE)
(lambda (code size)
(if (not (zero? (remainder size 8)))
(error "process-fields: bad syllable size" size))
code))))
-(define (expand-variable-width field)
+(define (expand-variable-width field ea-value-operator)
(let ((binding (cadr field))
(clauses (cddr field)))
`(LIST
(map (lambda (clause)
(expand-fields
(cdr clause)
+ ea-value-operator
(lambda (code size)
(if (not (zero? (remainder size 8)))
(error "expand-variable-width: bad clause size" size))
`(,code ,size ,@(car clause)))))
clauses)))))
\f
-(define (expand-fields fields receiver)
+(define (expand-fields fields ea-value-operator receiver)
(if (null? fields)
(receiver ''() 0)
- (expand-fields (cdr fields)
+ (expand-fields (cdr fields) ea-value-operator
(lambda (tail tail-size)
(case (caar fields)
((BYTE)
,(displacement-syntaxer expression size)
,tail)
(+ size tail-size)))))
+ ((IMMEDIATE)
+ (receiver
+ `(CONS-SYNTAX
+ (COERCE-TO-TYPE ,(cadar fields) *IMMEDIATE-TYPE*)
+ ,tail)
+ tail-size))
(else
(error "expand-fields: Unknown field kind" (caar fields))))))))
-
+\f
(define (displacement-syntaxer expression size)
(cond ((not (pair? expression))
`(SYNTAX-DISPLACEMENT ,expression
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/insutl.scm,v 1.5 1987/08/22 22:01:26 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/insutl.scm,v 1.6 1987/08/22 22:44:35 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
\f
;;;; Addressing modes
-;; Missing: index and immediate modes.
-
(define-ea-database
((S (? value))
(R)
(BYTE (6 value)
(2 0)))
+ ((X (? n) (? base ea-i-?))
+ (R M W V)
+ (BYTE (4 n)
+ (4 4))
+ (OPERAND ? base))
+
((R (? n))
(R M W V)
(BYTE (4 n)
(4 15))
(BYTE (32 off SIGNED)))
\f
+ ((& (? value))
+ (R M W A V I)
+ (BYTE (4 15)
+ (4 8))
+ (IMMEDIATE value))
+
((@& (? value)) ; Absolute
(R M W A V I)
(BYTE (4 15)
\f
;;;; Effective address processing
-;; Handling of index and immediate modes
-;; Index mode:
-;; (X (? n) (? base ea))
-;; base is prefixed by (BYTE (4 n) (4 4)).
-;; Immediate mode:
-;; (& (? value))
-;; The operand size dependent value is preceeded by
-;; (BYTE (4 15) (4 8))
+(define *immediate-type*)
(define (process-ea expression type)
- (define (wrap keyword cats reg mode value)
- (make-effective-address
- keyword
- cats
- (cons-syntax
- (syntax-evaluation reg coerce-4-bit-unsigned)
- (cons-syntax (syntax-evaluation mode coerce-4-bit-unsigned)
- value))))
-
- (define (kernel expression)
+ (fluid-let ((*immediate-type*
+ (if (eq? '? type) *immediate-type* type)))
(let ((match (pattern-lookup ea-database expression)))
(cond (match (match))
- ((and (pair? expression) (eq? (car expression) '&))
- (wrap '& '(R A V I) ; M and W unpredictable
- 15 8
- (cons-syntax
- (coerce-to-type (cadr expression) type)
- '())))
- ;; Guarantee idempotency for early processing.
- ((effective-address? expression)
- expression)
- (else #F))))
-
- (cond ((not (pair? expression))
- ;; Guarantee idempotency for early processing.
- (if (effective-address? object)
- object
- #F))
- ((eq? (car expression) 'X)
- (let ((base (kernel (caddr expression))))
- (and base
- (memq 'I (ea-categories base))
- (wrap 'X '(R M W A V)
- (cadr expression) 4
- (ea-value result)))))
- (else (kernel expression))))
+ ;; Guarantee idempotency for early instruction processing.
+ ((effective-address? expression) expression)
+ (else #F)))))
(define (coerce-to-type expression type)
(syntax-evaluation
((d f g h l o q)
(error "coerce-to-type: Unimplemented type" type))
(else (error "coerce-to-type: Unknown type" type)))))
-\f
-;;;; Transformers
+
+;;; Transformers
(define-symbol-transformer cc
(NEQ . #x2) (NEQU . #x2) (EQL . #x3) (EQLU . #x3)
(or (eq? (car expression) '@PCR)
(eq? (car expression) '@PCO))
expression)))
+\f
+;;;; Effective address transformers
(define-ea-transformer ea-a-b a b)
(define-ea-transformer ea-a-d a d)
(define-ea-transformer ea-w-o w o)
(define-ea-transformer ea-w-q w q)
(define-ea-transformer ea-w-w w w)
+(define-ea-transformer ea-i-? i ?)
\ No newline at end of file
projects / mit-scheme.git / commitdiff