Changeset 13123

Timestamp:

01/04/11 09:22:57 (13 years ago)

Author:

ehuelsmann

Message:

Remove UNSAFE-P from pass2 by eliminating SETQ rewriting.

File:

• branches/unsafe-p-removal/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (modified) (4 diffs)

branches/unsafe-p-removal/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -6149 +6149 @@
          (compile-function-call form target representation))))
 
-(declaim (ftype (function (t) t) rewrite-setq))
-(defun rewrite-setq (form)
-  (let ((expr (%caddr form)))
-    (if (unsafe-p expr)
-        (let ((sym (gensym)))
-          (list 'LET (list (list sym expr)) (list 'SETQ (%cadr form) sym)))
-        form)))
-
 (defknown p2-setq (t t t) t)
 (defun p2-setq (form target representation)
@@ -6165 +6157 @@
          (value-form (%caddr form)))
     (when (or (null variable)
-              (variable-special-p variable))
-      (let ((new-form (rewrite-setq form)))
-        (when (neq new-form form)
-          (return-from p2-setq (compile-form (p1 new-form) target representation))))
+        (variable-special-p variable))
       ;; We're setting a special variable.
       (cond ((and variable
@@ -6175 +6164 @@
                   (not (enclosed-by-runtime-bindings-creating-block-p
                         (variable-block variable))))
+       ;; ### choose this compilation order to prevent
+       ;; with-operand-accumulation
+             (compile-forms-and-maybe-emit-clear-values value-form 'stack nil)
+       (emit 'dup)
              (aload (variable-binding-register variable))
-             (compile-forms-and-maybe-emit-clear-values value-form 'stack nil)
-             (emit 'dup_x1) ;; copy past th
+             (emit 'swap)
              (emit-putfield +lisp-special-binding+ "value"
                    +lisp-object+))
@@ -6184 +6176 @@
                   (= (length value-form) 3)
                   (var-ref-p (third value-form))
-                  (eq (variable-name (var-ref-variable (third value-form))) name))
-             (emit-push-current-thread)
-             (emit-load-externalized-object name)
-             (compile-forms-and-maybe-emit-clear-values (second value-form) 'stack nil)
-             (emit-invokevirtual +lisp-thread+ "pushSpecial"
-                                 (list +lisp-symbol+ +lisp-object+) +lisp-object+))
+                  (eq (variable-name (var-ref-variable (third value-form)))
+          name))
+       (with-operand-accumulation
+           ((emit-thread-operand)
+      (emit-load-externalized-object-operand name)
+      (compile-operand (second value-form) nil)
+      (maybe-emit-clear-values (second value-form)))
+    (emit-invokevirtual +lisp-thread+ "pushSpecial"
+            (list +lisp-symbol+ +lisp-object+)
+            +lisp-object+)))
             (t
-             (emit-push-current-thread)
-             (emit-load-externalized-object name)
-             (compile-forms-and-maybe-emit-clear-values value-form 'stack nil)
-             (emit-invokevirtual +lisp-thread+ "setSpecialVariable"
-                                 (list +lisp-symbol+ +lisp-object+) +lisp-object+)))
+       (with-operand-accumulation
+           ((emit-thread-operand)
+      (emit-load-externalized-object-operand name)
+      (compile-operand value-form nil)
+      (maybe-emit-clear-values value-form))
+         (emit-invokevirtual +lisp-thread+ "setSpecialVariable"
+           (list +lisp-symbol+ +lisp-object+)
+           +lisp-object+))))
       (fix-boxing representation nil)
       (emit-move-from-stack target representation)