From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Thu, 13 Feb 1992 06:40:36 +0000 (+0000)
Subject: More changes.
X-Git-Tag: 20090517-FFI~9763
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=47f361282d6b512c58a5e5a36f0285c7afa38c5f;p=mit-scheme.git

More changes.
---

diff --git a/v7/src/compiler/machines/i386/rules3.scm b/v7/src/compiler/machines/i386/rules3.scm
index b798ca248..5d2d0c0a3 100644
--- 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.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))
 
 (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)
diff --git a/v7/src/compiler/machines/i386/rulfix.scm b/v7/src/compiler/machines/i386/rulfix.scm
index 30515bfc9..ea3ec9ac5 100644
--- a/v7/src/compiler/machines/i386/rulfix.scm
+++ b/v7/src/compiler/machines/i386/rulfix.scm
@@ -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) ***
 
diff --git a/v7/src/compiler/machines/i386/rulrew.scm b/v7/src/compiler/machines/i386/rulrew.scm
index ddc64f283..9871c2f60 100644
--- a/v7/src/compiler/machines/i386/rulrew.scm
+++ b/v7/src/compiler/machines/i386/rulrew.scm
@@ -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) 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) n true)))
   (rtl:make-fixnum-2-args 'MULTIPLY-FIXNUM operand-1 operand-2 overflow?))
 
 (define-rule rewriting