- movitz-cvs@common-lisp.net - mailman3.common-lisp.net

[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
by Frode Vatvedt Fjeld 13 Jul '04

13 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv17940 Modified Files: integers.lisp Log Message: Implement the fact that (truncate fixnum bignum) results in (values 0 fixnum). Date: Tue Jul 13 15:43:40 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.52 movitz/losp/muerte/integers.lisp:1.53 --- movitz/losp/muerte/integers.lisp:1.52 Tue Jul 13 14:01:42 2004 +++ movitz/losp/muerte/integers.lisp Tue Jul 13 15:43:40 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.52 2004/07/13 21:01:42 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.53 2004/07/13 22:43:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1335,6 +1335,8 @@ (:xorl :ecx :ecx) (:movb 2 :cl) ; return values: qutient, remainder. (:stc))) + ((positive-fixnum positive-bignum) + (values 0 number)) ((positive-bignum positive-fixnum) (macrolet ((do-it ()

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.lisp
by Frode Vatvedt Fjeld 13 Jul '04

13 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv20226 Modified Files: inspect.lisp Log Message: Sigh.. another bug in copy-bignum. Now I do hope it's correct. Date: Tue Jul 13 15:42:39 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.19 movitz/losp/muerte/inspect.lisp:1.20 --- movitz/losp/muerte/inspect.lisp:1.19 Tue Jul 13 07:29:22 2004 +++ movitz/losp/muerte/inspect.lisp Tue Jul 13 15:42:38 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.19 2004/07/13 14:29:22 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.20 2004/07/13 22:42:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -315,7 +315,7 @@ (defun copy-bignum (old) (check-type old bignum) (let* ((length (%bignum-bigits old)) - (new (malloc-data-words length))) + (new (malloc-data-clumps (1+ (truncate length 2))))) (with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ebx) new old) (:compile-form (:result-mode :edx) length)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/functions.lisp
by Frode Vatvedt Fjeld 13 Jul '04

13 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16608 Modified Files: functions.lisp Log Message: Added a continuation to unbound-function. Date: Tue Jul 13 15:41:48 2004 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.14 movitz/losp/muerte/functions.lisp:1.15 --- movitz/losp/muerte/functions.lisp:1.14 Wed Jul 7 10:37:43 2004 +++ movitz/losp/muerte/functions.lisp Tue Jul 13 15:41:48 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 12 22:58:54 2002 ;;;; -;;;; $Id: functions.lisp,v 1.14 2004/07/07 17:37:43 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.15 2004/07/13 22:41:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -83,9 +83,11 @@ (compiled-function (funobj-name edx)) (t '(unknown))))) - (error 'undefined-function-call - :name function-name - :arguments (copy-list args)))) + (with-simple-restart (continue "Return NIL from ~S." function-name) + (error 'undefined-function-call + :name function-name + :arguments (copy-list args)))) + nil) ;;; funobj object

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by Frode Vatvedt Fjeld 13 Jul '04

13 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv6720 Modified Files: compiler.lisp Log Message: Changed make-stack-setup-code to push any number of EDIs rather than subtracting from ESP, so as to keep the stack GC-safe. I don't know if this is a viable long-term solution to this problem, though. Date: Tue Jul 13 15:41:07 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.74 movitz/compiler.lisp:1.75 --- movitz/compiler.lisp:1.74 Mon Jul 12 02:11:07 2004 +++ movitz/compiler.lisp Tue Jul 13 15:41:06 2004 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.74 2004/07/12 09:11:07 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.75 2004/07/13 22:41:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1175,14 +1175,6 @@ ;;; (t (warn "1-req-1-opt failed")))))) ;;; (t nil)))))) - -(defun make-compiled-stack-frame-init (stack-frame-init) - (case stack-frame-init - (0 nil) - (1 '((:pushl :edi))) - (2 '((:pushl :edi) (:pushl :edi))) - (t `((:subl ,(* 4 stack-frame-init) :esp))))) - (defun movitz-compile-file (path &key ((:image *image*) *image*) load-priority (delete-file-p nil)) @@ -3895,6 +3887,9 @@ min-args max-args))))) (defun make-stack-setup-code (stack-setup-size) + (loop repeat stack-setup-size + collect '(:pushl :edi)) + #+ignore (case stack-setup-size (0 nil) (1 '((:pushl :edi)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
by Frode Vatvedt Fjeld 13 Jul '04

13 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv14368 Modified Files: integers.lisp Log Message: Added a non-square-complexity isqrt. Date: Tue Jul 13 14:01:42 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.51 movitz/losp/muerte/integers.lisp:1.52 --- movitz/losp/muerte/integers.lisp:1.51 Tue Jul 13 12:45:38 2004 +++ movitz/losp/muerte/integers.lisp Tue Jul 13 14:01:42 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.51 2004/07/13 19:45:38 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.52 2004/07/13 21:01:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2365,9 +2365,18 @@ (defun isqrt (natural) "=> natural-root" - (check-type natural (integer 0 *)) - (do ((i 0 (1+ i))) - ((> (* i i) natural) (1- i)))) + (etypecase natural + ((eql 0) 0) + ((integer 1 *) + (let ((r 1)) + (do ((next-r (truncate (+ r (truncate natural r)) 2) + (truncate (+ r (truncate natural r)) 2))) + ((typep (- next-r r) '(integer 0 1)) + (let ((r+1 (1+ r))) + (if (<= (* r+1 r+1) natural) + r+1 + r))) + (setf r next-r)))))) (define-compiler-macro expt (&whole form base-number power-number &environment env) (if (not (and (movitz:movitz-constantp base-number env)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
by Frode Vatvedt Fjeld 13 Jul '04

13 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6538 Modified Files: integers.lisp Log Message: Two fixes: Comparison of bignums was flawed, because the bigits were compared as signed values, while they in fact are unsigned. So <, >, =, etc would return the wrong answer in 50% of the cases. Secondly, added a linear-complexity algorithm for truncate, rather than the idiotic quadratic one. Date: Tue Jul 13 12:45:38 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.50 movitz/losp/muerte/integers.lisp:1.51 --- movitz/losp/muerte/integers.lisp:1.50 Tue Jul 13 07:17:05 2004 +++ movitz/losp/muerte/integers.lisp Tue Jul 13 12:45:38 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.50 2004/07/13 14:17:05 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.51 2004/07/13 19:45:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -570,12 +570,22 @@ (:cmpl :ecx (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) (:je 'positive-compare-loop) - (:ret) - positive-compare-lsb ; it's down to the LSB bigits. - (:movl (:ebx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) - :ecx) - (:cmpl :ecx - (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + positive-compare-lsb + ;; Now make the compare unsigned.. + (:movzxw (:ebx :edx ,(+ 2 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + :ecx) ; First compare upper 16 bits. + (:locally (:movl :ecx (:edi (:edi-offset scratch0)))) + (:movzxw (:eax :edx ,(+ 2 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + :ecx) + (:locally (:cmpl (:edi (:edi-offset scratch0)) :ecx)) + (:jne 'upper-16-decisive) + (:movzxw (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + :ecx) ; Then compare lower 16 bits. + (:locally (:movl :ecx (:edi (:edi-offset scratch0)))) + (:movzxw (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + :ecx) ; Then compare lower 16 bits. + (:locally (:cmpl (:edi (:edi-offset scratch0)) :ecx)) + upper-16-decisive (:ret) compare-negatives @@ -1424,10 +1434,23 @@ (cond ((= number divisor) (values 1 0)) ((< number divisor) (values 0 number)) - (t (do ((q 0 (1+ q)) - (r number (- r divisor))) - ((< r divisor) (values q r)))))) - )))) + (t (let* ((msb-pos (1- (* 2 (%bignum-bigits divisor)))) + (msb (memref divisor -2 msb-pos :unsigned-byte16))) + (when (= 0 msb) + (decf msb-pos) + (setf msb (memref divisor -2 msb-pos :unsigned-byte16)) + (assert (plusp msb))) + (do ((msb+1 (1+ msb)) + (q 0) (r number)) + ((< r divisor) (values q r)) + (let ((guess (truncate r msb+1))) + (dotimes (i msb-pos) + (setf guess (truncate guess #x10000))) + (if (= 0 guess) + (setf q (1+ q) + r (- r divisor)) + (setf q (+ q guess) + r (- r (* divisor guess)))))))))))))) (defun / (number &rest denominators) (declare (dynamic-extent denominators))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.lisp
by Frode Vatvedt Fjeld 13 Jul '04

13 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3876 Modified Files: inspect.lisp Log Message: Minor edit. Date: Tue Jul 13 07:29:22 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.18 movitz/losp/muerte/inspect.lisp:1.19 --- movitz/losp/muerte/inspect.lisp:1.18 Mon Jul 12 19:21:08 2004 +++ movitz/losp/muerte/inspect.lisp Tue Jul 13 07:29:22 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.18 2004/07/13 02:21:08 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.19 2004/07/13 14:29:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -322,7 +322,7 @@ copy-bignum-loop (:movl (:ebx :edx #.movitz:+other-type-offset+) :ecx) (:movl :ecx (:eax :edx #.movitz:+other-type-offset+)) - (:subl #.movitz:+movitz-fixnum-factor+ :edx) + (:subl 4 :edx) (:jnc 'copy-bignum-loop)))) (defun print-bignum (x)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/more-macros.lisp
by Frode Vatvedt Fjeld 13 Jul '04

13 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv17787 Modified Files: more-macros.lisp Log Message: Added some extra-safe checking to %bignum-bigits. Date: Tue Jul 13 07:28:05 2004 Author: ffjeld Index: movitz/losp/muerte/more-macros.lisp diff -u movitz/losp/muerte/more-macros.lisp:1.12 movitz/losp/muerte/more-macros.lisp:1.13 --- movitz/losp/muerte/more-macros.lisp:1.12 Mon Jul 12 04:09:29 2004 +++ movitz/losp/muerte/more-macros.lisp Tue Jul 13 07:28:05 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Jun 7 15:05:57 2002 ;;;; -;;;; $Id: more-macros.lisp,v 1.12 2004/07/12 11:09:29 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.13 2004/07/13 14:28:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -312,7 +312,9 @@ `(with-inline-assembly (:returns :eax :type (unsigned-byte 14)) (:compile-form (:result-mode :eax) ,x) (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) - :eax))) + :eax) + (:testb 3 :al) ; Just to be sure.. + (:jnz '(:sub-program () (:int 63))))) ;;; Some macros that aren't implemented, and we want to give compiler errors.

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
by Frode Vatvedt Fjeld 13 Jul '04

13 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv14993 Modified Files: integers.lisp Log Message: Made defun ash slightly smarter. Also, in the * compiler-macro, never implement * in terms of ash. Date: Tue Jul 13 07:17:05 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.49 movitz/losp/muerte/integers.lisp:1.50 --- movitz/losp/muerte/integers.lisp:1.49 Tue Jul 13 06:41:17 2004 +++ movitz/losp/muerte/integers.lisp Tue Jul 13 07:17:05 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.49 2004/07/13 13:41:17 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.50 2004/07/13 14:17:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1064,32 +1064,14 @@ (defun ash (integer count) (cond ((not (minusp count)) + (do () ((< count 16)) + (setf integer (no-macro-call * #x10000 integer)) + (decf count 16)) (dotimes (i count integer) (setf integer (no-macro-call * 2 integer)))) (t (dotimes (i (- count) integer) (setf integer (truncate integer 2)))))) -;;;(defun ash (integer count) -;;; (check-type integer fixnum) -;;; (check-type count fixnum) -;;; (cond -;;; ((= 0 count) -;;; integer) -;;; ((<= 1 count 29) -;;; (dotimes (i count integer) -;;; (setq integer (ash integer 1)))) -;;; ((<= count #.(cl:- 1 movitz::+movitz-fixnum-bits+)) -;;; (if (minusp integer) -1 0)) -;;; ((minusp count) -;;; (with-inline-assembly (:returns :eax) -;;; (:compile-form (:result-mode :ecx) count) -;;; (:compile-form (:result-mode :eax) integer) -;;; (:negl :ecx) -;;; (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) -;;; (:sarl :cl :eax) -;;; (:andb #.(cl:logxor #xff movitz::+movitz-fixnum-zmask+) :al))) -;;; (t (if (= 0 integer) 0 (error "Illegal ash count: ~D" count))))) - ;;;; (defun integer-length (integer) @@ -1150,7 +1132,6 @@ (case f1 (0 `(progn ,factor2 0)) (1 factor2) - (2 `(ash ,factor2 1)) (t `(no-macro-call * ,factor1 ,factor2))))) (t `(no-macro-call * ,factor1 ,factor2))))) (t `(* (* ,(first operands) ,(second operands)) ,@(cddr operands)))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/symbols.lisp
by Frode Vatvedt Fjeld 13 Jul '04

13 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv25442 Modified Files: symbols.lisp Log Message: Accessors symbol-special-variable-p and symbol-constant-variable-p were out of sync with storage-types.lisp. This caused e.g. let of special variables not to work in the REPL. Date: Tue Jul 13 07:06:57 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.15 movitz/losp/muerte/symbols.lisp:1.16 --- movitz/losp/muerte/symbols.lisp:1.15 Wed Jul 7 16:22:16 2004 +++ movitz/losp/muerte/symbols.lisp Tue Jul 13 07:06:56 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 23:55:41 2001 ;;;; -;;;; $Id: symbols.lisp,v 1.15 2004/07/07 23:22:16 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.16 2004/07/13 14:06:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -195,18 +195,18 @@ flags))) (defun symbol-special-variable-p (symbol) - (logbitp 0 (symbol-flags symbol))) + (logbitp 3 (symbol-flags symbol))) (defun (setf symbol-special-variable-p) (value symbol) - (setf (ldb (byte 1 0) (symbol-flags symbol)) + (setf (ldb (byte 1 3) (symbol-flags symbol)) (if value 1 0)) value) (defun symbol-constant-variable-p (symbol) - (logbitp 1 (symbol-flags symbol))) + (logbitp 4 (symbol-flags symbol))) (defun (setf symbol-constant-variable-p) (value symbol) - (setf (ldb (byte 1 1) (symbol-flags symbol)) + (setf (ldb (byte 1 4) (symbol-flags symbol)) (if value 1 0)) value)

1 0