1 /* Determination of the object size (in bytes) of the various heap objects. */
2
3 /* -------------------------- Specification ---------------------------- */
4
5 #ifdef TYPECODES
6
7 /* Returns the typecode of the varobject at a given address.
8 typecode_at(addr)
9
10 Because the result of typecode_at may contain symbol flags, any switch
11 statement on such a result must contain 'case_symbolwithflags:' instead of
12 'case_symbol:'. */
13
14 #endif
15
16 /* Computes the size (in bytes, including header and alignment) of the
17 varobject starting at addr. The result is a multiple of varobject_alignment.
18 var uintL heapnr = ...; [only needed if SPVW_PURE]
19 var_prepare_objsize; [declaration of some variable, depends on heapnr]
20 objsize(addr)
21
22 Returns the size (in bytes, including header and alignment) of an object.
23 varobject_bytelength(obj)
24 > obj: heap object of various length
25 < result: number of occupied bytes */
26 global uintM varobject_bytelength (object obj);
27
28 /* -------------------------- Implementation --------------------------- */
29
30 #ifdef TYPECODES
31
32 /* Varobjects contain in the first word a pointer to itself, except during GC.
33 (During GC it's a pointer to the new location, but with the same typecode.) */
34 #define typecode_at(addr) mtypecode(((Varobject)(addr))->GCself)
35 /* or (equivalently):
36 define typecode_at(addr) (((((Varobject)(addr))->header_flags)>>(oint_type_shift%8))&tint_type_mask) */
37
38 #define case_symbolwithflags \
39 case symbol_type: \
40 case symbol_type|bit(var_bit0_t): \
41 case symbol_type|bit(var_bit1_t): \
42 case symbol_type|bit(var_bit1_t)|bit(var_bit0_t)
43
44 #endif
45
46 /* Varobject_aligned_size(HS,ES,C) returns the length of an object of variable
47 length with HS=Header-Size, ES=Element-Size, C=Element-Count.
48 Varobject_aligned_size(HS,ES,C) = round_up(HS+ES*C,varobject_alignment) . */
49 #define Varobject_aligned_size(HS,ES,C) \
50 ((ES % varobject_alignment) == 0 \
51 ? /* ES is divisible by varobject_alignment */ \
52 round_up(HS,varobject_alignment) + (ES)*(C) \
53 : round_up((HS)+(ES)*(C),varobject_alignment)) \
54
55 /* length of an object, according to type: */
56 #ifdef TYPECODES
57 #define size_symbol() /* symbol */ \
58 round_up( sizeof(symbol_), varobject_alignment)
59 #endif
60 #define size_sbvector(length) /* simple-bit-vector */ \
61 ( ceiling( (uintM)(length) + 8*offsetofa(sbvector_,data), \
62 8*varobject_alignment ) * varobject_alignment )
63 #define size_sb2vector(length) /* simple-2bit-vector */ \
64 ( ceiling( (uintL)(length) + 4*offsetofa(sbvector_,data), \
65 4*varobject_alignment ) * varobject_alignment )
66 #define size_sb4vector(length) /* simple-4bit-vector */ \
67 ( ceiling( (uintL)(length) + 2*offsetofa(sbvector_,data), \
68 2*varobject_alignment ) * varobject_alignment )
69 #define size_sb8vector(length) /* simple-8bit-vector */ \
70 Varobject_aligned_size(offsetofa(sbvector_,data),1,(uintL)(length))
71 #define size_sb16vector(length) /* simple-16bit-vector */ \
72 Varobject_aligned_size(offsetofa(sbvector_,data),2,(uintL)(length))
73 #define size_sb32vector(length) /* simple-32bit-vector */ \
74 Varobject_aligned_size(offsetofa(sbvector_,data),4,(uintL)(length))
75 #define size_s8string(length) /* simple-8bit-string */ \
76 Varobject_aligned_size(offsetofa(s8string_,data), \
77 sizeof(cint8),(uintL)(length))
78 #define size_s16string(length) /* simple-16bit-string */ \
79 Varobject_aligned_size(offsetofa(s16string_,data), \
80 sizeof(cint16),(uintL)(length))
81 #define size_s32string(length) /* simple-32bit-string */ \
82 Varobject_aligned_size(offsetofa(s32string_,data), \
83 sizeof(cint32),(uintL)(length))
84 #ifdef ENABLE_UNICODE
85 #define size_sstring(length) /* normal-simple-string */ \
86 size_s32string(length)
87 #else
88 #define size_sstring(length) /* normal-simple-string */ \
89 size_s8string(length)
90 #endif
91 #define size_svector(length) /* simple-vector */ \
92 Varobject_aligned_size(offsetofa(svector_,data), \
93 sizeof(gcv_object_t),(uintM)(uintL)(length))
94 #define size_sistring(xlength) /* simple indirect string */ \
95 Varobject_aligned_size(offsetof(sistring_,data),sizeof(uintB), \
96 sizeof(gcv_object_t)/sizeof(uintB)+(uintL)(xlength))
97 #define size_iarray(size) /* non-simple array, with */ \
98 /* size = dimension number + (1 if fill-pointer) + (1 if displaced-offset) */ \
99 Varobject_aligned_size(offsetofa(iarray_,dims),sizeof(uintL),(uintL)(size))
100 #define size_lrecord(length) /* Long-Record */ \
101 Varobject_aligned_size(offsetofa(record_,recdata), \
102 sizeof(gcv_object_t),(uintL)(length))
103 #define size_srecord(length) /* Simple-Record */ \
104 Varobject_aligned_size(offsetofa(record_,recdata), \
105 sizeof(gcv_object_t),(uintL)(length))
106 #define size_xrecord(length,xlength) /* Extended-Record */ \
107 Varobject_aligned_size(offsetofa(record_,recdata),sizeof(uintB), \
108 (sizeof(gcv_object_t)/sizeof(uintB)) \
109 *(uintL)(length)+(uintL)(xlength))
110 #define size_bignum(length) /* Bignum */ \
111 Varobject_aligned_size(offsetofa(bignum_,data),sizeof(uintD),(uintL)(length))
112 #ifdef TYPECODES
113 #ifndef IMMEDIATE_FFLOAT
114 #define size_ffloat() /* Single-Float */ \
115 round_up( sizeof(ffloat_), varobject_alignment)
116 #endif
117 #define size_dfloat() /* Double-Float */ \
118 round_up( sizeof(dfloat_), varobject_alignment)
119 #else
120 #define size_ffloat() /* Single-Float */ \
121 size_xrecord(0,sizeof(ffloat))
122 #define size_dfloat() /* Double-Float */ \
123 size_xrecord(0,sizeof(dfloat))
124 #endif
125 #define size_lfloat(length) /* Long-Float */ \
126 Varobject_aligned_size(offsetofa(lfloat_,data), \
127 sizeof(uintD),(uintL)(length))
128
129 /* special functions for each type: */
objsize_iarray(void * addr)130 inline local uintM objsize_iarray (void* addr) { /* non-simple array */
131 var uintL size;
132 size = (uintL)iarray_rank((Iarray)addr);
133 if (iarray_flags((Iarray)addr) & bit(arrayflags_fillp_bit))
134 size++;
135 if (iarray_flags((Iarray)addr) & bit(arrayflags_dispoffset_bit))
136 size++;
137 /* size = dimension number + (1 if fill-pointer) + (1 if displaced-offset) */
138 return size_iarray(size);
139 }
140
objsize_s8string(void * addr)141 inline local uintM objsize_s8string (void* addr) { /* mutable S8string */
142 var uintL len = sstring_length((S8string)addr);
143 var uintL size = size_s8string(len);
144 #ifdef HAVE_SMALL_SSTRING
145 /* Some uprounding, for reallocate_small_string to work. */
146 if (size_s8string(1) < size_sistring(0)
147 && size < size_sistring(0) && len > 0)
148 size = size_sistring(0);
149 #endif
150 return size;
151 }
152
objsize_s16string(void * addr)153 inline local uintM objsize_s16string (void* addr) { /* mutable S16string */
154 var uintL len = sstring_length((S16string)addr);
155 var uintL size = size_s16string(len);
156 #ifdef HAVE_SMALL_SSTRING
157 /* Some uprounding, for reallocate_small_string to work. */
158 if (size_s16string(1) < size_sistring(0)
159 && size < size_sistring(0) && len > 0)
160 size = size_sistring(0);
161 #endif
162 return size;
163 }
164
objsize_s32string(void * addr)165 inline local uintM objsize_s32string (void* addr) { /* S32string */
166 return size_s32string(sstring_length((S32string)addr));
167 }
168
objsize_sstring(void * addr)169 inline local uintM objsize_sstring (void* addr) { /* simple-string */
170 #ifdef TYPECODES
171 #ifdef HAVE_SMALL_SSTRING
172 if (sstring_reallocatedp((Sstring)addr)) goto case_sistring;
173 switch ((((Sstring)addr)->tfl >> 3) & 7) {
174 case (Sstringtype_8Bit << 1) + 0: goto case_s8string;
175 case (Sstringtype_8Bit << 1) + 1: goto case_imm_s8string;
176 case (Sstringtype_16Bit << 1) + 0: goto case_s16string;
177 case (Sstringtype_16Bit << 1) + 1: goto case_imm_s16string;
178 case (Sstringtype_32Bit << 1) + 0: goto case_s32string;
179 case (Sstringtype_32Bit << 1) + 1: goto case_s32string;
180 default: /*NOTREACHED*/ abort();
181 }
182 #endif
183 #else
184 switch (record_type((Record)addr)) {
185 #ifdef ENABLE_UNICODE
186 case Rectype_S32string: case Rectype_Imm_S32string:
187 goto case_s32string;
188 #ifdef HAVE_SMALL_SSTRING
189 case Rectype_Imm_S8string:
190 goto case_imm_s8string;
191 case Rectype_S8string:
192 goto case_s8string;
193 case Rectype_Imm_S16string:
194 goto case_imm_s16string;
195 case Rectype_S16string:
196 goto case_s16string;
197 case Rectype_reallocstring:
198 goto case_sistring;
199 #endif
200 #else
201 case Rectype_S8string: case Rectype_Imm_S8string:
202 goto case_s8string;
203 #endif
204 default: /*NOTREACHED*/ abort();
205 }
206 #endif
207 #ifdef ENABLE_UNICODE
208 case_s32string:
209 return size_s32string(sstring_length((S32string)addr));
210 #ifdef HAVE_SMALL_SSTRING
211 case_imm_s8string:
212 return size_s8string(sstring_length((S8string)addr));
213 case_s8string:
214 return objsize_s8string(addr);
215 case_imm_s16string:
216 return size_s16string(sstring_length((S16string)addr));
217 case_s16string:
218 return objsize_s16string(addr);
219 case_sistring:
220 return size_sistring(sstring_length((Sstring)addr));
221 #endif
222 #else
223 case_s8string:
224 return size_s8string(sstring_length((S8string)addr));
225 #endif
226 }
227
228 #ifdef SPVW_MIXED
229
objsize(void * addr)230 local uintM objsize (void* addr) {
231 #ifdef TYPECODES
232 switch (typecode_at(addr) & ~bit(garcol_bit_t)) /* type of the object */
233 #else
234 switch (record_type((Record)addr)) {
235 case_Rectype_Sbvector_above;
236 case_Rectype_Sb2vector_above;
237 case_Rectype_Sb4vector_above;
238 case_Rectype_Sb8vector_above;
239 case_Rectype_Sb16vector_above;
240 case_Rectype_Sb32vector_above;
241 case_Rectype_Svector_above;
242 case_Rectype_mdarray_above;
243 case_Rectype_obvector_above;
244 case_Rectype_ob2vector_above;
245 case_Rectype_ob4vector_above;
246 case_Rectype_ob8vector_above;
247 case_Rectype_ob16vector_above;
248 case_Rectype_ob32vector_above;
249 case_Rectype_ostring_above;
250 case_Rectype_ovector_above;
251 case_Rectype_Bignum_above;
252 case_Rectype_Lfloat_above;
253 #ifdef ENABLE_UNICODE
254 case Rectype_S32string: case Rectype_Imm_S32string:
255 goto case_s32string;
256 #ifdef HAVE_SMALL_SSTRING
257 case Rectype_Imm_S8string:
258 goto case_imm_s8string;
259 case Rectype_S8string:
260 goto case_s8string;
261 case Rectype_Imm_S16string:
262 goto case_imm_s16string;
263 case Rectype_S16string:
264 goto case_s16string;
265 case Rectype_reallocstring:
266 goto case_sistring;
267 #endif
268 #else
269 case Rectype_S8string: case Rectype_Imm_S8string:
270 goto case_s8string;
271 #endif
272 default: goto case_record;
273 }
274 switch (0)
275 #endif
276 {
277 #ifdef TYPECODES
278 case_symbolwithflags: /* Symbol */
279 return size_symbol();
280 #endif
281 case_sbvector: /* simple-bit-vector */
282 return size_sbvector(sbvector_length((Sbvector)addr));
283 case_sb2vector: /* simple-2bit-vector */
284 return size_sb2vector(sbvector_length((Sbvector)addr));
285 case_sb4vector: /* simple-4bit-vector */
286 return size_sb4vector(sbvector_length((Sbvector)addr));
287 case_sb8vector: /* simple-8bit-vector */
288 return size_sb8vector(sbvector_length((Sbvector)addr));
289 case_sb16vector: /* simple-16bit-vector */
290 return size_sb16vector(sbvector_length((Sbvector)addr));
291 case_sb32vector: /* simple-32bit-vector */
292 return size_sb32vector(sbvector_length((Sbvector)addr));
293 #ifdef TYPECODES
294 case_sstring: /* normal-simple-string */
295 #ifdef HAVE_SMALL_SSTRING
296 if (sstring_reallocatedp((Sstring)addr)) goto case_sistring;
297 switch ((((Sstring)addr)->tfl >> 3) & 7) {
298 case (Sstringtype_8Bit << 1) + 0: goto case_s8string;
299 case (Sstringtype_8Bit << 1) + 1: goto case_imm_s8string;
300 case (Sstringtype_16Bit << 1) + 0: goto case_s16string;
301 case (Sstringtype_16Bit << 1) + 1: goto case_imm_s16string;
302 case (Sstringtype_32Bit << 1) + 0: goto case_s32string;
303 case (Sstringtype_32Bit << 1) + 1: goto case_s32string;
304 default: /*NOTREACHED*/ abort();
305 }
306 #endif
307 #endif
308 /*FALLTHROUGH*/
309 #ifdef ENABLE_UNICODE
310 case_s32string:
311 return size_s32string(sstring_length((S32string)addr));
312 #ifdef HAVE_SMALL_SSTRING
313 case_imm_s8string:
314 return size_s8string(sstring_length((S8string)addr));
315 case_s8string:
316 return objsize_s8string(addr);
317 case_imm_s16string:
318 return size_s16string(sstring_length((S16string)addr));
319 case_s16string:
320 return objsize_s16string(addr);
321 case_sistring:
322 return size_sistring(sstring_length((Sstring)addr));
323 #endif
324 #else
325 case_s8string:
326 return size_s8string(sstring_length((S8string)addr));
327 #endif
328 case_svector: /* simple-vector */
329 return size_svector(svector_length((Svector)addr));
330 case_mdarray: case_obvector: case_ob2vector: case_ob4vector:
331 case_ob8vector: case_ob16vector: case_ob32vector: case_ostring:
332 case_ovector: /* non-simple array */
333 return objsize_iarray(addr);
334 case_record: /* Record */
335 if (record_type((Record)addr) < rectype_longlimit) {
336 if (record_type((Record)addr) < rectype_limit)
337 return size_srecord(srecord_length((Srecord)addr));
338 else
339 return size_xrecord(xrecord_length((Xrecord)addr),
340 xrecord_xlength((Xrecord)addr));
341 } else
342 return size_lrecord(lrecord_length((Lrecord)addr));
343 case_bignum: /* Bignum */
344 return size_bignum(bignum_length((Bignum)addr));
345 #ifdef TYPECODES
346 #ifndef IMMEDIATE_FFLOAT
347 case_ffloat: /* Single-Float */
348 return size_ffloat();
349 #endif
350 case_dfloat: /* Double-Float */
351 return size_dfloat();
352 #endif
353 case_lfloat: /* Long-Float */
354 return size_lfloat(lfloat_length((Lfloat)addr));
355 #ifdef TYPECODES
356 case_machine:
357 #ifndef SIXBIT_TYPECODES
358 case_char:
359 case_subr:
360 case_system:
361 #endif
362 case_fixnum:
363 case_sfloat:
364 #ifdef IMMEDIATE_FFLOAT
365 case_ffloat:
366 #endif
367 /* these are direct objects, no pointers. */
368 #endif
369 default: /* these are no objects of variable length. */
370 /*NOTREACHED*/ abort();
371 }
372 }
373
374 #define var_prepare_objsize
375
376 #endif /* SPVW_MIXED */
377
378 #ifdef SPVW_PURE
379
objsize_symbol(void * addr)380 inline local uintM objsize_symbol (void* addr) { /* Symbol */
381 return size_symbol();
382 }
objsize_sbvector(void * addr)383 inline local uintM objsize_sbvector (void* addr) { /* simple-bit-vector */
384 return size_sbvector(sbvector_length((Sbvector)addr));
385 }
objsize_sb2vector(void * addr)386 inline local uintM objsize_sb2vector (void* addr) { /* simple-2bit-vector */
387 return size_sb2vector(sbvector_length((Sbvector)addr));
388 }
objsize_sb4vector(void * addr)389 inline local uintM objsize_sb4vector (void* addr) { /* simple-4bit-vector */
390 return size_sb4vector(sbvector_length((Sbvector)addr));
391 }
objsize_sb8vector(void * addr)392 inline local uintM objsize_sb8vector (void* addr) { /* simple-8bit-vector */
393 return size_sb8vector(sbvector_length((Sbvector)addr));
394 }
objsize_sb16vector(void * addr)395 inline local uintM objsize_sb16vector (void* addr) { /* simple-16bit-vector */
396 return size_sb16vector(sbvector_length((Sbvector)addr));
397 }
objsize_sb32vector(void * addr)398 inline local uintM objsize_sb32vector (void* addr) { /* simple-32bit-vector */
399 return size_sb32vector(sbvector_length((Sbvector)addr));
400 }
objsize_svector(void * addr)401 inline local uintM objsize_svector (void* addr) { /* simple-vector */
402 return size_svector(svector_length((Svector)addr));
403 }
objsize_sxrecord(void * addr)404 inline local uintM objsize_sxrecord (void* addr) { /* Record */
405 if (record_type((Record)addr) < rectype_limit)
406 return size_srecord(srecord_length((Srecord)addr));
407 else
408 return size_xrecord(xrecord_length((Xrecord)addr),
409 xrecord_xlength((Xrecord)addr));
410 }
objsize_lrecord(void * addr)411 inline local uintM objsize_lrecord (void* addr) { /* Lrecord */
412 return size_lrecord(lrecord_length((Lrecord)addr));
413 }
objsize_bignum(void * addr)414 inline local uintM objsize_bignum (void* addr) { /* Bignum */
415 return size_bignum(bignum_length((Bignum)addr));
416 }
417 #ifndef IMMEDIATE_FFLOAT
objsize_ffloat(void * addr)418 inline local uintM objsize_ffloat (void* addr) { /* Single-Float */
419 return size_ffloat();
420 }
421 #endif
objsize_dfloat(void * addr)422 inline local uintM objsize_dfloat (void* addr) { /* Double-Float */
423 return size_dfloat();
424 }
objsize_lfloat(void * addr)425 inline local uintM objsize_lfloat (void* addr) { /* Long-Float */
426 return size_lfloat(lfloat_length((Lfloat)addr));
427 }
428
429 /* table of functions: */
430 typedef uintM (*objsize_func_t) (void* addr);
431 local objsize_func_t objsize_table[heapcount];
432
init_objsize_table(void)433 local void init_objsize_table (void) {
434 var uintL heapnr;
435 for (heapnr=0; heapnr<heapcount; heapnr++) {
436 switch (heapnr) {
437 case_symbol:
438 objsize_table[heapnr] = &objsize_symbol; break;
439 case_sbvector:
440 objsize_table[heapnr] = &objsize_sbvector; break;
441 case_sb2vector:
442 objsize_table[heapnr] = &objsize_sb2vector; break;
443 case_sb4vector:
444 objsize_table[heapnr] = &objsize_sb4vector; break;
445 case_sb8vector:
446 objsize_table[heapnr] = &objsize_sb8vector; break;
447 case_sb16vector:
448 objsize_table[heapnr] = &objsize_sb16vector; break;
449 case_sb32vector:
450 objsize_table[heapnr] = &objsize_sb32vector; break;
451 case_sstring:
452 objsize_table[heapnr] = &objsize_sstring; break;
453 case_svector:
454 objsize_table[heapnr] = &objsize_svector; break;
455 case_mdarray: case_obvector: case_ob2vector: case_ob4vector:
456 case_ob8vector: case_ob16vector: case_ob32vector: case_ostring:
457 case_ovector:
458 objsize_table[heapnr] = &objsize_iarray; break;
459 case_sxrecord:
460 objsize_table[heapnr] = &objsize_sxrecord; break;
461 case_lrecord:
462 objsize_table[heapnr] = &objsize_lrecord; break;
463 case_bignum:
464 objsize_table[heapnr] = &objsize_bignum; break;
465 #ifndef IMMEDIATE_FFLOAT
466 case_ffloat:
467 objsize_table[heapnr] = &objsize_ffloat; break;
468 #endif
469 case_dfloat:
470 objsize_table[heapnr] = &objsize_dfloat; break;
471 case_lfloat:
472 objsize_table[heapnr] = &objsize_lfloat; break;
473 case_machine:
474 case_char:
475 case_subr:
476 case_system:
477 case_fixnum:
478 case_sfloat:
479 #ifdef IMMEDIATE_FFLOAT
480 case_ffloat:
481 #endif
482 /* these are direct objects, not pointers. */
483 /* case_ratio: */
484 /* case_complex: */
485 default:
486 /* these are no objects of variable length. */
487 objsize_table[heapnr] = (objsize_func_t)&abort; break;
488 }
489 }
490 }
491
492 #define var_prepare_objsize \
493 var objsize_func_t _objsize_func = objsize_table[heapnr];
494 #define objsize(addr) (*_objsize_func)(addr)
495
496 #endif /* SPVW_PURE */
497
varobject_bytelength(object obj)498 global uintM varobject_bytelength (object obj) {
499 #ifdef SPVW_PURE
500 var uintL heapnr = typecode(obj);
501 #endif
502 var_prepare_objsize;
503 return objsize(TheVarobject(obj));
504 }
505