From 31b6e294e59e118e8291379471d80035e971d387 Mon Sep 17 00:00:00 2001
From: Matthew Fluet <matthew.fluet@gmail.com>
Date: Wed, 1 Nov 2017 15:08:43 -0400
Subject: [PATCH] Improve Allocation.Stack.get

`val get: t * Type.t -> t * {offset: Bytes.t}` takes a stack
allocation (list of allocated slots) and a type and returns a new
stack allocation and an offset, such that the new stack allocation
extends the old stack allocation with an allocated slot at `offset`
suitable for an object of the given type.

Previously, when the old stack allocation is non-empty, a search was
made through the old stack allocation for an available slot.  However,
the search started after the first allocation in the old stack
allocation.  That is, the result `offset` was always greater than the
offset of the head of the old stack allocation, even unallocated slots
existed before the head of the old stack allocation.  This could lead
to larger than necessary stack frames.

It suffices to simply initiate the search as though a dummy
`{offset = Bytes.zero, size = Bytes.zero}` allocation were at the head
of the old stack allocation.  A small amount of logic is used to avoid
including that dummy allocation in the result allocation in order to
avoid accumulating unnecessary dummy allocations.
---
 mlton/backend/allocate-registers.fun | 78 ++++++++++++----------------
 1 file changed, 33 insertions(+), 45 deletions(-)

diff --git a/mlton/backend/allocate-registers.fun b/mlton/backend/allocate-registers.fun
index 351c08a865..29d15f5ffb 100644
--- a/mlton/backend/allocate-registers.fun
+++ b/mlton/backend/allocate-registers.fun
@@ -104,55 +104,43 @@ structure Allocation:
           fun get (T alloc, ty) =
              let
                 val slotSize = Type.bytes ty
-             in
-                case alloc of
-                   [] => (T [{offset = Bytes.zero, size = slotSize}],
-                          {offset = Bytes.zero})
-                 | a :: alloc =>
-                      let
-                         fun loop (alloc, a as {offset, size}, ac) =
+                fun loop (alloc, a as {offset, size}, ac) =
+                   let
+                      val prevEnd = Bytes.+ (offset, size)
+                      val begin = Type.align (ty, prevEnd)
+                      fun coalesce () =
+                         if Bytes.equals (prevEnd, begin)
+                            then ({offset = offset, size = Bytes.+ (size, slotSize)}, ac)
+                            else ({offset = begin, size = slotSize}, a :: ac)
+                   in
+                      case alloc of
+                         [] =>
                             let
-                               val prevEnd = Bytes.+ (offset, size)
-                               val begin = Type.align (ty, prevEnd)
-                               fun coalesce () =
-                                  if Bytes.equals (prevEnd, begin)
-                                     then ({offset = offset,
-                                            size = Bytes.+ (size, slotSize)},
-                                           ac)
-                                  else ({offset = begin, size = slotSize},
-                                        {offset = offset, size = size} :: ac)
+                               val (a, ac) = coalesce ()
                             in
-                              case alloc of
-                                 [] =>
-                                    let
-                                       val (a, ac) = coalesce ()
+                               (T (rev (a :: ac)), {offset = begin})
+                            end
+                       | (a' as {offset, size}) :: alloc =>
+                            if Bytes.> (Bytes.+ (begin, slotSize), offset)
+                               then loop (alloc, a',
+                                          if Bytes.isZero offset andalso Bytes.isZero size
+                                             then ac
+                                             else a :: ac)
+                               else let
+                                       val (a'' as {offset = o', size = s'}, ac) =
+                                          coalesce ()
+                                       val alloc =
+                                          List.appendRev
+                                          (ac,
+                                           if Bytes.equals (Bytes.+ (o', s'), offset)
+                                              then {offset = o', size = Bytes.+ (size, s')} :: alloc
+                                              else a'' :: a' :: alloc)
                                     in
-                                       (T (rev (a :: ac)), {offset = begin})
+                                       (T alloc, {offset = begin})
                                     end
-                                | (a' as {offset, size}) :: alloc =>
-                                    if Bytes.> (Bytes.+ (begin, slotSize),
-                                                offset)
-                                       then loop (alloc, a', a :: ac)
-                                    else
-                                       let
-                                          val (a'' as {offset = o', size = s'}, ac) = 
-                                             coalesce ()
-                                          val alloc =
-                                             List.appendRev
-                                             (ac,
-                                              if Bytes.equals (Bytes.+ (o', s'),
-                                                               offset)
-                                                 then {offset = o',
-                                                       size = Bytes.+ (size, s')}
-                                                      :: alloc
-                                              else a'' :: a' :: alloc)
-                                       in
-                                          (T alloc, {offset = begin})
-                                       end
-                            end
-                      in
-                         loop (alloc, a, [])
-                      end
+                   end
+             in
+                loop (alloc, {offset = Bytes.zero, size = Bytes.zero}, [])
              end
           val get =
              Trace.trace2