src/runtime/alloc.c

   1 /*
   2  * allocation routines for C code.  For allocation done by Lisp look
   3  * instead at src/compiler/target/alloc.lisp and .../macros.lisp
   4  */
   5
   6 /*
   7  * This software is part of the SBCL system. See the README file for
   8  * more information.
   9  *
  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.
  15  */
  16
  17 #include "sbcl.h"
  18 #include "alloc.h"
  19 #include "thread.h"
  20 #include "pseudo-atomic.h"
  21 #include "genesis/code.h"
  22
  23 #ifdef LISP_FEATURE_GENCGC
  24 lispobj alloc_code_object (unsigned boxed, unsigned unboxed) {
  25     struct code * code;
  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
  29      * bytes. */
  30     boxed = (boxed + 1 +
  31              (offsetof(struct code, constants) >>
  32               WORD_SHIFT)) << WORD_SHIFT;
  33     boxed &= ~LOWTAG_MASK;
  34
  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;
  39
  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);
  46
  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);
  58 }
  59 #endif