X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsrctran.lisp;h=5ca87190b77e6e24af8166309307ebd1f8a546be;hb=df1314801984738011676b539cedd2c2a41d1f6e;hp=c1a1042fda9d981278222dca4282bb8189097f7f;hpb=4fb49bd07d1737a450249cea98fc825687d3bbf7;p=sbcl.git

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index c1a1042..5ca8719 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -145,7 +145,7 @@
 (define-source-transform last (x) `(sb!impl::last1 ,x))
 (define-source-transform gethash (&rest args)
   (case (length args)
-   (2 `(sb!impl::gethash2 ,@args))
+   (2 `(sb!impl::gethash3 ,@args nil))
    (3 `(sb!impl::gethash3 ,@args))
    (t (values nil t))))
 (define-source-transform get (&rest args)
@@ -702,8 +702,9 @@
                   ;; Multiply by closed zero is special. The result
                   ;; is always a closed bound. But don't replace this
                   ;; with zero; we want the multiplication to produce
-                  ;; the correct signed zero, if needed.
-                  (* (type-bound-number x) (type-bound-number y)))
+                  ;; the correct signed zero, if needed. Use SIGNUM
+                  ;; to avoid trying to multiply huge bignums with 0.0.
+                  (* (signum (type-bound-number x)) (signum (type-bound-number y))))
                  ((or (and (floatp x) (float-infinity-p x))
                       (and (floatp y) (float-infinity-p y)))
                   ;; Infinity times anything is infinity
@@ -3497,15 +3498,16 @@
 ;;; negated test as appropriate. If it is a degenerate one-arg call,
 ;;; then we transform to code that returns true. Otherwise, we bind
 ;;; all the arguments and expand into a bunch of IFs.
-(declaim (ftype (function (symbol list boolean t) *) multi-compare))
-(defun multi-compare (predicate args not-p type)
+(defun multi-compare (predicate args not-p type &optional force-two-arg-p)
   (let ((nargs (length args)))
     (cond ((< nargs 1) (values nil t))
           ((= nargs 1) `(progn (the ,type ,@args) t))
           ((= nargs 2)
            (if not-p
                `(if (,predicate ,(first args) ,(second args)) nil t)
-               (values nil t)))
+               (if force-two-arg-p
+                   `(,predicate ,(first args) ,(second args))
+                   (values nil t))))
           (t
            (do* ((i (1- nargs) (1- i))
                  (last nil current)
@@ -3543,15 +3545,15 @@
                                                             'character))
 
 (define-source-transform char-equal (&rest args)
-  (multi-compare 'char-equal args nil 'character))
+  (multi-compare 'sb!impl::two-arg-char-equal args nil 'character t))
 (define-source-transform char-lessp (&rest args)
-  (multi-compare 'char-lessp args nil 'character))
+  (multi-compare 'sb!impl::two-arg-char-lessp args nil 'character t))
 (define-source-transform char-greaterp (&rest args)
-  (multi-compare 'char-greaterp args nil 'character))
+  (multi-compare 'sb!impl::two-arg-char-greaterp args nil 'character t))
 (define-source-transform char-not-greaterp (&rest args)
-  (multi-compare 'char-greaterp args t 'character))
+  (multi-compare 'sb!impl::two-arg-char-greaterp args t 'character t))
 (define-source-transform char-not-lessp (&rest args)
-  (multi-compare 'char-lessp args t 'character))
+  (multi-compare 'sb!impl::two-arg-char-lessp args t 'character t))
 
 ;;; This function does source transformation of N-arg inequality
 ;;; functions such as /=. This is similar to MULTI-COMPARE in the <3
@@ -4125,7 +4127,5 @@
   (unless (and (constant-lvar-p quality-name)
                (policy-quality-name-p (lvar-value quality-name)))
     (give-up-ir1-transform))
-  `(let* ((acons (assoc quality-name policy))
-          (result (or (cdr acons) 1)))
-     result))
+  '(%policy-quality policy quality-name))