src/runtime/alloc.c

   1 /*
   2  * allocation routines
   3  */
   4
   5 /*
   6  * This software is part of the SBCL system. See the README file for
   7  * more information.
   8  *
   9  * This software is derived from the CMU CL system, which was
  10  * written at Carnegie Mellon University and released into the
  11  * public domain. The software is in the public domain and is
  12  * provided with absolutely no warranty. See the COPYING and CREDITS
  13  * files for more information.
  14  */
  15
  16 #include "runtime.h"
  17 #include "sbcl.h"
  18 #include "alloc.h"
  19 #include "globals.h"
  20 #include "gc.h"
  21 #include <stdio.h>
  22
  23 #define GET_FREE_POINTER() dynamic_space_free_pointer
  24 #define SET_FREE_POINTER(new_value) \
  25   (dynamic_space_free_pointer = (new_value))
  26 #define GET_GC_TRIGGER() current_auto_gc_trigger
  27 #define SET_GC_TRIGGER(new_value) \
  28     clear_auto_gc_trigger(); set_auto_gc_trigger(new_value);
  29
  30 #define ALIGNED_SIZE(n) (n+lowtag_Mask) & ~lowtag_Mask
  31
  32 #if defined GENCGC
  33 extern lispobj *alloc(int bytes);
  34 #else
  35 static lispobj *
  36 alloc(int bytes)
  37 {
  38     lispobj *result;
  39
  40     /* Round to dual word boundary. */
  41     bytes = (bytes + lowtag_Mask) & ~lowtag_Mask;
  42
  43     result = GET_FREE_POINTER();
  44
  45     SET_FREE_POINTER(result + (bytes / sizeof(lispobj)));
  46
  47     if (GET_GC_TRIGGER() && GET_FREE_POINTER() > GET_GC_TRIGGER()) {
  48         SET_GC_TRIGGER((char *)GET_FREE_POINTER()
  49                        - (char *)current_dynamic_space);
  50     }
  51     return result;
  52 }
  53 #endif
  54
  55 static lispobj *
  56 alloc_unboxed(int type, int words)
  57 {
  58     lispobj *result;
  59
  60     result = alloc(ALIGNED_SIZE((1 + words) * sizeof(lispobj)));
  61     *result = (lispobj) (words << type_Bits) | type;
  62     return result;
  63 }
  64
  65 static lispobj
  66 alloc_vector(int type, int length, int size)
  67 {
  68     struct vector *result;
  69
  70     result = (struct vector *)
  71       alloc(ALIGNED_SIZE((2 + (length*size + 31) / 32) * sizeof(lispobj)));
  72
  73     result->header = type;
  74     result->length = make_fixnum(length);
  75
  76     return ((lispobj)result)|type_OtherPointer;
  77 }
  78
  79 lispobj
  80 alloc_cons(lispobj car, lispobj cdr)
  81 {
  82     struct cons *ptr = (struct cons *)alloc(ALIGNED_SIZE(sizeof(struct cons)));
  83
  84     ptr->car = car;
  85     ptr->cdr = cdr;
  86
  87     return (lispobj)ptr | type_ListPointer;
  88 }
  89
  90 lispobj
  91 alloc_number(long n)
  92 {
  93     struct bignum *ptr;
  94
  95     if (-0x20000000 < n && n < 0x20000000)
  96         return make_fixnum(n);
  97     else {
  98         ptr = (struct bignum *)alloc_unboxed(type_Bignum, 1);
  99
 100         ptr->digits[0] = n;
 101
 102         return (lispobj) ptr | type_OtherPointer;
 103     }
 104 }
 105
 106 lispobj
 107 alloc_string(char *str)
 108 {
 109     int len = strlen(str);
 110     lispobj result = alloc_vector(type_SimpleString, len+1, 8);
 111     struct vector *vec = (struct vector *)native_pointer(result);
 112
 113     vec->length = make_fixnum(len);
 114     strcpy((char *)vec->data, str);
 115
 116     return result;
 117 }
 118
 119 lispobj
 120 alloc_sap(void *ptr)
 121 {
 122     int n_words_to_alloc =
 123         (sizeof(struct sap) - sizeof(lispobj)) / sizeof(u32);
 124     struct sap *sap =
 125         (struct sap *)alloc_unboxed((int)type_Sap, n_words_to_alloc);
 126     sap->pointer = ptr;
 127     return (lispobj) sap | type_OtherPointer;
 128 }