2 * allocation routines for C code. For allocation done by Lisp look
3 * instead at src/compiler/target/alloc.lisp and .../macros.lisp
7 * This software is part of the SBCL system. See the README file for
10 * This software is derived from the CMU CL system, which was
11 * written at Carnegie Mellon University and released into the
12 * public domain. The software is in the public domain and is
13 * provided with absolutely no warranty. See the COPYING and CREDITS
14 * files for more information.
20 #include "pseudo-atomic.h"
21 #include "genesis/code.h"
23 #ifdef LISP_FEATURE_GENCGC
24 lispobj
alloc_code_object (unsigned boxed
, unsigned unboxed
) {
26 struct thread
*th
= arch_os_get_current_thread();
27 /* boxed is the number of constants, add other slots, align it to
28 * two words, so that the code start is aligned, and convert it to
31 (offsetof(struct code
, constants
) >>
32 WORD_SHIFT
)) << WORD_SHIFT
;
33 boxed
&= ~LOWTAG_MASK
;
35 /* Unboxed is the size of instructions in bytes. It will be stored
36 * as is in the code_size slot, but it needs to be allocated with
37 * double-word alignment. */
38 unsigned unboxed_aligned
= (unboxed
+ LOWTAG_MASK
) & ~LOWTAG_MASK
;
40 /* Since alloc_code_object is run under WITHOUT-GCING it doesn't
41 * actaully need to be pseudo-atomic, this is just to appease the
42 * assertions in general_alloc() */
43 set_pseudo_atomic_atomic(th
);
44 code
= (struct code
*)general_alloc(boxed
+ unboxed_aligned
, CODE_PAGE_FLAG
);
45 clear_pseudo_atomic_atomic(th
);
47 /* It used to be that even on gencgc builds the
48 * ALLOCATE-CODE-OBJECT VOP did all this initialization within
49 * pseudo atomic. Here, we rely on gc being inhibited. */
50 if (SymbolValue(GC_INHIBIT
, arch_os_get_current_thread()) == NIL
)
51 lose("alloc_code_object called with GC enabled.");
52 boxed
= boxed
<< (N_WIDETAG_BITS
- WORD_SHIFT
);
53 code
->header
= boxed
| CODE_HEADER_WIDETAG
;
54 code
->code_size
= make_fixnum(unboxed
);
55 code
->entry_points
= NIL
;
56 code
->debug_info
= NIL
;
57 return make_lispobj(code
, OTHER_POINTER_LOWTAG
);