libguile/debug.c

   1 /* Debugging extensions for Guile
   2  * Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation; either version 2, or (at your option)
   7  * any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this software; see the file COPYING.  If not, write to
  16  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  17  * Boston, MA 02111-1307 USA
  18  *
  19  * As a special exception, the Free Software Foundation gives permission
  20  * for additional uses of the text contained in its release of GUILE.
  21  *
  22  * The exception is that, if you link the GUILE library with other files
  23  * to produce an executable, this does not by itself cause the
  24  * resulting executable to be covered by the GNU General Public License.
  25  * Your use of that executable is in no way restricted on account of
  26  * linking the GUILE library code into it.
  27  *
  28  * This exception does not however invalidate any other reasons why
  29  * the executable file might be covered by the GNU General Public License.
  30  *
  31  * This exception applies only to the code released by the
  32  * Free Software Foundation under the name GUILE.  If you copy
  33  * code from other Free Software Foundation releases into a copy of
  34  * GUILE, as the General Public License permits, the exception does
  35  * not apply to the code that you add in this way.  To avoid misleading
  36  * anyone as to the status of such modified files, you must delete
  37  * this exception notice from them.
  38  *
  39  * If you write modifications of your own for GUILE, it is your choice
  40  * whether to permit this exception to apply to your modifications.
  41  * If you do not wish that, delete this exception notice.
  42  *
  43  * The author can be reached at djurfeldt@nada.kth.se
  44  * Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN */
  45
  46
  47
  48 #include "libguile/_scm.h"
  49 #include "libguile/eval.h"
  50 #include "libguile/stackchk.h"
  51 #include "libguile/throw.h"
  52 #include "libguile/macros.h"
  53 #include "libguile/smob.h"
  54 #include "libguile/procprop.h"
  55 #include "libguile/srcprop.h"
  56 #include "libguile/alist.h"
  57 #include "libguile/continuations.h"
  58 #include "libguile/strports.h"
  59 #include "libguile/read.h"
  60 #include "libguile/feature.h"
  61 #include "libguile/dynwind.h"
  62 #include "libguile/modules.h"
  63 #include "libguile/ports.h"
  64 #include "libguile/root.h"
  65 #include "libguile/fluids.h"
  66
  67 #include "libguile/validate.h"
  68 #include "libguile/debug.h"
  69 \f
  70
  71 /* {Run time control of the debugging evaluator}
  72  */
  73
  74 SCM_DEFINE (scm_debug_options, "debug-options-interface", 0, 1, 0,
  75             (SCM setting),
  76             "Option interface for the debug options. Instead of using\n"
  77             "this procedure directly, use the procedures @code{debug-enable},\n"
  78             "@code{debug-disable}, @code{debug-set!} and @var{debug-options}.")
  79 #define FUNC_NAME s_scm_debug_options
  80 {
  81   SCM ans;
  82   SCM_DEFER_INTS;
  83   ans = scm_options (setting,
  84                      scm_debug_opts,
  85                      SCM_N_DEBUG_OPTIONS,
  86                      FUNC_NAME);
  87 #ifndef SCM_RECKLESS
  88   if (!(1 <= SCM_N_FRAMES && SCM_N_FRAMES <= SCM_MAX_FRAME_SIZE))
  89     {
  90       scm_options (ans, scm_debug_opts, SCM_N_DEBUG_OPTIONS, FUNC_NAME);
  91       SCM_OUT_OF_RANGE (1, setting);
  92     }
  93 #endif
  94   SCM_RESET_DEBUG_MODE;
  95   scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
  96   scm_debug_eframe_size = 2 * SCM_N_FRAMES;
  97   SCM_ALLOW_INTS;
  98   return ans;
  99 }
 100 #undef FUNC_NAME
 101
 102 static void
 103 with_traps_before (void *data)
 104 {
 105   int *trap_flag = data;
 106   *trap_flag = SCM_TRAPS_P;
 107   SCM_TRAPS_P = 1;
 108 }
 109
 110 static void
 111 with_traps_after (void *data)
 112 {
 113   int *trap_flag = data;
 114   SCM_TRAPS_P = *trap_flag;
 115 }
 116
 117 static SCM
 118 with_traps_inner (void *data)
 119 {
 120   SCM thunk = SCM_PACK (data);
 121   return scm_call_0 (thunk);
 122 }
 123
 124 SCM_DEFINE (scm_with_traps, "with-traps", 1, 0, 0,
 125             (SCM thunk),
 126             "Call @var{thunk} with traps enabled.")
 127 #define FUNC_NAME s_scm_with_traps
 128 {
 129   int trap_flag;
 130   SCM_VALIDATE_THUNK (1,thunk);
 131   return scm_internal_dynamic_wind (with_traps_before,
 132                                     with_traps_inner,
 133                                     with_traps_after,
 134                                     (void *) SCM_UNPACK (thunk),
 135                                     &trap_flag);
 136 }
 137 #undef FUNC_NAME
 138
 139 \f
 140
 141 SCM_SYMBOL (scm_sym_procname, "procname");
 142 SCM_SYMBOL (scm_sym_dots, "...");
 143 SCM_SYMBOL (scm_sym_source, "source");
 144
 145 /* {Memoized Source}
 146  */
 147
 148 scm_t_bits scm_tc16_memoized;
 149
 150 static int
 151 memoized_print (SCM obj, SCM port, scm_print_state *pstate)
 152 {
 153   int writingp = SCM_WRITINGP (pstate);
 154   scm_puts ("#<memoized ", port);
 155   SCM_SET_WRITINGP (pstate, 1);
 156 #ifdef GUILE_DEBUG
 157   scm_iprin1 (SCM_MEMOIZED_EXP (obj), port, pstate);
 158 #else
 159   scm_iprin1 (scm_unmemoize (obj), port, pstate);
 160 #endif
 161   SCM_SET_WRITINGP (pstate, writingp);
 162   scm_putc ('>', port);
 163   return 1;
 164 }
 165
 166 SCM_DEFINE (scm_memoized_p, "memoized?", 1, 0, 0,
 167             (SCM obj),
 168             "Return @code{#t} if @var{obj} is memoized.")
 169 #define FUNC_NAME s_scm_memoized_p
 170 {
 171   return SCM_BOOL(SCM_MEMOIZEDP (obj));
 172 }
 173 #undef FUNC_NAME
 174
 175 SCM
 176 scm_make_memoized (SCM exp, SCM env)
 177 {
 178   /* *fixme* Check that env is a valid environment. */
 179   register SCM z, ans;
 180   SCM_ENTER_A_SECTION;
 181   SCM_NEWSMOB (z, SCM_UNPACK (exp), SCM_UNPACK (env));
 182   SCM_NEWSMOB (ans, scm_tc16_memoized, SCM_UNPACK (z));
 183   SCM_EXIT_A_SECTION;
 184   return ans;
 185 }
 186
 187 #ifdef GUILE_DEBUG
 188 /*
 189  * Some primitives for construction of memoized code
 190  *
 191  * - procedure: memcons CAR CDR [ENV]
 192  *
 193  *     Construct a pair, encapsulated in a memoized object.
 194  *
 195  *     The CAR and CDR can be either normal or memoized.  If ENV isn't
 196  *     specified, the top-level environment of the current module will
 197  *     be assumed.  All environments must match.
 198  *
 199  * - procedure: make-iloc FRAME BINDING CDRP
 200  *
 201  *     Return an iloc referring to frame no. FRAME, binding
 202  *     no. BINDING.  If CDRP is non-#f, the iloc is referring to a
 203  *     frame consisting of a single pair, with the value stored in the
 204  *     CDR.
 205  *
 206  * - procedure: iloc? OBJECT
 207  *
 208  *     Return #t if OBJECT is an iloc.
 209  *
 210  * - procedure: mem->proc MEMOIZED
 211  *
 212  *     Construct a closure from the memoized lambda expression MEMOIZED
 213  *
 214  *     WARNING! The code is not copied!
 215  *
 216  * - procedure: proc->mem CLOSURE
 217  *
 218  *     Turn the closure CLOSURE into a memoized object.
 219  *
 220  *     WARNING! The code is not copied!
 221  *
 222  * - constant: SCM_IM_AND
 223  * - constant: SCM_IM_BEGIN
 224  * - constant: SCM_IM_CASE
 225  * - constant: SCM_IM_COND
 226  * - constant: SCM_IM_DO
 227  * - constant: SCM_IM_IF
 228  * - constant: SCM_IM_LAMBDA
 229  * - constant: SCM_IM_LET
 230  * - constant: SCM_IM_LETSTAR
 231  * - constant: SCM_IM_LETREC
 232  * - constant: SCM_IM_OR
 233  * - constant: SCM_IM_QUOTE
 234  * - constant: SCM_IM_SET
 235  * - constant: SCM_IM_DEFINE
 236  * - constant: SCM_IM_APPLY
 237  * - constant: SCM_IM_CONT
 238  * - constant: SCM_IM_DISPATCH
 239  */
 240
 241 #include "libguile/variable.h"
 242 #include "libguile/procs.h"
 243
 244 SCM_DEFINE (scm_make_iloc, "make-iloc", 3, 0, 0,
 245             (SCM frame, SCM binding, SCM cdrp),
 246             "Return a new iloc with frame offset @var{frame}, binding\n"
 247             "offset @var{binding} and the cdr flag @var{cdrp}.")
 248 #define FUNC_NAME s_scm_make_iloc
 249 {
 250   SCM_VALIDATE_INUM (1,frame);
 251   SCM_VALIDATE_INUM (2,binding);
 252   return SCM_PACK (SCM_UNPACK (SCM_ILOC00)
 253                    + SCM_IFRINC * SCM_INUM (frame)
 254                    + (SCM_NFALSEP (cdrp) ? SCM_ICDR : 0)
 255                    + SCM_IDINC * SCM_INUM (binding));
 256 }
 257 #undef FUNC_NAME
 258
 259 SCM_DEFINE (scm_iloc_p, "iloc?", 1, 0, 0,
 260           (SCM obj),
 261             "Return @code{#t} if @var{obj} is an iloc.")
 262 #define FUNC_NAME s_scm_iloc_p
 263 {
 264   return SCM_BOOL(SCM_ILOCP (obj));
 265 }
 266 #undef FUNC_NAME
 267
 268 SCM_DEFINE (scm_memcons, "memcons", 2, 1, 0,
 269             (SCM car, SCM cdr, SCM env),
 270             "Return a new memoized cons cell with @var{car} and @var{cdr}\n"
 271             "as members and @var{env} as the environment.")
 272 #define FUNC_NAME s_scm_memcons
 273 {
 274   if (SCM_MEMOIZEDP (car))
 275     {
 276       /*fixme* environments may be two different but equal top-level envs */
 277       if (!SCM_UNBNDP (env) && SCM_MEMOIZED_ENV (car) != env)
 278         SCM_MISC_ERROR ("environment mismatch arg1 <-> arg3",
 279                         scm_cons2 (car, env, SCM_EOL));
 280       else
 281         env = SCM_MEMOIZED_ENV (car);
 282       car = SCM_MEMOIZED_EXP (car);
 283     }
 284   if (SCM_MEMOIZEDP (cdr))
 285     {
 286       if (!SCM_UNBNDP (env) && SCM_MEMOIZED_ENV (cdr) != env)
 287         SCM_MISC_ERROR ("environment mismatch arg2 <-> arg3",
 288                         scm_cons2 (cdr, env, SCM_EOL));
 289       else
 290         env = SCM_MEMOIZED_ENV (cdr);
 291       cdr = SCM_MEMOIZED_EXP (cdr);
 292     }
 293   if (SCM_UNBNDP (env))
 294     env = scm_top_level_env (SCM_TOP_LEVEL_LOOKUP_CLOSURE);
 295   else
 296     SCM_VALIDATE_NULLORCONS (3,env);
 297   return scm_make_memoized (scm_cons (car, cdr), env);
 298 }
 299 #undef FUNC_NAME
 300
 301 SCM_DEFINE (scm_mem_to_proc, "mem->proc", 1, 0, 0,
 302             (SCM obj),
 303             "Convert a memoized object (which must be a lambda expression)\n"
 304             "to a procedure.")
 305 #define FUNC_NAME s_scm_mem_to_proc
 306 {
 307   SCM env;
 308   SCM_VALIDATE_MEMOIZED (1,obj);
 309   env = SCM_MEMOIZED_ENV (obj);
 310   obj = SCM_MEMOIZED_EXP (obj);
 311   if (!(SCM_NIMP (obj) && SCM_CAR (obj) == SCM_IM_LAMBDA))
 312     SCM_MISC_ERROR ("expected lambda expression",
 313                     scm_cons (obj, SCM_EOL));
 314   return scm_closure (SCM_CDR (obj), env);
 315 }
 316 #undef FUNC_NAME
 317
 318 SCM_DEFINE (scm_proc_to_mem, "proc->mem", 1, 0, 0,
 319             (SCM obj),
 320             "Convert a procedure to a memoized object.")
 321 #define FUNC_NAME s_scm_proc_to_mem
 322 {
 323   SCM_VALIDATE_CLOSURE (1, obj);
 324   return scm_make_memoized (scm_cons (SCM_IM_LAMBDA, SCM_CODE (obj)),
 325                             SCM_ENV (obj));
 326 }
 327 #undef FUNC_NAME
 328
 329 #endif /* GUILE_DEBUG */
 330
 331 SCM_DEFINE (scm_unmemoize, "unmemoize", 1, 0, 0,
 332             (SCM m),
 333             "Unmemoize the memoized expression @var{m},")
 334 #define FUNC_NAME s_scm_unmemoize
 335 {
 336   SCM_VALIDATE_MEMOIZED (1,m);
 337   return scm_unmemocopy (SCM_MEMOIZED_EXP (m), SCM_MEMOIZED_ENV (m));
 338 }
 339 #undef FUNC_NAME
 340
 341 SCM_DEFINE (scm_memoized_environment, "memoized-environment", 1, 0, 0,
 342             (SCM m),
 343             "Return the environment of the memoized expression @var{m}.")
 344 #define FUNC_NAME s_scm_memoized_environment
 345 {
 346   SCM_VALIDATE_MEMOIZED (1,m);
 347   return SCM_MEMOIZED_ENV (m);
 348 }
 349 #undef FUNC_NAME
 350
 351 SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
 352             (SCM proc),
 353             "Return the name of the procedure @var{proc}")
 354 #define FUNC_NAME s_scm_procedure_name
 355 {
 356   SCM_VALIDATE_PROC (1,proc);
 357   switch (SCM_TYP7 (proc)) {
 358   case scm_tcs_subrs:
 359     return SCM_SNAME (proc);
 360   default:
 361     {
 362       SCM name = scm_procedure_property (proc, scm_sym_name);
 363 #if 0
 364       /* Source property scm_sym_procname not implemented yet... */
 365       SCM name = scm_source_property (SCM_CAR (SCM_CDR (SCM_CODE (proc))), scm_sym_procname);
 366       if (SCM_FALSEP (name))
 367         name = scm_procedure_property (proc, scm_sym_name);
 368 #endif
 369       if (SCM_FALSEP (name) && SCM_CLOSUREP (proc))
 370         name = scm_reverse_lookup (SCM_ENV (proc), proc);
 371       return name;
 372     }
 373   }
 374 }
 375 #undef FUNC_NAME
 376
 377 SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0,
 378             (SCM proc),
 379             "Return the source of the procedure @var{proc}.")
 380 #define FUNC_NAME s_scm_procedure_source
 381 {
 382   SCM_VALIDATE_NIM (1,proc);
 383   switch (SCM_TYP7 (proc)) {
 384   case scm_tcs_closures:
 385     {
 386       SCM formals = SCM_CLOSURE_FORMALS (proc);
 387       SCM src = scm_source_property (SCM_CDR (SCM_CODE (proc)), scm_sym_copy);
 388       if (!SCM_FALSEP (src))
 389         return scm_cons2 (scm_sym_lambda, formals, src);
 390       return scm_cons (scm_sym_lambda,
 391                        scm_unmemocopy (SCM_CODE (proc),
 392                                        SCM_EXTEND_ENV (formals,
 393                                                        SCM_EOL,
 394                                                        SCM_ENV (proc))));
 395     }
 396   case scm_tcs_subrs:
 397 #ifdef CCLO
 398   case scm_tc7_cclo:
 399 #endif
 400     /* It would indeed be a nice thing if we supplied source even for
 401        built in procedures! */
 402     return scm_procedure_property (proc, scm_sym_source);
 403   default:
 404     SCM_WRONG_TYPE_ARG (1, proc);
 405     /* not reached */
 406   }
 407 }
 408 #undef FUNC_NAME
 409
 410 SCM_DEFINE (scm_procedure_environment, "procedure-environment", 1, 0, 0,
 411             (SCM proc),
 412             "Return the environment of the procedure @var{proc}.")
 413 #define FUNC_NAME s_scm_procedure_environment
 414 {
 415   SCM_VALIDATE_NIM (1,proc);
 416   switch (SCM_TYP7 (proc)) {
 417   case scm_tcs_closures:
 418     return SCM_ENV (proc);
 419   case scm_tcs_subrs:
 420 #ifdef CCLO
 421   case scm_tc7_cclo:
 422 #endif
 423     return SCM_EOL;
 424   default:
 425     SCM_WRONG_TYPE_ARG (1, proc);
 426     /* not reached */
 427   }
 428 }
 429 #undef FUNC_NAME
 430
 431 \f
 432
 433 /* Eval in a local environment.  We would like to have the ability to
 434  * evaluate in a specified local environment, but due to the
 435  * memoization this isn't normally possible.  We solve it by copying
 436  * the code before evaluating.  One solution would be to have eval.c
 437  * generate yet another evaluator.  They are not very big actually.
 438  */
 439 SCM_DEFINE (scm_local_eval, "local-eval", 1, 1, 0,
 440             (SCM exp, SCM env),
 441             "Evaluate @var{exp} in its environment.  If @var{env} is supplied,\n"
 442             "it is the environment in which to evaluate @var{exp}.  Otherwise,\n"
 443             "@var{exp} must be a memoized code object (in which case, its environment\n"
 444             "is implicit).")
 445 #define FUNC_NAME s_scm_local_eval
 446 {
 447   if (SCM_UNBNDP (env))
 448   {
 449     SCM_VALIDATE_MEMOIZED (1, exp);
 450     return scm_i_eval_x (SCM_MEMOIZED_EXP (exp), SCM_MEMOIZED_ENV (exp));
 451   }
 452   return scm_i_eval (exp, env);
 453 }
 454 #undef FUNC_NAME
 455
 456 #if 0
 457 SCM_REGISTER_PROC (s_reverse_lookup, "reverse-lookup", 2, 0, 0, scm_reverse_lookup);
 458 #endif
 459
 460 SCM
 461 scm_reverse_lookup (SCM env, SCM data)
 462 {
 463   while (SCM_CONSP (env) && SCM_CONSP (SCM_CAR (env)))
 464     {
 465       SCM names = SCM_CAAR (env);
 466       SCM values = SCM_CDAR (env);
 467       while (SCM_CONSP (names))
 468         {
 469           if (SCM_EQ_P (SCM_CAR (values), data))
 470             return SCM_CAR (names);
 471           names = SCM_CDR (names);
 472           values = SCM_CDR (values);
 473         }
 474       if (!SCM_NULLP (names) && SCM_EQ_P (values, data))
 475         return names;
 476       env = SCM_CDR (env);
 477     }
 478   return SCM_BOOL_F;
 479 }
 480
 481 SCM
 482 scm_start_stack (SCM id, SCM exp, SCM env)
 483 {
 484   SCM answer;
 485   scm_t_debug_frame vframe;
 486   scm_t_debug_info vframe_vect_body;
 487   vframe.prev = scm_last_debug_frame;
 488   vframe.status = SCM_VOIDFRAME;
 489   vframe.vect = &vframe_vect_body;
 490   vframe.vect[0].id = id;
 491   scm_last_debug_frame = &vframe;
 492   answer = scm_i_eval (exp, env);
 493   scm_last_debug_frame = vframe.prev;
 494   return answer;
 495 }
 496
 497 SCM_SYNTAX(s_start_stack, "start-stack", scm_makacro, scm_m_start_stack);
 498
 499 static SCM
 500 scm_m_start_stack (SCM exp, SCM env)
 501 #define FUNC_NAME s_start_stack
 502 {
 503   exp = SCM_CDR (exp);
 504   if (!SCM_CONSP (exp)
 505       || !SCM_CONSP (SCM_CDR (exp))
 506       || !SCM_NULLP (SCM_CDDR (exp)))
 507     SCM_WRONG_NUM_ARGS ();
 508   return scm_start_stack (scm_eval_car (exp, env), SCM_CADR (exp), env);
 509 }
 510 #undef FUNC_NAME
 511
 512
 513 /* {Debug Objects}
 514  *
 515  * The debugging evaluator throws these on frame traps.
 516  */
 517
 518 scm_t_bits scm_tc16_debugobj;
 519
 520 static int
 521 debugobj_print (SCM obj, SCM port, scm_print_state *pstate SCM_UNUSED)
 522 {
 523   scm_puts ("#<debug-object ", port);
 524   scm_intprint ((int) SCM_DEBUGOBJ_FRAME (obj), 16, port);
 525   scm_putc ('>', port);
 526   return 1;
 527 }
 528
 529 SCM_DEFINE (scm_debug_object_p, "debug-object?", 1, 0, 0,
 530             (SCM obj),
 531             "Return @code{#t} if @var{obj} is a debug object.")
 532 #define FUNC_NAME s_scm_debug_object_p
 533 {
 534   return SCM_BOOL(SCM_DEBUGOBJP (obj));
 535 }
 536 #undef FUNC_NAME
 537
 538
 539 SCM
 540 scm_make_debugobj (scm_t_debug_frame *frame)
 541 {
 542   register SCM z;
 543   SCM_NEWCELL (z);
 544   SCM_ENTER_A_SECTION;
 545   SCM_SET_DEBUGOBJ_FRAME (z, frame);
 546   SCM_SET_CELL_TYPE (z, scm_tc16_debugobj);
 547   SCM_EXIT_A_SECTION;
 548   return z;
 549 }
 550
 551 \f
 552
 553 /* Undocumented debugging procedure */
 554 #ifdef GUILE_DEBUG
 555 SCM_DEFINE (scm_debug_hang, "debug-hang", 0, 1, 0,
 556             (SCM obj),
 557             "Go into an endless loop, which can be only terminated with\n"
 558             "a debugger.")
 559 #define FUNC_NAME s_scm_debug_hang
 560 {
 561   int go = 0;
 562   while (!go) ;
 563   return SCM_UNSPECIFIED;
 564 }
 565 #undef FUNC_NAME
 566 #endif
 567
 568 \f
 569
 570 void
 571 scm_init_debug ()
 572 {
 573   scm_init_opts (scm_debug_options, scm_debug_opts, SCM_N_DEBUG_OPTIONS);
 574
 575   scm_tc16_memoized = scm_make_smob_type ("memoized", 0);
 576   scm_set_smob_mark (scm_tc16_memoized, scm_markcdr);
 577   scm_set_smob_print (scm_tc16_memoized, memoized_print);
 578
 579   scm_tc16_debugobj = scm_make_smob_type ("debug-object", 0);
 580   scm_set_smob_print (scm_tc16_debugobj, debugobj_print);
 581
 582 #ifdef GUILE_DEBUG
 583   scm_c_define ("SCM_IM_AND", SCM_IM_AND);
 584   scm_c_define ("SCM_IM_BEGIN", SCM_IM_BEGIN);
 585   scm_c_define ("SCM_IM_CASE", SCM_IM_CASE);
 586   scm_c_define ("SCM_IM_COND", SCM_IM_COND);
 587   scm_c_define ("SCM_IM_DO", SCM_IM_DO);
 588   scm_c_define ("SCM_IM_IF", SCM_IM_IF);
 589   scm_c_define ("SCM_IM_LAMBDA", SCM_IM_LAMBDA);
 590   scm_c_define ("SCM_IM_LET", SCM_IM_LET);
 591   scm_c_define ("SCM_IM_LETSTAR", SCM_IM_LETSTAR);
 592   scm_c_define ("SCM_IM_LETREC", SCM_IM_LETREC);
 593   scm_c_define ("SCM_IM_OR", SCM_IM_OR);
 594   scm_c_define ("SCM_IM_QUOTE", SCM_IM_QUOTE);
 595   scm_c_define ("SCM_IM_SET_X", SCM_IM_SET_X);
 596   scm_c_define ("SCM_IM_DEFINE", SCM_IM_DEFINE);
 597   scm_c_define ("SCM_IM_APPLY", SCM_IM_APPLY);
 598   scm_c_define ("SCM_IM_CONT", SCM_IM_CONT);
 599   scm_c_define ("SCM_IM_DISPATCH", SCM_IM_DISPATCH);
 600 #endif
 601   scm_add_feature ("debug-extensions");
 602
 603 #ifndef SCM_MAGIC_SNARFER
 604 #include "libguile/debug.x"
 605 #endif
 606 }
 607
 608 /*
 609   Local Variables:
 610   c-file-style: "gnu"
 611   End:
 612 */