Changeset 13129


Ignore:
Timestamp:
01/06/11 17:26:32 (11 years ago)
Author:
ehuelsmann
Message:

Remove UNSAFE-P from SINGLE-VALUED-P (pass2).

Note: The use of UNSAFE-P was misguided. TAGBODY returns NIL, not
any of the values in the body. UNSAFE-P was used to determine (non-local)
returns. BLOCKs do not only return the value of the last form, but can
also return any of the values from the VALUES-FORM in RETURN-FROM. Etc, etc.

Location:
branches/unsafe-p-removal/abcl/src/org/armedbear/lisp
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/unsafe-p-removal/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

    r13127 r13129  
    644644           (setf (block-non-local-return-p block) t)))
    645645    (when (block-non-local-return-p block)
    646       (dformat t "non-local return from block ~S~%" (block-name block))))
    647   (list* 'RETURN-FROM (cadr form) (mapcar #'p1 (cddr form))))
     646      (dformat t "non-local return from block ~S~%" (block-name block)))
     647    (let ((value-form (p1 (caddr form))))
     648      (push value-form (block-return-value-forms block))
     649      (list 'RETURN-FROM name value-form))))
    648650
    649651(defun p1-tagbody (form)
  • branches/unsafe-p-removal/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r13123 r13129  
    580580(defun single-valued-p (form)
    581581  (cond ((node-p form)
    582          (if (tagbody-node-p form)
    583              (not (unsafe-p (node-form form)))
    584              (single-valued-p (node-form form))))
     582         (cond ((tagbody-node-p form)
     583                t)
     584               ((block-node-p form)
     585                (and (single-valued-p (car (last (node-form form))))
     586                     ;; return-from value forms
     587                     (every #'single-valued-p
     588                            (block-return-value-forms form))))
     589               ((or (flet-node-p form)
     590                    (labels-node-p form)
     591                    (let/let*-node-p form)
     592                    (m-v-b-node-p form)
     593                    (progv-node-p form)
     594                    (locally-node-p form)
     595                    (synchronized-node-p form))
     596                (single-valued-p (car (last (node-form form)))))
     597               ((unwind-protect-node-p form)
     598                (single-valued-p (second (node-form form))))
     599               ((catch-node-p form)
     600                nil)
     601               (t
     602                (assert (not "SINGLE-VALUED-P unhandled NODE-P branch")))))
    585603        ((var-ref-p form)
    586604         t)
     
    591609               result-type
    592610               compiland)
     611           (assert (not (member op '(LET LET* FLET LABELS TAGBODY CATCH
     612                                         MULTIPLE-VALUE-BIND
     613                                         UNWIND-PROTECT BLOCK PROGV
     614                                         LOCALLY))))
    593615           (cond ((eq op 'IF)
    594616                  (and (single-valued-p (third form))
     
    596618                 ((eq op 'PROGN)
    597619                  (single-valued-p (car (last form))))
    598                  ((eq op 'BLOCK)
    599                   (single-valued-p (car (last form))))
    600                  ((memq op '(LET LET*))
    601                   (single-valued-p (car (last (cddr form)))))
    602620                 ((memq op '(AND OR))
    603621                  (every #'single-valued-p (cdr form)))
  • branches/unsafe-p-removal/abcl/src/org/armedbear/lisp/jvm.lisp

    r13120 r13129  
    465465  ;; Contains a variable whose value uniquely identifies the
    466466  ;; lexical scope from this block, to be used by RETURN-FROM
    467   id-variable)
     467  id-variable
     468  ;; A list of all RETURN-FROM value forms associated with this block
     469  return-value-forms)
     470
    468471(defknown make-block-node (t) t)
    469472(defun make-block-node (name)
Note: See TracChangeset for help on using the changeset viewer.