diff --git a/code/dfixnum.lisp b/code/dfixnum.lisp index b7c707366a7d701cb909d28698194734422c3d51..aa05b30c0a81a40626913e15e0e150d76ac3f991 100644 --- a/code/dfixnum.lisp +++ b/code/dfixnum.lisp @@ -5,7 +5,7 @@ ;;; and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/dfixnum.lisp,v 1.2 2002/12/20 17:39:36 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/dfixnum.lisp,v 1.3 2003/02/12 18:35:29 cracauer Rel $") ;;; ;;; ********************************************************************** ;;; @@ -24,16 +24,29 @@ ;;; Compatibility: Runs in any valid Common Lisp. (defpackage "DFIXNUM" - (:export "DFIXNUM" "MAKE-DFIXNUM" dfparttype - "DFIXNUM-INC-DF" "DFIXNUM-INC-HF" - "DFIXNUM-SET-FROM-NUMBER" "DFIXNUM-MAKE-FROM-NUMBER" - "DFIXNUM-INTEGER" "DFIXNUM-SINGLE-FLOAT" - dfixnum-set-df - dfixnum-dec-df dfixnum-dec-hf - dfixnum-single-float dfixnum-single-float-inline - dfixnum-set-single-float dfixnum-inc-single-float - dfixnum-set-pair dfixnum-inc-pair dfixnum-pair-integer - dfixnum-dec-pair dfixnum-copy-pair)) + (:export + + ;; types + dfixnum dfparttype + + ;; constructing + make-dfixnum + dfixnum-make-from-number + + ;; arthmetic with our datatypes + dfixnum-inc-df dfixnum-inc-hf + dfixnum-set-df dfixnum-dec-df dfixnum-dec-hf + + + ;; operations with normal datatypes + dfixnum-set-from-number dfixnum-inc-integer + dfixnum-set-single-float dfixnum-inc-single-float + dfixnum-integer dfixnum-single-float + dfixnum-single-float dfixnum-single-float-inline + + ;; operations on pairs instead of the dfixnum struct + dfixnum-set-pair dfixnum-inc-pair dfixnum-pair-integer + dfixnum-dec-pair dfixnum-copy-pair)) (in-package "DFIXNUM") @@ -110,6 +123,20 @@ (setf (dfixnum-l v) low)) v) +(defun dfixnum-inc-integer (df i) + "increments dfixnum by an interger which may be bigger than fixnum. + May cons" + (declare (type dfixnum df) (integer i) (optimize (ext:inhibit-warnings 3))) + (let ((carry (+ (dfixnum-l df) (mod i dfmax)))) + (setf (dfixnum-l df) (mod carry dfmax)) + (if (> carry dfmax) + (setf carry 1) + (setf carry 0)) + (setf (dfixnum-h df) + (+ (dfixnum-h df) + (ash i (- dfbits)) + carry)))) + (defun dfixnum-set-from-number (df i) (declare (type dfixnum df) (optimize (ext:inhibit-warnings 3))) (setf (dfixnum-h df) (ash i (- dfbits))) diff --git a/code/gc.lisp b/code/gc.lisp index 4e64446a3e83b34b15760509171559d639a670a4..84c8b0fd47e9e362349e941fccccbe2b1c477075 100644 --- a/code/gc.lisp +++ b/code/gc.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.32 2003/01/28 02:49:15 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.33 2003/02/12 18:35:29 cracauer Exp $") ;;; ;;; ********************************************************************** ;;; @@ -438,7 +438,8 @@ (let* ((post-gc-dyn-usage (dynamic-usage)) (bytes-freed (- pre-gc-dyn-usage post-gc-dyn-usage))) (when *last-bytes-in-use* - #+nil(when verbose-p + #+nil + (when verbose-p (format t "~&Adjusting *last-bytes-in-use* from ~:D to ~:D, gen ~d, pre ~:D ~%" *last-bytes-in-use* @@ -446,9 +447,12 @@ gen pre-gc-dyn-usage) (force-output)) - (dfixnum:dfixnum-inc-hf - *total-bytes-consed* - (- pre-gc-dyn-usage *last-bytes-in-use*)) + (let ((correction (- pre-gc-dyn-usage *last-bytes-in-use*))) + (if (<= correction dfixnum::dfmax) + (dfixnum:dfixnum-inc-hf *total-bytes-consed* correction) + ;; give up on not consing + (dfixnum:dfixnum-inc-integer *total-bytes-consed* + correction))) (setq *last-bytes-in-use* post-gc-dyn-usage)) (setf *need-to-collect-garbage* nil) (setf *gc-trigger*