From fdc4e9fa86b5eaaf8939f004a66e4be075069aa8 Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Thu, 5 May 2016 19:25:19 -0400 Subject: [PATCH] Remove SIMPLE-EVAL-IN-LEXENV with #!+sb-fasteval When *EVALUATOR-MODE* is :COMPILE, the tiny evaluator is redundant with fasteval. Two small adjustments to fasteval make it do the same thing that simple-eval was trying to do - avoid compiling whenever possible, and: * instead of producing a funcallable instance when encountering a FUNCTION operator, punt to the compiler. * the set of special operators to interpret is smaller than the full set of operators that could be interpreted. Also fix package locks. No new test; an existing test found the bug. --- src/code/eval.lisp | 37 ++++++++++++---- src/cold/warm.lisp | 22 ++++++---- src/interpreter/env.lisp | 2 +- src/interpreter/eval.lisp | 86 +++++++++++++++++++++----------------- src/interpreter/special-forms.lisp | 8 ++-- 5 files changed, 96 insertions(+), 59 deletions(-) diff --git a/src/code/eval.lisp b/src/code/eval.lisp index 8fefd30ae..aae834e73 100644 --- a/src/code/eval.lisp +++ b/src/code/eval.lisp @@ -23,14 +23,23 @@ ;;;; to evaluate EXPR -- if EXPR is already a lambda form, there's ;;;; no need. (defun make-eval-lambda (expr) - (if (typep expr `(cons (member lambda named-lambda lambda-with-lexenv))) - (values expr nil) - (values `(lambda () + (flet ((lexpr-p (x) + (typep x '(cons (member lambda named-lambda lambda-with-lexenv))))) + (cond ((lexpr-p expr) + (values expr nil)) + (t + (when (typep expr '(cons (eql function) (cons t null))) + (let ((inner (second expr))) + (when (lexpr-p inner) + (return-from make-eval-lambda (values inner nil))))) + (values `(lambda () ;; why PROGN? So that attempts to eval free declarations ;; signal errors rather than return NIL. -- CSR, 2007-05-01 - (progn ,expr)) - t))) + (progn ,expr)) + t))))) +;;; FIXME: what does "except in that it can't handle toplevel ..." mean? +;;; Is there anything wrong with the implementation, or is the comment obsolete? ;;; general case of EVAL (except in that it can't handle toplevel ;;; EVAL-WHEN magic properly): Delegate to #'COMPILE. (defun %simple-eval (expr lexenv) @@ -53,6 +62,8 @@ fun)))) ;;; Handle PROGN and implicit PROGN. +#!-sb-fasteval +(progn (defun simple-eval-progn-body (progn-body lexenv) (unless (list-with-length-p progn-body) (let ((*print-circle* t)) @@ -99,6 +110,7 @@ :lexenv lexenv :context :eval)))) (simple-eval-progn-body body lexenv)))) +) ; end PROGN ;;;; EVAL-ERROR ;;;; @@ -115,6 +127,7 @@ ;;; Pick off a few easy cases, and the various top level EVAL-WHEN ;;; magical cases, and call %SIMPLE-EVAL for the rest. +#!-sb-fasteval (defun simple-eval-in-lexenv (original-exp lexenv) (declare (optimize (safety 1))) ;; (aver (lexenv-simple-p lexenv)) @@ -258,6 +271,15 @@ (t exp)))))) +;;; This definition will be replaced after the interpreter is compiled. +;;; Until then we just always compile. +#!+sb-fasteval +(defun sb!interpreter:eval-in-environment (exp lexenv) + (let ((exp (macroexpand exp lexenv))) + (if (symbolp exp) + (symbol-value exp) + (%simple-eval exp (or lexenv (make-null-lexenv)))))) + (defun eval-in-lexenv (exp lexenv) #!+sb-eval (let ((lexenv (or lexenv (make-null-lexenv)))) @@ -265,9 +287,8 @@ (simple-eval-in-lexenv exp lexenv) (sb!eval:eval-in-native-environment exp lexenv))) #!+sb-fasteval - (if (eq *evaluator-mode* :compile) - (simple-eval-in-lexenv exp (or lexenv (make-null-lexenv))) - (sb!interpreter:eval-in-environment exp lexenv)) + (sb!c:with-compiler-error-resignalling + (sb!interpreter:eval-in-environment exp lexenv)) #!-(or sb-eval sb-fasteval) (simple-eval-in-lexenv exp (or lexenv (make-null-lexenv)))) diff --git a/src/cold/warm.lisp b/src/cold/warm.lisp index 39ee26520..c32fc95c3 100644 --- a/src/cold/warm.lisp +++ b/src/cold/warm.lisp @@ -89,7 +89,16 @@ ;;; into build-order.lisp-expr with some new flag (perhaps :WARM) to ;;; indicate that the files should be handled not in cold load but ;;; afterwards. -(let ((pcl-srcs +(let ((interpreter-srcs + #+sb-fasteval + '("SRC;INTERPRETER;MACROS" + "SRC;INTERPRETER;CHECKFUNS" + "SRC;INTERPRETER;ENV" + "SRC;INTERPRETER;SEXPR" + "SRC;INTERPRETER;SPECIAL-FORMS" + "SRC;INTERPRETER;EVAL" + "SRC;INTERPRETER;DEBUG")) + (pcl-srcs '(;; CLOS, derived from the PCL reference implementation ;; ;; This PCL build order is based on a particular @@ -151,14 +160,6 @@ ;; cold init "SRC;CODE;DESCRIBE" - #+sb-fasteval "SRC;INTERPRETER;MACROS" - #+sb-fasteval "SRC;INTERPRETER;CHECKFUNS" - #+sb-fasteval "SRC;INTERPRETER;ENV" - #+sb-fasteval "SRC;INTERPRETER;SEXPR" - #+sb-fasteval "SRC;INTERPRETER;SPECIAL-FORMS" - #+sb-fasteval "SRC;INTERPRETER;EVAL" - #+sb-fasteval "SRC;INTERPRETER;DEBUG" - "SRC;CODE;DESCRIBE-POLICY" "SRC;CODE;INSPECT" "SRC;CODE;PROFILE" @@ -219,6 +220,9 @@ (with-compilation-unit () (let ((*compile-print* nil)) + (do-srcs interpreter-srcs))) + (with-compilation-unit () + (let ((*compile-print* nil)) (do-srcs pcl-srcs))) (when *compile-files-p* (format t "~&; Done with PCL compilation~2%")) diff --git a/src/interpreter/env.lisp b/src/interpreter/env.lisp index bed30f07d..83f0e0c44 100644 --- a/src/interpreter/env.lisp +++ b/src/interpreter/env.lisp @@ -285,7 +285,7 @@ (recurse it (and globalp (not (lambda-env-p env))))) (globalp (setq list (copy-list sb-c::*disabled-package-locks*)))) - (do-decl-spec (declaration (env-declarations env)) + (do-decl-spec (declaration (env-declarations env) list) (when (member (car declaration) '(disable-package-locks enable-package-locks)) (setq list (sb-c::process-package-lock-decl declaration list)))))) diff --git a/src/interpreter/eval.lisp b/src/interpreter/eval.lisp index 8c1cffd25..4f0e2ae77 100644 --- a/src/interpreter/eval.lisp +++ b/src/interpreter/eval.lisp @@ -66,10 +66,18 @@ (defparameter *eval-level* -1) (defparameter *eval-verbose* nil) +;;; These are the forms sb-fasteval will process for itself when the evaluator +;;; mode is :COMPILE. They all preserve a bidirectional mapping between +;;; LEXENV and subtypes of BASIC-ENV. Things like BLOCK/RETURN could not. +;;; The list also happens to match the the tiny evaluator (in 'eval'), +;;; though it might be reasonable to have additional things here. +(defconstant-eqx !simple-special-operators + '(eval-when if progn quote locally macrolet symbol-macrolet setq) + #'equal) + (defun %eval (exp env) - (incf *eval-calls*) (labels - ((%%eval () + ((%%eval (&aux fname special-op) (cond ((symbolp exp) ;; CLHS 3.1.2.1.1 Symbols as Forms @@ -81,35 +89,38 @@ ;; CLHS 3.1.2.1.3 Self-Evaluating Objects ;; We can save a few instructions vs. testing ATOM ;; because SYMBOLP was already picked off. - ((not (listp exp)) - exp) + ((not (listp exp)) exp) + ;; CLHS 3.1.2.1.2 Conses as Forms + ((eq (setq fname (car exp)) 'setq) + (eval-setq (cdr exp) env nil)) ; SEXPR = nil + ;; CLHS 3.1.2.1.2.4 Lambda Forms + ((typep fname '(cons (eql lambda))) + (if (eq sb-ext:*evaluator-mode* :interpret) + ;; It should be possible to avoid consing a function, + ;; but this syntax isn't common enough to matter. + (apply-it (funcall (if (must-freeze-p env) #'enclose-freeze #'enclose) + (make-proto-fn fname) env nil)) + (compile-it))) + ((not (symbolp fname)) + (ip-error "Invalid function name: ~S" fname)) + ;; CLHS 3.1.2.1.2.1 Special Forms + ;; Pick off special forms first for speed. Special operators + ;; can't be shadowed by local defs. + ((setq special-op (let ((fdefn (sb-impl::symbol-fdefn fname))) + (and fdefn (!special-form-handler fdefn)))) + (if (or (eq sb-ext:*evaluator-mode* :interpret) + (member fname !simple-special-operators)) + (funcall (truly-the function (car special-op)) (cdr exp) env) + (compile-it))) (t - ;; CLHS 3.1.2.1.2 Conses as Forms - (let ((fname (car exp))) - ;; CLHS 3.1.2.1.2.4 Lambda Forms - (cond ((eq fname 'setq) - (eval-setq (cdr exp) env nil)) ; SEXPR = nil - ((typep fname '(cons (eql lambda))) - ;; It should be possible to avoid consing a function, - ;; but this syntax isn't common enough to matter. - (apply-it (funcall (if (must-freeze-p env) #'enclose-freeze #'enclose) - (make-proto-fn fname) env nil))) - ((not (symbolp fname)) - (ip-error "Invalid function name: ~S" fname)) - (t - ;; CLHS 3.1.2.1.2.1 Special Forms - ;; Pick off special forms first for speed. Special operators - ;; can't be shadowed by local defs. - (let ((fdefn (sb-impl::symbol-fdefn fname))) - (acond - ((and fdefn (!special-form-handler fdefn)) - (funcall (truly-the function (car it)) (cdr exp) env)) - (t - ;; Everything else: macros and functions. - (multiple-value-bind (fn macro-p) (get-function (car exp) env) - (if macro-p - (%eval (funcall (valid-macroexpand-hook) fn exp env) env) - (apply-it fn)))))))))))) + ;; Everything else: macros and functions. + (multiple-value-bind (fn macro-p) (get-function (car exp) env) + (if macro-p + (%eval (funcall (valid-macroexpand-hook) fn exp env) env) + (apply-it fn)))))) + (compile-it () ; the escape hatch for evaluator-mode = :COMPILE. + (sb-impl::%simple-eval + exp (if env (lexenv-from-env env) (make-null-lexenv)))) (apply-it (f) (let ((args (mapcar (lambda (arg) (%eval arg env)) (cdr exp))) (h *applyhook*)) @@ -195,15 +206,14 @@ (digest-global-call fname (cdr form) env))) (%dispatch sexpr env)))))) -;;; full-eval has compiler-error-resignalling stuff in here. -;;; I think it was better to wrap the handler for EVAL-ERROR around everything -;;; due to the relative expense of establishing a handler-binding. -;;; In this interpreter it is better to establish handlers for EVAL-ERROR -;;; on an as-needed localized basis, when the preprocessor knows that -;;; condition might be signaled. Otherwise there should be no handler. +(fmakunbound 'eval-in-environment) (defun eval-in-environment (form env) - (%eval form - (typecase env (sb-kernel:lexenv (env-from-lexenv env)) (t env)))) + (incf *eval-calls*) + ;; Should we pre-test that ENV is one that can be converted both to + ;; and from an interpreter environment? If it isn't, we might want to + ;; call the compiler now rather than performing an un-invertable step. + ;; Can that happen? + (%eval form (typecase env (sb-kernel:lexenv (env-from-lexenv env)) (t env)))) (defun unintern-init-only-stuff () (let ((this-pkg (find-package "SB-INTERPRETER"))) diff --git a/src/interpreter/special-forms.lisp b/src/interpreter/special-forms.lisp index 403ce7187..ebab4b34d 100644 --- a/src/interpreter/special-forms.lisp +++ b/src/interpreter/special-forms.lisp @@ -1236,7 +1236,9 @@ ABS ADJUSTABLE-ARRAY-P ALPHA-CHAR-P ALPHANUMERICP - ARRAY-DIMENSIONS ARRAY-ELEMENT-TYPE ARRAY-HAS-FILL-POINTER-P + ;;; Compiling ARRAY-ELEMENT-TYPE refers to the type CLASS + ;;; which isn't defined yet. Why does it? + ARRAY-DIMENSIONS #|ARRAY-ELEMENT-TYPE|# ARRAY-HAS-FILL-POINTER-P ARRAY-IN-BOUNDS-P ARRAY-RANK ARRAY-TOTAL-SIZE ARRAYP ATOM BIT-NOT BIT-VECTOR-P BOTH-CASE-P BOUNDP @@ -1245,7 +1247,7 @@ CHAR-INT CHAR-LESSP CHAR-NOT-EQUAL CHAR-NOT-GREATERP CHAR-NOT-LESSP CHAR-UPCASE CHAR/= CHAR< CHAR<= CHAR= CHAR> CHAR>= - CHARACTER CHARACTERP CLASS-NAME CLASS-OF + CHARACTER CHARACTERP CODE-CHAR COMPILED-FUNCTION-P COMPLEMENT COMPLEX COMPLEXP CONSP DENOMINATOR @@ -1277,7 +1279,7 @@ STRING-CAPITALIZE STRING-DOWNCASE STRING-UPCASE STRINGP SXHASH SYMBOL-FUNCTION SYMBOL-NAME SYMBOL-PACKAGE SYMBOL-PLIST SYMBOL-VALUE SYMBOLP - TRUNCATE TYPE-OF + TRUNCATE UPPER-CASE-P VALUES-LIST VECTOR-POP -- 2.11.4.GIT