Skip to content
Snippets Groups Projects
Commit 1b9b5a26 authored by wlott's avatar wlott
Browse files

Fixed two-arg-gcd to correctly handle most-negative-fixnum. Was choaking

because someone declared (- most-negative-fixnum) to be a fixnum.
parent eab5608d
No related branches found
No related tags found
No related merge requests found
...@@ -7,11 +7,11 @@ ...@@ -7,11 +7,11 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.23 1993/06/24 12:56:22 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.24 1994/02/09 16:49:40 wlott Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.23 1993/06/24 12:56:22 ram Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.24 1994/02/09 16:49:40 wlott Exp $
;;; ;;;
;;; This file contains the definitions of most number functions. ;;; This file contains the definitions of most number functions.
;;; ;;;
...@@ -1173,22 +1173,28 @@ ...@@ -1173,22 +1173,28 @@
(t (t
(number-dispatch ((u integer) (v integer)) (number-dispatch ((u integer) (v integer))
((fixnum fixnum) ((fixnum fixnum)
(do ((k 0 (1+ k)) (locally
(u (abs u) (ash u -1)) (declare (optimize (speed 3) (safety 0)))
(v (abs v) (ash v -1))) (do ((k 0 (1+ k))
((oddp (logior u v)) (u (abs u) (ash u -1))
(do ((temp (if (oddp u) (- v) (ash u -1)) (v (abs v) (ash v -1)))
(ash temp -1))) ((oddp (logior u v))
(nil) (do ((temp (if (oddp u) (- v) (ash u -1))
(declare (fixnum temp)) (ash temp -1)))
(when (oddp temp) (nil)
(if (plusp temp) (declare (fixnum temp))
(setq u temp) (when (oddp temp)
(setq v (- temp))) (if (plusp temp)
(setq temp (- u v)) (setq u temp)
(when (zerop temp) (setq v (- temp)))
(return (the fixnum (ash u k))))))) (setq temp (- u v))
(declare (fixnum k u v)))) (when (zerop temp)
(let ((res (ash u k)))
(declare (type (signed-byte 31) res)
(optimize (inhibit-warnings 3)))
(return res))))))
(declare (type (mod 30) k)
(type (signed-byte 31) u v)))))
((bignum bignum) ((bignum bignum)
(bignum-gcd u v)) (bignum-gcd u v))
((bignum fixnum) ((bignum fixnum)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment