Reimplemented C2LET without REPLACEd variables and eliminated this kind from the rest of the compiler.

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

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))

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)

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)

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))

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

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

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