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

Export some SB-C symbols

Browse source
This commit is contained in:
Douglas Katzman 2021-10-06 11:29:50 -04:00
parent 75a8be28cb
commit 35213d0024
43 changed files with 111 additions and 106 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
contrib/sb-posix/strtod.lisp
View file

@ -28,7 +28,7 @@ and a secondary value, the number of characters consumed."
(when (typep string 'base-string)
(sb-kernel:with-array-data ((data string) (start) (end) :check-fill-pointer t)
(when (eql (locally
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(schar data (1+ end))) #\Nul)
(return-from strtod (strtod/base-string data start)))))
;; Short simple non-base string, or base-string w/o a null in the right place

2
src/code/array.lisp
View file

@ -1395,7 +1395,7 @@ of specialized arrays is supported."
;; appear to be an out-of-bounds access if the length is not
;; changing at all. i.e. while it's safe to always do a store,
;; the length check has to be skipped.
(locally (declare (optimize (sb-c::insert-array-bounds-checks 0)))
(locally (declare (optimize (sb-c:insert-array-bounds-checks 0)))
(setf (schar vector new-length) (code-char 0)))
;; Now treat both the old and new lengths as if they include
;; the byte that holds the implicit string terminator.

2
src/code/load.lisp
View file

@ -312,7 +312,7 @@
`(macrolet ((fop-stack-ref (i)
`(locally
#-sb-xc-host
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(svref ,',stack-var (truly-the index ,i)))))
(let* (,@(when stack-expr
(list `(,stack-var (the simple-vector ,stack-expr))))

2
src/code/octets.lisp
View file

@ -256,7 +256,7 @@
do (let ((byte (funcall get-bytes string pos)))
(typecase byte
((unsigned-byte 8)
(locally (declare (optimize (sb-c::insert-array-bounds-checks 0)))
(locally (declare (optimize (sb-c:insert-array-bounds-checks 0)))
(setf (aref octets index) byte)))
((simple-array (unsigned-byte 8) (*))
;; KLUDGE: We ran into encoding errors. Bail and do

2
src/code/pred.lisp
View file

@ -414,7 +414,7 @@ length and have identical components. Other arrays must be EQ to be EQUAL."
(flet
((data-vector-compare (x y start-x end-x start-y)
(declare (index start-x end-x start-y)
(optimize (sb-c::insert-array-bounds-checks 0)))
(optimize (sb-c:insert-array-bounds-checks 0)))
(let ((xtag (%other-pointer-widetag (truly-the (simple-array * 1) x)))
(ytag (%other-pointer-widetag (truly-the (simple-array * 1) y))))
(case (if (= xtag ytag) xtag 0)

2
src/code/print.lisp
View file

@ -1123,7 +1123,7 @@ variable: an unreadable object representing the error is printed instead.")
;; "The function SB-KERNEL:SIMPLE-CHARACTER-STRING-P is undefined."
;; but a symbol-macrolet is ok. This is a FIXME except I don't care.
(symbol-macrolet ((chars "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
(declare (optimize (sb-c::insert-array-bounds-checks 0) speed))
(declare (optimize (sb-c:insert-array-bounds-checks 0) speed))
(macrolet ((iterative-algorithm ()
`(loop (multiple-value-bind (q r)
(truncate (truly-the word integer) base)

12
src/code/reader.lisp
View file

@ -580,7 +580,7 @@ standard Lisp readtable when NIL."
(defun ouch-read-buffer (char buffer)
;; When buffer overflow
(let ((op (token-buf-fill-ptr buffer)))
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(when (>= op (length (token-buf-string buffer)))
;; an out-of-line call for the uncommon case avoids bloat.
;; Size should be doubled.
@ -603,7 +603,7 @@ standard Lisp readtable when NIL."
;; Retun the next character from the buffered token, or NIL.
(declaim (maybe-inline token-buf-getchar))
(defun token-buf-getchar (b)
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(let ((i (token-buf-cursor (truly-the token-buf b))))
(and (< i (token-buf-fill-ptr b))
(prog1 (elt (token-buf-string b) i)
@ -929,7 +929,7 @@ standard Lisp readtable when NIL."
(declare (character closech))
(macrolet ((scan (read-a-char eofp &optional finish)
`(loop (let ((char ,read-a-char))
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(cond (,eofp (error 'end-of-file :stream stream))
((eql char closech)
(return ,finish))
@ -1151,7 +1151,7 @@ standard Lisp readtable when NIL."
((and (zerop (length escapes)) (eq case :upcase))
(let ((buffer (token-buf-string token-buf)))
(dotimes (i (token-buf-fill-ptr token-buf))
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(setf (schar buffer i) (char-upcase (schar buffer i))))))
((eq case :preserve))
(t
@ -1162,7 +1162,7 @@ standard Lisp readtable when NIL."
-1 (vector-pop escapes))))
((minusp i))
(declare (fixnum i)
(optimize (sb-c::insert-array-bounds-checks 0)))
(optimize (sb-c:insert-array-bounds-checks 0)))
(if (< esc i)
(let ((ch (schar buffer i)))
,@body)
@ -1642,7 +1642,7 @@ extended <package-name>::<form-in-package> syntax."
(defmacro !setq-optional-leading-sign (sign-flag token-buf rewind)
;; guaranteed to have at least one character in buffer at the start
;; or immediately following [ESFDL] marker depending on 'rewind' flag.
`(locally (declare (optimize (sb-c::insert-array-bounds-checks 0)))
`(locally (declare (optimize (sb-c:insert-array-bounds-checks 0)))
(,(if rewind 'setf 'incf)
(token-buf-cursor ,token-buf)
(case (elt (token-buf-string ,token-buf)

4
src/code/seq.lisp
View file

@ -368,7 +368,7 @@
(car list)))
(declare (type index count)))
(locally
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(when (>= index (length sequence))
(signal-index-too-large-error sequence index))
(aref sequence index))
@ -1092,7 +1092,7 @@ many elements are copied."
(macrolet ((def (name element-type &rest dispatch)
`(defun ,name (&rest sequences)
(declare (explicit-check)
(optimize (sb-c::insert-array-bounds-checks 0)))
(optimize (sb-c:insert-array-bounds-checks 0)))
(let ((length 0))
(declare (index length))
(do-rest-arg ((seq) sequences)

2
src/code/sharpm.lisp
View file

@ -68,7 +68,7 @@
:element-type 'bit :initial-element fill)))
(do ((i 0 (1+ i)))
((= i input-len) bvec)
(declare (index i) (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (index i) (optimize (sb-c:insert-array-bounds-checks 0)))
(let ((char (char bstring i)))
(setf (elt bvec i)
(case char

14
src/code/stream.lisp
View file

@ -357,7 +357,7 @@
(eof)
(index 0))
(declare (type (simple-array character (*)) buffer))
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(declare (index index))
(setf (schar res index) (truly-the character ch))
(incf index)
@ -1342,11 +1342,11 @@
(char string index))))))
(flet ((base-char-in (stream eof-error-p eof-value)
(declare (optimize (sb-c::verify-arg-count 0)
(sb-c::insert-array-bounds-checks 0)))
(sb-c:insert-array-bounds-checks 0)))
(char-in base-char))
(character-in (stream eof-error-p eof-value)
(declare (optimize (sb-c::verify-arg-count 0)
(sb-c::insert-array-bounds-checks 0)))
(sb-c:insert-array-bounds-checks 0)))
(char-in character)))
(let ((input-routine
(etypecase string
@ -1400,7 +1400,7 @@
(buffer (truly-the (simple-array ,elt-type (*))
(string-output-stream-buffer stream)))
(index (string-output-stream-index stream)))
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(when (= pointer (length buffer))
;; The usual doubling technique: the new buffer shall hold as many
;; characters as were already emplaced.
@ -1444,7 +1444,7 @@
;; BASE-STRING, we needn't check anything.
;; Bounds check was already performed
`(let ((s (truly-the simple-character-string src)))
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(loop for i from start2 below end2
thereis (>= (char-code (aref s i)) base-char-code-limit)))))
;; The "wonderful" thing is you never know where type checks have already been done.
@ -1801,7 +1801,7 @@ benefit of the function GET-OUTPUT-STREAM-STRING."
result))
(defun finite-base-string-ouch (stream character)
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(let ((pointer (finite-base-string-output-stream-pointer stream))
(buffer (finite-base-string-output-stream-buffer stream)))
(cond ((= pointer (length buffer))
@ -1812,7 +1812,7 @@ benefit of the function GET-OUTPUT-STREAM-STRING."
(truly-the index (1+ pointer)))))))
(defun finite-base-string-sout (stream string start end)
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(let* ((pointer (finite-base-string-output-stream-pointer stream))
(buffer (finite-base-string-output-stream-buffer stream))
(length (- end start))

6
src/code/string.lisp
View file

@ -143,7 +143,7 @@
`(return-from string=*
(let ((string1 (truly-the (simple-array ,type1 1) string1))
(string2 (truly-the (simple-array ,type2 1) string2)))
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(do ((index1 start1 (1+ index1))
(index2 start2 (1+ index2)))
((>= index1 end1) t)
@ -491,7 +491,7 @@ new string COUNT long filled with the fill character."
(do ((index start (1+ index))
(cases +character-cases+))
((>= index end))
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(let ((char (schar string index)))
(with-case-info (char case-index cases
:cases cases)
@ -521,7 +521,7 @@ new string COUNT long filled with the fill character."
(do ((index start (1+ index))
(cases +character-cases+))
((>= index end))
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(let ((char (schar (truly-the (or simple-base-string
simple-character-string)
string)

2
src/code/target-char.lisp
View file

@ -559,7 +559,7 @@ argument is an alphabetic character, A-Z or a-z; otherwise NIL."
(page-var (gensym "PAGE")))
`(block nil
(locally
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(let ((,code-var (char-code ,char)))
(let* ((,shifted-var (ash ,code-var -6))
(,page-var (if (>= ,shifted-var (length +character-case-pages+))

2
src/code/target-extensions.lisp
View file

@ -153,7 +153,7 @@ these hooks.")
(type (integer 0 ,(1- array-dimension-limit)) ,pointer)
(type (simple-array ,element-type (*)) ,string))
(flet ((push-char (char)
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(when (= ,pointer ,size)
(let ((old ,string))
(setf ,size (* 2 (+ ,size 2))

4
src/code/target-hash-table.lisp
View file

@ -825,7 +825,7 @@ multiple threads accessing the same hash-table without locking."
(mask (1- (length index-vector)))
(hwm (kv-vector-high-water-mark kv-vector))
(result 0))
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(cond
(hash-vector
(do ((i hwm (1- i))) ((zerop i))
@ -1434,7 +1434,7 @@ nnnn 1_ any linear scan
;;; key and hash-table-test whenever some thread is rehashing. If hash-based
;;; lookup uses EQ as the comparator for KEY, then linear search does too.
(defun hash-table-lsearch (hash-table eq-test key hash default)
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(declare (type (and fixnum unsigned-byte) hash))
(atomic-incf (hash-table-n-lsearch hash-table))
(let* ((kv-vector (hash-table-pairs hash-table))

4
src/code/target-package.lisp
View file

@ -157,7 +157,7 @@
;; index. The returned value is a physical index.
(named-let recurse ((start 0) (end (ash (length v) -1)))
(declare (type (unsigned-byte 9) start end)
(optimize (sb-c::insert-array-bounds-checks 0)))
(optimize (sb-c:insert-array-bounds-checks 0)))
(when (< start end)
(let* ((i (ash (+ start end) -1))
(elt (keyfn (aref v (ash i 1)))))
@ -1982,7 +1982,7 @@ PACKAGE."
(logand start-state 3))))))
(when (zerop index)
(return (advance start-state))))))
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(if (logtest start-state +package-iter-check-shadows+)
(let ((shadows (package-%shadowing-symbols (this-package))))
(scan (not (member sym shadows :test #'string=))))

2
src/code/target-sxhash.lisp
View file

@ -380,7 +380,7 @@
(declare (optimize speed))
(labels
((data-vector-hash (data start end depthoid)
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(let ((result 572539))
(declare (type hash-code result))
(when (plusp depthoid)

5
src/cold/package-data-list.lisp-expr
View file

@ -320,10 +320,12 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
"GET-TOPLEVELISH-FILE-INFO"
"HALT"
"IF-EQ"
"CONSTANT-LVAR-P"
"CONSTANT-TN-P"
"INSERT-SAFEPOINTS"
"COMPILER-MACRO-APPLICATION-MISSED-WARNING"
"INLINING-DEPENDENCY-FAILURE"
"INSERT-ARRAY-BOUNDS-CHECKS"
"INSERT-STEP-CONDITIONS"
"IR2-COMPONENT-CONSTANTS" "IR2-CONVERT"
"IR2-PHYSENV-NUMBER-STACK-P"
@ -331,6 +333,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
"LAMBDA-VAR-IGNOREP"
"LAMBDA-WITH-LEXENV" "LEXENV-FIND"
"LOCATION=" "LTN-ANNOTATE"
"LVAR-VALUE"
"MACRO-POLICY-DECLS"
"MAKE-ALIAS-TN" "MAKE-CATCH-BLOCK"
"MAKE-CLOSURE" "MAKE-CONSTANT-TN"
@ -365,6 +368,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
"READ-VAR-INTEGER" "READ-VAR-INTEGERF"
"SAP-READ-VAR-INTEGER" "SAP-READ-VAR-INTEGERF"
"READ-VAR-STRING"
"REFERENCE-TN" "REFERENCE-TN-LIST"
"REGISTER-INLINE-CONSTANT"
"RESET-STACK-POINTER" "RESTORE-DYNAMIC-STATE"
"RETURN-MULTIPLE" "SAVE-DYNAMIC-STATE" "STORAGE-BASE"
@ -2959,6 +2963,7 @@ no guarantees of interface stability."
structure representations"
:use ("CL" "SB-ALIEN" "SB-ALIEN-INTERNALS" "SB-ASSEM" "SB-C"
"SB-EXT" "SB-FASL" "SB-INT" "SB-KERNEL" "SB-SYS" "SB-UNIX")
:import-from (("SB-C" "VOP-ARGS" "VOP-RESULTS"))
:reexport ("WORD")
:export ("*PRIMITIVE-OBJECTS*"
"+HIGHEST-NORMAL-GENERATION+"

4
src/compiler/arm/c-call.lisp
View file

@ -270,8 +270,8 @@
;;; long-long support
(deftransform %alien-funcall ((function type &rest args) * * :node node)
(aver (sb-c::constant-lvar-p type))
(let* ((type (sb-c::lvar-value type))
(aver (sb-c:constant-lvar-p type))
(let* ((type (sb-c:lvar-value type))
(env (sb-c::node-lexenv node))
(arg-types (alien-fun-type-arg-types type))
(result-type (alien-fun-type-result-type type)))

4
src/compiler/arm64/c-call.lisp
View file

@ -222,8 +222,8 @@
;;; long-long support
;; (deftransform %alien-funcall ((function type &rest args) * * :node node)
;; (aver (sb-c::constant-lvar-p type))
;; (let* ((type (sb-c::lvar-value type))
;; (aver (sb-c:constant-lvar-p type))
;; (let* ((type (sb-c:lvar-value type))
;; (env (sb-c::node-lexenv node))
;; (arg-types (alien-fun-type-arg-types type))
;; (result-type (alien-fun-type-result-type type)))

12
src/compiler/arm64/move.lisp
View file

@ -220,11 +220,11 @@
(and (tn-p tn)
(sc-is tn control-stack)))
(source (vop)
(tn-ref-tn (sb-c::vop-args vop)))
(tn-ref-tn (vop-args vop)))
(dest (vop)
(tn-ref-tn (sb-c::vop-results vop)))
(tn-ref-tn (vop-results vop)))
(load-tn (vop)
(tn-ref-load-tn (sb-c::vop-args vop)))
(tn-ref-load-tn (vop-args vop)))
(suitable-offsets-p (tn1 tn2)
(and (= (abs (- (tn-offset tn1)
(tn-offset tn2)))
@ -332,8 +332,8 @@
'(load-stack store-stack)))
(do-moves (source vop1) (source vop2) (dest vop1) (dest vop2)))))
(move-arg
(let ((fp1 (tn-ref-tn (tn-ref-across (sb-c::vop-args vop1))))
(fp2 (tn-ref-tn (tn-ref-across (sb-c::vop-args vop2))))
(let ((fp1 (tn-ref-tn (tn-ref-across (vop-args vop1))))
(fp2 (tn-ref-tn (tn-ref-across (vop-args vop2))))
(dest1 (dest vop1))
(dest2 (dest vop2)))
(when (eq fp1 fp2)
@ -342,7 +342,7 @@
(stack-p dest2))
fp1
cfp-tn)
(tn-ref-load-tn (tn-ref-across (sb-c::vop-args vop1)))))))))))
(tn-ref-load-tn (tn-ref-across (vop-args vop1)))))))))))
;;;; ILLEGAL-MOVE

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

@ -336,10 +336,10 @@
(destructuring-bind (size posn integer)
(sb-c::basic-combination-args node)
(declare (ignore integer))
(and (plusp (sb-c::lvar-value posn))
(or (= (sb-c::lvar-value size) 1)
(<= (+ (sb-c::lvar-value size)
(sb-c::lvar-value posn))
(and (plusp (sb-c:lvar-value posn))
(or (= (sb-c:lvar-value size) 1)
(<= (+ (sb-c:lvar-value size)
(sb-c:lvar-value posn))
n-word-bits)))))))
(if (or (validp 'word)
(validp 'signed-word))

2
src/compiler/mips/arith.lisp
View file

@ -615,7 +615,7 @@
fast-ash-left/unsigned=>unsigned))
(deftransform ash-left-mod32 ((integer count)
((unsigned-byte 32) (unsigned-byte 5)))
(when (sb-c::constant-lvar-p count)
(when (sb-c:constant-lvar-p count)
(sb-c::give-up-ir1-transform))
'(%primitive fast-ash-left-mod32/unsigned=>unsigned integer count))

4
src/compiler/mips/c-call.lisp
View file

@ -131,8 +131,8 @@
(make-result-state))))))
(deftransform %alien-funcall ((function type &rest args))
(aver (sb-c::constant-lvar-p type))
(let* ((type (sb-c::lvar-value type))
(aver (sb-c:constant-lvar-p type))
(let* ((type (sb-c:lvar-value type))
(env (make-null-lexenv))
(arg-types (alien-fun-type-arg-types type))
(result-type (alien-fun-type-result-type type)))

2
src/compiler/parse-lambda-list.lisp
View file

@ -114,7 +114,7 @@
(probably-ll-keyword-p (arg)
;; Compiler doesn't see that the check is manually done. :-(
#-sb-xc-host
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(and (symbolp arg)
(let ((name (symbol-name arg)))
(and (plusp (length name))

2
src/compiler/ppc/arith.lisp
View file

@ -706,7 +706,7 @@
fast-ash-left/unsigned=>unsigned))
(deftransform ash-left-mod32 ((integer count)
((unsigned-byte 32) (unsigned-byte 5)))
(when (sb-c::constant-lvar-p count)
(when (sb-c:constant-lvar-p count)
(sb-c::give-up-ir1-transform))
'(%primitive fast-ash-left-mod32/unsigned=>unsigned integer count))

8
src/compiler/ppc/c-call.lisp
View file

@ -210,8 +210,8 @@
;;; fit into registers or must go on the stack.
#-darwin
(deftransform %alien-funcall ((function type &rest args))
(aver (sb-c::constant-lvar-p type))
(let* ((type (sb-c::lvar-value type))
(aver (sb-c:constant-lvar-p type))
(let* ((type (sb-c:lvar-value type))
(arg-types (alien-fun-type-arg-types type))
(result-type (alien-fun-type-result-type type))
(gprs 0)
@ -306,8 +306,8 @@
#+darwin
(deftransform %alien-funcall ((function type &rest args))
(aver (sb-c::constant-lvar-p type))
(let* ((type (sb-c::lvar-value type))
(aver (sb-c:constant-lvar-p type))
(let* ((type (sb-c:lvar-value type))
(arg-types (alien-fun-type-arg-types type))
(result-type (alien-fun-type-result-type type)))
(aver (= (length arg-types) (length args)))

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

@ -366,8 +366,8 @@
(destructuring-bind (size posn integer)
(sb-c::basic-combination-args node)
(declare (ignore integer))
(<= (+ (sb-c::lvar-value size)
(sb-c::lvar-value posn))
(<= (+ (sb-c:lvar-value size)
(sb-c:lvar-value posn))
width)))))
(if (or (validp 'fixnum 29)
(validp '(signed-byte 32) 32)

2
src/compiler/ppc64/arith.lisp
View file

@ -497,7 +497,7 @@
fast-ash-left/unsigned=>unsigned))
(deftransform ash-left-mod64 ((integer count)
((unsigned-byte 64) (unsigned-byte 6)))
(when (sb-c::constant-lvar-p count)
(when (sb-c:constant-lvar-p count)
(sb-c::give-up-ir1-transform))
'(%primitive fast-ash-left-mod64/unsigned=>unsigned integer count))

4
src/compiler/ppc64/vm.lisp
View file

@ -358,8 +358,8 @@
(destructuring-bind (size posn integer)
(sb-c::basic-combination-args node)
(declare (ignore integer))
(<= (+ (sb-c::lvar-value size)
(sb-c::lvar-value posn))
(<= (+ (sb-c:lvar-value size)
(sb-c:lvar-value posn))
width)))))
(if (or (validp 'fixnum 29)
(validp '(signed-byte 32) 32)

4
src/compiler/riscv/arith.lisp
View file

@ -602,7 +602,7 @@
(deftransform ash-left-mod32 ((integer count)
((unsigned-byte 32) (unsigned-byte 5)))
(when (sb-c::constant-lvar-p count)
(when (sb-c:constant-lvar-p count)
(sb-c::give-up-ir1-transform))
'(%primitive fast-ash-left-mod32/unsigned=>unsigned integer count)))
@ -617,7 +617,7 @@
(deftransform ash-left-mod64 ((integer count)
((unsigned-byte 64) (unsigned-byte 6)))
(when (sb-c::constant-lvar-p count)
(when (sb-c:constant-lvar-p count)
(sb-c::give-up-ir1-transform))
'(%primitive fast-ash-left-mod64/unsigned=>unsigned integer count)))

2
src/compiler/sparc/arith.lisp
View file

@ -650,7 +650,7 @@
fast-ash-left/unsigned=>unsigned))
(deftransform ash-left-mod32 ((integer count)
((unsigned-byte 32) (unsigned-byte 5)))
(when (sb-c::constant-lvar-p count)
(when (sb-c:constant-lvar-p count)
(sb-c::give-up-ir1-transform))
'(%primitive fast-ash-left-mod32/unsigned=>unsigned integer count))

4
src/compiler/sparc/c-call.lisp
View file

@ -97,8 +97,8 @@
(make-result-state))))))
(deftransform %alien-funcall ((function type &rest args))
(aver (sb-c::constant-lvar-p type))
(let* ((type (sb-c::lvar-value type))
(aver (sb-c:constant-lvar-p type))
(let* ((type (sb-c:lvar-value type))
(arg-types (alien-fun-type-arg-types type))
(result-type (alien-fun-type-result-type type)))
(aver (= (length arg-types) (length args)))

2
src/compiler/target-disassem.lisp
View file

@ -762,7 +762,7 @@
(map-segment-instructions
(lambda (chunk inst)
(declare (type dchunk chunk) (type instruction inst))
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(loop with list = (inst-labeller inst)
while list
;; item = #(FUNCTION PREFILTERED-VALUE-INDEX)

24
src/compiler/x86-64/arith.lisp
View file

@ -283,13 +283,13 @@
(defun prepare-alu-operands (op x y vop const-tn-xform commutative)
(declare (ignore op))
(let ((arg (sb-c::vop-args vop)))
(let ((arg (vop-args vop)))
(when (tn-ref-load-tn arg)
(bug "Shouldn't have a load TN for arg0"))
(let ((arg (tn-ref-across arg)))
(when (and arg (tn-ref-load-tn arg))
(bug "Shouldn't have a load TN for arg1"))))
(let ((res (sb-c::vop-results vop)))
(let ((res (vop-results vop)))
(when (tn-ref-load-tn res) (bug "Shouldn't have a load TN for result")))
;; Immediates won't be loaded since the :LOAD-IF expression is NIL.
;; Such value should always be placed into Y if the operation is +.
@ -1417,7 +1417,7 @@
;;; This removes one instruction and possibly shortens the TEST by eliding
;;; a REX prefix.
(defoptimizer (sb-c::vop-optimize fast-logtest-c/fixnum) (vop)
(unless (tn-ref-memory-access (sb-c::vop-args vop))
(unless (tn-ref-memory-access (vop-args vop))
(let ((prev (sb-c::previous-vop-is
;; TODO: missing data-vector-ref/simple-vector-c
vop '(%raw-instance-ref/signed-word
@ -1435,22 +1435,22 @@
;; because VECTOR-LENGTH is not in a slot.
;; Obviously a GENERATE-CODE bug is the mother of all bugs.
#-ubsan slot))))
(aver (not (sb-c::vop-results vop))) ; is a :CONDITIONAL vop
(aver (not (vop-results vop))) ; is a :CONDITIONAL vop
(when (and prev (eq (vop-block prev) (vop-block vop)))
;; If the memory ref produces a fixnum, the constant should be a fixnum
;; so that we don't see cases such as in lp#1939897.
;; In the absence of vop combining, MOVE-TO-WORD would be inserted
;; between INSTANCE-INDEX-REF and LOGTEST, but it did not happen yet.
(let* ((arg (sb-c::vop-args vop))
(let* ((arg (vop-args vop))
(info-arg (car (vop-codegen-info vop)))
(constant (if (member (vop-name prev) '(instance-index-ref-c slot))
(ash info-arg n-fixnum-tag-bits)
info-arg)))
(when (and (eq (tn-ref-tn (sb-c::vop-results prev)) (tn-ref-tn arg))
(when (and (eq (tn-ref-tn (vop-results prev)) (tn-ref-tn arg))
(sb-c::very-temporary-p (tn-ref-tn arg))
(typep constant '(or word signed-word)))
(binding* ((disp (valid-memref-byte-disp prev) :exit-if-null)
(arg-ref (sb-c::reference-tn (tn-ref-tn (sb-c::vop-args prev)) nil))
(arg-ref (sb-c:reference-tn (tn-ref-tn (vop-args prev)) nil))
(new (sb-c::emit-and-insert-vop
(sb-c::vop-node vop) (vop-block vop)
(template-or-lose 'logtest-memref)
@ -1572,16 +1572,16 @@
(inst test :byte (ea (+ slot-disp extra-disp) x) (ash 1 bit-shift)))))
(defoptimizer (sb-c::vop-optimize %logbitp/c) (vop)
(unless (tn-ref-memory-access (sb-c::vop-args vop))
(unless (tn-ref-memory-access (vop-args vop))
(let ((prev (sb-c::previous-vop-is
;; TODO: missing data-vector-ref/simple-vector-c and SLOT
vop '(%raw-instance-ref/signed-word
%raw-instance-ref/word
instance-index-ref-c))))
(aver (not (sb-c::vop-results vop))) ; is a :CONDITIONAL vop
(aver (not (vop-results vop))) ; is a :CONDITIONAL vop
(when (and prev (eq (vop-block prev) (vop-block vop)))
(let ((arg (sb-c::vop-args vop)))
(when (and (eq (tn-ref-tn (sb-c::vop-results prev)) (tn-ref-tn arg))
(let ((arg (vop-args vop)))
(when (and (eq (tn-ref-tn (vop-results prev)) (tn-ref-tn arg))
(sb-c::very-temporary-p (tn-ref-tn arg))
(vop-next vop)
;; Ensure we can change the tested flag from CF to ZF
@ -1589,7 +1589,7 @@
'(branch-if compute-from-flags)))
(binding* ((disp (valid-memref-byte-disp prev) :exit-if-null)
(arg-ref
(sb-c::reference-tn (tn-ref-tn (sb-c::vop-args prev)) nil))
(sb-c:reference-tn (tn-ref-tn (vop-args prev)) nil))
(bit (car (vop-codegen-info vop)))
(info
(if (sb-c::previous-vop-is vop 'instance-index-ref-c) ; tagged slot

18
src/compiler/x86-64/array.lisp
View file

@ -257,9 +257,9 @@
(when (and prev
(eq (vop-name prev) 'slot)
(eq (car (vop-codegen-info prev)) 'sb-c::vector-length)
(eq (tn-ref-tn (sb-c::vop-args prev))
(tn-ref-tn (sb-c::vop-args vop))))
(let* ((args (sb-c::vop-args vop))
(eq (tn-ref-tn (vop-args prev))
(tn-ref-tn (vop-args vop))))
(let* ((args (vop-args vop))
(array (tn-ref-tn args))
(limit (tn-ref-tn (tn-ref-across args)))
(index (tn-ref-tn (tn-ref-across (tn-ref-across args)))))
@ -268,7 +268,7 @@
(let ((new (sb-c::emit-and-insert-vop
(sb-c::vop-node vop) (vop-block vop)
(template-or-lose replacement)
(sb-c::reference-tn-list (list array index) nil)
(sb-c:reference-tn-list (list array index) nil)
nil vop)))
(sb-c::delete-vop prev)
(sb-c::delete-vop vop)
@ -360,8 +360,8 @@
(eq (vop-name next) 'if-eq)
;; Prevent this optimization in safe code
(sb-c::policy (sb-c::vop-node vop) (< safety 3)))
(let* ((result-tn (tn-ref-tn (sb-c::vop-results vop)))
(next-args (sb-c::vop-args next))
(let* ((result-tn (tn-ref-tn (vop-results vop)))
(next-args (vop-args next))
(left (tn-ref-tn next-args))
(right (tn-ref-tn (tn-ref-across next-args)))
(comparand (if (eq result-tn left) right left)))
@ -373,9 +373,9 @@
(and (tn-sc comparand)
(plausible-signed-imm32-operand-p
(encode-value-if-immediate comparand)))))
(let* ((new-args (sb-c::reference-tn-list
(list (tn-ref-tn (sb-c::vop-args vop))
(tn-ref-tn (tn-ref-across (sb-c::vop-args vop)))
(let* ((new-args (sb-c:reference-tn-list
(list (tn-ref-tn (vop-args vop))
(tn-ref-tn (tn-ref-across (vop-args vop)))
comparand)
nil))
(new (sb-c::emit-and-insert-vop

8
src/compiler/x86-64/c-call.lisp
View file

@ -133,8 +133,8 @@
(deftransform %alien-funcall ((function type &rest args) * * :node node)
(aver (sb-c::constant-lvar-p type))
(let* ((type (sb-c::lvar-value type))
(aver (sb-c:constant-lvar-p type))
(let* ((type (sb-c:lvar-value type))
(env (sb-c::node-lexenv node))
(arg-types (alien-fun-type-arg-types type))
(result-type (alien-fun-type-result-type type)))
@ -202,8 +202,8 @@
(defoptimizer (sign-extend derive-type) ((x size))
(declare (ignore x))
(when (sb-c::constant-lvar-p size)
(specifier-type `(signed-byte ,(sb-c::lvar-value size)))))
(when (sb-c:constant-lvar-p size)
(specifier-type `(signed-byte ,(sb-c:lvar-value size)))))
(define-vop (sign-extend)
(:translate sign-extend)

2
src/compiler/x86-64/cell.lisp
View file

@ -145,7 +145,7 @@
(deftransform %compare-and-swap-symbol-value ((symbol old new)
((constant-arg symbol) t t))
(if (eq (info :variable :kind (sb-c::lvar-value symbol)) :global)
(if (eq (info :variable :kind (sb-c:lvar-value symbol)) :global)
`(%cas-symbol-global-value symbol old new)
(sb-c::give-up-ir1-transform)))

12
src/compiler/x86-64/type-vops.lisp
View file

@ -559,7 +559,7 @@
instance-pointer-lowtag)))
((%raw-instance-ref/word %raw-instance-ref/signed-word)
;; raw slot vops accept an immediate TN, not a codegen arg
(let ((index (tn-ref-tn (tn-ref-across (sb-c::vop-args mem-op)))))
(let ((index (tn-ref-tn (tn-ref-across (vop-args mem-op)))))
(when (sc-is index immediate)
(- (ash (+ (tn-value index) instance-slots-offset) word-shift)
instance-pointer-lowtag))))
@ -606,7 +606,7 @@
;; to (memref+fixnump (memref x)), it would seem to allow matching of the pattern
;; again if this optimizer is reapplied, because the "new" fixnump vop is superficially
;; the same, except for the attachment of extra data to its input.
(unless (tn-ref-memory-access (sb-c::vop-args vop))
(unless (tn-ref-memory-access (vop-args vop))
(let ((prev (sb-c::previous-vop-is
vop
'(instance-index-ref-c slot
@ -622,14 +622,14 @@
(eq (vop-name prev) 'data-vector-ref-with-offset/simple-vector-c)
#-ubsan (sb-c::policy (sb-c::vop-node vop) (= safety 3)))
(return-from vop-optimize-fixnump-optimizer nil))
(aver (not (sb-c::vop-results vop))) ; is a :CONDITIONAL vop
(aver (not (vop-results vop))) ; is a :CONDITIONAL vop
(when (and prev (eq (vop-block prev) (vop-block vop)))
(let ((arg (sb-c::vop-args vop)))
(when (and (eq (tn-ref-tn (sb-c::vop-results prev)) (tn-ref-tn arg))
(let ((arg (vop-args vop)))
(when (and (eq (tn-ref-tn (vop-results prev)) (tn-ref-tn arg))
(sb-c::very-temporary-p (tn-ref-tn arg)))
(binding* ((disp (valid-memref-byte-disp prev) :exit-if-null)
(arg-ref
(sb-c::reference-tn (tn-ref-tn (sb-c::vop-args prev)) nil))
(sb-c:reference-tn (tn-ref-tn (vop-args prev)) nil))
(new (sb-c::emit-and-insert-vop
(sb-c::vop-node vop) (vop-block vop) (sb-c::vop-info vop)
arg-ref nil prev (vop-codegen-info vop))))

4
src/compiler/x86/arith.lisp
View file

@ -1465,7 +1465,7 @@ constant shift greater than word length")))
fast-ash-left/unsigned=>unsigned))
(deftransform ash-left-mod32 ((integer count)
((unsigned-byte 32) (unsigned-byte 5)))
(when (sb-c::constant-lvar-p count)
(when (sb-c:constant-lvar-p count)
(sb-c::give-up-ir1-transform))
'(%primitive fast-ash-left-mod32/unsigned=>unsigned integer count))
@ -1478,7 +1478,7 @@ constant shift greater than word length")))
fast-ash-left/fixnum=>fixnum))
(deftransform ash-left-modfx ((integer count)
(fixnum (unsigned-byte 5)))
(when (sb-c::constant-lvar-p count)
(when (sb-c:constant-lvar-p count)
(sb-c::give-up-ir1-transform))
'(%primitive fast-ash-left-modfx/fixnum=>fixnum integer count))

4
src/compiler/x86/c-call.lisp
View file

@ -130,8 +130,8 @@
(deftransform %alien-funcall ((function type &rest args) * * :node node)
(aver (sb-c::constant-lvar-p type))
(let* ((type (sb-c::lvar-value type))
(aver (sb-c:constant-lvar-p type))
(let* ((type (sb-c:lvar-value type))
(env (sb-c::node-lexenv node))
(arg-types (alien-fun-type-arg-types type))
(result-type (alien-fun-type-result-type type)))

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

@ -467,7 +467,7 @@
(logbitp
(cond
((and (valid-funtype '((integer 0 29) fixnum) '*)
(sb-c::constant-lvar-p (first (sb-c::basic-combination-args node))))
(sb-c:constant-lvar-p (first (sb-c::basic-combination-args node))))
(values :transform '(lambda (index integer)
(%logbitp integer index))))
((valid-funtype '((integer 0 31) (signed-byte 32)) '*)

4
src/pcl/slots-boot.lisp
View file

@ -569,7 +569,7 @@
(defun find-slot-cell (wrapper slot-name)
(declare (symbol slot-name))
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(let* ((vector (wrapper-slot-table wrapper))
(modulus (truly-the index (svref vector 0)))
;; Can elide the 'else' branch of (OR symbol-hash ensure-symbol-hash)
@ -600,7 +600,7 @@
(vector (make-array n :initial-element nil)))
(flet ((add-to-vector (name slot)
(declare (symbol name)
(optimize (sb-c::insert-array-bounds-checks 0)))
(optimize (sb-c:insert-array-bounds-checks 0)))
(let ((index (rem (ensure-symbol-hash name) n)))
(setf (svref vector index)
(acons name

2
tests/hash.pure.lisp
View file

@ -52,7 +52,7 @@
(unsafely-set-bit
(compile nil
'(lambda (bv i val)
(declare (optimize (sb-c::insert-array-bounds-checks 0)))
(declare (optimize (sb-c:insert-array-bounds-checks 0)))
(setf (bit bv i) val)))))
(replace bv '(1 0 1 1 1))
(let ((hash (sxhash bv)))