libguile/stackchk.c

   1 /*      Copyright (C) 1995,1996,1997, 2000, 2001, 2006, 2008, 2010, 2011, 2014 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 License
   5  * as published by the Free Software Foundation; either version 3 of
   6  * the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful, but
   9  * 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
  16  * 02110-1301 USA
  17  */
  18
  19
  20 \f
  21 #ifdef HAVE_CONFIG_H
  22 # include <config.h>
  23 #endif
  24
  25 #include "libguile/_scm.h"
  26 #include "libguile/ports.h"
  27 #include "libguile/root.h"
  28 #include "libguile/threads.h"
  29 #include "libguile/dynwind.h"
  30
  31 #include "libguile/stackchk.h"
  32 \f
  33
  34 /* {Stack Checking}
  35  */
  36
  37 int scm_stack_checking_enabled_p;
  38
  39 static void
  40 reset_scm_stack_checking_enabled_p (void *arg)
  41 {
  42   scm_stack_checking_enabled_p = (int)(scm_t_bits)arg;
  43 }
  44
  45 long
  46 scm_stack_size (SCM_STACKITEM *start)
  47 {
  48   SCM_STACKITEM stack;
  49 #if SCM_STACK_GROWS_UP
  50   return &stack - start;
  51 #else
  52   return start - &stack;
  53 #endif /* SCM_STACK_GROWS_UP */
  54 }
  55
  56
  57 void
  58 scm_stack_report ()
  59 {
  60   SCM port = scm_current_error_port ();
  61   SCM_STACKITEM stack;
  62   scm_i_thread *thread = SCM_I_CURRENT_THREAD;
  63
  64   scm_uintprint ((scm_stack_size (thread->continuation_base)
  65                   * sizeof (SCM_STACKITEM)),
  66                  16, port);
  67   scm_puts_unlocked (" of stack: 0x", port);
  68   scm_uintprint ((scm_t_bits) thread->continuation_base, 16, port);
  69   scm_puts_unlocked (" - 0x", port);
  70   scm_uintprint ((scm_t_bits) &stack, 16, port);
  71   scm_puts_unlocked ("\n", port);
  72 }
  73
  74
  75 SCM_DEFINE (scm_sys_get_stack_size, "%get-stack-size", 0, 0, 0,
  76             (),
  77             "Return the current thread's C stack size (in Scheme objects).")
  78 #define FUNC_NAME s_scm_sys_get_stack_size
  79 {
  80   return scm_from_long (scm_stack_size (SCM_I_CURRENT_THREAD->base));
  81 }
  82 #undef FUNC_NAME
  83
  84
  85 void
  86 scm_init_stackchk ()
  87 {
  88 #include "libguile/stackchk.x"
  89 }
  90
  91 /*
  92   Local Variables:
  93   c-file-style: "gnu"
  94   End:
  95 */