movitz-cvs July 2004

movitz-cvs@common-lisp.net

2 participants
376 discussions

[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-serv8513 Modified Files: typep.lisp Log Message: Don't try to mirror deftype of names in the common-lisp package on the host side. Date: Wed Jul 21 07:16:57 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.29 movitz/losp/muerte/typep.lisp:1.30 --- movitz/losp/muerte/typep.lisp:1.29 Wed Jul 21 05:49:24 2004 +++ movitz/losp/muerte/typep.lisp Wed Jul 21 07:16:57 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.29 2004/07/21 12:49:24 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.30 2004/07/21 14:16:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -426,7 +426,8 @@ (let ((fname (intern (format nil "~A-~A" 'deftype name)))) `(progn (eval-when (:compile-toplevel) - ,form + (unless (eq (symbol-package ',name) (find-package :common-lisp)) + ,form) (setf (gethash (translate-program ',name :cl :muerte.cl) *compiler-derived-typespecs*) (lambda ,lambda ,@body))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/interrupt.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-serv545 Modified Files: interrupt.lisp Log Message: Don't use @ as an operator name, it's a good reader macro candidate. Date: Wed Jul 21 07:16:15 2004 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.16 movitz/losp/muerte/interrupt.lisp:1.17 --- movitz/losp/muerte/interrupt.lisp:1.16 Tue Jul 20 01:54:19 2004 +++ movitz/losp/muerte/interrupt.lisp Wed Jul 21 07:16:15 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.16 2004/07/20 08:54:19 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.17 2004/07/21 14:16:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -254,7 +254,7 @@ (defun interrupt-default-handler (number interrupt-frame) (declare (without-check-stack-limit)) - (macrolet ((@ (fixnum-address &optional (type :lisp)) + (macrolet ((dereference (fixnum-address &optional (type :lisp)) "Dereference the fixnum-address." `(memref ,fixnum-address 0 0 ,type))) (let (($eip (+ interrupt-frame (interrupt-frame-index :eip))) @@ -277,15 +277,15 @@ ((61) ;; EAX failed type in EDX. May be restarted by returning with a new value in EAX. (with-simple-restart (continue "Retry with a different value.") - (error 'type-error :datum (@ $eax) :expected-type (@ $edx))) + (error 'type-error :datum (dereference $eax) :expected-type (dereference $edx))) (format *query-io* "Enter a new value: ") - (setf (@ $eax) (read *query-io*))) + (setf (dereference $eax) (read *query-io*))) (62 (error "Trying to save too many values: ~@Z." $ecx)) (63 (error "Primitive assertion error. EIP=~@Z, ESI=~@Z." $eip $esi)) - (64 (error 'type-error :datum (@ $eax) :expected-type 'integer)) - (65 (error 'index-out-of-range :index (@ $ebx) (@ $ecx))) + (64 (error 'type-error :datum (dereference $eax) :expected-type 'integer)) + (65 (error 'index-out-of-range :index (dereference $ebx) (dereference $ecx))) (66 (error "Unspecified type error at ~@Z in ~S with EAX=~@Z, ECX=~@Z." - $eip (@ (+ interrupt-frame (interrupt-frame-index :esi))) + $eip (dereference (+ interrupt-frame (interrupt-frame-index :esi))) $eax $ecx)) (67 (backtrace :fresh-lines nil :length 6) (dotimes (i 100000) @@ -323,19 +323,19 @@ old-bottom) (setf (stack-bottom) old-bottom)))) (69 - (error "Not a function: ~S" (@ $edx))) + (error "Not a function: ~S" (dereference $edx))) (70 - (error "[EIP=~@Z] Index ~@Z out of bounds ~@Z for ~S." $eip $ecx $ebx (@ $eax))) + (error "[EIP=~@Z] Index ~@Z out of bounds ~@Z for ~S." $eip $ecx $ebx (dereference $eax))) (98 - (let ((name (@ $edx))) + (let ((name (dereference $edx))) (when (symbolp name) (error 'undefined-function :name name)))) (99 - (let ((name (@ $edx))) + (let ((name (dereference $edx))) (when (symbolp name) (error 'unbound-variable :name name)))) ((100);; 101 102 103 104 105) - (let ((funobj (@ (+ interrupt-frame (interrupt-frame-index :esi)))) + (let ((funobj (dereference (+ interrupt-frame (interrupt-frame-index :esi)))) (code (interrupt-frame-ref :ecx :unsigned-byte8 0 interrupt-frame))) (error 'wrong-argument-count :function funobj @@ -345,7 +345,7 @@ -24) code)))) (108 - (error 'throw-error :tag (@ $eax))) + (error 'throw-error :tag (dereference $eax))) (110 ;; (print-dynamic-context); what's this? (throw :debugger nil))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/read.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-serv17920 Modified Files: read.lisp Log Message: Moved un-backquote to read.lisp. Date: Wed Jul 21 07:15:43 2004 Author: ffjeld Index: movitz/losp/muerte/read.lisp diff -u movitz/losp/muerte/read.lisp:1.5 movitz/losp/muerte/read.lisp:1.6 --- movitz/losp/muerte/read.lisp:1.5 Thu Jul 8 06:38:15 2004 +++ movitz/losp/muerte/read.lisp Wed Jul 21 07:15:43 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Oct 17 21:50:42 2001 ;;;; -;;;; $Id: read.lisp,v 1.5 2004/07/08 13:38:15 ffjeld Exp $ +;;;; $Id: read.lisp,v 1.6 2004/07/21 14:15:43 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -314,3 +314,55 @@ ;;; (error 'end-of-file :stream stream)) ;;; (t eof-value)))) + +(defun un-backquote (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/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-serv17106 Modified Files: lists.lisp Log Message: Moved un-backquote to read.lisp. Date: Wed Jul 21 07:15:37 2004 Author: ffjeld Index: movitz/losp/muerte/lists.lisp diff -u movitz/losp/muerte/lists.lisp:1.7 movitz/losp/muerte/lists.lisp:1.8 --- movitz/losp/muerte/lists.lisp:1.7 Wed Jul 21 06:24:58 2004 +++ movitz/losp/muerte/lists.lisp Wed Jul 21 07:15:37 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.7 2004/07/21 13:24:58 ffjeld Exp $ +;;;; $Id: lists.lisp,v 1.8 2004/07/21 14:15:37 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -455,61 +455,3 @@ 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/storage-types.lisp
by Frode Vatvedt Fjeld 21 Jul '04

21 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv7830 Modified Files: storage-types.lisp Log Message: Use aref rather than svref, we don't know that the vector is simple. Date: Wed Jul 21 07:15:13 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.28 movitz/storage-types.lisp:1.29 --- movitz/storage-types.lisp:1.28 Mon Jul 12 19:26:19 2004 +++ movitz/storage-types.lisp Wed Jul 21 07:15:13 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.28 2004/07/13 02:26:19 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.29 2004/07/21 14:15:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -396,8 +396,8 @@ (defmethod update-movitz-object ((movitz-vector movitz-basic-vector) (vector vector)) (when (eq :any-t (movitz-vector-element-type movitz-vector)) (loop for i from 0 below (length vector) - do (setf (svref (movitz-vector-symbolic-data movitz-vector) i) - (movitz-read (svref vector i))))) + do (setf (aref (movitz-vector-symbolic-data movitz-vector) i) + (movitz-read (aref vector i))))) (values)) (defmethod write-binary-record ((obj movitz-basic-vector) stream)

1 0

[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

← Newer
1
...
9
10
11
12
13
14
15
...
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