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

Allow encoding negative immediate numbers in error breaks.

Browse source
This commit is contained in:
Stas Boukarev 2025-08-30 05:23:27 +03:00
parent 12eb2ced1f
commit 37f7e8eed4
5 changed files with 31 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/code/debug-int.lisp
View file

@ -2791,7 +2791,9 @@ register."
:invalid-code-object-at-pc))
:invalid-value-for-unescaped-register-storage))
(#.immediate-sc-number
(sb-c:sc+offset-offset sc+offset)))))
(sb-c:sc+offset-offset sc+offset))
(#.sb-vm::negative-immediate-sc-number
(- (sb-c:sc+offset-offset sc+offset))))))
;;; This stores value as the value of DEBUG-VAR in FRAME. In the
;;; COMPILED-DEBUG-VAR case, access the current value to determine if

9
src/compiler/generic/type-error.lisp
View file

@ -171,6 +171,13 @@
(prog1 (progn ,@body)
(push ,var *adjustable-vectors*))))
(defun encode-immediate-error-arg (x)
(declare (type sc-offset-immediate x))
(make-sc+offset (if (minusp x)
negative-immediate-sc-number
immediate-sc-number)
(abs x)))
(defun encode-internal-error-args (values)
(with-adjustable-vector (vector)
(dolist (where values)
@ -180,7 +187,7 @@
where)
((and (sc-is where immediate)
(fixnump (tn-value where)))
(make-sc+offset immediate-sc-number (tn-value where)))
(encode-immediate-error-arg (tn-value where)))
(t
(make-sc+offset (if (and (sc-is where immediate)
(typep (tn-value where) '(or symbol layout)))

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

@ -189,6 +189,9 @@
(append *!late-primitive-object-forms*
',(forms)))))))
;;; A special sc-number for encoding errors
(defconstant negative-immediate-sc-number 61)
;;; We want small SC-NUMBERs for SCs whose numbers are frequently
;;; embedded into machine code. We therefore fix the numbers for the
;;; four (i.e two bits) most frequently embedded SCs (empirically
@ -204,6 +207,9 @@
(let* ((sc-number (or (cdr (assoc sc-name fixed-numbers))
(1- (incf index))))
(constant-name (symbolicate sc-name "-SC-NUMBER")))
(when (= sc-number negative-immediate-sc-number)
(error "sc-number can't be the sames ~a=~a"
'negative-immediate-sc-number negative-immediate-sc-number))
`((!define-storage-class ,sc-name ,sc-number
,sb-name ,@args)
(defconstant ,constant-name ,sc-number))))))
@ -220,6 +226,7 @@
(defconstant sc-offset-limit (ash 1 21))
(defconstant sc-offset-bits (integer-length (1- sc-offset-limit)))
(deftype sc-offset () `(integer 0 (,sc-offset-limit)))
(deftype sc-offset-immediate () `(signed-byte 22))
(defconstant finite-sc-offset-limit
#-(or sparc) 32

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

@ -2589,10 +2589,13 @@
(defun get-random-tn-name (sc+offset)
(let ((sc (sb-c:sc+offset-scn sc+offset))
(offset (sb-c:sc+offset-offset sc+offset)))
(if (= sc sb-vm:immediate-sc-number)
(princ-to-string offset)
(sb-c:location-print-name
(sb-c:make-random-tn (svref sb-c:*backend-sc-numbers* sc) offset)))))
(cond ((= sc sb-vm:immediate-sc-number)
(princ-to-string offset))
((= sc sb-vm::negative-immediate-sc-number)
(princ-to-string (- offset)))
(t
(sb-c:location-print-name
(sb-c:make-random-tn (svref sb-c:*backend-sc-numbers* sc) offset))))))
;;; When called from an error break instruction's :DISASSEM-CONTROL (or
;;; :DISASSEM-PRINTER) function, will correctly deal with printing the

6
xperfecthash63.lisp-expr
View file

@ -1634,5 +1634,11 @@
(#(379EC24E B0932BD7 DBE841E7)
"((ASSOC-IF . ASSOC-IF-NOT) (RASSOC-IF . RASSOC-IF-NOT) (MEMBER-IF . MEMBER-IF-NOT))"
"((^ (>> val 30) 2))")
(#(0 2 4 6 8 A E 10 12 14 16 18 1A 1C 1E 20 22 24 2A 2C 2E 30 7A)
"(61 4 3 10 7 8 9 5 14 13 12 11 24 23 22 21 18 17 2 16 15 0 1)"
"((let ((tab #a((16) (unsigned-byte 8) 0 13 1 7 15 13 15 7 16 9 18 22 16 0 18 22)))
(let ((b (& (>> val 1) #xf)))
(let ((a (>> (<< val 25) 28)))
(^ a (aref tab b))))))")
)
;; EOF