#include "EXTERN.h"
#include "perl.h"
-#ifdef DEBUGGING
-#if !defined(I_STDARG) && !defined(I_VARARGS)
-
-/*
- * Fallback on the old hackers way of doing varargs
- */
-
-/*VARARGS1*/
-void
-deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
- char *pat;
-{
- dTHR;
- register I32 i;
- GV* gv = 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)curcop->cop_line);
-#else
- PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
- SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
- (long)curcop->cop_line);
-#endif /* USE_THREADS */
- for (i=0; i<dlevel; i++)
- PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]);
- PerlIO_printf(Perl_debug_log, pat,a1,a2,a3,a4,a5,a6,a7,a8);
-}
-
-#else /* !defined(I_STDARG) && !defined(I_VARARGS) */
-
-# ifdef I_STDARG
void
deb(const char *pat, ...)
-# else
-/*VARARGS1*/
-void
-deb(pat, va_alist)
- const char *pat;
- va_dcl
-# endif
{
+#ifdef DEBUGGING
dTHR;
va_list args;
register I32 i;
for (i=0; i<dlevel; i++)
PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]);
-# ifdef I_STDARG
va_start(args, pat);
-# else
- va_start(args);
-# endif
(void) PerlIO_vprintf(Perl_debug_log,pat,args);
va_end( args );
+#endif /* DEBUGGING */
}
-#endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
void
deb_growlevel(void)
{
+#ifdef DEBUGGING
dlmax += 128;
Renew(debname, dlmax, char);
Renew(debdelim, dlmax, char);
+#endif /* DEBUGGING */
}
I32
debstackptrs(void)
{
+#ifdef DEBUGGING
dTHR;
PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
(unsigned long)curstack, (unsigned long)stack_base,
PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
(unsigned long)mainstack, (unsigned long)AvARRAY(curstack),
(long)mainstack, (long)AvFILLp(curstack), (long)AvMAX(curstack));
+#endif /* DEBUGGING */
return 0;
}
I32
debstack(void)
{
+#ifdef DEBUGGING
dTHR;
I32 top = stack_sp - stack_base;
register I32 i = top - 30;
}
while (1);
PerlIO_printf(Perl_debug_log, "\n");
+#endif /* DEBUGGING */
return 0;
}
-#else
-static int dummy; /* avoid totally empty deb.o file */
-#endif /* DEBUGGING */
#include "EXTERN.h"
#include "perl.h"
-#ifndef DEBUGGING
-void
-dump_all(void)
-{
-}
-#else /* Rest of file is for DEBUGGING */
-
-#ifdef I_STDARG
static void dump(char *pat, ...);
-#else
-static void dump();
-#endif
void
dump_all(void)
{
+#ifdef DEBUGGING
dTHR;
PerlIO_setlinebuf(Perl_debug_log);
if (main_root)
dump_op(main_root);
dump_packsubs(defstash);
+#endif /* DEBUGGING */
}
void
dump_packsubs(HV *stash)
{
+#ifdef DEBUGGING
dTHR;
I32 i;
HE *entry;
dump_packsubs(hv); /* nested package */
}
}
+#endif /* DEBUGGING */
}
void
dump_sub(GV *gv)
{
+#ifdef DEBUGGING
SV *sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
dump_op(CvROOT(GvCV(gv)));
else
dump("<undef>\n");
+#endif /* DEBUGGING */
}
void
dump_form(GV *gv)
{
+#ifdef DEBUGGING
SV *sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
dump_op(CvROOT(GvFORM(gv)));
else
dump("<undef>\n");
+#endif /* DEBUGGING */
}
void
dump_eval(void)
{
+#ifdef DEBUGGING
dump_op(eval_root);
+#endif /* DEBUGGING */
}
void
dump_op(OP *o)
{
+#ifdef DEBUGGING
dump("{\n");
if (o->op_seq)
PerlIO_printf(Perl_debug_log, "%-4d", o->op_seq);
}
dumplvl--;
dump("}\n");
+#endif /* DEBUGGING */
}
void
dump_gv(GV *gv)
{
+#ifdef DEBUGGING
SV *sv;
if (!gv) {
dump("\n");
dumplvl--;
dump("}\n");
+#endif /* DEBUGGING */
}
void
dump_pm(PMOP *pm)
{
+#ifdef DEBUGGING
char ch;
if (!pm) {
dumplvl--;
dump("}\n");
+#endif /* DEBUGGING */
}
-#if !defined(I_STDARG) && !defined(I_VARARGS)
-/* VARARGS1 */
-static void dump(arg1,arg2,arg3,arg4,arg5)
-char *arg1;
-long arg2, arg3, arg4, arg5;
-{
- I32 i;
-
- for (i = dumplvl*4; i; i--)
- (void)PerlIO_putc(Perl_debug_log,' ');
- PerlIO_printf(Perl_debug_log, arg1, arg2, arg3, arg4, arg5);
-}
-
-#else
-
-#ifdef I_STDARG
static void
dump(char *pat,...)
-#else
-/*VARARGS0*/
-static void
-dump(pat,va_alist)
- char *pat;
- va_dcl
-#endif
{
+#ifdef DEBUGGING
I32 i;
va_list args;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
for (i = dumplvl*4; i; i--)
(void)PerlIO_putc(Perl_debug_log,' ');
PerlIO_vprintf(Perl_debug_log,pat,args);
va_end(args);
+#endif /* DEBUGGING */
}
-#endif
-
-#endif
/* This code is based on croak/warn, see mess() in util.c */
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
message = mess(pat, &args);
va_end(args);
#endif
#include <setjmp.h>
#include <signal.h>
-#ifdef I_STDARG
#include <stdarg.h>
-#endif
+
#ifdef I_STDDEF
#include <stddef.h>
#endif
#if defined (WIN32)
# undef mkfifo /* #defined in perl.h */
# define mkfifo(a,b) not_here("mkfifo")
-# define ttyname(a) not_here("ttyname")
+# define ttyname(a) (char*)not_here("ttyname")
# define sigset_t long
# define pid_t long
# ifdef __BORLANDC__
sfset(sfstdout,SF_SHARE,0);
}
-#else
+#else /* USE_SFIO */
/* Implement all the PerlIO interface using stdio.
- this should be only file to include <stdio.h>
#undef PerlIO_printf
int
-#ifdef I_STDARG
PerlIO_printf(PerlIO *f,const char *fmt,...)
-#else
-PerlIO_printf(f,fmt,va_alist)
-PerlIO *f;
-const char *fmt;
-va_dcl
-#endif
{
va_list ap;
int result;
-#ifdef I_STDARG
va_start(ap,fmt);
-#else
- va_start(ap);
-#endif
result = vfprintf(f,fmt,ap);
va_end(ap);
return result;
#undef PerlIO_stdoutf
int
-#ifdef I_STDARG
PerlIO_stdoutf(const char *fmt,...)
-#else
-PerlIO_stdoutf(fmt, va_alist)
-const char *fmt;
-va_dcl
-#endif
{
va_list ap;
int result;
-#ifdef I_STDARG
va_start(ap,fmt);
-#else
- va_start(ap);
-#endif
result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
va_end(ap);
return result;
#ifndef PerlIO_sprintf
int
-#ifdef I_STDARG
PerlIO_sprintf(char *s, int n, const char *fmt,...)
-#else
-PerlIO_sprintf(s, n, fmt, va_alist)
-char *s;
-int n;
-const char *fmt;
-va_dcl
-#endif
{
va_list ap;
int result;
-#ifdef I_STDARG
va_start(ap,fmt);
-#else
- va_start(ap);
-#endif
result = PerlIO_vsprintf(s, n, fmt, ap);
va_end(ap);
return result;
SV* cv_const_sv _((CV* cv));
SV* op_const_sv _((OP* o, CV* cv));
void cv_undef _((CV* cv));
-#ifdef DEBUGGING
void cx_dump _((PERL_CONTEXT* cs));
-#endif
SV* filter_add _((filter_t funcp, SV* datasv));
void filter_del _((filter_t funcp));
I32 filter_read _((int idx, SV* buffer, int maxlen));
void deb_growlevel _((void));
I32 debop _((OP* o));
I32 debstackptrs _((void));
-#ifdef DEBUGGING
void debprofdump _((void));
-#endif
I32 debstack _((void));
char* delimcpy _((char* to, char* toend, char* from, char* fromend,
int delim, I32* retlen));
return TRUE;
}
-#ifdef DEBUGGING
static regnode *
dumpuntil(regnode *start, regnode *node, regnode *last, SV* sv, I32 l)
{
+#ifdef DEBUGGING
register char op = EXACT; /* Arbitrary non-END op. */
register regnode *next, *onode;
else if (op == WHILEM)
l--;
}
+#endif /* DEBUGGING */
return node;
}
void
regdump(regexp *r)
{
+#ifdef DEBUGGING
SV *sv = sv_newmortal();
(void)dumpuntil(r->program, r->program + 1, NULL, sv, 0);
PerlIO_printf(Perl_debug_log, "implicit ");
PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
PerlIO_printf(Perl_debug_log, "\n");
+#endif /* DEBUGGING */
}
/*
void
regprop(SV *sv, regnode *o)
{
+#ifdef DEBUGGING
register char *p = 0;
sv_setpv(sv, ":");
}
if (p)
sv_catpv(sv, p);
+#endif /* DEBUGGING */
}
-#endif /* DEBUGGING */
void
pregfree(struct regexp *r)
#endif
}
-#ifdef I_STDARG
static void
re_croak2(const char* pat1,const char* pat2,...)
-#else
-/*VARARGS0*/
-static void
-re_croak2(const char* pat1,const char* pat2, va_alist)
- const char* pat1;
- const char* pat2;
- va_dcl
-#endif
{
va_list args;
STRLEN l1 = strlen(pat1);
Copy(pat2, buf + l1, l2 , char);
buf[l1 + l2 + 1] = '\n';
buf[l1 + l2 + 2] = '\0';
-#ifdef I_STDARG
va_start(args, pat2);
-#else
- va_start(args);
-#endif
message = mess(buf, &args);
va_end(args);
l1 = strlen(message);
int
-runops_standard(void) {
+runops_standard(void)
+{
dTHR;
while ( op = (*op->op_ppaddr)(ARGS) ) ;
static void debprof _((OP*o));
+#endif /* DEBUGGING */
+
int
-runops_debug(void) {
+runops_debug(void)
+{
+#ifdef DEBUGGING
dTHR;
if (!op) {
warn("NULL OP IN RUN");
TAINT_NOT;
return 0;
+#else
+ return runops_standard();
+#endif /* DEBUGGING */
}
I32
debop(OP *o)
{
+#ifdef DEBUGGING
SV *sv;
deb("%s", op_name[o->op_type]);
switch (o->op_type) {
break;
}
PerlIO_printf(Perl_debug_log, "\n");
+#endif /* DEBUGGING */
return 0;
}
void
watch(char **addr)
{
+#ifdef DEBUGGING
watchaddr = addr;
watchok = *addr;
PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n",
(long)watchaddr, (long)watchok);
+#endif /* DEBUGGING */
}
+#ifdef DEBUGGING
static void
debprof(OP *o)
{
New(000, profiledata, MAXO, U32);
++profiledata[o->op_type];
}
+#endif /* DEBUGGING */
void
debprofdump(void)
{
+#ifdef DEBUGGING
unsigned i;
if (!profiledata)
return;
PerlIO_printf(Perl_debug_log,
"%u\t%lu\n", i, (unsigned long)profiledata[i]);
}
+#endif /* DEBUGGING */
}
-
-#endif /* DEBUGGING */
-
}
}
-#ifdef DEBUGGING
-
void
cx_dump(PERL_CONTEXT *cx)
{
+#ifdef DEBUGGING
dTHR;
PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), block_type[cx->cx_type]);
if (cx->cx_type != CXt_SUBST) {
(long)cx->sb_rxres);
break;
}
+#endif /* DEBUGGING */
}
-#endif
return TRUE;
}
-#ifdef DEBUGGING
char *
sv_peek(SV *sv)
{
+#ifdef DEBUGGING
SV *t = sv_newmortal();
STRLEN prevlen;
int unref = 0;
sv_catpv(t, ")");
}
return SvPV(t, na);
+#else /* DEBUGGING */
+ return "";
+#endif /* DEBUGGING */
}
-#endif
int
sv_backoff(register SV *sv)
return sv;
}
-#ifdef I_STDARG
SV *
newSVpvf(const char* pat, ...)
-#else
-/*VARARGS0*/
-SV *
-newSVpvf(pat, va_alist)
-const char *pat;
-va_dcl
-#endif
{
register SV *sv;
va_list args;
SvANY(sv) = 0;
SvREFCNT(sv) = 1;
SvFLAGS(sv) = 0;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
return sv;
SvSETMAGIC(sv);
}
-#ifdef I_STDARG
void
sv_setpvf(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_setpvf(sv, pat, va_alist)
- SV *sv;
- const char *pat;
- va_dcl
-#endif
{
va_list args;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
}
-#ifdef I_STDARG
void
sv_setpvf_mg(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_setpvf_mg(sv, pat, va_alist)
- SV *sv;
- const char *pat;
- va_dcl
-#endif
{
va_list args;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
SvSETMAGIC(sv);
}
-#ifdef I_STDARG
void
sv_catpvf(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_catpvf(sv, pat, va_alist)
- SV *sv;
- const char *pat;
- va_dcl
-#endif
{
va_list args;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
}
-#ifdef I_STDARG
void
sv_catpvf_mg(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_catpvf_mg(sv, pat, va_alist)
- SV *sv;
- const char *pat;
- va_dcl
-#endif
{
va_list args;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
SvSETMAGIC(sv);
}
}
-#ifdef DEBUGGING
void
sv_dump(SV *sv)
{
+#ifdef DEBUGGING
SV *d = sv_newmortal();
char *s;
U32 flags;
PerlIO_printf(Perl_debug_log, " FLAGS = 0x%lx\n", (long)IoFLAGS(sv));
break;
}
+#endif /* DEBUGGING */
}
-#else
-void
-sv_dump(SV *sv)
-{
-}
-#endif
-
-
-
-
return sv;
}
-#ifdef I_STDARG
char *
form(const char* pat, ...)
-#else
-/*VARARGS0*/
-char *
-form(pat, va_alist)
- const char *pat;
- va_dcl
-#endif
{
va_list args;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
if (!mess_sv)
mess_sv = mess_alloc();
sv_vsetpvfn(mess_sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
return SvPVX(sv);
}
-#ifdef I_STDARG
OP *
die(const char* pat, ...)
-#else
-/*VARARGS0*/
-OP *
-die(pat, va_alist)
- const char *pat;
- va_dcl
-#endif
{
dTHR;
va_list args;
thr, curstack, mainstack));
#endif /* USE_THREADS */
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
message = pat ? mess(pat, &args) : Nullch;
va_end(args);
return restartop;
}
-#ifdef I_STDARG
void
croak(const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-croak(pat, va_alist)
- char *pat;
- va_dcl
-#endif
{
dTHR;
va_list args;
GV *gv;
CV *cv;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
message = mess(pat, &args);
va_end(args);
#ifdef USE_THREADS
}
void
-#ifdef I_STDARG
warn(const char* pat,...)
-#else
-/*VARARGS0*/
-warn(pat,va_alist)
- const char *pat;
- va_dcl
-#endif
{
va_list args;
char *message;
GV *gv;
CV *cv;
-#ifdef I_STDARG
va_start(args, pat);
-#else
- va_start(args);
-#endif
message = mess(pat, &args);
va_end(args);
}
#endif /* !HAS_MEMCMP || !HAS_SANE_MEMCMP */
-#if defined(I_STDARG) || defined(I_VARARGS)
#ifndef HAS_VPRINTF
#ifdef USE_CHAR_VSPRINTF
}
#endif /* HAS_VPRINTF */
-#endif /* I_VARARGS || I_STDARGS */
#ifdef MYSWAP
#if BYTEORDER != 0x4321
#endif /* !DOSISH */
#ifdef DUMP_FDS
-dump_fds(s)
-char *s;
+void
+dump_fds(char *s)
{
int fd;
struct stat tmpstatbuf;
}
PerlIO_printf(PerlIO_stderr(),"\n");
}
-#endif
+#endif /* DUMP_FDS */
#ifndef HAS_DUP2
int
#include "INTERN.h"
#include "util.h"
-#ifdef I_STDARG
-# include <stdarg.h>
-#endif
+#include <stdarg.h>
#define FLUSH
static char nomem[] = "Out of memory!\n";
}
void
-#if defined(I_STDARG) && defined(HAS_VPRINTF)
croak(char *pat,...)
-#else /* I_STDARG */
-/*VARARGS1*/
-croak(pat,a1,a2,a3,a4)
- char *pat;
- int a1,a2,a3,a4;
-#endif /* I_STDARG */
{
-#if defined(I_STDARG) && defined(HAS_VPRINTF)
+#if defined(HAS_VPRINTF)
va_list args;
va_start(args, pat);
}
void
-#if defined(I_STDARG) && defined(HAS_VPRINTF)
fatal(char *pat,...)
-#else /* I_STDARG */
-/*VARARGS1*/
-fatal(pat,a1,a2,a3,a4)
- char *pat;
- int a1,a2,a3,a4;
-#endif /* I_STDARG */
{
-#if defined(I_STDARG) && defined(HAS_VPRINTF)
+#if defined(HAS_VPRINTF)
va_list args;
va_start(args, pat);
}
void
-#if defined(I_STDARG) && defined(HAS_VPRINTF)
warn(char *pat,...)
-#else /* I_STDARG */
-/*VARARGS1*/
-warn(pat,a1,a2,a3,a4)
- char *pat;
- int a1,a2,a3,a4;
-#endif /* I_STDARG */
{
-#if defined(I_STDARG) && defined(HAS_VPRINTF)
+#if defined(HAS_VPRINTF)
va_list args;
va_start(args, pat);
char * instr _(( char *big, char *little ));
char * safecpy _(( char *to, char *from, int len ));
char * savestr _(( char *str ));
-#if defined(I_STDARG) && defined(HAS_VPRINTF)
void croak _(( char *pat, ... ));
void fatal _(( char *pat, ... ));
void warn _(( char *pat, ... ));
-#else /* defined(I_STDARG) && defined(HAS_VPRINTF) */
-void croak _(( char *pat, int a1, int a2, int a3, int a4 ));
-void Myfatal ();
-void warn ();
-#endif /* defined(I_STDARG) && defined(HAS_VPRINTF) */
int prewalk _(( int numit, int level, int node, int *numericptr ));
Malloc_t safemalloc _((MEM_SIZE nbytes));