diff options
author | Andy Wingo <wingo@pobox.com> | 2013-05-16 20:58:54 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-06-09 23:43:25 +0200 |
commit | eb2bc00fb3863986927f0bade97487209b6d6a5b (patch) | |
tree | 8671c68378b99fc3066de39d6e0e9dc1e11a8b3e /libguile/programs.c | |
parent | f88e574d58aa3e64b6f1ed0bc6ea918d20a67d88 (diff) | |
download | guile-eb2bc00fb3863986927f0bade97487209b6d6a5b.tar.gz |
Wire up ability to print RTL program arities
* 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.
Diffstat (limited to 'libguile/programs.c')
-rw-r--r-- | libguile/programs.c | 30 |
1 files changed, 27 insertions, 3 deletions
diff --git a/libguile/programs.c b/libguile/programs.c index d3569159a..12561b30d 100644 --- a/libguile/programs.c +++ b/libguile/programs.c @@ -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; |