libguile/debug.c

   1 /* Debugging extensions for Guile
   2  * Copyright (C) 1995, 1996, 1997, 1998 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 #include <stdio.h>
  47 #include "_scm.h"
  48 #include "eval.h"
  49 #include "stackchk.h"
  50 #include "throw.h"
  51 #include "genio.h"
  52 #include "macros.h"
  53 #include "smob.h"
  54 #include "procprop.h"
  55 #include "srcprop.h"
  56 #include "alist.h"
  57 #include "continuations.h"
  58 #include "strports.h"
  59 #include "read.h"
  60 #include "feature.h"
  61 #include "dynwind.h"
  62
  63 #include "debug.h"
  64 \f
  65
  66 /* {Run time control of the debugging evaluator}
  67  */
  68
  69 SCM_PROC (s_debug_options, "debug-options-interface", 0, 1, 0, scm_debug_options);
  70
  71 SCM
  72 scm_debug_options (setting)
  73      SCM setting;
  74 {
  75   SCM ans;
  76   SCM_DEFER_INTS;
  77   ans = scm_options (setting,
  78                      scm_debug_opts,
  79                      SCM_N_DEBUG_OPTIONS,
  80                      s_debug_options);
  81 #ifndef SCM_RECKLESS
  82   if (!(1 <= SCM_N_FRAMES && SCM_N_FRAMES <= SCM_MAX_FRAME_SIZE))
  83     {
  84       scm_options (ans, scm_debug_opts, SCM_N_DEBUG_OPTIONS, s_debug_options);
  85       scm_out_of_range (s_debug_options, setting);
  86     }
  87 #endif
  88   SCM_RESET_DEBUG_MODE;
  89   scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
  90   scm_debug_eframe_size = 2 * SCM_N_FRAMES;
  91   SCM_ALLOW_INTS
  92   return ans;
  93 }
  94
  95 SCM_PROC (s_with_traps, "with-traps", 1, 0, 0, scm_with_traps);
  96
  97 static void
  98 with_traps_before (void *data)
  99 {
 100   int *trap_flag = data;
 101   *trap_flag = SCM_TRAPS_P;
 102   SCM_TRAPS_P = 1;
 103 }
 104
 105 static void
 106 with_traps_after (void *data)
 107 {
 108   int *trap_flag = data;
 109   SCM_TRAPS_P = *trap_flag;
 110 }
 111
 112 static SCM
 113 with_traps_inner (void *data)
 114 {
 115   SCM thunk = (SCM) data;
 116   return scm_apply (thunk, SCM_EOL, SCM_EOL);
 117 }
 118
 119 SCM
 120 scm_with_traps (SCM thunk)
 121 {
 122   int trap_flag;
 123   SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)),
 124               thunk,
 125               SCM_ARG1,
 126               s_with_traps);
 127   return scm_internal_dynamic_wind (with_traps_before,
 128                                     with_traps_inner,
 129                                     with_traps_after,
 130                                     (void *) thunk,
 131                                     &trap_flag);
 132 }
 133
 134 \f
 135 static SCM scm_i_source, scm_i_more;
 136 static SCM scm_i_proc, scm_i_args, scm_i_eval_args;
 137 static SCM scm_i_procname;
 138
 139 /* {Memoized Source}
 140  */
 141
 142 long scm_tc16_memoized;
 143
 144
 145 static int prinmemoized SCM_P ((SCM obj, SCM port, scm_print_state *pstate));
 146
 147 static int
 148 prinmemoized (obj, port, pstate)
 149      SCM obj;
 150      SCM port;
 151      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 static scm_smobfuns memoizedsmob =
 167 {scm_markcdr, scm_free0, prinmemoized, 0};
 168
 169 SCM_PROC (s_memoized_p, "memoized?", 1, 0, 0, scm_memoized_p);
 170
 171 SCM
 172 scm_memoized_p (obj)
 173      SCM obj;
 174 {
 175   return SCM_NIMP (obj) && SCM_MEMOIZEDP (obj) ? SCM_BOOL_T : SCM_BOOL_F;
 176 }
 177
 178 SCM
 179 scm_make_memoized (exp, env)
 180      SCM exp;
 181      SCM env;
 182 {
 183   /* *fixme* Check that env is a valid environment. */
 184   register SCM z, ans;
 185   SCM_ENTER_A_SECTION;
 186   SCM_NEWCELL (z);
 187   SCM_SETCDR (z, env);
 188   SCM_SETCAR (z, exp);
 189   SCM_NEWCELL (ans);
 190   SCM_SETCDR (ans, z);
 191   SCM_SETCAR (ans, scm_tc16_memoized);
 192   SCM_EXIT_A_SECTION;
 193   return ans;
 194 }
 195
 196 #ifdef GUILE_DEBUG
 197 /*
 198  * Some primitives for construction of memoized code
 199  *
 200  * - procedure: memcons CAR CDR [ENV]
 201  *
 202  *     Construct a pair, encapsulated in a memoized object.
 203  *
 204  *     The CAR and CDR can be either normal or memoized.  If ENV isn't
 205  *     specified, the top-level environment of the current module will
 206  *     be assumed.  All environments must match.
 207  *
 208  * - procedure: make-gloc VARIABLE [ENV]
 209  *
 210  *     Return a gloc, encapsulated in a memoized object.
 211  *
 212  *     (Glocs can't exist in normal list structures, since they will
 213  *     be mistaken for structs.)
 214  *
 215  * - procedure: gloc? OBJECT
 216  *
 217  *     Return #t if OBJECT is a memoized gloc.
 218  *
 219  * - procedure: make-iloc FRAME BINDING CDRP
 220  *
 221  *     Return an iloc referring to frame no. FRAME, binding
 222  *     no. BINDING.  If CDRP is non-#f, the iloc is referring to a
 223  *     frame consisting of a single pair, with the value stored in the
 224  *     CDR.
 225  *
 226  * - procedure: iloc? OBJECT
 227  *
 228  *     Return #t if OBJECT is an iloc.
 229  *
 230  * - procedure: mem->proc MEMOIZED
 231  *
 232  *     Construct a closure from the memoized lambda expression MEMOIZED
 233  *
 234  *     WARNING! The code is not copied!
 235  *
 236  * - procedure: proc->mem CLOSURE
 237  *
 238  *     Turn the closure CLOSURE into a memoized object.
 239  *
 240  *     WARNING! The code is not copied!
 241  *
 242  * - constant: SCM_IM_AND
 243  * - constant: SCM_IM_BEGIN
 244  * - constant: SCM_IM_CASE
 245  * - constant: SCM_IM_COND
 246  * - constant: SCM_IM_DO
 247  * - constant: SCM_IM_IF
 248  * - constant: SCM_IM_LAMBDA
 249  * - constant: SCM_IM_LET
 250  * - constant: SCM_IM_LETSTAR
 251  * - constant: SCM_IM_LETREC
 252  * - constant: SCM_IM_OR
 253  * - constant: SCM_IM_QUOTE
 254  * - constant: SCM_IM_SET
 255  * - constant: SCM_IM_DEFINE
 256  * - constant: SCM_IM_APPLY
 257  * - constant: SCM_IM_CONT
 258  * - constant: SCM_IM_DISPATCH
 259  */
 260
 261 #include "variable.h"
 262 #include "procs.h"
 263
 264 SCM_PROC (s_make_gloc, "make-gloc", 1, 1, 0, scm_make_gloc);
 265
 266 SCM
 267 scm_make_gloc (var, env)
 268      SCM var;
 269      SCM env;
 270 {
 271 #if 1 /* Unsafe */
 272   if (SCM_NIMP (var) && SCM_CONSP (var))
 273     var = scm_cons (SCM_BOOL_F, var);
 274   else
 275 #endif
 276   SCM_ASSERT (SCM_NIMP (var) && SCM_VARIABLEP (var),
 277               var,
 278               SCM_ARG1,
 279               s_make_gloc);
 280   if (SCM_UNBNDP (env))
 281     env = scm_top_level_env (SCM_CDR (scm_top_level_lookup_closure_var));
 282   else
 283     SCM_ASSERT (SCM_NULLP (env) || (SCM_NIMP (env) && SCM_CONSP (env)),
 284                 env,
 285                 SCM_ARG2,
 286                 s_make_gloc);
 287   return scm_make_memoized (SCM_VARVCELL (var) + 1, env);
 288 }
 289
 290 SCM_PROC (s_gloc_p, "gloc?", 1, 0, 0, scm_gloc_p);
 291
 292 SCM
 293 scm_gloc_p (obj)
 294      SCM obj;
 295 {
 296   return ((SCM_NIMP (obj)
 297            && SCM_MEMOIZEDP (obj)
 298            && (SCM_MEMOIZED_EXP (obj) & 7) == 1)
 299           ? SCM_BOOL_T
 300           : SCM_BOOL_F);
 301 }
 302
 303 SCM_PROC (s_make_iloc, "make-iloc", 3, 0, 0, scm_make_iloc);
 304
 305 SCM
 306 scm_make_iloc (frame, binding, cdrp)
 307      SCM frame;
 308      SCM binding;
 309      SCM cdrp;
 310 {
 311   SCM_ASSERT (SCM_INUMP (frame), frame, SCM_ARG1, s_make_iloc);
 312   SCM_ASSERT (SCM_INUMP (binding), binding, SCM_ARG2, s_make_iloc);
 313   return (SCM_ILOC00
 314           + SCM_IFRINC * SCM_INUM (frame)
 315           + (SCM_NFALSEP (cdrp) ? SCM_ICDR : 0)
 316           + SCM_IDINC * SCM_INUM (binding));
 317 }
 318
 319 SCM_PROC (s_iloc_p, "iloc?", 1, 0, 0, scm_iloc_p);
 320
 321 SCM
 322 scm_iloc_p (obj)
 323      SCM obj;
 324 {
 325   return SCM_ILOCP (obj) ? SCM_BOOL_T : SCM_BOOL_F;
 326 }
 327
 328 SCM_PROC (s_memcons, "memcons", 2, 1, 0, scm_memcons);
 329
 330 SCM
 331 scm_memcons (car, cdr, env)
 332      SCM car;
 333      SCM cdr;
 334      SCM env;
 335 {
 336   if (SCM_NIMP (car) && SCM_MEMOIZEDP (car))
 337     {
 338       /*fixme* environments may be two different but equal top-level envs */
 339       if (!SCM_UNBNDP (env) && SCM_MEMOIZED_ENV (car) != env)
 340         scm_misc_error (s_memcons,
 341                         "environment mismatch arg1 <-> arg3",
 342                         scm_cons2 (car, env, SCM_EOL));
 343       else
 344         env = SCM_MEMOIZED_ENV (car);
 345       car = SCM_MEMOIZED_EXP (car);
 346     }
 347   if (SCM_NIMP (cdr) && SCM_MEMOIZEDP (cdr))
 348     {
 349       if (!SCM_UNBNDP (env) && SCM_MEMOIZED_ENV (cdr) != env)
 350         scm_misc_error (s_memcons,
 351                         "environment mismatch arg2 <-> arg3",
 352                         scm_cons2 (cdr, env, SCM_EOL));
 353       else
 354         env = SCM_MEMOIZED_ENV (cdr);
 355       cdr = SCM_MEMOIZED_EXP (cdr);
 356     }
 357   if (SCM_UNBNDP (env))
 358     env = scm_top_level_env (SCM_CDR (scm_top_level_lookup_closure_var));
 359   else
 360     SCM_ASSERT (SCM_NULLP (env) || (SCM_NIMP (env) && SCM_CONSP (env)),
 361                 env,
 362                 SCM_ARG3,
 363                 s_make_iloc);
 364   return scm_make_memoized (scm_cons (car, cdr), env);
 365 }
 366
 367 SCM_PROC (s_mem_to_proc, "mem->proc", 1, 0, 0, scm_mem_to_proc);
 368
 369 SCM
 370 scm_mem_to_proc (obj)
 371      SCM obj;
 372 {
 373   SCM env;
 374   SCM_ASSERT (SCM_NIMP (obj) && SCM_MEMOIZEDP (obj),
 375               obj,
 376               SCM_ARG1,
 377               s_mem_to_proc);
 378   env = SCM_MEMOIZED_ENV (obj);
 379   obj = SCM_MEMOIZED_EXP (obj);
 380   if (!(SCM_NIMP (obj) && SCM_CAR (obj) == SCM_IM_LAMBDA))
 381     scm_misc_error (s_mem_to_proc,
 382                     "expected lambda expression",
 383                     scm_cons (obj, SCM_EOL));
 384   return scm_closure (SCM_CDR (obj), env);
 385 }
 386
 387 SCM_PROC (s_proc_to_mem, "proc->mem", 1, 0, 0, scm_proc_to_mem);
 388
 389 SCM
 390 scm_proc_to_mem (obj)
 391      SCM obj;
 392 {
 393   SCM_ASSERT (SCM_NIMP (obj) && SCM_CLOSUREP (obj),
 394               obj,
 395               SCM_ARG1,
 396               s_proc_to_mem);
 397   return scm_make_memoized (scm_cons (SCM_IM_LAMBDA, SCM_CODE (obj)),
 398                             SCM_ENV (obj));
 399 }
 400
 401 #endif /* GUILE_DEBUG */
 402
 403 SCM_PROC (s_unmemoize, "unmemoize", 1, 0, 0, scm_unmemoize);
 404
 405 SCM
 406 scm_unmemoize (m)
 407      SCM m;
 408 {
 409   SCM_ASSERT (SCM_NIMP (m) && SCM_MEMOIZEDP (m), m, SCM_ARG1, s_unmemoize);
 410   return scm_unmemocopy (SCM_MEMOIZED_EXP (m), SCM_MEMOIZED_ENV (m));
 411 }
 412
 413 SCM_PROC (s_memoized_environment, "memoized-environment", 1, 0, 0, scm_memoized_environment);
 414
 415 SCM
 416 scm_memoized_environment (m)
 417      SCM m;
 418 {
 419   SCM_ASSERT (SCM_NIMP (m) && SCM_MEMOIZEDP (m), m, SCM_ARG1, s_unmemoize);
 420   return SCM_MEMOIZED_ENV (m);
 421 }
 422
 423 SCM_PROC (s_procedure_name, "procedure-name", 1, 0, 0, scm_procedure_name);
 424
 425 SCM
 426 scm_procedure_name (proc)
 427      SCM proc;
 428 {
 429   SCM_ASSERT(scm_procedure_p (proc) == SCM_BOOL_T,
 430              proc,
 431              SCM_ARG1,
 432              s_procedure_name);
 433   switch (SCM_TYP7 (proc)) {
 434   case scm_tcs_closures:
 435   case scm_tc7_cclo:
 436     {
 437       SCM name = scm_procedure_property (proc, scm_i_name);
 438 #if 0
 439       /* Source property scm_i_procname not implemented yet... */
 440       SCM name = scm_source_property (SCM_CAR (SCM_CDR (SCM_CODE (proc))), scm_i_procname);
 441       if (SCM_FALSEP (name))
 442         name = scm_procedure_property (proc, scm_i_name);
 443 #endif
 444       if (SCM_FALSEP (name))
 445         name = scm_procedure_property (proc, scm_i_inner_name);
 446       return name;
 447     }
 448   case scm_tcs_subrs:
 449     return SCM_SNAME (proc);
 450   default:
 451     return SCM_BOOL_F;
 452   }
 453 }
 454
 455 SCM_PROC (s_procedure_source, "procedure-source", 1, 0, 0, scm_procedure_source);
 456
 457 SCM
 458 scm_procedure_source (proc)
 459      SCM proc;
 460 {
 461   SCM_ASSERT(SCM_NIMP (proc), proc, SCM_ARG1, s_procedure_source);
 462   switch (SCM_TYP7 (proc)) {
 463   case scm_tcs_closures:
 464     {
 465       SCM src;
 466       src = scm_source_property (SCM_CDR (SCM_CODE (proc)), scm_i_copy);
 467       if (src != SCM_BOOL_F)
 468         return scm_cons2 (scm_i_lambda, SCM_CAR (SCM_CODE (proc)), src);
 469       src = SCM_CODE (proc);
 470       return scm_cons (scm_i_lambda,
 471                        scm_unmemocopy (src,
 472                                        SCM_EXTEND_ENV (SCM_CAR (src),
 473                                                            SCM_EOL,
 474                                                            SCM_ENV (proc))));
 475     }
 476   case scm_tc7_contin:
 477   case scm_tcs_subrs:
 478 #ifdef CCLO
 479   case scm_tc7_cclo:
 480 #endif
 481     /* It would indeed be a nice thing if we supplied source even for
 482        built in procedures! */
 483     return scm_procedure_property (proc, scm_i_source);
 484   default:
 485     scm_wta (proc, (char *) SCM_ARG1, s_procedure_source);
 486     return 0;
 487   }
 488 }
 489
 490 SCM_PROC (s_procedure_environment, "procedure-environment", 1, 0, 0, scm_procedure_environment);
 491
 492 SCM
 493 scm_procedure_environment (proc)
 494      SCM proc;
 495 {
 496   SCM_ASSERT (SCM_NIMP (proc), proc, SCM_ARG1, s_procedure_environment);
 497   switch (SCM_TYP7 (proc)) {
 498   case scm_tcs_closures:
 499     return SCM_ENV (proc);
 500   case scm_tc7_contin:
 501   case scm_tcs_subrs:
 502 #ifdef CCLO
 503   case scm_tc7_cclo:
 504 #endif
 505     return SCM_EOL;
 506   default:
 507     scm_wta (proc, (char *) SCM_ARG1, s_procedure_environment);
 508     return 0;
 509   }
 510 }
 511
 512 \f
 513
 514 /* Eval in a local environment.  We would like to have the ability to
 515  * evaluate in a specified local environment, but due to the
 516  * memoization this isn't normally possible.  We solve it by copying
 517  * the code before evaluating.  One solution would be to have eval.c
 518  * generate yet another evaluator.  They are not very big actually.
 519  */
 520 SCM_PROC (s_local_eval, "local-eval", 1, 1, 0, scm_local_eval);
 521
 522 SCM
 523 scm_local_eval (exp, env)
 524      SCM exp;
 525      SCM env;
 526 {
 527   if (SCM_UNBNDP (env))
 528   {
 529     SCM_ASSERT (SCM_NIMP (exp) && SCM_MEMOIZEDP (exp), exp, SCM_ARG1, s_local_eval);
 530     return scm_eval_3 (SCM_MEMOIZED_EXP (exp), 0, SCM_MEMOIZED_ENV (exp));
 531   }
 532   return scm_eval_3 (exp, 1, env);
 533 }
 534
 535 SCM
 536 scm_start_stack (id, exp, env)
 537      SCM id;
 538      SCM exp;
 539      SCM env;
 540 {
 541   SCM answer;
 542   scm_debug_frame vframe;
 543   scm_debug_info vframe_vect_body;
 544   vframe.prev = scm_last_debug_frame;
 545   vframe.status = SCM_VOIDFRAME;
 546   vframe.vect = &vframe_vect_body;
 547   vframe.vect[0].id = id;
 548   scm_last_debug_frame = &vframe;
 549   answer = scm_eval_3 (exp, 1, env);
 550   scm_last_debug_frame = vframe.prev;
 551   return answer;
 552 }
 553
 554 SCM_SYNTAX(s_start_stack, "start-stack", scm_makacro, scm_m_start_stack);
 555
 556 static SCM
 557 scm_m_start_stack (exp, env)
 558      SCM exp;
 559      SCM env;
 560 {
 561   exp = SCM_CDR (exp);
 562   SCM_ASSERT (SCM_NIMP (exp)
 563               && SCM_ECONSP (exp)
 564               && SCM_NIMP (SCM_CDR (exp))
 565               && SCM_ECONSP (SCM_CDR (exp))
 566               && SCM_NULLP (SCM_CDDR (exp)),
 567               exp,
 568               SCM_WNA,
 569               s_start_stack);
 570   return scm_start_stack (scm_eval_car (exp, env), SCM_CADR (exp), env);
 571 }
 572
 573 /* {Debug Objects}
 574  *
 575  * The debugging evaluator throws these on frame traps.
 576  */
 577
 578 long scm_tc16_debugobj;
 579
 580 static int prindebugobj SCM_P ((SCM obj, SCM port, scm_print_state *pstate));
 581
 582 static int
 583 prindebugobj (obj, port, pstate)
 584      SCM obj;
 585      SCM port;
 586      scm_print_state *pstate;
 587 {
 588   scm_puts ("#<debug-object ", port);
 589   scm_intprint (SCM_DEBUGOBJ_FRAME (obj), 16, port);
 590   scm_putc ('>', port);
 591   return 1;
 592 }
 593
 594 static scm_smobfuns debugobjsmob =
 595 {0, scm_free0, prindebugobj, 0};
 596
 597 SCM_PROC (s_debug_object_p, "debug-object?", 1, 0, 0, scm_debug_object_p);
 598
 599 SCM
 600 scm_debug_object_p (obj)
 601      SCM obj;
 602 {
 603   return SCM_NIMP (obj) && SCM_DEBUGOBJP (obj) ? SCM_BOOL_T : SCM_BOOL_F;
 604 }
 605
 606
 607 SCM
 608 scm_make_debugobj (frame)
 609      scm_debug_frame *frame;
 610 {
 611   register SCM z;
 612   SCM_NEWCELL (z);
 613   SCM_ENTER_A_SECTION;
 614   SCM_SET_DEBUGOBJ_FRAME (z, (SCM) frame);
 615   SCM_SETCAR (z, scm_tc16_debugobj);
 616   SCM_EXIT_A_SECTION;
 617   return z;
 618 }
 619
 620 \f
 621
 622 /* Undocumented debugging procedure */
 623 #ifdef GUILE_DEBUG
 624 SCM_PROC (s_debug_hang, "debug-hang", 0, 1, 0, scm_debug_hang);
 625
 626 SCM
 627 scm_debug_hang (obj)
 628      SCM obj;
 629 {
 630   int go = 0;
 631   while (!go) ;
 632   return SCM_UNSPECIFIED;
 633 }
 634 #endif
 635
 636 \f
 637
 638 void
 639 scm_init_debug ()
 640 {
 641   scm_init_opts (scm_debug_options, scm_debug_opts, SCM_N_DEBUG_OPTIONS);
 642
 643   scm_tc16_memoized = scm_newsmob (&memoizedsmob);
 644   scm_tc16_debugobj = scm_newsmob (&debugobjsmob);
 645
 646   scm_i_procname = SCM_CAR (scm_sysintern ("procname", SCM_UNDEFINED));
 647   scm_i_more = SCM_CAR (scm_sysintern ("...", SCM_UNDEFINED));
 648   scm_i_source = SCM_CAR (scm_sysintern ("source", SCM_UNDEFINED));
 649   scm_i_proc = SCM_CAR (scm_sysintern ("proc", SCM_UNDEFINED));
 650   scm_i_args = SCM_CAR (scm_sysintern ("args", SCM_UNDEFINED));
 651   scm_i_eval_args = SCM_CAR (scm_sysintern ("eval-args", SCM_UNDEFINED));
 652
 653 #ifdef GUILE_DEBUG
 654   scm_sysintern ("SCM_IM_AND", SCM_IM_AND);
 655   scm_sysintern ("SCM_IM_BEGIN", SCM_IM_BEGIN);
 656   scm_sysintern ("SCM_IM_CASE", SCM_IM_CASE);
 657   scm_sysintern ("SCM_IM_COND", SCM_IM_COND);
 658   scm_sysintern ("SCM_IM_DO", SCM_IM_DO);
 659   scm_sysintern ("SCM_IM_IF", SCM_IM_IF);
 660   scm_sysintern ("SCM_IM_LAMBDA", SCM_IM_LAMBDA);
 661   scm_sysintern ("SCM_IM_LET", SCM_IM_LET);
 662   scm_sysintern ("SCM_IM_LETSTAR", SCM_IM_LETSTAR);
 663   scm_sysintern ("SCM_IM_LETREC", SCM_IM_LETREC);
 664   scm_sysintern ("SCM_IM_OR", SCM_IM_OR);
 665   scm_sysintern ("SCM_IM_QUOTE", SCM_IM_QUOTE);
 666   scm_sysintern ("SCM_IM_SET_X", SCM_IM_SET_X);
 667   scm_sysintern ("SCM_IM_DEFINE", SCM_IM_DEFINE);
 668   scm_sysintern ("SCM_IM_APPLY", SCM_IM_APPLY);
 669   scm_sysintern ("SCM_IM_CONT", SCM_IM_CONT);
 670   scm_sysintern ("SCM_IM_DISPATCH", SCM_IM_DISPATCH);
 671 #endif
 672   scm_add_feature ("debug-extensions");
 673
 674 #include "debug.x"
 675 }