mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
0f1fb5049a
Instead of trying to materialize immediate values greater than 32 bits, which is hard to do GC-safely on riscv64, don't treat >32 bit immediate values as immediates at all. Rather, always treat them as boxed constants. If we ever fix up how immediates are materialized on riscv64, such that no untagged intermediates could possibly be loaded into descriptor-regs, then we can go back to loading in immediates for all fixnum values. This also corrects a misunderstanding on what immediate-constant-sc is supposed to do, as tested for in vm.before-xc.lisp. It's actually entirely backend/implementation dependent for what we treat as an immediate. It just happened that on 32-bit MIPS, encoded fixnums coincided with the conveniently materializable immediate, so the idea of fixnum = immediate got adopted to the other platforms, even when this wasn't the original design intention. And also give SAPs the same treatment.
62 lines
2.5 KiB
Common Lisp
62 lines
2.5 KiB
Common Lisp
;;;; tests of the compiler vm internal consistency intended to be
|
|
;;;; executed as soon as the cross-compiler is built.
|
|
|
|
;;;; This software is part of the SBCL system. See the README file for
|
|
;;;; more information.
|
|
;;;;
|
|
;;;; While most of SBCL is derived from the CMU CL system, the test
|
|
;;;; files (like this one) were written from scratch after the fork
|
|
;;;; from CMU CL.
|
|
;;;;
|
|
;;;; This software is in the public domain and is provided with
|
|
;;;; absolutely no warranty. See the COPYING and CREDITS files for
|
|
;;;; more information.
|
|
|
|
(in-package "SB-VM")
|
|
|
|
(/show "beginning tests/vm.before-xc.lisp")
|
|
|
|
(flet ((no (x)
|
|
(assert
|
|
(not (immediate-constant-sc x)))))
|
|
(no #.(1+ most-positive-fixnum))
|
|
(no #.(1- most-negative-fixnum)))
|
|
|
|
;; Assert that DO-PACKED-TNS has unsurprising behavior if the body RETURNs.
|
|
;; This isn't a test in the problem domain of CL - it's of an internal macro,
|
|
;; and x86-64-specific not because of broken-ness, but because it uses
|
|
;; known random TNs to play with.
|
|
(in-package "SB-C")
|
|
#+x86-64
|
|
(dotimes (i (ash 1 6))
|
|
(labels ((make-tns (n)
|
|
(mapcar 'copy-structure
|
|
(subseq `(,sb-vm::rax-tn ,sb-vm::rbx-tn ,sb-vm::rcx-tn) 0 n)))
|
|
(link (list)
|
|
(when list
|
|
(setf (sb-c::tn-next (car list)) (link (cdr list)))
|
|
(car list))))
|
|
(let* ((normal (make-tns (ldb (byte 2 0) i)))
|
|
(restricted (make-tns (ldb (byte 2 2) i)))
|
|
(wired (make-tns (ldb (byte 2 4) i)))
|
|
(expect (append normal restricted wired))
|
|
(comp (sb-c::make-empty-component))
|
|
(ir2-comp (sb-c::make-ir2-component)))
|
|
(setf (sb-c:component-info comp) ir2-comp
|
|
(sb-c::ir2-component-normal-tns ir2-comp) (link normal)
|
|
(sb-c::ir2-component-restricted-tns ir2-comp) (link restricted)
|
|
(sb-c::ir2-component-wired-tns ir2-comp) (link wired))
|
|
(let* ((list)
|
|
(result (sb-c::do-packed-tns (tn comp 42) (push tn list))))
|
|
(assert (eq result 42))
|
|
(assert (equal expect (nreverse list))))
|
|
(let* ((n 0) (list)
|
|
(result (sb-c::do-packed-tns (tn comp 'bar)
|
|
(push tn list)
|
|
(if (= (incf n) 4) (return 'foo)))))
|
|
(assert (eq result (if (>= (length expect) 4) 'foo 'bar)))
|
|
(assert (equal (subseq expect 0 (min 4 (length expect)))
|
|
(nreverse list)))))))
|
|
|
|
(/show "done with tests/vm.before-xc.lisp")
|