movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

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

21 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv14191 Modified Files: eval.lisp Log Message: Teach movitz-eval and movitz-constantp about coerce. Date: Wed Jul 21 07:14:29 2004 Author: ffjeld Index: movitz/eval.lisp diff -u movitz/eval.lisp:1.6 movitz/eval.lisp:1.7 --- movitz/eval.lisp:1.6 Wed Apr 14 14:56:08 2004 +++ movitz/eval.lisp Wed Jul 21 07:14:29 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Thu Nov 2 17:45:05 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: eval.lisp,v 1.6 2004/04/14 21:56:08 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.7 2004/07/21 14:14:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -66,7 +66,7 @@ ((muerte.cl:quote) t) ((muerte.cl:not) (movitz-constantp (second form))) - ((muerte.cl:+ muerte.cl:- muerte.cl:*) + ((muerte.cl:+ muerte.cl:- muerte.cl:* muerte.cl:coerce) (every (lambda (sub-form) (movitz-constantp sub-form environment)) (cdr form))))) @@ -146,5 +146,9 @@ (apply (translate-program (car form) :muerte.cl :cl) (mapcar (lambda (sub-form) (movitz-eval sub-form env nil)) + (cdr form)))) + ((muerte.cl:coerce) + (apply #'coerce + (mapcar (lambda (arg) (movitz-eval arg env nil)) (cdr form)))) (t (error "Don't know how to compile constant compound form ~A" form))))

1 0

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

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6312 Modified Files: basic-macros.lisp Log Message: Try to actually expand backquote expressions run-time. Date: Wed Jul 21 06:28:44 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.28 movitz/losp/muerte/basic-macros.lisp:1.29 --- movitz/losp/muerte/basic-macros.lisp:1.28 Tue Jul 20 16:50:56 2004 +++ movitz/losp/muerte/basic-macros.lisp Wed Jul 21 06:28:44 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.28 2004/07/20 23:50:56 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.29 2004/07/21 13:28:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -966,8 +966,7 @@ (error "numargs-case at illegal position.")) (defmacro movitz-backquote (expression) - (declare (ignore expression)) - `(warn "movitz-backquote!")) + `(un-backquote ',expression 0)) (define-compiler-macro spin-wait-pause () "Insert a pause instruction, which improves performance of

1 0

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

21 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv25813 Modified Files: bochsrc.txt Log Message: Believe it or not, the CVS tag in the header caused Bochs to pause during start-up about 30 seconds. Isn't the babylonic world of unix wonderful? I mean, READ was invented what, 40 years ago? Oh well. Date: Wed Jul 21 06:27:58 2004 Author: ffjeld Index: movitz/bochsrc.txt diff -u movitz/bochsrc.txt:1.5 movitz/bochsrc.txt:1.6 --- movitz/bochsrc.txt:1.5 Wed Jul 21 04:45:52 2004 +++ movitz/bochsrc.txt Wed Jul 21 06:27:58 2004 @@ -12,8 +12,6 @@ ## Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ## Created at: Wed Jul 21 13:41:59 2004 ## -## $Id: bochsrc.txt,v 1.5 2004/07/21 11:45:52 ffjeld Exp $ -## ###################################################################### # how much memory the emulated machine will have

1 0

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

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv22368 Modified Files: lists.lisp Log Message: Fixed a nasty bug in append. Date: Wed Jul 21 06:24:58 2004 Author: ffjeld Index: movitz/losp/muerte/lists.lisp diff -u movitz/losp/muerte/lists.lisp:1.6 movitz/losp/muerte/lists.lisp:1.7 --- movitz/losp/muerte/lists.lisp:1.6 Wed Jul 21 06:17:22 2004 +++ movitz/losp/muerte/lists.lisp Wed Jul 21 06:24:58 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Tue Dec 5 18:40:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: lists.lisp,v 1.6 2004/07/21 13:17:22 ffjeld Exp $ +;;;; $Id: lists.lisp,v 1.7 2004/07/21 13:24:58 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -180,22 +180,25 @@ (previous-copy nil) (x lists (cdr x)) (x+ (cdr lists) (cdr x+))) - ((endp x+) (cond - (previous-copy - (setf (cdr (last previous-copy)) - (car x)) - copied-result) - (copied-result - (setf (cdr (last copied-result)) - (car x)) - copied-result) - (t (car x)))) + ((endp x+) + (cond + (previous-copy + (setf (cdr (last previous-copy)) + (car x)) + copied-result) + (copied-result + (setf (cdr (last copied-result)) + (car x)) + copied-result) + (t (car x)))) (when (consp (car x)) (let ((copy (copy-list (car x)))) (if previous-copy (setf (cdr (last previous-copy)) copy) (setf copied-result copy)) - (setf previous-copy copy))))))) + (setf previous-copy copy) + (unless copied-result + (setf copied-result copy)))))))) (defun copy-list (list) (if (null list)

1 0

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

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv31520 Modified Files: lists.lisp Log Message: Trying to make un-backquote run on the movitz side. Date: Wed Jul 21 06:17:23 2004 Author: ffjeld Index: movitz/losp/muerte/lists.lisp diff -u movitz/losp/muerte/lists.lisp:1.5 movitz/losp/muerte/lists.lisp:1.6 --- movitz/losp/muerte/lists.lisp:1.5 Wed Jun 9 13:18:45 2004 +++ movitz/losp/muerte/lists.lisp Wed Jul 21 06:17:22 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Tue Dec 5 18:40:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: lists.lisp,v 1.5 2004/06/09 20:18:45 ffjeld Exp $ +;;;; $Id: lists.lisp,v 1.6 2004/07/21 13:17:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -451,3 +451,62 @@ (if (member (funcall key item) list :test test) list (cons item list)))) + + +(defun ub (x) + `(hello world)) + +(defun un-backquote (expr level) + (eval (un-backquote-xxx expr level))) + +(defun un-backquote-xxx (form level) + "Dont ask.." + (declare (notinline un-backquote)) + (assert (not (minusp level))) + (values + (typecase form + (null nil) + (list + (case (car form) + (backquote-comma + (cadr form)) + (t (cons 'append + (loop for sub-form-head on form + as sub-form = (and (consp sub-form-head) + (car sub-form-head)) + collecting + (cond + ((atom sub-form-head) + (list 'quote sub-form-head)) + ((atom sub-form) + (list 'quote (list sub-form))) + (t (case (car sub-form) + (muerte::movitz-backquote + (list 'list + (list 'list (list 'quote 'muerte::movitz-backquote) + (un-backquote-xxx (cadr sub-form) (1+ level))))) + (backquote-comma + (cond + ((= 0 level) + (list 'list (cadr sub-form))) + ((and (listp (cadr sub-form)) + (eq 'backquote-comma-at (caadr sub-form))) + (list 'append + (list 'mapcar + '(lambda (x) (list 'backquote-comma x)) + (cadr (cadr sub-form))))) + (t (list 'list + (list 'list + (list 'quote 'backquote-comma) + (un-backquote-xxx (cadr sub-form) (1- level))))))) + (backquote-comma-at + (if (= 0 level) + (cadr sub-form) + (list 'list + (list 'list + (list 'quote 'backquote-comma-at) + (un-backquote-xxx (cadr sub-form) (1- level)))))) + (t (list 'list (un-backquote-xxx sub-form level))))))))))) + (array + (error "Array backquote not implemented.")) + (t (list 'quote form)))))

1 0

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

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv28772 Modified Files: typep.lisp Log Message: Recognize "array" as the same as "simple-array". Date: Wed Jul 21 05:49:24 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.28 movitz/losp/muerte/typep.lisp:1.29 --- movitz/losp/muerte/typep.lisp:1.28 Wed Jul 21 05:28:15 2004 +++ movitz/losp/muerte/typep.lisp Wed Jul 21 05:49:24 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.28 2004/07/21 12:28:15 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.29 2004/07/21 12:49:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -268,7 +268,7 @@ (if deriver-function `(typep ,object ',(apply deriver-function (cdr type))) (case (car type) - ((simple-array) + ((simple-array array) (let ((et (second type)) (dim (if (listp (third type)) (length (third type)) @@ -401,10 +401,6 @@ (t (warn "compiling typep ~S [~A]" type (package-name (symbol-package (car type)))))))))) form))))) - -#+ignore -(defun foo (x) - (typep x '(simple-array (unsigned-byte 4)))) (defmacro define-typep (tname lambda &body body) (let ((fname (format nil "~A-~A" 'typep tname)))

1 0

[movitz-cvs] CVS update: movitz/losp/tmp/packet.lisp
by Frode Vatvedt Fjeld 21 Jul '04

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/tmp In directory common-lisp.net:/tmp/cvs-serv21280 Modified Files: packet.lisp Log Message: With these modifications, the file is accepted by movitz-compile-file. Date: Wed Jul 21 05:33:54 2004 Author: ffjeld Index: movitz/losp/tmp/packet.lisp diff -u movitz/losp/tmp/packet.lisp:1.1 movitz/losp/tmp/packet.lisp:1.2 --- movitz/losp/tmp/packet.lisp:1.1 Wed Jul 21 05:02:14 2004 +++ movitz/losp/tmp/packet.lisp Wed Jul 21 05:33:54 2004 @@ -270,11 +270,11 @@ ;;; ;;; The read syntax is `#e"ff:00:1:2:3:4'. ;;; -(eval-when (:compile-toplevel :load-toplevel :execute) +(eval-when (:compile-toplevel #-movitz :load-toplevel #-movitz :execute) (defstruct (ethernet-address (:conc-name #:ethernet-address.) (:print-function print-ethernet-address)) "48-bit Ethernet MAC address." - (octets (ext:required-argument) :type (array octet (6)))) + (octets 0 :type (array octet (6)))) (defun read-ethernet-address (stream &optional c n) "Read an ethernet address in colon-separated syntax. @@ -397,10 +397,10 @@ ;;; ;;; IP addresses also have a special read-syntax: `(a)10.0.0.1'. ;;; -(eval-when (:compile-toplevel :load-toplevel :execute) +(eval-when (:compile-toplevel #-movitz :load-toplevel #-movitz :execute) (defstruct (ipv4-address (:conc-name #:ipv4-address.) (:print-function print-ipv4-address)) - (octets (ext:required-argument) :type (array octet (4)))) + (octets 0 :type (array octet (4)))) (defun read-ipv4-address (stream &optional c n) "Read an IPv4 address in dotted-quad format. @@ -826,8 +826,8 @@ (structure-accessors name))) (defun structure-accessors (name) - (mapcar #'pcl::slot-definition-defstruct-accessor-symbol - (pcl:class-direct-slots (find-class name)))) + #+cmu (mapcar #'pcl::slot-definition-defstruct-accessor-symbol + (pcl:class-direct-slots (find-class name)))) (export (structure-exports)))

1 0

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

21 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv7969 Modified Files: image.lisp Log Message: Fixed movitz-read for structs. Date: Wed Jul 21 05:32:26 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.47 movitz/image.lisp:1.48 --- movitz/image.lisp:1.47 Thu Jul 15 14:06:19 2004 +++ movitz/image.lisp Wed Jul 21 05:32:26 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.47 2004/07/15 21:06:19 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.48 2004/07/21 12:32:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1460,11 +1460,12 @@ (unless slot-descriptions (error "Don't know how to movitz-read struct: ~S" expr)) (let ((movitz-object (make-instance 'movitz-struct - :name (movitz-read (type-of expr)) - :length (length slot-descriptions)))) + :name (movitz-read (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 slot))) + (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/typep.lisp
by Frode Vatvedt Fjeld 21 Jul '04

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11200 Modified Files: typep.lisp Log Message: In the deftype expander, have the type declaration be mirrored on the host side. Date: Wed Jul 21 05:28:15 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.27 movitz/losp/muerte/typep.lisp:1.28 --- movitz/losp/muerte/typep.lisp:1.27 Sun Jul 18 17:54:34 2004 +++ movitz/losp/muerte/typep.lisp Wed Jul 21 05:28:15 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.27 2004/07/19 00:54:34 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.28 2004/07/21 12:28:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -426,10 +426,11 @@ (list 'typep x '',tname)) (defun ,fname ,lambda ,@body))))) -(defmacro deftype (name lambda &body body) +(defmacro deftype (&whole form name lambda &body body) (let ((fname (intern (format nil "~A-~A" 'deftype name)))) `(progn (eval-when (:compile-toplevel) + ,form (setf (gethash (translate-program ',name :cl :muerte.cl) *compiler-derived-typespecs*) (lambda ,lambda ,@body))

1 0

[movitz-cvs] CVS update: movitz/special-operators-cl.lisp
by Frode Vatvedt Fjeld 21 Jul '04

21 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv15555 Modified Files: special-operators-cl.lisp Log Message: When doing eval-when, execute :compile-toplevel (on the host side) after movitz-side :execute and/or :load-toplevel. Why not? Date: Wed Jul 21 05:19:15 2004 Author: ffjeld Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.19 movitz/special-operators-cl.lisp:1.20 --- movitz/special-operators-cl.lisp:1.19 Fri Jun 11 14:34:02 2004 +++ movitz/special-operators-cl.lisp Wed Jul 21 05:19:15 2004 @@ -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.19 2004/06/11 21:34:02 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.20 2004/07/21 12:19:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -864,26 +864,24 @@ (define-special-operator eval-when (&all forward &form form &top-level-p top-level-p) (destructuring-bind (situations &body body) (cdr form) - (when (member :compile-toplevel situations) -;;; (warn "EVAL-WHEN: ~S" `(progn ,@(movitz::translate-program body :muerte.cl :cl -;;; :when :eval -;;; :remove-double-quotes-p t))) - (with-compilation-unit () - (dolist (toplevel-form (translate-program body :muerte.cl :cl - :when :eval - :remove-double-quotes-p t)) - (with-host-environment () - (if *compiler-compile-eval-whens* - (funcall (compile () `(lambda () ,toplevel-form))) - (eval toplevel-form)))))) - (if (or (member :execute situations) - (and (member :load-toplevel situations) - top-level-p)) - (compiler-call #'compile-implicit-progn - :defaults forward - :top-level-p top-level-p - :form body) - (compiler-values ())))) + (multiple-value-prog1 + (if (or (member :execute situations) + (and (member :load-toplevel situations) + top-level-p)) + (compiler-call #'compile-implicit-progn + :defaults forward + :top-level-p top-level-p + :form body) + (compiler-values ())) + (when (member :compile-toplevel situations) + (with-compilation-unit () + (dolist (toplevel-form (translate-program body :muerte.cl :cl + :when :eval + :remove-double-quotes-p t)) + (with-host-environment () + (if *compiler-compile-eval-whens* + (funcall (compile () `(lambda () ,toplevel-form))) + (eval toplevel-form))))))))) (define-special-operator function (&funobj funobj &form form &result-mode result-mode &env env) (destructuring-bind (name)

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