mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-09 22:50:34 -07:00
Code Issues Projects Releases Packages Wiki Activity

ihs/swank: make si_ihs_env return the local environment (not lexical)

Browse source 
We deprecate the function si_ihs_env in favor of more explicit si_ihs_lex and
si_ihs_lcl, but the former is left for backward compatibility with SLIME/SLYNK
because they call it to query the environment to add locals to the backtrace.
This commit is contained in:
Daniel Kochmański 2025-11-17 19:20:25 +01:00
parent 8a5007fd4a
commit e6ae6146a4
5 changed files with 15 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

10
src/c/stacks.d
View file

@ -941,7 +941,7 @@ si_ihs_fun(cl_object arg)
}
cl_object
si_ihs_env(cl_object arg)
si_ihs_lex(cl_object arg)
{
cl_env_ptr env = ecl_process_env();
ecl_return1(env, get_ihs_ptr(ecl_to_size(arg))->lex_env);
@ -954,6 +954,14 @@ si_ihs_lcl(cl_object arg)
ecl_return1(env, get_ihs_ptr(ecl_to_size(arg))->lcl_env);
}
/* DEPRECATED backward compatibility with SWANK/SLYNK. --jd 2025-11-17 */
cl_object
si_ihs_env(cl_object arg)
{
cl_env_ptr env = ecl_process_env();
ecl_return1(env, get_ihs_ptr(ecl_to_size(arg))->lcl_env);
}
/* -- General purpose stack implementation ----------------------------------- */
/* Stacks are based on actually adjustable simple vectors. */

1
src/c/symbols_list.h
View file

@ -1215,6 +1215,7 @@ cl_symbols[] = {
{SYS_ "HASH-TABLE-ITERATOR" ECL_FUN("si_hash_table_iterator", si_hash_table_iterator, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "IHS-BDS" ECL_FUN("si_ihs_bds", si_ihs_bds, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "IHS-ENV" ECL_FUN("si_ihs_env", si_ihs_env, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "IHS-LEX" ECL_FUN("si_ihs_lex", si_ihs_lex, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "IHS-LCL" ECL_FUN("si_ihs_lcl", si_ihs_lcl, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "IHS-FUN" ECL_FUN("si_ihs_fun", si_ihs_fun, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "IHS-NEXT" ECL_FUN("si_ihs_next", si_ihs_next, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},

1
src/cmp/proclamations.lsp
View file

@ -299,6 +299,7 @@
(proclamation si:ihs-top () si::index)
(proclamation si:ihs-fun (si::index) (or null function-designator))
(proclamation si:ihs-env (si::index) (or null vector))
(proclamation si:ihs-lex (si::index) (or null vector))
(proclamation si:ihs-lcl (si::index) (or null vector si::frame))
(proclamation si:frs-top () si::index)
(proclamation si:frs-bds (si::index) si::index)

1
src/h/external.h
View file

@ -1649,6 +1649,7 @@ extern ECL_API __m128d ecl_unbox_double_sse_pack(cl_object value);
extern ECL_API cl_object si_ihs_top(void);
extern ECL_API cl_object si_ihs_fun(cl_object arg);
extern ECL_API cl_object si_ihs_env(cl_object arg);
extern ECL_API cl_object si_ihs_lex(cl_object arg);
extern ECL_API cl_object si_ihs_lcl(cl_object arg);
extern ECL_API cl_object si_ihs_bds(cl_object arg);
extern ECL_API cl_object si_ihs_next(cl_object arg);

5
src/lsp/top.lsp
View file

@ -1213,7 +1213,7 @@ Use special code 0 to cancel this operation.")
(set-break-env))
(defun set-break-env ()
(setq *break-lexenv* (ihs-env *ihs-current*))
(setq *break-lexenv* (ihs-lex *ihs-current*))
(setq *break-locals* (ihs-lcl *ihs-current*)))
(defun ihs-search (string unrestricted &optional (start (si::ihs-top)))
@ -1310,7 +1310,8 @@ Use the following functions to directly access ECL stacks.
Invocation History Stack:
(SYS:IHS-TOP) Returns the index of the TOP of the IHS.
(SYS:IHS-FUN i) Returns the function of the i-th entity in IHS.
(SYS:IHS-ENV i)
(SYS:IHS-LEX i) Returns the lexical environment of the i-th entry in IHS.
(SYS:IHS-LCL i) Returns the local environment of the i-th entry in IHS.
(SYS:IHS-PREV i)
(SYS:IHS-NEXT i)