Changeset 13147


Ignore:
Timestamp:
01/14/11 15:57:37 (11 years ago)
Author:
ehuelsmann
Message:

Set the COMPILAND-%SINGLE-VALUED-P field after the full analysis of the
compiland's source form, instead of setting it to T if *any*
non-single-valued function is called.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

    r13118 r13147  
    12901290  (let* ((op (car form))
    12911291         (local-function (find-local-function op)))
    1292     (cond (local-function
     1292    (when local-function
    12931293;;            (format t "p1 local call to ~S~%" op)
    12941294;;            (format t "inline-p = ~S~%" (inline-p op))
    1295            (when (and *enable-inline-expansion* (inline-p op)
    1296           (local-function-definition local-function))
    1297              (let* ((definition (local-function-definition local-function))
    1298         (lambda-list (car definition))
    1299         (body (cdr definition))
    1300         (expansion (generate-inline-expansion op lambda-list body
    1301                 (cdr form))))
    1302                (when expansion
    1303                  (let ((explain *explain*))
    1304                    (when (and explain (memq :calls explain))
    1305                      (format t ";   inlining call to local function ~S~%" op)))
    1306                  (return-from p1-function-call
    1307        (let ((*inline-declarations*
    1308         (remove op *inline-declarations* :key #'car :test #'equal)))
    1309          (p1 expansion))))))
    1310 
    1311            ;; FIXME
    1312            (dformat t "local function assumed not single-valued~%")
    1313            (setf (compiland-%single-valued-p *current-compiland*) nil)
    1314 
    1315            (let ((variable (local-function-variable local-function)))
    1316              (when variable
    1317                (dformat t "p1 ~S used non-locally~%" (variable-name variable))
    1318                (setf (variable-used-non-locally-p variable) t))))
    1319           (t
    1320            ;; Not a local function call.
    1321            (dformat t "p1 non-local call to ~S~%" op)
    1322            (unless (single-valued-p form)
    1323 ;;                (format t "not single-valued op = ~S~%" op)
    1324              (setf (compiland-%single-valued-p *current-compiland*) nil)))))
     1295
     1296      (when (and *enable-inline-expansion* (inline-p op)
     1297                 (local-function-definition local-function))
     1298        (let* ((definition (local-function-definition local-function))
     1299               (lambda-list (car definition))
     1300               (body (cdr definition))
     1301               (expansion (generate-inline-expansion op lambda-list body
     1302                                                     (cdr form))))
     1303          (when expansion
     1304            (let ((explain *explain*))
     1305              (when (and explain (memq :calls explain))
     1306                (format t ";   inlining call to local function ~S~%" op)))
     1307            (return-from p1-function-call
     1308                         (let ((*inline-declarations*
     1309                                (remove op *inline-declarations* :key #'car :test #'equal)))
     1310                           (p1 expansion))))))
     1311
     1312      (let ((variable (local-function-variable local-function)))
     1313        (when variable
     1314          (dformat t "p1 ~S used non-locally~%" (variable-name variable))
     1315          (setf (variable-used-non-locally-p variable) t)))))
    13251316  (p1-default form))
    13261317
     
    14581449           (closure (make-closure `(lambda ,lambda-list nil) nil))
    14591450           (syms (sys::varlist closure))
    1460            (vars nil))
     1451           (vars nil)
     1452           compiland-result)
    14611453      (dolist (sym syms)
    14621454        (let ((var (make-variable :name sym
     
    14701462        (dolist (var free-specials)
    14711463          (push var *visible-variables*)))
     1464      (setf compiland-result
     1465            (list* 'LAMBDA lambda-list (p1-body body)))
     1466      (setf (compiland-%single-valued-p compiland)
     1467            (single-valued-p compiland-result))
    14721468      (setf (compiland-p1-result compiland)
    1473             (list* 'LAMBDA lambda-list (p1-body body))))))
     1469            compiland-result))))
    14741470
    14751471(provide "COMPILER-PASS1")
Note: See TracChangeset for help on using the changeset viewer.