movitz-cvs July 2004

movitz-cvs@common-lisp.net

2 participants
376 discussions

[movitz-cvs] CVS update: movitz/image.lisp
by Frode Vatvedt Fjeld 30 Jul '04

30 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3906 Modified Files: image.lisp Log Message: Improved support for ratios in compare (i.e. <, <=, >, etc). Date: Fri Jul 30 14:06:22 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.57 movitz/image.lisp:1.58 --- movitz/image.lisp:1.57 Thu Jul 29 09:18:47 2004 +++ movitz/image.lisp Fri Jul 30 14:06:22 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.57 2004/07/29 16:18:47 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.58 2004/07/30 21:06:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -294,6 +294,11 @@ :map-binary-write 'movitz-intern :map-binary-read-delayed 'movitz-word) (complicated-class-of + :binary-type word + :binary-tag :global-function + :map-binary-read-delayed 'movitz-word + :map-binary-write 'movitz-intern) + (complicated-compare :binary-type word :binary-tag :global-function :map-binary-read-delayed 'movitz-word

1 0

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

29 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv22690 Modified Files: format.lisp Log Message: Added an imbecile format-float, for ~F. Date: Thu Jul 29 09:21:39 2004 Author: ffjeld Index: movitz/losp/muerte/format.lisp diff -u movitz/losp/muerte/format.lisp:1.5 movitz/losp/muerte/format.lisp:1.6 --- movitz/losp/muerte/format.lisp:1.5 Thu May 20 10:47:24 2004 +++ movitz/losp/muerte/format.lisp Thu Jul 29 09:21:39 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.5 2004/05/20 17:47:24 ffjeld Exp $ +;;;; $Id: format.lisp,v 1.6 2004/07/29 16:21:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -59,6 +59,22 @@ (*print-readably* nil)) (write x)))) +(defun format-float (x &optional at-sign-p colon-p w d k overflowchar padchar) + (declare (ignore w k overflowchar padchar at-sign-p colon-p)) + (multiple-value-bind (integer-part decimal-part) + (truncate x) + (write-integer integer-part *standard-output* 10 t) + (do ((remainder decimal-part) + (i 0 (1+ i))) + ((if (not d) + (or (and (plusp i) (zerop decimal-part)) + (>= i 16)) + (= i d))) + (multiple-value-bind (next-digit next-remainder) + (truncate (* 10 remainder)) + (setf remainder next-remainder) + (write-integer next-digit *standard-output* 10 nil))))) + (defun find-directive (string i directive &optional recursive-skip-start (recursive-skip-end directive)) "Return position of <directive> in <string>, starting search at <i>. Also return @@ -142,6 +158,7 @@ (nreverse prefix-parameters))) (#\X (format-integer (pop args) 16 at-sign-p colon-p (nreverse prefix-parameters))) + (#\F (apply 'format-float (pop args) at-sign-p colon-p (nreverse prefix-parameters))) (#\C (if colon-p (let ((c (pop args))) (write-string (or (char-name c) c))) @@ -292,3 +309,4 @@ end-loop) (values i args))) +

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/ratios.lisp
by Frode Vatvedt Fjeld 29 Jul '04

29 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv17760 Modified Files: ratios.lisp Log Message: Add a defconstant pi, for the fun of it. Date: Thu Jul 29 09:20:43 2004 Author: ffjeld Index: movitz/losp/muerte/ratios.lisp diff -u movitz/losp/muerte/ratios.lisp:1.1 movitz/losp/muerte/ratios.lisp:1.2 --- movitz/losp/muerte/ratios.lisp:1.1 Tue Jul 27 06:54:12 2004 +++ movitz/losp/muerte/ratios.lisp Thu Jul 29 09:20:43 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Jul 20 00:39:59 2004 ;;;; -;;;; $Id: ratios.lisp,v 1.1 2004/07/27 13:54:12 ffjeld Exp $ +;;;; $Id: ratios.lisp,v 1.2 2004/07/29 16:20:43 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -51,3 +51,5 @@ (etypecase x (integer 1) (ratio (ratio-denominator x)))) + +(defconstant pi #xea7632a/4aa1a8b)

1 0

[movitz-cvs] CVS update: movitz/losp/lib/readline.lisp
by Frode Vatvedt Fjeld 29 Jul '04

29 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv12977 Modified Files: readline.lisp Log Message: Minor fix: dont assume the screen is 25 characters high. Date: Thu Jul 29 09:20:18 2004 Author: ffjeld Index: movitz/losp/lib/readline.lisp diff -u movitz/losp/lib/readline.lisp:1.4 movitz/losp/lib/readline.lisp:1.5 --- movitz/losp/lib/readline.lisp:1.4 Fri Feb 13 14:11:19 2004 +++ movitz/losp/lib/readline.lisp Thu Jul 29 09:20:18 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 2 13:58:58 2001 ;;;; -;;;; $Id: readline.lisp,v 1.4 2004/02/13 22:11:19 ffjeld Exp $ +;;;; $Id: readline.lisp,v 1.5 2004/07/29 16:20:18 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -135,7 +135,7 @@ when (member key terminator-keys) do (when displayed-completions-p (do ((y (1+ (cursor-y console)) (1+ y))) - ((>= y 25)) + ((>= y (console-height console))) (clear-line console 0 y))) and return key do (case key

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by Frode Vatvedt Fjeld 29 Jul '04

29 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv5345 Modified Files: image.lisp Log Message: Added support for movitz-read'ing ratios. Date: Thu Jul 29 09:18:47 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.56 movitz/image.lisp:1.57 --- movitz/image.lisp:1.56 Wed Jul 28 18:59:13 2004 +++ movitz/image.lisp Thu Jul 29 09:18:47 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.56 2004/07/29 01:59:13 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.57 2004/07/29 16:18:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1426,61 +1426,75 @@ (declare (special *movitz-reader-clean-map*)) ,@body)) -(defun movitz-read (expr) +(defun movitz-read (expr &optional re-read) "Map native lisp data to movitz-objects. Makes sure that when two EXPR are EQ, ~@ the Movitz objects are also EQ, under the same image." (declare (optimize (debug 3) (speed 0))) (with-movitz-read-context () (when (typep expr 'movitz-object) (return-from movitz-read expr)) - (or - (let ((old-object (image-lisp-to-movitz-object *image* expr))) - (when (and old-object (not (gethash old-object *movitz-reader-clean-map*))) - (update-movitz-object old-object expr) - (setf (gethash old-object *movitz-reader-clean-map*) t)) - old-object) - (setf (image-lisp-to-movitz-object *image* expr) - (etypecase expr - (null *movitz-nil*) - ((member t) (movitz-read 'muerte.cl:t)) - (symbol (intern-movitz-symbol expr)) - (integer (make-movitz-integer expr)) - (character (make-movitz-character expr)) - (string (or (gethash expr (image-string-constants *image*)) - (setf (gethash expr (image-string-constants *image*)) - (make-movitz-string expr)))) - (vector (make-movitz-vector (length expr) - :element-type (array-element-type expr) - :initial-contents expr)) - (cons - (or (gethash expr (image-cons-constants *image*)) - (setf (gethash expr (image-cons-constants *image*)) - (if (eq '#0=#:error (ignore-errors (when (not (list-length expr)) '#0#))) - (multiple-value-bind (unfolded-expr cdr-index) - (unfold-circular-list expr) - (let ((result (movitz-read unfolded-expr))) - (setf (movitz-last-cdr result) - (movitz-nthcdr cdr-index result)) - result)) - (make-movitz-cons (movitz-read (car expr)) - (movitz-read (cdr expr))))))) - (hash-table - (make-movitz-hash-table expr)) - (structure-object - (let ((slot-descriptions (gethash (type-of expr) - (image-struct-slot-descriptions *image*) - nil))) - (unless slot-descriptions - (error "Don't know how to movitz-read struct: ~S" expr)) - (let ((movitz-object (make-instance 'movitz-struct - :class (muerte::movitz-find-class (type-of expr)) - :length (length slot-descriptions)))) - (setf (image-lisp-to-movitz-object *image* expr) movitz-object) - (setf (slot-value movitz-object 'slot-values) - (mapcar #'(lambda (slot) - (movitz-read (slot-value expr (if (consp slot) (car slot) slot)))) - slot-descriptions)) - movitz-object)))))))) + (or (and (not re-read) + (let ((old-object (image-lisp-to-movitz-object *image* expr))) + (when (and old-object (not (gethash old-object *movitz-reader-clean-map*))) + (update-movitz-object old-object expr) + (setf (gethash old-object *movitz-reader-clean-map*) t)) + old-object)) + (setf (image-lisp-to-movitz-object *image* expr) + (etypecase expr + (null *movitz-nil*) + ((member t) (movitz-read 'muerte.cl:t)) + (symbol (intern-movitz-symbol expr)) + (integer (make-movitz-integer expr)) + (character (make-movitz-character expr)) + (string (or (gethash expr (image-string-constants *image*)) + (setf (gethash expr (image-string-constants *image*)) + (make-movitz-string expr)))) + (vector (make-movitz-vector (length expr) + :element-type (array-element-type expr) + :initial-contents expr)) + (cons + (or (gethash expr (image-cons-constants *image*)) + (setf (gethash expr (image-cons-constants *image*)) + (if (eq '#0=#:error (ignore-errors (when (not (list-length expr)) '#0#))) + (multiple-value-bind (unfolded-expr cdr-index) + (unfold-circular-list expr) + (let ((result (movitz-read unfolded-expr))) + (setf (movitz-last-cdr result) + (movitz-nthcdr cdr-index result)) + result)) + (make-movitz-cons (movitz-read (car expr)) + (movitz-read (cdr expr))))))) + (hash-table + (make-movitz-hash-table expr)) + (ratio + (let ((slot-descriptions (gethash 'muerte.cl::ratio + (image-struct-slot-descriptions *image*) + nil))) + (unless slot-descriptions + (error "Don't know how to movitz-read ratios (yet)." expr)) + (let ((movitz-object (make-instance 'movitz-struct + :class (muerte::movitz-find-class 'muerte.cl::ratio) + :length (length slot-descriptions)))) + (setf (image-lisp-to-movitz-object *image* expr) movitz-object) + (setf (slot-value movitz-object 'slot-values) + (list (movitz-read (numerator expr)) + (movitz-read (denominator expr)))) + movitz-object))) + (structure-object + (let ((slot-descriptions (gethash (type-of expr) + (image-struct-slot-descriptions *image*) + nil))) + (unless slot-descriptions + (error "Don't know how to movitz-read struct: ~S" expr)) + (let ((movitz-object (make-instance 'movitz-struct + :class (muerte::movitz-find-class (type-of expr)) + :length (length slot-descriptions)))) + (setf (image-lisp-to-movitz-object *image* expr) movitz-object) + (setf (slot-value movitz-object 'slot-values) + (mapcar #'(lambda (slot) + (movitz-read (slot-value expr (if (consp slot) (car slot) slot)))) + slot-descriptions)) + movitz-object)))))))) ;;;

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.lisp
by Frode Vatvedt Fjeld 29 Jul '04

29 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv22529 Modified Files: inspect.lisp Log Message: Fixed objects-equalp for symbols. Date: Thu Jul 29 05:51:40 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.33 movitz/losp/muerte/inspect.lisp:1.34 --- movitz/losp/muerte/inspect.lisp:1.33 Wed Jul 28 03:01:06 2004 +++ movitz/losp/muerte/inspect.lisp Thu Jul 29 05:51:40 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.33 2004/07/28 10:01:06 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.34 2004/07/29 12:51:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -229,12 +229,12 @@ (dotimes (i (funobj-num-constants x) t) (unless (test funobj-constant-ref i))))) (symbol - (and ;; (test memref -7 0 :lisp) ; value - (test memref -7 1 :lisp) ; function-value - ;; (test memref -7 2 :lisp) ; plist - (test memref -7 3 :lisp) ; name - ;; (test memref -7 4 :lisp) ; package - (test memref -7 5 :lisp))) ; flags + (and (test memref #.(bt:slot-offset 'movitz:movitz-symbol 'movitz::function-value) + 0 :lisp) + (test memref #.(bt:slot-offset 'movitz:movitz-symbol 'movitz::name) + 0 :lisp) + (test memref #.(bt:slot-offset 'movitz:movitz-symbol 'movitz::flags) + 0 :lisp))) (vector (and (typep y 'vector) (test array-element-type)

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/textmode.lisp
by Frode Vatvedt Fjeld 29 Jul '04

29 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv10906 Modified Files: textmode.lisp Log Message: Tweaked textmode-scroll-down. Date: Thu Jul 29 05:48:35 2004 Author: ffjeld Index: movitz/losp/x86-pc/textmode.lisp diff -u movitz/losp/x86-pc/textmode.lisp:1.8 movitz/losp/x86-pc/textmode.lisp:1.9 --- movitz/losp/x86-pc/textmode.lisp:1.8 Mon Jul 12 02:12:40 2004 +++ movitz/losp/x86-pc/textmode.lisp Thu Jul 29 05:48:35 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Thu Nov 9 15:38:56 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: textmode.lisp,v 1.8 2004/07/12 09:12:40 ffjeld Exp $ +;;;; $Id: textmode.lisp,v 1.9 2004/07/29 12:48:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -127,10 +127,11 @@ (declare (special muerte.lib::*scroll-offset*)) (incf muerte.lib::*scroll-offset*) (loop with stride = (* 2 *screen-stride*) - for y below *screen-height* + for y below (1- *screen-height*) as src from (+ *screen* stride) by stride as dst from *screen* by stride - do (textmode-copy-line dst src *screen-width*)) + do (textmode-copy-line dst src *screen-width*) + finally (textmode-clear-line 0 (1- *screen-height*))) (signal 'newline)) (defun textmode-clear-line (from-column line)

1 0

[movitz-cvs] CVS update: movitz/storage-types.lisp
by Frode Vatvedt Fjeld 29 Jul '04

29 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv7691 Modified Files: storage-types.lisp Log Message: Calculate correct sxhash for lower-case strings. Date: Wed Jul 28 19:14:35 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.35 movitz/storage-types.lisp:1.36 --- movitz/storage-types.lisp:1.35 Wed Jul 28 17:13:13 2004 +++ movitz/storage-types.lisp Wed Jul 28 19:14:35 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: storage-types.lisp,v 1.35 2004/07/29 00:13:13 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.36 2004/07/29 02:14:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -990,8 +990,8 @@ (incf result result) (incf result (if (evenp i) - (char-code (aref object i)) - (* 7 (char-code (aref object i)))))) + (char-code (char-upcase (aref object i))) + (* 7 (char-code (char-upcase (aref object i))))))) (ldb (byte 16 0) (+ (* #x10ad (length object)) result))))

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by Frode Vatvedt Fjeld 29 Jul '04

29 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv24091 Modified Files: image.lisp Log Message: (global-constant-offset 'unbound-function) was calculated incorrectly. Date: Wed Jul 28 18:59:13 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.55 movitz/image.lisp:1.56 --- movitz/image.lisp:1.55 Wed Jul 28 18:37:10 2004 +++ movitz/image.lisp Wed Jul 28 18:59:13 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.55 2004/07/29 01:37:10 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.56 2004/07/29 01:59:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -519,7 +519,8 @@ (if (not (eq slot-name 'unbound-function)) (slot-offset 'movitz-run-time-context slot-name) (+ (slot-offset 'movitz-run-time-context 'null-symbol) - (slot-offset 'movitz-symbol 'function-value))))) + (slot-offset 'movitz-symbol 'function-value) + (tag :symbol))))) (defun make-movitz-run-time-context () (make-instance 'movitz-run-time-context

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by Frode Vatvedt Fjeld 29 Jul '04

29 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv27969 Modified Files: image.lisp Log Message: Try to protect against slurping in symbols from the common-lisp package. Date: Wed Jul 28 18:37:10 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.54 movitz/image.lisp:1.55 --- movitz/image.lisp:1.54 Wed Jul 28 17:13:00 2004 +++ movitz/image.lisp Wed Jul 28 18:37:10 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.54 2004/07/29 00:13:00 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.55 2004/07/29 01:37:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1111,14 +1111,9 @@ sum))))) (defun intern-movitz-symbol (name) - #+ignore (assert (or (not (symbol-package name)) - (eq (symbol-package name) - (find-package :keyword)) - (string= (string :muerte.) - (package-name (symbol-package name)) - :end2 (min 5 (length (package-name (symbol-package name)))))) - (name) - "Trying to movitz-intern a symbol not in a Movitz package: ~S" name) + (assert (not (eq (symbol-package name) (find-package :common-lisp))) + (name) + "Trying to movitz-intern a symbol in the Common-Lisp package: ~S" name) (or (gethash name (image-oblist *image*)) (let ((symbol (make-movitz-symbol name))) (when (get name :setf-placeholder)

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