diff --git a/mlton/backend/allocate-variables.fun b/mlton/backend/allocate-variables.fun index 191222c6f..e380ded29 100644 --- a/mlton/backend/allocate-variables.fun +++ b/mlton/backend/allocate-variables.fun @@ -1,4 +1,4 @@ -(* Copyright (C) 2017,2019,2022 Matthew Fluet. +(* Copyright (C) 2017,2019,2022-2023 Matthew Fluet. * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. @@ -102,7 +102,9 @@ structure Allocation: | (a1 as {offset = offset1, size = size1})::(a2 as {offset = offset2, size = size2})::alloc => if Bytes.equals (Bytes.+ (offset1, size1), offset2) then loop ({offset = offset1, size = Bytes.+ (size1, size2)}::alloc, ac) - else loop (a2::alloc, a1::ac) + else if Bytes.> (Bytes.+ (offset1, size1), offset2) + then Error.bug "AllocateVariables.Stack.new" + else loop (a2::alloc, a1::ac) in T (loop (Array.toList a, [])) end @@ -461,8 +463,8 @@ fun allocate {function = f: Rssa.Function.t, *) val (stack, {offset = linkOffset, ...}) = Allocation.Stack.get (stack, Type.exnStack ()) - val (_, {offset = handlerOffset, ...}) = - Allocation.Stack.get (stack, Type.label (Label.newNoname ())) + val handlerTy = Type.label (Label.newNoname ()) + val handlerOffset = Type.align (handlerTy, Allocation.Stack.size stack) val handlerArgsOffset = Bytes.align (Bytes.+ (handlerOffset, Runtime.labelSize ()), @@ -476,6 +478,17 @@ fun allocate {function = f: Rssa.Function.t, (paramOffsets args, maxSize, fn ({offset, ty, ...}, maxSize) => Bytes.max (maxSize, Bytes.+ (offset, Type.bytes ty)))) val handlerOffset = Bytes.- (handlerArgsOffset, Runtime.labelSize ()) + val () = + Control.diagnostic + (fn () => + let open Layout + in + record + [("handlerArgsOffset", Bytes.layout handlerArgsOffset), + ("handlerArgsSize", Bytes.layout handlerArgsSize), + ("handlerOffset", Bytes.layout handlerOffset), + ("linkOffset", Bytes.layout linkOffset)] + end) in SOME {handlerArgsOffset = handlerArgsOffset, handlerArgsSize = handlerArgsSize,