diff --git a/days/day09.st b/days/day09.st
index a7c28f0..5f03560 100644
--- a/days/day09.st
+++ b/days/day09.st
@@ -66,10 +66,44 @@ Link subclass: Block [
     printOn: st [st << '#[' << len << ']@' << pos]
 ]
 
+LinkedList subclass: FreeList [
+    | searchCache |
+
+    initialize [ searchCache := nil ]
+
+    searchCache
+    [ searchCache ifNil: [
+        searchCache := Array new: 9 withAll: self first].
+      ^searchCache ]
+
+    cachedLinkForSize: sz [ ^self searchCache at: sz ]
+    cachedLinkForSize: sz put: block [ searchCache at: sz put: block ]
+
+    remove: block
+    [ searchCache keysAndValuesDo: [
+        :i :elt | elt == block ifTrue: [
+            searchCache at: i put: elt nextLink ]].
+      super remove: block ]
+
+    freeForBlock: block
+    [ | link len |
+      len := block len.
+      link := self cachedLinkForSize: len.
+      [ link isNil ] whileFalse: [
+          link pos > block pos ifTrue: [
+              self cachedLinkForSize: len put: link. ^nil ].
+          link len >= len ifTrue: [
+              self cachedLinkForSize: len put: link. ^link ].
+          link nextLink
+              ifNil: [ self cachedLinkForSize: len put: link. ^nil ]
+              ifNotNil: [:it | link := it]].
+      ^nil ]
+]
+
 DriveBase subclass: DriveP2 [
     | freeList idMap lastId |
     map: m
-    [ freeList := LinkedList new.
+    [ freeList := FreeList new.
       idMap := Dictionary new.
       super map: m ]
 
@@ -101,13 +135,8 @@ DriveBase subclass: DriveP2 [
 
     compactBlock: id
     [ | block | block := idMap at: id.
-      freeList do: [
-          :free |
-          free pos > block pos ifTrue: [^self].
-          free len >= block len ifTrue: [
-              self moveBlock: block to: free.
-              ^self
-          ]]]
+      (freeList freeForBlock: block) ifNotNil: [
+          :free | self moveBlock: block to: free ]]
 ]
 
 AOC input: [ stdin nextLine ];
diff --git a/days/day10.st b/days/day10.st
index fbb3a90..a28cbea 100644
--- a/days/day10.st
+++ b/days/day10.st
@@ -1,5 +1,15 @@
+Grid subclass: HeightMap [
+    | invHeights |
+    rows: r [super rows: r. self initInvHeights]
+
+    initInvHeights
+    [invHeights := (0 to: 9) collect: [:h | (super allPosnsOf: h) asArray]]
+
+    allPosnsOf: h [^invHeights at: h + 1]
+]
+
 Object subclass: TrailMap [
-    | heightMap scores allDirs |
+    | heightMap scores allDirs heightsRev |
     scores [^scores]
 
     initFor: pos [ ^Set new add: pos; yourself ]
@@ -10,32 +20,29 @@ Object subclass: TrailMap [
     initialize [ allDirs := {Posn up. Posn down. Posn left. Posn right}. ]
     heights: hm [ heightMap := hm. self initScores. ]
     initScores
-    [ | rows |
-      rows := (1 to: heightMap height) collect: [
-          :y | (1 to: heightMap width) collect: [
-              :x | | pos | pos := Posn x: x y: y.
-              ((heightMap at: pos) = 9)
-                  ifTrue: [self initFor: pos]
-                  ifFalse: [nil]]].
-      scores := Grid new rows: rows ]
+    [ scores :=
+          Grid width: heightMap width height: heightMap height
+              initWith: [
+                  :pos | ((heightMap at: pos) = 9)
+                       ifTrue: [self initFor: pos]
+                       ifFalse: [nil]] ]
 
     computeScores
     [ (8 to: 0 by: -1) do: [:i | self computeScoresForHeight: i]. ]
 
     computeScoresForHeight: h
     [ | h1 | h1 := h + 1.
-      heightMap allPosnsDo: [
-          :pos |
-          (heightMap at: pos) = h ifTrue: [
-              | res | res := self initScore.
-              allDirs collect: [
-                  :off | | offp | offp := pos + off.
-                  ((heightMap at: offp) = h1) ifTrue:
-                      [ res := self combineScore: res with: (scores at: offp) ]].
-              scores at: pos put: res ]]]
+      (heightMap allPosnsOf: h) do: [
+          :pos | | res | res := self initScore.
+          allDirs collect: [
+              :off | | offp | offp := pos + off.
+              ((heightMap at: offp) = h1) ifTrue: [
+                  res := self combineScore: res with: (scores at: offp) ]].
+          scores at: pos put: res ]]
 
     trailheadScores
-    [ ^(heightMap allPosnsOf: 0) collect: [:p | self numberFromScore: (scores at: p)] ]
+    [ ^(heightMap allPosnsOf: 0) collect: [
+          :p | self numberFromScore: (scores at: p)] ]
 ]
 
 TrailMap subclass: TrailMapP2 [
@@ -48,7 +55,7 @@ TrailMap subclass: TrailMapP2 [
 AOC input: [ | rows |
              rows := stdin toLines asArray collect: [
                  :line | line asArray collect: [:it | it digitValue]].
-             Grid new rows: rows ];
+             HeightMap new rows: rows ];
     part1: TrailMap; part2: TrailMapP2;
     result: [ :heights :Class | | map |
               map := Class new heights: heights.
diff --git a/days/utils.st b/days/utils.st
index 0afc4ff..ff5a123 100644
--- a/days/utils.st
+++ b/days/utils.st
@@ -261,6 +261,14 @@ Object subclass: Grid [
 
     printOn: st [ rows do: [ :r | st << r; nl ] ]
 ]
+Grid class extend [
+    width: w height: h initWith: block
+    [ | rows |
+      rows := (1 to: h) collect: [
+          :y | (1 to: h) collect: [
+              :x | block value: (Posn x: x y: y)]].
+      ^self new rows: rows ]
+]
 
 Dictionary extend [
     at: key inA: Type [^self at: key ifAbsentPut: [Type new]]