summaryrefslogtreecommitdiffstats
path: root/contrib/perl5/deb.c
diff options
context:
space:
mode:
authormarkm <markm@FreeBSD.org>1998-09-09 07:00:04 +0000
committermarkm <markm@FreeBSD.org>1998-09-09 07:00:04 +0000
commit4fcbc3669aa997848e15198cc9fb856287a6788c (patch)
tree58b20e81687d6d5931f120b50802ed21225bf440 /contrib/perl5/deb.c
downloadFreeBSD-src-4fcbc3669aa997848e15198cc9fb856287a6788c.zip
FreeBSD-src-4fcbc3669aa997848e15198cc9fb856287a6788c.tar.gz
Initial import of Perl5. The king is dead; long live the king!
Diffstat (limited to 'contrib/perl5/deb.c')
-rw-r--r--contrib/perl5/deb.c114
1 files changed, 114 insertions, 0 deletions
diff --git a/contrib/perl5/deb.c b/contrib/perl5/deb.c
new file mode 100644
index 0000000..0c25225
--- /dev/null
+++ b/contrib/perl5/deb.c
@@ -0,0 +1,114 @@
+/* deb.c
+ *
+ * Copyright (c) 1991-1997, Larry Wall
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ *
+ */
+
+/*
+ * "Didst thou think that the eyes of the White Tower were blind? Nay, I
+ * have seen more than thou knowest, Gray Fool." --Denethor
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+void
+deb(const char *pat, ...)
+{
+#ifdef DEBUGGING
+ dTHR;
+ va_list args;
+ register I32 i;
+ GV* gv = PL_curcop->cop_filegv;
+
+#ifdef USE_THREADS
+ PerlIO_printf(Perl_debug_log, "0x%lx (%s:%ld)\t",
+ (unsigned long) thr,
+ SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
+ (long)PL_curcop->cop_line);
+#else
+ PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
+ SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
+ (long)PL_curcop->cop_line);
+#endif /* USE_THREADS */
+ for (i=0; i<PL_dlevel; i++)
+ PerlIO_printf(Perl_debug_log, "%c%c ",PL_debname[i],PL_debdelim[i]);
+
+ va_start(args, pat);
+ (void) PerlIO_vprintf(Perl_debug_log,pat,args);
+ va_end( args );
+#endif /* DEBUGGING */
+}
+
+void
+deb_growlevel(void)
+{
+#ifdef DEBUGGING
+ PL_dlmax += 128;
+ Renew(PL_debname, PL_dlmax, char);
+ Renew(PL_debdelim, PL_dlmax, char);
+#endif /* DEBUGGING */
+}
+
+I32
+debstackptrs(void)
+{
+#ifdef DEBUGGING
+ dTHR;
+ PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
+ (unsigned long)PL_curstack, (unsigned long)PL_stack_base,
+ (long)*PL_markstack_ptr, (long)(PL_stack_sp-PL_stack_base),
+ (long)(PL_stack_max-PL_stack_base));
+ PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
+ (unsigned long)PL_mainstack, (unsigned long)AvARRAY(PL_curstack),
+ (long)PL_mainstack, (long)AvFILLp(PL_curstack), (long)AvMAX(PL_curstack));
+#endif /* DEBUGGING */
+ return 0;
+}
+
+I32
+debstack(void)
+{
+#ifdef DEBUGGING
+ dTHR;
+ I32 top = PL_stack_sp - PL_stack_base;
+ register I32 i = top - 30;
+ I32 *markscan = PL_curstackinfo->si_markbase;
+
+ if (i < 0)
+ i = 0;
+
+ while (++markscan <= PL_markstack_ptr)
+ if (*markscan >= i)
+ break;
+
+#ifdef USE_THREADS
+ PerlIO_printf(Perl_debug_log, i ? "0x%lx => ... " : "0x%lx => ",
+ (unsigned long) thr);
+#else
+ PerlIO_printf(Perl_debug_log, i ? " => ... " : " => ");
+#endif /* USE_THREADS */
+ if (PL_stack_base[0] != &PL_sv_undef || PL_stack_sp < PL_stack_base)
+ PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
+ do {
+ ++i;
+ if (markscan <= PL_markstack_ptr && *markscan < i) {
+ do {
+ ++markscan;
+ PerlIO_putc(Perl_debug_log, '*');
+ }
+ while (markscan <= PL_markstack_ptr && *markscan < i);
+ PerlIO_printf(Perl_debug_log, " ");
+ }
+ if (i > top)
+ break;
+ PerlIO_printf(Perl_debug_log, "%-4s ", SvPEEK(PL_stack_base[i]));
+ }
+ while (1);
+ PerlIO_printf(Perl_debug_log, "\n");
+#endif /* DEBUGGING */
+ return 0;
+}
OpenPOWER on IntegriCloud