aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorPaul Eggert2015-11-20 08:51:13 -0800
committerPaul Eggert2015-11-20 08:51:42 -0800
commite61f1c3c8bd852ea8357047a408c8af56bc9918c (patch)
tree0389d127311a28c4a7b5b69d87d22f0cc9b89c9c /src
parentc0c309e4cd618ef660b04a13e5fc68c1a43031a6 (diff)
downloademacs-e61f1c3c8bd852ea8357047a408c8af56bc9918c.tar.gz
emacs-e61f1c3c8bd852ea8357047a408c8af56bc9918c.zip
Module function arg counts are ptrdiff_t, not int
* src/emacs-module.c (struct module_fun_env) (module_make_function, module_funcall, Fmodule_call): * src/emacs-module.h (struct emacs_runtime, struct emacs_env_25): Use ptrdiff_t, not int, for arg counts. * src/emacs-module.c (module_make_function): Don’t bother checking arity against MOST_POSITIVE_FIXNUM, as that’s unnecessary here. Make the checking clearer by negating it. (module_make_function, Fmodule_call): No need to use xzalloc since the storage doesn’t need to be cleared. (module_funcall): Don’t use VLA, since C11 doesn’t guarantee support for it, and many implementations are buggy with large VLAs anyway. Use SAFE_ALLOCA_LISP instead. (module_vec_set): Don’t crash if i < 0. (module_vec_get): Don’t crash if i < MOST_NEGATIVE_FIXNUM. (module_vec_set, module_vec_get): Do fixnum checks only when i is out of array bounds, for efficiency in the usual case. (Fmodule_load): Simplify fixnum range check. (Fmodule_call): Simplify arity check. Use xnmalloc to detect integer overflow in array allocation size.
Diffstat (limited to 'src')
-rw-r--r--src/emacs-module.c75
-rw-r--r--src/emacs-module.h16
2 files changed, 44 insertions, 47 deletions
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 25c5e019881..09b09d03366 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -222,7 +222,7 @@ static void module_wrong_type (emacs_env *, Lisp_Object, Lisp_Object);
222 222
223struct module_fun_env 223struct module_fun_env
224{ 224{
225 int min_arity, max_arity; 225 ptrdiff_t min_arity, max_arity;
226 emacs_subr subr; 226 emacs_subr subr;
227 void *data; 227 void *data;
228}; 228};
@@ -367,7 +367,7 @@ module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value)
367 (module-call envobj arglist))) */ 367 (module-call envobj arglist))) */
368 368
369static emacs_value 369static emacs_value
370module_make_function (emacs_env *env, int min_arity, int max_arity, 370module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
371 emacs_subr subr, const char *documentation, 371 emacs_subr subr, const char *documentation,
372 void *data) 372 void *data)
373{ 373{
@@ -375,24 +375,20 @@ module_make_function (emacs_env *env, int min_arity, int max_arity,
375 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 375 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
376 MODULE_HANDLE_SIGNALS; 376 MODULE_HANDLE_SIGNALS;
377 377
378 if (min_arity > MOST_POSITIVE_FIXNUM || max_arity > MOST_POSITIVE_FIXNUM) 378 if (! (0 <= min_arity
379 xsignal0 (Qoverflow_error); 379 && (max_arity < 0
380 380 ? max_arity == emacs_variadic_function
381 if (min_arity < 0 381 : min_arity <= max_arity)))
382 || (max_arity >= 0 && max_arity < min_arity)
383 || (max_arity < 0 && max_arity != emacs_variadic_function))
384 xsignal2 (Qinvalid_arity, make_number (min_arity), make_number (max_arity)); 382 xsignal2 (Qinvalid_arity, make_number (min_arity), make_number (max_arity));
385 383
386 Lisp_Object envobj; 384 /* FIXME: This should be freed when envobj is GC'd. */
387 385 struct module_fun_env *envptr = xmalloc (sizeof *envptr);
388 /* XXX: This should need to be freed when envobj is GC'd. */
389 struct module_fun_env *envptr = xzalloc (sizeof *envptr);
390 envptr->min_arity = min_arity; 386 envptr->min_arity = min_arity;
391 envptr->max_arity = max_arity; 387 envptr->max_arity = max_arity;
392 envptr->subr = subr; 388 envptr->subr = subr;
393 envptr->data = data; 389 envptr->data = data;
394 envobj = make_save_ptr (envptr);
395 390
391 Lisp_Object envobj = make_save_ptr (envptr);
396 Lisp_Object ret = list4 (Qlambda, 392 Lisp_Object ret = list4 (Qlambda,
397 list2 (Qand_rest, Qargs), 393 list2 (Qand_rest, Qargs),
398 documentation ? build_string (documentation) : Qnil, 394 documentation ? build_string (documentation) : Qnil,
@@ -404,7 +400,8 @@ module_make_function (emacs_env *env, int min_arity, int max_arity,
404} 400}
405 401
406static emacs_value 402static emacs_value
407module_funcall (emacs_env *env, emacs_value fun, int nargs, emacs_value args[]) 403module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
404 emacs_value args[])
408{ 405{
409 check_main_thread (); 406 check_main_thread ();
410 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 407 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
@@ -413,11 +410,15 @@ module_funcall (emacs_env *env, emacs_value fun, int nargs, emacs_value args[])
413 410
414 /* Make a new Lisp_Object array starting with the function as the 411 /* Make a new Lisp_Object array starting with the function as the
415 first arg, because that's what Ffuncall takes. */ 412 first arg, because that's what Ffuncall takes. */
416 Lisp_Object newargs[nargs + 1]; 413 Lisp_Object *newargs;
414 USE_SAFE_ALLOCA;
415 SAFE_ALLOCA_LISP (newargs, nargs + 1);
417 newargs[0] = value_to_lisp (fun); 416 newargs[0] = value_to_lisp (fun);
418 for (int i = 0; i < nargs; i++) 417 for (ptrdiff_t i = 0; i < nargs; i++)
419 newargs[1 + i] = value_to_lisp (args[i]); 418 newargs[1 + i] = value_to_lisp (args[i]);
420 return lisp_to_value (env, Ffuncall (nargs + 1, newargs)); 419 emacs_value result = lisp_to_value (env, Ffuncall (nargs + 1, newargs));
420 SAFE_FREE ();
421 return result;
421} 422}
422 423
423static emacs_value 424static emacs_value
@@ -615,20 +616,18 @@ module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val)
615{ 616{
616 check_main_thread (); 617 check_main_thread ();
617 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return); 618 eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
618 if (i > MOST_POSITIVE_FIXNUM)
619 {
620 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
621 return;
622 }
623 Lisp_Object lvec = value_to_lisp (vec); 619 Lisp_Object lvec = value_to_lisp (vec);
624 if (! VECTORP (lvec)) 620 if (! VECTORP (lvec))
625 { 621 {
626 module_wrong_type (env, Qvectorp, lvec); 622 module_wrong_type (env, Qvectorp, lvec);
627 return; 623 return;
628 } 624 }
629 if (i >= ASIZE (lvec)) 625 if (! (0 <= i && i < ASIZE (lvec)))
630 { 626 {
631 module_args_out_of_range (env, lvec, make_number (i)); 627 if (MOST_NEGATIVE_FIXNUM <= i && i <= MOST_POSITIVE_FIXNUM)
628 module_args_out_of_range (env, lvec, make_number (i));
629 else
630 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
632 return; 631 return;
633 } 632 }
634 ASET (lvec, i, value_to_lisp (val)); 633 ASET (lvec, i, value_to_lisp (val));
@@ -645,11 +644,12 @@ module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i)
645 module_wrong_type (env, Qvectorp, lvec); 644 module_wrong_type (env, Qvectorp, lvec);
646 return NULL; 645 return NULL;
647 } 646 }
648 ptrdiff_t size = ASIZE (lvec); 647 if (! (0 <= i && i < ASIZE (lvec)))
649 eassert (size >= 0);
650 if (! (0 <= i && i < size))
651 { 648 {
652 module_args_out_of_range (env, lvec, make_number (i)); 649 if (MOST_NEGATIVE_FIXNUM <= i && i <= MOST_POSITIVE_FIXNUM)
650 module_args_out_of_range (env, lvec, make_number (i));
651 else
652 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
653 return NULL; 653 return NULL;
654 } 654 }
655 return lisp_to_value (env, AREF (lvec, i)); 655 return lisp_to_value (env, AREF (lvec, i));
@@ -707,9 +707,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
707 707
708 if (r != 0) 708 if (r != 0)
709 { 709 {
710 if (r < MOST_NEGATIVE_FIXNUM) 710 if (! (MOST_NEGATIVE_FIXNUM <= r && r <= MOST_POSITIVE_FIXNUM))
711 xsignal0 (Qunderflow_error);
712 if (r > MOST_POSITIVE_FIXNUM)
713 xsignal0 (Qoverflow_error); 711 xsignal0 (Qoverflow_error);
714 xsignal2 (Qmodule_load_failed, file, make_number (r)); 712 xsignal2 (Qmodule_load_failed, file, make_number (r));
715 } 713 }
@@ -724,22 +722,19 @@ ARGLIST is a list of arguments passed to SUBRPTR. */)
724 (Lisp_Object envobj, Lisp_Object arglist) 722 (Lisp_Object envobj, Lisp_Object arglist)
725{ 723{
726 struct module_fun_env *envptr = XSAVE_POINTER (envobj, 0); 724 struct module_fun_env *envptr = XSAVE_POINTER (envobj, 0);
727 EMACS_INT len = XINT (Flength (arglist)); 725 EMACS_INT len = XFASTINT (Flength (arglist));
728 eassert (len >= 0); 726 eassume (0 <= envptr->min_arity);
729 if (len > MOST_POSITIVE_FIXNUM) 727 if (! (envptr->min_arity <= len
730 xsignal0 (Qoverflow_error); 728 && len <= (envptr->max_arity < 0 ? PTRDIFF_MAX : envptr->max_arity)))
731 if (len > INT_MAX || len < envptr->min_arity
732 || (envptr->max_arity >= 0 && len > envptr->max_arity))
733 xsignal2 (Qwrong_number_of_arguments, module_format_fun_env (envptr), 729 xsignal2 (Qwrong_number_of_arguments, module_format_fun_env (envptr),
734 make_number (len)); 730 make_number (len));
735 731
736 struct env_storage env; 732 struct env_storage env;
737 initialize_environment (&env); 733 initialize_environment (&env);
738 734
739 emacs_value *args = xzalloc (len * sizeof *args); 735 emacs_value *args = xnmalloc (len, sizeof *args);
740 int i;
741 736
742 for (i = 0; i < len; i++) 737 for (ptrdiff_t i = 0; i < len; i++)
743 { 738 {
744 args[i] = lisp_to_value (&env.pub, XCAR (arglist)); 739 args[i] = lisp_to_value (&env.pub, XCAR (arglist));
745 if (! args[i]) 740 if (! args[i])
diff --git a/src/emacs-module.h b/src/emacs-module.h
index 18344270b29..4d204d0b96f 100644
--- a/src/emacs-module.h
+++ b/src/emacs-module.h
@@ -60,8 +60,8 @@ struct emacs_runtime
60typedef int (*emacs_init_function) (struct emacs_runtime *ert); 60typedef int (*emacs_init_function) (struct emacs_runtime *ert);
61 61
62/* Function prototype for the module Lisp functions. */ 62/* Function prototype for the module Lisp functions. */
63typedef emacs_value (*emacs_subr) (emacs_env *env, int nargs, emacs_value args[], 63typedef emacs_value (*emacs_subr) (emacs_env *env, ptrdiff_t nargs,
64 void *data); 64 emacs_value args[], void *data);
65 65
66/* Function prototype for module user-pointer finalizers. */ 66/* Function prototype for module user-pointer finalizers. */
67typedef void (*emacs_finalizer_function) (void *); 67typedef void (*emacs_finalizer_function) (void *);
@@ -117,17 +117,19 @@ struct emacs_env_25
117 /* Function registration. */ 117 /* Function registration. */
118 118
119 emacs_value (*make_function) (emacs_env *env, 119 emacs_value (*make_function) (emacs_env *env,
120 int min_arity, 120 ptrdiff_t min_arity,
121 int max_arity, 121 ptrdiff_t max_arity,
122 emacs_value (*function) (emacs_env *, int, 122 emacs_value (*function) (emacs_env *env,
123 emacs_value *, void *) 123 ptrdiff_t nargs,
124 emacs_value args[],
125 void *)
124 EMACS_NOEXCEPT, 126 EMACS_NOEXCEPT,
125 const char *documentation, 127 const char *documentation,
126 void *data); 128 void *data);
127 129
128 emacs_value (*funcall) (emacs_env *env, 130 emacs_value (*funcall) (emacs_env *env,
129 emacs_value function, 131 emacs_value function,
130 int nargs, 132 ptrdiff_t nargs,
131 emacs_value args[]); 133 emacs_value args[]);
132 134
133 emacs_value (*intern) (emacs_env *env, 135 emacs_value (*intern) (emacs_env *env,