libguile/stackchk.c

   1 /*      Copyright (C) 1995,1996,1997, 2000, 2001 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  16  */
  17
  18
  19 \f
  20
  21 #include "libguile/_scm.h"
  22 #include "libguile/ports.h"
  23 #include "libguile/root.h"
  24
  25 #include "libguile/stackchk.h"
  26 \f
  27
  28 /* {Stack Checking}
  29  */
  30
  31 #ifdef STACK_CHECKING
  32 int scm_stack_checking_enabled_p;
  33
  34 SCM_SYMBOL (scm_stack_overflow_key, "stack-overflow");
  35
  36 void
  37 scm_report_stack_overflow ()
  38 {
  39   scm_stack_checking_enabled_p = 0;
  40   scm_error (scm_stack_overflow_key,
  41              NULL,
  42              "Stack overflow",
  43              SCM_BOOL_F,
  44              SCM_BOOL_F);
  45 }
  46
  47 #endif
  48
  49 long
  50 scm_stack_size (SCM_STACKITEM *start)
  51 {
  52   SCM_STACKITEM stack;
  53 #if SCM_STACK_GROWS_UP
  54   return &stack - start;
  55 #else
  56   return start - &stack;
  57 #endif /* SCM_STACK_GROWS_UP */
  58 }
  59
  60
  61 void
  62 scm_stack_report ()
  63 {
  64   SCM port = scm_current_error_port ();
  65   SCM_STACKITEM stack;
  66   scm_i_thread *thread = SCM_I_CURRENT_THREAD;
  67
  68   scm_uintprint ((scm_stack_size (thread->continuation_base)
  69                   * sizeof (SCM_STACKITEM)),
  70                  16, port);
  71   scm_puts (" of stack: 0x", port);
  72   scm_uintprint ((scm_t_bits) thread->continuation_base, 16, port);
  73   scm_puts (" - 0x", port);
  74   scm_uintprint ((scm_t_bits) &stack, 16, port);
  75   scm_puts ("\n", port);
  76 }
  77
  78 void
  79 scm_init_stackchk ()
  80 {
  81 #include "libguile/stackchk.x"
  82 }
  83
  84 /*
  85   Local Variables:
  86   c-file-style: "gnu"
  87   End:
  88 */