Changeset 13157

Timestamp:

01/19/11 13:09:14 (13 years ago)

Author:

ehuelsmann

Message:

Further transition to unsafety detection in pass2.

Location:

branches/unsafe-p-removal/abcl/src/org/armedbear/lisp

Files:

• compiler-pass1.lisp (modified) (3 diffs)
• compiler-pass2.lisp (modified) (3 diffs)

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

@@ -1154 +1154 @@
   '(
 
-     %ldb
-     and
-     aset
      char
      char-code
@@ -1192 +1189 @@
      mod
      not
-     nthcdr
      null
      or
@@ -1221 +1217 @@
        vector-push-extend
        write-8-bits
-       with-inline-code)
+)
 "The functions named in the list bound to this variable
 need to be rewritten if UNSAFE-P returns non-NIL for their

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

@@ -4663 +4663 @@
           ((and (fixnum-type-p size-type)
                 (fixnum-type-p position-type))
-           (compile-forms-and-maybe-emit-clear-values size-arg 'stack :int
-                                                      position-arg 'stack :int
-                                                      arg3 'stack nil)
+           (with-operand-accumulation
+                ((compile-operand size-arg :int)
+                 (compile-operand position-arg :int)
+                 (compile-operand arg3 nil)
+                 (maybe-emit-clear-values size-arg position-arg arg3)))
            (emit 'dup_x2) ;; use not supported by emit-dup: 3 values involved
            (emit 'pop)
@@ -5975 +5977 @@
                 (*register* *register*)
                 (value-register (unless (null target) (allocate-register nil))))
+           (with-operand-accumulation
+               (
            ;; array
-           (compile-form arg1 'stack nil)
+                (compile-operand arg1 nil)
            ;; index
-           (compile-form arg2 'stack :int)
+                (compile-operand arg2 :int)
            ;; value
-           (cond ((fixnum-type-p type3)
-                  (compile-form arg3 'stack :int)
-                  (when value-register
-                    (emit 'dup)
-                    (emit-move-from-stack value-register :int)))
-                 (t
-                  (compile-form arg3 'stack nil)
-                  (when value-register
-                    (emit 'dup)
-                    (emit-move-from-stack value-register nil))))
+                (accumulate-operand
+                         ((when (fixnum-type-p type3) :int)
+                          :unsafe-p (some-nested-block
+                                     #'node-opstack-unsafe-p
+                                     (find-enclosed-blocks arg3)))
+                   (cond ((fixnum-type-p type3)
+                          (compile-form arg3 'stack :int)
+                          (when value-register
+                            (emit 'dup)
+                            (emit-move-from-stack value-register :int)))
+                         (t
+                          (compile-form arg3 'stack nil)
+                          (when value-register
+                            (emit 'dup)
+                            (emit-move-from-stack value-register nil)))))))
            (maybe-emit-clear-values arg1 arg2 arg3)
            (cond ((fixnum-type-p type3)
                   (emit-invokevirtual +lisp-object+ "aset" '(:int :int) nil))
                  (t
-                  (emit-invokevirtual +lisp-object+ "aset" (list :int +lisp-object+) nil)))
+                  (emit-invokevirtual +lisp-object+ "aset"
+                                      (list :int +lisp-object+) nil)))
            (when value-register
              (cond ((fixnum-type-p type3)
@@ -6148 +6158 @@
          (arg2 (%cadr args)))
     (cond ((fixnum-type-p (derive-compiler-type arg1))
-           (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
-                                                      arg2 'stack nil)
+           (with-operand-accumulation
+               ((compile-operand arg1 :int)
+                (compile-operand arg2 nil)
+                (maybe-emit-clear-values arg1 arg2)))
            (emit 'swap)
            (emit-invokevirtual +lisp-object+ "nthcdr" '(:int) +lisp-object+)