StorageExhausted holds over the Map's four allocating operations
One rule over every allocating operation, so it has to hold for map-new, put, reserve and clone exactly as it holds for vec-new, push, reserve and clone. put stays Unit and clone stays the container; nothing grows a Result. A map is the harder of the two and that is why it gets its own program. A Vec's failing allocation leaves the Vec untouched, whereas a map's growth allocates a whole new block, rehashes into it and only then releases the old one — so a failure partway has to leave the map exactly as it was or the retry re-attempts against a half-moved map. 300 entries through several grows against a ceiling that is raised each time, then every one of them read back: no entry lost, none doubled.
This commit is contained in:
parent
e0aedadd74
commit
1bc5161ee2
82
test/programs/map-exhausted.flan
Normal file
82
test/programs/map-exhausted.flan
Normal file
@ -0,0 +1,82 @@
|
||||
;;;; StorageExhausted and retry, over a Map — spec-memory.md, "Allocation
|
||||
;;;; failure". The rule is one rule over *every* allocating operation, so it has
|
||||
;;;; to hold for map-new, put, reserve and clone exactly as exhausted.flan shows
|
||||
;;;; it holding for vec-new, push, reserve and clone. put stays Unit, clone
|
||||
;;;; stays the container, and no signature anywhere grows a Result.
|
||||
;;;;
|
||||
;;;; A map is the harder case of the two, and that is why it gets its own
|
||||
;;;; program. A Vec's failing allocation leaves the Vec untouched. A map's
|
||||
;;;; growth allocates a whole new block, rehashes into it and only then
|
||||
;;;; releases the old one — so a failure partway must leave the map exactly as
|
||||
;;;; it was, or the retry re-attempts against a half-moved map.
|
||||
|
||||
;; Globals, because a handler cannot see the locals of the function that
|
||||
;; established it.
|
||||
(defvar tight Allocator)
|
||||
(defvar failures i64)
|
||||
(defvar last-bytes i64)
|
||||
(defvar same-allocator bool)
|
||||
|
||||
(defn main [] i32
|
||||
(set tight (heap-allocator))
|
||||
;; Enough for the smallest block and not for the one after it. A map's block
|
||||
;; is keys, values, hashes and scratch, each rounded to a cache line, so it
|
||||
;; is a few hundred bytes at eight slots — the ceiling has to be low enough
|
||||
;; to be hit and high enough that the first block fits after one raise.
|
||||
(set-alloc-budget tight 64)
|
||||
|
||||
(handler-bind
|
||||
[(StorageExhausted [c]
|
||||
(set failures (+ failures 1))
|
||||
(set last-bytes (.bytes c))
|
||||
(set same-allocator (= (.allocator c) (alloc-id tight)))
|
||||
;; Raise the ceiling and re-attempt the same request. The map is
|
||||
;; untouched and its allocator is unchanged, which is why this can
|
||||
;; succeed — releasing the region instead would invalidate the map,
|
||||
;; which is what the epoch check catches and is its own program.
|
||||
(set-alloc-budget tight (* 4 (alloc-budget tight)))
|
||||
(invoke-restart 'retry))]
|
||||
(let [m (map-new i32 i64 tight)]
|
||||
;; Several grows, each one a fresh block rehashed into. A put that fails
|
||||
;; puts nothing, and the retry puts exactly once — so no entry is lost
|
||||
;; and none is doubled.
|
||||
(dotimes [i 300] (put m i (* (i64 i) 7)))
|
||||
(println (len m)) ; 300
|
||||
(let [bad 0]
|
||||
(dotimes [i 300]
|
||||
(match (get m i)
|
||||
(Some v) (if (not (= v (* (i64 i) 7))) (set bad (+ bad 1)))
|
||||
None (set bad (+ bad 1))))
|
||||
(println bad)) ; 0
|
||||
(free m)))
|
||||
|
||||
(println (> failures 1)) ; true
|
||||
(println (> last-bytes 0)) ; true
|
||||
(println same-allocator) ; true
|
||||
|
||||
;; reserve asks for the whole block at once, and clone asks the new allocator
|
||||
;; for one big enough to hold the source — both are allocating operations and
|
||||
;; neither returns an error.
|
||||
(set-alloc-budget tight 64)
|
||||
(set failures 0)
|
||||
(handler-bind
|
||||
[(StorageExhausted [c]
|
||||
(set failures (+ failures 1))
|
||||
(set-alloc-budget tight (* 8 (alloc-budget tight)))
|
||||
(invoke-restart 'retry))]
|
||||
(let [m (map-new string i32 tight)]
|
||||
(reserve m 200)
|
||||
(println (len m)) ; 0
|
||||
(put m "a" 1)
|
||||
(put m "b" 2)
|
||||
(let [w (clone m)]
|
||||
(println (len w)) ; 2
|
||||
(match (get w "b")
|
||||
(Some v) (println v) ; 2
|
||||
None (println "missing"))
|
||||
(free w))
|
||||
(free m)))
|
||||
(println (> failures 0)) ; true
|
||||
|
||||
(set-alloc-budget tight 0)
|
||||
0)
|
||||
Loading…
x
Reference in New Issue
Block a user