diff --git a/mlton/backend/backend.fun b/mlton/backend/backend.fun index b1cd64e23..dc718b143 100644 --- a/mlton/backend/backend.fun +++ b/mlton/backend/backend.fun @@ -373,14 +373,14 @@ fun toMachine (rssa: Rssa.Program.t) = ({offset = offset, src = src}, hasDynamic' orelse hasDynamic) end) - fun translateObject obj = + fun translateObject (obj, {forceDynamic}) = case obj of R.Object.Normal {init, tycon} => let val {components, ...} = ObjectType.deNormal (tyconTy tycon) val (init, hasDynamic) = translateInit init val kind = - if hasDynamic + if forceDynamic orelse hasDynamic then Kind.Dynamic else if Prod.someIsMutable components then if Vector.exists (Prod.dest components, @@ -414,7 +414,7 @@ fun toMachine (rssa: Rssa.Program.t) = (init, hasDynamic' orelse hasDynamic) end) val kind = - if hasDynamic + if forceDynamic orelse hasDynamic then Kind.Dynamic else if hasIdentity then if Vector.isEmpty init @@ -448,10 +448,10 @@ fun toMachine (rssa: Rssa.Program.t) = nextIndex = Counter.generator 0, nextOffset = ref Bytes.zero}) - fun add obj = + fun add (obj, forceDynamic) = let val {kind, obj, offset, size, tycon} = - translateObject obj + translateObject (obj, forceDynamic) val {objs, nextIndex, nextOffset} = kindAcc kind val r = Ref.T {index = nextIndex (), kind = kind, @@ -481,7 +481,7 @@ fun toMachine (rssa: Rssa.Program.t) = val () = Vector.foreach (statics, fn {dst = (dstVar, dstTy), obj} => let - val oper = addToStaticHeaps obj + val oper = addToStaticHeaps (obj, {forceDynamic = true}) in setVarInfo (dstVar, {operand = VarOperand.Const oper, ty = dstTy}) end) @@ -519,7 +519,10 @@ fun toMachine (rssa: Rssa.Program.t) = val globalWordVector = make {equals = WordXVector.equals, hash = WordXVector.hash, - oper = addToStaticHeaps o R.Object.fromWordXVector} + oper = (fn wxv => + addToStaticHeaps + (R.Object.fromWordXVector wxv, + {forceDynamic = true}))} end fun constOperand (c: Const.t): M.Operand.t = let diff --git a/mlton/backend/rssa-simplify.fun b/mlton/backend/rssa-simplify.fun index db0969fde..c68e90a30 100644 --- a/mlton/backend/rssa-simplify.fun +++ b/mlton/backend/rssa-simplify.fun @@ -23,10 +23,10 @@ val rssaPasses = execute = true} :: {name = "collectStatics.Globals", doit = CollectStatics.Globals.transform, - execute = true} :: + execute = false} :: {name = "collectStatics.RealConsts", doit = CollectStatics.RealConsts.transform, - execute = true} :: + execute = false} :: {name = "insertLimitChecks", doit = LimitCheck.transform, execute = true} :: {name = "insertSignalChecks", doit = SignalCheck.transform, execute = true} :: (* must be before implementHandlers *) diff --git a/runtime/gc/init-world.c b/runtime/gc/init-world.c index 2297881b9..25f50ee29 100644 --- a/runtime/gc/init-world.c +++ b/runtime/gc/init-world.c @@ -22,123 +22,104 @@ size_t sizeofInitialBytesLive (GC_state s) { } void initDynHeap(GC_state s, GC_thread thread) { + assert(0 == thread->currentDepth); + + HM_chunk currentChunk; + pointer frontier, limit; + pointer start = s->staticHeaps.dynamic.start; + pointer end = start + s->staticHeaps.dynamic.size; + pointer p = start; + size_t metaDataSize = 0, objectSize = 0; + + // While there are segments of the initial dynamic heap to be copied + // into the root hierarchical heap. + while (1) { + currentChunk = thread->currentChunk; + frontier = HM_getChunkFrontier(currentChunk); + assert(isFrontierAligned(s, frontier)); + limit = HM_getChunkLimit(currentChunk); + assert(frontier <= limit); + + // Find the end of this segement of the initial dynamic heap to + // copy into the current chunk of the root hierarchical heap. + // `start` is the start of the segment. + // `p` is the candidate end of segment. + while (1) { + if (p >= end) { + // This segment is the last to be copied. + break; + } + pointer q = advanceToObjectData (s, p); +#if ASSERT + GC_header header = getHeader (q); + assert (header == GC_REAL32_VECTOR_HEADER + || header == GC_REAL64_VECTOR_HEADER + || header == GC_WORD8_VECTOR_HEADER + || header == GC_WORD16_VECTOR_HEADER + || header == GC_WORD32_VECTOR_HEADER + || header == GC_WORD64_VECTOR_HEADER); +#endif + sizeofObjectAux (s, q, &metaDataSize, &objectSize); + pointer r = q + objectSize; + if (!inFirstBlockOfChunk(currentChunk, frontier + (q - start)) + || frontier + (r - start) > limit) { + // Next object does not fit into current chunk. + break; + } + // Next object fits into current chunk; advance `p`. + p = r; + } + + // Copy segment `[start,p)` into current segment. + memcpy (frontier, start, p - start); + // Adjust global objptrs that referenced an object in the segment. + for (uint32_t i = 0; i < s->globalsLength; i++) { + pointer g = objptrToPointer(s->globals[i], NULL); + if (start <= g && g < p) { + g = (g - start) + frontier; + s->globals[i] = pointerToObjptr(g, NULL); + } + } + // Advance frontier. + frontier += p - start; + HM_updateChunkValues(currentChunk, frontier); + + if (p >= end) { + // This segment was the last to be copied. + break; + } + + // Initialize search for next segment. + start = p; + // `p` points to the beginning of an object that did not fit in + // the last chunk; extend hierarchical heap with a chunk + // sufficient to hold the next object. + if (!HM_HH_extend(s, thread, metaDataSize + objectSize)) { + DIE("Ran out of space for Hierarchical Heap!"); + } + } + + /* If the last allocation passed a block boundary, we need to extend to have + * a valid frontier. Extending with GC_HEAP_LIMIT_SLOP is arbitrary. */ + if (!inFirstBlockOfChunk(currentChunk, frontier + GC_SEQUENCE_METADATA_SIZE)) { + if (!HM_HH_extend(s, thread, GC_HEAP_LIMIT_SLOP)) { + DIE("Ran out of space for Hierarchical Heap!"); + } + currentChunk = thread->currentChunk; + frontier = HM_getChunkFrontier(currentChunk); + assert(isFrontierAligned(s, frontier)); + limit = HM_getChunkLimit(currentChunk); + assert(frontier <= limit); + } + + s->frontier = frontier; + s->limitPlusSlop = limit; + s->limit = s->limitPlusSlop - GC_HEAP_LIMIT_SLOP; + assert(isFrontierAligned(s, s->frontier)); + assert(inFirstBlockOfChunk(currentChunk, s->frontier + GC_SEQUENCE_METADATA_SIZE)); } -/* void initVectors(GC_state s, GC_thread thread) { */ -/* struct GC_vectorInit *inits; */ -/* HM_chunk currentChunk; */ -/* pointer frontier; */ -/* pointer limit; */ -/* uint32_t i; */ - -/* assert(isFrontierAligned(s, s->frontier)); */ -/* inits = s->vectorInits; */ -/* frontier = s->frontier; */ -/* limit = s->limitPlusSlop; */ - -/* currentChunk = HM_getChunkOf(frontier); */ -/* assert(currentChunk == thread->currentChunk); */ -/* assert(0 == thread->currentDepth); */ - -/* for (i = 0; i < s->vectorInitsLength; i++) { */ -/* size_t elementSize; */ -/* size_t dataBytes; */ -/* size_t objectSize; */ -/* uint32_t typeIndex; */ - -/* elementSize = inits[i].elementSize; */ -/* dataBytes = elementSize * inits[i].length; */ -/* objectSize = align(GC_SEQUENCE_METADATA_SIZE + dataBytes, s->alignment); */ - -/* #if ASSERT */ -/* assert(limit == HM_getChunkLimit(currentChunk)); */ -/* assert(frontier >= HM_getChunkFrontier(currentChunk)); */ -/* assert(frontier <= limit); */ -/* #endif */ - -/* /\* Extend with a new chunk, if there is not enough free space or if we have */ -/* * crossed a block boundary. *\/ */ -/* if ((size_t)(limit - frontier) < objectSize || */ -/* !inFirstBlockOfChunk(currentChunk, frontier + GC_SEQUENCE_METADATA_SIZE)) */ -/* { */ -/* HM_HH_updateValues(thread, frontier); */ -/* if (!HM_HH_extend(s, thread, objectSize)) { */ -/* DIE("Ran out of space for Hierarchical Heap!"); */ -/* } */ -/* s->frontier = HM_HH_getFrontier(thread); */ -/* s->limitPlusSlop = HM_HH_getLimit(thread); */ -/* s->limit = s->limitPlusSlop - GC_HEAP_LIMIT_SLOP; */ - -/* frontier = s->frontier; */ -/* limit = s->limitPlusSlop; */ - -/* currentChunk = HM_getChunkOf(frontier); */ -/* assert(currentChunk == thread->currentChunk); */ -/* } */ - -/* assert(isFrontierAligned(s, frontier)); */ -/* assert((size_t)(limit - frontier) >= objectSize); */ -/* assert(inFirstBlockOfChunk(currentChunk, frontier + GC_SEQUENCE_METADATA_SIZE)); */ - -/* *((GC_sequenceCounter*)(frontier)) = 0; */ -/* frontier = frontier + GC_SEQUENCE_COUNTER_SIZE; */ -/* *((GC_sequenceLength*)(frontier)) = inits[i].length; */ -/* frontier = frontier + GC_SEQUENCE_LENGTH_SIZE; */ -/* switch (elementSize) { */ -/* case 1: */ -/* typeIndex = WORD8_VECTOR_TYPE_INDEX; */ -/* break; */ -/* case 2: */ -/* typeIndex = WORD16_VECTOR_TYPE_INDEX; */ -/* break; */ -/* case 4: */ -/* typeIndex = WORD32_VECTOR_TYPE_INDEX; */ -/* break; */ -/* case 8: */ -/* typeIndex = WORD64_VECTOR_TYPE_INDEX; */ -/* break; */ -/* default: */ -/* die ("unknown element size in vectorInit: %"PRIuMAX"", */ -/* (uintmax_t)elementSize); */ -/* } */ -/* *((GC_header*)(frontier)) = buildHeaderFromTypeIndex (typeIndex); */ -/* frontier = frontier + GC_HEADER_SIZE; */ -/* // *((objptr*)(frontier)) = BOGUS_OBJPTR; */ -/* // frontier = frontier + OBJPTR_SIZE; */ -/* s->globals[inits[i].globalIndex] = pointerToObjptr(frontier, NULL); */ -/* if (DEBUG_DETAILED) */ -/* fprintf (stderr, "allocated vector at "FMTPTR"\n", */ -/* (uintptr_t)(s->globals[inits[i].globalIndex])); */ -/* memcpy (frontier, inits[i].words, dataBytes); */ -/* frontier += objectSize - GC_SEQUENCE_METADATA_SIZE; */ -/* } */ - -/* s->frontier = frontier; */ - -/* /\* If the last allocation passed a block boundary, we need to extend to have */ -/* * a valid frontier. Extending with GC_HEAP_LIMIT_SLOP is arbitrary. *\/ */ -/* if (!inFirstBlockOfChunk(currentChunk, frontier + GC_SEQUENCE_METADATA_SIZE)) */ -/* { */ -/* HM_HH_updateValues(thread, frontier); */ -/* if (!HM_HH_extend(s, thread, GC_HEAP_LIMIT_SLOP)) { */ -/* DIE("Ran out of space for Hierarchical Heap!"); */ -/* } */ -/* s->frontier = HM_HH_getFrontier(thread); */ -/* s->limitPlusSlop = HM_HH_getLimit(thread); */ -/* s->limit = s->limitPlusSlop - GC_HEAP_LIMIT_SLOP; */ - -/* frontier = s->frontier; */ -/* limit = s->limitPlusSlop; */ - -/* currentChunk = HM_getChunkOf(frontier); */ -/* assert(currentChunk == thread->currentChunk); */ -/* } */ - -/* assert(isFrontierAligned(s, s->frontier)); */ -/* assert(inFirstBlockOfChunk(currentChunk, s->frontier + GC_SEQUENCE_METADATA_SIZE)); */ -/* } */ - GC_thread initThreadAndHeap(GC_state s, uint32_t depth) { GC_thread thread = newThreadWithHeap(s, sizeofStackInitialReserved(s), depth);