eval closures as applicable smobs

[Keisuke Nishida]

Hello,

This is a patch to define eval closures as applicable smobs.
May I commit it?  Performance is almost same or slightly improved:

Before:
bash$ time guile -e 'quit'
0.81user 0.31system 0:01.21elapsed 91%CPU (0avgtext+0avgdata 0maxresident)k
0inputs+0outputs (269major+526minor)pagefaults 0swaps
bash$ time guile -e 'quit'
0.81user 0.02system 0:00.82elapsed 100%CPU (0avgtext+0avgdata 0maxresident)k
0inputs+0outputs (269major+526minor)pagefaults 0swaps
bash$ time guile -e 'quit'
0.79user 0.02system 0:00.81elapsed 99%CPU (0avgtext+0avgdata 0maxresident)k
0inputs+0outputs (269major+526minor)pagefaults 0swaps

After:
bash$ time guile -e 'quit'
0.78user 0.02system 0:00.82elapsed 96%CPU (0avgtext+0avgdata 0maxresident)k
0inputs+0outputs (269major+526minor)pagefaults 0swaps
bash$ time guile -e 'quit'
0.80user 0.03system 0:00.82elapsed 100%CPU (0avgtext+0avgdata 0maxresident)k
0inputs+0outputs (269major+526minor)pagefaults 0swaps
bash$ time guile -e 'quit'
0.81user 0.01system 0:00.82elapsed 99%CPU (0avgtext+0avgdata 0maxresident)k
0inputs+0outputs (269major+526minor)pagefaults 0swaps

-- Kei

Index: modules.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/modules.c,v
retrieving revision 1.14
diff -c -r1.14 modules.c
*** modules.c   2000/09/02 23:21:57     1.14
--- modules.c   2000/09/10 13:49:27
***************
*** 47,52 ****
--- 47,53 ----
  #include "libguile/_scm.h"
  
  #include "libguile/eval.h"
+ #include "libguile/smob.h"
  #include "libguile/procprop.h"
  #include "libguile/vectors.h"
  #include "libguile/hashtab.h"
***************
*** 240,251 ****
    }
  }
  
! static SCM f_eval_closure;
  
! static SCM
! eval_closure (SCM cclo, SCM sym, SCM definep)
  {
!   SCM module = SCM_VELTS (cclo) [1];
    if (SCM_NFALSEP (definep))
      return scm_apply (SCM_CDR (module_make_local_var_x),
                      SCM_LIST2 (module, sym),
--- 241,252 ----
    }
  }
  
! SCM scm_eval_closure_tag;
  
! SCM
! scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep)
  {
!   SCM module = SCM_PACK (SCM_SMOB_DATA (eclo));
    if (SCM_NFALSEP (definep))
      return scm_apply (SCM_CDR (module_make_local_var_x),
                      SCM_LIST2 (module, sym),
***************
*** 259,267 ****
            "")
  #define FUNC_NAME s_scm_standard_eval_closure
  {
!   SCM cclo = scm_makcclo (f_eval_closure, 2);
!   SCM_VELTS (cclo) [1] = module;
!   return cclo;
  }
  #undef FUNC_NAME
  
--- 260,266 ----
            "")
  #define FUNC_NAME s_scm_standard_eval_closure
  {
!   SCM_RETURN_NEWSMOB (scm_eval_closure_tag, SCM_UNPACK (module));
  }
  #undef FUNC_NAME
  
***************
*** 271,280 ****
  #include "libguile/modules.x"
    module_make_local_var_x = scm_sysintern ("module-make-local-var!",
                                           SCM_UNDEFINED);
!   f_eval_closure = scm_make_subr_opt ("eval-closure",
!                                     scm_tc7_subr_3,
!                                     eval_closure,
!                                     0);
  }
  
  void
--- 270,278 ----
  #include "libguile/modules.x"
    module_make_local_var_x = scm_sysintern ("module-make-local-var!",
                                           SCM_UNDEFINED);
!   scm_eval_closure_tag = scm_make_smob_type ("eval-closure", 0);
!   scm_set_smob_mark (scm_eval_closure_tag, scm_markcdr);
!   scm_set_smob_apply (scm_eval_closure_tag, scm_eval_closure_lookup, 2, 0, 0);
  }
  
  void
Index: modules.h
===================================================================
RCS file: /cvs/guile/guile-core/libguile/modules.h,v
retrieving revision 1.8
diff -c -r1.8 modules.h
*** modules.h   2000/08/11 08:44:16     1.8
--- modules.h   2000/09/10 13:49:27
***************
*** 73,82 ****
--- 73,85 ----
  #define SCM_MODULE_EVAL_CLOSURE(module) \
    SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_eval_closure])
  
+ #define SCM_EVAL_CLOSURE_P(OBJ)       SCM_SMOB_PREDICATE 
(scm_eval_closure_tag, OBJ)
+ 
  
  
  extern SCM scm_module_system_booted_p;
  extern SCM scm_module_tag;
+ extern SCM scm_eval_closure_tag;
  
  extern SCM scm_the_root_module (void);
  extern SCM scm_selected_module (void);
***************
*** 90,95 ****
--- 93,99 ----
  extern SCM scm_env_top_level (SCM env);
  extern SCM scm_top_level_env (SCM thunk);
  extern SCM scm_system_module_env_p (SCM env);
+ extern SCM scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep);
  extern SCM scm_standard_eval_closure (SCM module);
  extern void scm_init_modules (void);
  extern void scm_post_boot_init_modules (void);
Index: symbols.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/symbols.c,v
retrieving revision 1.49
diff -c -r1.49 symbols.c
*** symbols.c   2000/09/06 14:45:59     1.49
--- symbols.c   2000/09/10 13:49:27
***************
*** 48,53 ****
--- 48,54 ----
  #include "libguile/_scm.h"
  #include "libguile/chars.h"
  #include "libguile/eval.h"
+ #include "libguile/smob.h"
  #include "libguile/variable.h"
  #include "libguile/alist.h"
  #include "libguile/fluids.h"
***************
*** 112,121 ****
      {
        SCM var;
  
!       if (SCM_TYP7 (thunk) == scm_tc7_cclo
!         && SCM_TYP7 (SCM_CCLO_SUBR (thunk)) == scm_tc7_subr_3)
        /* Bypass evaluator in the standard case. */
!       var = SCM_SUBRF (SCM_CCLO_SUBR (thunk)) (thunk, sym, definep);
        else
        var = scm_apply (thunk, sym, scm_cons (definep, scm_listofnull));
  
--- 113,121 ----
      {
        SCM var;
  
!       if (SCM_EVAL_CLOSURE_P (thunk))
        /* Bypass evaluator in the standard case. */
!       var = scm_eval_closure_lookup (thunk, sym, definep);
        else
        var = scm_apply (thunk, sym, scm_cons (definep, scm_listofnull));