[Openmcl-cvs-notifications] r13148 - in /release/1.4/source/compiler: PPC/ppc2.lisp X86/x862.lisp nx2.lisp
gb at clozure.com
gb at clozure.com
Fri Oct 30 18:33:17 EDT 2009
Author: gb
Date: Fri Oct 30 18:33:17 2009
New Revision: 13148
Log:
Propagate r13143 (fix for ticket:620) to 1.4.
Modified:
release/1.4/source/compiler/PPC/ppc2.lisp
release/1.4/source/compiler/X86/x862.lisp
release/1.4/source/compiler/nx2.lisp
Modified: release/1.4/source/compiler/PPC/ppc2.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.4/source/compiler/PPC/ppc2.lisp (original)
+++ release/1.4/source/compiler/PPC/ppc2.lisp Fri Oct 30 18:33:17 2009
@@ -40,10 +40,6 @@
=
=
=
-(defun ppc2-immediate-operand (x)
- (if (eq (acode-operator x) (%nx1-operator immediate))
- (cadr x)
- (compiler-bug "~&Bug: not an immediate: ~s" x)))
=
(defmacro with-ppc-p2-declarations (declsform &body body)
`(let* ((*ppc2-tail-allow* *ppc2-tail-allow*)
@@ -7644,7 +7640,7 @@
(ppc2-form seg nil nil arr)
(ppc2-form seg nil nil i)
(ppc2-form seg nil xfer j))
- (let* ((type-keyword (ppc2-immediate-operand typename))
+ (let* ((type-keyword (acode-immediate-operand typename))
(fixtype (nx-lookup-target-uvector-subtag type-keyword ))
(safe (unless *ppc2-reckless* fixtype))
(dim0 (acode-fixnum-form-p dim0))
@@ -7697,7 +7693,7 @@
(ppc2-form seg nil nil i)
(ppc2-form seg nil nil j)
(ppc2-form seg nil xfer k)))
- (let* ((type-keyword (ppc2-immediate-operand typename))
+ (let* ((type-keyword (acode-immediate-operand typename))
(fixtype (nx-lookup-target-uvector-subtag type-keyword ))
(safe (unless *ppc2-reckless* fixtype))
(dim0 (acode-fixnum-form-p dim0))
@@ -7748,7 +7744,7 @@
(ppc2-fixed-call-builtin seg vreg xfer nil (subprim-name->offse=
t '.SParef3))))))
=
(defppc2 ppc2-%aset2 simple-typed-aset2 (seg vreg xfer typename arr i j ne=
w &optional dim0 dim1)
- (let* ((type-keyword (ppc2-immediate-operand typename))
+ (let* ((type-keyword (acode-immediate-operand typename))
(fixtype (nx-lookup-target-uvector-subtag type-keyword ))
(safe (unless *ppc2-reckless* fixtype))
(dim0 (acode-fixnum-form-p dim0))
@@ -7841,7 +7837,7 @@
(ppc2-fixed-call-builtin seg vreg xfer nil (subprim-name->offse=
t '.SPaset3))))))
=
(defppc2 ppc2-%aset3 simple-typed-aset3 (seg vreg xfer typename arr i j k =
new &optional dim0 dim1 dim2)
- (let* ((type-keyword (ppc2-immediate-operand typename))
+ (let* ((type-keyword (acode-immediate-operand typename))
(fixtype (nx-lookup-target-uvector-subtag type-keyword))
(safe (unless *ppc2-reckless* fixtype))
(dim0 (acode-fixnum-form-p dim0))
@@ -7856,7 +7852,7 @@
(let* ((fixtype (acode-fixnum-form-p subtag)))
(if fixtype
(nx-target-uvector-subtag-name fixtype)
- (ppc2-immediate-operand subtag)))))
+ (acode-immediate-operand subtag)))))
(if type-keyword
(ppc2-vref seg vreg xfer type-keyword uvector index (unless *ppc2-re=
ckless* (nx-lookup-target-uvector-subtag type-keyword)))
(progn
@@ -7870,7 +7866,7 @@
(let* ((fixtype (acode-fixnum-form-p subtag)))
(if fixtype
(nx-target-uvector-subtag-name fixtype)
- (ppc2-immediate-operand subtag)))))
+ (acode-immediate-operand subtag)))))
(if type-keyword
(ppc2-vset seg vreg xfer type-keyword uvector index newval (unless *=
ppc2-reckless* (nx-lookup-target-uvector-subtag type-keyword)))
(progn
Modified: release/1.4/source/compiler/X86/x862.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.4/source/compiler/X86/x862.lisp (original)
+++ release/1.4/source/compiler/X86/x862.lisp Fri Oct 30 18:33:17 2009
@@ -62,11 +62,7 @@
(progn
, at body)))))
=
- =
-(defun x862-immediate-operand (x)
- (if (eq (acode-operator x) (%nx1-operator immediate))
- (cadr x)
- (compiler-bug "not an immediate: ~s" x)))
+
=
(defmacro with-x86-p2-declarations (declsform &body body)
`(let* ((*x862-tail-allow* *x862-tail-allow*)
@@ -3702,7 +3698,7 @@
(when vreg
(if (nx-t constant)
(! compare-to-t ireg)
- (let* ((imm (x862-immediate-operand constant))
+ (let* ((imm (acode-immediate-operand constant))
(reg (x862-register-constant-p imm))) =
(if reg
(! compare-registers reg ireg)
@@ -8527,7 +8523,7 @@
(x862-form seg nil nil arr)
(x862-form seg nil nil i)
(x862-form seg nil xfer j)))
- (let* ((type-keyword (x862-immediate-operand typename))
+ (let* ((type-keyword (acode-immediate-operand typename))
(fixtype (nx-lookup-target-uvector-subtag type-keyword ))
(safe (unless *x862-reckless* fixtype))
(dim0 (acode-fixnum-form-p dim0))
@@ -8582,7 +8578,7 @@
(x862-form seg nil nil i)
(x862-form seg nil nil j)
(x862-form seg nil xfer k)))
- (let* ((type-keyword (x862-immediate-operand typename))
+ (let* ((type-keyword (acode-immediate-operand typename))
(fixtype (nx-lookup-target-uvector-subtag type-keyword ))
(safe (unless *x862-reckless* fixtype))
(dim0 (acode-fixnum-form-p dim0))
@@ -8724,7 +8720,7 @@
=
=
(defx862 x862-%aset2 simple-typed-aset2 (seg vreg xfer typename arr i j ne=
w &optional dim0 dim1)
- (let* ((type-keyword (x862-immediate-operand typename))
+ (let* ((type-keyword (acode-immediate-operand typename))
(fixtype (nx-lookup-target-uvector-subtag type-keyword))
(safe (unless *x862-reckless* fixtype))
(dim0 (acode-fixnum-form-p dim0))
@@ -8733,7 +8729,7 @@
=
=
(defx862 x862-%aset3 simple-typed-aset3 (seg vreg xfer typename arr i j k =
new &optional dim0 dim1 dim2)
- (let* ((type-keyword (x862-immediate-operand typename))
+ (let* ((type-keyword (acode-immediate-operand typename))
(fixtype (nx-lookup-target-uvector-subtag type-keyword))
(safe (unless *x862-reckless* fixtype))
(dim0 (acode-fixnum-form-p dim0))
@@ -8746,7 +8742,7 @@
(let* ((fixtype (acode-fixnum-form-p subtag)))
(if fixtype
(nx-target-uvector-subtag-name fixtype)
- (x862-immediate-operand subtag)))))
+ (acode-immediate-operand subtag)))))
(if type-keyword
(x862-vref seg vreg xfer type-keyword uvector index (unless *x862-re=
ckless* (nx-lookup-target-uvector-subtag type-keyword)))
(progn
@@ -8765,7 +8761,7 @@
(let* ((fixtype (acode-fixnum-form-p subtag)))
(if fixtype
(nx-target-uvector-subtag-name fixtype)
- (x862-immediate-operand subtag)))))
+ (acode-immediate-operand subtag)))))
(if type-keyword
(x862-vset seg vreg xfer type-keyword uvector index newval (unless *=
x862-reckless* (nx-lookup-target-uvector-subtag type-keyword)))
(progn
Modified: release/1.4/source/compiler/nx2.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.4/source/compiler/nx2.lisp (original)
+++ release/1.4/source/compiler/nx2.lisp Fri Oct 30 18:33:17 2009
@@ -235,3 +235,9 @@
(when (acode-p ref)
(setf (acode-operator ref) op
(acode-operands ref) operands)))))))
+
+(defun acode-immediate-operand (x)
+ (let* ((x (acode-unwrapped-form x)))
+ (if (eq (acode-operator x) (%nx1-operator immediate))
+ (cadr x)
+ (compiler-bug "not an immediate: ~s" x))))
More information about the Openmcl-cvs-notifications
mailing list