From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Tue, 21 Jul 1987 18:34:56 +0000 (+0000)
Subject: Add new 68020 addressing modes.
X-Git-Tag: 20090517-FFI~13233
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2d01b3dec21dac28f6cc912c6aa8b6b56d157466;p=mit-scheme.git

Add new 68020 addressing modes.
---

diff --git a/v7/src/compiler/machines/bobcat/coerce.scm b/v7/src/compiler/machines/bobcat/coerce.scm
index be2d9d7c7..0afaf2fe3 100644
--- 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))))))
+
+;; *** 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 277902cd9..8931448a2 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.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 8cd76b22a..d3a1fddca 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.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))
-
-;;;; Effective Address transformers and description database
+
+;;; Effective Address description database
 
 (define-ea-database
+
   ((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))
-  
   ((@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))
+
+;;; 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*)))
+
+;;; 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)))
+
+;;;; 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 d5f0d6aeb..f195cd9a6 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.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))))
 
-;;; 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)))))
 
+;;;; 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 bd2f6675a..14d719e65 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.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))))