Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/runtime/gc/ml-objects.c
ViewVC logotype

Annotation of /sml/trunk/src/runtime/gc/ml-objects.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download) (as text)

1 : monnier 2 /* ml-objects.c
2 :     *
3 :     * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.
4 :     *
5 :     * Code to allocate and manipulate ML objects.
6 :     *
7 :     * MP Note: when invoking the GC, we add the requested size to reqSizeB,
8 :     * so that multiple processors can request space at the same time.
9 :     */
10 :    
11 :     #include "ml-base.h"
12 :     #include "heap.h"
13 :     #include "ml-objects.h"
14 :     #include "ml-limits.h"
15 :     #include "ml-mp.h"
16 :    
17 :     /* A macro to check for necessary GC; on MP systems, this needs to be
18 :     * a loop, since other processors may steal the memory before the
19 :     * checking processor can use it.
20 :     */
21 :     #ifdef MP_SUPPORT
22 :     #define IFGC(ap, szb) \
23 :     while ((! isACTIVE(ap)) || (AVAIL_SPACE(ap) <= (szb)))
24 :     #else
25 :     #define IFGC(ap, szb) \
26 :     if ((! isACTIVE(ap)) || (AVAIL_SPACE(ap) <= (szb)))
27 :     #endif
28 :    
29 :     #ifdef COLLECT_STATS
30 :     #define COUNT_ALLOC(msp, nbytes) { \
31 :     heap_t *__h = msp->ml_heap; \
32 :     CNTR_INCR(&(__h->numAlloc), (nbytes)); \
33 :     }
34 :     #else
35 :     #define COUNT_ALLOC(msp, nbytes) /* null */
36 :     #endif
37 :    
38 :    
39 :     /* ML_CString:
40 :     *
41 :     * Allocate an ML string using a C string as an initializer. We assume
42 :     * that the string is small and can be allocated in the allocation
43 :     * arena.
44 :     */
45 :     ml_val_t ML_CString (ml_state_t *msp, const char *v)
46 :     {
47 :     int len = ((v == NIL(char *)) ? 0 : strlen(v));
48 :    
49 :     if (len == 0)
50 :     return ML_string0;
51 :     else {
52 :     int n = BYTES_TO_WORDS(len+1); /* count "\0" too */
53 :     ml_val_t res;
54 :    
55 :     ML_AllocWrite (msp, 0, MAKE_DESC(len, DTAG_string));
56 :     ML_AllocWrite (msp, n, 0); /* so word-by-word string equality works */
57 :     res = ML_Alloc (msp, n);
58 :     strcpy (PTR_MLtoC(char, res), v);
59 :     return res;
60 :     }
61 :    
62 :     } /* end of ML_CString */
63 :    
64 :     /* ML_CStringList:
65 :     *
66 :     * Given a NIL terminated array of char *, build a list of ML strings.
67 :     */
68 :     ml_val_t ML_CStringList (ml_state_t *msp, char **strs)
69 :     {
70 :     /** NOTE: we should do something about possible GC!!! **/
71 :     int i;
72 :     ml_val_t p, s;
73 :    
74 :     for (i = 0; strs[i] != NIL(char *); i++)
75 :     continue;
76 :    
77 :     p = LIST_nil;
78 :     while (i-- > 0) {
79 :     s = ML_CString(msp, strs[i]);
80 :     LIST_cons(msp, p, s, p);
81 :     }
82 :    
83 :     return p;
84 :    
85 :     } /* end of ML_CStringList */
86 :    
87 :     /* ML_AllocString:
88 :     *
89 :     * Allocate an uninitialized ML string of length > 0. This string is
90 :     * guaranteed to be padded to word size with 0 bytes, and to be 0 terminated.
91 :     */
92 :     ml_val_t ML_AllocString (ml_state_t *msp, int len)
93 :     {
94 :     int nwords = BYTES_TO_WORDS(len);
95 :     int allocSz = (((len & 0x3) == 0) ? nwords+1 : nwords);
96 :     ml_val_t desc = MAKE_DESC(len, DTAG_string);
97 :     ml_val_t res;
98 :    
99 :     if (allocSz > SMALL_OBJ_SZW) {
100 :     arena_t *ap = msp->ml_heap->gen[0]->arena[STRING_INDX];
101 :    
102 :     BEGIN_CRITICAL_SECT(MP_GCGenLock)
103 :     IFGC (ap, (WORD_SZB*(allocSz + 1))+msp->ml_heap->allocSzB) {
104 :     /* we need to do a GC */
105 :     ap->reqSizeB += WORD_SZB*(allocSz + 1);
106 :     RELEASE_LOCK(MP_GCGenLock);
107 :     InvokeGC (msp, 1);
108 :     ACQUIRE_LOCK(MP_GCGenLock);
109 :     }
110 :     *(ap->nextw++) = desc;
111 :     res = PTR_CtoML(ap->nextw);
112 :     ap->nextw += allocSz;
113 :     END_CRITICAL_SECT(MP_GCGenLock)
114 :     COUNT_ALLOC(msp, WORD_SZB*(allocSz + 1));
115 :     }
116 :     else {
117 :     ML_AllocWrite (msp, 0, desc);
118 :     res = ML_Alloc (msp, allocSz);
119 :     }
120 :    
121 :     /* zero the last word to allow fast (word) string comparisons, and to
122 :     * guarantee 0 termination.
123 :     */
124 :     PTR_MLtoC(Word_t, res)[allocSz-1] = 0;
125 :    
126 :     return res;
127 :    
128 :     } /* end of ML_AllocString. */
129 :    
130 :     /* ML_AllocCode:
131 :     *
132 :     * Allocate an uninitialized ML code string. Assume that len > 1.
133 :     */
134 :     ml_val_t ML_AllocCode (ml_state_t *msp, int len)
135 :     {
136 :     heap_t *heap = msp->ml_heap;
137 :     int allocGen = (heap->numGens < CODE_ALLOC_GEN)
138 :     ? heap->numGens
139 :     : CODE_ALLOC_GEN;
140 :     gen_t *gen = heap->gen[allocGen-1];
141 :     bigobj_desc_t *dp;
142 :    
143 :     BEGIN_CRITICAL_SECT(MP_GCGenLock)
144 :     dp = BO_Alloc (heap, allocGen, len);
145 :     ASSERT(dp->gen == allocGen);
146 :     dp->next = gen->bigObjs[CODE_INDX];
147 :     gen->bigObjs[CODE_INDX] = dp;
148 :     dp->objc = CODE_INDX;
149 :     COUNT_ALLOC(msp, len);
150 :     END_CRITICAL_SECT(MP_GCGenLock)
151 :    
152 :     return PTR_CtoML(dp->obj);
153 :    
154 :     } /* end of ML_AllocCode. */
155 :    
156 :     /* ML_AllocBytearray:
157 :     *
158 :     * Allocate an uninitialized ML bytearray. Assume that len > 0.
159 :     */
160 :     ml_val_t ML_AllocBytearray (ml_state_t *msp, int len)
161 :     {
162 :     int nwords = BYTES_TO_WORDS(len);
163 :     ml_val_t desc = MAKE_DESC(len, DTAG_bytearray);
164 :     ml_val_t res;
165 :    
166 :     if (nwords > SMALL_OBJ_SZW) {
167 :     arena_t *ap = msp->ml_heap->gen[0]->arena[STRING_INDX];
168 :     BEGIN_CRITICAL_SECT(MP_GCGenLock)
169 :     IFGC (ap, (WORD_SZB*(nwords + 1))+msp->ml_heap->allocSzB) {
170 :     /* we need to do a GC */
171 :     ap->reqSizeB += WORD_SZB*(nwords + 1);
172 :     RELEASE_LOCK(MP_GCGenLock);
173 :     InvokeGC (msp, 1);
174 :     ACQUIRE_LOCK(MP_GCGenLock);
175 :     }
176 :     *(ap->nextw++) = desc;
177 :     res = PTR_CtoML(ap->nextw);
178 :     ap->nextw += nwords;
179 :     END_CRITICAL_SECT(MP_GCGenLock)
180 :     COUNT_ALLOC(msp, WORD_SZB*(nwords + 1));
181 :     }
182 :     else {
183 :     ML_AllocWrite (msp, 0, desc);
184 :     res = ML_Alloc (msp, nwords);
185 :     }
186 :    
187 :     return res;
188 :    
189 :     } /* end of ML_AllocBytearray. */
190 :    
191 :     /* ML_AllocRealdarray:
192 :     *
193 :     * Allocate an uninitialized ML realarray. Assume that len > 0.
194 :     */
195 :     ml_val_t ML_AllocRealdarray (ml_state_t *msp, int len)
196 :     {
197 :     int nwords = DOUBLES_TO_WORDS(len);
198 :     ml_val_t desc = MAKE_DESC(len, DTAG_realdarray);
199 :     ml_val_t res;
200 :    
201 :     if (nwords > SMALL_OBJ_SZW) {
202 :     arena_t *ap = msp->ml_heap->gen[0]->arena[STRING_INDX];
203 :     BEGIN_CRITICAL_SECT(MP_GCGenLock)
204 :     /* NOTE: we use nwords+2 to allow for the alignment padding */
205 :     IFGC (ap, (WORD_SZB*(nwords + 2))+msp->ml_heap->allocSzB) {
206 :     /* we need to do a GC */
207 :     ap->reqSizeB += WORD_SZB*(nwords + 1);
208 :     RELEASE_LOCK(MP_GCGenLock);
209 :     InvokeGC (msp, 1);
210 :     ACQUIRE_LOCK(MP_GCGenLock);
211 :     }
212 :     #ifdef ALIGN_REALDS
213 :     /* Force REALD_SZB alignment (descriptor is off by one word) */
214 :     ap->nextw = (ml_val_t *)((Addr_t)(ap->nextw) | WORD_SZB);
215 :     #endif
216 :     *(ap->nextw++) = desc;
217 :     res = PTR_CtoML(ap->nextw);
218 :     ap->nextw += nwords;
219 :     END_CRITICAL_SECT(MP_GCGenLock)
220 :     COUNT_ALLOC(msp, WORD_SZB*(nwords + 1));
221 :     }
222 :     else {
223 :     #ifdef ALIGN_REALDS
224 :     /* Force REALD_SZB alignment */
225 :     msp->ml_allocPtr = (ml_val_t *)((Addr_t)(msp->ml_allocPtr) | WORD_SZB);
226 :     #endif
227 :     ML_AllocWrite (msp, 0, desc);
228 :     res = ML_Alloc (msp, nwords);
229 :     }
230 :    
231 :     return res;
232 :    
233 :     } /* end of ML_AllocRealdarray. */
234 :    
235 :     /* ML_AllocArray:
236 :     *
237 :     * Allocate an ML array using initVal as an initial value. Assume
238 :     * that len > 0.
239 :     */
240 :     ml_val_t ML_AllocArray (ml_state_t *msp, int len, ml_val_t initVal)
241 :     {
242 :     ml_val_t res, *p;
243 :     ml_val_t desc = MAKE_DESC(len, DTAG_array);
244 :    
245 :     if (len > SMALL_OBJ_SZW) {
246 :     arena_t *ap = msp->ml_heap->gen[0]->arena[ARRAY_INDX];
247 :     int gcLevel = (isBOXED(initVal) ? 0 : -1);
248 :    
249 :     BEGIN_CRITICAL_SECT(MP_GCGenLock)
250 :     checkGC:; /* the MP version jumps to here to recheck for GC */
251 :     if (! isACTIVE(ap)
252 :     || (AVAIL_SPACE(ap) <= (WORD_SZB*(len + 1))+msp->ml_heap->allocSzB))
253 :     gcLevel = 1;
254 :     if (gcLevel >= 0) {
255 :     /* we need to do a GC (and preserve initVal) */
256 :     ml_val_t root = initVal;
257 :     ap->reqSizeB += WORD_SZB*(len + 1);
258 :     RELEASE_LOCK(MP_GCGenLock);
259 :     InvokeGCWithRoots (msp, gcLevel, &root, NIL(ml_val_t *));
260 :     initVal = root;
261 :     ACQUIRE_LOCK(MP_GCGenLock);
262 :     #ifdef MP_SUPPORT
263 :     /* check again to insure that we have sufficient space */
264 :     gcLevel = -1;
265 :     goto checkGC;
266 :     #endif
267 :     }
268 :     ASSERT(ap->nextw == ap->sweep_nextw);
269 :     *(ap->nextw++) = desc;
270 :     res = PTR_CtoML(ap->nextw);
271 :     ap->nextw += len;
272 :     ap->sweep_nextw = ap->nextw;
273 :     END_CRITICAL_SECT(MP_GCGenLock)
274 :     COUNT_ALLOC(msp, WORD_SZB*(len + 1));
275 :     }
276 :     else {
277 :     ML_AllocWrite (msp, 0, desc);
278 :     res = ML_Alloc (msp, len);
279 :     }
280 :    
281 :     for (p = PTR_MLtoC(ml_val_t, res); --len >= 0; )
282 :     *p++ = initVal;
283 :    
284 :     return res;
285 :    
286 :     } /* end of ML_AllocArray. */
287 :    
288 :     /* ML_AllocVector:
289 :     *
290 :     * Allocate an ML vector, using the list initVal as an initializer.
291 :     * Assume that len > 0.
292 :     */
293 :     ml_val_t ML_AllocVector (ml_state_t *msp, int len, ml_val_t initVal)
294 :     {
295 :     ml_val_t desc = MAKE_DESC(len, DTAG_vector);
296 :     ml_val_t res, *p;
297 :    
298 :     if (len > SMALL_OBJ_SZW) {
299 :     /* Since we want to avoid pointers from the 1st generation record space
300 :     * into the allocation space, we need to do a GC (and preserve initVal)
301 :     */
302 :     arena_t *ap = msp->ml_heap->gen[0]->arena[RECORD_INDX];
303 :     ml_val_t root = initVal;
304 :     int gcLevel = 0;
305 :    
306 :     BEGIN_CRITICAL_SECT(MP_GCGenLock)
307 :     if (! isACTIVE(ap)
308 :     || (AVAIL_SPACE(ap) <= (WORD_SZB*(len + 1))+msp->ml_heap->allocSzB))
309 :     gcLevel = 1;
310 :     checkGC:; /* the MP version jumps to here to redo the GC */
311 :     ap->reqSizeB += WORD_SZB*(len + 1);
312 :     RELEASE_LOCK(MP_GCGenLock);
313 :     InvokeGCWithRoots (msp, gcLevel, &root, NIL(ml_val_t *));
314 :     initVal = root;
315 :     ACQUIRE_LOCK(MP_GCGenLock);
316 :     #ifdef MP_SUPPORT
317 :     /* check again to insure that we have sufficient space */
318 :     if (AVAIL_SPACE(ap) <= (WORD_SZB*(len + 1))+msp->ml_heap->allocSzB)
319 :     goto checkGC;
320 :     #endif
321 :     ASSERT(ap->nextw == ap->sweep_nextw);
322 :     *(ap->nextw++) = desc;
323 :     res = PTR_CtoML(ap->nextw);
324 :     ap->nextw += len;
325 :     ap->sweep_nextw = ap->nextw;
326 :     END_CRITICAL_SECT(MP_GCGenLock)
327 :     COUNT_ALLOC(msp, WORD_SZB*(len + 1));
328 :     }
329 :     else {
330 :     ML_AllocWrite (msp, 0, desc);
331 :     res = ML_Alloc (msp, len);
332 :     }
333 :    
334 :     for (p = PTR_MLtoC(ml_val_t, res); --len >= 0; initVal = LIST_tl(initVal))
335 :     *p++ = LIST_hd(initVal);
336 :    
337 :     return res;
338 :    
339 :     } /* end of ML_AllocVector. */
340 :    
341 :    
342 :     /* ML_SysConst:
343 :     *
344 :     * Find the system constant with the given id in tbl, and allocate a pair
345 :     * to represent it. If the constant is not present, then return the
346 :     * pair (~1, "<UNKNOWN>").
347 :     */
348 :     ml_val_t ML_SysConst (ml_state_t *msp, sysconst_tbl_t *tbl, int id)
349 :     {
350 :     ml_val_t name, res;
351 :     int i;
352 :    
353 :     for (i = 0; i < tbl->numConsts; i++) {
354 :     if (tbl->consts[i].id == id) {
355 :     name = ML_CString (msp, tbl->consts[i].name);
356 :     REC_ALLOC2 (msp, res, INT_CtoML(id), name);
357 :     return res;
358 :     }
359 :     }
360 :     /* here, we did not find the constant */
361 :     name = ML_CString (msp, "<UNKNOWN>");
362 :     REC_ALLOC2 (msp, res, INT_CtoML(-1), name);
363 :     return res;
364 :    
365 :     } /* end of ML_SysConst */
366 :    
367 :    
368 :     /* ML_SysConstList:
369 :     *
370 :     * Generate a list of system constants from the given table.
371 :     */
372 :     ml_val_t ML_SysConstList (ml_state_t *msp, sysconst_tbl_t *tbl)
373 :     {
374 :     int i;
375 :     ml_val_t name, sysConst, list;
376 :    
377 :     /** should check for available heap space !!! **/
378 :     for (list = LIST_nil, i = tbl->numConsts; --i >= 0; ) {
379 :     name = ML_CString (msp, tbl->consts[i].name);
380 :     REC_ALLOC2 (msp, sysConst, INT_CtoML(tbl->consts[i].id), name);
381 :     LIST_cons(msp, list, sysConst, list);
382 :     }
383 :    
384 :     return list;
385 :    
386 :     } /* end of ML_SysConstList */
387 :    
388 :    
389 :     /* ML_CData:
390 :     *
391 :     * Allocate a Word8Vector.vector.
392 :     */
393 :     ml_val_t ML_AllocCData (ml_state_t *msp, int nbytes)
394 :     {
395 :     ml_val_t obj;
396 :    
397 :     obj = ML_AllocString (msp, nbytes);
398 :    
399 :     return obj;
400 :    
401 :     } /* end of ML_AllocCData */
402 :    
403 :    
404 :     /* ML_CData:
405 :     *
406 :     * Allocate a Word8Vector.vector and initialize it to the given C data.
407 :     */
408 :     ml_val_t ML_CData (ml_state_t *msp, void *data, int nbytes)
409 :     {
410 :     ml_val_t obj;
411 :    
412 :     obj = ML_AllocString (msp, nbytes);
413 :     memcpy (PTR_MLtoC(void, obj), data, nbytes);
414 :    
415 :     return obj;
416 :    
417 :     } /* end of ML_CData */
418 :    
419 :    
420 :     /* ML_StringEq:
421 :     * Test two ML strings for equality.
422 :     */
423 :     bool_t ML_StringEq (ml_val_t a, ml_val_t b)
424 :     {
425 :     int l;
426 :    
427 :     if (a == b)
428 :     return TRUE;
429 :     else if ((l = OBJ_LEN(a)) != OBJ_LEN(b))
430 :     return FALSE;
431 :     else
432 :     return (strncmp(PTR_MLtoC(char, a), PTR_MLtoC(char, b), l) == 0);
433 :    
434 :     } /* end of ML_StringEq */
435 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0