October 2004 - movitz-cvs@common-lisp.net

[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv2604 Modified Files: arrays.lisp Log Message: Minor edits. Date: Thu Oct 21 22:30:08 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.45 movitz/losp/muerte/arrays.lisp:1.46 --- movitz/losp/muerte/arrays.lisp:1.45 Mon Oct 11 15:52:12 2004 +++ movitz/losp/muerte/arrays.lisp Thu Oct 21 22:30:07 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sun Feb 11 23:14:04 2001 ;;;; -;;;; $Id: arrays.lisp,v 1.45 2004/10/11 13:52:12 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.46 2004/10/21 20:30:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -764,8 +764,9 @@ (:addl 4 :ecx) (:andl -8 :ecx) (:jz 'init-done) + (:load-lexical (:lexical-binding initial-element) :edx) init-loop - (:movl :edi (:eax (:offset movitz-basic-vector data) :ecx -4)) + (:movl :edx (:eax (:offset movitz-basic-vector data) :ecx -4)) (:subl 4 :ecx) (:jnz 'init-loop) init-done @@ -779,6 +780,7 @@ (cond (initial-contents (replace array initial-contents)) + #+ignore (initial-element (dotimes (i dimension) (setf (svref%unsafe array i) initial-element))))

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/debugger.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv2447 Modified Files: debugger.lisp Log Message: Typo: slot-value should be symbol-value. Date: Thu Oct 21 22:27:00 2004 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.26 movitz/losp/x86-pc/debugger.lisp:1.27 --- movitz/losp/x86-pc/debugger.lisp:1.26 Sat Sep 25 17:53:25 2004 +++ movitz/losp/x86-pc/debugger.lisp Thu Oct 21 22:27:00 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 22 10:09:18 2002 ;;;; -;;;; $Id: debugger.lisp,v 1.26 2004/09/25 15:53:25 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.27 2004/10/21 20:27:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -500,7 +500,7 @@ (cond ((eq 0 casf-funobj) (values 'default-interrupt-trampoline - (code-vector-offset (slot-value 'default-interrupt-trampoline) + (code-vector-offset (symbol-value 'default-interrupt-trampoline) eip))) ((not (typep casf-funobj 'function)) ;; Hm.. very suspicius

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/memref.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv25516 Modified Files: memref.lisp Log Message: Added :signed-byte8 to memref-int compiler-macro. Date: Thu Oct 21 18:31:36 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.34 movitz/losp/muerte/memref.lisp:1.35 --- movitz/losp/muerte/memref.lisp:1.34 Wed Oct 20 12:51:06 2004 +++ movitz/losp/muerte/memref.lisp Thu Oct 21 18:31:35 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 6 21:25:49 2001 ;;;; -;;;; $Id: memref.lisp,v 1.34 2004/10/20 10:51:06 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.35 2004/10/21 16:31:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -785,6 +785,23 @@ (:addl :ebx :ecx) (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale down address (,prefixes :movzxb (:ecx) :ecx))))))) + (:signed-byte8 + (cond + ((and (eq 0 offset) (eq 0 index)) + `(with-inline-assembly (:returns :ecx :type (signed-byte 8)) + (:compile-form (:result-mode :untagged-fixnum-ecx) ,address) + (,prefixes :movsxb (:ecx) :ecx) + (:shll ,movitz:+movitz-fixnum-shift+ :ecx))) + (t (let ((address-var (gensym "memref-int-address-"))) + `(let ((,address-var ,address)) + (with-inline-assembly (:returns :ecx :type (signed-byte 8)) + (:compile-two-forms (:eax :ecx) ,offset ,index) + (:load-lexical (:lexical-binding ,address-var) :ebx) + (:addl :eax :ecx) + (:addl :ebx :ecx) + (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale down address + (,prefixes :movsxb (:ecx) :ecx) + (:shll ,movitz:+movitz-fixnum-shift+ :ecx))))))) (:unsigned-byte16 (cond ((and (eq 0 offset) (eq 0 index))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/memref.lisp
by Frode Vatvedt Fjeld 20 Oct '04

20 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6012 Modified Files: memref.lisp Log Message: Improved (memref :code-vector), and bug-fixed (memref-int :unsigned-byte8) which in fact behaved as :unsigned-byte16. Date: Wed Oct 20 12:51:07 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.33 movitz/losp/muerte/memref.lisp:1.34 --- movitz/losp/muerte/memref.lisp:1.33 Tue Oct 12 16:52:07 2004 +++ movitz/losp/muerte/memref.lisp Wed Oct 20 12:51:06 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 6 21:25:49 2001 ;;;; -;;;; $Id: memref.lisp,v 1.33 2004/10/12 14:52:07 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.34 2004/10/20 10:51:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -316,6 +316,20 @@ (:compile-two-forms (:ebx :untagged-fixnum-ecx) ,object ,offset) (:movl ,(ldb (byte 32 0) (- movitz:+code-vector-word-offset+)) :eax) (:addl (:ebx :ecx ,(offset-by 4)) :eax))) + (t (let ((object-var (gensym "memref-object-")) + (offset-var (gensym "memref-offset-")) + (index-var (gensym "memref-index-"))) + `(let ((,object-var ,object) + (,offset-var ,offset) + (,index-var ,index)) + (with-inline-assembly (:returns :eax) + (:load-lexical (:lexical-binding ,offset-var) :untagged-fixnum-ecx) + (:load-lexical (:lexical-binding ,object-var) :ebx) + (:load-lexical (:lexical-binding ,index-var) :edx) + (:addl :edx :ecx) + (:movl ,(ldb (byte 32 0) (- movitz:+code-vector-word-offset+)) :eax) + (:addl (:ebx :ecx ,(offset-by 4)) :eax))))) + #+ignore (t (error "variable memref type :code-vector not implemented.")) #+ignore (t (assert (not (movitz:movitz-constantp offset env))) @@ -341,12 +355,13 @@ (:character (memref object offset :index index :type :character)) (:unsigned-byte8 (memref object offset :index index :type :unsigned-byte8)) (:location (memref object offset :index index :type :location)) - (:unsigned-byte14 (memref object offset :index index :type :unsigned-byte14)) (:unsigned-byte16 (ecase endian ((:host :little) (memref object offset :index index :type :unsigned-byte16 :endian :little)) ((:big) - (memref object offset :index index :type :unsigned-byte16 :endian :big)))))) + (memref object offset :index index :type :unsigned-byte16 :endian :big)))) + (:code-vector (memref object offset :index index :type :code-vector)) + (:unsigned-byte14 (memref object offset :index index :type :unsigned-byte14)))) ;;; (:signed-byte30+2 (memref object offset index :signed-byte30+2)) ;;; (:unsigned-byte29+3 (memref object offset index :unsigned-byte29+3)))) @@ -756,18 +771,20 @@ (:unsigned-byte8 (cond ((and (eq 0 offset) (eq 0 index)) - `(with-inline-assembly (:returns :untagged-fixnum-ecx) + `(with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 8)) (:compile-form (:result-mode :untagged-fixnum-ecx) ,address) - (,prefixes :movzxw (:ecx) :ecx))) + (,prefixes :movzxb (:ecx) :ecx))) (t (let ((address-var (gensym "memref-int-address-"))) `(let ((,address-var ,address)) - (with-inline-assembly (:returns :untagged-fixnum-ecx) + (with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 8)) (:compile-two-forms (:eax :ecx) ,offset ,index) (:load-lexical (:lexical-binding ,address-var) :ebx) (:addl :eax :ecx) (:addl :ebx :ecx) (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale down address - (,prefixes :movzxw (:ecx) :ecx))))))) + (,prefixes :movzxb (:ecx) :ecx))))))) (:unsigned-byte16 (cond ((and (eq 0 offset) (eq 0 index))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/memref.lisp
by Frode Vatvedt Fjeld 12 Oct '04

12 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv27208 Modified Files: memref.lisp Log Message: Have memref provide the correct type in more cases. I.e. an :unsigned-byte16 memref becomes a (unsigned-byte 16) type etc. Date: Tue Oct 12 16:52:07 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.32 movitz/losp/muerte/memref.lisp:1.33 --- movitz/losp/muerte/memref.lisp:1.32 Mon Oct 11 15:53:01 2004 +++ movitz/losp/muerte/memref.lisp Tue Oct 12 16:52:07 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 6 21:25:49 2001 ;;;; -;;;; $Id: memref.lisp,v 1.32 2004/10/11 13:53:01 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.33 2004/10/12 14:52:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -98,7 +98,8 @@ (:big `((:xchgb :cl :ch)))))) (cond ((and (eq 0 offset) (eq 0 index)) - `(with-inline-assembly (:returns :untagged-fixnum-ecx) + `(with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 16)) (:compile-form (:result-mode :eax) ,object) (:movzxw (:eax ,(offset-by 2)) :ecx) ,@endian-fix-ecx)) @@ -118,7 +119,8 @@ `(let ((,object-var ,object) (,offset-var ,offset) (,index-var ,index)) - (with-inline-assembly (:returns :untagged-fixnum-ecx) + (with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 16)) (:compile-two-forms (:ecx :ebx) ,offset-var ,index-var) (:leal (:ecx (:ebx 2)) :ecx) (:load-lexical (:lexical-binding ,object-var) :eax) @@ -217,18 +219,18 @@ (assert (= 4 movitz::+movitz-fixnum-factor+)) (cond ((and (eq 0 offset) (eq 0 index)) - `(with-inline-assembly (:returns :ecx) + `(with-inline-assembly (:returns :ecx :type (unsigned-byte 29)) (:compile-form (:result-mode :eax) ,object) (:movl (:eax ,(offset-by 4)) :ecx) (:andl -4 :ecx))) ((eq 0 offset) - `(with-inline-assembly (:returns :ecx) + `(with-inline-assembly (:returns :ecx :type (unsigned-byte 29)) (:compile-two-forms (:eax :ecx) ,object ,index) (:movl (:eax :ecx ,(offset-by 4)) :ecx) (:andl -4 :ecx))) (t (let ((object-var (gensym "memref-object-"))) `(let ((,object-var ,object)) - (with-inline-assembly (:returns :ecx) + (with-inline-assembly (:returns :ecx :type (unsigned-byte 29)) (:compile-two-forms (:ecx :ebx) ,offset ,index) (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) (:load-lexical (:lexical-binding ,object-var) :eax) @@ -241,16 +243,19 @@ (assert (= 4 movitz::+movitz-fixnum-factor+)) (cond ((and (eq 0 offset) (eq 0 index)) - `(with-inline-assembly (:returns :untagged-fixnum-ecx) + `(with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 32)) (:compile-form (:result-mode :eax) ,object) (:movl (:eax ,(offset-by 4)) :ecx))) ((eq 0 offset) - `(with-inline-assembly (:returns :untagged-fixnum-ecx) + `(with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 32)) (:compile-two-forms (:eax :ecx) ,object ,index) (:movl (:eax :ecx ,(offset-by 4)) :ecx))) (t (let ((object-var (gensym "memref-object-"))) `(let ((,object-var ,object)) - (with-inline-assembly (:returns :untagged-fixnum-ecx) + (with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 32)) (:compile-two-forms (:ecx :ebx) ,offset ,index) (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) (:load-lexical (:lexical-binding ,object-var) :eax)

1 0

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

12 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv26496 Modified Files: symbols.lisp Log Message: Fixed some symbol accessors to use memref rather than inline assembly. Date: Tue Oct 12 16:45:17 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.20 movitz/losp/muerte/symbols.lisp:1.21 --- movitz/losp/muerte/symbols.lisp:1.20 Mon Oct 11 15:53:28 2004 +++ movitz/losp/muerte/symbols.lisp Tue Oct 12 16:45:16 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.20 2004/10/11 13:53:28 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.21 2004/10/12 14:45:16 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -211,19 +211,16 @@ (etypecase symbol (null #.(bt:enum-value 'movitz::movitz-symbol-flags '(:constant-variable))) (symbol - (with-inline-assembly (:returns :untagged-fixnum-eax) - (:compile-form (:result-mode :eax) symbol) - (:movzxw (:eax #.(bt:slot-offset 'movitz::movitz-symbol 'movitz::flags)) :eax))))) + (memref symbol (movitz-type-slot-offset 'movitz-symbol 'flags) + :type :unsigned-byte16)))) (defun (setf symbol-flags) (flags symbol) (etypecase symbol (null (error "Can't set NIL's flags.")) (symbol - (with-inline-assembly (:returns :nothing) - (:compile-form (:result-mode :ebx) symbol) - (:compile-form (:result-mode :untagged-fixnum-eax) flags) - (:movw :ax (:ebx #.(bt:slot-offset 'movitz::movitz-symbol 'movitz::flags)))) - flags))) + (setf (memref symbol (movitz-type-slot-offset 'movitz-symbol 'flags) + :type :unsigned-byte16) + flags)))) (defun symbol-special-variable-p (symbol) (logbitp 3 (symbol-flags symbol)))

1 0

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

12 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv26225 Modified Files: integers.lisp Log Message: Fixed incredibly stupid bug in ratio multiplication. Date: Tue Oct 12 16:43:56 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.99 movitz/losp/muerte/integers.lisp:1.100 --- movitz/losp/muerte/integers.lisp:1.99 Tue Oct 12 12:51:47 2004 +++ movitz/losp/muerte/integers.lisp Tue Oct 12 16:43:55 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.99 2004/10/12 10:51:47 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.100 2004/10/12 14:43:55 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1152,7 +1152,7 @@ (incf r (ash (* x (ldb (byte 29 i) y)) i))))) ((ratio ratio) (make-rational (* (ratio-numerator x) (ratio-numerator y)) - (* (ratio-denominator x) (ratio-denominator x)))) + (* (ratio-denominator x) (ratio-denominator y)))) ((ratio t) (make-rational (* y (ratio-numerator x)) (ratio-denominator x)))

1 0

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

12 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv26193 Modified Files: functions.lisp Log Message: Removed some usage of the deprecated mode :untagged-fixnum-eax. Date: Tue Oct 12 16:43:28 2004 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.22 movitz/losp/muerte/functions.lisp:1.23 --- movitz/losp/muerte/functions.lisp:1.22 Mon Oct 11 15:52:34 2004 +++ movitz/losp/muerte/functions.lisp Tue Oct 12 16:43:27 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.22 2004/10/11 13:52:34 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.23 2004/10/12 14:43:27 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -166,15 +166,14 @@ (:compile-form (:result-mode :ebx) funobj) (:compile-form (:result-mode :eax) code-vector) (:addl 2 :eax) ; this cell stores word+2 - (:movl :eax (:ebx #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector%1op))))) + (:movl :eax (:ebx (:offset movitz-funobj code-vector%1op))))) (integer (with-inline-assembly (:returns :nothing) (:compile-form (:result-mode :ebx) funobj) - (:movl (:ebx #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector)) :eax) - (:movl :eax (:ebx #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector%1op))) - (:compile-form (:result-mode :untagged-fixnum-eax) code-vector) - (:addl :eax (:ebx #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector%1op))) - (:xorl :eax :eax)))) + (:movl (:ebx (:offset movitz-funobj code-vector)) :eax) + (:movl :eax (:ebx (:offset movitz-funobj code-vector%1op))) + (:compile-form (:result-mode :untagged-fixnum-ecx) code-vector) + (:addl :ecx (:ebx (:offset movitz-funobj code-vector%1op)))))) code-vector) (defun funobj-code-vector%2op (funobj) @@ -227,15 +226,14 @@ (:compile-form (:result-mode :ebx) funobj) (:compile-form (:result-mode :eax) code-vector) (:addl 2 :eax) ; this cell stores word+2 - (:movl :eax (:ebx #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector%2op))))) + (:movl :eax (:ebx (:offset movitz-funobj code-vector%2op))))) (integer (with-inline-assembly (:returns :nothing) (:compile-form (:result-mode :ebx) funobj) - (:movl (:ebx #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector)) :eax) - (:movl :eax (:ebx #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector%2op))) - (:compile-form (:result-mode :untagged-fixnum-eax) code-vector) - (:addl :eax (:ebx #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector%2op))) - (:xorl :eax :eax)))) + (:movl (:ebx (:offset movitz-funobj code-vector)) :eax) + (:movl :eax (:ebx (:offset movitz-funobj code-vector%2op))) + (:compile-form (:result-mode :untagged-fixnum-ecx) code-vector) + (:addl :ecx (:ebx (:offset movitz-funobj code-vector%2op)))))) code-vector) (defun funobj-code-vector%3op (funobj) @@ -288,15 +286,14 @@ (:compile-form (:result-mode :ebx) funobj) (:compile-form (:result-mode :eax) code-vector) (:addl 2 :eax) ; this cell stores word+2 - (:movl :eax (:ebx #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector%3op))))) + (:movl :eax (:ebx (:offset movitz-funobj code-vector%3op))))) (integer (with-inline-assembly (:returns :nothing) (:compile-form (:result-mode :ebx) funobj) - (:movl (:ebx #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector)) :eax) - (:movl :eax (:ebx #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector%3op))) - (:compile-form (:result-mode :untagged-fixnum-eax) code-vector) - (:addl :eax (:ebx #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector%3op))) - (:xorl :eax :eax)))) + (:movl (:ebx (:offset movitz-funobj code-vector)) :eax) + (:movl :eax (:ebx (:offset movitz-funobj code-vector%3op))) + (:compile-form (:result-mode :untagged-fixnum-ecx) code-vector) + (:addl :ecx (:ebx (:offset movitz-funobj code-vector%3op)))))) code-vector) (defun funobj-name (funobj)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/format.lisp
by Frode Vatvedt Fjeld 12 Oct '04

12 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv26161 Modified Files: format.lisp Log Message: Fixed format-float (used by ~F) to handle negative numbers. Date: Tue Oct 12 16:42:42 2004 Author: ffjeld Index: movitz/losp/muerte/format.lisp diff -u movitz/losp/muerte/format.lisp:1.7 movitz/losp/muerte/format.lisp:1.8 --- movitz/losp/muerte/format.lisp:1.7 Sat Jul 31 00:15:23 2004 +++ movitz/losp/muerte/format.lisp Tue Oct 12 16:42:41 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Mar 23 01:18:36 2002 ;;;; -;;;; $Id: format.lisp,v 1.7 2004/07/30 22:15:23 ffjeld Exp $ +;;;; $Id: format.lisp,v 1.8 2004/10/12 14:42:41 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -60,26 +60,29 @@ (write x)))) (defun format-float (x &optional at-sign-p colon-p w d (k 0) overflowchar padchar) - (declare (ignore w overflowchar padchar at-sign-p colon-p)) - (if (eql 0 d) - (write-integer (round x) *standard-output* 10 nil) - (multiple-value-bind (integer-part decimal-part) - (truncate x) - (write-integer integer-part *standard-output* 10 nil) - (dotimes (i k) - (write-char #\0)) - (write-char #\.) - (do ((remainder decimal-part) - (last-i (if d (1- d) 15)) - (i 0 (1+ i))) - ((or (and (not d) (plusp i) (zerop remainder)) - (> i last-i))) - (multiple-value-bind (next-digit next-remainder) - (if (= i last-i) - (round (* 10 remainder)) - (truncate (* 10 remainder))) - (setf remainder next-remainder) - (write-digit next-digit *standard-output*)))))) + (cond + ((eql 0 d) + (write-integer (round x) *standard-output* 10 nil)) + ((minusp x) + (write-char #\-) + (format-float (- x) at-sign-p colon-p w d k overflowchar padchar)) + (t (multiple-value-bind (integer-part decimal-part) + (truncate x) + (write-integer integer-part *standard-output* 10 nil) + (dotimes (i k) + (write-char #\0)) + (write-char #\.) + (do ((remainder decimal-part) + (last-i (if d (1- d) 15)) + (i 0 (1+ i))) + ((or (and (not d) (plusp i) (zerop remainder)) + (> i last-i))) + (multiple-value-bind (next-digit next-remainder) + (if (= i last-i) + (round (* 10 remainder)) + (truncate (* 10 remainder))) + (setf remainder next-remainder) + (write-digit next-digit *standard-output*))))))) (defun find-directive (string i directive &optional recursive-skip-start (recursive-skip-end directive))

1 0

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

12 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11825 Modified Files: integers.lisp Log Message: Fixed one-operand - and two-operand / on ratios. Date: Tue Oct 12 12:51:47 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.98 movitz/losp/muerte/integers.lisp:1.99 --- movitz/losp/muerte/integers.lisp:1.98 Mon Oct 11 15:52:50 2004 +++ movitz/losp/muerte/integers.lisp Tue Oct 12 12:51:47 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.98 2004/10/11 13:52:50 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.99 2004/10/12 10:51:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -688,44 +688,23 @@ (declare (dynamic-extent subtrahends)) (numargs-case (1 (x) - (macrolet - ((do-it () - `(with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) x) - (:testb ,movitz:+movitz-fixnum-zmask+ :al) - (:jnz '(:sub-program (not-fixnum) - (:leal (:eax ,(- (movitz:tag :other))) :ecx) - (:testb 7 :cl) - (:jnz '(:sub-program (not-a-number) - (:compile-form (:result-mode :ignore) - (if (typep x 'ratio) - (make-rational (- (%ratio-numerator x)) - (%ratio-denominator x)) - (error 'type-error :expected-type 'number :datum x))))) - (:movl (:eax ,movitz:+other-type-offset+) :ecx) - (:cmpb ,(movitz:tag :bignum) :cl) - (:jne 'not-a-number) - (:cmpl ,(dpb 4 (byte 16 16) (movitz:tag :bignum 0)) :ecx) - (:jne 'not-most-negative-fixnum) - (:cmpl ,(- most-negative-fixnum) (:eax (:offset movitz-bignum bigit0))) - (:jne 'not-most-negative-fixnum) - (:movl ,(ldb (byte 32 0) - (* most-negative-fixnum movitz::+movitz-fixnum-factor+)) - :eax) - (:jmp 'fix-ok) - not-most-negative-fixnum - (:compile-form (:result-mode :eax) - (copy-bignum x)) - (:notb (:eax (:offset movitz-bignum sign))) - (:jmp 'fix-ok))) - (:negl :eax) - (:jo '(:sub-program (fix-overflow) - (:compile-form (:result-mode :eax) - ,(1+ movitz:+movitz-most-positive-fixnum+)) - (:jmp 'fix-ok))) - fix-ok - ))) - (do-it))) + (etypecase x + (fixnum + (macrolet + ((do-it () + `(with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) x) + (:negl :eax) + (:jo '(:sub-program (fix-overflow) + (:compile-form (:result-mode :eax) + ,(1+ movitz:+movitz-most-positive-fixnum+)) + (:jmp 'fix-ok))) + fix-ok))) + (do-it))) + (bignum + (%bignum-negate (copy-bignum x))) + (ratio + (make-ratio (- (ratio-numerator x)) (ratio-denominator x))))) (2 (minuend subtrahend) (macrolet ((do-it () @@ -1421,9 +1400,11 @@ (2 (x y) (multiple-value-bind (q r) (truncate x y) - (if (= 0 r) - q - (make-rational x y)))) + (cond + ((= 0 r) + q) + (t (make-rational (* (numerator x) (denominator y)) + (* (denominator x) (numerator y))))))) (t (number &rest denominators) (declare (dynamic-extent denominators)) (cond

1 0