March 2008 - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

[movitz-cvs] CVS movitz
by ffjeld 23 Mar '08

23 Mar '08

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv14395 Modified Files: storage-types.lisp Log Message: Support dumping of bit-vectors. --- /project/movitz/cvsroot/movitz/storage-types.lisp 2008/03/20 22:24:27 1.61 +++ /project/movitz/cvsroot/movitz/storage-types.lisp 2008/03/23 12:19:19 1.62 @@ -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.61 2008/03/20 22:24:27 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.62 2008/03/23 12:19:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -417,15 +417,26 @@ (:character (write-binary 'char8 stream data)) (:any-t (write-binary 'word stream (movitz-read-and-intern data 'word)))))) (+ (call-next-method) ; header - (etypecase (movitz-vector-symbolic-data obj) - (list - (loop for data in (movitz-vector-symbolic-data obj) - with type = (movitz-vector-element-type obj) - summing (write-element type stream data))) - (vector - (loop for data across (movitz-vector-symbolic-data obj) - with type = (movitz-vector-element-type obj) - summing (write-element type stream data))))))) + (multiple-value-bind (data type) + (case (movitz-vector-element-type obj) + (:bit (let ((data (movitz-vector-symbolic-data obj))) + (values (loop for byte upfrom 0 below (ceiling (length data) 8) + collect (loop for bit from 0 to 7 + sum (* (let ((b (+ (* byte 8) bit))) + (if (< b (length data)) + (bit data b) + 0)) + (expt 2 bit)))) + :u8))) + (t (values (movitz-vector-symbolic-data obj) + (movitz-vector-element-type obj)))) + (etypecase data + (list + (loop for datum in data + sum (write-element type stream datum))) + (vector + (loop for datum across data + sum (write-element type stream datum)))))))) (defmethod read-binary-record ((type-name (eql 'movitz-basic-vector)) stream &key &allow-other-keys) (let ((object (call-next-method))) @@ -452,6 +463,8 @@ (cond ((eq type 'code) (values :code 0)) + ((subtypep type 'bit) + (values :bit 0)) ((subtypep type '(unsigned-byte 8)) (values :u8 0)) ((subtypep type '(unsigned-byte 16)) @@ -502,7 +515,7 @@ (setf initial-contents (make-array size :initial-element (or (and initial-element-p initial-element) default-element)))) - (assert (member et '(:any-t :character :u8 :u32 :code))) + (assert (member et '(:any-t :bit :character :u8 :u32 :code))) (when flags (break "flags: ~S" flags)) (when (and alignment-offset (plusp alignment-offset)) (break "alignment: ~S" alignment-offset))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Mar '08

21 Mar '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv4249 Modified Files: print.lisp Log Message: Safe printing of unbound-value. --- /project/movitz/cvsroot/movitz/losp/muerte/print.lisp 2008/03/15 20:58:15 1.24 +++ /project/movitz/cvsroot/movitz/losp/muerte/print.lisp 2008/03/21 22:31:07 1.25 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Sep 3 11:48:19 2001 ;;;; -;;;; $Id: print.lisp,v 1.24 2008/03/15 20:58:15 ffjeld Exp $ +;;;; $Id: print.lisp,v 1.25 2008/03/21 22:31:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -216,6 +216,8 @@ (t (let ((do-escape-p (or *print-escape* *print-readably*)) (*print-level* (minus-if *print-level* 1))) (typecase object + (unbound-value + (write-string "#<unbound!>" stream)) (character (if (not do-escape-p) (write-char object stream)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Mar '08

21 Mar '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv4096 Modified Files: variables.lisp Log Message: Less extreme call-arguments-limit. --- /project/movitz/cvsroot/movitz/losp/muerte/variables.lisp 2008/03/19 12:37:29 1.11 +++ /project/movitz/cvsroot/movitz/losp/muerte/variables.lisp 2008/03/21 22:30:40 1.12 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 5 21:53:34 2003 ;;;; -;;;; $Id: variables.lisp,v 1.11 2008/03/19 12:37:29 ffjeld Exp $ +;;;; $Id: variables.lisp,v 1.12 2008/03/21 22:30:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -65,8 +65,8 @@ (defvar long-float-negative-epsilon -1/1000) -(defconstant call-arguments-limit #xffff0) -(defconstant lambda-parameters-limit #x1000) ; ? +(defconstant call-arguments-limit 512) +(defconstant lambda-parameters-limit 512) ; ? (defvar *print-pprint-dispatch* nil)

1 0

[movitz-cvs] CVS movitz
by ffjeld 21 Mar '08

21 Mar '08

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv3954 Modified Files: compiler-protocol.lisp Log Message: Add boolean-mode :boolean-overflow and :boolean-no-overflow. --- /project/movitz/cvsroot/movitz/compiler-protocol.lisp 2005/08/20 20:30:03 1.4 +++ /project/movitz/cvsroot/movitz/compiler-protocol.lisp 2008/03/21 22:30:05 1.5 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Oct 10 13:02:03 2001 ;;;; -;;;; $Id: compiler-protocol.lisp,v 1.4 2005/08/20 20:30:03 ffjeld Exp $ +;;;; $Id: compiler-protocol.lisp,v 1.5 2008/03/21 22:30:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -30,7 +30,9 @@ :boolean-zf=0 :boolean-cf=1 :boolean-cf=0 - :boolean-ecx)) + :boolean-ecx + :boolean-overflow + :boolean-no-overflow)) (defconstant +multiple-value-result-modes+ '(:multiple-values

1 0

[movitz-cvs] CVS movitz
by ffjeld 21 Mar '08

21 Mar '08

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv3896 Modified Files: compiler.lisp Log Message: Add boolean-mode :boolean-overflow and :boolean-no-overflow. --- /project/movitz/cvsroot/movitz/compiler.lisp 2008/03/19 15:06:10 1.198 +++ /project/movitz/cvsroot/movitz/compiler.lisp 2008/03/21 22:29:57 1.199 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.198 2008/03/19 15:06:10 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.199 2008/03/21 22:29:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -4951,7 +4951,9 @@ (:boolean-zf=1 :boolean-zf=0) (:boolean-zf=0 :boolean-zf=1) (:boolean-cf=1 :boolean-cf=0) - (:boolean-cf=0 :boolean-cf=1))) + (:boolean-cf=0 :boolean-cf=1) + (:boolean-overflow :boolean-no-overflow) + (:boolean-no-overflow :boolean-overflow))) (cons (let ((args (cdr mode))) (ecase (car mode) @@ -4976,7 +4978,9 @@ (:boolean-zf=0 :jnz) (:boolean-cf=1 :jc) (:boolean-cf=0 :jnc) - (:boolean-true :jmp)) + (:boolean-true :jmp) + (:boolean-overflow :jo) + (:boolean-no-overflow :jno)) (list 'quote label)))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Mar '08

21 Mar '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv3803 Modified Files: primitive-functions.lisp Log Message: Bounds-check of the stack while unwinding can be problematic. Don't. --- /project/movitz/cvsroot/movitz/losp/muerte/primitive-functions.lisp 2008/03/15 20:58:08 1.70 +++ /project/movitz/cvsroot/movitz/losp/muerte/primitive-functions.lisp 2008/03/21 22:28:26 1.71 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 2 21:02:18 2001 ;;;; -;;;; $Id: primitive-functions.lisp,v 1.70 2008/03/15 20:58:08 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.71 2008/03/21 22:28:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -138,7 +138,7 @@ search-loop (:jecxz '(:sub-program () (:int 63))) - (:locally (:bound (:edi (:edi-offset stack-bottom)) :ecx)) + ;; (:locally (:bound (:edi (:edi-offset stack-bottom)) :ecx)) (:cmpl :ecx :eax) (:je 'found-dynamic-env)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Mar '08

21 Mar '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv3728 Modified Files: eval.lisp Log Message: Add multiple-value-call special-operator. --- /project/movitz/cvsroot/movitz/losp/muerte/eval.lisp 2008/03/21 00:20:48 1.27 +++ /project/movitz/cvsroot/movitz/losp/muerte/eval.lisp 2008/03/21 22:27:17 1.28 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 19 21:15:12 2001 ;;;; -;;;; $Id: eval.lisp,v 1.27 2008/03/21 00:20:48 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.28 2008/03/21 22:27:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -117,12 +117,19 @@ (setq (eval-setq form env)) (setf (eval-setf form env)) ((defvar) (eval-defvar form env)) - (let (eval-let (cadr form) (cddr form) env)) - (let* (multiple-value-bind (body declarations) - (parse-declarations-and-body (cddr form)) - (eval-let* (cadr form) declarations body env))) + ((let) + (eval-let (cadr form) (cddr form) env)) + ((let*) + (multiple-value-bind (body declarations) + (parse-declarations-and-body (cddr form)) + (eval-let* (cadr form) declarations body env))) ((defun) (eval-defun (cadr form) (caddr form) (cdddr form) env)) ((lambda) (eval-function form env)) ; the lambda macro.. + ((multiple-value-call) + (apply (eval-form (cadr form) env) + (mapcan (lambda (args-form) + (multiple-value-list (eval-form args-form env))) + (cddr form)))) ((multiple-value-bind) (eval-m-v-bind form env)) ((multiple-value-prog1)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Mar '08

21 Mar '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv839 Modified Files: sequences.lisp Log Message: Fix dynamic-extent bug in concatenate. --- /project/movitz/cvsroot/movitz/losp/muerte/sequences.lisp 2008/03/15 20:58:17 1.38 +++ /project/movitz/cvsroot/movitz/losp/muerte/sequences.lisp 2008/03/21 22:17:06 1.39 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 11 14:19:23 2001 ;;;; -;;;; $Id: sequences.lisp,v 1.38 2008/03/15 20:58:17 ffjeld Exp $ +;;;; $Id: sequences.lisp,v 1.39 2008/03/21 22:17:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1799,7 +1799,9 @@ (replace r s :start1 i) (incf i (length s))) r)) - (t (error "Can't concatenate ~S yet: ~:S" result-type sequences)))) + (t (error "Can't concatenate ~S yet: ~:S" + result-type + (copy-list sequences))))) ; no more dynamic-extent. (defun substitute (newitem olditem sequence

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Mar '08

21 Mar '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv20381 Modified Files: eval.lisp Log Message: Have evaluated m-v-bind deal with declarations and special bindings. --- /project/movitz/cvsroot/movitz/losp/muerte/eval.lisp 2008/03/21 00:06:07 1.26 +++ /project/movitz/cvsroot/movitz/losp/muerte/eval.lisp 2008/03/21 00:20:48 1.27 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 19 21:15:12 2001 ;;;; -;;;; $Id: eval.lisp,v 1.26 2008/03/21 00:06:07 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.27 2008/03/21 00:20:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -366,13 +366,25 @@ env)))))) (defun eval-m-v-bind (form env) - (destructuring-bind (variables values-form &body body) + (destructuring-bind (variables values-form &body declarations-and-body) (cdr form) - (let ((values (multiple-value-list (eval-form values-form env)))) - (dolist (variable variables) - (push (cons variable (pop values)) - env)) - (eval-progn body env)))) + (multiple-value-bind (body declarations) + (parse-declarations-and-body declarations-and-body) + (let ((values (multiple-value-list (eval-form values-form env))) + special-vars + special-values) + (dolist (var variables) + (let ((value (pop values))) + (cond + ((or (symbol-special-variable-p var) + (declared-special-p var declarations)) + ;; special + (push var special-vars) + (push value special-values)) + (t ;; lexical + (push (cons var value) + env))))) + (eval-progn body env))))) (defun eval-function (function-name env) (etypecase function-name

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Mar '08

21 Mar '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv19575 Modified Files: setf.lisp Log Message: Add a trivial run-time get-setf-expander. --- /project/movitz/cvsroot/movitz/losp/muerte/setf.lisp 2007/04/13 23:29:31 1.6 +++ /project/movitz/cvsroot/movitz/losp/muerte/setf.lisp 2008/03/21 00:20:22 1.7 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Feb 8 20:43:20 2001 ;;;; -;;;; $Id: setf.lisp,v 1.6 2007/04/13 23:29:31 ffjeld Exp $ +;;;; $Id: setf.lisp,v 1.7 2008/03/21 00:20:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -60,6 +60,14 @@ `(funcall #'(setf ,(car place)) ,store-var ,@arglist) (list* (car place) arglist))))))))))) +(eval-when (:load-toplevel) + (defun get-setf-expansion (place &optional env) + (cond + ((symbolp place) + (let ((store-var (gensym "store-var-"))) + (values nil nil (list store-var) `(setq ,place ,store-var) place))) + (t (error "Place ~S not implemented."))))) + ;;;(defsetf subseq (sequence start &optional end) (new-sequence) ;;; `(progn (replace ,sequence ,new-sequence

1 0