From 7ec2f4a93947a6430849ce912d1c8794b5ade337 Mon Sep 17 00:00:00 2001 From: Daniel Kochmanski Date: Sat, 10 Feb 2018 20:21:11 +0100 Subject: [PATCH] Major cleanup for environment mark interpretation Code was previously written with an assumption, that we know whenever function crosses lexical for closure boundaries before it is compiled (and env-mark for such boundries was LB and CB appropriately). Later it has changed, but code was ready to work with LB and CB marks. Fix these parts of code and replace it with a single mark ECI:FUNCTION. Also replace CL:UNWIND-PROTECT boundry mark with ECI:UNWIND-PROTECT so we are less dependent on use-ing CL package. Adjust comments to have this change. --- src/cmp/cmpblock.lsp | 25 ++++++++++--------------- src/cmp/cmpcatch.lsp | 2 +- src/cmp/cmpenv-api.lsp | 26 ++++++++++---------------- src/cmp/cmpflet.lsp | 14 +++++--------- src/cmp/cmpglobals.lsp | 29 +++++++++++++++-------------- src/cmp/cmplam.lsp | 6 +++--- src/cmp/cmppackage.lsp | 7 ++++++- src/cmp/cmptag.lsp | 8 +++----- src/cmp/cmptypes.lsp | 2 +- src/cmp/cmpvar.lsp | 15 +++++---------- 10 files changed, 59 insertions(+), 75 deletions(-) diff --git a/src/cmp/cmpblock.lsp b/src/cmp/cmpblock.lsp index a78f566b0..7bafa1dad 100644 --- a/src/cmp/cmpblock.lsp +++ b/src/cmp/cmpblock.lsp @@ -16,14 +16,13 @@ (in-package "COMPILER") -;;; A dummy variable is created to hold the block identifier. When a -;;; reference to the block (via return-from) is found, the var-ref -;;; count for that variable is incremented only if the reference -;;; appears across a boundary (CB, LB or UNWIND-PROTECT), while the -;;; blk-ref is always incremented. Therefore blk-ref represents -;;; whether the block is used at all and var-ref for the dummy -;;; variable represents whether a block identifier must be created and -;;; stored in such variable. +;;; A dummy variable is created to hold the block identifier. When a reference +;;; to the block (via `return-from') is found, the `var-ref' count for that +;;; variable is incremented only if the reference appears across a boundary +;;; (`ECI:FUNCTION' or `ECI:UNWIND-PROTECT'), while the `blk-ref' is always +;;; incremented. Therefore `blk-ref' represents whether the block is used at +;;; all and `var-ref' for the dummy variable represents whether a block +;;; identifier must be created and stored in such variable. (defun c1block (args) (check-args-number 'BLOCK args 1) @@ -38,8 +37,6 @@ (when (or (var-ref-ccb blk-var) (var-ref-clb blk-var)) (incf *setjmps*)) (if (plusp (blk-ref blk)) - ;; FIXME! By simplifying the type of a BLOCK form so much (it is - ;; either NIL or T), we lose a lot of information. (make-c1form* 'BLOCK :local-vars (list blk-var) :type (values-type-or (blk-type blk) (c1form-type body)) @@ -78,22 +75,20 @@ (let ((name (first args))) (unless (symbolp name) (cmperr "The block name ~s is not a symbol." name)) - (multiple-value-bind (blk ccb clb unw) + (multiple-value-bind (blk cfb unw) (cmp-env-search-block name) (unless blk (cmperr "The block ~s is undefined." name)) (let* ((val (c1expr (second args))) (var (blk-var blk)) (type T)) - (cond (ccb (setf type 'CCB - (var-ref-ccb var) T)) - (clb (setf type 'CLB + (cond (cfb (setf type 'CLB (var-ref-clb var) T)) (unw (setf type 'UNWIND-PROTECT))) (incf (blk-ref blk)) (setf (blk-type blk) (values-type-or (blk-type blk) (c1form-type val))) (let ((output (make-c1form* 'RETURN-FROM :type 'T :args blk type val))) - (when (or ccb clb unw) + (when (or cfb unw) (add-to-read-nodes var output)) output))))) diff --git a/src/cmp/cmpcatch.lsp b/src/cmp/cmpcatch.lsp index b64959899..93257fc1b 100644 --- a/src/cmp/cmpcatch.lsp +++ b/src/cmp/cmpcatch.lsp @@ -59,7 +59,7 @@ (c1expr (first args))) (T (incf *setjmps*) - (let ((form (let ((*cmp-env* (cmp-env-mark 'UNWIND-PROTECT))) + (let ((form (let ((*cmp-env* (cmp-env-mark 'ECI:UNWIND-PROTECT))) (c1expr (first args))))) (make-c1form* 'UNWIND-PROTECT :type (c1form-type form) :sp-change t :args form (c1progn (rest args))))))) diff --git a/src/cmp/cmpenv-api.lsp b/src/cmp/cmpenv-api.lsp index 5ad9b9991..c2ad0fb03 100644 --- a/src/cmp/cmpenv-api.lsp +++ b/src/cmp/cmpenv-api.lsp @@ -117,16 +117,13 @@ that are susceptible to be changed by PROCLAIM." env) (defun cmp-env-search-function (name &optional (env *cmp-env*)) - (let ((ccb nil) - (clb nil) + (let ((cfb nil) (unw nil) (found nil)) (dolist (record (cmp-env-functions env)) - (cond ((eq record 'CB) - (setf ccb t)) - ((eq record 'LB) - (setf clb t)) - ((eq record 'UNWIND-PROTECT) + (cond ((eq record 'ECI:FUNCTION) + (setf cfb t)) + ((eq record 'ECI:UNWIND-PROTECT) (setf unw t)) ((atom record) (baboon :format-control "Uknown record found in environment~%~S" @@ -135,19 +132,16 @@ that are susceptible to be changed by PROCLAIM." ((equal (first record) name) (setf found (first (last record))) (return)))) - (values found ccb clb unw))) + (values found cfb unw))) (defun cmp-env-search-variables (type name env) - (let ((ccb nil) - (clb nil) + (let ((cfb nil) (unw nil) (found nil)) (dolist (record (cmp-env-variables env)) - (cond ((eq record 'CB) - (setf ccb t)) - ((eq record 'LB) - (setf clb t)) - ((eq record 'UNWIND-PROTECT) + (cond ((eq record 'ECI:FUNCTION) + (setf cfb t)) + ((eq record 'ECI:UNWIND-PROTECT) (setf unw t)) ((atom record) (baboon :format-control "Uknown record found in environment~%~S" @@ -168,7 +162,7 @@ that are susceptible to be changed by PROCLAIM." (t (setf found record) (return)))) - (values (first (last found)) ccb clb unw))) + (values (first (last found)) cfb unw))) (defun cmp-env-search-block (name &optional (env *cmp-env*)) (cmp-env-search-variables :block name env)) diff --git a/src/cmp/cmpflet.lsp b/src/cmp/cmpflet.lsp index f51fdc5b4..e842260e7 100644 --- a/src/cmp/cmpflet.lsp +++ b/src/cmp/cmpflet.lsp @@ -51,7 +51,7 @@ (dolist (def (nreverse defs)) (let ((fun (first def))) ;; The closure type will be fixed later on by COMPUTE-... - (push (c1compile-function (rest def) :fun fun :CB/LB 'LB) + (push (c1compile-function (rest def) :fun fun) local-funs)))) ;; When we are in a LABELs form, we have to propagate the external @@ -255,7 +255,7 @@ (c1locally (cdr args)))) (defun local-function-ref (fname &optional build-object) - (multiple-value-bind (fun ccb clb unw) + (multiple-value-bind (fun cfb unw) (cmp-env-search-function fname) (declare (ignore unw)) (when fun @@ -274,13 +274,9 @@ (push caller (fun-referencing-funs fun))))) ;; we introduce a variable to hold the funob (let ((var (fun-var fun))) - (cond (ccb (when build-object - (setf (var-ref-ccb var) t - (var-kind var) 'CLOSURE)) - (setf (fun-ref-ccb fun) t)) - (clb (when build-object - (setf (var-ref-clb var) t - (var-kind var) 'LEXICAL)))))) + (when (and cfb build-object) + (setf (var-ref-clb var) t + (var-kind var) 'LEXICAL)))) fun)) (defun c2call-local (c1form fun args) diff --git a/src/cmp/cmpglobals.lsp b/src/cmp/cmpglobals.lsp index 26de12e55..e115e36e1 100644 --- a/src/cmp/cmpglobals.lsp +++ b/src/cmp/cmpglobals.lsp @@ -165,21 +165,22 @@ variable-record = (:block block-name) | (:function function-name) | (var-name {:special | nil} bound-p) | (symbol si::symbol-macro macro-function) | - CB | LB | UNWIND-PROTECT -macro-record = (function-name function) | - (macro-name si::macro macro-function) - CB | LB | UNWIND-PROTECT + ECI:FUNCTION | + ECI:UNWIND-PROTECT -A *-NAME is a symbol. A TAG-ID is either a symbol or a number. A -MACRO-FUNCTION is a function that provides us with the expansion -for that local macro or symbol macro. BOUND-P is true when the -variable has been bound by an enclosing form, while it is NIL if -the variable-record corresponds just to a special declaration. -CB, LB and UNWIND-PROTECT are only used by the C compiler and -they denote closure, lexical environment and unwind-protect -boundaries. Note that compared with the bytecodes compiler, these -records contain an additional variable, block, tag or function -object at the end.") +macro-record = (function-name function) | + (macro-name si::macro macro-function) + ECI:FUNCTION | + ECI:UNWIND-PROTECT + +A *-NAME is a symbol. A TAG-ID is either a symbol or a number. A MACRO-FUNCTION +is a function that provides us with the expansion for that local macro or symbol +macro. BOUND-P is true when the variable has been bound by an enclosing form, +while it is NIL if the variable-record corresponds just to a special +declaration. ECI:FUNCTION and ECI:UNWIND-PROTECT are only used by the C +compiler and they denote function and unwind-protect boundaries. Note that +compared with the bytecodes compiler, these records contain an additional +variable, block, tag or function object at the end.") (defvar *cmp-env-root* (cons nil (list (list '#:no-macro 'si::macro (constantly nil)))) diff --git a/src/cmp/cmplam.lsp b/src/cmp/cmplam.lsp index 98a935f8d..7770212ec 100644 --- a/src/cmp/cmplam.lsp +++ b/src/cmp/cmplam.lsp @@ -97,8 +97,8 @@ The function thus belongs to the type of functions that ecl_make_cfun accepts." (setf (fun-referenced-funs fun) new-funs) (return t)))) -(defun c1compile-function (lambda-list-and-body &key (fun (make-fun)) - (name (fun-name fun)) (CB/LB 'CB)) +(defun c1compile-function (lambda-list-and-body + &key (fun (make-fun)) (name (fun-name fun))) (let ((lambda (if name `(ext:lambda-block ,name ,@lambda-list-and-body) `(lambda ,@lambda-list-and-body)))) @@ -108,7 +108,7 @@ The function thus belongs to the type of functions that ecl_make_cfun accepts." (when *current-function* (push fun (fun-child-funs *current-function*))) (let* ((*current-function* fun) - (*cmp-env* (setf (fun-cmp-env fun) (cmp-env-mark CB/LB))) + (*cmp-env* (setf (fun-cmp-env fun) (cmp-env-mark 'ECI:FUNCTION))) (setjmps *setjmps*) (decl (si::process-declarations (rest lambda-list-and-body))) (global (and *use-c-global* diff --git a/src/cmp/cmppackage.lsp b/src/cmp/cmppackage.lsp index 11118555c..68a610fbb 100644 --- a/src/cmp/cmppackage.lsp +++ b/src/cmp/cmppackage.lsp @@ -14,7 +14,9 @@ ;;;; CMPPACKAGE -- Package definitions and exported symbols ;;;; -(ext:package-lock "CL" nil) +(defpackage #:ecl-cmp-internals + (:export #:unwind-protect + #:function)) (defpackage "C" (:nicknames "COMPILER") @@ -50,3 +52,6 @@ (:import-from "SI" "GET-SYSPROP" "PUT-SYSPROP" "REM-SYSPROP" "MACRO" "*COMPILER-CONSTANTS*" "REGISTER-GLOBAL" "CMP-ENV-REGISTER-MACROLET" "COMPILER-LET")) + +(ext:package-lock "CL" nil) +(ext:add-package-local-nickname "ECI" '#:ecl-cmp-internals '#:compiler) diff --git a/src/cmp/cmptag.lsp b/src/cmp/cmptag.lsp index d419e8ad9..f70ac5d6a 100644 --- a/src/cmp/cmptag.lsp +++ b/src/cmp/cmptag.lsp @@ -192,19 +192,17 @@ (let ((name (first args))) (unless (or (symbolp name) (integerp name)) (cmperr "The tag name ~s is not a symbol nor an integer." name)) - (multiple-value-bind (tag ccb clb unw) + (multiple-value-bind (tag cfb unw) (cmp-env-search-tag name) (unless tag (cmperr "Undefined tag ~A" name)) (let ((var (tag-var tag))) - (cond (ccb (setf (var-ref-ccb var) t - (var-kind var) 'CLOSURE)) - (clb (setf (var-ref-clb var) t + (cond (cfb (setf (var-ref-clb var) t (var-kind var) 'LEXICAL)) (unw (unless (var-kind var) (setf (var-kind var) :OBJECT)))) (incf (tag-ref tag)) - (add-to-read-nodes var (make-c1form* 'GO :args tag (or ccb clb unw))))))) + (add-to-read-nodes var (make-c1form* 'GO :args tag (or cfb unw))))))) (defun c2go (c1form tag nonlocal) (declare (ignore c1form)) diff --git a/src/cmp/cmptypes.lsp b/src/cmp/cmptypes.lsp index 2ba79fbef..369ac8ef1 100644 --- a/src/cmp/cmptypes.lsp +++ b/src/cmp/cmptypes.lsp @@ -102,7 +102,7 @@ ;;; looking at the info-referenced-vars and info-local-referenced of its body. ;;; A LISP_CFUN or LISP_CLOSURE must be created when the function is returned. -;;; The LISP funob may then be referenced locally or across LB or CB: +;;; The LISP funob may then be referenced locally or across a function boundary: ;;; (flet ((foo (z) (bar z))) (list #'foo))) ;;; (flet ((foo (z) z)) (flet ((bar () #'foo)) (bar))) ;;; (flet ((foo (z) (bar z))) #'(lambda () #'foo))) diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp index c0039dbde..03fcf6af2 100644 --- a/src/cmp/cmpvar.lsp +++ b/src/cmp/cmpvar.lsp @@ -152,8 +152,7 @@ (and record (not (var-p record))))) (defun variable-type-in-env (name &optional (env *cmp-env*)) - (multiple-value-bind (var ccb clb unw) - (cmp-env-search-var name) + (let ((var (cmp-env-search-var name))) (cond ((var-p var) (var-type var)) ((si:get-sysprop name 'CMP-TYPE)) @@ -228,7 +227,7 @@ ;;; ( var-object ) Beppe(ccb) ccb-reference ) (defun c1vref (name) - (multiple-value-bind (var ccb clb unw) + (multiple-value-bind (var cfb unw) (cmp-env-search-var name) (cond ((null var) (c1make-global-variable name :warn t @@ -242,14 +241,10 @@ ((SPECIAL GLOBAL)) ((CLOSURE)) ((LEXICAL) - (cond (ccb (setf (var-ref-clb var) nil ; replace a previous 'CLB - (var-ref-ccb var) t - (var-kind var) 'CLOSURE - (var-loc var) 'OBJECT)) - (clb (setf (var-ref-clb var) t - (var-loc var) 'OBJECT)))) + (setf (var-ref-clb var) t + (var-loc var) 'OBJECT)) (t - (when (or clb ccb) + (when cfb (cmperr "Variable ~A declared of C type cannot be referenced across function boundaries." (var-name var))))) var))))