movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 12 Apr '08

12 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv29667 Modified Files: defmacro-runtime.lisp Log Message: Rename to defmacro/run-time and defmacro/compile-time --- /project/movitz/cvsroot/movitz/losp/muerte/defmacro-runtime.lisp 2008/03/19 15:00:13 1.2 +++ /project/movitz/cvsroot/movitz/losp/muerte/defmacro-runtime.lisp 2008/04/12 16:23:31 1.3 @@ -7,7 +7,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: defmacro-runtime.lisp,v 1.2 2008/03/19 15:00:13 ffjeld Exp $ +;;;; $Id: defmacro-runtime.lisp,v 1.3 2008/04/12 16:23:31 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -17,6 +17,6 @@ (defmacro defmacro (name lambda-list &body macro-body) `(progn - (defmacro/runtime ,name ,lambda-list ,@macro-body) - (defmacro-compile-time ,name ,lambda-list ,macro-body) + (defmacro/run-time ,name ,lambda-list ,@macro-body) + (defmacro/compile-time ,name ,lambda-list ,macro-body) ',name))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 12 Apr '08

12 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv29617 Modified Files: defmacro-bootstrap.lisp Log Message: Rename to defmacro/run-time and defmacro/compile-time --- /project/movitz/cvsroot/movitz/losp/muerte/defmacro-bootstrap.lisp 2008/03/17 08:00:21 1.1 +++ /project/movitz/cvsroot/movitz/losp/muerte/defmacro-bootstrap.lisp 2008/04/12 16:23:28 1.2 @@ -7,14 +7,14 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: defmacro-bootstrap.lisp,v 1.1 2008/03/17 08:00:21 ffjeld Exp $ +;;;; $Id: defmacro-bootstrap.lisp,v 1.2 2008/04/12 16:23:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ (provide :muerte/defmacro-bootstrap) -(muerte::defmacro-compile-time muerte.cl:defmacro (name lambda-list &body macro-body) - (`(muerte::defmacro-compile-time ,name ,lambda-list ,macro-body))) +(muerte::defmacro/compile-time muerte.cl:defmacro (name lambda-list &body macro-body) + (`(muerte::defmacro/compile-time ,name ,lambda-list ,macro-body))) (muerte.cl:defmacro muerte.cl:in-package (name) `(progn @@ -25,13 +25,13 @@ (defmacro defmacro/cross-compilation (name lambda-list &body body) `(progn - (defmacro-compile-time ,name ,lambda-list ,body) + (defmacro/compile-time ,name ,lambda-list ,body) ',name)) (defmacro defmacro (name lambda-list &body body) `(defmacro/cross-compilation ,name ,lambda-list ,@body)) -(defmacro defmacro/runtime (name lambda-list &body body) +(defmacro defmacro/run-time (name lambda-list &body body) (multiple-value-bind (real-body declarations docstring) (movitz::parse-docstring-declarations-and-body body 'cl:declare) (let* ((block-name (compute-function-block-name name))

1 0

[movitz-cvs] CVS movitz
by ffjeld 12 Apr '08

12 Apr '08

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv29597 Modified Files: special-operators.lisp Log Message: Rename to defmacro/run-time and defmacro/compile-time --- /project/movitz/cvsroot/movitz/special-operators.lisp 2008/03/15 20:57:03 1.57 +++ /project/movitz/cvsroot/movitz/special-operators.lisp 2008/04/12 16:23:26 1.58 @@ -8,7 +8,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 24 16:22:59 2000 ;;;; -;;;; $Id: special-operators.lisp,v 1.57 2008/03/15 20:57:03 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.58 2008/04/12 16:23:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -348,7 +348,7 @@ (movitz-macro-expander-make-function expander :type :setf :name access-fn))))))) (compiler-values ())) -(define-special-operator muerte::defmacro-compile-time (&form form) +(define-special-operator muerte::defmacro/compile-time (&form form) (destructuring-bind (name lambda-list macro-body) (cdr form) (check-type name symbol "a macro name")

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 09 Apr '08

09 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv15504 Modified Files: more-macros.lisp Log Message: For destructuring-bind, fix parsing of &key bindings (sometimes init-form and supplied-p were ignored). --- /project/movitz/cvsroot/movitz/losp/muerte/more-macros.lisp 2008/03/16 22:28:18 1.41 +++ /project/movitz/cvsroot/movitz/losp/muerte/more-macros.lisp 2008/04/09 18:33:41 1.42 @@ -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.41 2008/03/16 22:28:18 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.42 2008/04/09 18:33:41 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -248,7 +248,10 @@ ((atom b) (values b (intern (string b) :keyword) nil nil)) ((atom (car b)) - (values (car b) (intern (string (car b)) :keyword) nil nil)) + (values (car b) + (intern (string (pop b)) :keyword) + (pop b) + (pop b))) (t (let ((bn (pop b))) (values (cadr bn) (car bn) (pop b) (pop b)))))) (when supplied-var @@ -543,7 +546,9 @@ (defmacro/cross-compilation load (filespec &key verbose print if-does-not-exist external-format) "hm..." (warn "load-compile: ~S" filespec) - `(funcall ',(movitz:movitz-compile-file (format nil "losp/ansi-tests/~A" filespec)))) + `(progn + (format t "~&Loading ~S.." ',filespec) + (funcall ',(movitz:movitz-compile-file (format nil "losp/ansi-tests/~A" filespec))))) (defmacro locally (&body body) `(let () ,@body)) @@ -571,3 +576,6 @@ (*read-suppress* nil) #+ignore (*readtable* nil)) ,@body)) + +(defmacro/run-time loop (&rest clauses) + (error "Loop not implemented."))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 09 Apr '08

09 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv8438 Modified Files: typep.lisp Log Message: Add compiled-function-p. --- /project/movitz/cvsroot/movitz/losp/muerte/typep.lisp 2008/04/02 20:49:47 1.57 +++ /project/movitz/cvsroot/movitz/losp/muerte/typep.lisp 2008/04/09 18:02:47 1.58 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.57 2008/04/02 20:49:47 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.58 2008/04/09 18:02:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -652,6 +652,9 @@ (define-simple-typep (function functionp) (x) (typep x 'function)) +(define-simple-typep (compiled-function compiled-function-p) (x) + (typep x 'compiled-function)) + (define-simple-typep (macro-function macro-function-p) (x) (typep x 'macro-function))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 09 Apr '08

09 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv8362 Modified Files: symbols.lisp Log Message: Fix buggy copy-symbol. --- /project/movitz/cvsroot/movitz/losp/muerte/symbols.lisp 2007/04/07 08:02:35 1.29 +++ /project/movitz/cvsroot/movitz/losp/muerte/symbols.lisp 2008/04/09 18:02:31 1.30 @@ -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.29 2007/04/07 08:02:35 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.30 2008/04/09 18:02:31 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -139,10 +139,10 @@ (load-global-constant movitz::unbound-function)))) (defun %create-symbol (name &optional (package nil) - (plist nil) - (value (load-global-constant new-unbound-value)) - (function (load-global-constant movitz::unbound-function)) - (flags 0)) + (value (load-global-constant new-unbound-value)) + (flags 0) + (plist nil) + (function (load-global-constant movitz::unbound-function))) (eval-when (:compile-toplevel) (assert (= 1 (- (movitz:tag :symbol) (movitz:tag :other))))) (let ((sxhash (sxhash name))) @@ -179,31 +179,29 @@ "copy-symbol returns a fresh, uninterned symbol, the name of which is string= to and possibly the same as the name of the given symbol." - (if (or (eq nil symbol) - (not copy-properties)) - (%create-symbol (symbol-name symbol)) - (with-non-header-allocation-assembly - (6 :object-register :eax :fixed-size-p t) - (:addl 1 :eax) - (:load-lexical (:lexical-binding symbol) :ebx) - ;; 0 - (:movl (:ebx #.(cl:- (movitz:tag :symbol)) 0) :ecx) - (:movl :ecx (:eax #.(cl:- (movitz:tag :symbol)) 0)) - ;; 1 - (:movl (:ebx #.(cl:- (movitz:tag :symbol)) 4) :ecx) - (:movl :ecx (:eax #.(cl:- (movitz:tag :symbol)) 4)) - ;; 2 - (:movl (:ebx #.(cl:- (movitz:tag :symbol)) 8) :ecx) - (:movl :ecx (:eax #.(cl:- (movitz:tag :symbol)) 8)) - ;; 3 - (:movl (:ebx #.(cl:- (movitz:tag :symbol)) 12) :ecx) - (:movl :ecx (:eax #.(cl:- (movitz:tag :symbol)) 12)) - ;; 4 - (:movl (:ebx #.(cl:- (movitz:tag :symbol)) 16) :ecx) - (:movl :ecx (:eax #.(cl:- (movitz:tag :symbol)) 16)) - ;; 5 - (:movl (:ebx #.(cl:- (movitz:tag :symbol)) 20) :ecx) - (:movl :ecx (:eax #.(cl:- (movitz:tag :symbol)) 20))))) + (cond + ((not copy-properties) + (%create-symbol (symbol-name symbol))) + ((eq symbol nil) + (%create-symbol (symbol-name symbol) + nil + nil + (symbol-flags nil))) + (t (with-non-header-allocation-assembly + (6 :object-register :eax :fixed-size-p t) + (:addl 1 :eax) + (:load-lexical (:lexical-binding symbol) :ebx) + (:movl (:ebx (:offset movitz-symbol function-value)) :ecx) + (:movl :ecx (:eax (:offset movitz-symbol function-value) 0)) + (:movl (:ebx (:offset movitz-symbol value)) :ecx) + (:movl :ecx (:eax (:offset movitz-symbol value))) + (:movl (:ebx (:offset movitz-symbol plist)) :ecx) + (:movl :ecx (:eax (:offset movitz-symbol plist))) + (:movl (:ebx (:offset movitz-symbol name)) :ecx) + (:movl :ecx (:eax (:offset movitz-symbol name))) + (:movl :edi (:eax (:offset movitz-symbol package))) ; no package + (:movl (:ebx (:offset movitz-symbol flags)) :ecx) + (:movl :ecx (:eax (:offset movitz-symbol flags))))))) (defun symbol-flags (symbol) (etypecase symbol

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 09 Apr '08

09 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv8133 Modified Files: interrupt.lisp Log Message: Error rather than break upon stack-exhaustion. --- /project/movitz/cvsroot/movitz/losp/muerte/interrupt.lisp 2008/02/18 22:31:13 1.57 +++ /project/movitz/cvsroot/movitz/losp/muerte/interrupt.lisp 2008/04/09 18:02:04 1.58 @@ -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.57 2008/02/18 22:31:13 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.58 2008/04/09 18:02:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -381,7 +381,7 @@ (- old-bottom new-bottom) new-bottom) (backtrace :length 5 :spartan t) - (break "Stack overload exception ~D at EIP=~@Z, ESP=~@Z, bottom=#x~X, ENV=#x~X." + (error "Stack overload exception ~D at EIP=~@Z, ESP=~@Z, bottom=#x~X, ENV=#x~X." vector $eip (dit-frame-esp nil dit-frame) old-bottom

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 09 Apr '08

09 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv7715 Modified Files: conditions.lisp Log Message: Somewhat improved ecase (signal a type-error). --- /project/movitz/cvsroot/movitz/losp/muerte/conditions.lisp 2008/04/08 21:42:08 1.25 +++ /project/movitz/cvsroot/movitz/losp/muerte/conditions.lisp 2008/04/09 18:01:36 1.26 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 20 15:47:04 2002 ;;;; -;;;; $Id: conditions.lisp,v 1.25 2008/04/08 21:42:08 ffjeld Exp $ +;;;; $Id: conditions.lisp,v 1.26 2008/04/09 18:01:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -127,6 +127,18 @@ :datum datum :expected-type (cons 'or expecteds))) +(define-condition ecase-error (type-error) + () + (:report (lambda (c s) + (format s "The object '~S' fell through an ecase where the legal cases were ~S." + (type-error-datum c) + (type-error-expected-type c))))) + +(defun ecase-error (datum expecteds) + (error 'ecase-error + :datum datum + :expected-type (cons 'member expecteds))) + (define-condition control-error (error) ()) (define-condition throw-error (control-error)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 09 Apr '08

09 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv7674 Modified Files: basic-macros.lisp Log Message: Somewhat improved ecase (signal a type-error). --- /project/movitz/cvsroot/movitz/losp/muerte/basic-macros.lisp 2008/03/20 22:50:01 1.75 +++ /project/movitz/cvsroot/movitz/losp/muerte/basic-macros.lisp 2008/04/09 18:01:34 1.76 @@ -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.75 2008/03/20 22:50:01 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.76 2008/04/09 18:01:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -375,10 +375,17 @@ (t `(compiled-case ,keyform ,@clauses)))) (defmacro ecase (keyform &rest clauses) - ;; "Not quite implemented.." - `(case ,keyform ,@clauses (t (error "~S fell through an ecase where the legal cases were ~S" - ,keyform - ',(mapcar #'first clauses))))) + (let ((ecase-var (gensym))) + `(let ((,ecase-var ,keyform)) + (case ,ecase-var + ,@clauses + (t (ecase-error ,ecase-var + ',(mapcan (lambda (clause) + (let ((x (car clause))) + (if (atom x) + (list x) + (copy-list x)))) + clauses))))))) (define-compiler-macro asm-register (register-name) (if (member register-name '(:eax :ebx :ecx :untagged-fixnum-ecx :edx)) @@ -1117,11 +1124,17 @@ (define-compiler-macro boundp (symbol) `(with-inline-assembly-case () - (do-case (t :boolean-zf=0 :labels (boundp-done)) + (do-case (t :boolean-zf=0 :labels (boundp-done boundp-restart)) (:compile-form (:result-mode :ebx) ,symbol) + boundp-restart (:leal (:ebx ,(- (movitz:tag :null))) :ecx) (:testb 5 :cl) - (:jne '(:sub-program () (:int 66))) + (:jne '(:sub-program () + (:movl :ebx :eax) + (:load-constant symbol :edx) + (:int 60) + (:movl :eax :ebx) + (:jmp 'boundp-restart))) (:call-local-pf dynamic-variable-lookup) (:globally (:cmpl (:edi (:edi-offset new-unbound-value)) :eax)))))

1 0

[movitz-cvs] CVS movitz
by ffjeld 09 Apr '08

09 Apr '08

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv7047 Modified Files: image.lisp Log Message: A bit bigger stack cushion by default. --- /project/movitz/cvsroot/movitz/image.lisp 2008/04/02 20:49:30 1.119 +++ /project/movitz/cvsroot/movitz/image.lisp 2008/04/09 18:00:56 1.120 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.119 2008/04/02 20:49:30 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.120 2008/04/09 18:00:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1015,7 +1015,7 @@ (set-file-position stream (global-slot-position 'stack-vector) 'stack-vector) (write-binary 'word stream stack-vector-word) (set-file-position stream (global-slot-position 'stack-bottom) 'stack-bottom) - (write-binary 'lu32 stream (+ 8 (* 4 4096) ; cushion + (write-binary 'lu32 stream (+ 8 (* 6 4096) ; cushion (- stack-vector-word (tag :other)))) (set-file-position stream (global-slot-position 'stack-top) 'stack-top) (write-binary 'lu32 stream (+ 8 (- stack-vector-word (tag :other))

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