From fe4e8d81c828b73dac27dc7819ea151ddd335424 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Sun, 23 Aug 1987 07:56:16 +0000 Subject: [PATCH] Fix immediate effective address early processing. --- v7/src/compiler/machines/vax/inerly.scm | 80 +++++++++++++++---------- v7/src/compiler/machines/vax/insmac.scm | 25 ++++---- 2 files changed, 64 insertions(+), 41 deletions(-) diff --git a/v7/src/compiler/machines/vax/inerly.scm b/v7/src/compiler/machines/vax/inerly.scm index 882c4863a..eee0a7af7 100644 --- a/v7/src/compiler/machines/vax/inerly.scm +++ b/v7/src/compiler/machines/vax/inerly.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/inerly.scm,v 1.1 1987/08/22 22:51:27 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/inerly.scm,v 1.2 1987/08/23 07:55:56 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -84,24 +84,16 @@ MIT in each case. |# `(define-early-transformer ',name (make-ea-transformer 'category 'type)))) -(define *immediate-type*) - (define (make-ea-transformer category type) - (let ((kernel - (make-database-transformer - (mapcan (lambda (rule) - (apply - (lambda (pattern variables categories expression) - (if (memq category categories) - (list (early-make-rule pattern variables expression)) - '())) - rule)) - early-ea-database)))) - (if (eq? type '?) - kernel - (lambda all - (fluid-let ((*immediate-type* type)) - (apply kernel all)))))) + (make-database-transformer + (mapcan (lambda (rule) + (apply + (lambda (pattern variables categories expression) + (if (memq category categories) + (list (early-make-rule pattern variables expression)) + '())) + rule)) + early-ea-database))) ;;;; Early effective address assembly. @@ -125,18 +117,22 @@ MIT in each case. |# (MAKE-EFFECTIVE-ADDRESS ',keyword ',categories - ,(process-fields fields)))))))) + ,(process-fields fields true)))))))) rule)) rules))))) + +;; This is super hairy because of immediate operands! +;; The index 2 here is the argument number to MAKE-EFFECTIVE-ADDRESS. -(define (make-ea-selector-expander late-name index) +(define ea-value-expander ((access scode->scode-expander package/expansion package/scode-optimizer) (lambda (operands if-expanded if-not-expanded) (define (default) - (if-expanded (scode/make-combination (scode/make-variable late-name) - operands))) + (if-expanded (scode/make-combination (scode/make-variable 'EA-VALUE) + (cdr operands)))) - (let ((operand (car operands))) + (let ((operand (cadr operands)) + (type (car operands))) (if (not (scode/combination? operand)) (default) (scode/combination-components @@ -146,10 +142,34 @@ MIT in each case. |# (not (eq? (scode/variable-name operator) 'MAKE-EFFECTIVE-ADDRESS))) (default) - (if-expanded (list-ref operands index)))))))))) - -;; The indeces here are the argument number to MAKE-EFFECTIVE-ADDRESS. - -(define ea-keyword-expander (make-ea-selector-expander 'EA-KEYWORD 0)) -(define ea-categories-expander (make-ea-selector-expander 'EA-CATEGORIES 1)) -(define ea-value-expander (make-ea-selector-expander 'EA-VALUE 2)) + (if-expanded + (scode/make-combination + (scode/make-lambda lambda-tag:let + '(*IMMEDIATE-TYPE*) + '() + false + '() + '((INTEGRATE *IMMEDIATE-TYPE*)) + (list-ref operands 2)) + (list type))))))))))) + +(define coerce-to-type-expander + ((access scode->scode-expander package/expansion package/scode-optimizer) + (lambda (operands if-expanded if-not-expanded) + (define (handle coercion name) + (if-expanded + (if (scode/constant? (car operands)) + (scode/make-constant + (coercion (scode/constant-value (car operands)))) + (scode/make-combination (scode/make-variable name) + (list (car operands)))))) + + (if (not (scode/constant? (cadr operands))) + (if-not-expanded) + (case (scode/constant-value (cadr operands)) + ((b) (handle coerce-8-bit-signed 'coerce-8-bit-signed)) + ((w) (handle coerce-16-bit-signed 'coerce-16-bit-signed)) + ((b) (handle coerce-32-bit-signed 'coerce-32-bit-signed)) + (else (if-not-expanded))))))) + + diff --git a/v7/src/compiler/machines/vax/insmac.scm b/v7/src/compiler/machines/vax/insmac.scm index 7cd4dba09..1cc128bec 100644 --- a/v7/src/compiler/machines/vax/insmac.scm +++ b/v7/src/compiler/machines/vax/insmac.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$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 $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/insmac.scm,v 1.9 1987/08/23 07:56:16 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -82,16 +82,15 @@ MIT in each case. |# (define (process-fields fields early?) (if (and (null? (cdr fields)) (eq? (caar fields) 'VARIABLE-WIDTH)) - (expand-variable-width (car fields) - (if early? 'EA-VALUE-EARLY 'EA-VALUE)) + (expand-variable-width (car fields) early?) (expand-fields fields - (if early? 'EA-VALUE-EARLY 'EA-VALUE) + early? (lambda (code size) (if (not (zero? (remainder size 8))) (error "process-fields: bad syllable size" size)) code)))) -(define (expand-variable-width field ea-value-operator) +(define (expand-variable-width field early?) (let ((binding (cadr field)) (clauses (cddr field))) `(LIST @@ -101,17 +100,17 @@ MIT in each case. |# (map (lambda (clause) (expand-fields (cdr clause) - ea-value-operator + early? (lambda (code size) (if (not (zero? (remainder size 8))) (error "expand-variable-width: bad clause size" size)) `(,code ,size ,@(car clause))))) clauses))))) -(define (expand-fields fields ea-value-operator receiver) +(define (expand-fields fields early? receiver) (if (null? fields) (receiver ''() 0) - (expand-fields (cdr fields) ea-value-operator + (expand-fields (cdr fields) early? (lambda (tail tail-size) (case (caar fields) ((BYTE) @@ -120,9 +119,13 @@ MIT in each case. |# (lambda (code size) (receiver code (+ size tail-size))))) ((OPERAND) - (receiver `(APPEND-SYNTAX! (,ea-value-operator ,(caddar fields)) - ,tail) - tail-size)) + (receiver + `(APPEND-SYNTAX! + ,(if early? + `(EA-VALUE-EARLY '(cadar fields) ,(caddar fields)) + `(EA-VALUE ,(caddar fields))) + ,tail) + tail-size)) ((DISPLACEMENT) (let ((desc (cadar fields))) (let ((expression (cadr desc)) -- 2.25.1