Added knowledge of byte/char operations

diff --git a/v7/src/compiler/machines/bobcat/dassm2.scm b/v7/src/compiler/machines/bobcat/dassm2.scm
index 0abf66bccb55275bee3f2baa2cdb17393b06db1c..6b8b6c4bcf1d0a467531a938a7ef6ab60256ab3b 100644 (file)
--- a/v7/src/compiler/machines/bobcat/dassm2.scm
+++ b/v7/src/compiler/machines/bobcat/dassm2.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/dassm2.scm,v 4.3 1988/03/14 19:16:00 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/dassm2.scm,v 4.4 1988/05/10 19:53:08 mhwu Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -202,10 +202,7 @@ MIT in each case. |#
 (set! make-address-offset
   (lambda (register offset)
     (if disassembler/symbolize-output?
-       (or (and (= register interpreter-register-pointer)
-                (let ((entry (assq offset interpreter-register-assignments)))
-                  (and entry
-                       (cdr entry))))
+       (or (interpreter-register register offset)
            `(@AO ,(cdr (assq register address-register-assignments))
                  ,offset))
        `(@AO ,register ,offset))))
@@ -215,13 +212,25 @@ MIT in each case. |#
     (case (car effective-address)
       ((@AO)
        (and (= (cadr effective-address) interpreter-register-pointer)
-           (let ((entry
-                  (assq (caddr effective-address)
-                        interpreter-register-assignments)))
-             (and entry
-                  (cdr entry)))))
+           (intepreter-register interpreter-register-pointer
+                                (caddr effective-address))))
       ((REGISTER TEMPORARY ENTRY) effective-address)
       (else false))))
+
+(define (interpreter-register register offset)
+  (with-aligned-offset offset
+    (lambda (word-offset residue)
+      (and (= register interpreter-register-pointer)
+          (let ((entry (assq word-offset interpreter-register-assignments)))
+            (and entry
+                 (if (= residue 0)
+                     (cdr entry)
+                     `(,@(cdr entry) (,residue)))))))))
+
+(define (with-aligned-offset offset receiver)
+  (let ((q/r (integer-divide offset 4)))
+    (receiver (* (car q/r) 4) (cdr q/r))))
+
 \f
 (define interpreter-register-pointer
   6)

diff --git a/v7/src/compiler/machines/bobcat/dassm3.scm b/v7/src/compiler/machines/bobcat/dassm3.scm
index 66e9b753b50f4da5913b9fa87aec6db2386d75f9..422bf263ca17821fbb1c03edf4aa7a03a318d103 100644 (file)
--- a/v7/src/compiler/machines/bobcat/dassm3.scm
+++ b/v7/src/compiler/machines/bobcat/dassm3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/dassm3.scm,v 4.3 1988/04/15 02:22:34 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/dassm3.scm,v 4.4 1988/05/10 19:53:41 mhwu Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -105,7 +105,7 @@ MIT in each case. |#
                         (= (extract *ir 4 6) #b00))
                    %ADDX
                    %ADD)))
-         (lambda () shift/rotate)
+         (lambda () shift/rotate/bitop)
          undefined))
 \f
 ;;;; Operations
@@ -520,6 +520,11 @@ MIT in each case. |#
   `(EXG ,(make-address-register 'A (extract *ir 0 3))
        ,(make-data-register 'D (extract *ir 9 12))))
 
+(define (shift/rotate/bitop)
+  (if (= #b11 (extract *ir 6 8))
+      (bit-extract)
+      (shift-rotate)))
+
 (define (shift/rotate)
   (let ((size (decode-bwl (extract *ir 6 8)))
        (direction (decode-rl (extract *ir 8 9))))
@@ -535,6 +540,23 @@ MIT in each case. |#
                      (if (zero? n) 8 n)))
               `,(make-data-register 'D (extract *ir 9 12)))
          ,(make-data-register 'D (extract *ir 0 3))))))
+
+(define (bit-extract)
+  (let ((opcode (decode-bf (extract *ir 8 11)))
+       (source (decode-ea-m&d)))
+    (let ((extension (get-word)))
+      (let ((target (if (memq opcode '(BFEXTS BFEXTU BFFFO BFINS))
+                       `(,(make-data-register 'D
+                                              (extract extension 12 15)))
+                       '()))
+           (offset (if (= #b0 (extract extension 11 12))
+                       `(& ,(extract extension 6 11))
+                       (make-data-register 'D (extract extension 6 9))))
+           (width (if (= #b0 (extract extension 5 6))
+                      `(& ,(extract extension 0 5))
+                      (make-data-register 'D (extract extension 0 3)))))
+       `(,opcode ,source ,offset ,width ,@target)))))
+
 \f
 ;;;; Bit String Manipulation
 
@@ -579,6 +601,9 @@ MIT in each case. |#
 (define decode-shift-type (symbol-decoder #(AS LS ROX RO)))
 (define decode-ze  (symbol-decoder #(E Z)))
 
+(define decode-bf
+  (symbol-decoder #(BFTST BFEXTU BFCHG BFEXTS BFCLR BFFFO BFSET BFINS)))
+
 (define (decode-scale scale)
   (vector-ref '#(1 2 4 8) scale))
 \f
@@ -747,6 +772,21 @@ MIT in each case. |#
                       decode-ea-<@PCO>
                       decode-ea-<@PCOX>
                       decode-ea-<&>))
+
+(define decode-ea-m&d
+  (decode-ea-w/o-size decode-ea-<D>
+                     decode-ea-undefined
+                     decode-ea-<@A>
+                     decode-ea-undefined
+                     decode-ea-undefined
+                     decode-ea-<@AO>
+                     decode-ea-<@AOX>
+                     decode-ea-<W>
+                     decode-ea-<L>
+                     decode-ea-<@PCO>
+                     decode-ea-<@PCOX>
+                     decode-ea-undefined))
+                      
 \f
 (define decode-ea-c
   (decode-ea-w/o-size decode-ea-undefined