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