/[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.32 by pw, Thu Feb 25 13:03:04 1999 UTC revision 1.33 by dtc, Tue Sep 26 16:38:57 2000 UTC
# Line 644  Line 644 
644          (internal-apply res nil '#()))))          (internal-apply res nil '#()))))
645    
646    
 ;;; MAKE-INDIRECT-VALUE-CELL -- Internal.  
 ;;;  
 ;;; Later this will probably be the same weird internal thing the compiler  
 ;;; makes to represent these things.  
 ;;;  
 (defun make-indirect-value-cell (value)  
   (list value))  
 ;;;  
 (defmacro indirect-value (value-cell)  
   `(car ,value-cell))  
   
   
647  ;;; VALUE -- Internal.  ;;; VALUE -- Internal.
648  ;;;  ;;;
649  ;;; This passes on a node's value appropriately, possibly returning from  ;;; This passes on a node's value appropriately, possibly returning from
# Line 708  Line 696 
696          (cond ((c::leaf-refs var)          (cond ((c::leaf-refs var)
697                 (setf (eval-stack-local frame-ptr (c::lambda-var-info var))                 (setf (eval-stack-local frame-ptr (c::lambda-var-info var))
698                       (if (c::lambda-var-indirect var)                       (if (c::lambda-var-indirect var)
699                           (make-indirect-value-cell (pop args))                           (c:make-value-cell (pop args))
700                           (pop args))))                           (pop args))))
701                (ignore-unused (pop args)))))                (ignore-unused (pop args)))))
702      (internal-apply-loop (c::lambda-bind lambda) frame-ptr lambda args      (internal-apply-loop (c::lambda-bind lambda) frame-ptr lambda args
# Line 917  Line 905 
905  ;;; SET-LEAF-VALUE-LAMBDA-VAR -- Internal Interface.  ;;; SET-LEAF-VALUE-LAMBDA-VAR -- Internal Interface.
906  ;;;  ;;;
907  ;;; This does SET-LEAF-VALUE for a lambda-var leaf.  The debugger tools'  ;;; This does SET-LEAF-VALUE for a lambda-var leaf.  The debugger tools'
908  ;;; internals uses this also to set interpreted local variables.  ;;; internals uses this also to set interpreted local variables. If the var
909    ;;; is a lexical variable with no refs, then we don't actually set anything,
910    ;;; since the variable has been deleted.
911  ;;;  ;;;
912  (defun set-leaf-value-lambda-var (node var frame-ptr closure value)  (defun set-leaf-value-lambda-var (node var frame-ptr closure value)
913    (let ((env (c::node-environment node)))    (when (c::leaf-refs var)
914      (cond ((not (eq (c::lambda-environment (c::lambda-var-home var))      (let ((env (c::node-environment node)))
915                      env))        (cond ((not (eq (c::lambda-environment (c::lambda-var-home var))
916             (setf (indirect-value                        env))
917                    (svref closure               (c:value-cell-set
918                           (position var (c::environment-closure env)                (svref closure (position var (c::environment-closure env)
919                                     :test #'eq)))                                         :test #'eq))
920                   value))                value))
921            ((c::lambda-var-indirect var)              ((c::lambda-var-indirect var)
922             (setf (indirect-value               (c:value-cell-set
923                    (eval-stack-local frame-ptr (c::lambda-var-info var)))                (eval-stack-local frame-ptr (c::lambda-var-info var))
924                   value))                value))
925            (t              (t
926             (setf (eval-stack-local frame-ptr (c::lambda-var-info var))               (setf (eval-stack-local frame-ptr (c::lambda-var-info var))
927                   value)))))                     value)))))
928      value)
929    
930  ;;; LEAF-VALUE -- Internal.  ;;; LEAF-VALUE -- Internal.
931  ;;;  ;;;
# Line 1028  Line 1019 
1019                       (position leaf (c::environment-closure env)                       (position leaf (c::environment-closure env)
1020                                 :test #'eq)))))                                 :test #'eq)))))
1021      (if (c::lambda-var-indirect leaf)      (if (c::lambda-var-indirect leaf)
1022          (indirect-value temp)          (c:value-cell-ref temp)
1023          temp)))          temp)))
1024    
1025  ;;; COMPUTE-CLOSURE -- Internal.  ;;; COMPUTE-CLOSURE -- Internal.
# Line 1172  Line 1163 
1163        (when (c::leaf-refs v)        (when (c::leaf-refs v)
1164          (setf (eval-stack-local frame-ptr (c::lambda-var-info v))          (setf (eval-stack-local frame-ptr (c::lambda-var-info v))
1165                (if (c::lambda-var-indirect v)                (if (c::lambda-var-indirect v)
1166                    (make-indirect-value-cell (pop args))                    (c:make-value-cell (pop args))
1167                    (pop args)))))))                    (pop args)))))))
1168    
1169  ;;; STORE-MV-LET-VARS -- Internal.  ;;; STORE-MV-LET-VARS -- Internal.
# Line 1191  Line 1182 
1182        (if (c::leaf-refs v)        (if (c::leaf-refs v)
1183            (setf (eval-stack-local frame-ptr (c::lambda-var-info v))            (setf (eval-stack-local frame-ptr (c::lambda-var-info v))
1184                  (if (c::lambda-var-indirect v)                  (if (c::lambda-var-indirect v)
1185                      (make-indirect-value-cell (pop args))                      (c:make-value-cell (pop args))
1186                      (pop args)))                      (pop args)))
1187            (pop args)))))            (pop args)))))
1188    
# Line 1223  Line 1214 
1214          (when (c::leaf-refs v)          (when (c::leaf-refs v)
1215            (setf (eval-stack-local frame-ptr (c::lambda-var-info v))            (setf (eval-stack-local frame-ptr (c::lambda-var-info v))
1216                  (if (c::lambda-var-indirect v)                  (if (c::lambda-var-indirect v)
1217                      (make-indirect-value-cell (car remaining-args))                      (c:make-value-cell (car remaining-args))
1218                      (car remaining-args))))                      (car remaining-args))))
1219          (cdr remaining-args))          (cdr remaining-args))
1220        args))        args))

Legend:
Removed from v.1.32  
changed lines
  Added in v.1.33

  ViewVC Help
Powered by ViewVC 1.1.5