movitz-cvs July 2004

movitz-cvs@common-lisp.net

2 participants
376 discussions

[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-serv6538 Modified Files: integers.lisp Log Message: Two fixes: Comparison of bignums was flawed, because the bigits were compared as signed values, while they in fact are unsigned. So <, >, =, etc would return the wrong answer in 50% of the cases. Secondly, added a linear-complexity algorithm for truncate, rather than the idiotic quadratic one. Date: Tue Jul 13 12:45:38 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.50 movitz/losp/muerte/integers.lisp:1.51 --- movitz/losp/muerte/integers.lisp:1.50 Tue Jul 13 07:17:05 2004 +++ movitz/losp/muerte/integers.lisp Tue Jul 13 12:45:38 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.50 2004/07/13 14:17:05 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.51 2004/07/13 19:45:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -570,12 +570,22 @@ (:cmpl :ecx (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) (:je 'positive-compare-loop) - (:ret) - positive-compare-lsb ; it's down to the LSB bigits. - (:movl (:ebx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) - :ecx) - (:cmpl :ecx - (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + positive-compare-lsb + ;; Now make the compare unsigned.. + (:movzxw (:ebx :edx ,(+ 2 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + :ecx) ; First compare upper 16 bits. + (:locally (:movl :ecx (:edi (:edi-offset scratch0)))) + (:movzxw (:eax :edx ,(+ 2 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + :ecx) + (:locally (:cmpl (:edi (:edi-offset scratch0)) :ecx)) + (:jne 'upper-16-decisive) + (:movzxw (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + :ecx) ; Then compare lower 16 bits. + (:locally (:movl :ecx (:edi (:edi-offset scratch0)))) + (:movzxw (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + :ecx) ; Then compare lower 16 bits. + (:locally (:cmpl (:edi (:edi-offset scratch0)) :ecx)) + upper-16-decisive (:ret) compare-negatives @@ -1424,10 +1434,23 @@ (cond ((= number divisor) (values 1 0)) ((< number divisor) (values 0 number)) - (t (do ((q 0 (1+ q)) - (r number (- r divisor))) - ((< r divisor) (values q r)))))) - )))) + (t (let* ((msb-pos (1- (* 2 (%bignum-bigits divisor)))) + (msb (memref divisor -2 msb-pos :unsigned-byte16))) + (when (= 0 msb) + (decf msb-pos) + (setf msb (memref divisor -2 msb-pos :unsigned-byte16)) + (assert (plusp msb))) + (do ((msb+1 (1+ msb)) + (q 0) (r number)) + ((< r divisor) (values q r)) + (let ((guess (truncate r msb+1))) + (dotimes (i msb-pos) + (setf guess (truncate guess #x10000))) + (if (= 0 guess) + (setf q (1+ q) + r (- r divisor)) + (setf q (+ q guess) + r (- r (* divisor guess)))))))))))))) (defun / (number &rest denominators) (declare (dynamic-extent denominators))

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-serv3876 Modified Files: inspect.lisp Log Message: Minor edit. Date: Tue Jul 13 07:29:22 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.18 movitz/losp/muerte/inspect.lisp:1.19 --- movitz/losp/muerte/inspect.lisp:1.18 Mon Jul 12 19:21:08 2004 +++ movitz/losp/muerte/inspect.lisp Tue Jul 13 07:29:22 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.18 2004/07/13 02:21:08 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.19 2004/07/13 14:29:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -322,7 +322,7 @@ copy-bignum-loop (:movl (:ebx :edx #.movitz:+other-type-offset+) :ecx) (:movl :ecx (:eax :edx #.movitz:+other-type-offset+)) - (:subl #.movitz:+movitz-fixnum-factor+ :edx) + (:subl 4 :edx) (:jnc 'copy-bignum-loop)))) (defun print-bignum (x)

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-serv17787 Modified Files: more-macros.lisp Log Message: Added some extra-safe checking to %bignum-bigits. Date: Tue Jul 13 07:28:05 2004 Author: ffjeld Index: movitz/losp/muerte/more-macros.lisp diff -u movitz/losp/muerte/more-macros.lisp:1.12 movitz/losp/muerte/more-macros.lisp:1.13 --- movitz/losp/muerte/more-macros.lisp:1.12 Mon Jul 12 04:09:29 2004 +++ movitz/losp/muerte/more-macros.lisp Tue Jul 13 07:28: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.12 2004/07/12 11:09:29 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.13 2004/07/13 14:28:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -312,7 +312,9 @@ `(with-inline-assembly (:returns :eax :type (unsigned-byte 14)) (:compile-form (:result-mode :eax) ,x) (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) - :eax))) + :eax) + (:testb 3 :al) ; Just to be sure.. + (:jnz '(:sub-program () (:int 63))))) ;;; 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-serv14993 Modified Files: integers.lisp Log Message: Made defun ash slightly smarter. Also, in the * compiler-macro, never implement * in terms of ash. Date: Tue Jul 13 07:17:05 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.49 movitz/losp/muerte/integers.lisp:1.50 --- movitz/losp/muerte/integers.lisp:1.49 Tue Jul 13 06:41:17 2004 +++ movitz/losp/muerte/integers.lisp Tue Jul 13 07:17:05 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.49 2004/07/13 13:41:17 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.50 2004/07/13 14:17:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1064,32 +1064,14 @@ (defun ash (integer count) (cond ((not (minusp count)) + (do () ((< count 16)) + (setf integer (no-macro-call * #x10000 integer)) + (decf count 16)) (dotimes (i count integer) (setf integer (no-macro-call * 2 integer)))) (t (dotimes (i (- count) integer) (setf integer (truncate integer 2)))))) -;;;(defun ash (integer count) -;;; (check-type integer fixnum) -;;; (check-type count fixnum) -;;; (cond -;;; ((= 0 count) -;;; integer) -;;; ((<= 1 count 29) -;;; (dotimes (i count integer) -;;; (setq integer (ash integer 1)))) -;;; ((<= count #.(cl:- 1 movitz::+movitz-fixnum-bits+)) -;;; (if (minusp integer) -1 0)) -;;; ((minusp count) -;;; (with-inline-assembly (:returns :eax) -;;; (:compile-form (:result-mode :ecx) count) -;;; (:compile-form (:result-mode :eax) integer) -;;; (:negl :ecx) -;;; (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) -;;; (:sarl :cl :eax) -;;; (:andb #.(cl:logxor #xff movitz::+movitz-fixnum-zmask+) :al))) -;;; (t (if (= 0 integer) 0 (error "Illegal ash count: ~D" count))))) - ;;;; (defun integer-length (integer) @@ -1150,7 +1132,6 @@ (case f1 (0 `(progn ,factor2 0)) (1 factor2) - (2 `(ash ,factor2 1)) (t `(no-macro-call * ,factor1 ,factor2))))) (t `(no-macro-call * ,factor1 ,factor2))))) (t `(* (* ,(first operands) ,(second operands)) ,@(cddr operands)))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/symbols.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-serv25442 Modified Files: symbols.lisp Log Message: Accessors symbol-special-variable-p and symbol-constant-variable-p were out of sync with storage-types.lisp. This caused e.g. let of special variables not to work in the REPL. Date: Tue Jul 13 07:06:57 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.15 movitz/losp/muerte/symbols.lisp:1.16 --- movitz/losp/muerte/symbols.lisp:1.15 Wed Jul 7 16:22:16 2004 +++ movitz/losp/muerte/symbols.lisp Tue Jul 13 07:06:56 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.15 2004/07/07 23:22:16 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.16 2004/07/13 14:06:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -195,18 +195,18 @@ flags))) (defun symbol-special-variable-p (symbol) - (logbitp 0 (symbol-flags symbol))) + (logbitp 3 (symbol-flags symbol))) (defun (setf symbol-special-variable-p) (value symbol) - (setf (ldb (byte 1 0) (symbol-flags symbol)) + (setf (ldb (byte 1 3) (symbol-flags symbol)) (if value 1 0)) value) (defun symbol-constant-variable-p (symbol) - (logbitp 1 (symbol-flags symbol))) + (logbitp 4 (symbol-flags symbol))) (defun (setf symbol-constant-variable-p) (value symbol) - (setf (ldb (byte 1 1) (symbol-flags symbol)) + (setf (ldb (byte 1 4) (symbol-flags symbol)) (if value 1 0)) value)

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-serv27082 Modified Files: integers.lisp Log Message: Implement bignum multiplication with a linear rather than a quadratic algorithm. Quite a bit faster.. Date: Tue Jul 13 06:41:17 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.48 movitz/losp/muerte/integers.lisp:1.49 --- movitz/losp/muerte/integers.lisp:1.48 Mon Jul 12 19:29:15 2004 +++ movitz/losp/muerte/integers.lisp Tue Jul 13 06:41:17 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.48 2004/07/13 02:29:15 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.49 2004/07/13 13:41:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1231,6 +1231,7 @@ fixnum-done))) (((eql 0) t) 0) (((eql 1) t) y) + (((eql -1) t) (- y)) ((t fixnum) (* y x)) ((fixnum bignum) (let (r) @@ -1304,13 +1305,15 @@ positive-result ))) ((positive-bignum positive-bignum) - (do ((mx (* most-positive-fixnum x)) - (f y) - (r 0)) - ((typep f 'fixnum) (+ r (* f x))) - (setf r (+ r mx)) - (setf f (- f most-positive-fixnum)))) - ))) + (if (< x y) + (* y x) + ;; X is the biggest factor. + (let ((r 0) (f 0)) + (dotimes (half-bigit (* 2 (%bignum-bigits y))) + (incf r (ash (* (memref y -2 half-bigit :unsigned-byte16) x) + f)) + (incf f 16)) + r)))))) (do-it))) (t (&rest factors) (declare (dynamic-extent factors))

1 0

[movitz-cvs] CVS update: movitz/doc/ChangeLog
by Frode Vatvedt Fjeld 13 Jul '04

13 Jul '04

Update of /project/movitz/cvsroot/movitz/doc In directory common-lisp.net:/tmp/cvs-serv23200 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Tue Jul 13 06:05:23 2004 Author: ffjeld Index: movitz/doc/ChangeLog diff -u movitz/doc/ChangeLog:1.6 movitz/doc/ChangeLog:1.7 --- movitz/doc/ChangeLog:1.6 Mon Jul 12 02:11:24 2004 +++ movitz/doc/ChangeLog Tue Jul 13 06:05:23 2004 @@ -1,3 +1,10 @@ +2004-07-13 Frode Vatvedt Fjeld <frodef(a)cs.uit.no> + + * Added the feature that after each GC cycle, the keyboard is + polled. If the escape key is entered, a break to the debugger is + performed. This way one can interrupt long-running executions, so + long as the GC is triggered once in a while. + 2004-07-12 Frode Vatvedt Fjeld <frodef(a)cs.uit.no> * Added top-level-command :more, that will evaluate a form while

1 0

[movitz-cvs] CVS update: movitz/losp/los0-gc.lisp
by Frode Vatvedt Fjeld 13 Jul '04

13 Jul '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv25462 Modified Files: los0-gc.lisp Log Message: Changed the GC messages a bit, and added the feature of polling the keyboard for ESC (if pressed, break) after each GC stop-and-copy cycle. Date: Tue Jul 13 06:02:45 2004 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.24 movitz/losp/los0-gc.lisp:1.25 --- movitz/losp/los0-gc.lisp:1.24 Mon Jul 12 19:38:27 2004 +++ movitz/losp/los0-gc.lisp Tue Jul 13 06:02:45 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Feb 21 17:48:32 2004 ;;;; -;;;; $Id: los0-gc.lisp,v 1.24 2004/07/13 02:38:27 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.25 2004/07/13 13:02:45 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -247,8 +247,12 @@ (setf (exception-handler 113) (lambda (exception interrupt-frame) (declare (ignore exception interrupt-frame)) - (format t "~&;; Handling out-of-memory exception..") - (stop-and-copy))) + (format t "~&;; GC.. ") + (stop-and-copy) + ;; This is a nice opportunity to poll the keyboard.. + (case (muerte.x86-pc.keyboard:poll-char) + ((#\esc) + (break "Los0 GC keyboard poll."))))) (let ((conser (symbol-value 'los0-fast-cons))) (check-type conser vector) (setf (%run-time-context-slot 'muerte::fast-cons) @@ -365,7 +369,7 @@ (vector-push (object-location x) *x*) (vector-push (object-location fw) *x*) fw)))) - (t (let ((forwarded-x (memref (object-location x) 0 1 :lisp))) + (t (let ((forwarded-x (memref (object-location x) 0 0 :lisp))) (if (object-in-space-p newspace forwarded-x) (progn (assert (eq (object-tag forwarded-x) @@ -374,7 +378,7 @@ (let ((forward-x (shallow-copy x))) (when (typep x 'muerte::bignum) (assert (= x forward-x))) - (setf (memref (object-location x) 0 1 :lisp) forward-x) + (setf (memref (object-location x) 0 0 :lisp) forward-x) forward-x))))))))) ;; Scavenge roots (map-heap-words evacuator 0 (+ (malloc-buffer-start) @@ -404,7 +408,7 @@ ;; GC completed, oldspace is evacuated. (let ((old-size (truncate (- (space-fresh-pointer oldspace) 2) 2)) (new-size (truncate (- (space-fresh-pointer newspace) 2) 2))) - (format t "~&;; Old space: ~/muerte:pprint-clumps/, new space: ~ + (format t "Old space: ~/muerte:pprint-clumps/, new space: ~ ~/muerte:pprint-clumps/, freed: ~/muerte:pprint-clumps/.~%" old-size new-size (- old-size new-size))) (initialize-space oldspace))))

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-serv7520 Modified Files: scavenge.lisp Log Message: Minor edit. Date: Tue Jul 13 06:00:37 2004 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.16 movitz/losp/muerte/scavenge.lisp:1.17 --- movitz/losp/muerte/scavenge.lisp:1.16 Mon Jul 12 19:37:36 2004 +++ movitz/losp/muerte/scavenge.lisp Tue Jul 13 06:00:36 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.16 2004/07/13 02:37:36 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.17 2004/07/13 13:00:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -127,6 +127,7 @@ (incf scan) (let ((delta (memref scan 0 0 :lisp))) (check-type delta positive-fixnum) + ;; (warn "at ~S skipping ~S to ~S." scan delta (+ scan delta)) (incf scan delta))) ((typep x 'pointer) (let ((new (funcall function x scan)))

1 0

[movitz-cvs] CVS update: movitz/bochsrc.txt
by Frode Vatvedt Fjeld 13 Jul '04

13 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv27777 Modified Files: bochsrc.txt Log Message: Configure bochs with 64 MB to allow experimentation with more memory. Date: Tue Jul 13 06:00:11 2004 Author: ffjeld Index: movitz/bochsrc.txt diff -u movitz/bochsrc.txt:1.2 movitz/bochsrc.txt:1.3 --- movitz/bochsrc.txt:1.2 Fri May 21 02:40:09 2004 +++ movitz/bochsrc.txt Tue Jul 13 06:00:10 2004 @@ -3,7 +3,7 @@ ############################################################### # how much memory the emulated machine will have -megs: 32 +megs: 64 # filename of ROM images #romimage: file=/usr/local/bochs/1.2.1/BIOS-bochs-latest, address=0xf0000

1 0

← Newer
1
...
24
25
26
27
28
29
30
...
38
Older →

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 July 2004