From fb35df18abde8fc88c521cf7a811f41914a82890 Mon Sep 17 00:00:00 2001 From: Alastair Bridgewater Date: Tue, 23 Oct 2012 13:47:27 -0400 Subject: [PATCH] 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. --- package-data-list.lisp-expr | 2 +- src/code/fop.lisp | 2 +- src/code/symbol.lisp | 3 +-- src/compiler/alpha/alloc.lisp | 2 +- src/compiler/alpha/system.lisp | 16 ---------------- src/compiler/hppa/alloc.lisp | 2 +- src/compiler/hppa/system.lisp | 17 ----------------- src/compiler/ir2tran.lisp | 3 +-- src/compiler/mips/alloc.lisp | 2 +- src/compiler/mips/system.lisp | 16 ---------------- src/compiler/ppc/alloc.lisp | 2 +- src/compiler/ppc/system.lisp | 16 ---------------- src/compiler/sparc/alloc.lisp | 2 +- src/compiler/sparc/system.lisp | 16 ---------------- src/compiler/x86-64/alloc.lisp | 2 +- src/compiler/x86-64/system.lisp | 11 ----------- src/compiler/x86/alloc.lisp | 2 +- src/compiler/x86/system.lisp | 11 ----------- tests/defglobal.impure.lisp | 2 +- 19 files changed, 12 insertions(+), 117 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index ac8e63a..1a6ebf6 100644 --- 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 --- 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 --- 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 --- 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 --- 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))))) - ;;;; allocation diff --git a/src/compiler/hppa/alloc.lisp b/src/compiler/hppa/alloc.lisp index c72e87d..18c5eae 100644 --- 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 --- 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))))) ;;;; Allocation diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index af5c7e4..36d4218 100644 --- 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 --- 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 --- 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))))) - ;;;; Allocation diff --git a/src/compiler/ppc/alloc.lisp b/src/compiler/ppc/alloc.lisp index 58d9547..0656963 100644 --- 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 --- 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))))) - ;;;; Allocation diff --git a/src/compiler/sparc/alloc.lisp b/src/compiler/sparc/alloc.lisp index 2104313..8ba7aca 100644 --- 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 --- 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))))) - ;;;; allocation diff --git a/src/compiler/x86-64/alloc.lisp b/src/compiler/x86-64/alloc.lisp index fbde8b6..c6b6b62 100644 --- 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 --- 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)))))) ;;;; allocation diff --git a/src/compiler/x86/alloc.lisp b/src/compiler/x86/alloc.lisp index 6e2561b..24a2278 100644 --- 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 --- 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)))))) ;;;; allocation diff --git a/tests/defglobal.impure.lisp b/tests/defglobal.impure.lisp index 5b5e634..ce1fd2e 100644 --- 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)) -- 1.7.10.4