procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix emacs-module.c for wide ints

Browse source 
* 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.
This commit is contained in:
Eli Zaretskii 2015-12-01 20:34:12 +02:00
parent b99a34bcb0
commit bdebeb77a0
2 changed files with 19 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
modules/mod-test/test.el
View file

@ -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")))

24
src/emacs-module.c
View file

@ -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);