movitz-cvs September 2005

movitz-cvs@common-lisp.net

1 participants
21 discussions

[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

[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-serv32150 Modified Files: integers.lisp Log Message: Fixed bug in ldb%byte that would erroneously return 0 for byte-positions above #x4000. (same bug present at anoter spot.) Date: Sat Sep 17 00:14:59 2005 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.111 movitz/losp/muerte/integers.lisp:1.112 --- movitz/losp/muerte/integers.lisp:1.111 Sat Sep 17 00:05:46 2005 +++ movitz/losp/muerte/integers.lisp Sat Sep 17 00:14:59 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.111 2005/09/16 22:05:46 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.112 2005/09/16 22:14:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1862,7 +1862,8 @@ (:compile-form (:result-mode :ebx) integer) (:compile-form (:result-mode :ecx) position) (:shrl 5 :ecx) ; compute fixnum bigit-number in ecx - (:cmpl #x4000 :ecx) + (:cmpl ,(* #x4000 movitz:+movitz-fixnum-factor+) + :ecx) (:jnc 'position-outside-integer) (:cmpw :cx (:ebx (:offset movitz-bignum length))) (:jbe '(:sub-program (position-outside-integer)

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-serv31870 Modified Files: integers.lisp Log Message: Fixed bug in ldb%byte that would erroneously return 0 for byte-positions above #x4000. Date: Sat Sep 17 00:05:46 2005 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.110 movitz/losp/muerte/integers.lisp:1.111 --- movitz/losp/muerte/integers.lisp:1.110 Thu Sep 1 00:34:14 2005 +++ movitz/losp/muerte/integers.lisp Sat Sep 17 00:05:46 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.110 2005/08/31 22:34:14 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.111 2005/09/16 22:05:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1053,6 +1053,10 @@ (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))) @@ -1797,7 +1801,8 @@ (:sarl 5 :ecx) (:andl -4 :ecx) (:addl 4 :ecx) - (:cmpl #x4000 :ecx) + (:cmpl ,(* #x4000 movitz:+movitz-fixnum-factor+) + :ecx) (:jae 'position-outside-integer) (:cmpw :cx (:ebx (:offset movitz-bignum length))) (:jc '(:sub-program (position-outside-integer) @@ -2173,7 +2178,14 @@ (defun expt (base-number power-number) "Take base-number to the power-number." - (do ((i 0 (1+ i)) - (r 1 (* r base-number))) - ((>= i power-number) r))) + (etypecase power-number + (positive-fixnum + (do ((i 0 (1+ i)) + (r 1 (* r base-number))) + ((>= i power-number) r) + (declare (index i)))) + (positive-bignum + (do ((i 0 (1+ i)) + (r 1 (* r base-number))) + ((>= i power-number) r)))))

1 0

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

06 Sep '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv6951 Modified Files: compiler.lisp Log Message: Fixed bug in make-load-lexical: Loading a constant into :untagged-fixnum-ecx would load the boxed fixnum rather than the unboxed value. Date: Wed Sep 7 00:00:18 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.163 movitz/compiler.lisp:1.164 --- movitz/compiler.lisp:1.163 Fri Sep 2 00:52:58 2005 +++ movitz/compiler.lisp Wed Sep 7 00:00:17 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.163 2005/09/01 22:52:58 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.164 2005/09/06 22:00:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -3546,7 +3546,7 @@ (type-specifier-singleton decoded-type)) #+ignore (warn "Immloadlex: ~S" (type-specifier-singleton decoded-type)) - (make-immediate-move (movitz-immediate-value + (make-immediate-move (movitz-fixnum-value (car (type-specifier-singleton decoded-type))) :ecx)) ((and binding-type

1 0

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

01 Sep '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv31319 Modified Files: interrupt.lisp Log Message: sync Date: Fri Sep 2 00:53:53 2005 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.48 movitz/losp/muerte/interrupt.lisp:1.49 --- movitz/losp/muerte/interrupt.lisp:1.48 Fri Aug 26 21:40:32 2005 +++ movitz/losp/muerte/interrupt.lisp Fri Sep 2 00:53:53 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.48 2005/08/26 19:40:32 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.49 2005/09/01 22:53:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -348,7 +348,7 @@ (princ "Halting CPU due to stack exhaustion.") (halt-cpu)) ((<= stack-left 1024) - (backtrace :print-frames t) + #+ignore (backtrace :print-frames t) (halt-cpu) #+ignore (format *debug-io* @@ -363,6 +363,7 @@ (format *debug-io* "~&Stack-warning: Bumped stack-bottom by ~D to #x~X. Reset ES.~%" (- old-bottom new-bottom) new-bottom) + (backtrace :length 5 :spartan t) (break "Stack overload exception ~D at EIP=~@Z, ESP=~@Z, bottom=#x~X, ENV=#x~X." vector $eip (dit-frame-esp nil dit-frame)

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs September 2005