movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[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

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

17 Sep '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv14451 Modified Files: integers.lisp Log Message: Added rootn to implement sqrt and expt for ratio powers. Date: Sat Sep 17 03:44:29 2005 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.114 movitz/losp/muerte/integers.lisp:1.115 --- movitz/losp/muerte/integers.lisp:1.114 Sat Sep 17 01:02:19 2005 +++ movitz/losp/muerte/integers.lisp Sat Sep 17 03:44:29 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.114 2005/09/16 23:02:19 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.115 2005/09/17 01:44:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2175,6 +2175,26 @@ r))) (setf r next-r))))) +(defun rootn (x root) + (check-type root (integer 2 *)) + (let ((root-1 (1- root)) + (r (/ x root))) + (dotimes (i 10 r) + (let ((m (min (integer-length (numerator r)) + (integer-length (denominator r))))) + (when (>= m 32) + (setf r (/ (ash (numerator r) (- 24 m)) + (ash (denominator r) (- 24 m)))))) + #+ignore (format t "~&~D: ~X~%~D: ~F [~D ~D]~%" i r i r + (integer-length (numerator r)) + (integer-length (denominator r))) + (setf r (/ (+ (* root-1 r) + (/ x (expt r root-1))) + root))))) + +(defun sqrt (x) + (rootn x 2)) + (defun expt (base-number power-number) "Take base-number to the power-number." (etypecase power-number @@ -2187,6 +2207,10 @@ (do ((i 0 (1+ i)) (r 1 (* r base-number))) ((>= i power-number) r))) - ((integer * -1) - (/ (expt base-number (- power-number)))))) + ((real * -1) + (/ (expt base-number (- power-number)))) + (ratio + (expt (rootn base-number (denominator power-number)) + (numerator power-number))))) +

1 0

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

16 Sep '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3942 Modified Files: integers.lisp Log Message: Added expt with negative power-number. Date: Sat Sep 17 01:02:19 2005 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.113 movitz/losp/muerte/integers.lisp:1.114 --- movitz/losp/muerte/integers.lisp:1.113 Sat Sep 17 00:55:11 2005 +++ movitz/losp/muerte/integers.lisp Sat Sep 17 01:02:19 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.113 2005/09/16 22:55:11 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.114 2005/09/16 23:02:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2186,5 +2186,7 @@ (positive-bignum (do ((i 0 (1+ i)) (r 1 (* r base-number))) - ((>= i power-number) r))))) - + ((>= i power-number) r))) + ((integer * -1) + (/ (expt base-number (- power-number)))))) +

1 0

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

16 Sep '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv2947 Modified Files: integers.lisp Log Message: fast-compare-two-reals would fail for bignum comparison where a bignum of 8192 bigits (or 262144 bits) was involved. Date: Sat Sep 17 00:55:12 2005 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.112 movitz/losp/muerte/integers.lisp:1.113 --- movitz/losp/muerte/integers.lisp:1.112 Sat Sep 17 00:14:59 2005 +++ movitz/losp/muerte/integers.lisp Sat Sep 17 00:55:11 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.112 2005/09/16 22:14:59 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.113 2005/09/16 22:55:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -74,12 +74,14 @@ ;; Both n1 and n2 are positive bignums. (:shrl 16 :ecx) - (:cmpw :cx (:eax (:offset movitz-bignum length))) + (:movzxw (:eax (:offset movitz-bignum length)) :edx) + ;; (:cmpw :cx (:eax (:offset movitz-bignum length))) + (:cmpl :ecx :edx) (:jne '(:sub-program (positive-different-sizes) (:ret))) ;; Both n1 and n2 are positive bignums of the same size, namely ECX. - (:movl :ecx :edx) ; counter + ;; (:movl :ecx :edx) ; counter positive-compare-loop (:subl ,movitz:+movitz-fixnum-factor+ :edx) (:jz 'positive-compare-lsb) @@ -1053,10 +1055,6 @@ (i 0 (+ i 29))) ((>= i length) (bignum-canonicalize r)) (bignum-set-zerof tmp) - (when (get 'foo 'foo) - (format t "~&i: ~D, y: #x~X ~S/~S~%" i (ldb (byte 29 i) y) - (integer-length x) - (integer-length y))) (bignum-addf r (bignum-shift-leftf (bignum-mulf (bignum-addf tmp x) (ldb (byte 29 i) y)) i)))

1 0

[movitz-cvs] CVS update: movitz/special-operators-cl.lisp
by ffjeld＠common-lisp.net 16 Sep '05

16 Sep '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv2828 Modified Files: special-operators-cl.lisp Log Message: minor edits. Date: Sat Sep 17 00:50:08 2005 Author: ffjeld Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.48 movitz/special-operators-cl.lisp:1.49 --- movitz/special-operators-cl.lisp:1.48 Sun Aug 28 23:03:27 2005 +++ movitz/special-operators-cl.lisp Sat Sep 17 00:50:08 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 24 16:31:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: special-operators-cl.lisp,v 1.48 2005/08/28 21:03:27 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.49 2005/09/16 22:50:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1319,7 +1319,7 @@ ,cleanup-entry ;; First, restore stack-frame in EBP (:movl (:esp) :ebp) - ;; Now (?), modify unwind-protect dyn-env-entry to be normal continuation + ;; Now, modify unwind-protect dyn-env-entry to be normal continuation (:locally (:movl (:edi (:edi-offset unbound-function)) :edx)) (:movl :edx (:esp 4)) ; not unwind-protect-tag (:movl ',continue-label (:esp 8)) ; new jumper index @@ -1341,25 +1341,10 @@ (:store-lexical ,next-continuation-step-binding :eax :type t)) ,@cleanup-forms)) `((:locally (:popl (:edi (:edi-offset raw-scratch0)))) ; pop final continuation - -;;; ;; Now (?), modify unwind-protect dyn-env-entry to be normal continuation -;;; (:locally (:movl (:edi (:edi-offset unbound-value)) :edx)) -;;; (:movl :edx (:esp 4)) ; not unwind-protect-tag -;;; (:movl ',continue-label (:esp 8)) ; new jumper index - (:load-lexical ,next-continuation-step-binding :edx) (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) (:locally (:call (:edi (:edi-offset dynamic-jump-next)))) - -;;; (:locally (:movl :esi (:edi (:edi-offset scratch1)))) -;;; (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) -;;; (:movl :edx :esp) ; enter non-local jump stack mode (possibly). -;;; (:movl (:esp) :edx) ; target stack-frame EBP -;;; (:movl (:edx -4) :esi) ; get target funobj into EDX -;;; (:movl (:esp 8) :edx) ; target jumper number -;;; (:jmp (:esi :edx ,(slot-offset 'movitz-funobj 'constant0))) - ) - `(,continue + ,continue (:movl (:esp) :ebp) (:movl (:esp 12) :edx) (:locally (:movl :edx (:edi (:edi-offset dynamic-env))))

1 0

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

16 Sep '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv2810 Modified Files: eval.lisp Log Message: Fix eval of coerce. Date: Sat Sep 17 00:49:35 2005 Author: ffjeld Index: movitz/eval.lisp diff -u movitz/eval.lisp:1.9 movitz/eval.lisp:1.10 --- movitz/eval.lisp:1.9 Thu Dec 9 14:27:28 2004 +++ movitz/eval.lisp Sat Sep 17 00:49:34 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 20012000, 2002-2004, +;;;; Copyright (C) 2000-2005, ;;;; Department of Computer Science, University of Tromso, Norway ;;;; ;;;; Filename: eval.lisp @@ -9,7 +9,7 @@ ;;;; Created at: Thu Nov 2 17:45:05 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: eval.lisp,v 1.9 2004/12/09 13:27:28 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.10 2005/09/16 22:49:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -149,7 +149,7 @@ (cdr form)))) ((member operator '(muerte.cl:coerce)) (apply #'coerce - (mapcar (lambda (arg) (movitz-eval arg env nil)) + (mapcar (lambda (arg) (translate-program (movitz-eval arg env nil) :muerte.cl :cl)) (cdr form)))) ((and compiler-macro-function (not (movitz-env-get (car form) 'notinline nil env))

1 0

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

16 Sep '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv2783 Modified Files: io-port.lisp Log Message: Added (io-port :location). Date: Sat Sep 17 00:48:06 2005 Author: ffjeld Index: movitz/losp/muerte/io-port.lisp diff -u movitz/losp/muerte/io-port.lisp:1.18 movitz/losp/muerte/io-port.lisp:1.19 --- movitz/losp/muerte/io-port.lisp:1.18 Sat Aug 20 22:27:19 2005 +++ movitz/losp/muerte/io-port.lisp Sat Sep 17 00:48:06 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.18 2005/08/20 20:27:19 ffjeld Exp $ +;;;; $Id: io-port.lisp,v 1.19 2005/09/16 22:48:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -79,6 +79,15 @@ (:movl :edi :eax) (:movl :edi :edx) (:cld))) + (:location + `(with-inline-assembly (:returns :eax :type fixnum) + (:compile-form (:result-mode :edx) ,port) + (:std) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) + (:inl :dx :eax) + (:andl -8 :eax) + (:movl :edi :edx) + (:cld))) (:character `(with-inline-assembly (:returns :eax) (:compile-form (:result-mode :edx) ,port) @@ -99,6 +108,8 @@ (io-port port :unsigned-byte16)) (:unsigned-byte32 (io-port port :unsigned-byte32)) + (:location + (io-port port :location)) (:character (io-port port :character)))) @@ -260,6 +271,20 @@ (:movl :edi :edx) (:movl :edi :eax) (:cld)))) + (:location + `(let ((,value-var ,value) + (,port-var ,port)) + (with-inline-assembly (:returns :nothing) + (:load-lexical (:lexical-binding ,port-var) :edx) + (:load-lexical (:lexical-binding ,value-var) :eax) + (:andl -8 :eax) + (:std) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) + (:outl :eax :dx) + (:movl :edi :edx) + (:movl :edi :eax) + (:cld)) + ,value-var)) (:character `(let ((,value-var ,value) (,port-var ,port)) @@ -284,6 +309,8 @@ (setf (io-port port :unsigned-byte16) value)) (:unsigned-byte32 (setf (io-port port :unsigned-byte32) value)) + (:location + (setf (io-port port :location) value)) (:character (setf (io-port port :character) value)))) @@ -309,7 +336,7 @@ that reads from <io-base-form> plus some offset." (let ((io-var (gensym "io-base-"))) `(let ((,io-var (check-the (unsigned-byte 16) ,io-base-form))) - (symbol-macrolet ((,name ,io-var)) + (let ((,name ,io-var)) (macrolet ((,name (offset &optional (type :unsigned-byte8)) `(io-port (+ ,',io-var ,offset) ,type))) ,@body)))))

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs