Thou shalt not MAKE-OTHER-IMMEDIATE-TYPE.

  * Really, it's only ever used to make unbound-markers, for which
we have MAKE-UNBOUND-MARKER, which produces more optimal code in
the first place, has a shorter invocation, and reveals intention
far better than using MAKE-OTHER-IMMEDIATE-TYPE.

  * Rewrite all uses of MAKE-OTHER-IMMEDIATE-TYPE, excise the VOPs
from all of the backends, and remove the symbol name from package-
data.

  * And add DESCRIPTOR-REG to the permitted SCs for
MAKE-UNBOUND-MARKER, since it now must be legal to use a TN of
primitive-type T.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index ac8e63a..1a6ebf6 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -300,7 +300,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
                "MAKE-CLOSURE" "MAKE-CONSTANT-TN"
                "MAKE-FIXUP-NOTE"
                "MAKE-LOAD-TIME-CONSTANT-TN" "MAKE-N-TNS" "MAKE-NORMAL-TN"
-               "MAKE-OTHER-IMMEDIATE-TYPE" "MAKE-RANDOM-TN"
+               "MAKE-RANDOM-TN"
                "MAKE-REPRESENTATION-TN" "MAKE-RESTRICTED-TN" "MAKE-SC-OFFSET"
                "MAKE-STACK-POINTER-TN" "MAKE-TN-REF" "MAKE-UNWIND-BLOCK"
                "MAKE-WIRED-TN" "MAYBE-COMPILER-NOTIFY"

diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index ddf5ba7..b3863eb 100644 (file)
--- a/src/code/fop.lisp
+++ b/src/code/fop.lisp
@@ -145,7 +145,7 @@
   #+sb-xc-host ; since xc host doesn't know how to compile %PRIMITIVE
   (error "FOP-MISC-TRAP can't be defined without %PRIMITIVE.")
   #-sb-xc-host
-  (%primitive sb!c:make-other-immediate-type 0 sb!vm:unbound-marker-widetag))
+  (%primitive sb!c:make-unbound-marker))
 
 (define-cloned-fops (fop-character 68) (fop-short-character 69)
   (code-char (clone-arg)))

diff --git a/src/code/symbol.lisp b/src/code/symbol.lisp
index 7031776..7dcfe23 100644 (file)
--- a/src/code/symbol.lisp
+++ b/src/code/symbol.lisp
@@ -52,8 +52,7 @@ distinct from the global value. Can also be SETF."
 
 (declaim (inline %makunbound))
 (defun %makunbound (symbol)
-  (%set-symbol-value symbol (%primitive sb!c:make-other-immediate-type
-                                        0 sb!vm:unbound-marker-widetag)))
+  (%set-symbol-value symbol (%primitive sb!c:make-unbound-marker)))
 
 (defun makunbound (symbol)
   #!+sb-doc

diff --git a/src/compiler/alpha/alloc.lisp b/src/compiler/alpha/alloc.lisp
index 96621a3..c88ecce 100644 (file)
--- a/src/compiler/alpha/alloc.lisp
+++ b/src/compiler/alpha/alloc.lisp
@@ -154,7 +154,7 @@
 
 (define-vop (make-unbound-marker)
   (:args)
-  (:results (result :scs (any-reg)))
+  (:results (result :scs (descriptor-reg any-reg)))
   (:generator 1
     (inst li unbound-marker-widetag result)))
 

diff --git a/src/compiler/alpha/system.lisp b/src/compiler/alpha/system.lisp
index c051514..23e74b1 100644 (file)
--- a/src/compiler/alpha/system.lisp
+++ b/src/compiler/alpha/system.lisp
@@ -140,22 +140,6 @@
     (inst sll ptr 35 res)
     (inst srl res 33 res)))
 
-(define-vop (make-other-immediate-type)
-  (:args (val :scs (any-reg descriptor-reg))
-         (type :scs (any-reg descriptor-reg immediate)
-               :target temp))
-  (:results (res :scs (any-reg descriptor-reg)))
-  (:temporary (:scs (non-descriptor-reg)) temp)
-  (:generator 2
-    (sc-case type
-      ((immediate)
-       (inst sll val n-widetag-bits temp)
-       (inst bis temp (tn-value type) res))
-      (t
-       (inst sra type n-fixnum-tag-bits temp)
-       (inst sll val (- n-widetag-bits n-fixnum-tag-bits) res)
-       (inst bis res temp res)))))
-
 \f
 ;;;; allocation
 

diff --git a/src/compiler/hppa/alloc.lisp b/src/compiler/hppa/alloc.lisp
index c72e87d..18c5eae 100644 (file)
--- a/src/compiler/hppa/alloc.lisp
+++ b/src/compiler/hppa/alloc.lisp
@@ -184,7 +184,7 @@
 
 (define-vop (make-unbound-marker)
   (:args)
-  (:results (result :scs (any-reg)))
+  (:results (result :scs (descriptor-reg any-reg)))
   (:generator 1
     (inst li unbound-marker-widetag result)))
 

diff --git a/src/compiler/hppa/system.lisp b/src/compiler/hppa/system.lisp
index ad172c2..fd2dcff 100644 (file)
--- a/src/compiler/hppa/system.lisp
+++ b/src/compiler/hppa/system.lisp
@@ -130,23 +130,6 @@
   (:policy :fast-safe)
   (:generator 1
     (inst zdep ptr n-positive-fixnum-bits n-positive-fixnum-bits res)))
-
-(define-vop (make-other-immediate-type)
-  (:args (val :scs (any-reg descriptor-reg))
-         (type :scs (any-reg descriptor-reg immediate) :target temp))
-  (:results (res :scs (any-reg descriptor-reg)))
-  (:temporary (:scs (non-descriptor-reg)) temp)
-  (:temporary (:scs (non-descriptor-reg)) t2)
-  (:generator 2
-    (sc-case type
-      ((immediate)
-        (inst sll val n-widetag-bits temp)
-        (inst li (tn-value type) t2)
-        (inst or temp t2 res))
-      (t
-        (inst sra type 2 temp)
-        (inst sll val (- n-widetag-bits 2) res)
-        (inst or res temp res)))))
 \f
 ;;;; Allocation
 

diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index af5c7e4..36d4218 100644 (file)
--- a/src/compiler/ir2tran.lisp
+++ b/src/compiler/ir2tran.lisp
@@ -1542,8 +1542,7 @@
              (progn
                (labels ((,unbind (vars)
                           (declare (optimize (speed 2) (debug 0)))
-                          (let ((unbound-marker (%primitive make-other-immediate-type
-                                                            0 sb!vm:unbound-marker-widetag)))
+                          (let ((unbound-marker (%primitive make-unbound-marker)))
                             (dolist (var vars)
                               ;; CLHS says "bound and then made to have no value" -- user
                               ;; should not be able to tell the difference between that and this.

diff --git a/src/compiler/mips/alloc.lisp b/src/compiler/mips/alloc.lisp
index 88d5d74..0567e30 100644 (file)
--- a/src/compiler/mips/alloc.lisp
+++ b/src/compiler/mips/alloc.lisp
@@ -213,7 +213,7 @@
 
 (define-vop (make-unbound-marker)
   (:args)
-  (:results (result :scs (any-reg)))
+  (:results (result :scs (descriptor-reg any-reg)))
   (:generator 1
     (inst li result unbound-marker-widetag)))
 

diff --git a/src/compiler/mips/system.lisp b/src/compiler/mips/system.lisp
index dcf7aba..9cd4b39 100644 (file)
--- a/src/compiler/mips/system.lisp
+++ b/src/compiler/mips/system.lisp
@@ -141,22 +141,6 @@
     (inst sll res ptr 3)
     (inst srl res res 1)))
 
-(define-vop (make-other-immediate-type)
-  (:args (val :scs (any-reg descriptor-reg))
-         (type :scs (any-reg descriptor-reg immediate)
-               :target temp))
-  (:results (res :scs (any-reg descriptor-reg)))
-  (:temporary (:scs (non-descriptor-reg)) temp)
-  (:generator 2
-    (sc-case type
-      ((immediate)
-       (inst sll temp val n-widetag-bits)
-       (inst or res temp (tn-value type)))
-      (t
-       (inst sra temp type n-fixnum-tag-bits)
-       (inst sll res val (- n-widetag-bits n-fixnum-tag-bits))
-       (inst or res res temp)))))
-
 \f
 ;;;; Allocation
 

diff --git a/src/compiler/ppc/alloc.lisp b/src/compiler/ppc/alloc.lisp
index 58d9547..0656963 100644 (file)
--- a/src/compiler/ppc/alloc.lisp
+++ b/src/compiler/ppc/alloc.lisp
@@ -164,7 +164,7 @@
 
 (define-vop (make-unbound-marker)
   (:args)
-  (:results (result :scs (any-reg)))
+  (:results (result :scs (descriptor-reg any-reg)))
   (:generator 1
     (inst li result unbound-marker-widetag)))
 

diff --git a/src/compiler/ppc/system.lisp b/src/compiler/ppc/system.lisp
index 1482de1..7fd20d8 100644 (file)
--- a/src/compiler/ppc/system.lisp
+++ b/src/compiler/ppc/system.lisp
@@ -131,22 +131,6 @@
     ;; and shift the result into a positive fixnum like on x86.
     (inst rlwinm res ptr n-fixnum-tag-bits 1 n-positive-fixnum-bits)))
 
-(define-vop (make-other-immediate-type)
-  (:args (val :scs (any-reg descriptor-reg))
-         (type :scs (any-reg descriptor-reg immediate)
-               :target temp))
-  (:results (res :scs (any-reg descriptor-reg)))
-  (:temporary (:scs (non-descriptor-reg)) temp)
-  (:generator 2
-    (sc-case type
-      (immediate
-       (inst slwi temp val n-widetag-bits)
-       (inst ori res temp (tn-value type)))
-      (t
-       (inst srawi temp type n-fixnum-tag-bits)
-       (inst slwi res val (- n-widetag-bits n-fixnum-tag-bits))
-       (inst or res res temp)))))
-
 \f
 ;;;; Allocation
 

diff --git a/src/compiler/sparc/alloc.lisp b/src/compiler/sparc/alloc.lisp
index 2104313..8ba7aca 100644 (file)
--- a/src/compiler/sparc/alloc.lisp
+++ b/src/compiler/sparc/alloc.lisp
@@ -150,7 +150,7 @@
 
 (define-vop (make-unbound-marker)
   (:args)
-  (:results (result :scs (any-reg)))
+  (:results (result :scs (descriptor-reg any-reg)))
   (:generator 1
     (inst li result unbound-marker-widetag)))
 

diff --git a/src/compiler/sparc/system.lisp b/src/compiler/sparc/system.lisp
index 62d6f4c..9d55247 100644 (file)
--- a/src/compiler/sparc/system.lisp
+++ b/src/compiler/sparc/system.lisp
@@ -137,22 +137,6 @@
     (inst sll res ptr 3)
     (inst srl res res 1)))
 
-(define-vop (make-other-immediate-type)
-  (:args (val :scs (any-reg descriptor-reg))
-         (type :scs (any-reg descriptor-reg immediate)
-               :target temp))
-  (:results (res :scs (any-reg descriptor-reg)))
-  (:temporary (:scs (non-descriptor-reg)) temp)
-  (:generator 2
-    (sc-case type
-      (immediate
-       (inst sll temp val n-widetag-bits)
-       (inst or res temp (tn-value type)))
-      (t
-       (inst sra temp type n-fixnum-tag-bits)
-       (inst sll res val (- n-widetag-bits n-fixnum-tag-bits))
-       (inst or res res temp)))))
-
 \f
 ;;;; allocation
 

diff --git a/src/compiler/x86-64/alloc.lisp b/src/compiler/x86-64/alloc.lisp
index fbde8b6..c6b6b62 100644 (file)
--- a/src/compiler/x86-64/alloc.lisp
+++ b/src/compiler/x86-64/alloc.lisp
@@ -169,7 +169,7 @@
 
 (define-vop (make-unbound-marker)
   (:args)
-  (:results (result :scs (any-reg)))
+  (:results (result :scs (descriptor-reg any-reg)))
   (:generator 1
     (inst mov result unbound-marker-widetag)))
 

diff --git a/src/compiler/x86-64/system.lisp b/src/compiler/x86-64/system.lisp
index 9d7973c..083374f 100644 (file)
--- a/src/compiler/x86-64/system.lisp
+++ b/src/compiler/x86-64/system.lisp
@@ -136,17 +136,6 @@
     ;; fixnum.
     (inst and res (lognot lowtag-mask))
     (inst shr res 1)))
-
-(define-vop (make-other-immediate-type)
-  (:args (val :scs (any-reg descriptor-reg) :target res)
-         (type :scs (unsigned-reg immediate)))
-  (:results (res :scs (any-reg descriptor-reg) :from (:argument 0)))
-  (:generator 2
-    (move res val)
-    (inst shl res (- n-widetag-bits n-fixnum-tag-bits))
-    (inst or res (sc-case type
-                   (unsigned-reg type)
-                   (immediate (tn-value type))))))
 \f
 ;;;; allocation
 

diff --git a/src/compiler/x86/alloc.lisp b/src/compiler/x86/alloc.lisp
index 6e2561b..24a2278 100644 (file)
--- a/src/compiler/x86/alloc.lisp
+++ b/src/compiler/x86/alloc.lisp
@@ -198,7 +198,7 @@
 
 (define-vop (make-unbound-marker)
   (:args)
-  (:results (result :scs (any-reg)))
+  (:results (result :scs (descriptor-reg any-reg)))
   (:generator 1
     (inst mov result unbound-marker-widetag)))
 

diff --git a/src/compiler/x86/system.lisp b/src/compiler/x86/system.lisp
index 6ee2c63..ddde026 100644 (file)
--- a/src/compiler/x86/system.lisp
+++ b/src/compiler/x86/system.lisp
@@ -135,17 +135,6 @@
     ;; fixnum.
     (inst and res (lognot lowtag-mask))
     (inst shr res 1)))
-
-(define-vop (make-other-immediate-type)
-  (:args (val :scs (any-reg descriptor-reg) :target res)
-         (type :scs (unsigned-reg immediate)))
-  (:results (res :scs (any-reg descriptor-reg) :from (:argument 0)))
-  (:generator 2
-    (move res val)
-    (inst shl res (- n-widetag-bits n-fixnum-tag-bits))
-    (inst or res (sc-case type
-                   (unsigned-reg type)
-                   (immediate (tn-value type))))))
 \f
 ;;;; allocation
 

diff --git a/tests/defglobal.impure.lisp b/tests/defglobal.impure.lisp
index 5b5e634..ce1fd2e 100644 (file)
--- a/tests/defglobal.impure.lisp
+++ b/tests/defglobal.impure.lisp
@@ -18,7 +18,7 @@
     (eval form)))
 
 (defun unbound-marker ()
-  (sb-c::%primitive sb-c:make-other-immediate-type 0 sb-vm:unbound-marker-widetag))
+  (sb-c::%primitive sb-c:make-unbound-marker))
 
 (defun assert-foo-not-checked (fun)
   (let* ((marker (unbound-marker))