mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 23:50:19 +02:00
Code Activity

Wire up ability to print RTL program arities

Browse source 
* libguile/procprop.c (scm_i_procedure_arity): Allow RTL programs to
  dispatch to scm_i_program_arity.

* libguile/programs.c (scm_i_program_print): Refactor reference to
  write-program.
  (scm_i_rtl_program_minimum_arity): New procedure, dispatches to
  Scheme.
  (scm_i_program_arity): Dispatch to scm_i_rtl_program_minimum_arity if
  appropriate.

* module/system/vm/debug.scm (program-minimum-arity): New export.

* module/system/vm/program.scm (rtl-program-minimum-arity): New internal
  function.
  (program-arguments-alists): New helper, implemented also for RTL
  procedures.
  (write-program): Refactor a bit, and call program-arguments-alists.

* test-suite/tests/rtl.test ("simply procedure arity"): Add tests that
  arities make it all the way to cold ELF and back to warm Guile.
This commit is contained in:
Andy Wingo 2013-05-16 20:58:54 +02:00
parent f88e574d58
commit eb2bc00fb3
5 changed files with 100 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

30
libguile/programs.c
View file

@ -129,9 +129,8 @@ scm_i_program_print (SCM program, SCM port, scm_print_state *pstate)
static int print_error = 0;
if (scm_is_false (write_program) && scm_module_system_booted_p)
write_program = scm_module_local_variable
(scm_c_resolve_module ("system vm program"),
scm_from_latin1_symbol ("write-program"));
write_program = scm_c_private_variable ("system vm program",
"write-program");
if (SCM_PROGRAM_IS_CONTINUATION (program))
{
@ -450,11 +449,36 @@ parse_arity (SCM arity, int *req, int *opt, int *rest)
*req = *opt = *rest = 0;
}
static int
scm_i_rtl_program_minimum_arity (SCM program, int *req, int *opt, int *rest)
{
static SCM rtl_program_minimum_arity = SCM_BOOL_F;
SCM l;
if (scm_is_false (rtl_program_minimum_arity) && scm_module_system_booted_p)
rtl_program_minimum_arity =
scm_c_private_variable ("system vm debug",
"rtl-program-minimum-arity");
l = scm_call_1 (scm_variable_ref (rtl_program_minimum_arity), program);
if (scm_is_false (l))
return 0;
*req = scm_to_int (scm_car (l));
*opt = scm_to_int (scm_cadr (l));
*rest = scm_is_true (scm_caddr (l));
return 1;
}
int
scm_i_program_arity (SCM program, int *req, int *opt, int *rest)
{
SCM arities;
if (SCM_RTL_PROGRAM_P (program))
return scm_i_rtl_program_minimum_arity (program, req, opt, rest);
arities = scm_program_arities (program);
if (!scm_is_pair (arities))
return 0;