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

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

14 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv9184 Modified Files: typep.lisp Log Message: Fixed a bug in typep for types like (integer * 4). Date: Wed Jul 14 03:53:24 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.25 movitz/losp/muerte/typep.lisp:1.26 --- movitz/losp/muerte/typep.lisp:1.25 Thu Jul 8 14:50:03 2004 +++ movitz/losp/muerte/typep.lisp Wed Jul 14 03:53:24 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.25 2004/07/08 21:50:03 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.26 2004/07/14 10:53:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -289,7 +289,7 @@ `(typep ,object 'integer)) ((null lower-limit) `(let ((x ,object)) - (and (typep x 'integer) (<= x upper-limit)))) + (and (typep x 'integer) (<= x ,upper-limit)))) ((and (null upper-limit) (= (1+ movitz:+movitz-most-positive-fixnum+) lower-limit)) `(with-inline-assembly-case ()

1 0

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

14 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv27873 Modified Files: integers.lisp Log Message: Fixed bogus implementations of abs, signum, max, and min. Date: Wed Jul 14 03:03:45 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.53 movitz/losp/muerte/integers.lisp:1.54 --- movitz/losp/muerte/integers.lisp:1.53 Tue Jul 13 15:43:40 2004 +++ movitz/losp/muerte/integers.lisp Wed Jul 14 03:03:44 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.53 2004/07/13 22:43:40 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.54 2004/07/14 10:03:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -938,90 +938,59 @@ `(< ,number 0)) (define-compiler-macro abs (x) - `(with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) ,x) - (:testb #.movitz::+movitz-fixnum-zmask+ :al) - (:jnz '(:sub-program () (:int 107))) - (:movl :eax :ecx) - (:addl :ecx :ecx) - (:sbbl :ecx :ecx) - (:xorl :ecx :eax) - (:subl :ecx :eax))) + `(let ((x ,x)) + (if (>= 0 x) x (- x)))) (defun abs (x) (abs x)) (defun signum (x) - (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) x) - (:testb #.movitz::+movitz-fixnum-zmask+ :al) - (:jnz '(:sub-program (not-fixnum) (:int 107))) - (:cdq :eax :edx) - (:negl :eax) - (:adcl :edx :edx) - (:leal ((:edx #.movitz::+movitz-fixnum-factor+)) :eax))) + (cond + ((> x 0) 1) + ((< x 0) -1) + (t 0))) ;;; -(define-compiler-macro max%2op (number1 number2) - #+ignore - `(let ((number1 ,number1) (number2 ,number2)) - (if (< number1 number2) - number2 number1)) - (let ((label (gensym))) - `(with-inline-assembly (:returns :eax :type fixnum) - (:compile-two-forms (:eax :ebx) ,number1 ,number2) - (:movl :ebx :ecx) - (:orl :eax :ecx) - (:testb ,movitz::+movitz-fixnum-zmask+ :cl) - (:jnz '(:sub-program () (:int 107))) - (:cmpl :eax :ebx) - (:jl ',label) - (:movl :ebx :eax) - ,label))) - - -(defun max%2op (number1 number2) - (max%2op number1 number2)) - (define-compiler-macro max (&whole form first-number &rest more-numbers) (case (length more-numbers) (0 first-number) - (1 `(max%2op ,first-number ,(car more-numbers))) + (1 `(let ((x ,first-number) + (y ,(car more-numbers))) + (if (>= x y) x y))) ((2 3 4) - `(max%2op ,first-number (max ,@more-numbers))) + `(max ,first-number (max ,@more-numbers))) (t form))) (defun max (number1 &rest numbers) - (declare (dynamic-extent numbers)) - (let ((max number1)) - (dolist (x numbers max) - (when (>= x max) - (setq max x))))) - -(define-compiler-macro min%2op (number1 number2) - `(let ((number1 ,number1) (number2 ,number2)) - (if (< number1 number2) - number1 number2))) - -(defun min%2op (number1 number2) - (min%2op number1 number2)) + (numargs-case + (2 (x y) (max x y)) + (t (number1 &rest numbers) + (declare (dynamic-extent numbers)) + (let ((max number1)) + (dolist (x numbers max) + (when (> x max) + (setq max x))))))) (define-compiler-macro min (&whole form first-number &rest more-numbers) (case (length more-numbers) (0 first-number) - (1 `(min%2op ,first-number ,(car more-numbers))) + (1 `(let ((x ,first-number) + (y ,(car more-numbers))) + (if (<= x y) x y))) ((2 3 4) - `(min%2op ,first-number (min ,@more-numbers))) + `(min ,first-number (min ,@more-numbers))) (t form))) (defun min (number1 &rest numbers) - (declare (dynamic-extent numbers)) - #+ignore (reduce #'min%2op numbers :initial-value number1) - (let ((min number1)) - (dolist (x numbers min) - (when (< x min) - (setq min x))))) + (numargs-case + (2 (x y) (min x y)) + (t (number1 &rest numbers) + (declare (dynamic-extent numbers)) + (let ((min number1)) + (dolist (x numbers min) + (when (< x min) + (setq min x))))))) ;; shift @@ -1138,10 +1107,11 @@ `(* ,(movitz:movitz-eval factor2 env) ,factor1)) ((movitz:movitz-constantp factor1 env) (let ((f1 (movitz:movitz-eval factor1 env))) - (check-type f1 fixnum) + (check-type f1 integer) (case f1 (0 `(progn ,factor2 0)) (1 factor2) +;;; (2 `(let ((x ,factor2)) (+ x x))) (t `(no-macro-call * ,factor1 ,factor2))))) (t `(no-macro-call * ,factor1 ,factor2))))) (t `(* (* ,(first operands) ,(second operands)) ,@(cddr operands))))) @@ -1564,34 +1534,6 @@ (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) (:btl :ecx (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))))))) (do-it))) - -;;;(define-compiler-macro logbitp (&whole form index integer &environment env) -;;; (if (not (movitz:movitz-constantp index env)) -;;; form -;;; (let ((index (movitz::movitz-eval index env))) -;;; (check-type index (integer 0 30)) -;;; `(with-inline-assembly (:returns :boolean-cf=1) -;;; (:compile-form (:result-mode :eax) ,integer) -;;; (:testb #.movitz::+movitz-fixnum-zmask+ :al) -;;; (:jnz '(:sub-program () (:int 107))) -;;; (:btl ,(+ index movitz::+movitz-fixnum-shift+) :eax))))) - - -;;;(defun logand%2op (x y) -;;; (with-inline-assembly (:returns :eax) -;;; (:compile-form (:result-mode :eax) x) -;;; (:compile-form (:result-mode :ebx) y) -;;; (:testb #.movitz::+movitz-fixnum-zmask+ :al) -;;; (:jnz '(:sub-program () (:int 107))) -;;; (:testb #.movitz::+movitz-fixnum-zmask+ :bl) -;;; (:jnz '(:sub-program () (:movl :ebx :eax) (:int 107))) -;;; (:andl :ebx :eax))) -;;; -;;;(define-compiler-macro logand%2op (&whole form x y) -;;; (cond -;;; ((and (movitz:movitz-constantp x) (movitz:movitz-constantp y)) -;;; (logand (movitz::movitz-eval x) (movitz::movitz-eval y))) -;;; (t form))) (define-compiler-macro logand (&whole form &rest integers &environment env) (let ((constant-folded-integers (loop for x in integers

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/scavenge.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-serv13345 Modified Files: scavenge.lisp Log Message: Minor edit. Date: Tue Jul 13 15:44:37 2004 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.17 movitz/losp/muerte/scavenge.lisp:1.18 --- movitz/losp/muerte/scavenge.lisp:1.17 Tue Jul 13 06:00:36 2004 +++ movitz/losp/muerte/scavenge.lisp Tue Jul 13 15:44:37 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Mar 29 14:54:08 2004 ;;;; -;;;; $Id: scavenge.lisp,v 1.17 2004/07/13 13:00:36 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.18 2004/07/13 22:44:37 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -150,7 +150,7 @@ (function (assert (= 0 (funobj-frame-num-unboxed funobj))) (map-heap-words function (+ nether-frame 2) frame)) - ((eql 0) + ((eql 0) ; An interrupt-frame? ;; 1. Scavenge the interrupt-frame (map-heap-words function (+ nether-frame 2)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/restarts.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-serv32704 Modified Files: restarts.lisp Log Message: Moved the with-simple-restart macro to more-macros.lisp. Date: Tue Jul 13 15:44:10 2004 Author: ffjeld Index: movitz/losp/muerte/restarts.lisp diff -u movitz/losp/muerte/restarts.lisp:1.2 movitz/losp/muerte/restarts.lisp:1.3 --- movitz/losp/muerte/restarts.lisp:1.2 Mon Jan 19 03:23:47 2004 +++ movitz/losp/muerte/restarts.lisp Tue Jul 13 15:44:10 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 28 09:27:13 2003 ;;;; -;;;; $Id: restarts.lisp,v 1.2 2004/01/19 11:23:47 ffjeld Exp $ +;;;; $Id: restarts.lisp,v 1.3 2004/07/13 22:44:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -198,12 +198,6 @@ (restart-format-control restart) (restart-args restart))))))) restart) - -(defmacro with-simple-restart ((name format-control &rest format-arguments) - &body body) - `(with-basic-restart (,name 'with-simple-restart nil nil - ,format-control ,@format-arguments) - ,@body)) ;;;;

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-serv31826 Modified Files: more-macros.lisp Log Message: Moved the with-simple-restart macro to more-macros.lisp. Date: Tue Jul 13 15:44:05 2004 Author: ffjeld Index: movitz/losp/muerte/more-macros.lisp diff -u movitz/losp/muerte/more-macros.lisp:1.13 movitz/losp/muerte/more-macros.lisp:1.14 --- movitz/losp/muerte/more-macros.lisp:1.13 Tue Jul 13 07:28:05 2004 +++ movitz/losp/muerte/more-macros.lisp Tue Jul 13 15:44: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.13 2004/07/13 14:28:05 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.14 2004/07/13 22:44:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -315,6 +315,12 @@ :eax) (:testb 3 :al) ; Just to be sure.. (:jnz '(:sub-program () (:int 63))))) + +(defmacro with-simple-restart ((name format-control &rest format-arguments) + &body body) + `(with-basic-restart (,name 'with-simple-restart nil nil + ,format-control ,@format-arguments) + ,@body)) ;;; 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-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