return Nullch;
}
if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
- char *b = ninstr((char*)big,(char*)bigend,
+ char * const b = ninstr((char*)big,(char*)bigend,
(char*)little, (char*)little + littlelen);
if (!b && SvTAIL(littlestr)) { /* Automatically multiline! */
}
{ /* Do actual FBM. */
- register const unsigned char *table = little + littlelen + FBM_TABLE_OFFSET;
+ register const unsigned char * const table = little + littlelen + FBM_TABLE_OFFSET;
register const unsigned char *oldlittle;
if (littlelen > (STRLEN)(bigend - big))
SV *
Perl_vmess(pTHX_ const char *pat, va_list *args)
{
- SV *sv = mess_alloc();
+ SV * const sv = mess_alloc();
static const char dgd[] = " during global destruction.\n";
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
if (val == NULL) {
(void)unsetenv(nam);
} else {
- int nlen = strlen(nam);
- int vlen = strlen(val);
- char *new_env =
+ const int nlen = strlen(nam);
+ const int vlen = strlen(val);
+ char * const new_env =
(char*)safesysmalloc((nlen + vlen + 2) * sizeof(char));
my_setenv_format(new_env, nam, nlen, val, vlen);
(void)putenv(new_env);
}
# else /* ! HAS_UNSETENV */
char *new_env;
- int nlen = strlen(nam), vlen;
+ const int nlen = strlen(nam);
+ int vlen;
if (!val) {
val = "";
}
PL_ppid = (IV)getppid();
#endif
PL_forkprocess = 0;
+#ifdef PERL_USES_PL_PIDSTATUS
hv_clear(PL_pidstatus); /* we have no children */
+#endif
return Nullfp;
#undef THIS
#undef THAT
I32 result = 0;
if (!pid)
return -1;
-#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
+#ifdef PERL_USES_PL_PIDSTATUS
{
- char spid[TYPE_CHARS(IV)];
-
if (pid > 0) {
- SV** svp;
- sprintf(spid, "%"IVdf, (IV)pid);
- svp = hv_fetch(PL_pidstatus,spid,strlen(spid),FALSE);
+ /* The keys in PL_pidstatus are now the raw 4 (or 8) bytes of the
+ pid, rather than a string form. */
+ SV * const * const svp = hv_fetch(PL_pidstatus,(const char*) &pid,sizeof(Pid_t),FALSE);
if (svp && *svp != &PL_sv_undef) {
*statusp = SvIVX(*svp);
- (void)hv_delete(PL_pidstatus,spid,strlen(spid),G_DISCARD);
+ (void)hv_delete(PL_pidstatus,(const char*) &pid,sizeof(Pid_t),
+ G_DISCARD);
return pid;
}
}
hv_iterinit(PL_pidstatus);
if ((entry = hv_iternext(PL_pidstatus))) {
- SV *sv = hv_iterval(PL_pidstatus,entry);
+ SV * const sv = hv_iterval(PL_pidstatus,entry);
+ I32 len;
+ const char *spid = hv_iterkey(entry,&len);
- pid = atoi(hv_iterkey(entry,(I32*)statusp));
+ assert (len == sizeof(Pid_t));
+ memcpy((char *)&pid, spid, len);
*statusp = SvIVX(sv);
- sprintf(spid, "%"IVdf, (IV)pid);
- (void)hv_delete(PL_pidstatus,spid,strlen(spid),G_DISCARD);
+ /* The hash iterator is currently on this entry, so simply
+ calling hv_delete would trigger the lazy delete, which on
+ aggregate does more work, beacuse next call to hv_iterinit()
+ would spot the flag, and have to call the delete routine,
+ while in the meantime any new entries can't re-use that
+ memory. */
+ hv_iterinit(PL_pidstatus);
+ (void)hv_delete(PL_pidstatus,spid,len,G_DISCARD);
return pid;
}
}
result = wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
goto finish;
#endif
-#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
+#ifdef PERL_USES_PL_PIDSTATUS
#if defined(HAS_WAITPID) && defined(HAS_WAITPID_RUNTIME)
hard_way:
#endif
}
#endif /* !DOSISH || OS2 || WIN32 || NETWARE */
+#ifdef PERL_USES_PL_PIDSTATUS
void
Perl_pidgone(pTHX_ Pid_t pid, int status)
{
register SV *sv;
- char spid[TYPE_CHARS(IV)];
- size_t len = my_sprintf(spid, "%"IVdf, (IV)pid);
- sv = *hv_fetch(PL_pidstatus,spid,len,TRUE);
+ sv = *hv_fetch(PL_pidstatus,(const char*)&pid,sizeof(Pid_t),TRUE);
SvUPGRADE(sv,SVt_IV);
SvIV_set(sv, status);
return;
}
+#endif
#if defined(atarist) || defined(OS2) || defined(EPOC)
int pclose();
#endif
{
/* Needs work for PerlIO ! */
- FILE *f = PerlIO_findFILE(ptr);
+ FILE * const f = PerlIO_findFILE(ptr);
I32 result = pclose(f);
PerlIO_releaseFILE(ptr,f);
return result;
Perl_my_pclose(pTHX_ PerlIO *ptr)
{
/* Needs work for PerlIO ! */
- FILE *f = PerlIO_findFILE(ptr);
+ FILE * const f = PerlIO_findFILE(ptr);
I32 result = djgpp_pclose(f);
result = (result << 8) & 0xff00;
PerlIO_releaseFILE(ptr,f);
Perl_repeatcpy(pTHX_ register char *to, register const char *from, I32 len, register I32 count)
{
register I32 todo;
- register const char *frombase = from;
+ register const char * const frombase = from;
if (len == 1) {
register const char c = *from;
char *fb = strrchr(b,'/');
Stat_t tmpstatbuf1;
Stat_t tmpstatbuf2;
- SV *tmpsv = sv_newmortal();
+ SV * const tmpsv = sv_newmortal();
if (fa)
fa++;
# ifdef ALWAYS_DEFTYPES
len = strlen(scriptname);
if (!(len == 1 && *scriptname == '-') && scriptname[len-1] != ':') {
- int hasdir, idx = 0, deftypes = 1;
+ int idx = 0, deftypes = 1;
bool seen_dot = 1;
- hasdir = !dosearch || (strpbrk(scriptname,":[</") != Nullch) ;
+ const int hasdir = !dosearch || (strpbrk(scriptname,":[</") != Nullch);
# else
if (dosearch) {
- int hasdir, idx = 0, deftypes = 1;
+ int idx = 0, deftypes = 1;
bool seen_dot = 1;
- hasdir = (strpbrk(scriptname,":[</") != Nullch) ;
+ const int hasdir = (strpbrk(scriptname,":[</") != Nullch);
# endif
/* The first time through, just add SEARCH_EXTS to whatever we
* already have, so we can check for default file types. */
=for apidoc sv_nosharing
Dummy routine which "shares" an SV when there is no sharing module present.
-Exists to avoid test for a NULL function pointer and because it could potentially warn under
-some level of strict-ness.
+Or "locks" it. Or "unlocks" it. In other words, ignores its single SV argument.
+Exists to avoid test for a NULL function pointer and because it could
+potentially warn under some level of strict-ness.
=cut
*/
PERL_UNUSED_ARG(sv);
}
-/*
-=for apidoc sv_nolocking
-
-Dummy routine which "locks" an SV when there is no locking module present.
-Exists to avoid test for a NULL function pointer and because it could potentially warn under
-some level of strict-ness.
-
-=cut
-*/
-
-void
-Perl_sv_nolocking(pTHX_ SV *sv)
-{
- PERL_UNUSED_ARG(sv);
-}
-
-
-/*
-=for apidoc sv_nounlocking
-
-Dummy routine which "unlocks" an SV when there is no locking module present.
-Exists to avoid test for a NULL function pointer and because it could potentially warn under
-some level of strict-ness.
-
-=cut
-*/
-
-void
-Perl_sv_nounlocking(pTHX_ SV *sv)
-{
- PERL_UNUSED_ARG(sv);
-}
-
U32
Perl_parse_unicode_opts(pTHX_ const char **popt)
{
projects / p5sagit/p5-mst-13.2.git / blobdiff