move checking for constant ALIEN-INFO into a separate function
authorRoman Marynchak <jmrbox@gmail.com>
Sun, 8 May 2011 10:41:13 +0000 (13:41 +0300)
committerNikodemus Siivola <nikodemus@sb-studio.net>
Fri, 5 Aug 2011 08:21:11 +0000 (11:21 +0300)
  Introducing CONSTANT-ALIEN-INFO-OR-ABORT.

src/compiler/aliencomp.lisp

index 513c003..36226af 100644 (file)
 \f
 ;;;; support for local (stack or register) aliens
 
-(deftransform make-local-alien ((info) * * :important t)
+(defun alien-info-constant-or-abort (info)
   (unless (constant-lvar-p info)
-    (abort-ir1-transform "Local alien info isn't constant?"))
+    (abort-ir1-transform "Local alien info isn't constant?")))
+
+(deftransform make-local-alien ((info) * * :important t)
+  (alien-info-constant-or-abort info)
   (let* ((info (lvar-value info))
          (alien-type (local-alien-info-type info))
          (bits (alien-type-bits alien-type)))
                   (unparse-alien-type alien-type))))))))
 
 (deftransform note-local-alien-type ((info var) * * :important t)
-  ;; FIXME: This test and error occur about a zillion times. They
-  ;; could be factored into a function.
-  (unless (constant-lvar-p info)
-    (abort-ir1-transform "Local alien info isn't constant?"))
+  (alien-info-constant-or-abort info)
   (let ((info (lvar-value info)))
     (/noshow "in DEFTRANSFORM NOTE-LOCAL-ALIEN-TYPE" info)
     (/noshow (local-alien-info-force-to-memory-p info))
   nil)
 
 (deftransform local-alien ((info var) * * :important t)
-  (unless (constant-lvar-p info)
-    (abort-ir1-transform "Local alien info isn't constant?"))
+  (alien-info-constant-or-abort info)
   (let* ((info (lvar-value info))
          (alien-type (local-alien-info-type info)))
     (/noshow "in DEFTRANSFORM LOCAL-ALIEN" info alien-type)
         `(naturalize var ',alien-type))))
 
 (deftransform %local-alien-forced-to-memory-p ((info) * * :important t)
-  (unless (constant-lvar-p info)
-    (abort-ir1-transform "Local alien info isn't constant?"))
+  (alien-info-constant-or-abort info)
   (let ((info (lvar-value info)))
     (local-alien-info-force-to-memory-p info)))
 
 (deftransform %set-local-alien ((info var value) * * :important t)
-  (unless (constant-lvar-p info)
-    (abort-ir1-transform "Local alien info isn't constant?"))
+  (alien-info-constant-or-abort info)
   (let* ((info (lvar-value info))
          (alien-type (local-alien-info-type info)))
     (if (local-alien-info-force-to-memory-p info)
       *wild-type*))
 
 (deftransform %local-alien-addr ((info var) * * :important t)
-  (unless (constant-lvar-p info)
-    (abort-ir1-transform "Local alien info isn't constant?"))
+  (alien-info-constant-or-abort info)
   (let* ((info (lvar-value info))
          (alien-type (local-alien-info-type info)))
     (/noshow "in DEFTRANSFORM %LOCAL-ALIEN-ADDR, creating %SAP-ALIEN")
         (error "This shouldn't happen."))))
 
 (deftransform dispose-local-alien ((info var) * * :important t)
-  (unless (constant-lvar-p info)
-    (abort-ir1-transform "Local alien info isn't constant?"))
+  (alien-info-constant-or-abort info)
   (let* ((info (lvar-value info))
          (alien-type (local-alien-info-type info)))
     (if (local-alien-info-force-to-memory-p info)