From bb3eeabf7461d76039e5da63a3cd5a06588ae260 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Tue, 25 May 2010 19:43:31 +0200 Subject: [PATCH] Reimplemented C2LET without REPLACEd variables and eliminated this kind from the rest of the compiler. --- src/cmp/cmpflet.lsp | 3 +- src/cmp/cmpinline.lsp | 12 +++- src/cmp/cmplet.lsp | 140 ++++++++++++++++++------------------------ src/cmp/cmploc.lsp | 23 +++++++ src/cmp/cmpprop.lsp | 4 +- src/cmp/cmptop.lsp | 2 +- src/cmp/cmptypes.lsp | 4 +- src/cmp/cmpvar.lsp | 24 +++----- 8 files changed, 106 insertions(+), 106 deletions(-) diff --git a/src/cmp/cmpflet.lsp b/src/cmp/cmpflet.lsp index 3064cb5dd..c6c331a1c 100644 --- a/src/cmp/cmpflet.lsp +++ b/src/cmp/cmpflet.lsp @@ -89,8 +89,7 @@ body-c1form))) (defun fun-referred-local-vars (fun) - (remove-if #'(lambda (v) (member (var-kind v) '(SPECIAL GLOBAL REPLACED))) - (fun-referred-vars fun))) + (remove-if #'global-var-p (fun-referred-vars fun))) (defun compute-fun-closure-type (fun) (labels diff --git a/src/cmp/cmpinline.lsp b/src/cmp/cmpinline.lsp index e00f2b1b0..40341ce08 100644 --- a/src/cmp/cmpinline.lsp +++ b/src/cmp/cmpinline.lsp @@ -294,8 +294,16 @@ (nreverse rts)) inline-info)))) -(defun close-inline-blocks () - (dotimes (i *inline-blocks*) (declare (fixnum i)) (wt #\}))) +(defun maybe-open-inline-block () + (unless (plusp *inline-blocks*) + (wt "{") + (setf *inline-blocks* 1))) + +(defun close-inline-blocks (&optional new-line) + (loop for i of-type fixnum from 0 below *inline-blocks* + when (and (zerop i) new-line) + do (wt-nl) + do (wt #\}))) (defun form-causes-side-effect (form) (c1form-side-effects form)) diff --git a/src/cmp/cmplet.lsp b/src/cmp/cmplet.lsp index ee60b91e7..f38e43322 100644 --- a/src/cmp/cmplet.lsp +++ b/src/cmp/cmplet.lsp @@ -124,7 +124,7 @@ do (fix-read-only-variable-type var form rest-forms) unless (and read-only-p (or (c1let-unused-variable-p var form) - (c1let-constant-value var form rest-vars rest-forms) + (c1let-constant-value-p var form rest-vars rest-forms) (c1let-can-move-variable-value-p var form rest-vars rest-forms))) collect var into used-vars and collect form into used-forms @@ -149,16 +149,32 @@ (delete-c1forms form) t)) -(defun c1let-constant-value (var form rest-vars rest-forms) +(defun c1let-constant-value-p (var form rest-vars rest-forms) ;; (let ((v1 e1) (v2 e2) (v3 e3)) (expr e4 v2 e5)) ;; - v2 is a read only variable ;; - the value of e2 is not modified in e3 nor in following expressions - (when (and (notany #'(lambda (v) (var-referenced-in-form v form)) rest-vars) - (c1form-unmodified-p form rest-forms)) + (when (and (eq (c1form-name form) 'LOCATION) + (loc-in-c1form-movable-p (c1form-arg 0 form))) (cmpdebug "Replacing variable ~A by its value ~A" (var-name var) form) (nsubst-var var form) t)) +(defun c2let-replaceable-var-ref-p (var form rest-forms) + (when (and (eq (c1form-name form) 'VAR) + (null (var-set-nodes var)) + (local var)) + (let ((var1 (c1form-arg 0 form))) + (declare (type var var1)) + (when (and ;; Fixme! We should be able to replace variable + ;; even if they are referenced across functions. + ;; We just need to keep track of their uses. + (local var1) + (eq (unboxed var) (unboxed var1)) + (not (var-changed-in-form-list var1 rest-forms))) + (cmpdebug "Replacing variable ~a by its value" (var-name var)) + (nsubst-var var form) + t)))) + (defun c1let-can-move-variable-value-p (var form rest-vars rest-forms) ;; (let ((v1 e1) (v2 e2) (v3 e3)) (expr e4 v2 e5)) ;; can become @@ -214,79 +230,56 @@ :format-arguments (list (var-name var) *current-form*)))) (defun c2let* (vars forms body - &aux (block-p nil) - (*unwind-exit* *unwind-exit*) - (*env* *env*) - (*env-lvl* *env-lvl*) env-grows) + &aux + (*unwind-exit* *unwind-exit*) + (*env* *env*) + (*env-lvl* *env-lvl*) + (*inline-blocks* 0)) (declare (type boolean block-p)) ;; FIXME! Until we switch on the type propagation phase we do ;; this little optimization here (mapc 'c2let-update-variable-type vars forms) - (do ((vl vars (cdr vl)) - (fl forms (cdr fl)) - (var) (form) (kind)) - ((endp vl)) - (declare (type var var)) - (setq form (car fl) - var (car vl) - kind (local var)) - (unless (unboxed var) - ;; LEXICAL, CLOSURE, SPECIAL, GLOBAL or OBJECT - (case (c1form-name form) - (LOCATION - (when (can-be-replaced* var body (cdr fl)) - (cmpdebug "Replacing variable ~a by its value" (var-name var)) - (setf (var-kind var) 'REPLACED - (var-loc var) (c1form-arg 0 form)))) - (VAR - (let* ((var1 (c1form-arg 0 form))) - (declare (type var var1)) - (when (and ;; Fixme! We should be able to replace variable - ;; even if they are referenced across functions. - ;; We just need to keep track of their uses. - (member (var-kind var1) '(REPLACED :OBJECT)) - (can-be-replaced* var body (cdr fl)) - (not (var-changed-in-form-list var1 (rest fl))) - (not (var-changed-in-form var1 body))) - (cmpdebug "Replacing variable ~a by its value" (var-name var)) - (setf (var-kind var) 'REPLACED - (var-loc var) var1))))) - (unless env-grows - (setq env-grows (var-ref-ccb var)))) - (when (and kind (not (eq (var-kind var) 'REPLACED))) - (bind (next-lcl) var) - (wt-nl) (unless block-p (wt "{") (setq block-p t)) - (wt *volatile* (rep-type-name kind) " " var ";") - (wt-comment (var-name var))) - ) + ;; Replace read-only variables when it is worth doing it. + (loop for var in vars + for rest-forms on (append forms (list body)) + for form = (first rest-forms) + unless (c2let-replaceable-var-ref-p var form rest-forms) + collect var into used-vars and + collect form into used-forms + finally (setf vars used-vars forms used-forms)) - (when (env-grows env-grows) - (unless block-p - (wt-nl "{ ") (setq block-p t)) + ;; Emit C definitions of local variables + (loop for var in vars + for kind = (local var) + when kind + do (progn + (wt-nl)(maybe-open-inline-block) + (bind (next-lcl) var) + (wt *volatile* (rep-type-name kind) " " var ";") + (wt-comment (var-name var)))) + + ;; Create closure bindings for closed-over variables + (when (some #'var-ref-ccb vars) + (wt-nl) (maybe-open-inline-block) (let ((env-lvl *env-lvl*)) (wt *volatile* "cl_object env" (incf *env-lvl*) " = env" env-lvl ";"))) - (do ((vl vars (cdr vl)) - (fl forms (cdr fl)) - (var nil) (form nil)) - ((null vl)) - (declare (type var var)) - (setq var (car vl) - form (car fl)) - (case (var-kind var) - (REPLACED) - ((LEXICAL CLOSURE SPECIAL GLOBAL) - (case (c1form-name form) - (LOCATION (bind (c1form-arg 0 form) var)) - (VAR (bind (c1form-arg 0 form) var)) - (t (bind-init form var)))) - (t ; local var - (let ((*destination* var)) ; nil (ccb) - (c2expr* form))) - ) - ) + ;; Assign values + (loop for form in forms + for var in vars + do (case (var-kind var) + ((LEXICAL CLOSURE SPECIAL GLOBAL) + (case (c1form-name form) + (LOCATION (bind (c1form-arg 0 form) var)) + (VAR (bind (c1form-arg 0 form) var)) + (t (bind-init form var)))) + (t ; local var + (let ((*destination* var)) ; nil (ccb) + (c2expr* form))))) + + ;; Optionally register the variables with the IHS frame for debugging (if (policy-debug-variable-bindings) (let ((*unwind-exit* *unwind-exit*)) (wt-nl "{") @@ -297,8 +290,7 @@ (when env (pop-debug-lexical-env)))) (c2expr body)) - (when block-p (wt-nl "}")) - ) + (close-inline-blocks :line)) (defun discarded (var form body &aux last) (labels ((last-form (x &aux (args (c1form-args x))) @@ -315,16 +307,6 @@ (eq var (last-form body)) (eq 'TRASH *destination*)))))) -(defun can-be-replaced (var body) - (declare (type var var)) - (and (eq (var-kind var) :OBJECT) - (not (var-changed-in-form var body)))) - -(defun can-be-replaced* (var body forms) - (declare (type var var)) - (and (can-be-replaced var body) - (not (var-changed-in-form-list var forms)))) - ;; should check whether a form before var causes a side-effect ;; exactly one occurrence of var is present in forms (defun delete-c1forms (form) diff --git a/src/cmp/cmploc.lsp b/src/cmp/cmploc.lsp index 3541ebad6..f5ba6d9ba 100644 --- a/src/cmp/cmploc.lsp +++ b/src/cmp/cmploc.lsp @@ -21,6 +21,7 @@ ;;; VALUE0 ;;; VALUES ;;; var-object +;;; a string designating a C expression ;;; ( VALUE i ) VALUES(i) ;;; ( VV vv-index ) ;;; ( VV-temp vv-index ) @@ -67,6 +68,28 @@ (TRASH 'TRASH) (T 'RETURN))) +(defun loc-in-c1form-movable-p (loc) + "A location that is in a C1FORM and can be moved" + (cond ((member loc '(t nil)) + t) + ((ext:fixnump loc) + t) + ((stringp loc) + t) + ((member loc '(value0 values va-arg cl-va-arg)) + nil) + ((atom loc) + (baboon :format-control "Unknown location ~A found in C1FORM" + :format-arguments (list loc))) + ((member (setf loc (car loc)) + '(VV VV-TEMP FIXNUM-VALUE CHARACTER-VALUE + DOUBLE-FLOAT-VALUE SINGLE-FLOAT-VALUE #+long-float LONG-FLOAT-VALUE + KEYVARS)) + t) + (t + (baboon :format-control "Unknown location ~A found in C1FORM" + :format-arguments (list loc))))) + (defun uses-values (loc) (and (consp loc) (or (member (car loc) '(CALL CALL-NORMAL CALL-INDIRECT) :test #'eq) diff --git a/src/cmp/cmpprop.lsp b/src/cmp/cmpprop.lsp index 8b712ef20..61dd75568 100644 --- a/src/cmp/cmpprop.lsp +++ b/src/cmp/cmpprop.lsp @@ -106,7 +106,7 @@ of the occurrences in those lists." (defun revise-var-type (variable assumptions where-to-stop) (unless (member (var-kind variable) - '(LEXICAL CLOSURE SPECIAL GLOBAL REPLACED) :test #'eql) + '(LEXICAL CLOSURE SPECIAL GLOBAL) :test #'eql) (do* ((l assumptions (cdr l)) (variable-type nil)) ((or (null l) (eq l where-to-stop)) @@ -125,7 +125,7 @@ of the occurrences in those lists." one-type)))))))) (defun p1expand-assumptions (var type assumptions) - (unless (member (var-kind var) '(LEXICAL CLOSURE SPECIAL GLOBAL REPLACED)) + (unless (member (var-kind var) '(LEXICAL CLOSURE SPECIAL GLOBAL)) (prop-message "~&;;; Adding variable ~A with type ~A" (var-name var) type) (unless (or (var-set-nodes var) (var-functions-setting var)) (prop-message "~&;;; Changing type of read-only variable ~A" (var-name var)) diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index 6ee8d9b00..7f001a7af 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -558,7 +558,7 @@ (:char . "_ecl_base_char_loc") (:float . "_ecl_float_loc") (:double . "_ecl_double_loc") - ((special global closure replaced lexical) . NIL))))) + ((special global closure lexical) . NIL))))) (defun build-debug-lexical-env (var-locations &optional first) #-:msvc ;; FIXME! Problem with initialization of statically defined vectors diff --git a/src/cmp/cmptypes.lsp b/src/cmp/cmptypes.lsp index 9e7031d1d..5a0b4d585 100644 --- a/src/cmp/cmptypes.lsp +++ b/src/cmp/cmptypes.lsp @@ -52,8 +52,7 @@ ; read-nodes ;;; Nodes (c1forms) in which the reference occurs set-nodes ;;; Nodes in which the variable is modified kind ;;; One of LEXICAL, CLOSURE, SPECIAL, GLOBAL, :OBJECT, :FIXNUM, - ;;; :CHAR, :DOUBLE, :FLOAT, or REPLACED (used for - ;;; LET variables). + ;;; :CHAR, :DOUBLE, :FLOAT. (function *current-function*) ;;; For local variables, in which function it was created. ;;; For global variables, it doesn't have a meaning. @@ -69,7 +68,6 @@ ;;; variable is used later, and therefore CLB may supersede ;;; OBJECT. ;;; During Pass 2: - ;;; For REPLACED: the actual location of the variable. ;;; For :FIXNUM, :CHAR, :FLOAT, :DOUBLE, :OBJECT: ;;; the cvar for the C variable that holds the value. ;;; For LEXICAL or CLOSURE: the frame-relative address for diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp index 94528e322..5ae88a3cb 100644 --- a/src/cmp/cmpvar.lsp +++ b/src/cmp/cmpvar.lsp @@ -43,24 +43,16 @@ (defun var-referenced-in-form (var form) (declare (type var var)) - (if (eq (var-kind var) 'REPLACED) - (let ((loc (var-loc var))) - (when (var-p loc) - (var-referenced-in-forms loc form))) - (or (find-form-in-node-list form (var-read-nodes var)) - (var-functions-reading var)))) + (or (find-form-in-node-list form (var-read-nodes var)) + (var-functions-reading var))) (defun var-changed-in-form (var form) (declare (type var var)) (let ((kind (var-kind var))) - (if (eq (var-kind var) 'REPLACED) - (let ((loc (var-loc var))) - (when (var-p loc) - (var-changed-in-form loc form))) - (or (find-form-in-node-list form (var-set-nodes var)) - (if (or (eq kind 'SPECIAL) (eq kind 'GLOBAL)) - (c1form-sp-change form) - (var-functions-setting var)))))) + (or (find-form-in-node-list form (var-set-nodes var)) + (if (or (eq kind 'SPECIAL) (eq kind 'GLOBAL)) + (c1form-sp-change form) + (var-functions-setting var))))) (defun update-variable-type (var orig-type) ;; FIXME! Refuse to update type of variables that are modified @@ -247,7 +239,7 @@ (not (eq (var-rep-type var) :object))) (defun local (var) - (and (not (member (var-kind var) '(LEXICAL CLOSURE SPECIAL GLOBAL REPLACED))) + (and (not (member (var-kind var) '(LEXICAL CLOSURE SPECIAL GLOBAL))) (var-kind var))) (defun global-var-p (var) @@ -264,7 +256,6 @@ (case (var-kind var) (CLOSURE (wt-env var-loc)) (LEXICAL (wt-lex var-loc)) - (REPLACED (wt var-loc)) ((SPECIAL GLOBAL) (if (safe-compile) (wt "ecl_symbol_value(" var-loc ")") @@ -275,7 +266,6 @@ (defun var-rep-type (var) (case (var-kind var) ((LEXICAL CLOSURE SPECIAL GLOBAL) :object) - (REPLACED (loc-representation-type (var-loc var))) (t (var-kind var)))) (defun set-var (loc var &aux (var-loc (var-loc var))) ; ccb