From 65aadc9cfcbc33d46c4496414626ba78a54e23ad Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Thu, 30 Jul 1987 07:10:59 +0000 Subject: [PATCH] Make the compiler handle 32 bit offsets. --- v7/src/compiler/back/bittop.scm | 6 +- v7/src/compiler/back/bitutl.scm | 16 +- v7/src/compiler/back/syntax.scm | 61 ++++--- v7/src/compiler/machines/bobcat/inerly.scm | 150 ++++++++++++------ v7/src/compiler/machines/bobcat/insmac.scm | 115 ++++++++++---- v7/src/compiler/machines/bobcat/instr1.scm | 24 ++- v7/src/compiler/machines/bobcat/instr2.scm | 16 +- v7/src/compiler/machines/bobcat/instr3.scm | 17 +- v7/src/compiler/machines/bobcat/insutl.scm | 57 ++++--- v7/src/compiler/machines/bobcat/lapgen.scm | 10 +- .../compiler/machines/bobcat/make.scm-68040 | 6 +- v7/src/compiler/machines/bobcat/rules3.scm | 8 +- 12 files changed, 320 insertions(+), 166 deletions(-) diff --git a/v7/src/compiler/back/bittop.scm b/v7/src/compiler/back/bittop.scm index 47cc424b4..245bfcce1 100644 --- a/v7/src/compiler/back/bittop.scm +++ b/v7/src/compiler/back/bittop.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/bittop.scm,v 1.3 1987/07/22 17:14:09 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/bittop.scm,v 1.4 1987/07/30 07:05:13 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -402,5 +402,5 @@ MIT in each case. |# (define (list->bit-string l) (if (null? (cdr l)) (car l) - (bit-string-append (car l) - (list->bit-string (cdr l))))) \ No newline at end of file + (bit-string-append (list->bit-string (cdr l)) + (car l)))) \ No newline at end of file diff --git a/v7/src/compiler/back/bitutl.scm b/v7/src/compiler/back/bitutl.scm index fa38f0935..3c5ca1130 100644 --- a/v7/src/compiler/back/bitutl.scm +++ b/v7/src/compiler/back/bitutl.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/bitutl.scm,v 1.2 1987/07/22 17:14:31 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/bitutl.scm,v 1.3 1987/07/30 07:05:24 jinx Rel $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -213,24 +213,24 @@ MIT in each case. |# (and (or (false? low) (<= low val)) (or (false? high) (<= val high))))) -(declare (integrate-operator selector/low selector/high +(declare (integrate-operator selector/high selector/low selector/handler selector/length)) -(define (selector/low sel) +(define (selector/high sel) (declare (integrate sel)) - (vector-ref sel 0)) + (vector-ref sel 3)) -(define (selector/high sel) +(define (selector/low sel) (declare (integrate sel)) - (vector-ref sel 1)) + (vector-ref sel 2)) (define (selector/length sel) (declare (integrate sel)) - (vector-ref sel 2)) + (vector-ref sel 1)) (define (selector/handler sel) (declare (integrate sel)) - (vector-ref sel 3)) + (vector-ref sel 0)) ;;;; Random utilities diff --git a/v7/src/compiler/back/syntax.scm b/v7/src/compiler/back/syntax.scm index 96fc42491..2584a38e1 100644 --- a/v7/src/compiler/back/syntax.scm +++ b/v7/src/compiler/back/syntax.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syntax.scm,v 1.17 1987/07/22 17:15:00 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syntax.scm,v 1.18 1987/07/30 07:05:33 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -45,6 +45,20 @@ MIT in each case. |# directives) (cons directive directives))) +(define (append-syntax! directives1 directives2) + (cond ((null? directives1) directives2) + ((null? directives2) directives1) + (else + (let ((tail (last-pair directives1))) + (if (and (bit-string? (car tail)) + (bit-string? (car directives2))) + (begin + (set-car! tail + (bit-string-append (car directives2) (car tail))) + (set-cdr! tail (cdr directives2))) + (set-cdr! tail directives2)) + directives1)))) + (define-export (lap:syntax-instruction instruction) (if (memq (car instruction) '(EQUATE SCHEME-OBJECT ENTRY-POINT LABEL)) (directive->instruction-sequence instruction) @@ -74,12 +88,13 @@ MIT in each case. |# (let ((coercion (make-coercion-name coercion-type size))) (if (integer? expression) `',((lexical-reference coercion-environment coercion) expression) - `(SYNTAX-EVALUATION ,expression ,coercion)))) + `(SYNTAX-EVALUATION ,expression ,coercion)))) (define (syntax-evaluation expression coercion) - (if (integer? expression) - (coercion expression) - (list 'EVALUATION expression (coercion-size coercion) coercion))) + (cond ((integer? expression) + (coercion expression)) + (else + (list 'EVALUATION expression (coercion-size coercion) coercion)))) (define (optimize-group . components) (optimize-group-internal components @@ -132,34 +147,30 @@ MIT in each case. |# (cond ((null? clauses) (error "choose-clause: value out of range" value)) - ((in-range? value (caar clauses) (cadar clauses)) + ((in-range? value (caddr (car clauses)) (cadddr (car clauses))) (car clauses)) - (else (choose-clause (cdr clauses))))) + (else (choose-clause value (cdr clauses))))) (define (variable-width-expression-syntaxer name expression clauses) (if (integer? expression) (let ((chosen (choose-clause expression clauses))) - `(let ((,name ,expression)) - (declare (integrate ,name)) - ,(cadddr chosen))) - `(LIST - (SYNTAX-VARIABLE-WIDTH-EXPRESSION - ,expression - (LIST - ,@(map (LAMBDA (clause) - `(LIST ,(car clause) - ,(cadr clause) - ,(caddr clause) - (LAMBDA (,name) - ,(cadddr clause)))) - clauses)))))) + `(LET ((,name ,expression)) + (DECLARE (INTEGRATE ,name)) + (CAR ,(car chosen)))) + `(SYNTAX-VARIABLE-WIDTH-EXPRESSION + ,expression + (LIST + ,@(map (LAMBDA (clause) + `(CONS (LAMBDA (,name) ,(car clause)) + ',(cdr clause))) + clauses))))) (define (syntax-variable-width-expression expression clauses) (if (integer? expression) (let ((chosen (choose-clause expression clauses))) - ((cadddr chosen) expression)) - (cons* 'VARIABLE-WIDTH-EXPRESSION - expression - clauses))) + (car ((car chosen) expression))) + `(VARIABLE-WIDTH-EXPRESSION + ,expression + ,@clauses))) ;;;; Coercion Machinery diff --git a/v7/src/compiler/machines/bobcat/inerly.scm b/v7/src/compiler/machines/bobcat/inerly.scm index de88dbbc8..66df50537 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.3 1987/07/22 17:16:22 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/inerly.scm,v 1.4 1987/07/30 07:08:36 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -36,6 +36,8 @@ MIT in each case. |# (declare (usual-integrations)) +;;;; Transformers and utilities + (define early-instructions '()) (define early-transformers '()) @@ -45,6 +47,38 @@ MIT in each case. |# (cons (cons name transformer) early-transformers))) +(define (make-ea-transformer #!optional modes keywords) + (make-database-transformer + (mapcan (lambda (rule) + (apply + (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)))) + +(syntax-table-define early-syntax-table 'DEFINE-EA-TRANSFORMER + (macro (name . restrictions) + `(define-early-transformer ',name (apply make-ea-transformer ',restrictions)))) + +(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)))) + +;;;; Instruction and addressing mode macros + (syntax-table-define early-syntax-table 'DEFINE-INSTRUCTION (macro (opcode . patterns) `(set! early-instructions @@ -76,17 +110,16 @@ MIT in each case. |# (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)))) +(syntax-table-define early-syntax-table 'VARIABLE-EXTENSION + (macro (binding . clauses) + (variable-width-expression-syntaxer + (car binding) + (cadr binding) + (map (lambda (clause) + `((LIST ,(caddr clause)) + ,(cadr clause) ; Size + ,@(car clause))) ; Range + clauses)))) ;;;; Early effective address assembly. @@ -97,27 +130,9 @@ MIT in each case. |# `(define early-ea-database (list ,@(map (lambda (rule) - (apply (lambda (pattern categories mode register . extension) - (let ((keyword (car pattern))) - `(early-parse-rule - ',pattern - (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)) + (if (null? (cdddr rule)) + (apply make-position-dependent-early rule) + (apply make-position-independent-early rule))) rules))))) (define (make-ea-selector-expander late-name index) @@ -145,22 +160,53 @@ MIT in each case. |# (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 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)))) + +;;;; Utilities + +(define (make-position-independent-early pattern categories mode register . extension) + (let ((keyword (car pattern))) + `(early-parse-rule + ',pattern + (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))))))) + +(define (make-position-dependent-early pattern categories code-list) + (let ((keyword (car pattern)) + (code (cdr code-list))) + (let ((name (car code)) + (mode (cadr code)) + (register (caddr code)) + (extension (cadddr code))) + `(EARLY-PARSE-RULE + ',pattern + (LAMBDA (PAT VARS) + (LIST PAT + VARS + ',categories + (SCODE-QUOTE + (LET ((,name (GENERATE-LABEL 'MARK))) + (MAKE-EFFECTIVE-ADDRESS + ',keyword + ,(process-ea-field mode) + ,(process-ea-field register) + (LAMBDA (IMMEDIATE-SIZE INSTRUCTION-TAIL) + (DECLARE (INTEGRATE IMMEDIATE-SIZE INSTRUCTION-TAIL)) + ,(if (null? extension) + 'INSTRUCTION-TAIL + `(CONS (LIST 'LABEL ,name) + (CONS-SYNTAX ,extension INSTRUCTION-TAIL)))) + ',categories))))))))) \ No newline at end of file diff --git a/v7/src/compiler/machines/bobcat/insmac.scm b/v7/src/compiler/machines/bobcat/insmac.scm index 0fb264e91..00b3b429a 100644 --- a/v7/src/compiler/machines/bobcat/insmac.scm +++ b/v7/src/compiler/machines/bobcat/insmac.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/insmac.scm,v 1.122 1987/07/22 17:16:31 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/insmac.scm,v 1.123 1987/07/30 07:08:55 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -45,21 +45,9 @@ MIT in each case. |# `(define ,ea-database-name ,(compile-database rules (lambda (pattern actions) - (let ((keyword (car pattern)) - (categories (car actions)) - (mode (cadr actions)) - (register (caddr actions)) - (extension (cdddr actions))) - ;;(declare (integrate keyword categories mode register extension)) - `(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))))))) + (if (null? (cddr actions)) + (make-position-dependent pattern actions) + (make-position-independent pattern actions))))))) (syntax-table-define assembler-syntax-table 'EXTENSION-WORD (macro descriptors @@ -71,6 +59,67 @@ MIT in each case. |# (optimize-group-syntax instruction false) (error "EXTENSION-WORD: Extensions must be 16 bit multiples" size))))))) + +(syntax-table-define assembler-syntax-table 'VARIABLE-EXTENSION + (macro (binding . clauses) + (variable-width-expression-syntaxer + (car binding) + (cadr binding) + (map (lambda (clause) + `((LIST ,(caddr clause)) + ,(cadr clause) + ,@(car clause))) + clauses)))) + +(define (make-position-independent pattern actions) + (let ((keyword (car pattern)) + (categories (car actions)) + (mode (cadr actions)) + (register (caddr actions)) + (extension (cdddr actions))) + ;;(declare (integrate keyword categories mode register extension)) + `(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))) + +(define (process-ea-field field) + (if (integer? field) (integer-syntaxer field 'UNSIGNED 3) + (let ((binding (cadr field)) + (clauses (cddr field))) + (variable-width-expression-syntaxer + (car binding) + (cadr binding) + (map (lambda (clause) + `((LIST ,(integer-syntaxer (cadr clause) 'UNSIGNED 3)) + 3 + ,@(car clause))) + clauses))))) + +(define (make-position-dependent pattern actions) + (let ((keyword (car pattern)) + (categories (car actions)) + (code (cdr (cadr actions)))) + (let ((name (car code)) + (mode (cadr code)) + (register (caddr code)) + (extension (cadddr code))) + `(LET ((,name (GENERATE-LABEL 'MARK))) + (make-effective-address + ',keyword + ,(process-ea-field mode) + ,(process-ea-field register) + (LAMBDA (IMMEDIATE-SIZE INSTRUCTION-TAIL) + ,(if (null? extension) + 'INSTRUCTION-TAIL + `(CONS (LIST 'LABEL ,name) + (CONS-SYNTAX ,extension INSTRUCTION-TAIL)))) + ',categories))))) ;;;; Transformers @@ -148,23 +197,23 @@ MIT in each case. |# (if (not (null? tail)) (error "PARSE-GROWING-WORD: non null tail" tail)) (let ((binding (cadr expression))) - (variable-width-expression-syntaxer - (car binding) - (cadr binding) - (map (lambda (clause) - (if (not (null? (cddr clause))) - (error "PARSE-GROWING-WORD: Extension found in clause" clause)) - (expand-descriptors - (cdadr clause) - (lambda (instruction size src dst) - (if (not (zero? (remainder size 16))) - (error "PARSE-GROWING-WORD: Instructions must be 16 bit multiples" - size) - (list (caar clause) ; Range low - (cadar clause) ; Range high - size ; Width in bits - (collect-word instruction src dst '())))))) - (cddr expression))))) + `(LIST + ,(variable-width-expression-syntaxer + (car binding) + (cadr binding) + (map (lambda (clause) + (if (not (null? (cddr clause))) + (error "PARSE-GROWING-WORD: Extension found in clause" clause)) + (expand-descriptors + (cdadr clause) + (lambda (instruction size src dst) + (if (not (zero? (remainder size 16))) + (error "PARSE-GROWING-WORD: Instructions must be 16 bit multiples" + size) + `(,(collect-word instruction src dst '()) + ,size + ,@(car clause)))))) ; Range + (cddr expression)))))) ;;;; Fixed width instruction parsing diff --git a/v7/src/compiler/machines/bobcat/instr1.scm b/v7/src/compiler/machines/bobcat/instr1.scm index d3a1fddca..0d39b6389 100644 --- a/v7/src/compiler/machines/bobcat/instr1.scm +++ b/v7/src/compiler/machines/bobcat/instr1.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr1.scm,v 1.64 1987/07/21 18:34:34 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr1.scm,v 1.65 1987/07/30 07:09:17 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -79,7 +79,7 @@ MIT in each case. |# (DATA MEMORY CONTROL) #b111 #b010 (output-16bit-offset o)) - ((@PCR (? l)) + ((@PCR.W (? l)) (DATA MEMORY CONTROL) #b111 #b010 (output-16bit-relative l)) @@ -166,7 +166,25 @@ MIT in each case. |# (DATA MEMORY CONTROL) #b111 #b011 (output-full-format-extension-word xtype xr xsz factor pcs irs bdtype `(- ,bd *PC*) - memtype odtype od))) + memtype odtype od)) + +;;; Optimized addressing modes. +;;; Only a subset of those that can be optimized. + + ((@PCR (? l)) + (DATA MEMORY CONTROL) + (POSITION-DEPENDENT label + #b111 + (FIELD (offset `(- ,l ,label)) + ((-32768 32767) #b010) + ((() ()) #b011)) + (VARIABLE-EXTENSION (offset `(- ,l ,label)) + ((-32768 32767) + 16 + (EXTENSION-WORD (16 offset SIGNED))) + ((() ()) + 48 + (output-32bit-offset offset)))))) ;;;; Effective address transformers (restrictions) diff --git a/v7/src/compiler/machines/bobcat/instr2.scm b/v7/src/compiler/machines/bobcat/instr2.scm index b8b6c6cd8..0e85d3e79 100644 --- a/v7/src/compiler/machines/bobcat/instr2.scm +++ b/v7/src/compiler/machines/bobcat/instr2.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr2.scm,v 1.11 1987/07/17 15:48:53 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr2.scm,v 1.12 1987/07/30 07:09:32 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -41,7 +41,19 @@ MIT in each case. |# (define-instruction DC ((W (? expression)) - (WORD (16 expression SIGNED)))) + (WORD (16 expression SIGNED))) + + ((L (? expression)) + (WORD (32 expression SIGNED))) + + ((O (? expression)) + (GROWING-WORD + (offset expression) + ((0 65535) + (WORD (16 offset))) + ;; Always non-negative + ((0 ()) + (WORD (32 (1+ offset))))))) ;;;; BCD Arithmetic diff --git a/v7/src/compiler/machines/bobcat/instr3.scm b/v7/src/compiler/machines/bobcat/instr3.scm index a26121fcc..6db2df6e4 100644 --- a/v7/src/compiler/machines/bobcat/instr3.scm +++ b/v7/src/compiler/machines/bobcat/instr3.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr3.scm,v 1.13 1987/07/22 17:16:43 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/instr3.scm,v 1.14 1987/07/30 07:09:49 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -39,13 +39,16 @@ MIT in each case. |# ;;;; Control Transfer: Branch instructions -;; The size U (unknown, undecided?) means that the assembler should -;; choose the right size. +;; No size suffix means that the assembler should choose the right +;; size offset. ;; When the displacement goes to 0, a NOP is issued. ;; The instruction is hard to remove because of the workings of the -;; branch tensioner. Note that the NOP ``kludge'' is not correct for -;; the BSR instruction. +;; branch tensioner. + +;; Note that this NOP ``kludge'' is not correct for the BSR +;; instruction, but doing a BSR to the following instruction is even +;; stranger than branching to the following instruction. (let-syntax ((define-branch-instruction @@ -81,7 +84,7 @@ MIT in each case. |# (8 #b11111111)) (relative-long l)) - ((,@prefix U (@PCO (? o))) + ((,@prefix (@PCO (? o))) (GROWING-WORD (disp o) ((0 0) (WORD (16 #b0100111001110001))) ; NOP @@ -97,7 +100,7 @@ MIT in each case. |# (8 #b11111111) (32 disp SIGNED))))) - ((,@prefix U (@PCR (? l))) + ((,@prefix (@PCR (? l))) (GROWING-WORD (disp `(- ,l (+ *PC* 2))) ((0 0) (WORD (16 #b0100111001110001))) ; NOP diff --git a/v7/src/compiler/machines/bobcat/insutl.scm b/v7/src/compiler/machines/bobcat/insutl.scm index f195cd9a6..be05d9b62 100644 --- a/v7/src/compiler/machines/bobcat/insutl.scm +++ b/v7/src/compiler/machines/bobcat/insutl.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/insutl.scm,v 1.4 1987/07/21 18:34:47 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/insutl.scm,v 1.5 1987/07/30 07:10:09 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -152,26 +152,28 @@ MIT in each case. |# memory-indirection-type outer-displacement-size outer-displacement) - (EXTENSION-WORD (1 index-register-type) - (3 index-register) - (1 index-size) - (2 factor SCALE-FACTOR) - (1 #b1) - (1 base-suppress) - (1 index-suppress) - (2 base-displacement-size) - (1 #b0) - (3 (case memory-indirection-type - ((#F) - #b000) - ((PRE) - outer-displacement-size) - ((POST) - (+ #b100 outer-displacement-size)) - (else - "bad memory indirection-type" memory-indirection-type)))) - (output-displacement base-displacement-size base-displacement) - (output-displacement outer-displacement-size outer-displacement)) + (append-syntax! + (EXTENSION-WORD (1 index-register-type) + (3 index-register) + (1 index-size) + (2 factor SCALE-FACTOR) + (1 #b1) + (1 base-suppress) + (1 index-suppress) + (2 base-displacement-size) + (1 #b0) + (3 (case memory-indirection-type + ((#F) + #b000) + ((PRE) + outer-displacement-size) + ((POST) + (+ #b100 outer-displacement-size)) + (else + (error "bad memory indirection-type" memory-indirection-type))))) + (append-syntax! + (output-displacement base-displacement-size base-displacement) + (output-displacement outer-displacement-size outer-displacement)))) (define (output-displacement size displacement) (case size @@ -206,6 +208,19 @@ MIT in each case. |# (1 #b0) (3 #b000) ;no memory indirection (16 displacement SIGNED))) + +(define (output-32bit-offset offset) + (EXTENSION-WORD (1 #b0) ;index register = data + (3 #b000) ;register number = 0 + (1 #b0) ;index size = 32 bits + (2 #b00) ;scale factor = 1 + (1 #b1) + (1 #b0) ;use base register + (1 #b1) ;suppress index register + (2 #b11) ;base displacement size = 32 bits + (1 #b0) + (3 #b000) ;no memory indirection + (32 offset SIGNED))) ;;;; Operand Syntaxers. diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm index 7678bdde2..00e6925b1 100644 --- a/v7/src/compiler/machines/bobcat/lapgen.scm +++ b/v7/src/compiler/machines/bobcat/lapgen.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 1.186 1987/07/16 10:10:29 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 1.187 1987/07/30 07:10:24 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -145,9 +145,9 @@ MIT in each case. |# (define (set-standard-branches! cc) (set-current-branches! (lambda (label) - (LAP (B ,cc U (@PCR ,label)))) + (LAP (B ,cc (@PCR ,label)))) (lambda (label) - (LAP (B ,(invert-cc cc) U (@PCR ,label)))))) + (LAP (B ,(invert-cc cc) (@PCR ,label)))))) (define (invert-cc cc) (cdr (or (assq cc @@ -251,13 +251,13 @@ MIT in each case. |# (INST (LABEL ,label))) (define-export (lap:make-unconditional-branch label) - (INST (BRA U (@PCR ,label)))) + (INST (BRA (@PCR ,label)))) (define-export (lap:make-entry-point label block-start-label) (set! compiler:external-labels (cons label compiler:external-labels)) (LAP (ENTRY-POINT ,label) - (DC W (- ,label ,block-start-label)) + (DC O (- ,label ,block-start-label)) (LABEL ,label))) ;;;; Registers/Entries diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040 index 619dee4ed..ac83525f6 100644 --- a/v7/src/compiler/machines/bobcat/make.scm-68040 +++ b/v7/src/compiler/machines/bobcat/make.scm-68040 @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.36 1987/07/22 17:17:01 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.37 1987/07/30 07:10:47 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -46,11 +46,11 @@ MIT in each case. |# (make-environment (define :name "Liar (Bobcat 68020)") (define :version 1) - (define :modification 36) + (define :modification 37) (define :files) ; (parse-rcs-header -; "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.36 1987/07/22 17:17:01 jinx Exp $" +; "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.37 1987/07/30 07:10:47 jinx Exp $" ; (lambda (filename version date time zone author state) ; (set! :version (car version)) ; (set! :modification (cadr version)))) diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm index dc6a0035e..5d7d57dbc 100644 --- a/v7/src/compiler/machines/bobcat/rules3.scm +++ b/v7/src/compiler/machines/bobcat/rules3.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 1.11 1987/07/21 01:40:20 mhwu Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 1.12 1987/07/30 07:10:59 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -67,7 +67,7 @@ MIT in each case. |# (QUALIFIER (not (memq (car prefix) '(APPLY-CLOSURE APPLY-STACK)))) (disable-frame-pointer-offset! (LAP ,@(generate-invocation-prefix prefix '()) - (BRA U (@PCR ,label))))) + (BRA (@PCR ,label))))) (define-rule statement (INVOCATION:LEXPR (? number-pushed) (? prefix) (? continuation) @@ -75,7 +75,7 @@ MIT in each case. |# (disable-frame-pointer-offset! (LAP ,@(generate-invocation-prefix prefix '()) ,(load-dnw number-pushed 0) - (BRA U (@PCR ,label))))) + (BRA (@PCR ,label))))) (define-rule statement (INVOCATION:CACHE-REFERENCE (? frame-size) (? prefix) (? continuation) @@ -323,5 +323,5 @@ MIT in each case. |# (define (make-external-label label) (set! compiler:external-labels (cons label compiler:external-labels)) - (LAP (DC W (- ,label ,*block-start-label*)) + (LAP (DC O (- ,label ,*block-start-label*)) (LABEL ,label))) -- 2.25.1