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 ;;;; from signed/unsigned
16 ;;; KLUDGE: Why don't we want vops for this one and the next
17 ;;; one? -- WHN 19990916
18 #+sb-assembling ; We don't want a vop for this one.
19 (define-assembly-routine
21 ((:temp eax unsigned-reg eax-offset)
22 (:temp ebx unsigned-reg ebx-offset))
31 (with-fixed-allocation (ebx bignum-widetag (+ bignum-digits-offset 1))
32 (storew eax ebx bignum-digits-offset other-pointer-lowtag))
36 #+sb-assembling ; We don't want a vop for this one either.
37 (define-assembly-routine
39 ((:temp eax unsigned-reg eax-offset)
40 (:temp ebx unsigned-reg ebx-offset))
42 (inst test eax #xe0000000)
50 ;;; Note: On the mips port space for a two word bignum is always
51 ;;; allocated and the header size is set to either one or two words
52 ;;; as appropriate. On the mips port this is faster, and smaller
53 ;;; inline, but produces more garbage. The inline x86 version uses
54 ;;; the same approach, but here we save garbage and allocate the
55 ;;; smallest possible bignum.
56 (inst jmp :ns one-word-bignum)
60 (with-fixed-allocation (ebx bignum-widetag (+ bignum-digits-offset 2))
61 (storew eax ebx bignum-digits-offset other-pointer-lowtag))
65 (with-fixed-allocation (ebx bignum-widetag (+ bignum-digits-offset 1))
66 (storew eax ebx bignum-digits-offset other-pointer-lowtag))
70 (defun frob-allocation-assembly-routine (obj lowtag arg-tn)
71 `(define-assembly-routine (,(intern (format nil "ALLOCATE-~A-TO-~A" obj arg-tn)))
72 ((:temp ,arg-tn descriptor-reg ,(intern (format nil "~A-OFFSET" arg-tn))))
74 (allocation ,arg-tn (pad-data-block ,(intern (format nil "~A-SIZE" obj))))
75 (inst lea ,arg-tn (make-ea :byte :base ,arg-tn :disp ,lowtag))
79 (macrolet ((frob-cons-routines ()
81 (dolist (tn-offset *dword-regs*
83 (push (frob-allocation-assembly-routine 'cons
85 (intern (aref *dword-register-names* tn-offset)))