[bknr-cvs] ksprotte changed trunk/projects/bos/m2/allocation.lisp

[BKNR Commits]

Revision: 3639
Author: ksprotte
URL: http://bknr.net/trac/changeset/3639

allocate-m2s-for-sale uses again the allocate-cache with exact matches

U   trunk/projects/bos/m2/allocation.lisp

Modified: trunk/projects/bos/m2/allocation.lisp
===================================================================
--- trunk/projects/bos/m2/allocation.lisp	2008-07-25 12:59:11 UTC (rev 3638)
+++ trunk/projects/bos/m2/allocation.lisp	2008-07-25 13:13:02 UTC (rev 3639)
@@ -195,13 +195,13 @@
 (deftransaction activate-allocation-area (area)
   (warn "activating ~S" area)
   (setf (slot-value area 'active-p) t)
-  (bos.m2.allocation-cache::rebuild-cache)
+  (bos.m2.allocation-cache::rebuild-allocation-cache)
   area)
 
 (deftransaction deactivate-allocation-area (area)
   (warn "deactivating ~S" area)
   (setf (slot-value area 'active-p) nil)
-  (bos.m2.allocation-cache::rebuild-cache)
+  (bos.m2.allocation-cache::rebuild-allocation-cache)
   area)
 
 ;;; FIXME can be optimized
@@ -358,17 +358,18 @@
   "The main entry point to the allocation machinery. Will return a
    list of N m2 instances or NIL if the requested amount cannot be
    allocated."
-  (dolist (area (active-allocation-areas))
-    (when (<= n (allocation-area-free-m2s area))
-      (let ((m2s (allocate-in-area area n)))
-        (when m2s
-          (return-from allocate-m2s-for-sale m2s)))))
-  (dolist (area (inactive-nonempty-allocation-areas))
-    (when (<= n (allocation-area-free-m2s area))
-      (let ((m2s (allocate-in-area area n)))
-        (when m2s
-          (activate-allocation-area area)
-          (return-from allocate-m2s-for-sale m2s))))))
+  (or (bos.m2.allocation-cache:find-exact-match n :remove t)
+      (dolist (area (active-allocation-areas))
+        (when (<= n (allocation-area-free-m2s area))
+          (let ((m2s (allocate-in-area area n)))
+            (when m2s
+              (return m2s)))))
+      (dolist (area (inactive-nonempty-allocation-areas))
+        (when (<= n (allocation-area-free-m2s area))
+          (let ((m2s (allocate-in-area area n)))
+            (when m2s
+              (activate-allocation-area area)
+              (return m2s)))))))
 
 (defgeneric return-contract-m2s (m2s)
   (:documentation "Mark the given square meters as free, so that