[Openmcl-cvs-notifications] r15294 - in /trunk/source: level-0/ARM/arm-pred.lisp lisp-kernel/arm-spentry.s
gb at clozure.com
gb at clozure.com
Thu Apr 5 20:34:27 CDT 2012
Author: gb
Date: Thu Apr 5 20:34:27 2012
New Revision: 15294
Log:
Don't call out in .SPbuiltin_eql. Implement #'EQL for ARM in terms
of .SPbuiltin_eql.
Note that running the old kernel with a new image will cause an =
infinite loop in EQL in some cases. Don't do that; do =
(REBUILD-CCL :FULL T) to avoid the issue.
Modified:
trunk/source/level-0/ARM/arm-pred.lisp
trunk/source/lisp-kernel/arm-spentry.s
Modified: trunk/source/level-0/ARM/arm-pred.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
--- trunk/source/level-0/ARM/arm-pred.lisp (original)
+++ trunk/source/level-0/ARM/arm-pred.lisp Thu Apr 5 20:34:27 2012
@@ -22,103 +22,7 @@
(defarmlapfunction eql ((x arg_y) (y arg_z))
"Return T if OBJ1 and OBJ2 represent the same object, otherwise NIL."
(check-nargs 2)
- @tail
- (cmp x y)
- (extract-lisptag imm0 x)
- (extract-lisptag imm1 y)
- (beq @win)
- (cmp imm0 (:$ arm::tag-misc))
- (cmpeq imm1 (:$ arm::tag-misc))
- (bne @lose)
- ;; Objects are both of tag-misc. Headers must match exactly;
- ;; dispatch on subtag.
- (getvheader imm1 y)
- (extract-lowbyte imm2 imm1)
- (getvheader imm0 x)
- (cmp imm2 (:$ arm::subtag-macptr))
- (beq @macptr)
- (cmp imm0 imm1)
- (bne @lose)
- (lri imm1 (logior (ash 1 target::tag-fixnum)
- (ash 1 target::subtag-bignum)
- (ash 1 target::subtag-single-float)
- (ash 1 target::subtag-double-float)
- (ash 1 target::subtag-ratio)
- (ash 1 target::subtag-complex)))
- (mov imm0 (:$ 1))
- (tst imm1 (:lsl imm0 imm2))
- (getvheader imm0 x)
- (getvheader imm1 y)
- (beq @lose)
- (cmp imm2 (:$ arm::subtag-ratio))
- (cmpne imm2 (:$ arm::subtag-complex))
- (beq @node)
- (cmp imm2 (:$ arm::subtag-bignum))
- (beq @bignum)
- (cmp imm2 (:$ arm::subtag-double-float))
- (bne @one-unboxed-word)
- ;; This is the double-float case.
- (ldr imm0 (:@ x (:$ arm::double-float.val-low)))
- (ldr imm1 (:@ y (:$ arm::double-float.val-low)))
- (cmp imm0 imm1)
- (ldreq imm0 (:@ x (:$ arm::double-float.val-high)))
- (ldreq imm1 (:@ y (:$ arm::double-float.val-high)))
- (cmpeq imm0 imm1)
- (mov arg_z 'nil)
- (addeq arg_z arg_z (:$ arm::t-offset))
- (bx lr)
- @win
- (mov arg_z 'nil)
- (add arg_z arg_z (:$ arm::t-offset))
- (bx lr)
- @macptr
- (extract-lowbyte imm0 imm0)
- (cmp imm2 imm0)
- (bne @lose)
- @one-unboxed-word
- (ldr imm0 (:@ x (:$ arm::misc-data-offset)))
- (ldr imm1 (:@ y (:$ arm::misc-data-offset)))
- (cmp imm0 imm1)
- (beq @win)
- @lose
- (mov arg_z 'nil)
- (bx lr)
- @bignum
- ;; Way back when, we got x's header into imm0. We know that y's
- ;; header is identical. Use the element-count from imm0 to control
- ;; the loop. There's no such thing as a 0-element bignum, so the
- ;; loop must always execute at least once.
- (header-length temp0 imm0)
- (mov imm2 (:$ arm::misc-data-offset))
- @bignum-next
- (ldr imm0 (:@ x imm2))
- (ldr imm1 (:@ y imm2))
- (cmp imm0 imm1)
- (add imm2 imm2 (:$ arm::node-size))
- (bne @lose)
- (subs temp0 temp0 '1)
- (bne @bignum-next)
- (mov arg_z 'nil)
- (add arg_z arg_z (:$ arm::t-offset))
- (bx lr)
- @node
- ;; Have either a ratio or a complex. In either case, corresponding
- ;; elements of both objects must be EQL. Recurse on the first
- ;; elements. If true, tail-call on the second, else fail.
- (vpush1 x)
- (vpush1 y)
- (build-lisp-frame imm0)
- (ldr x (:@ x (:$ arm::misc-data-offset)))
- (ldr y (:@ y (:$ arm::misc-data-offset)))
- (bl @tail)
- (cmp arg_z 'nil)
- (restore-lisp-frame imm0)
- (vpop1 y)
- (vpop1 x)
- (beq @lose)
- (ldr x (:@ x (:$ (+ 4 arm::misc-data-offset))))
- (ldr y (:@ y (:$ (+ 4 arm::misc-data-offset))))
- (b @tail))
+ (spjump .SPbuiltin-eql))
=
=
=
Modified: trunk/source/lisp-kernel/arm-spentry.s
=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
--- trunk/source/lisp-kernel/arm-spentry.s (original)
+++ trunk/source/lisp-kernel/arm-spentry.s Thu Apr 5 20:34:27 2012
@@ -150,19 +150,72 @@
__(jump_builtin(_builtin_le,2))
=
_spentry(builtin_eql)
- __(cmp arg_y,arg_z)
- __(beq 1f)
+0: __(cmp arg_y,arg_z)
+ __(beq 8f)
__(extract_fulltag(imm0,arg_y))
__(extract_fulltag(imm1,arg_z))
__(cmp imm0,imm1)
+ __(bne 9f)
+ __(cmp imm0,#fulltag_misc)
+ __(bne 9f)
+ __(extract_subtag(imm0,arg_y))
+ __(extract_subtag(imm1,arg_z))
+ __(cmp imm0,imm1)
+ __(bne 9f)
+ __(cmp imm0,#subtag_macptr)
+ __(cmpne imm0,#subtag_single_float)
+ __(bne 1f)
+ __(ldr imm0,[arg_y,#misc_data_offset])
+ __(ldr imm1,[arg_z,#misc_data_offset])
+ __(cmp imm0,imm1)
+ __(mov arg_z,#nil_value)
+ __(addeq arg_z,arg_z,#t_offset)
+ __(bx lr)
+1: __(cmp imm0,#subtag_double_float)
__(bne 2f)
- __(cmp imm0,#fulltag_misc)
- __(bne 2f)
- __(jump_builtin(_builtin_eql,2))
-1: __(mov arg_z,#nil_value)
+ __(ldr imm0,[arg_y,#misc_dfloat_offset])
+ __(ldr imm1,[arg_z,#misc_dfloat_offset])
+ __(cmp imm0,imm1)
+ __(ldreq imm0,[arg_y,#misc_dfloat_offset+node_size])
+ __(ldreq imm1,[arg_z,#misc_dfloat_offset+node_size])
+ __(cmpeq imm0,imm1)
+ __(mov arg_z,#nil_value)
+ __(addeq arg_z,arg_z,#t_offset)
+ __(bx lr)
+2: __(cmp imm0,#subtag_ratio)
+ __(cmpne imm0,#subtag_complex)
+ __(bne 3f)
+ __(ldr temp0,[arg_y,#ratio.denom])
+ __(ldr temp1,[arg_z,#ratio.denom])
+ __(stmdb vsp!,{temp0,temp1})
+ __(ldr arg_y,[arg_y,#ratio.numer])
+ __(ldr arg_z,[arg_z,#ratio.numer])
+ __(build_lisp_frame(imm0))
+ __(bl 0b)
+ __(cmp arg_z,#nil_value)
+ __(restore_lisp_frame(imm0))
+ __(ldmia vsp!,{arg_z,arg_y})
+ __(bne 0b)
+ __(bx lr)
+3: __(cmp imm0,#subtag_bignum)
+ __(bne 9f)
+ __(getvheader(imm0,arg_y))
+ __(getvheader(imm1,arg_z))
+ __(cmp imm0,imm1)
+ __(bne 9f)
+ __(header_length(temp0,imm0))
+ __(mov imm2,#misc_data_offset)
+4: __(ldr imm0,[arg_y,imm2])
+ __(ldr imm1,[arg_z,imm2])
+ __(cmp imm0,imm1)
+ __(bne 9f)
+ __(add imm2,imm2,#node_size)
+ __(subs temp0,temp0,#fixnumone)
+ __(bne 4b) =
+8: __(mov arg_z,#nil_value)
__(add arg_z,arg_z,#t_offset)
__(bx lr)
-2: __(mov arg_z,#nil_value)
+9: __(mov arg_z,#nil_value)
__(bx lr)
=
_spentry(builtin_length)
More information about the Openmcl-cvs-notifications
mailing list