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