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 1219 - (view) (download) (as text)

1 : monnier 249 /* 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 : jhr 1214 PVT bool_t ShrinkCheck (arena_t *ap, Word_t reqSzB);
39 : monnier 249
40 : jhr 1214
41 : monnier 249 /* ML_CString:
42 :     *
43 :     * Allocate an ML string using a C string as an initializer. We assume
44 :     * that the string is small and can be allocated in the allocation
45 :     * arena.
46 :     */
47 :     ml_val_t ML_CString (ml_state_t *msp, const char *v)
48 :     {
49 :     int len = ((v == NIL(char *)) ? 0 : strlen(v));
50 :    
51 :     if (len == 0)
52 :     return ML_string0;
53 :     else {
54 :     int n = BYTES_TO_WORDS(len+1); /* count "\0" too */
55 :     ml_val_t res;
56 :    
57 :     res = ML_AllocRaw32 (msp, n);
58 :     /* zero the last word to allow fast (word) string comparisons, and to
59 :     * guarantee 0 termination.
60 :     */
61 :     PTR_MLtoC(Word_t, res)[n-1] = 0;
62 :     strcpy (PTR_MLtoC(char, res), v);
63 :    
64 :     SEQHDR_ALLOC (msp, res, DESC_string, res, len);
65 :    
66 :     return res;
67 :     }
68 :    
69 :     } /* end of ML_CString */
70 :    
71 :     /* ML_CStringList:
72 :     *
73 :     * Given a NIL terminated array of char *, build a list of ML strings.
74 :     */
75 :     ml_val_t ML_CStringList (ml_state_t *msp, char **strs)
76 :     {
77 :     /** NOTE: we should do something about possible GC!!! **/
78 :     int i;
79 :     ml_val_t p, s;
80 :    
81 :     for (i = 0; strs[i] != NIL(char *); i++)
82 :     continue;
83 :    
84 :     p = LIST_nil;
85 :     while (i-- > 0) {
86 :     s = ML_CString(msp, strs[i]);
87 :     LIST_cons(msp, p, s, p);
88 :     }
89 :    
90 :     return p;
91 :    
92 :     } /* end of ML_CStringList */
93 :    
94 :     /* ML_AllocString:
95 :     *
96 :     * Allocate an uninitialized ML string of length > 0. This string is
97 :     * guaranteed to be padded to word size with 0 bytes, and to be 0 terminated.
98 :     */
99 :     ml_val_t ML_AllocString (ml_state_t *msp, int len)
100 :     {
101 :     int nwords = BYTES_TO_WORDS(len+1);
102 :     ml_val_t res;
103 :    
104 :     ASSERT(len > 0);
105 :    
106 :     res = ML_AllocRaw32 (msp, nwords);
107 :    
108 :     /* zero the last word to allow fast (word) string comparisons, and to
109 :     * guarantee 0 termination.
110 :     */
111 :     PTR_MLtoC(Word_t, res)[nwords-1] = 0;
112 :    
113 :     SEQHDR_ALLOC (msp, res, DESC_string, res, len);
114 :    
115 :     return res;
116 :    
117 :     } /* end of ML_AllocString. */
118 :    
119 :     /* ML_AllocRaw32:
120 :     *
121 :     * Allocate an uninitialized chunk of raw32 data.
122 :     */
123 :     ml_val_t ML_AllocRaw32 (ml_state_t *msp, int nwords)
124 :     {
125 :     ml_val_t desc = MAKE_DESC(nwords, DTAG_raw32);
126 :     ml_val_t res;
127 : jhr 1214 Word_t szb;
128 : monnier 249
129 :     ASSERT(nwords > 0);
130 :    
131 :     if (nwords > SMALL_OBJ_SZW) {
132 :     arena_t *ap = msp->ml_heap->gen[0]->arena[STRING_INDX];
133 :    
134 : jhr 1214 szb = WORD_SZB*(nwords + 1);
135 : monnier 249 BEGIN_CRITICAL_SECT(MP_GCGenLock)
136 : jhr 1214 IFGC (ap, szb+msp->ml_heap->allocSzB) {
137 : monnier 249 /* we need to do a GC */
138 : jhr 1214 ap->reqSizeB += szb;
139 : monnier 249 RELEASE_LOCK(MP_GCGenLock);
140 :     InvokeGC (msp, 1);
141 : jhr 1214 if (ShrinkCheck (ap, szb))
142 :     InvokeGC (msp, 1);
143 : monnier 249 ACQUIRE_LOCK(MP_GCGenLock);
144 :     }
145 :     *(ap->nextw++) = desc;
146 :     res = PTR_CtoML(ap->nextw);
147 :     ap->nextw += nwords;
148 :     END_CRITICAL_SECT(MP_GCGenLock)
149 :     COUNT_ALLOC(msp, WORD_SZB*(nwords + 1));
150 :     }
151 :     else {
152 :     ML_AllocWrite (msp, 0, desc);
153 :     res = ML_Alloc (msp, nwords);
154 :     }
155 :    
156 :     return res;
157 :    
158 :     } /* end of ML_AllocRaw32. */
159 :    
160 :     /* ML_ShrinkRaw32:
161 :     *
162 :     * Shrink a freshly allocated Raw32 vector. This is used by the input routines
163 :     * that must allocate space for input that may be excessive.
164 :     */
165 :     void ML_ShrinkRaw32 (ml_state_t *msp, ml_val_t v, int nWords)
166 :     {
167 :     int oldNWords = OBJ_LEN(v);
168 :    
169 :     if (nWords == oldNWords)
170 :     return;
171 :    
172 :     ASSERT((nWords > 0) && (nWords < oldNWords));
173 :    
174 :     if (oldNWords > SMALL_OBJ_SZW) {
175 :     arena_t *ap = msp->ml_heap->gen[0]->arena[STRING_INDX];
176 :     ASSERT(ap->nextw - oldNWords == PTR_MLtoC(ml_val_t, v));
177 :     ap->nextw -= (oldNWords - nWords);
178 :     }
179 :     else {
180 :     ASSERT(msp->ml_allocPtr - oldNWords == PTR_MLtoC(ml_val_t, v));
181 :     msp->ml_allocPtr -= (oldNWords - nWords);
182 :     }
183 :    
184 :     PTR_MLtoC(ml_val_t, v)[-1] = MAKE_DESC(nWords, DTAG_raw32);
185 :    
186 :     } /* end of ML_ShrinkRaw32 */
187 :    
188 :     /* ML_AllocRaw64:
189 :     *
190 :     * Allocate an uninitialized chunk of raw64 data.
191 :     */
192 :     ml_val_t ML_AllocRaw64 (ml_state_t *msp, int nelems)
193 :     {
194 :     int nwords = DOUBLES_TO_WORDS(nelems);
195 :     ml_val_t desc = MAKE_DESC(nwords, DTAG_raw64);
196 :     ml_val_t res;
197 : jhr 1214 Word_t szb;
198 : monnier 249
199 :     if (nwords > SMALL_OBJ_SZW) {
200 :     arena_t *ap = msp->ml_heap->gen[0]->arena[STRING_INDX];
201 : jhr 1214 szb = WORD_SZB*(nwords + 2);
202 : monnier 249 BEGIN_CRITICAL_SECT(MP_GCGenLock)
203 :     /* NOTE: we use nwords+2 to allow for the alignment padding */
204 : jhr 1214 IFGC (ap, szb+msp->ml_heap->allocSzB) {
205 : monnier 249 /* we need to do a GC */
206 : jhr 1214 ap->reqSizeB += szb;
207 : monnier 249 RELEASE_LOCK(MP_GCGenLock);
208 :     InvokeGC (msp, 1);
209 : jhr 1214 if (ShrinkCheck (ap, szb))
210 :     InvokeGC (msp, 1);
211 : monnier 249 ACQUIRE_LOCK(MP_GCGenLock);
212 :     }
213 :     #ifdef ALIGN_REALDS
214 :     /* Force REALD_SZB alignment (descriptor is off by one word) */
215 :     # ifdef CHECK_HEAP
216 :     if (((Addr_t)ap->nextw & WORD_SZB) == 0) {
217 :     *(ap->nextw) = (ml_val_t)0;
218 :     ap->nextw++;
219 :     }
220 :     # else
221 :     ap->nextw = (ml_val_t *)(((Addr_t)ap->nextw) | WORD_SZB);
222 :     # endif
223 :     #endif
224 :     *(ap->nextw++) = desc;
225 :     res = PTR_CtoML(ap->nextw);
226 :     ap->nextw += nwords;
227 :     END_CRITICAL_SECT(MP_GCGenLock)
228 :     COUNT_ALLOC(msp, WORD_SZB*(nwords + 1));
229 :     }
230 :     else {
231 :     #ifdef ALIGN_REALDS
232 :     /* Force REALD_SZB alignment */
233 :     msp->ml_allocPtr = (ml_val_t *)((Addr_t)(msp->ml_allocPtr) | WORD_SZB);
234 :     #endif
235 :     ML_AllocWrite (msp, 0, desc);
236 :     res = ML_Alloc (msp, nwords);
237 :     }
238 :    
239 :     return res;
240 :    
241 :     } /* end of ML_AllocRaw64 */
242 :    
243 :     /* ML_AllocCode:
244 :     *
245 :     * Allocate an uninitialized ML code object. Assume that len > 1.
246 :     */
247 :     ml_val_t ML_AllocCode (ml_state_t *msp, int len)
248 :     {
249 :     heap_t *heap = msp->ml_heap;
250 :     int allocGen = (heap->numGens < CODE_ALLOC_GEN)
251 :     ? heap->numGens
252 :     : CODE_ALLOC_GEN;
253 :     gen_t *gen = heap->gen[allocGen-1];
254 :     bigobj_desc_t *dp;
255 :    
256 :     BEGIN_CRITICAL_SECT(MP_GCGenLock)
257 :     dp = BO_Alloc (heap, allocGen, len);
258 :     ASSERT(dp->gen == allocGen);
259 :     dp->next = gen->bigObjs[CODE_INDX];
260 :     gen->bigObjs[CODE_INDX] = dp;
261 :     dp->objc = CODE_INDX;
262 :     COUNT_ALLOC(msp, len);
263 :     END_CRITICAL_SECT(MP_GCGenLock)
264 :    
265 :     return PTR_CtoML(dp->obj);
266 :    
267 :     } /* end of ML_AllocCode. */
268 :    
269 :     /* ML_AllocBytearray:
270 :     *
271 :     * Allocate an uninitialized ML bytearray. Assume that len > 0.
272 :     */
273 :     ml_val_t ML_AllocBytearray (ml_state_t *msp, int len)
274 :     {
275 :     int nwords = BYTES_TO_WORDS(len);
276 :     ml_val_t res;
277 :    
278 :     res = ML_AllocRaw32 (msp, nwords);
279 :    
280 :     /* zero the last word to allow fast (word) string comparisons, and to
281 :     * guarantee 0 termination.
282 :     */
283 :     PTR_MLtoC(Word_t, res)[nwords-1] = 0;
284 :    
285 :     SEQHDR_ALLOC (msp, res, DESC_word8arr, res, len);
286 :    
287 :     return res;
288 :    
289 :     } /* end of ML_AllocBytearray. */
290 :    
291 :     /* ML_AllocRealdarray:
292 :     *
293 :     * Allocate an uninitialized ML realarray. Assume that len > 0.
294 :     */
295 :     ml_val_t ML_AllocRealdarray (ml_state_t *msp, int len)
296 :     {
297 :     ml_val_t res;
298 :    
299 :     res = ML_AllocRaw64 (msp, len);
300 :    
301 :     SEQHDR_ALLOC (msp, res, DESC_real64arr, res, len);
302 :    
303 :     return res;
304 :    
305 :     } /* end of ML_AllocRealdarray. */
306 :    
307 :     /* ML_AllocArray:
308 :     *
309 :     * Allocate an ML array using initVal as an initial value. Assume
310 :     * that len > 0.
311 :     */
312 :     ml_val_t ML_AllocArray (ml_state_t *msp, int len, ml_val_t initVal)
313 :     {
314 :     ml_val_t res, *p;
315 :     ml_val_t desc = MAKE_DESC(len, DTAG_arr_data);
316 :     int i;
317 : jhr 1214 Word_t szb;
318 : monnier 249
319 :     if (len > SMALL_OBJ_SZW) {
320 :     arena_t *ap = msp->ml_heap->gen[0]->arena[ARRAY_INDX];
321 :     int gcLevel = (isBOXED(initVal) ? 0 : -1);
322 :    
323 : jhr 1214 szb = WORD_SZB*(len + 1);
324 : monnier 249 BEGIN_CRITICAL_SECT(MP_GCGenLock)
325 : blume 569 #ifdef MP_SUPPORT
326 : monnier 249 checkGC:; /* the MP version jumps to here to recheck for GC */
327 : blume 569 #endif
328 : monnier 249 if (! isACTIVE(ap)
329 : jhr 1214 || (AVAIL_SPACE(ap) <= szb+msp->ml_heap->allocSzB))
330 : monnier 249 gcLevel = 1;
331 :     if (gcLevel >= 0) {
332 :     /* we need to do a GC (and preserve initVal) */
333 :     ml_val_t root = initVal;
334 : jhr 1214 ap->reqSizeB += szb;
335 : monnier 249 RELEASE_LOCK(MP_GCGenLock);
336 :     InvokeGCWithRoots (msp, gcLevel, &root, NIL(ml_val_t *));
337 : jhr 1214 if (ShrinkCheck(ap, szb))
338 :     InvokeGCWithRoots (msp, 1, &root, NIL(ml_val_t *));
339 : monnier 249 initVal = root;
340 :     ACQUIRE_LOCK(MP_GCGenLock);
341 :     #ifdef MP_SUPPORT
342 :     /* check again to insure that we have sufficient space */
343 :     gcLevel = -1;
344 :     goto checkGC;
345 :     #endif
346 :     }
347 :     ASSERT(ap->nextw == ap->sweep_nextw);
348 :     *(ap->nextw++) = desc;
349 :     res = PTR_CtoML(ap->nextw);
350 :     ap->nextw += len;
351 :     ap->sweep_nextw = ap->nextw;
352 :     END_CRITICAL_SECT(MP_GCGenLock)
353 :     COUNT_ALLOC(msp, WORD_SZB*(len + 1));
354 :     }
355 :     else {
356 :     ML_AllocWrite (msp, 0, desc);
357 :     res = ML_Alloc (msp, len);
358 :     }
359 :    
360 :     for (p = PTR_MLtoC(ml_val_t, res), i = 0; i < len; i++)
361 :     *p++ = initVal;
362 :    
363 :     SEQHDR_ALLOC (msp, res, DESC_polyarr, res, len);
364 :    
365 :     return res;
366 :    
367 :     } /* end of ML_AllocArray. */
368 :    
369 :     /* ML_AllocVector:
370 :     *
371 :     * Allocate an ML vector, using the list initVal as an initializer.
372 :     * Assume that len > 0.
373 :     */
374 :     ml_val_t ML_AllocVector (ml_state_t *msp, int len, ml_val_t initVal)
375 :     {
376 :     ml_val_t desc = MAKE_DESC(len, DTAG_vec_data);
377 :     ml_val_t res, *p;
378 :    
379 :     if (len > SMALL_OBJ_SZW) {
380 :     /* Since we want to avoid pointers from the 1st generation record space
381 :     * into the allocation space, we need to do a GC (and preserve initVal)
382 :     */
383 :     arena_t *ap = msp->ml_heap->gen[0]->arena[RECORD_INDX];
384 :     ml_val_t root = initVal;
385 :     int gcLevel = 0;
386 : jhr 1214 Word_t szb;
387 : monnier 249
388 : jhr 1214 szb = WORD_SZB*(len + 1);
389 : monnier 249 BEGIN_CRITICAL_SECT(MP_GCGenLock)
390 :     if (! isACTIVE(ap)
391 : jhr 1214 || (AVAIL_SPACE(ap) <= szb+msp->ml_heap->allocSzB))
392 : monnier 249 gcLevel = 1;
393 : blume 569 #ifdef MP_SUPPORT
394 : monnier 249 checkGC:; /* the MP version jumps to here to redo the GC */
395 : blume 569 #endif
396 : jhr 1214 ap->reqSizeB += szb;
397 : monnier 249 RELEASE_LOCK(MP_GCGenLock);
398 :     InvokeGCWithRoots (msp, gcLevel, &root, NIL(ml_val_t *));
399 : jhr 1214 if (ShrinkCheck(ap, szb))
400 :     InvokeGCWithRoots (msp, 1, &root, NIL(ml_val_t *));
401 : monnier 249 initVal = root;
402 :     ACQUIRE_LOCK(MP_GCGenLock);
403 :     #ifdef MP_SUPPORT
404 :     /* check again to insure that we have sufficient space */
405 : jhr 1214 if (AVAIL_SPACE(ap) <= szb+msp->ml_heap->allocSzB)
406 : monnier 249 goto checkGC;
407 :     #endif
408 :     ASSERT(ap->nextw == ap->sweep_nextw);
409 :     *(ap->nextw++) = desc;
410 :     res = PTR_CtoML(ap->nextw);
411 :     ap->nextw += len;
412 :     ap->sweep_nextw = ap->nextw;
413 :     END_CRITICAL_SECT(MP_GCGenLock)
414 :     COUNT_ALLOC(msp, WORD_SZB*(len + 1));
415 :     }
416 :     else {
417 :     ML_AllocWrite (msp, 0, desc);
418 :     res = ML_Alloc (msp, len);
419 :     }
420 :    
421 :     for (
422 :     p = PTR_MLtoC(ml_val_t, res);
423 :     initVal != LIST_nil;
424 :     initVal = LIST_tl(initVal)
425 :     )
426 :     *p++ = LIST_hd(initVal);
427 :    
428 :     SEQHDR_ALLOC (msp, res, DESC_polyvec, res, len);
429 :    
430 :     return res;
431 :    
432 :     } /* end of ML_AllocVector. */
433 :    
434 :    
435 :     /* ML_SysConst:
436 :     *
437 :     * Find the system constant with the given id in tbl, and allocate a pair
438 :     * to represent it. If the constant is not present, then return the
439 :     * pair (~1, "<UNKNOWN>").
440 :     */
441 :     ml_val_t ML_SysConst (ml_state_t *msp, sysconst_tbl_t *tbl, int id)
442 :     {
443 :     ml_val_t name, res;
444 :     int i;
445 :    
446 :     for (i = 0; i < tbl->numConsts; i++) {
447 :     if (tbl->consts[i].id == id) {
448 :     name = ML_CString (msp, tbl->consts[i].name);
449 :     REC_ALLOC2 (msp, res, INT_CtoML(id), name);
450 :     return res;
451 :     }
452 :     }
453 :     /* here, we did not find the constant */
454 :     name = ML_CString (msp, "<UNKNOWN>");
455 :     REC_ALLOC2 (msp, res, INT_CtoML(-1), name);
456 :     return res;
457 :    
458 :     } /* end of ML_SysConst */
459 :    
460 :    
461 :     /* ML_SysConstList:
462 :     *
463 :     * Generate a list of system constants from the given table.
464 :     */
465 :     ml_val_t ML_SysConstList (ml_state_t *msp, sysconst_tbl_t *tbl)
466 :     {
467 :     int i;
468 :     ml_val_t name, sysConst, list;
469 :    
470 :     /** should check for available heap space !!! **/
471 :     for (list = LIST_nil, i = tbl->numConsts; --i >= 0; ) {
472 :     name = ML_CString (msp, tbl->consts[i].name);
473 :     REC_ALLOC2 (msp, sysConst, INT_CtoML(tbl->consts[i].id), name);
474 :     LIST_cons(msp, list, sysConst, list);
475 :     }
476 :    
477 :     return list;
478 :    
479 :     } /* end of ML_SysConstList */
480 :    
481 :    
482 :     /* ML_CData:
483 :     *
484 : monnier 439 * Allocate a 64-bit aligned raw data object (to store abstract C data).
485 : monnier 249 */
486 :     ml_val_t ML_AllocCData (ml_state_t *msp, int nbytes)
487 :     {
488 :     ml_val_t obj;
489 :    
490 : monnier 439 obj = ML_AllocRaw64 (msp, (nbytes+7)>>2);
491 : monnier 249
492 :     return obj;
493 :    
494 :     } /* end of ML_AllocCData */
495 :    
496 :    
497 :     /* ML_CData:
498 :     *
499 : monnier 439 * Allocate a 64-bit aligned raw data object and initialize it to the given C data.
500 : monnier 249 */
501 :     ml_val_t ML_CData (ml_state_t *msp, void *data, int nbytes)
502 :     {
503 :     ml_val_t obj;
504 :    
505 :     if (nbytes == 0)
506 : monnier 439 return ML_unit;
507 : monnier 249 else {
508 : monnier 439 obj = ML_AllocRaw64 (msp, (nbytes+7)>>2);
509 :     memcpy (PTR_MLtoC(void, obj), data, nbytes);
510 : monnier 249
511 :     return obj;
512 :     }
513 :    
514 :     } /* end of ML_CData */
515 : jhr 1214
516 :    
517 :     /********** Local routines **********/
518 :    
519 :     /* ShrinkCheck:
520 :     *
521 :     * This function checks to see if we need to do another GC to shrink the
522 :     * heap. It is a hack to work around a flaw in the sizing policy that can
523 :     * lead to unbounded heap growth even when the live data is constant.
524 :     */
525 :     PVT bool_t ShrinkCheck (arena_t *ap, Word_t reqSzB)
526 :     {
527 :     if ((ap->tospSizeB > ap->maxSizeB)
528 : jhr 1219 && (USED_SPACE(ap) + 2*reqSzB < ap->tospSizeB)) {
529 : jhr 1214 /* here the arena has grown beyond the soft max, while it would be
530 : jhr 1219 * possible to fit the twice request within the arena, so we force
531 :     * another GC.
532 : jhr 1214 */
533 :     ap->reqSizeB = reqSzB;
534 :     return TRUE;
535 :     }
536 :     else
537 :     return FALSE;
538 :    
539 :     } /* end of ShrinkCheck */

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