X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fearly-type-vops.lisp;h=8b4d96c56ce9136851904a46d45f434cb1104940;hb=77869604fc3eb4417a630651e5fe40e74342ee59;hp=d3572d6812e78b654f0f68474a23a70c5b83df6c;hpb=d007a04970c7daa85d522a1816e3ffc7a3bf1913;p=sbcl.git

diff --git a/src/compiler/generic/early-type-vops.lisp b/src/compiler/generic/early-type-vops.lisp
index d3572d6..8b4d96c 100644
--- a/src/compiler/generic/early-type-vops.lisp
+++ b/src/compiler/generic/early-type-vops.lisp
@@ -1,5 +1,15 @@
-(in-package "SB!VM")
+;;;; generic type testing and checking apparatus
 
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+(in-package "SB!VM")
+
 (defparameter *immediate-types*
   (list unbound-marker-widetag base-char-widetag))
 
@@ -31,7 +41,10 @@
 	(emit-test)))
     (results)))
 
-(defmacro test-type (value target not-p &rest type-codes)
+(defmacro test-type (value target not-p
+		     (&rest type-codes)
+		     &rest other-args
+		     &key &allow-other-keys)
   ;; Determine what interesting combinations we need to test for.
   (let* ((type-codes (mapcar #'eval type-codes))
 	 (fixnump (and (member even-fixnum-lowtag type-codes)
@@ -62,8 +75,10 @@
 	 (error "can't mix fixnum testing with other immediates"))
        (if headers
 	   `(%test-fixnum-and-headers ,value ,target ,not-p
-	     ',(canonicalize-headers headers))
-	   `(%test-fixnum ,value ,target ,not-p)))
+	     ',(canonicalize-headers headers)
+	     ,@other-args)
+	   `(%test-fixnum ,value ,target ,not-p
+	     ,@other-args)))
       (immediates
        (when headers
 	 (error "can't mix testing of immediates with testing of headers"))
@@ -71,18 +86,22 @@
 	 (error "can't mix testing of immediates with testing of lowtags"))
        (when (cdr immediates)
 	 (error "can't test multiple immediates at the same time"))
-       `(%test-immediate ,value ,target ,not-p ,(car immediates)))
+       `(%test-immediate ,value ,target ,not-p ,(car immediates)
+	 ,@other-args))
       (lowtags
        (when (cdr lowtags)
 	 (error "can't test multiple lowtags at the same time"))
        (if headers
 	   `(%test-lowtag-and-headers
 	     ,value ,target ,not-p ,(car lowtags)
-	     ,function-p ',(canonicalize-headers headers))
-	   `(%test-lowtag ,value ,target ,not-p ,(car lowtags))))
+	     ,function-p ',(canonicalize-headers headers)
+	     ,@other-args)
+	   `(%test-lowtag ,value ,target ,not-p ,(car lowtags)
+	     ,@other-args)))
       (headers
        `(%test-headers ,value ,target ,not-p ,function-p
-	 ',(canonicalize-headers headers)))
+	 ',(canonicalize-headers headers)
+	 ,@other-args))
       (t
        (error "nothing to test?")))))