Add new 68020 addressing modes.

diff --git a/v7/src/compiler/machines/bobcat/coerce.scm b/v7/src/compiler/machines/bobcat/coerce.scm
index be2d9d7c7ea376d7ba46716e0629b3191ed3a270..0afaf2fe3452cf9d7c11d7c866ec7e3ceb437c8d 100644 (file)
--- a/v7/src/compiler/machines/bobcat/coerce.scm
+++ b/v7/src/compiler/machines/bobcat/coerce.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/coerce.scm,v 1.8 1987/07/17 15:40:20 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/coerce.scm,v 1.9 1987/07/21 18:34:10 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -58,6 +58,20 @@ MIT in each case. |#
           ((= w 32) 0)
           (else (error "Bad bit field width" w))))))
 
+(define coerce-index-scale
+  (standard-coercion
+   (lambda (sf)
+     (case sf
+       ((1) #b00)
+       ((2) #b01)
+       ((4) #b10)
+       ((8) #b11)
+       (else (error "Bad index scale" sf))))))
+\f
+;; *** NOTE ***
+;; If you add coercions here, remember to also add them to
+;; EXPAND-DESCRIPTOR in isnmac.scm .
+
 (define make-coercion
   (coercion-maker
    `((UNSIGNED . ,coerce-unsigned-integer)
@@ -65,7 +79,8 @@ MIT in each case. |#
      (QUICK . ,coerce-quick)
      (SHIFT-NUMBER . ,coerce-quick)
      (SHORT-LABEL . ,coerce-short-label)
-     (BFWIDTH . ,coerce-bit-field-width))))
+     (BFWIDTH . ,coerce-bit-field-width)
+     (SCALE-FACTOR . ,coerce-index-scale))))
 
 (define-coercion 'UNSIGNED 1)
 (define-coercion 'UNSIGNED 2)

diff --git a/v7/src/compiler/machines/bobcat/insmac.scm b/v7/src/compiler/machines/bobcat/insmac.scm
index 277902cd935ba264dea2004e86f700c84f01177b..8931448a2219a754b6bb5557e41f923605a00d02 100644 (file)
--- 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.120 1987/07/17 15:48:27 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/insmac.scm,v 1.121 1987/07/21 18:34:23 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -151,7 +151,7 @@ MIT in each case. |#
           (error "PARSE-WORD: Instructions must be 16 bit multiples" size)))))
   (if (or (unassigned? early?) (not early?))
       (kernel)
-      (with-early-selectors kernel)))     
+      (with-early-selectors kernel)))
 
 (define (expand-descriptors descriptors receiver)
   (if (null? descriptors)
@@ -195,7 +195,7 @@ MIT in each case. |#
        (coercion-type
         (if (null? (cddr descriptor)) 'UNSIGNED (caddr descriptor))))
     (case coercion-type
-      ((UNSIGNED SIGNED SHIFT-NUMBER QUICK BFWIDTH)
+      ((UNSIGNED SIGNED SHIFT-NUMBER QUICK BFWIDTH SCALE-FACTOR)
        (receiver `(,(integer-syntaxer expression coercion-type size))
                 size false false))
       ((SHORT-LABEL)

diff --git a/v7/src/compiler/machines/bobcat/instr1.scm b/v7/src/compiler/machines/bobcat/instr1.scm
index 8cd76b22a03dba17d7cc95f00222e3f05fa994e0..d3a1fddcaac0e062910977beb4471da4aa954110 100644 (file)
--- 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.63 1987/07/17 15:48:41 jinx Exp $
+$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 $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -36,20 +36,17 @@ MIT in each case. |#
 ;;; Originally from GJS (who did the hard part).
 
 (declare (usual-integrations))
-\f
-;;;; Effective Address transformers and description database
+
+;;; Effective Address description database
 
 (define-ea-database
+\f
   ((D (? r)) (DATA ALTERABLE) #b000 r)
 
   ((A (? r)) (ALTERABLE) #b001 r)
 
   ((@A (? r)) (DATA MEMORY CONTROL ALTERABLE) #b010 r)
 
-  ((@D (? r))
-   (DATA MEMORY CONTROL ALTERABLE) #b110 #b000
-   (output-@D-indirect r))
-
   ((@A+ (? r)) (DATA MEMORY ALTERABLE) #b011 r)
 
   ((@-A (? r)) (DATA MEMORY ALTERABLE) #b100 r)
@@ -62,10 +59,6 @@ MIT in each case. |#
    (DATA MEMORY CONTROL ALTERABLE) #b101 r
    (output-16bit-relative l))
 
-  ((@DO (? r) (? o))
-   (DATA MEMORY CONTROL ALTERABLE) #b110 #b000
-   (output-@DO-indirect r o))
-  \f
   ((@AOX (? r) (? o) (? xtype da) (? xr) (? s wl))
    (DATA MEMORY CONTROL ALTERABLE) #b110 r
    (output-offset-index-register xtype xr s o))
@@ -100,7 +93,82 @@ MIT in each case. |#
 
   ((& (? i))
    (DATA MEMORY) #b111 #b100
-   (output-immediate-data immediate-size i)))
+   (output-immediate-data immediate-size i))
+\f
+;;; 68020 only
+
+  ;; These are common special cases of the full extension word forms below
+
+  ((@D (? r))
+   (DATA MEMORY CONTROL ALTERABLE) #b110 #b000
+   (output-@D-indirect r))
+
+  ((@DO (? r) (? o))
+   (DATA MEMORY CONTROL ALTERABLE) #b110 #b000
+   (output-@DO-indirect r o))
+
+  ;; Brief format extension word addressing modes
+
+  ;; These 2 are like @AOX and @ARX but accept a scale factor.
+  ;; The index register is collected into a spec like ((D 4) L 2).
+
+  ((@AOXS (? r) (? l) (((? xtype da) (? xr)) (? s wl) (? factor)))
+   (DATA MEMORY CONTROL ALTERABLE) #b110 r
+   (output-brief-format-extension-word xtype xr s factor l))
+
+  ((@ARXS (? r) (? l) (((? xtype da) (? xr)) (? s wl) (? factor)))
+   (DATA MEMORY CONTROL ALTERABLE) #b110 r
+   (output-brief-format-extension-word xtype xr s factor `(- ,l *PC*)))
+
+  ;; Similarly for @PCOX and @PCRX.
+
+  ((@PCOXS (? o) (((? xtype da) (? xr)) (? s wl) (? factor)))
+   (DATA MEMORY CONTROL) #b111 #b011
+   (output-brief-format-extension-word xtype xr s factor o))
+
+  ((@PCRXS (? l) (((? xtype da) (? xr)) (? s wl) (? factor)))
+   (DATA MEMORY CONTROL) #b111 #b011
+   (output-brief-format-extension-word xtype xr s factor `(- ,l *PC*)))
+\f
+;;; Full format extension word addressing modes
+
+  ((@AOF (? r) (? brs ze)
+        ((? bd) (? bdtype nwl)) (? memtype)
+        (((? xtype da) (? xr)) (? xsz wl) (? factor)) (? irs ze)
+        ((? od) (? odtype nwl)))
+   (DATA MEMORY CONTROL ALTERABLE) #b110 r
+   (output-full-format-extension-word xtype xr xsz factor
+                                     brs irs bdtype bd
+                                     memtype odtype od))
+
+  ((@ARF (? r) (? brs ze)
+        ((? bd) (? bdtype nwl)) (? memtype)
+        (((? xtype da) (? xr)) (? xsz wl) (? factor)) (? irs ze)
+        ((? od) (? odtype nwl)))
+   (DATA MEMORY CONTROL ALTERABLE) #b110 r
+   (output-full-format-extension-word xtype xr xsz factor
+                                     brs irs bdtype `(- ,bd *PC*)
+                                     memtype odtype od))
+
+  ((@PCOF (? pcs ze)
+        ((? bd) (? bdtype nwl)) (? memtype)
+        (((? xtype da) (? xr)) (? xsz wl) (? factor)) (? irs ze)
+        ((? od) (? odtype nwl)))
+   (DATA MEMORY CONTROL) #b111 #b011
+   (output-full-format-extension-word xtype xr xsz factor
+                                     pcs irs bdtype bd
+                                     memtype odtype od))
+
+  ((@PCRF (? pcs ze)
+         ((? bd) (? bdtype nwl)) (? memtype)
+         (((? xtype da) (? xr)) (? xsz wl) (? factor)) (? irs ze)
+         ((? od) (? odtype nwl)))
+   (DATA MEMORY CONTROL) #b111 #b011
+   (output-full-format-extension-word xtype xr xsz factor
+                                     pcs irs bdtype `(- ,bd *PC*)
+                                     memtype odtype od)))
+\f
+;;;; Effective address transformers (restrictions)
 
 (define-ea-transformer ea-all)
 
@@ -132,7 +200,8 @@ MIT in each case. |#
 (define-symbol-transformer us    (U . 0) (S . 1))
 (define-symbol-transformer chkwl (W . 6) (L . 4))
 (define-symbol-transformer bwl+1 (B . 1) (W . 2) (L . 3))
-(define-symbol-transformer nwl-n (W . 2) (L . 3))
+(define-symbol-transformer wl+2  (W . 2) (L . 3))
+(define-symbol-transformer ze    (Z . 1) (E . 0))
 
 (define-symbol-transformer cc
   (T . 0) (F . 1) (HI . 2) (LS . 3) (HS . 4) (LO . 5)

diff --git a/v7/src/compiler/machines/bobcat/insutl.scm b/v7/src/compiler/machines/bobcat/insutl.scm
index d5f0d6aeb54ff2a9c4e5bc5f90cbdc48f38e1c27..f195cd9a6183738ad2d922094cd2c205f390e645 100644 (file)
--- 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.3 1987/07/17 15:49:20 jinx Exp $
+$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 $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -131,29 +131,22 @@ MIT in each case. |#
      (error "OUTPUT-IMMEDIATE-DATA: illegal immediate size"
            immediate-size))))
 \f
-;;; New stuff for 68020
-
-;; (? index-register-type da)
-;; (? index-size wl)
-;; (? scale-factor bwlq)
-;; (? base-displacement-size nwl)
-;; (? outer-displacement-size nwl)
-
-(define (output-brief-format-extension-word immediate-size
-                                           index-register-type index-register
-                                           index-size scale-factor
-                                           displacement)
+;;; Support for 68020 addressing modes
+
+(define-integrable (output-brief-format-extension-word
+                   index-register-type index-register
+                   index-size factor
+                   displacement)
   (EXTENSION-WORD (1 index-register-type)
                  (3 index-register)
                  (1 index-size)
-                 (2 scale-factor)
+                 (2 factor SCALE-FACTOR)
                  (1 #b0)
                  (8 displacement SIGNED)))
 
-(define (output-full-format-extension-word immediate-size
-                                          index-register-type index-register
-                                          index-size scale-factor
-                                          base-suppress? index-suppress?
+(define (output-full-format-extension-word index-register-type index-register
+                                          index-size factor
+                                          base-suppress index-suppress
                                           base-displacement-size
                                           base-displacement
                                           memory-indirection-type
@@ -162,17 +155,21 @@ MIT in each case. |#
   (EXTENSION-WORD (1 index-register-type)
                  (3 index-register)
                  (1 index-size)
-                 (2 scale-factor)
+                 (2 factor SCALE-FACTOR)
                  (1 #b1)
-                 (1 (if base-suppress? #b1 #b0))
-                 (1 (if index-suppress? #b1 #b0))
+                 (1 base-suppress)
+                 (1 index-suppress)
                  (2 base-displacement-size)
                  (1 #b0)
                  (3 (case memory-indirection-type
-                      ((#F) #b000)
-                      ((PRE) outer-displacement-size)
+                      ((#F)
+                       #b000)
+                      ((PRE)
+                       outer-displacement-size)
                       ((POST)
-                       (+ #b100 outer-displacement-size)))))
+                       (+ #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))
 
@@ -182,6 +179,8 @@ MIT in each case. |#
     ((2) (EXTENSION-WORD (16 displacement SIGNED)))
     ((3) (EXTENSION-WORD (32 displacement SIGNED)))))
 \f
+;;;; Common special cases
+
 (define-integrable (output-@D-indirect register)
   (EXTENSION-WORD (1 #b0)              ;index register = data
                  (3 register)

diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040
index bd2f6675a52381b855bf2efdcd37ab4bd6a8a198..14d719e654e751357803d10389f9535c205d0ff9 100644 (file)
--- 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.34 1987/07/17 19:33:08 mhwu Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.35 1987/07/21 18:34:56 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 34)
+      (define :modification 35)
       (define :files)
 
 ;      (parse-rcs-header
-;       "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.34 1987/07/17 19:33:08 mhwu Exp $"
+;       "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 1.35 1987/07/21 18:34:56 jinx Exp $"
 ;       (lambda (filename version date time zone author state)
 ;       (set! :version (car version))
 ;       (set! :modification (cadr version))))