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

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