From bdebeb77a001fc4d9ee8392829cd7bc6cd11d7d1 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 1 Dec 2015 20:34:12 +0200 Subject: [PATCH] Fix emacs-module.c for wide ints * src/emacs-module.c (lisp_to_value): Compare the produced value with the original Lisp object, not with the one potentially converted into a Lisp_Cons. Fixes assertion violations when working with integers larger than fit into a 32-bit value. * modules/mod-test/test.el (mod-test-sum-test): Add tests for large integers, to test --with-wide-int. --- modules/mod-test/test.el | 6 +++++- src/emacs-module.c | 24 ++++++++++++++---------- 2 files changed, 19 insertions(+), 11 deletions(-) diff --git a/modules/mod-test/test.el b/modules/mod-test/test.el index a0abdab49e5..eacc6671ead 100644 --- a/modules/mod-test/test.el +++ b/modules/mod-test/test.el @@ -42,7 +42,11 @@ (nth 1 descr)))) (should (= (nth 2 descr) 3))) (should-error (mod-test-sum "1" 2) :type 'wrong-type-argument) - (should-error (mod-test-sum 1 "2") :type 'wrong-type-argument)) + (should-error (mod-test-sum 1 "2") :type 'wrong-type-argument) + (should (= (mod-test-sum -1 most-positive-fixnum) + (1- most-positive-fixnum))) + (should (= (mod-test-sum 1 most-negative-fixnum) + (1+ most-negative-fixnum)))) (ert-deftest mod-test-sum-docstring () (should (string= (documentation 'mod-test-sum) "Return A + B"))) diff --git a/src/emacs-module.c b/src/emacs-module.c index 67e5eab0110..13f2a1dd98f 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -880,44 +880,48 @@ value_to_lisp (emacs_value v) static emacs_value lisp_to_value (Lisp_Object o) { - EMACS_INT i = XLI (o); #ifdef WIDE_EMACS_INT /* We need to compress the EMACS_INT into the space of a pointer. For most objects, this is just a question of shuffling the tags around. But in some cases (e.g. large integers) this can't be done, so we should allocate a special object to hold the extra data. */ + Lisp_Object orig = o; int tag = XTYPE (o); switch (tag) { case_Lisp_Int: { - EMACS_UINT val = i & VALMASK; - if (val <= (SIZE_MAX >> GCTYPEBITS)) + EMACS_UINT ui = (EMACS_UINT) XINT (o); + if (ui <= (SIZE_MAX >> GCTYPEBITS)) { - size_t tv = (size_t)val; - emacs_value v = (emacs_value) ((tv << GCTYPEBITS) | tag); + uintptr_t uv = (uintptr_t) ui; + emacs_value v = (emacs_value) ((uv << GCTYPEBITS) | tag); eassert (EQ (value_to_lisp (v), o)); return v; } else - o = Fcons (o, ltv_mark); + { + o = Fcons (o, ltv_mark); + tag = Lisp_Cons; + } } /* FALLTHROUGH */ default: { void *ptr = XUNTAG (o, tag); - if (((size_t)ptr) & ((1 << GCTYPEBITS) - 1)) + if (((uintptr_t)ptr) & ((1 << GCTYPEBITS) - 1)) { /* Pointer is not properly aligned! */ eassert (!CONSP (o)); /* Cons cells have to always be aligned! */ o = Fcons (o, ltv_mark); ptr = XUNTAG (o, tag); } - emacs_value v = (emacs_value)(((size_t) ptr) | tag); - eassert (EQ (value_to_lisp (v), o)); + emacs_value v = (emacs_value) (((uintptr_t) ptr) | tag); + eassert (EQ (value_to_lisp (v), orig)); return v; } } #else - emacs_value v = (emacs_value)i; + emacs_value v = (emacs_value) XLI (o); + /* Check the assumption made elsewhere that Lisp_Object and emacs_value share the same underlying bit representation. */ eassert (v == *(emacs_value*)&o); -- 2.39.5