diff --git a/mps/src/fmthe.c b/mps/src/fmthe.c index 4bffe3884d8..f3aa1c8c4c4 100644 --- a/mps/src/fmthe.c +++ b/mps/src/fmthe.c @@ -1,7 +1,7 @@ /* impl.c.fmthe: DYLAN-LIKE OBJECT FORMAT WITH HEADERS * - * $HopeName: !fmthe.c(trunk.1) $ - * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * $Id$ + * Copyright (c) 2001 Ravenbrook Limited. * * .source: This was derived from impl.c.fmtdy -- it's probably a good idea to * keep them in sync and share improvements. @@ -164,7 +164,7 @@ static int dylan_wrapper_check(mps_word_t *w) /* size. This assumes that DylanWorks is only going to use byte */ /* vectors in the non-word case. */ - /* Variable part format 6 is reserved. */ + /* Variable part format 6 is reserved. */ assert(vf != 6); /* There should be no shift in word vector formats. */ @@ -221,6 +221,79 @@ static mps_res_t dylan_scan_contig(mps_ss_t mps_ss, return MPS_RES_OK; } +/* dylan_weak_dependent -- returns the linked object, if any. + */ + +extern mps_addr_t dylan_weak_dependent(mps_addr_t parent) +{ + mps_word_t *object; + mps_word_t *wrapper; + mps_word_t fword; + mps_word_t fl; + mps_word_t ff; + + assert(parent != NULL); + object = (mps_word_t *)parent; + wrapper = (mps_word_t *)object[0]; + assert(dylan_wrapper_check(wrapper)); + fword = wrapper[3]; + ff = fword & 3; + /* traceable fixed part */ + assert(ff == 1); + fl = fword & ~3uL; + /* at least one fixed field */ + assert(fl >= 1); + return (mps_addr_t) object[1]; +} + + +/* Scan weakly a contiguous array of references in [base, limit). */ +/* Only required to scan vectors for Dylan Weak Tables. */ +/* Depends on the vector length field being scannable (ie a tagged */ +/* integer). */ +/* When a reference that has been fixed to NULL is detected the */ +/* corresponding reference in the associated table (pointed to be the */ +/* assoc variable) will be deleted. */ + +static mps_res_t +dylan_scan_contig_weak(mps_ss_t mps_ss, + mps_addr_t *base, mps_addr_t *limit, + mps_addr_t *objectBase, mps_addr_t *assoc) +{ + mps_addr_t *p; + mps_res_t res; + mps_addr_t r; + + MPS_SCAN_BEGIN(mps_ss) { + p = base; + goto skip_inc; + loop: + ++p; + skip_inc: + if(p >= limit) + goto out; + r = *p; + if(((mps_word_t)r & 3) != 0) /* non-pointer */ + goto loop; + if(!MPS_FIX1(mps_ss, r)) + goto loop; + res = MPS_FIX2(mps_ss, p); + if(res == MPS_RES_OK) { + if(*p == 0 && r != 0) { + if(assoc != NULL) { + assoc[p-objectBase] = 0; /* delete corresponding entry */ + } + } + goto loop; + } + return res; + out: + assert(p == limit); + } MPS_SCAN_END(mps_ss); + + return MPS_RES_OK; +} + /* dylan_scan_pat -- scan according to pattern * @@ -293,21 +366,23 @@ static mps_res_t dylan_scan1(mps_ss_t mps_ss, mps_addr_t *object_io) unsigned es; /* variable part element size (log2 of bits) */ mps_word_t vt; /* total vector length */ mps_res_t res; - int* header; + int header; assert(object_io != NULL); p = (mps_addr_t *)*object_io; assert(p != NULL); - header = (int*)((char*)p - headerSIZE); - if (*header != realTYPE) { - switch (*header) { - case pad1TYPE: *object_io = (mps_addr_t)((char*)p + 4); break; - case pad2TYPE: *object_io = (mps_addr_t)((char*)p + 8); break; - default: notreached(); break; - } - return MPS_RES_OK; + header = *(int*)((char*)p - headerSIZE); + switch(headerType(header)) { + case realTYPE: + break; + case padTYPE: + *object_io = (mps_addr_t)((char*)p + headerPadSize(header)); + return MPS_RES_OK; + default: + notreached(); + break; } h = (mps_word_t)p[0]; /* load the header word */ @@ -453,6 +528,97 @@ static mps_res_t dylan_scan(mps_ss_t mps_ss, } +static mps_res_t dylan_scan1_weak(mps_ss_t mps_ss, mps_addr_t *object_io) +{ + mps_addr_t *assoc; + mps_addr_t *base; + mps_addr_t *p, q; + mps_res_t res; + mps_word_t *w; + mps_word_t fword, ff, fl; + mps_word_t h; + mps_word_t vword, vf, vl; + int header; + + assert(object_io != NULL); + base = (mps_addr_t *)*object_io; + assert(base != NULL); + p = base; + + header = *(int*)((char*)p - headerSIZE); + switch(headerType(header)) { + case realTYPE: + break; + case padTYPE: + *object_io = (mps_addr_t)((char*)p + headerPadSize(header)); + return MPS_RES_OK; + default: + notreached(); + break; + } + + h = (mps_word_t)p[0]; + /* object should not be forwarded (as there is no forwarding method) */ + assert((h & 3) == 0); + + mps_fix(mps_ss, p); + + /* w points to wrapper */ + w = (mps_word_t *)p[0]; + + assert(dylan_wrapper_check(w)); + + ++p; /* skip header */ + + fword = w[WF]; + fl = fword >> 2; + /* weak vectors should have at least one fixed field */ + /* (for assoc field) */ + assert(fl >= 1); + + ff = fword & 3; + + /* weak vectors should have traceable fixed format */ + assert(ff == 1); + + assoc = (mps_addr_t *)p[0]; + + vword = w[WV]; + vf = vword & 7; + vl = (mps_word_t)p[fl] >> 2; + + /* weak vectors should be non-stretchy traceable */ + assert(vf == 2); + + /* q is end of the object. There are fl fixed fields, vl variable */ + /* fields and another slot that contains the vector length */ + q = p + fl + vl + 1; + + res = dylan_scan_contig_weak(mps_ss, p, q, base, assoc); + if(res != MPS_RES_OK) { + return res; + } + + *object_io = AddHeader(q); + return MPS_RES_OK; +} + + +static mps_res_t dylan_scan_weak(mps_ss_t mps_ss, + mps_addr_t base, mps_addr_t limit) +{ + mps_res_t res; + + while(base < limit) { + res = dylan_scan1_weak(mps_ss, &base); + if(res) return res; + } + + assert(base <= AddHeader(limit)); + + return MPS_RES_OK; +} + static mps_addr_t dylan_skip(mps_addr_t object) { mps_addr_t *p; /* cursor in object */ @@ -463,18 +629,20 @@ static mps_addr_t dylan_skip(mps_addr_t object) mps_word_t vt; /* total vector length */ unsigned vb; /* vector bias */ unsigned es; /* variable part element size (log2 of bits) */ - int* header; + int header; p = (mps_addr_t *)object; assert(p != NULL); - header = (int*)((char*)object - headerSIZE); - if (*header != realTYPE) { - switch (*header) { - case pad1TYPE: return (mps_addr_t)((char*)object + 4); break; - case pad2TYPE: return (mps_addr_t)((char*)object + 8); break; - default: assert(0 == 1); break; - } + header = *(int*)((char*)object - headerSIZE); + switch(headerType(header)) { + case realTYPE: + break; + case padTYPE: + return (mps_addr_t)((char*)object + headerPadSize(header)); + default: + notreached(); + break; } h = (mps_word_t)p[0]; /* load the header word */ @@ -524,12 +692,11 @@ static mps_addr_t dylan_skip(mps_addr_t object) static mps_addr_t dylan_isfwd(mps_addr_t object) { mps_word_t h, tag; - int *header; + int header; - header = (int*)((char*)object - headerSIZE); - if (*header != realTYPE) { + header = *(int*)((char*)object - headerSIZE); + if (headerType(header) != realTYPE) return NULL; - } h = *(mps_word_t *)object; tag = h & 3; @@ -561,25 +728,29 @@ static void dylan_fwd(mps_addr_t old, mps_addr_t new) static void dylan_pad(mps_addr_t addr, size_t fullSize) { - mps_word_t *p; - size_t size; - - p = (mps_word_t *)AddHeader(addr); - size = fullSize - headerSIZE; - if (fullSize <= headerSIZE) { - *(int*)addr = (fullSize == 4) ? pad1TYPE : pad2TYPE; - } else { - *(int*)addr = realTYPE; - if(size == sizeof(mps_word_t)) /* single-word object? */ - p[0] = 1; - else { - p[0] = 2; - p[1] = (mps_word_t)AddHeader((char *)addr + fullSize); - } - } + *(int*)addr = padHeader(fullSize); } +static mps_addr_t dylan_no_isfwd(mps_addr_t object) +{ + unused(object); + notreached(); + return 0; +} + +static void dylan_no_fwd(mps_addr_t old, mps_addr_t new) +{ + unused(old); unused(new); + notreached(); +} + +static void dylan_no_pad(mps_addr_t addr, size_t size) +{ + unused(addr); unused(size); + notreached(); +} + /* HeaderFormat -- format descriptor for this format */ static struct mps_fmt_auto_header_s HeaderFormat = @@ -594,6 +765,20 @@ static struct mps_fmt_auto_header_s HeaderFormat = }; +/* HeaderWeakFormat -- format descriptor for this format */ + +static struct mps_fmt_auto_header_s HeaderWeakFormat = +{ + ALIGN, + dylan_scan_weak, + dylan_skip, + dylan_no_fwd, + dylan_no_isfwd, + dylan_no_pad, + (size_t)headerSIZE +}; + + /* EnsureHeaderFormat -- create a format object for this format */ mps_res_t EnsureHeaderFormat(mps_fmt_t *mps_fmt_o, mps_arena_t arena) @@ -602,6 +787,14 @@ mps_res_t EnsureHeaderFormat(mps_fmt_t *mps_fmt_o, mps_arena_t arena) } +/* EnsureHeaderWeakFormat -- create a format object for the weak format */ + +mps_res_t EnsureHeaderWeakFormat(mps_fmt_t *mps_fmt_o, mps_arena_t arena) +{ + return mps_fmt_create_auto_header(mps_fmt_o, arena, &HeaderWeakFormat); +} + + /* HeaderFormatCheck -- check an object in this format */ mps_res_t HeaderFormatCheck(mps_addr_t addr) @@ -612,3 +805,14 @@ mps_res_t HeaderFormatCheck(mps_addr_t addr) else return MPS_RES_FAIL; } + +/* HeaderWeakFormatCheck -- check an object in this format */ + +mps_res_t HeaderWeakFormatCheck(mps_addr_t addr) +{ + if (addr != 0 && ((mps_word_t)addr & (ALIGN-1)) == 0 + && dylan_wrapper_check((mps_word_t *)((mps_word_t *)addr)[0])) + return MPS_RES_OK; + else + return MPS_RES_FAIL; +} diff --git a/mps/src/fmthe.h b/mps/src/fmthe.h index dfd3f91bbb8..0445f34d098 100644 --- a/mps/src/fmthe.h +++ b/mps/src/fmthe.h @@ -1,7 +1,7 @@ /* impl.h.fmthe: DYLAN-LIKE OBJECT FORMAT WITH HEADERS * - * $HopeName: !fmthe.h(trunk.1) $ - * Copyright (C) 2000 Harlequin Limited. All rights reserved. + * $Id$ + * Copyright (c) 2001 Ravenbrook Limited. */ #ifndef fmthe_h @@ -10,10 +10,14 @@ #include "mps.h" -/* Format */ +/* Formats */ extern mps_res_t EnsureHeaderFormat(mps_fmt_t *, mps_arena_t); +extern mps_res_t EnsureHeaderWeakFormat(mps_fmt_t *, mps_arena_t); extern mps_res_t HeaderFormatCheck(mps_addr_t addr); +extern mps_res_t HeaderWeakFormatCheck(mps_addr_t addr); +/* dependent object function for weak pool */ +extern mps_addr_t dylan_weak_dependent(mps_addr_t); /* Constants describing wrappers. Used only for debugging / testing */ #define WW 0 /* offset of Wrapper-Wrapper */ @@ -29,10 +33,13 @@ extern mps_res_t HeaderFormatCheck(mps_addr_t addr); #define ALIGN sizeof(mps_word_t) /* alignment for Dylan format */ -#define headerSIZE (8) +#define headerSIZE (32) +#define headerTypeBits 1 #define realTYPE 0 -#define pad1TYPE 1 -#define pad2TYPE 2 - +#define realHeader realTYPE +#define padTYPE 1 +#define headerType(header) ((header) & ((1 << headerTypeBits) - 1)) +#define headerPadSize(header) ((header) >> headerTypeBits) +#define padHeader(size) ((size << headerTypeBits) | padTYPE) #endif /* fmthe_h */