feature/igc3 53136c41f4a 4/4: Add a workaround for failing a assertion in mps/code/protix.c

branch: feature/igc3
commit 53136c41f4afead5f21543b2434afb7a39df717a
Author: Helmut Eller <[email protected]>
Commit: Helmut Eller <[email protected]>

    Add a workaround for failing a assertion in mps/code/protix.c
    
    * src/igc.c (igc_vector_elts_max): Use a lower value to stay below
    INT_MAX bytes.
    * test/src/igc-tests.el (igc-tests-find-largest-vector-size): New test.
    (igc-tests--binary-search, igc-tests--try-vector-size): New helper.
---
 src/igc.c             | 13 ++++++++++---
 test/src/igc-tests.el | 30 ++++++++++++++++++++++++++++++
 2 files changed, 40 insertions(+), 3 deletions(-)

diff --git a/src/igc.c b/src/igc.c
index 01b4ac95f47..2fa0589b952 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -5280,12 +5280,19 @@ igc_make_pseudovector (size_t nwords_mem, size_t nwords_lisp,
   return v;
 }
 
+/* FIXME/igc: The INT_MAX bound is there for the assertion
+   AVER(AddrOffset(base, limit) <= INT_MAX) in ProtSet
+   (mps/code/protix.c:76).  That assertion looks like a bug and could
+   probably be removed.  */
 static size_t
 igc_vector_elts_max (void)
 {
-  size_t obj_size_max = to_bytes (igc_header_nwords_max ());
-  return (obj_size_max - header_size) / sizeof (Lisp_Object);
-};
+  size_t nwords_max
+    = min (igc_header_nwords_max (), INT_MAX / sizeof (mps_word_t));
+  return min (((nwords_max - to_words (header_size))
+	       / to_words (word_size)),
+	      PSEUDOVECTOR_FLAG - 1);
+}
 
 struct Lisp_Vector *
 igc_make_vector (ptrdiff_t len)
diff --git a/test/src/igc-tests.el b/test/src/igc-tests.el
index 34cf99555ca..081e22a651a 100644
--- a/test/src/igc-tests.el
+++ b/test/src/igc-tests.el
@@ -72,4 +72,34 @@
   (igc-collect)
   (thread-join (make-thread #'igc-test--trigger-incremental-gc)))
 
+(defun igc-tests--binary-search (start end cmp)
+  (named-let search ((start start) (end end))
+    (let* ((len (- end start))
+           (mid (+ start (/ len 2))))
+      (cond ((= len 0)
+             nil)
+            (t
+             (cl-ecase (funcall cmp mid)
+               (= mid)
+               (< (search start mid))
+               (> (search (1+ mid) end))))))))
+
+(defun igc-tests--try-vector-size (len)
+  (message "testing: %d (0x%x) (logb: %d)" len len (logb len))
+  (igc--process-messages)
+  (cond ((ignore-errors (length (make-vector len nil)))
+         (cond ((ignore-errors (length (make-vector (1+ len) nil)))
+                '>)
+               (t
+                '=)))
+        (t '<)))
+
+;; FIXME: this crashes with 32-bit configurations
+(ert-deftest igc-tests-find-largest-vector-size ()
+  "Find the largest size which we can allocate a vector."
+  :tags '(:igc :expensive-test)
+  (let ((garbage-collection-messages t))
+    (igc-tests--binary-search 0 (1+ most-positive-fixnum)
+                              #'igc-tests--try-vector-size)))
+
 ;;; igc-tests.el ends here.