/[cmucl]/src/compiler/eval.lisp
ViewVC logotype

Diff of /src/compiler/eval.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by ram, Wed Feb 7 12:07:22 1990 UTC revision 1.3 by ram, Wed Feb 7 14:49:20 1990 UTC
# Line 927  Line 927 
927  ;;;                  that calls INTERNAL-APPLY, closing over the leaf.  We also  ;;;                  that calls INTERNAL-APPLY, closing over the leaf.  We also
928  ;;;                  have to compute a closure, running environment, for the  ;;;                  have to compute a closure, running environment, for the
929  ;;;                  lambda in case it references stuff in the current  ;;;                  lambda in case it references stuff in the current
930  ;;;                  environment.  ;;;                  environment.  If the closure is empty and there is no
931    ;;;                  functional environment, then we use
932    ;;;                  MAKE-INTERPRETED-FUNCTION to make a cached translation.
933    ;;;                  Since it is too late to lazily convert, we set up the
934    ;;;                  EVAL-FUNCTION to be already converted.
935  ;;;  ;;;
936  (defun leaf-value (node frame-ptr closure)  (defun leaf-value (node frame-ptr closure)
937    (let ((leaf (c::ref-leaf node)))    (let ((leaf (c::ref-leaf node)))
# Line 954  Line 958 
958               (indirect-value temp)               (indirect-value temp)
959               temp)))               temp)))
960        (c::functional        (c::functional
961         (let ((calling-closure (compute-closure node leaf frame-ptr closure))         (let* ((calling-closure (compute-closure node leaf frame-ptr closure))
962               (eval-fun (make-eval-function                (real-fun (c::functional-entry-function leaf))
963                          :definition leaf                (arg-doc (c::functional-arg-documentation real-fun)))
964                          :name (c::leaf-name leaf)           (cond ((c:lambda-eval-info-function (c::leaf-info leaf)))
965                          :arglist (c::functional-arg-documentation                 ((and (zerop (length closure))
966                                    (c::functional-entry-function leaf)))))                       (null (c::functional-fenv real-fun)))
967           ;; Make interpreter IR1 thing be a real function that you can                  (let* ((res (make-interpreted-function
968           ;; call anytime, anywhere.                               (c::functional-inline-expansion real-fun)))
969           #'(lambda (&rest args)                         (eval-fun (get-eval-function res)))
970               (declare (list args))                    (push eval-fun *interpreted-function-cache*)
971               (internal-apply (eval-function-definition eval-fun)                    (setf (eval-function-definition eval-fun) leaf)
972                               (cons (length args) args)                    (setf (eval-function-converted-once eval-fun) t)
973                               calling-closure)))))))                    (setf (eval-function-arglist eval-fun) arg-doc)
974                      (setf (eval-function-name eval-fun) (c::leaf-name real-fun))
975                      (setf (c:lambda-eval-info-function (c::leaf-info leaf)) res)
976                      res))
977                   (t
978                    (let ((eval-fun (make-eval-function
979                                     :definition leaf
980                                     :name (c::leaf-name real-fun)
981                                     :arglist arg-doc)))
982                      #'(lambda (&rest args)
983                          (declare (list args))
984                          (internal-apply (eval-function-definition eval-fun)
985                                          (cons (length args) args)
986                                          calling-closure))))))))))
987    
988    
989  ;;; COMPUTE-CLOSURE -- Internal.  ;;; COMPUTE-CLOSURE -- Internal.

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

  ViewVC Help
Powered by ViewVC 1.1.5