More changes.
authorGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Thu, 13 Feb 1992 06:40:36 +0000 (06:40 +0000)
committerGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Thu, 13 Feb 1992 06:40:36 +0000 (06:40 +0000)
v7/src/compiler/machines/i386/rules3.scm
v7/src/compiler/machines/i386/rulfix.scm
v7/src/compiler/machines/i386/rulrew.scm

index b798ca248fdf76bfe5f43d3e70e1e53595a4b344..5d2d0c0a3784f1d385e38efd2606eb330f7ad9cf 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.9 1992/02/13 03:18:38 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.10 1992/02/13 06:37:24 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
@@ -243,6 +243,7 @@ MIT in each case. |#
 
 (define-rule statement
   (INVOCATION-PREFIX:DYNAMIC-LINK 0 (REGISTER 4) (? any))
+  any                                  ; ignored
   (LAP))
 \f
 (define-rule statement
@@ -424,7 +425,7 @@ MIT in each case. |#
 ;; the last component of closures with any entry points.
 
 (define (generate/cons-closure target procedure-label min max size)
-  (let* ((target (target-register-reference))
+  (let* ((target (target-register-reference target))
         (temp (temporary-register-reference)))
     (LAP ,@(load-pc-relative-address
            temp
@@ -448,7 +449,7 @@ MIT in each case. |#
         (MOV W (@RO B ,regnum:free-pointer -4) ,temp))))
 
 (define (generate/cons-multiclosure target nentries size entries)
-  (let* ((target (target-register-reference))
+  (let* ((target (target-register-reference target))
         (temp (temporary-register-reference)))
     (with-pc
       (lambda (pc-label pc-reg)
index 30515bfc92d21d8d462b29c0058ad3905081688e..ea3ec9ac556bcdd08676806639fbc785f9ea6229 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulfix.scm,v 1.14 1992/02/13 06:37:13 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulfix.scm,v 1.15 1992/02/13 06:40:36 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
@@ -226,17 +226,17 @@ MIT in each case. |#
 ;;;; Utilities
 
 (define (object->fixnum target)
-  (SAL W ,target (& ,scheme-type-width)))
+  (LAP (SAL W ,target (& ,scheme-type-width))))
 
 (define (fixnum->object target)
   (LAP (OR W ,target (& ,(ucode-type fixnum)))
        (ROR W ,target (& ,scheme-type-width))))
 
 (define (address->fixnum target)
-  (SAL W ,target (& ,scheme-type-width)))
+  (LAP (SAL W ,target (& ,scheme-type-width))))
 
 (define (fixnum->address target)
-  (SHR W ,target (& ,scheme-type-width)))
+  (LAP (SHR W ,target (& ,scheme-type-width))))
 
 (define-integrable fixnum-1 64)                ; (expt 2 scheme-type-width) ***
 
index ddc64f28310cb8efaf9d0b0c36a2413d645f0e24..9871c2f60871c35862359a992d0ad6c719c079ce 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulrew.scm,v 1.4 1992/02/13 05:55:35 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulrew.scm,v 1.5 1992/02/13 06:38:36 jinx Exp $
 $MC68020-Header: /scheme/src/compiler/machines/bobcat/RCS/rulrew.scm,v 1.4 1991/10/25 06:50:06 cph Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -138,7 +138,7 @@ MIT in each case. |#
                 (REGISTER (? operand-1 register-known-value))
                 (? operand-2)
                 (? overflow?))
-  (QUALIFIER (rtl:constant-fixnum-test operand-1 (lambda (n) true)))
+  (QUALIFIER (rtl:constant-fixnum-test operand-1 (lambda (n) true)))
   (rtl:make-fixnum-2-args 'MULTIPLY-FIXNUM operand-1 operand-2 overflow?))
 
 (define-rule rewriting
@@ -146,7 +146,7 @@ MIT in each case. |#
                 (? operand-1)
                 (REGISTER (? operand-2 register-known-value))
                 (? overflow?))
-  (QUALIFIER (rtl:constant-fixnum-test operand-2 (lambda (n) true)))
+  (QUALIFIER (rtl:constant-fixnum-test operand-2 (lambda (n) true)))
   (rtl:make-fixnum-2-args 'MULTIPLY-FIXNUM operand-1 operand-2 overflow?))
 
 (define-rule rewriting