diff options
| author | Andy Wingo <wingo@pobox.com> | 2015-11-27 12:17:36 +0100 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2015-12-01 11:30:54 +0100 |
| commit | 39090e677eed54761e0952f2575ddef1504545d3 (patch) | |
| tree | b583cc7c138840531c943af36bfe4be7422df1e9 /libguile/frames.c | |
| parent | 8af3423efe1aa4168a097cf9ae11d3c4338894bb (diff) | |
| download | guile-39090e677eed54761e0952f2575ddef1504545d3.tar.gz | |
Add frame-procedure-name
* libguile/frames.c (frame_procedure_name_var): New static definition.
(init_frame_procedure_name_var): New helper.
(scm_frame_procedure_name): New function that returns the name of the
frame's procedure, as frame-procedure is to be deprecated.
* libguile/frames.h (scm_frame_procedure_name): Export.
* module/ice-9/boot-9.scm (exception-printers): Use frame-procedure-name
instead of procedure-name on frame-procedure.
* module/system/vm/frame.scm (frame-procedure-name): New private
function, implementing scm_frame_procedure_name.
(frame-call-representation): Use frame-procedure-name to get the
procedure name to print.
Diffstat (limited to 'libguile/frames.c')
| -rw-r--r-- | libguile/frames.c | 23 |
1 files changed, 23 insertions, 0 deletions
diff --git a/libguile/frames.c b/libguile/frames.c index 312d53b00..7432f8d84 100644 --- a/libguile/frames.c +++ b/libguile/frames.c @@ -149,6 +149,29 @@ SCM_DEFINE (scm_frame_procedure, "frame-procedure", 1, 0, 0, } #undef FUNC_NAME +static SCM frame_procedure_name_var; + +static void +init_frame_procedure_name_var (void) +{ + frame_procedure_name_var + = scm_c_private_lookup ("system vm frame", "frame-procedure-name"); +} + +SCM_DEFINE (scm_frame_procedure_name, "frame-procedure-name", 1, 0, 0, + (SCM frame), + "") +#define FUNC_NAME s_scm_frame_procedure_name +{ + static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; + scm_i_pthread_once (&once, init_frame_procedure_name_var); + + SCM_VALIDATE_VM_FRAME (1, frame); + + return scm_call_1 (scm_variable_ref (frame_procedure_name_var), frame); +} +#undef FUNC_NAME + static SCM frame_arguments_var; static void |