X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=f61b66d1ae4d950fe27a48ed5ec69664f6de056d;hb=c73bb82c00a639630ef310b1ac1d896f5afcedab;hp=2e0cf74d0a97644b68810a77c38ab601e75e7644;hpb=17c3b45099488fbc22dc1d4e0e4600c17bc12645;p=p5sagit%2Fp5-mst-13.2.git diff --git a/util.c b/util.c index 2e0cf74..f61b66d 100644 --- a/util.c +++ b/util.c @@ -14,7 +14,6 @@ #include "EXTERN.h" #include "perl.h" -#include "perlmem.h" #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include @@ -122,13 +121,18 @@ saferealloc(Malloc_t where,MEM_SIZE size) 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( { @@ -844,13 +848,13 @@ char * mem_collxfrm(const char *s, STRLEN len, STRLEN *xlen) { char *xbuf; - STRLEN xalloc, xin, xout; + STRLEN xAlloc, xin, xout; /* xalloc is a reserved word in VC */ /* the first sizeof(collationix) bytes are used by sv_collxfrm(). */ /* the +1 is for the terminating NUL. */ - xalloc = sizeof(collation_ix) + collxfrm_base + (collxfrm_mult * len) + 1; - New(171, xbuf, xalloc, char); + xAlloc = sizeof(collation_ix) + collxfrm_base + (collxfrm_mult * len) + 1; + New(171, xbuf, xAlloc, char); if (! xbuf) goto bad; @@ -860,13 +864,13 @@ mem_collxfrm(const char *s, STRLEN len, STRLEN *xlen) SSize_t xused; for (;;) { - xused = strxfrm(xbuf + xout, s + xin, xalloc - xout); + xused = strxfrm(xbuf + xout, s + xin, xAlloc - xout); if (xused == -1) goto bad; - if (xused < xalloc - xout) + if (xused < xAlloc - xout) break; - xalloc = (2 * xalloc) + 1; - Renew(xbuf, xalloc, char); + xAlloc = (2 * xAlloc) + 1; + Renew(xbuf, xAlloc, char); if (! xbuf) goto bad; } @@ -1178,7 +1182,7 @@ savepvn(char *sv, register I32 len) /* the SV for form() and mess() is not kept in an arena */ -static SV * +STATIC SV * mess_alloc(void) { SV *sv; @@ -1285,12 +1289,12 @@ die(const char* pat, ...) msg = ERRSV; } - PUSHSTACK(SI_DIEHOOK); + PUSHSTACKi(SI_DIEHOOK); PUSHMARK(SP); XPUSHs(msg); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); - POPSTACK(); + POPSTACK; LEAVE; } } @@ -1339,12 +1343,12 @@ croak(const char* pat, ...) 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; } } @@ -1388,12 +1392,12 @@ warn(const char* pat,...) 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; } @@ -1827,6 +1831,8 @@ my_popen(char *cmd, char *mode) if (pid == 0) { GV* tmpgv; +#undef THIS +#undef THAT #define THIS that #define THAT This PerlLIO_close(p[THAT]); @@ -2127,7 +2133,7 @@ wait4pid(int pid, int *statusp, int flags) 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 *)); @@ -2139,7 +2145,7 @@ wait4pid(int pid, int *statusp, int flags) if (flags) croak("Can't do waitpid with flags"); else { - while ((result = wait(statusp)) != pid && pid > 0 && result >= 0) + while ((result = PerlProc_wait(statusp)) != pid && pid > 0 && result >= 0) pidgone(result,*statusp); if (result < 0) *statusp = -1; @@ -2370,6 +2376,7 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags) dTHR; char *xfound = Nullch; char *xfailed = Nullch; + char tmpbuf[512]; register char *s; I32 len; int retval; @@ -2413,6 +2420,7 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags) * + 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 @@ -2432,16 +2440,16 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags) /* 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 @@ -2470,12 +2478,12 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags) #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 @@ -2495,44 +2503,44 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags) && *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) @@ -2544,28 +2552,31 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags) #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); } @@ -2834,3 +2845,22 @@ get_op_descs(void) { return op_desc; } + +char * +get_no_modify(void) +{ + return (char*)no_modify; +} + +U32 * +get_opargs(void) +{ + return opargs; +} + + +SV ** +get_specialsv_list(void) +{ + return specialsv_list; +}