Skip to content
Snippets Groups Projects
Commit 59bbdaa0 authored by ram's avatar ram
Browse files

Changed ROUND to call %UNARY-ROUND when the second arg is 1.

parent c69a379b
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; Scott Fahlman (FAHLMAN@CMUC).
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.14 1990/10/03 09:58:11 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.15 1990/12/11 23:59:54 ram Exp $
;;; ;;;
;;; This file contains the definitions of most number functions. ;;; This file contains the definitions of most number functions.
;;; ;;;
...@@ -559,7 +559,8 @@ ...@@ -559,7 +559,8 @@
;;; Declare these guys inline to let them get optimized a little. Round and ;;; Declare these guys inline to let them get optimized a little. Round and
;;; Fround are not declared inline since they seem too obscure and too ;;; Fround are not declared inline since they seem too obscure and too
;;; big to inline-expand by default. ;;; big to inline-expand by default. Also, this gives the compiler a chance to
;;; pick off the unary float case.
;;; ;;;
(proclaim '(inline ceiling floor rem mod fceiling ffloor ftruncate)) (proclaim '(inline ceiling floor rem mod fceiling ffloor ftruncate))
...@@ -595,25 +596,25 @@ ...@@ -595,25 +596,25 @@
(values tru rem)))) (values tru rem))))
(defun round (number &optional (divisor 1) &aux thresh) (defun round (number &optional (divisor 1))
"Rounds number (or number/divisor) to nearest integer. "Rounds number (or number/divisor) to nearest integer.
The second returned value is the remainder." The second returned value is the remainder."
(multiple-value-bind (tru rem) (truncate number divisor) (if (eql divisor 1)
(if (eql divisor 1) (round number)
(setq thresh 0.5) (multiple-value-bind (tru rem) (truncate number divisor)
(setq thresh (/ (abs divisor) 2))) (let ((thresh (/ (abs divisor) 2)))
(cond ((or (> rem thresh) (cond ((or (> rem thresh)
(and (= rem thresh) (oddp tru))) (and (= rem thresh) (oddp tru)))
(if (minusp divisor) (if (minusp divisor)
(values (- tru 1) (+ rem divisor)) (values (- tru 1) (+ rem divisor))
(values (+ tru 1) (- rem divisor)))) (values (+ tru 1) (- rem divisor))))
((let ((-thresh (- thresh))) ((let ((-thresh (- thresh)))
(or (< rem -thresh) (or (< rem -thresh)
(and (= rem -thresh) (oddp tru)))) (and (= rem -thresh) (oddp tru))))
(if (minusp divisor) (if (minusp divisor)
(values (+ tru 1) (- rem divisor)) (values (+ tru 1) (- rem divisor))
(values (- tru 1) (+ rem divisor)))) (values (- tru 1) (+ rem divisor))))
(t (values tru rem))))) (t (values tru rem)))))))
(defun rem (number divisor) (defun rem (number divisor)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment