1 ;;;; allocating simple objects
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 ;;;; Signed and unsigned bignums from word-sized integers. Argument
15 ;;;; and return in the same register. No VOPs, as these are only used
16 ;;;; as out-of-line versions: MOVE-FROM-[UN]SIGNED VOPs handle the
17 ;;;; fixnum cases inline.
19 ;;; #+SB-ASSEMBLING as we don't need VOPS, just the asm routines:
20 ;;; these are out-of-line versions called by VOPs.
25 `(define-assembly-routine (,(symbolicate "ALLOC-SIGNED-BIGNUM-IN-" reg))
26 ((:temp number unsigned-reg ,(symbolicate reg "-OFFSET")))
28 (with-fixed-allocation (number bignum-widetag (+ bignum-digits-offset 1))
29 (popw number bignum-digits-offset other-pointer-lowtag))
48 `(define-assembly-routine (,(symbolicate "ALLOC-UNSIGNED-BIGNUM-IN-" reg))
49 ((:temp number unsigned-reg ,(symbolicate reg "-OFFSET")))
51 (inst jmp :ns one-word-bignum)
53 (with-fixed-allocation (number bignum-widetag (+ bignum-digits-offset 2))
54 (popw number bignum-digits-offset other-pointer-lowtag))
57 (with-fixed-allocation (number bignum-widetag (+ bignum-digits-offset 1))
58 (popw number bignum-digits-offset other-pointer-lowtag))
76 (declare (ignorable reg))
78 (let* ((name (intern (format nil "ALLOC-TLS-INDEX-IN-~A" reg)))
79 (target-offset (intern (format nil "~A-OFFSET" reg)))
80 (other-offset (if (eql 'rax reg)
83 ;; Symbol starts in TARGET, where the TLS-INDEX ends up in.
84 `(define-assembly-routine ,name
85 ((:temp other descriptor-reg ,other-offset)
86 (:temp target descriptor-reg ,target-offset))
87 (let ((get-tls-index-lock (gen-label))
88 (release-tls-index-lock (gen-label)))
90 ;; Save OTHER & push the symbol. RAX is either one of the two.
93 (emit-label get-tls-index-lock)
97 (inst cmpxchg (make-ea-for-symbol-value *tls-index-lock*) target)
98 (inst jmp :ne get-tls-index-lock)
99 ;; The symbol is now in OTHER.
101 ;; Now with the lock held, see if the symbol's tls index has been
102 ;; set in the meantime.
103 (loadw target other symbol-tls-index-slot other-pointer-lowtag)
104 (inst or target target)
105 (inst jmp :ne release-tls-index-lock)
106 ;; Allocate a new tls-index.
107 (load-symbol-value target *free-tls-index*)
108 (inst add (make-ea-for-symbol-value *free-tls-index*) (fixnumize 1))
109 (storew target other symbol-tls-index-slot other-pointer-lowtag)
110 (emit-label release-tls-index-lock)
111 (store-symbol-value 0 *tls-index-lock*)