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)))))