Clean up RCS ids
[projects/cmucl/cmucl.git] / src / lisp / alloc.c
CommitLineData
eeab7066
RT
1/*
2
3 This code was written as part of the CMU Common Lisp project at
4 Carnegie Mellon University, and has been placed in the public domain.
5
6*/
a09fed84 7
68ac9a3e 8#include <stdio.h>
a09fed84 9#include <string.h>
62957726 10
11#include "lisp.h"
12#include "internals.h"
13#include "alloc.h"
14#include "globals.h"
15#include "gc.h"
16
17#ifdef ibmrt
18#define GET_FREE_POINTER() ((lispobj *)SymbolValue(ALLOCATION_POINTER))
19#define SET_FREE_POINTER(new_value) \
20 (SetSymbolValue(ALLOCATION_POINTER,(lispobj)(new_value)))
21#define GET_GC_TRIGGER() ((lispobj *)SymbolValue(INTERNAL_GC_TRIGGER))
22#define SET_GC_TRIGGER(new_value) \
23 (SetSymbolValue(INTERNAL_GC_TRIGGER,(lispobj)(new_value)))
24#else
25#define GET_FREE_POINTER() current_dynamic_space_free_pointer
26#define SET_FREE_POINTER(new_value) \
27 (current_dynamic_space_free_pointer = (new_value))
28#define GET_GC_TRIGGER() current_auto_gc_trigger
29#define SET_GC_TRIGGER(new_value) \
30 clear_auto_gc_trigger(); set_auto_gc_trigger(new_value);
31#endif
32
5ced0fdf 33#define ALIGNED_SIZE(n) (n+lowtag_Mask) & ~lowtag_Mask
62957726 34
35/****************************************************************
36Allocation Routines.
37****************************************************************/
e31f8138 38
39#if defined GENCGC
5a1bf534 40#define alloc(nbytes) alloc_pseudo_atomic(nbytes)
41#include "gencgc.h"
e31f8138 42#elif defined(WANT_CGC)
5ced0fdf 43extern lispobj *alloc(int bytes);
44#else
9a8c1c2f 45static lispobj *
46alloc(int bytes)
62957726 47{
48 lispobj *result;
49
50 /* Round to dual word boundry. */
51 bytes = (bytes + lowtag_Mask) & ~lowtag_Mask;
52
53 result = GET_FREE_POINTER();
54 SET_FREE_POINTER(result + (bytes / sizeof(lispobj)));
55
56 if (GET_GC_TRIGGER() && GET_FREE_POINTER() > GET_GC_TRIGGER()) {
9a8c1c2f 57 SET_GC_TRIGGER((char *) GET_FREE_POINTER()
58 - (char *) current_dynamic_space);
62957726 59 }
60
61 return result;
62}
5ced0fdf 63#endif
62957726 64
9a8c1c2f 65static lispobj *
66alloc_unboxed(int type, int words)
62957726 67{
68 lispobj *result;
69
9a8c1c2f 70 result = (lispobj *) alloc(ALIGNED_SIZE((1 + words) * sizeof(lispobj)));
62957726 71
72 *result = (lispobj) (words << type_Bits) | type;
73
74 return result;
75}
76
9a8c1c2f 77static lispobj
78alloc_vector(int type, int length, int size)
62957726 79{
80 struct vector *result;
81
5ced0fdf 82 result = (struct vector *)
9a8c1c2f 83 alloc(ALIGNED_SIZE((2 + (length * size + 31) / 32) * sizeof(lispobj)));
62957726 84
85 result->header = type;
86 result->length = make_fixnum(length);
87
9a8c1c2f 88 return ((lispobj) result) | type_OtherPointer;
62957726 89}
90
9a8c1c2f 91lispobj
92alloc_cons(lispobj car, lispobj cdr)
62957726 93{
9a8c1c2f 94 struct cons *ptr = (struct cons *) alloc(ALIGNED_SIZE(sizeof(struct cons)));
62957726 95
96 ptr->car = car;
97 ptr->cdr = cdr;
98
9a8c1c2f 99 return (lispobj) ptr | type_ListPointer;
62957726 100}
101
9a8c1c2f 102lispobj
103alloc_number(long n)
62957726 104{
105 struct bignum *ptr;
106
777667de 107#ifdef __x86_64
9a8c1c2f 108 if (-0x2000000000000000 < n && n < 0x2000000000000000) /* -2^61 to 2^61 */
777667de 109#else
62957726 110 if (-0x20000000 < n && n < 0x20000000)
777667de 111#endif
9a8c1c2f 112 return make_fixnum(n);
62957726 113 else {
9a8c1c2f 114 ptr = (struct bignum *) alloc_unboxed(type_Bignum, 1);
62957726 115
9a8c1c2f 116 ptr->digits[0] = n;
62957726 117
118 return (lispobj) ptr | type_OtherPointer;
119 }
120}
121
68ac9a3e 122#ifndef UNICODE
9a8c1c2f 123lispobj
d4bc586c 124alloc_string(const char *str)
62957726 125{
126 int len = strlen(str);
9a8c1c2f 127 lispobj result = alloc_vector(type_SimpleString, len + 1, 8);
128 struct vector *vec = (struct vector *) PTR(result);
62957726 129
130 vec->length = make_fixnum(len);
9a8c1c2f 131 strcpy((char *) vec->data, str);
68ac9a3e 132 return result;
133}
134#else
135lispobj
136alloc_string(const char *str)
137{
138 int k;
139 int len = strlen(str);
140 lispobj result = alloc_vector(type_SimpleString, len + 1, 16);
141 struct vector *vec = (struct vector *) PTR(result);
142 unsigned short int *wide_char_data;
143
144 vec->length = make_fixnum(len);
145 wide_char_data = (unsigned short int*) vec->data;
146 for (k = 0; k < len; ++k) {
147 wide_char_data[k] = str[k] & 0xff;
148 }
62957726 149
68ac9a3e 150#if 0
151 fprintf(stderr, "alloc-string: 0x%lx %d -> `%s'\n",
152 result, len, str);
153#endif
154
62957726 155 return result;
156}
68ac9a3e 157#endif
62957726 158
9a8c1c2f 159lispobj
160alloc_sap(void *ptr)
62957726 161{
6f4a04e5 162#ifndef alpha
9a8c1c2f 163 struct sap *sap_ptr = (struct sap *) alloc_unboxed(type_Sap, 1);
6f4a04e5 164#else
9a8c1c2f 165 struct sap *sap_ptr = (struct sap *) alloc_unboxed(type_Sap, 3);
6f4a04e5 166#endif
1484dfe2 167 sap_ptr->pointer = ptr;
62957726 168
1484dfe2 169 return (lispobj) sap_ptr | type_OtherPointer;
62957726 170}