Skip to content
Snippets Groups Projects
Commit ecf339a7 authored by wlott's avatar wlott
Browse files

Added support for dylan-var leafs. Changed typecases to etypecases so

that we get a sensible error if any more leafs get added.
parent 5652206b
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/eval.lisp,v 1.22 1993/07/25 21:17:20 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/eval.lisp,v 1.23 1993/08/23 01:35:53 wlott Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -968,11 +968,20 @@ ...@@ -968,11 +968,20 @@
;;; ;;;
(defun set-leaf-value (node frame-ptr closure value) (defun set-leaf-value (node frame-ptr closure value)
(let ((var (c::set-var node))) (let ((var (c::set-var node)))
(typecase var (etypecase var
(c::lambda-var
(set-leaf-value-lambda-var node var frame-ptr closure value))
(c::global-var (c::global-var
(setf (symbol-value (c::global-var-name var)) value)) (setf (symbol-value (c::global-var-name var)) value))
(c::lambda-var (c::dylan-var
(set-leaf-value-lambda-var node var frame-ptr closure value))))) (locally
(declare (optimize (inhibit-warnings 3)))
(setf (dylan::value-datum
(dylan::lookup-varinfo-value (c::dylan-var-name var)
(dylan::find-module
(c::dylan-var-module-name var))
t))
value))))))
;;; SET-LEAF-VALUE-LAMBDA-VAR -- Internal Interface. ;;; SET-LEAF-VALUE-LAMBDA-VAR -- Internal Interface.
;;; ;;;
...@@ -1003,6 +1012,7 @@ ...@@ -1003,6 +1012,7 @@
;;; types: ;;; types:
;;; constant -- It knows its own value. ;;; constant -- It knows its own value.
;;; global-var -- It's either a value or function reference. Get it right. ;;; global-var -- It's either a value or function reference. Get it right.
;;; dylan-var -- Global dylan variable. Just ask dylan.
;;; local-var -- This may on the stack or in the current closure, the ;;; local-var -- This may on the stack or in the current closure, the
;;; environment for the lambda INTERNAL-APPLY is currently ;;; environment for the lambda INTERNAL-APPLY is currently
;;; executing. If the leaf's home environment is the same ;;; executing. If the leaf's home environment is the same
...@@ -1027,7 +1037,7 @@ ...@@ -1027,7 +1037,7 @@
;;; ;;;
(defun leaf-value (node frame-ptr closure) (defun leaf-value (node frame-ptr closure)
(let ((leaf (c::ref-leaf node))) (let ((leaf (c::ref-leaf node)))
(typecase leaf (etypecase leaf
(c::constant (c::constant
(c::constant-value leaf)) (c::constant-value leaf))
(c::global-var (c::global-var
...@@ -1038,6 +1048,14 @@ ...@@ -1038,6 +1048,14 @@
(symbol-function name) (symbol-function name)
(fdefinition name))) (fdefinition name)))
(symbol-value (c::global-var-name leaf))))) (symbol-value (c::global-var-name leaf)))))
(c::dylan-var
(locally
(declare (optimize (inhibit-warnings 3)))
(dylan::value-datum
(dylan::lookup-varinfo-value (c::dylan-var-name leaf)
(dylan::find-module
(c::dylan-var-module-name leaf))
t))))
(c::lambda-var (c::lambda-var
(leaf-value-lambda-var node leaf frame-ptr closure)) (leaf-value-lambda-var node leaf frame-ptr closure))
(c::functional (c::functional
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment