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
))
77 (declare (ignorable reg
))
79 (let* ((name (intern (format nil
"ALLOC-TLS-INDEX-IN-~A" reg
)))
80 (target-offset (intern (format nil
"~A-OFFSET" reg
)))
81 (other-offset (if (eql 'rax reg
)
84 ;; Symbol starts in TARGET, where the TLS-INDEX ends up in.
85 `(define-assembly-routine ,name
86 ((:temp other descriptor-reg
,other-offset
)
87 (:temp target descriptor-reg
,target-offset
))
88 (let ((get-tls-index-lock (gen-label))
89 (release-tls-index-lock (gen-label)))
91 ;; Save OTHER & push the symbol. RAX is either one of the two.
94 (emit-label get-tls-index-lock
)
98 (inst cmpxchg
(make-ea-for-symbol-value *tls-index-lock
*) target
)
99 (inst jmp
:ne get-tls-index-lock
)
100 ;; The symbol is now in OTHER.
102 ;; Now with the lock held, see if the symbol's tls index has been
103 ;; set in the meantime.
104 (loadw target other symbol-tls-index-slot other-pointer-lowtag
)
105 (inst or target target
)
106 (inst jmp
:ne release-tls-index-lock
)
107 ;; Allocate a new tls-index.
108 (load-symbol-value target
*free-tls-index
*)
109 (let ((error (generate-error-code nil tls-exhausted-error
)))
110 (inst cmp target
(fixnumize tls-size
))
111 (inst jmp
:ge error
))
112 (inst add
(make-ea-for-symbol-value *free-tls-index
*)
114 (storew target other symbol-tls-index-slot other-pointer-lowtag
)
115 (emit-label release-tls-index-lock
)
116 (store-symbol-value 0 *tls-index-lock
*)