@RO -> @RO.B or @RO.W

diff --git a/v7/src/compiler/machines/i386/lapgen.scm b/v7/src/compiler/machines/i386/lapgen.scm
index 2b51918570ab28d19e5f2b0592b37ee6f8f81e76..05a4a735dabca3aeb1ef6825d05a009b58aa1732 100644 (file)
--- a/v7/src/compiler/machines/i386/lapgen.scm
+++ b/v7/src/compiler/machines/i386/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.6 1992/02/08 23:59:15 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.7 1992/02/11 14:47:53 jinx Exp $
 $MC68020-Header: /scheme/compiler/bobcat/RCS/lapgen.scm,v 4.42 1991/05/28 19:14:26 jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -156,9 +156,12 @@ MIT in each case. |#
   (byte-offset-reference register (* 4 offset)))
 
 (define (byte-offset-reference register offset)
-    (if (zero? offset)
-       (INST-EA (@R ,register))
-       (INST-EA (@RO ,register ,offset))))
+  (cond ((zero? offset)
+        (INST-EA (@R ,register)))
+       ((fits-in-signed-byte? offset)
+        (INST-EA (@RO B ,register ,offset)))
+       (else
+        (INST-EA (@RO W ,register ,offset)))))
 
 (define-integrable (pseudo-register-offset register)
   (+ (+ (* 16 4) (* 80 4))
@@ -240,12 +243,12 @@ MIT in each case. |#
 (define (load-pc-relative target label-expr)
   (with-pc
     (lambda (pc-label pc-register)
-      (LAP (MOV W ,target (@RO ,pc-register (- ,label-expr ,pc-label)))))))
+      (LAP (MOV W ,target (@RO W ,pc-register (- ,label-expr ,pc-label)))))))
 
 (define (load-pc-relative-address target label-expr)
   (with-pc
     (lambda (pc-label pc-register)
-      (LAP (LEA ,target (@RO ,pc-register (- ,label-expr ,pc-label)))))))  
+      (LAP (LEA ,target (@RO W ,pc-register (- ,label-expr ,pc-label)))))))  
 \f
 (define (with-pc recvr)
   (with-values (lambda () (get-cached-label))
@@ -361,26 +364,24 @@ MIT in each case. |#
 ;;;; Named registers, codes, and entries
 
 (define reg:compiled-memtop
-  #|
-  (INST-EA (@RO ,regnum:regs-pointer ,(* 4 register-block/memtop-offset)))
-  |#
-  (INST-EA (@R ,regnum:regs-pointer)))
+  (offset-reference regnum:regs-pointer
+                   register-block/memtop-offset))
 
 (define reg:environment
-  (INST-EA (@RO ,regnum:regs-pointer
-               ,(* 4 register-block/environment-offset))))
+  (offset-reference regnum:regs-pointer
+                   register-block/environment-offset))
 
 (define reg:dynamic-link
-  (INST-EA (@RO ,regnum:regs-pointer
-               ,(* 4 register-block/dynamic-link-offset))))
+  (offset-reference regnum:regs-pointer
+                   register-block/dynamic-link-offset))
 
 (define reg:lexpr-primitive-arity
-  (INST-EA (@RO ,regnum:regs-pointer
-               ,(* 4 register-block/lexpr-primitive-arity-offset))))
+  (offset-reference regnum:regs-pointer
+                   register-block/lexpr-primitive-arity-offset))
 
 (define reg:utility-arg-4
-  (INST-EA (@RO ,regnum:regs-pointer
-               ,(* 4 register-block/utility-arg4-offset))))
+  (offset-reference regnum:regs-pointer
+                   register-block/utility-arg4-offset))
 
 (let-syntax ((define-codes
               (macro (start . names)
@@ -421,7 +422,8 @@ MIT in each case. |#
                       (cons `(DEFINE-INTEGRABLE
                                ,(symbol-append 'ENTRY:COMPILER-
                                                (car names))
-                               (INST-EA (@RO ,regnum:regs-pointer ,index)))
+                               (byte-offset-reference regnum:regs-pointer
+                                                      ,index))
                             (loop (cdr names) (+ index 4)))))
                 `(BEGIN ,@(loop names start)))))
   (define-entries (* 16 4)

diff --git a/v7/src/compiler/machines/i386/rules1.scm b/v7/src/compiler/machines/i386/rules1.scm
index d2d1146ac6b53d10783b05b37b850286a9c7eab6..a62a5df67a0930ff2b40e61c7b83f4878c0dc151 100644 (file)
--- a/v7/src/compiler/machines/i386/rules1.scm
+++ b/v7/src/compiler/machines/i386/rules1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules1.scm,v 1.6 1992/01/30 14:07:46 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules1.scm,v 1.7 1992/02/11 14:48:05 jinx Exp $
 $MC68020-Header: /scheme/src/compiler/machines/bobcat/RCS/rules1.scm,v 4.36 1991/10/25 06:49:58 cph Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -283,7 +283,8 @@ MIT in each case. |#
 (define (load-pc-relative-address/typed target type label)
   (with-pc
     (lambda (pc-label pc-register)
-      (LAP (LEA ,target (@RO ,pc-register
+      (LAP (LEA ,target (@RO UW
+                            ,pc-register
                             (+ ,(make-non-pointer-literal type 0)
                                (- ,label ,pc-label))))))))
 

diff --git a/v7/src/compiler/machines/i386/rules3.scm b/v7/src/compiler/machines/i386/rules3.scm
index 62a66957526a534a6840f6ee6608a543645ed9c9..54ca32c88e840a356c805824f690db7325205b19 100644 (file)
--- a/v7/src/compiler/machines/i386/rules3.scm
+++ b/v7/src/compiler/machines/i386/rules3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.7 1992/02/05 17:18:36 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.8 1992/02/11 14:48:20 jinx Exp $
 $MC68020-Header: /scheme/compiler/bobcat/RCS/rules3.scm,v 4.31 1991/05/28 19:14:55 jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -41,7 +41,7 @@ MIT in each case. |#
 ;;;; Invocations
 
 (define-integrable (clear-continuation-type-code)
-  (LAP (AND W (@RO ,regnum:stack-pointer) (R ,regnum:datum-mask))))
+  (LAP (AND W (@R ,regnum:stack-pointer) (R ,regnum:datum-mask))))
 
 (define-rule statement
   (POP-RETURN)
@@ -90,7 +90,7 @@ MIT in each case. |#
   (with-pc
     (lambda (pc-label pc-register)
       (LAP ,@(clear-map!)
-          (LEA (R ,ecx) (@RO ,pc-register (- ,label ,pc-label)))
+          (LEA (R ,ecx) (@RO W ,pc-register (- ,label ,pc-label)))
           (MOV W (R ,edx) (& ,number-pushed))
           ,@(invoke-interface code:compiler-lexpr-apply)))))
 
@@ -262,7 +262,7 @@ MIT in each case. |#
          ((= frame-size 2)
           (let ((temp1 (temporary-register-reference))
                 (temp2 (temporary-register-reference)))
-            (LAP (MOV W ,temp2 (@RO 4 4))
+            (LAP (MOV W ,temp2 (@RO B 4 4))
                  (MOV W ,temp1 (@R 4))
                  (ADD W (R 4) (& ,(* 4 offset)))
                  (PUSH W ,temp2)
@@ -296,7 +296,8 @@ MIT in each case. |#
       (let ((temp (get-temp))
            (ctr (allocate-temporary-register! 'GENERAL))
            (label (generate-label 'MOVE-LOOP)))
-       (LAP (LEA (R ,reg) (@RO ,reg ,(* -4 frame-size)))
+       (LAP (LEA (R ,reg)
+                 ,(byte-offset-reference reg (* -4 frame-size)))
             (MOV W (R ,ctr) (& (-1+ frame-size)))
             (LABEL ,label)
             (MOV W ,temp (@RI 4 ,ctr 4))
@@ -432,17 +433,19 @@ MIT in each case. |#
         (MOV W (@R ,regnum:free-pointer)
              (&U ,(make-non-pointer-literal (ucode-type manifest-closure)
                                             (+ 4 size))))
-        (MOV W (@RO ,regnum:free-pointer 4)
+        (MOV W (@RO B ,regnum:free-pointer 4)
              (&U ,(make-closure-code-longword min max 8)))
-        (LEA ,target (@RO ,regnum:free-pointer 8))
-        (MOV B (@RO ,regnum:free-pointer 8) (&U #xe8)) ; (CALL (@PCR <entry>))
+        (LEA ,target (@RO B ,regnum:free-pointer 8))
+        ;; (CALL (@PCR <entry>))
+        (MOV B (@RO B ,regnum:free-pointer 8) (&U #xe8))
         (SUB W ,temp ,target)
-        (MOV L (@RO ,regnum:free-pointer 9) ,temp) ; displacement
+        (MOV L (@RO B ,regnum:free-pointer 9) ,temp) ; displacement
         (ADD W (R ,regnum:free-pointer) (& ,(* 4 (+ 5 size))))
-        (LEA ,temp (@RO ,target
+        (LEA ,temp (@RO UW
+                        ,target
                         ,(make-non-pointer-literal (ucode-type compiled-entry)
                                                    0)))
-        (MOV W (@RO ,regnum:free-pointer -4) ,temp))))
+        (MOV W (@RO B ,regnum:free-pointer -4) ,temp))))
 
 (define (generate/cons-multiclosure target nentries size entries)
   (let* ((target (target-register-reference))
@@ -452,16 +455,18 @@ MIT in each case. |#
        (define (generate-entries entries offset)
          (let ((entry (car entries))
                (rest (cdr entries)))
-           (LAP (MOV W (@RO ,regnum:free-pointer -9)
+           (LAP (MOV W (@RO B ,regnum:free-pointer -9)
                      (&U ,(make-closure-code-longword (cadr entry)
                                                       (caddr entry)
                                                       offset)))
-                (MOV B (@RO ,regnum:free-pointer -5) (&U #xe8))
-                (LEA ,temp (@RO ,pc-reg (- ,(rtl-procedure/external-label
-                                             (label->object (car entry)))
-                                           ,pc-label)))
+                (MOV B (@RO B ,regnum:free-pointer -5) (&U #xe8))
+                (LEA ,temp (@RO W
+                                ,pc-reg
+                                (- ,(rtl-procedure/external-label
+                                     (label->object (car entry)))
+                                   ,pc-label)))
                 (SUB W ,temp (R ,regnum:free-pointer))
-                (MOV W (@RO ,regnum:free-pointer -4) ,temp)
+                (MOV W (@RO B ,regnum:free-pointer -4) ,temp)
                 ,@(if (null? rest)
                       (LAP)
                       (LAP (ADD W (R ,regnum:free-pointer) 10)
@@ -471,18 +476,19 @@ MIT in each case. |#
                  (&U ,(make-non-pointer-literal
                        (ucode-type manifest-closure)
                        (+ size (quotient (* 5 (1+ nentries)) 2)))))
-            (MOV W (@RO ,regnum:free-pointer 4)
+            (MOV W (@RO B ,regnum:free-pointer 4)
                  (&U ,(make-closure-longword nentries 0)))
-            (LEA ,target (@RO ,regnum:free-pointer 12))
+            (LEA ,target (@RO B ,regnum:free-pointer 12))
             (ADD W (R ,regnum:free-pointer) (& 17))
             ,@(generate-entries entries 12)
             (ADD W (R ,regnum:free-pointer)
                  (& ,(+ (* 4 size) (if (odd? nentries) 7 5))))
             (LEA ,temp
-                 (@RO ,target
+                 (@RO UW
+                      ,target
                       ,(make-non-pointer-literal (ucode-type compiled-entry)
                                                  0)))
-            (MOV W (@RO ,regnum:free-pointer -4) ,temp))))))
+            (MOV W (@RO B ,regnum:free-pointer -4) ,temp))))))
 \f
 (define (generate/closure-header internal-label nentries entry)
   nentries                             ; ignored
@@ -557,9 +563,10 @@ MIT in each case. |#
           (lambda (pc-label prefix)
             (LAP ,@prefix
                  (MOV W (R ,ecx) ,reg:environment)
-                 (MOV W (@RO ,eax (- ,environment-label ,pc-label)) (R ,ecx))
-                 (LEA (R ,edx) (@RO ,eax (- ,*block-label* ,pc-label)))
-                 (LEA (R ,ebx) (@RO ,eax (- ,free-ref-label ,pc-label)))
+                 (MOV W (@RO W ,eax (- ,environment-label ,pc-label))
+                      (R ,ecx))
+                 (LEA (R ,edx) (@RO W ,eax (- ,*block-label* ,pc-label)))
+                 (LEA (R ,ebx) (@RO W ,eax (- ,free-ref-label ,pc-label)))
                  (MOV W ,reg:utility-arg-4 (& ,n-sections))
                  #|
                  (CALL ,entry:compiler-link)
@@ -575,11 +582,11 @@ MIT in each case. |#
   (pc->reg eax
           (lambda (pc-label prefix)
             (LAP ,@prefix
-                 (MOV W (R ,edx) (@RO ,eax (- ,code-block-label ,pc-label)))
+                 (MOV W (R ,edx) (@RO W ,eax (- ,code-block-label ,pc-label)))
                  (AND W (R ,edx) (R ,regnum:datum-mask))
-                 (LEA (R ,ebx) (@RO ,edx ,free-ref-offset))
+                 (LEA (R ,ebx) (@RO W ,edx ,free-ref-offset))
                  (MOV W (R ,ecx) ,reg:environment)
-                 (MOV W (@RO ,edx ,environment-offset) (R ,ecx))
+                 (MOV W (@RO W ,edx ,environment-offset) (R ,ecx))
                  (MOV W ,reg:utility-arg-4 (& ,n-sections))
                  #|
                  (CALL ,entry:compiler-link)

diff --git a/v7/src/compiler/machines/i386/rulflo.scm b/v7/src/compiler/machines/i386/rulflo.scm
index f01efc5f9599b4fce1d8e0dd5c1fca0829fcbd9a..a6bff6630443d01a14a7c8b12da4bc6bc1bbbf4b 100644 (file)
--- a/v7/src/compiler/machines/i386/rulflo.scm
+++ b/v7/src/compiler/machines/i386/rulflo.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulflo.scm,v 1.9 1992/02/08 23:08:01 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulflo.scm,v 1.10 1992/02/11 14:48:30 jinx Exp $
 $MC68020-Header: /scheme/src/compiler/machines/bobcat/RCS/rules1.scm,v 4.36 1991/10/25 06:49:58 cph Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -68,17 +68,19 @@ MIT in each case. |#
               ;; Value is in memory home
               (let ((off (pseudo-register-offset source))
                     (temp (temporary-register-reference)))
-                (LAP (MOV W ,target (@RO ,regnum:regs-pointer ,off))
-                     (MOV W ,temp (@RO ,regnum:regs-pointer ,(+ 4 off)))
-                     (MOV W (@RO ,regnum:free-pointer 4) ,target)
-                     (MOV W (@RO ,regnum:free-pointer 8) ,temp)))
+                (LAP (MOV W ,target
+                          ,(offset-reference regnum:regs-pointer off))
+                     (MOV W ,temp
+                          ,(offset-reference regnum:regs-pointer (1+ off)))
+                     (MOV W (@RO B ,regnum:free-pointer 4) ,target)
+                     (MOV W (@RO B ,regnum:free-pointer 8) ,temp)))
               (let ((sti (floreg->sti source)))
                 (if (zero? sti)
-                    (LAP (FST D (@RO ,regnum:free-pointer 4)))
+                    (LAP (FST D (@RO B ,regnum:free-pointer 4)))
                     (LAP (FLD (ST ,(floreg->sti source)))
-                         (FSTP D (@RO ,regnum:free-pointer 4))))))
+                         (FSTP D (@RO B ,regnum:free-pointer 4))))))
         (LEA ,target
-             (@RO ,regnum:free-pointer
+             (@RO UW ,regnum:free-pointer
                   ,(make-non-pointer-literal (ucode-type flonum) 0)))
         (ADD W (R ,regnum:free-pointer) (& 12)))))
 
@@ -88,7 +90,7 @@ MIT in each case. |#
   (let* ((source (move-to-temporary-register! source 'GENERAL))
         (target (flonum-target! target)))
     (LAP ,@(object->address source)
-        (FLD D (@RO ,source 4))
+        (FLD D (@RO B ,source 4))
         (FSTP (ST ,(1+ target))))))
 
 (define-rule statement
@@ -149,11 +151,11 @@ MIT in each case. |#
            ,@(if (and (zero? target) (zero? source))
                  (LAP)
                  (LAP (FLD (ST ,source))))
-           (MOV B ,temp (@RO ,regnum:free-pointer 1))
-           (OR B (@RO ,regnum:free-pointer 1) (&U #x0c))
+           (MOV B ,temp (@RO B ,regnum:free-pointer 1))
+           (OR B (@RO B ,regnum:free-pointer 1) (&U #x0c))
            (FNLDCW (@R ,regnum:free-pointer))
            (FRNDINT)
-           (MOV B (@RO ,regnum:free-pointer 1) ,temp)
+           (MOV B (@RO B ,regnum:free-pointer 1) ,temp)
            ,@(if (and (zero? target) (zero? source))
                  (LAP)
                  (LAP (FSTP (ST ,(1+ target)))))