From ee9dff4dd6a205e6019c7fcce11ed5b214385517 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Wed, 1 Jul 1987 21:02:47 +0000 Subject: [PATCH] Done with early assembly. --- v7/src/compiler/machines/bobcat/inerly.scm | 141 ++++++++++++++------- 1 file changed, 97 insertions(+), 44 deletions(-) diff --git a/v7/src/compiler/machines/bobcat/inerly.scm b/v7/src/compiler/machines/bobcat/inerly.scm index 26551173d..68215a020 100644 --- a/v7/src/compiler/machines/bobcat/inerly.scm +++ b/v7/src/compiler/machines/bobcat/inerly.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/inerly.scm,v 1.1 1987/06/25 10:24:04 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/inerly.scm,v 1.2 1987/07/01 21:02:47 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -38,6 +38,13 @@ MIT in each case. |# (define early-instructions '()) +(define early-transformers '()) + +(define (define-early-transformer name transformer) + (set! early-transformers + (cons (cons name transformer) + early-transformers))) + (syntax-table-define early-syntax-table 'DEFINE-INSTRUCTION (macro (opcode . patterns) `(set! early-instructions @@ -45,12 +52,45 @@ MIT in each case. |# ,@(map (lambda (pattern) `(early-parse-rule ',(car pattern) - (scode-quote - ,(parse-word (cadr pattern) - (cddr pattern))))) + (lambda (pat vars) + (early-make-rule + pat + vars + (scode-quote + (instruction->instruction-sequence + ,(parse-word (cadr pattern) + (cddr pattern) + true))))))) patterns)) early-instructions)))) +(syntax-table-define early-syntax-table 'EXTENSION-WORD + (macro descriptors + (expand-descriptors descriptors + (lambda (instruction size source destination) + (if (or source destination) + (error "Source or destination used" 'EXTENSION-WORD) + (if (zero? (remainder size 16)) + (optimize-group-syntax instruction true) + (error "EXTENSION-WORD: Extensions must be 16 bit multiples" + size))))))) + +(syntax-table-define early-syntax-table 'DEFINE-SYMBOL-TRANSFORMER + (macro (name . assoc) + `(define-early-transformer ',name (make-symbol-transformer ',assoc)))) + +(syntax-table-define early-syntax-table 'DEFINE-REG-LIST-TRANSFORMER + (macro (name . assoc) + `(define-early-transformer ',name (make-bit-mask-transformer 16 ',assoc)))) + +(syntax-table-define early-syntax-table 'DEFINE-EA-TRANSFORMER + (macro (name . restrictions) + `(define-early-transformer ',name (apply make-ea-transformer ',restrictions)))) + +;;;; Early effective address assembly. + +;;; *** NOTE: If this format changes, insutl.scm must also be changed! *** + (syntax-table-define early-syntax-table 'DEFINE-EA-DATABASE (macro rules `(define early-ea-database @@ -60,53 +100,66 @@ MIT in each case. |# (let ((keyword (car pattern))) `(early-parse-rule ',pattern - (list ',categories - (scode-quote - (MAKE-EFFECTIVE-ADDRESS - ',keyword - ,(integer-syntaxer mode 'UNSIGNED 3) - ,(integer-syntaxer register 'UNSIGNED 3) - (lambda (IMMEDIATE-SIZE INSTRUCTION-TAIL) - ,(if (null? extension) - 'INSTRUCTION-TAIL - `(CONS-SYNTAX ,(car extension) - INSTRUCTION-TAIL))) - ',categories)))))) + (lambda (pat vars) + (list pat + vars + ',categories + (scode-quote + (MAKE-EFFECTIVE-ADDRESS + ',keyword + ,(integer-syntaxer mode 'UNSIGNED 3) + ,(integer-syntaxer register 'UNSIGNED 3) + (lambda (IMMEDIATE-SIZE INSTRUCTION-TAIL) + (DECLARE (INTEGRATE IMMEDIATE-SIZE INSTRUCTION-TAIL)) + ,(if (null? extension) + 'INSTRUCTION-TAIL + `(CONS-SYNTAX ,(car extension) + INSTRUCTION-TAIL))) + ',categories))))))) rule)) rules))))) -(syntax-table-define early-syntax-table 'EXTENSION-WORD - (syntax-table-ref assembler-syntax-table 'EXTENSION-WORD)) - -(syntax-table-define early-syntax-table 'DEFINE-EA-TRANSFORMER - (macro (name . restrictions) - `(define-transformer ',name (apply make-ea-transformer ',restrictions)))) - -(syntax-table-define early-syntax-table 'DEFINE-SYMBOL-TRANSFORMER - (macro (name . assoc) - `(define-transformer ',name (make-symbol-transformer ',assoc)))) - -(syntax-table-define early-syntax-table 'DEFINE-REG-LIST-TRANSFORMER - (macro (name . assoc) - `(define-transformer ',name (make-bit-mask-transformer 16 ',assoc)))) - -;;;; Utility procedures - -(define (eq-subset? s1 s2) - (or (null? s1) - (and (memq (car s1) s2) - (eq-subset? (cdr s1) s2)))) +(define (make-ea-selector-expander late-name index) + ((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))) + + (let ((operand (car operands))) + (if (not (scode/combination? operand)) + (default) + (scode/combination-components operand + (lambda (operator operands) + (if (or (not (scode/variable? operator)) + (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-mode-expander (make-ea-selector-expander 'EA-MODE 1)) +(define ea-register-expander (make-ea-selector-expander 'EA-REGISTER 2)) +(define ea-extension-expander (make-ea-selector-expander 'EA-EXTENSION 3)) +(define ea-categories-expander (make-ea-selector-expander 'EA-CATEGORIES 4)) + +;;; Utility procedures (define (make-ea-transformer #!optional modes keywords) (make-database-transformer (mapcan (lambda (rule) (apply - (lambda (pattern variables extra) - (let ((categories (car extra)) - (expression (cadr extra))) - (if (and (or (unassigned? modes) (eq-subset? modes categories)) - (or (unassigned? keywords) (not (memq (car pattern) keywords)))) - (list (list pattern variables expression)) - '()))) + (lambda (pattern variables categories expression) + (if (and (or (unassigned? modes) (eq-subset? modes categories)) + (or (unassigned? keywords) (not (memq (car pattern) keywords)))) + (list (early-make-rule pattern variables expression)) + '())) rule)) early-ea-database))) + +(define (eq-subset? s1 s2) + (or (null? s1) + (and (memq (car s1) s2) + (eq-subset? (cdr s1) s2)))) -- 2.25.1