September 2005 - movitz-cvs@common-lisp.net

[movitz-cvs] CVS update: movitz/losp/muerte/io-port.lisp
by ffjeld＠common-lisp.net 18 Sep '05

18 Sep '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv14485 Modified Files: io-port.lisp Log Message: Added ignorable declarations for with-io-register-syntax. Date: Sun Sep 18 18:21:25 2005 Author: ffjeld Index: movitz/losp/muerte/io-port.lisp diff -u movitz/losp/muerte/io-port.lisp:1.19 movitz/losp/muerte/io-port.lisp:1.20 --- movitz/losp/muerte/io-port.lisp:1.19 Sat Sep 17 00:48:06 2005 +++ movitz/losp/muerte/io-port.lisp Sun Sep 18 18:21:25 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Mar 21 22:14:08 2001 ;;;; -;;;; $Id: io-port.lisp,v 1.19 2005/09/16 22:48:06 ffjeld Exp $ +;;;; $Id: io-port.lisp,v 1.20 2005/09/18 16:21:25 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -337,6 +337,7 @@ (let ((io-var (gensym "io-base-"))) `(let ((,io-var (check-the (unsigned-byte 16) ,io-base-form))) (let ((,name ,io-var)) + (declare (ignorable ,name)) (macrolet ((,name (offset &optional (type :unsigned-byte8)) `(io-port (+ ,',io-var ,offset) ,type))) ,@body)))))

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by ffjeld＠common-lisp.net 18 Sep '05

18 Sep '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv14470 Modified Files: compiler.lisp Log Message: Teached the compiler to add a constant to :untagged-fixnum-ecx. Date: Sun Sep 18 18:20:35 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.164 movitz/compiler.lisp:1.165 --- movitz/compiler.lisp:1.164 Wed Sep 7 00:00:17 2005 +++ movitz/compiler.lisp Sun Sep 18 18:20:35 2005 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.164 2005/09/06 22:00:17 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.165 2005/09/18 16:20:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -7007,6 +7007,8 @@ ((eq :argument-stack (operator loc1)) `((:addl ,constant0 (:ebp ,(argument-stack-offset (binding-target term1)))))) + ((eq :untagged-fixnum-ecx (operator loc1)) + `((:addl ,(truncate constant0 +movitz-fixnum-factor+) :ecx))) (t (error "Don't know how to add this for loc1 ~S" loc1)))) ((and constant0 (integerp destination-location)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arithmetic-macros.lisp
by ffjeld＠common-lisp.net 18 Sep '05

18 Sep '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv14444 Modified Files: arithmetic-macros.lisp Log Message: Added proper inlining of logand when the mask is a constant (unsigned-byte 32). Date: Sun Sep 18 18:20:05 2005 Author: ffjeld Index: movitz/losp/muerte/arithmetic-macros.lisp diff -u movitz/losp/muerte/arithmetic-macros.lisp:1.14 movitz/losp/muerte/arithmetic-macros.lisp:1.15 --- movitz/losp/muerte/arithmetic-macros.lisp:1.14 Sun Sep 18 17:58:05 2005 +++ movitz/losp/muerte/arithmetic-macros.lisp Sun Sep 18 18:20:04 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Jul 17 13:42:46 2004 ;;;; -;;;; $Id: arithmetic-macros.lisp,v 1.14 2005/09/18 15:58:05 ffjeld Exp $ +;;;; $Id: arithmetic-macros.lisp,v 1.15 2005/09/18 16:20:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -293,7 +293,18 @@ (case (length constant-folded-integers) (0 0) (1 (first constant-folded-integers)) - (2 `(no-macro-call logand ,(first constant-folded-integers) ,(second constant-folded-integers))) + (2 (cond + ((typep (first constant-folded-integers) + '(unsigned-byte 32)) + (let ((x (first constant-folded-integers))) + `(with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte ,(integer-length x))) + (:compile-form (:result-mode :untagged-fixnum-ecx) + ,(second constant-folded-integers)) + (:andl ,x :ecx)))) + (t `(no-macro-call logand + ,(first constant-folded-integers) + ,(second constant-folded-integers))))) (t `(logand (logand ,(first constant-folded-integers) ,(second constant-folded-integers)) ,@(cddr constant-folded-integers))))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
by ffjeld＠common-lisp.net 18 Sep '05

18 Sep '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv12001 Modified Files: integers.lisp Log Message: Changed the bytespec representation back to integers. The longest bignum is (expt 2 20) bits, so that's what we use for the position. Most bytespec's sizes will fit in the 9 bits remaining in a fixnum. Date: Sun Sep 18 17:58:10 2005 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.118 movitz/losp/muerte/integers.lisp:1.119 --- movitz/losp/muerte/integers.lisp:1.118 Sun Sep 18 17:09:22 2005 +++ movitz/losp/muerte/integers.lisp Sun Sep 18 17:58:09 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.118 2005/09/18 15:09:22 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.119 2005/09/18 15:58:09 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1396,13 +1396,15 @@ ;;; bytes (defun byte (size position) - (cons size position)) + (check-type size positive-fixnum) + (let ((position (check-the (unsigned-byte 20) position))) + (+ position (ash size 20)))) (defun byte-size (bytespec) - (car bytespec)) + (ash bytespec -20)) (defun byte-position (bytespec) - (cdr bytespec)) + (ldb (byte 20 0) bytespec)) (defun logbitp (index integer) (check-type index positive-fixnum)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arithmetic-macros.lisp
by ffjeld＠common-lisp.net 18 Sep '05

18 Sep '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11984 Modified Files: arithmetic-macros.lisp Log Message: Changed the bytespec representation back to integers. The longest bignum is (expt 2 20) bits, so that's what we use for the position. Most bytespec's sizes will fit in the 9 bits remaining in a fixnum. Date: Sun Sep 18 17:58:06 2005 Author: ffjeld Index: movitz/losp/muerte/arithmetic-macros.lisp diff -u movitz/losp/muerte/arithmetic-macros.lisp:1.13 movitz/losp/muerte/arithmetic-macros.lisp:1.14 --- movitz/losp/muerte/arithmetic-macros.lisp:1.13 Sun Sep 18 17:09:15 2005 +++ movitz/losp/muerte/arithmetic-macros.lisp Sun Sep 18 17:58:05 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Jul 17 13:42:46 2004 ;;;; -;;;; $Id: arithmetic-macros.lisp,v 1.13 2005/09/18 15:09:15 ffjeld Exp $ +;;;; $Id: arithmetic-macros.lisp,v 1.14 2005/09/18 15:58:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -273,9 +273,11 @@ (cond ((and (movitz:movitz-constantp size env) (movitz:movitz-constantp position env)) - `(quote ,(cons (movitz:movitz-eval size env) - (movitz:movitz-eval position env)))) - (t `(cons ,size ,position)))) + (let ((size (movitz:movitz-eval size env)) + (position (movitz:movitz-eval position env))) + (check-type position (unsigned-byte 20)) + (+ position (ash size 20)))) + (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/integers.lisp
by ffjeld＠common-lisp.net 18 Sep '05

18 Sep '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv8880 Modified Files: integers.lisp Log Message: Changed representation of bytespecs to be cons-cells. Date: Sun Sep 18 17:09:22 2005 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.117 movitz/losp/muerte/integers.lisp:1.118 --- movitz/losp/muerte/integers.lisp:1.117 Sun Sep 18 16:42:21 2005 +++ movitz/losp/muerte/integers.lisp Sun Sep 18 17:09:22 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.117 2005/09/18 14:42:21 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.118 2005/09/18 15:09:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1396,14 +1396,13 @@ ;;; bytes (defun byte (size position) - (check-type position (integer 0 #x3ff)) - (+ (* size #x400) position)) + (cons size position)) (defun byte-size (bytespec) - (values (truncate bytespec #x400))) + (car bytespec)) (defun byte-position (bytespec) - (rem bytespec #x400)) + (cdr bytespec)) (defun logbitp (index integer) (check-type index positive-fixnum) @@ -2082,7 +2081,6 @@ (:jnz 'count-loop))) (positive-bignum (bignum-logcount integer)))) - (defun dpb (newbyte bytespec integer) (logior (if (= 0 newbyte)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arithmetic-macros.lisp
by ffjeld＠common-lisp.net 18 Sep '05

18 Sep '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv8862 Modified Files: arithmetic-macros.lisp Log Message: Changed representation of bytespecs to be cons-cells. Date: Sun Sep 18 17:09:15 2005 Author: ffjeld Index: movitz/losp/muerte/arithmetic-macros.lisp diff -u movitz/losp/muerte/arithmetic-macros.lisp:1.12 movitz/losp/muerte/arithmetic-macros.lisp:1.13 --- movitz/losp/muerte/arithmetic-macros.lisp:1.12 Sun Sep 18 16:23:48 2005 +++ movitz/losp/muerte/arithmetic-macros.lisp Sun Sep 18 17:09:15 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Jul 17 13:42:46 2004 ;;;; -;;;; $Id: arithmetic-macros.lisp,v 1.12 2005/09/18 14:23:48 ffjeld Exp $ +;;;; $Id: arithmetic-macros.lisp,v 1.13 2005/09/18 15:09:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -268,14 +268,14 @@ (t `(no-macro-call * ,factor1 ,factor2))))) (t `(* (* ,(first operands) ,(second operands)) ,@(cddr operands))))) -(define-compiler-macro byte (&whole form size position) + +(define-compiler-macro byte (&whole form size position &environment env) (cond - ((and (integerp size) - (integerp position)) - (+ (* size #x400) position)) - ((integerp size) - `(+ ,position ,(* size #x400))) - (t form))) + ((and (movitz:movitz-constantp size env) + (movitz:movitz-constantp position env)) + `(quote ,(cons (movitz:movitz-eval size env) + (movitz:movitz-eval position env)))) + (t `(cons ,size ,position)))) (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/integers.lisp
by ffjeld＠common-lisp.net 18 Sep '05

18 Sep '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6822 Modified Files: integers.lisp Log Message: Added lcm. Date: Sun Sep 18 16:42:21 2005 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.116 movitz/losp/muerte/integers.lisp:1.117 --- movitz/losp/muerte/integers.lisp:1.116 Sun Sep 18 16:23:44 2005 +++ movitz/losp/muerte/integers.lisp Sun Sep 18 16:42:21 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.116 2005/09/18 14:23:44 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.117 2005/09/18 14:42:21 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2137,6 +2137,18 @@ (gcd gcd (car rest))) (rest (cdr integers) (cdr rest))) ((null rest) gcd))))) + +(defun lcm (&rest numbers) + "Returns the least common multiple of one or more integers. LCM of no + arguments is defined to be 1." + (numargs-case + (1 (n) + (abs n)) + (2 (n m) + (abs (* (truncate (max n m) (gcd n m)) (min n m)))) + (t (&rest numbers) + (declare (dynamic-extent numbers)) + (reduce #'lcm numbers)))) (defun floor (n &optional (divisor 1)) "This is floor written in terms of truncate."

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arithmetic-macros.lisp
by ffjeld＠common-lisp.net 18 Sep '05

18 Sep '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv5571 Modified Files: arithmetic-macros.lisp Log Message: Added (deftype number). Date: Sun Sep 18 16:24:01 2005 Author: ffjeld Index: movitz/losp/muerte/arithmetic-macros.lisp diff -u movitz/losp/muerte/arithmetic-macros.lisp:1.11 movitz/losp/muerte/arithmetic-macros.lisp:1.12 --- movitz/losp/muerte/arithmetic-macros.lisp:1.11 Wed Aug 24 09:31:34 2005 +++ movitz/losp/muerte/arithmetic-macros.lisp Sun Sep 18 16:23:48 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Jul 17 13:42:46 2004 ;;;; -;;;; $Id: arithmetic-macros.lisp,v 1.11 2005/08/24 07:31:34 ffjeld Exp $ +;;;; $Id: arithmetic-macros.lisp,v 1.12 2005/09/18 14:23:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -606,7 +606,9 @@ (deftype real (&optional (lower-limit '*) (upper-limit '*)) `(or (integer ,lower-limit ,upper-limit) (rational ,lower-limit ,upper-limit))) - + +(deftype number (&optional (lower-limit '*) (upper-limit '*)) + `(real ,lower-limit ,upper-limit)) (define-simple-typep (bit bitp) (x) (or (eq x 0) (eq x 1)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
by ffjeld＠common-lisp.net 18 Sep '05

18 Sep '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv5553 Modified Files: integers.lisp Log Message: Added (deftype number). Date: Sun Sep 18 16:23:46 2005 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.115 movitz/losp/muerte/integers.lisp:1.116 --- movitz/losp/muerte/integers.lisp:1.115 Sat Sep 17 03:44:29 2005 +++ movitz/losp/muerte/integers.lisp Sun Sep 18 16:23:44 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.115 2005/09/17 01:44:29 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.116 2005/09/18 14:23:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2207,7 +2207,7 @@ (do ((i 0 (1+ i)) (r 1 (* r base-number))) ((>= i power-number) r))) - ((real * -1) + ((number * -1) (/ (expt base-number (- power-number)))) (ratio (expt (rootn base-number (denominator power-number))

1 0