#include "EXTERN.h"
#include "perl.h"
-#include "perlmem.h"
#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
#include <signal.h>
my_exit(1);
}
#endif /* HAS_64K_LIMIT */
+ if (!size) {
+ safefree(where);
+ return NULL;
+ }
+
if (!where)
- croak("Null realloc");
+ return safemalloc(size);
#ifdef DEBUGGING
if ((long)size < 0)
croak("panic: realloc");
#endif
- ptr = PerlMem_realloc(where,size?size:1); /* realloc(0) is NASTY on our system */
+ ptr = PerlMem_realloc(where,size);
#if !(defined(I286) || defined(atarist))
DEBUG_m( {
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);
msg = ERRSV;
}
- PUSHSTACK(SI_DIEHOOK);
+ PUSHSTACKi(SI_DIEHOOK);
PUSHMARK(SP);
XPUSHs(msg);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
- POPSTACK();
+ POPSTACK;
LEAVE;
}
}
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
SvREADONLY_on(msg);
SAVEFREESV(msg);
- PUSHSTACK(SI_DIEHOOK);
+ PUSHSTACKi(SI_DIEHOOK);
PUSHMARK(SP);
XPUSHs(msg);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
- POPSTACK();
+ POPSTACK;
LEAVE;
}
}
}
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);
SvREADONLY_on(msg);
SAVEFREESV(msg);
- PUSHSTACK(SI_WARNHOOK);
+ PUSHSTACKi(SI_WARNHOOK);
PUSHMARK(SP);
XPUSHs(msg);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
- POPSTACK();
+ POPSTACK;
LEAVE;
return;
}
}
#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
if (pid == 0) {
GV* tmpgv;
+#undef THIS
+#undef THAT
#define THIS that
#define THAT This
PerlLIO_close(p[THAT]);
if (!HAS_WAITPID_RUNTIME)
goto hard_way;
# endif
- return waitpid(pid,statusp,flags);
+ return PerlProc_waitpid(pid,statusp,flags);
#endif
#if !defined(HAS_WAITPID) && defined(HAS_WAIT4)
return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
dTHR;
char *xfound = Nullch;
char *xfailed = Nullch;
+ char tmpbuf[512];
register char *s;
I32 len;
int retval;
* + look *only* in the PATH for scriptname{,.foo,.bar} (note
* this will not look in '.' if it's not in the PATH)
*/
+ tmpbuf[0] = '\0';
#ifdef VMS
# ifdef ALWAYS_DEFTYPES
/* The first time through, just add SEARCH_EXTS to whatever we
* already have, so we can check for default file types. */
while (deftypes ||
- (!hasdir && my_trnlnm("DCL$PATH",tokenbuf,idx++)) )
+ (!hasdir && my_trnlnm("DCL$PATH",tmpbuf,idx++)) )
{
if (deftypes) {
deftypes = 0;
- *tokenbuf = '\0';
+ *tmpbuf = '\0';
}
- if ((strlen(tokenbuf) + strlen(scriptname)
- + MAX_EXT_LEN) >= sizeof tokenbuf)
+ if ((strlen(tmpbuf) + strlen(scriptname)
+ + MAX_EXT_LEN) >= sizeof tmpbuf)
continue; /* don't search dir with too-long name */
- strcat(tokenbuf, scriptname);
+ strcat(tmpbuf, scriptname);
#else /* !VMS */
#ifdef DOSISH
#ifdef SEARCH_EXTS
if (cur == scriptname) {
len = strlen(scriptname);
- if (len+MAX_EXT_LEN+1 >= sizeof(tokenbuf))
+ if (len+MAX_EXT_LEN+1 >= sizeof(tmpbuf))
break;
- cur = strcpy(tokenbuf, scriptname);
+ cur = strcpy(tmpbuf, scriptname);
}
} while (extidx >= 0 && ext[extidx] /* try an extension? */
- && strcpy(tokenbuf+len, ext[extidx++]));
+ && strcpy(tmpbuf+len, ext[extidx++]));
#endif
}
#endif
&& *s != ','
# endif
&& *s != ';'; len++, s++) {
- if (len < sizeof tokenbuf)
- tokenbuf[len] = *s;
+ if (len < sizeof tmpbuf)
+ tmpbuf[len] = *s;
}
- if (len < sizeof tokenbuf)
- tokenbuf[len] = '\0';
+ if (len < sizeof tmpbuf)
+ tmpbuf[len] = '\0';
#else /* ! (atarist || DOSISH) */
- s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend,
+ s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf, s, bufend,
':',
&len);
#endif /* ! (atarist || DOSISH) */
if (s < bufend)
s++;
- if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tokenbuf)
+ if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tmpbuf)
continue; /* don't search dir with too-long name */
if (len
#if defined(atarist) || defined(DOSISH)
- && tokenbuf[len - 1] != '/'
- && tokenbuf[len - 1] != '\\'
+ && tmpbuf[len - 1] != '/'
+ && tmpbuf[len - 1] != '\\'
#endif
)
- tokenbuf[len++] = '/';
- if (len == 2 && tokenbuf[0] == '.')
+ tmpbuf[len++] = '/';
+ if (len == 2 && tmpbuf[0] == '.')
seen_dot = 1;
- (void)strcpy(tokenbuf + len, scriptname);
+ (void)strcpy(tmpbuf + len, scriptname);
#endif /* !VMS */
#ifdef SEARCH_EXTS
- len = strlen(tokenbuf);
+ len = strlen(tmpbuf);
if (extidx > 0) /* reset after previous loop */
extidx = 0;
do {
#endif
- DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tokenbuf));
- retval = PerlLIO_stat(tokenbuf,&statbuf);
+ DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tmpbuf));
+ retval = PerlLIO_stat(tmpbuf,&statbuf);
#ifdef SEARCH_EXTS
} while ( retval < 0 /* not there */
&& extidx>=0 && ext[extidx] /* try an extension? */
- && strcpy(tokenbuf+len, ext[extidx++])
+ && strcpy(tmpbuf+len, ext[extidx++])
);
#endif
if (retval < 0)
#endif
)
{
- xfound = tokenbuf; /* bingo! */
+ xfound = tmpbuf; /* bingo! */
break;
}
if (!xfailed)
- xfailed = savepv(tokenbuf);
+ xfailed = savepv(tmpbuf);
}
#ifndef DOSISH
if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&statbuf) < 0))
#endif
seen_dot = 1; /* Disable message. */
- if (!xfound)
- scriptname = NULL;
-/* croak("Can't %s %s%s%s",
- (xfailed ? "execute" : "find"),
- (xfailed ? xfailed : scriptname),
- (xfailed ? "" : " on PATH"),
- (xfailed || seen_dot) ? "" : ", '.' not in PATH"); */
+ if (!xfound) {
+ if (flags & 1) { /* do or die? */
+ croak("Can't %s %s%s%s",
+ (xfailed ? "execute" : "find"),
+ (xfailed ? xfailed : scriptname),
+ (xfailed ? "" : " on PATH"),
+ (xfailed || seen_dot) ? "" : ", '.' not in PATH");
+ }
+ scriptname = Nullch;
+ }
if (xfailed)
Safefree(xfailed);
scriptname = xfound;
}
- return scriptname;
+ return (scriptname ? savepv(scriptname) : Nullch);
}
{
return opargs;
}
+
+
+SV **
+get_specialsv_list(void)
+{
+ return specialsv_list;
+}
projects / p5sagit/p5-mst-13.2.git / blobdiff