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

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