Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv6274

Modified Files: special-operators.lisp Log Message: Many fixes to the compiler. Basic change is that LET init-forms are compiled with compile-form-unprotected, and that compile-lexical-variable and compile-self-evaluating return binding only as "returns", not in the form of "code".

Date: Sun Aug 28 23:03:55 2005 Author: ffjeld

Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.53 movitz/special-operators.lisp:1.54 --- movitz/special-operators.lisp:1.53 Sat Aug 20 22:31:25 2005 +++ movitz/special-operators.lisp Sun Aug 28 23:03:53 2005 @@ -8,7 +8,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Fri Nov 24 16:22:59 2000 ;;;; -;;;; $Id: special-operators.lisp,v 1.53 2005/08/20 20:31:25 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.54 2005/08/28 21:03:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -82,21 +82,19 @@ ((not (null then-forms)) (let ((skip-label (gensym (format nil "cond-skip-~D-" clause-num)))) (compiler-values-bind (&code test-code) - (multiple-value-bind (test-result-mode) - (cond - ((and last-clause-p - (eq (operator result-mode) - :boolean-branch-on-false)) - (cons :boolean-branch-on-false - (cdr result-mode))) - (t (cons :boolean-branch-on-false - skip-label))) - (compiler-call #'compile-form - :result-mode test-result-mode - :modify-accumulate clause-modifies - :form test-form - :funobj funobj - :env env)) + (compiler-call #'compile-form + :result-mode (cond + ((and last-clause-p + (eq (operator result-mode) + :boolean-branch-on-false)) + (cons :boolean-branch-on-false + (cdr result-mode))) + (t (cons :boolean-branch-on-false + skip-label))) + :modify-accumulate clause-modifies + :form test-form + :funobj funobj + :env env) (compiler-values-bind (&code then-code &returns then-returns) (compiler-call #'compile-form :form (cons 'muerte.cl::progn then-forms) @@ -134,8 +132,7 @@ (define-special-operator compiled-cond (&form form &funobj funobj &env env &result-mode result-mode) (let ((clauses (cdr form))) - (let* ((cond-modifies nil) - (cond-exit-label (gensym "cond-exit-")) + (let* ((cond-exit-label (gensym "cond-exit-")) (cond-result-mode (case (operator result-mode) (:values :multiple-values) ((:ignore :function :multiple-values :eax :ebx :ecx :edx @@ -152,32 +149,28 @@ '(:ignore :boolean-branch-on-true :boolean-branch-on-false)))) - (loop for clause in clauses + (loop with last-clause-num = (1- (length clauses)) + for clause in clauses for clause-num upfrom 0 - with last-clause-num = (1- (length clauses)) - as (clause-code constantly-true-p clause-modifies) = - (multiple-value-list (make-compiled-cond-clause clause - clause-num - (and only-control-p - (= clause-num last-clause-num)) - cond-exit-label funobj env cond-result-mode)) + as (clause-code constantly-true-p) = + (multiple-value-list + (make-compiled-cond-clause clause + clause-num + (and only-control-p + (= clause-num last-clause-num)) + cond-exit-label funobj env cond-result-mode)) append clause-code into cond-code - do (setf cond-modifies - (modifies-union cond-modifies clause-modifies)) when constantly-true-p do (return (compiler-values () :returns cond-returns - :modifies cond-modifies :code (append cond-code (list cond-exit-label)))) finally (return (compiler-values () :returns cond-returns - :modifies cond-modifies :code (append cond-code ;; no test succeeded => nil (unless only-control-p -;;; (warn "doing default nil..") (compiler-call #'compile-form :form nil :funobj funobj