common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Use SC number constants rather than calling SC-NUMBER-OR-LOSE

Browse source
This commit is contained in:
Douglas Katzman 2017-11-17 11:42:51 -05:00
parent 94871002d2
commit 44c07c9f72
18 changed files with 106 additions and 116 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
src/compiler/alpha/vm.lisp
View file

@ -260,29 +260,29 @@
(defun immediate-constant-sc (value)
(typecase value
((integer 0 0)
(sc-number-or-lose 'zero))
zero-sc-number)
(null
(sc-number-or-lose 'null ))
null-sc-number)
((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
character)
(sc-number-or-lose 'immediate ))
immediate-sc-number)
(symbol
(if (static-symbol-p value)
(sc-number-or-lose 'immediate )
immediate-sc-number
nil))
(single-float
(if (eql value 0f0)
(sc-number-or-lose 'fp-single-zero )
fp-single-zero-sc-number
nil))
(double-float
(if (eql value 0d0)
(sc-number-or-lose 'fp-double-zero )
fp-double-zero-sc-number
nil))))
(defun boxed-immediate-sc-p (sc)
(or (eql sc (sc-number-or-lose 'zero))
(eql sc (sc-number-or-lose 'null))
(eql sc (sc-number-or-lose 'immediate))))
(or (eql sc zero-sc-number)
(eql sc null-sc-number)
(eql sc immediate-sc-number)))
;;; A predicate to see if a character can be used as an inline
;;; constant (the immediate field in the instruction used is eight
@ -295,8 +295,8 @@
;;;; function call parameters
;;; the SC numbers for register and stack arguments/return values
(defconstant immediate-arg-scn (sc-number-or-lose 'any-reg))
(defconstant control-stack-arg-scn (sc-number-or-lose 'control-stack))
(defconstant immediate-arg-scn any-reg-sc-number)
(defconstant control-stack-arg-scn control-stack-sc-number)
(eval-when (:compile-toplevel :load-toplevel :execute)

14
src/compiler/arm/vm.lisp
View file

@ -225,24 +225,24 @@
(defun immediate-constant-sc (value)
(typecase value
(null
(sc-number-or-lose 'null))
null-sc-number)
((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
character)
(sc-number-or-lose 'immediate))
immediate-sc-number)
(symbol
(if (static-symbol-p value)
(sc-number-or-lose 'immediate)
immediate-sc-number
nil))))
(defun boxed-immediate-sc-p (sc)
(or (eql sc (sc-number-or-lose 'null))
(eql sc (sc-number-or-lose 'immediate))))
(or (eql sc null-sc-number)
(eql sc immediate-sc-number)))
;;;; function call parameters
;;; the SC numbers for register and stack arguments/return values
(defconstant immediate-arg-scn (sc-number-or-lose 'any-reg))
(defconstant control-stack-arg-scn (sc-number-or-lose 'control-stack))
(defconstant immediate-arg-scn any-reg-sc-number)
(defconstant control-stack-arg-scn control-stack-sc-number)
;;; offsets of special stack frame locations
(defconstant ocfp-save-offset 0)

14
src/compiler/arm64/vm.lisp
View file

@ -246,24 +246,24 @@
(defun immediate-constant-sc (value)
(typecase value
(null
(sc-number-or-lose 'null))
null-sc-number)
((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
character)
(sc-number-or-lose 'immediate))
immediate-sc-number)
(symbol
(if (static-symbol-p value)
(sc-number-or-lose 'immediate)
immediate-sc-number
nil))))
(defun boxed-immediate-sc-p (sc)
(or (eql sc (sc-number-or-lose 'null))
(eql sc (sc-number-or-lose 'immediate))))
(or (eql sc null-sc-number)
(eql sc immediate-sc-number)))
;;;; function call parameters
;;; the SC numbers for register and stack arguments/return values
(defconstant immediate-arg-scn (sc-number-or-lose 'any-reg))
(defconstant control-stack-arg-scn (sc-number-or-lose 'control-stack))
(defconstant immediate-arg-scn any-reg-sc-number)
(defconstant control-stack-arg-scn control-stack-sc-number)
;;; offsets of special stack frame locations
(defconstant ocfp-save-offset 0)

5
src/compiler/debug-dump.lisp
View file

@ -134,9 +134,8 @@
(defun decode-restart-location (x)
(declare (fixnum x))
(let ((registers-size #.(integer-length (sb-size (sb-or-lose 'sb!vm::registers)))))
(values (make-sc-offset
(sc-number-or-lose 'sb!vm::descriptor-reg)
(ldb (byte registers-size 0) x))
(values (make-sc-offset sb!vm:descriptor-reg-sc-number
(ldb (byte registers-size 0) x))
(ash x (- registers-size)))))
;;; Dump a compiled debug-location into *BYTE-BUFFER* that describes

6
src/compiler/generic/vm-ir2tran.lisp
View file

@ -134,8 +134,7 @@
(or unbound-marker-tn
(setf unbound-marker-tn
(let ((tn (make-restricted-tn
nil
(sc-number-or-lose 'sb!vm::any-reg))))
nil sb!vm:any-reg-sc-number)))
(vop make-unbound-marker node block tn)
tn))))
(:null
@ -144,8 +143,7 @@
(or funcallable-instance-tramp-tn
(setf funcallable-instance-tramp-tn
(let ((tn (make-restricted-tn
nil
(sc-number-or-lose 'sb!vm::any-reg))))
nil sb!vm:any-reg-sc-number)))
(vop make-funcallable-instance-tramp node block tn)
tn)))))
name dx-p slot lowtag))))))))

2
src/compiler/generic/vm-macs.lisp
View file

@ -181,7 +181,7 @@
(constant-name (symbolicate sc-name "-SC-NUMBER")))
`((define-storage-class ,sc-name ,sc-number
,sb-name ,@args)
(def!constant ,constant-name ,sc-number))))))
(defconstant ,constant-name ,sc-number))))))
`(progn ,@(mapcan #'process-class classes)))))
;;;; stuff for defining reffers and setters

4
src/compiler/hppa/float.lisp
View file

@ -378,7 +378,7 @@
(inst ldw offset nfp y)
(inst ldw (+ offset n-word-bytes) nfp
(make-wired-tn (primitive-type-or-lose 'unsigned-byte-32)
(sc-number-or-lose 'unsigned-reg)
unsigned-reg-sc-number
(+ 1 (tn-offset y))))
(inst stw old1 offset nfp)
(inst stw old2 (+ offset n-word-bytes) nfp)))
@ -388,7 +388,7 @@
(inst ldw (- (* (1+ double-float-value-slot) n-word-bytes)
other-pointer-lowtag) x
(make-wired-tn (primitive-type-or-lose 'unsigned-byte-32)
(sc-number-or-lose 'unsigned-reg)
unsigned-reg-sc-number
(+ 1 (tn-offset y))))))))
(define-move-vop move-to-double-int-reg
:move (double-reg descriptor-reg) (double-int-carg-reg))

22
src/compiler/hppa/vm.lisp
View file

@ -290,37 +290,37 @@
(defun immediate-constant-sc (value)
(typecase value
((integer 0 0)
(sc-number-or-lose 'zero))
zero-sc-number)
(null
(sc-number-or-lose 'null))
null-sc-number)
((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
#-sb-xc-host system-area-pointer ; no object can be a SAP in the host
character)
(sc-number-or-lose 'immediate))
immediate-sc-number)
(symbol
(if (static-symbol-p value)
(sc-number-or-lose 'immediate)
immediate-sc-number
nil))
(single-float
(if (eql value 0f0)
(sc-number-or-lose 'fp-single-zero)
fp-single-zero-sc-number
nil))
(double-float
(if (eql value 0d0)
(sc-number-or-lose 'fp-double-zero)
fp-double-zero-sc-number
nil))))
(defun boxed-immediate-sc-p (sc)
(or (eql sc (sc-number-or-lose 'zero))
(eql sc (sc-number-or-lose 'null))
(eql sc (sc-number-or-lose 'immediate))))
(or (eql sc zero-sc-number)
(eql sc null-sc-number)
(eql sc immediate-sc-number)))
;;;; Function Call Parameters
;;; The SC numbers for register and stack arguments/return values.
;;;
(defconstant immediate-arg-scn (sc-number-or-lose 'any-reg))
(defconstant control-stack-arg-scn (sc-number-or-lose 'control-stack))
(defconstant immediate-arg-scn any-reg-sc-number)
(defconstant control-stack-arg-scn control-stack-sc-number)
(eval-when (:compile-toplevel :load-toplevel :execute)

11
src/compiler/ir2tran.lisp
View file

@ -1358,9 +1358,9 @@
(let ((closure (make-normal-tn *backend-t-primitive-type*)))
(when (policy fun (> store-closure-debug-pointer 1))
;; Save the closure pointer on the stack.
(let ((closure-save (make-representation-tn
*backend-t-primitive-type*
(sc-number-or-lose 'sb!vm::control-stack))))
(let ((closure-save
(make-representation-tn *backend-t-primitive-type*
sb!vm:control-stack-sc-number)))
(vop setup-closure-environment node block start-label
closure-save)
(setf (ir2-physenv-closure-save-tn env) closure-save)
@ -1412,9 +1412,8 @@
;; It could be saved from the XEP, but some functions have both
;; external and internal entry points, so it will be saved twice.
(let ((temp (make-normal-tn *backend-t-primitive-type*))
(bsp-save-tn (make-representation-tn
*backend-t-primitive-type*
(sc-number-or-lose 'sb!vm::control-stack))))
(bsp-save-tn (make-representation-tn *backend-t-primitive-type*
sb!vm:control-stack-sc-number)))
(vop current-binding-pointer node block temp)
(emit-move node block temp bsp-save-tn)
(setf (ir2-physenv-bsp-save-tn env) bsp-save-tn)

22
src/compiler/mips/vm.lisp
View file

@ -279,33 +279,33 @@
(defun immediate-constant-sc (value)
(typecase value
((integer 0 0)
(sc-number-or-lose 'zero))
zero-sc-number)
(null
(sc-number-or-lose 'null))
null-sc-number)
(symbol
(if (static-symbol-p value)
(sc-number-or-lose 'immediate)
immediate-sc-number
nil))
((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
character)
(sc-number-or-lose 'immediate))
immediate-sc-number)
#-sb-xc-host ; There is no such object type in the host
(system-area-pointer
(sc-number-or-lose 'immediate))
immediate-sc-number)
(character
(sc-number-or-lose 'immediate))))
immediate-sc-number)))
(defun boxed-immediate-sc-p (sc)
(or (eql sc (sc-number-or-lose 'zero))
(eql sc (sc-number-or-lose 'null))
(eql sc (sc-number-or-lose 'immediate))))
(or (eql sc zero-sc-number)
(eql sc null-sc-number)
(eql sc immediate-sc-number)))
;;;; Function Call Parameters
;;; The SC numbers for register and stack arguments/return values.
;;;
(defconstant immediate-arg-scn (sc-number-or-lose 'any-reg))
(defconstant control-stack-arg-scn (sc-number-or-lose 'control-stack))
(defconstant immediate-arg-scn any-reg-sc-number)
(defconstant control-stack-arg-scn control-stack-sc-number)
(eval-when (:compile-toplevel :load-toplevel :execute)

18
src/compiler/ppc/vm.lisp
View file

@ -255,21 +255,21 @@
(defun immediate-constant-sc (value)
(typecase value
((integer 0 0)
(sc-number-or-lose 'zero))
zero-sc-number)
(null
(sc-number-or-lose 'null))
null-sc-number)
((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
character)
(sc-number-or-lose 'immediate))
immediate-sc-number)
(symbol
(if (static-symbol-p value)
(sc-number-or-lose 'immediate)
immediate-sc-number
nil))))
(defun boxed-immediate-sc-p (sc)
(or (eql sc (sc-number-or-lose 'zero))
(eql sc (sc-number-or-lose 'null))
(eql sc (sc-number-or-lose 'immediate))))
(or (eql sc zero-sc-number)
(eql sc null-sc-number)
(eql sc immediate-sc-number)))
;;; A predicate to see if a character can be used as an inline
;;; constant (the immediate field in the instruction used is sixteen
@ -282,8 +282,8 @@
;;;; function call parameters
;;; the SC numbers for register and stack arguments/return values
(defconstant immediate-arg-scn (sc-number-or-lose 'any-reg))
(defconstant control-stack-arg-scn (sc-number-or-lose 'control-stack))
(defconstant immediate-arg-scn any-reg-sc-number)
(defconstant control-stack-arg-scn control-stack-sc-number)
(eval-when (:compile-toplevel :load-toplevel :execute)

2
src/compiler/represent.lisp
View file

@ -646,7 +646,7 @@
(ir2-component-constants 2comp))))))
(possible-scs (tn)
(if (eq (tn-kind tn) :constant)
(list (sc-number-or-lose 'constant)
(list sb!vm:constant-sc-number
(immediate-constant-sc (constant-value (tn-leaf tn))))
(primitive-type-scs (tn-primitive-type tn))))
(pass (tn &key unique)

18
src/compiler/sparc/vm.lisp
View file

@ -284,27 +284,27 @@
(defun immediate-constant-sc (value)
(typecase value
((integer 0 0)
(sc-number-or-lose 'zero))
zero-sc-number)
(null
(sc-number-or-lose 'null))
null-sc-number)
((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
character)
(sc-number-or-lose 'immediate))
immediate-sc-number)
(symbol
(if (static-symbol-p value)
(sc-number-or-lose 'immediate)
immediate-sc-number
nil))))
(defun boxed-immediate-sc-p (sc)
(or (eql sc (sc-number-or-lose 'zero))
(eql sc (sc-number-or-lose 'null))
(eql sc (sc-number-or-lose 'immediate))))
(or (eql sc zero-sc-number)
(eql sc null-sc-number)
(eql sc immediate-sc-number)))
;;;; function call parameters
;;; the SC numbers for register and stack arguments/return values.
(defconstant immediate-arg-scn (sc-number-or-lose 'any-reg))
(defconstant control-stack-arg-scn (sc-number-or-lose 'control-stack))
(defconstant immediate-arg-scn any-reg-sc-number)
(defconstant control-stack-arg-scn control-stack-sc-number)
(eval-when (:compile-toplevel :load-toplevel :execute)

7
src/compiler/tn.lisp
View file

@ -239,7 +239,7 @@
(defun make-load-time-value-tn (handle type)
(let* ((component (component-info *component-being-compiled*))
(sc (svref *backend-sc-numbers*
(sc-number-or-lose 'constant)))
sb!vm:constant-sc-number))
(res (make-tn 0 :constant (primitive-type type) sc))
(constants (ir2-component-constants component)))
(setf (tn-offset res) (fill-pointer constants))
@ -267,8 +267,7 @@
(res (make-tn 0
:constant
*backend-t-primitive-type*
(svref *backend-sc-numbers*
(sc-number-or-lose 'constant))))
(svref *backend-sc-numbers* sb!vm:constant-sc-number)))
(constants (ir2-component-constants component)))
(do ((i 0 (1+ i)))
@ -476,7 +475,7 @@
(and leaf
(eq (tn-kind tn) :constant)
(eq (immediate-constant-sc (constant-value leaf))
(sc-number-or-lose 'sb!vm::immediate)))))
'sb!vm:immediate-sc-number))))
;;; Force TN to be allocated in a SC that doesn't need to be saved: an
;;; unbounded non-save-p SC. We don't actually make it a real "restricted" TN,

3
src/compiler/x86-64/macros.lisp
View file

@ -303,8 +303,7 @@
(mapcar (lambda (tn)
(cond ((and (tn-p tn) (sc-is tn immediate))
(aver (typep (tn-value tn) '(or symbol layout)))
(make-sc-offset (sc-number-or-lose 'constant)
(tn-offset tn)))
(make-sc-offset constant-sc-number (tn-offset tn)))
(t
tn)))
values))))))

34
src/compiler/x86-64/vm.lisp
View file

@ -463,7 +463,7 @@
(typecase value
((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
character)
(sc-number-or-lose 'immediate))
immediate-sc-number)
(symbol ; Symbols in static and immobile space are immediate
(when (or ;; With #!+immobile-symbols, all symbols are in immobile-space.
;; And the cross-compiler always uses immobile-space if enabled.
@ -483,35 +483,31 @@
(immobile-space-obj-p value)))
(static-symbol-p value))
(sc-number-or-lose 'immediate)))
immediate-sc-number))
#!+immobile-space
(layout
(sc-number-or-lose 'immediate))
immediate-sc-number)
(single-float
(sc-number-or-lose
(if (eql value 0f0) 'fp-single-zero 'fp-single-immediate)))
(if (eql value 0f0) fp-single-zero-sc-number fp-single-immediate-sc-number))
(double-float
(sc-number-or-lose
(if (eql value 0d0) 'fp-double-zero 'fp-double-immediate)))
(if (eql value 0d0) fp-double-zero-sc-number fp-double-immediate-sc-number))
((complex single-float)
(sc-number-or-lose
(if (eql value #c(0f0 0f0))
'fp-complex-single-zero
'fp-complex-single-immediate)))
(if (eql value #c(0f0 0f0))
fp-complex-single-zero-sc-number
fp-complex-single-immediate-sc-number))
((complex double-float)
(sc-number-or-lose
(if (eql value #c(0d0 0d0))
'fp-complex-double-zero
'fp-complex-double-immediate)))
(if (eql value #c(0d0 0d0))
fp-complex-double-zero-sc-number
fp-complex-double-immediate-sc-number))
#!+(and sb-simd-pack (not (host-feature sb-xc-host)))
((simd-pack double-float) (sc-number-or-lose 'double-sse-immediate))
((simd-pack double-float) double-sse-immediate-sc-number)
#!+(and sb-simd-pack (not (host-feature sb-xc-host)))
((simd-pack single-float) (sc-number-or-lose 'single-sse-immediate))
((simd-pack single-float) single-sse-immediate-sc-number)
#!+(and sb-simd-pack (not (host-feature sb-xc-host)))
(simd-pack (sc-number-or-lose 'int-sse-immediate))))
(simd-pack int-sse-immediate-sc-number)))
(defun boxed-immediate-sc-p (sc)
(eql sc (sc-number-or-lose 'immediate)))
(eql sc immediate-sc-number))
(defun encode-value-if-immediate (tn &optional (tag t))
(if (sc-is tn immediate)

16
src/compiler/x86/vm.lisp
View file

@ -346,18 +346,18 @@
(typecase value
((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
character)
(sc-number-or-lose 'immediate))
immediate-sc-number)
(symbol
(when (static-symbol-p value)
(sc-number-or-lose 'immediate)))
immediate-sc-number))
(single-float
(case value
((0f0 1f0) (sc-number-or-lose 'fp-constant))
(t (sc-number-or-lose 'fp-single-immediate))))
((0f0 1f0) fp-constant-sc-number)
(t fp-single-immediate-sc-number)))
(double-float
(case value
((0d0 1d0) (sc-number-or-lose 'fp-constant))
(t (sc-number-or-lose 'fp-double-immediate))))
((0d0 1d0) fp-constant-sc-number)
(t fp-double-immediate-sc-number)))
#!+long-float
(long-float
(when (or (eql value 0l0) (eql value 1l0)
@ -366,10 +366,10 @@
(eql value (log 2.718281828459045235360287471352662L0 2l0))
(eql value (log 2l0 10l0))
(eql value (log 2l0 2.718281828459045235360287471352662L0)))
(sc-number-or-lose 'fp-constant)))))
fp-constant-sc-number))))
(defun boxed-immediate-sc-p (sc)
(eql sc (sc-number-or-lose 'immediate)))
(eql sc immediate-sc-number))
;; For an immediate TN, return its value encoded for use as a literal.
;; For any other TN, return the TN. Only works for FIXNUMs,

2
tests/vm.before-xc.lisp
View file

@ -18,7 +18,7 @@
(flet ((yes (x)
(assert
(eql (sc-number-or-lose 'immediate)
(eql immediate-sc-number
(immediate-constant-sc x))))
(no (x)
(assert