make factoring of common sub-expressions in inliners more conservative.
authorJean-Claude Beaudoin <jean.claude.beaudoin@gmail.com>
Tue, 10 Sep 2013 07:55:58 +0000 (03:55 -0400)
committerJean-Claude Beaudoin <jean.claude.beaudoin@gmail.com>
Tue, 10 Sep 2013 07:55:58 +0000 (03:55 -0400)
src/cmp/cmpffi.lsp
src/cmp/cmpinline.lsp

index be4c1fe..7dde872 100644 (file)
 
 (defun loc-movable-p (loc)
   (if (atom loc)
-      t
-      (case (first loc)
-       ((CALL CALL-LOCAL) NIL)
-       ((C-INLINE) (not (fifth loc))) ; side effects?
-       (otherwise t)
-       )))
+      (if (var-p loc)
+          (case (var-kind loc) ((CLOSURE SPECIAL GLOBAL) nil) (otherwise t)) ;; for efficiency reason.
+        t)
+    (case (first loc)
+      ((CALL CALL-LOCAL CALL-NORMAL CALL-INDIRECT) NIL) ;; Is CALL-LOCAL still used?
+      ((FDEFINITION MAKE-CCLOSURE SI::STRUCTURE-REF) NIL)  ;; for efficiency reason.
+      ((C-INLINE) NIL) ;; the safe choice, otherwise we need to prove it both side-effect free and context insensitive.
+      ((COERCE-LOC) (loc-movable-p (third loc)))
+      ((CAR CDR CADR) NIL) ;; not moveable in a multi-thread context.
+      (otherwise t)
+      )))
 
 (defun loc-type (loc)
   (cond ((eq loc NIL) 'NULL)
               (unless block-opened
                 (incf *inline-blocks*)
                 (wt-nl "{"))
-              (wt (rep-type-name rep-type) " " lcl "= ")
+              (wt " const " (rep-type-name rep-type) " " lcl "= ")
               (wt-coerce-loc rep-type loc)
               (wt ";")
               (setq loc lcl)))
index fce3ce4..81bb99b 100644 (file)
@@ -86,7 +86,7 @@
               (let* ((and-type (type-and return-type (loc-type loc)))
                      (out-rep-type (loc-representation-type loc))
                      (var (make-lcl-var :rep-type out-rep-type :type and-type)))
-                (wt-nl "{" (rep-type-name out-rep-type) " " var "= " loc ";")
+                (wt-nl "{" " const " (rep-type-name out-rep-type) " " var "= " loc ";")
                 (incf *inline-blocks*)
                 (setq loc var)
                 (push (list (loc-type loc) loc) locs))