Changeset 13537 for release

Timestamp:

Mar 16, 2010, 12:06:02 PM (15 years ago)

Author:

R. Matthew Emerson

Message:

Merge r13437 (ash fix for ticket:660) from trunk to 1.4 branch.

Location:

release/1.4/source

Files:

• . (modified) (1 prop)
• compiler (modified) (1 prop)
• compiler/nx1.lisp (modified) (2 diffs)
• level-0/X86 (modified) (1 prop)
• lisp-kernel (modified) (1 prop)
• scripts (modified) (1 prop)

release/1.4/source/compiler/nx1.lisp

@@ -2176 +2176 @@
 (defnx1 nx1-symvector ((%symptr->symvector) (%symvector->symptr)) (arg)
   (make-acode (%nx1-default-operator) (nx1-form arg)))
-        
+
+
 (defnx1 nx1-ash (ash) (&whole call &environment env num amt)
   (let* ((unsigned-natural-type (target-word-size-case
@@ -2194 +2195 @@
                          (nx1-form num))
              (if (nx-form-typep num unsigned-natural-type env)
-               (make-acode (%nx1-operator natural-shift-right)
-                           (nx1-form num)
-                           (make-acode (%nx1-operator fixnum)
-                                       (min (1- max) (- amt))))
+               (if (< (- amt) max)
+                 (make-acode (%nx1-operator natural-shift-right)
+                             (nx1-form num)
+                             (make-acode (%nx1-operator fixnum)
+                                         (- amt)))
+                 (nx1-form `(progn (require-type ,num 'integer) 0) env))
                (nx1-treat-as-call call))))
           ((and (fixnump amt)