X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=7ed4e975a511fe38a838aad8ff7877e28069f345;hb=93a096870a2b1bc978c5a5479df6131dc5b46062;hp=76a632a0039e2af50dcda56dc0427a4ccfc8911a;hpb=2b2a7552a15f8e825abc97e9ae95ff726e336474;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doio.c b/doio.c index 76a632a..7ed4e97 100644 --- a/doio.c +++ b/doio.c @@ -1,7 +1,7 @@ /* doio.c * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -65,8 +65,8 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, { dVAR; register IO * const io = GvIOn(gv); - PerlIO *saveifp = Nullfp; - PerlIO *saveofp = Nullfp; + PerlIO *saveifp = NULL; + PerlIO *saveofp = NULL; int savefd = -1; char savetype = IoTYPE_CLOSED; int writing = 0; @@ -125,7 +125,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, "Warning: unable to close filehandle %s properly.\n", GvENAME(gv)); } - IoOFP(io) = IoIFP(io) = Nullfp; + IoOFP(io) = IoIFP(io) = NULL; } if (as_raw) { @@ -176,10 +176,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, IoTYPE(io) = PerlIO_intmode2str(rawmode, &mode[ix], &writing); - namesv = sv_2mortal(newSVpvn(oname,strlen(oname))); + namesv = sv_2mortal(newSVpv(oname,0)); num_svs = 1; svp = &namesv; - type = Nullch; + type = NULL; fp = PerlIO_openn(aTHX_ type, mode, -1, rawmode, rawperm, NULL, num_svs, svp); } else { @@ -336,7 +336,8 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, } else { GV *thatgv; - thatgv = gv_fetchpv(type,FALSE,SVt_PVIO); + thatgv = gv_fetchpvn_flags(type, tend - type, + 0, SVt_PVIO); thatio = GvIO(thatgv); } if (!thatio) { @@ -380,7 +381,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, fd = -1; } if (!num_svs) - type = Nullch; + type = NULL; if (that_fp) { fp = PerlIO_fdupopen(aTHX_ that_fp, NULL, dodup); } @@ -411,7 +412,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, namesv = sv_2mortal(newSVpvn(type,tend - type)); num_svs = 1; svp = &namesv; - type = Nullch; + type = NULL; } fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp); } @@ -449,7 +450,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, namesv = sv_2mortal(newSVpvn(type,tend - type)); num_svs = 1; svp = &namesv; - type = Nullch; + type = NULL; } fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp); } @@ -541,7 +542,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, namesv = sv_2mortal(newSVpvn(type,tend - type)); num_svs = 1; svp = &namesv; - type = Nullch; + type = NULL; } fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp); } @@ -686,7 +687,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, } #if defined(HAS_FCNTL) && defined(F_SETFD) if (fd >= 0) { - int save_errno = errno; + const int save_errno = errno; fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ errno = save_errno; } @@ -703,7 +704,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, *s = 'w'; if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,s,fd,0,0,NULL,0,svp))) { PerlIO_close(fp); - IoIFP(io) = Nullfp; + IoIFP(io) = NULL; goto say_false; } } @@ -722,6 +723,7 @@ say_false: PerlIO * Perl_nextargv(pTHX_ register GV *gv) { + dVAR; register SV *sv; #ifndef FLEXFILENAMES int filedev; @@ -732,13 +734,13 @@ Perl_nextargv(pTHX_ register GV *gv) IO * const io = GvIOp(gv); if (!PL_argvoutgv) - PL_argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO); + PL_argvoutgv = gv_fetchpvs("ARGVOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO); if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) { IoFLAGS(io) &= ~IOf_START; if (PL_inplace) { if (!PL_argvout_stack) PL_argvout_stack = newAV(); - av_push(PL_argvout_stack, SvREFCNT_inc(PL_defoutgv)); + av_push(PL_argvout_stack, SvREFCNT_inc_simple(PL_defoutgv)); } } if (PL_filemode & (S_ISUID|S_ISGID)) { @@ -753,7 +755,7 @@ Perl_nextargv(pTHX_ register GV *gv) PL_lastfd = -1; PL_filemode = 0; if (!GvAV(gv)) - return Nullfp; + return NULL; while (av_len(GvAV(gv)) >= 0) { STRLEN oldlen; sv = av_shift(GvAV(gv)); @@ -761,11 +763,12 @@ Perl_nextargv(pTHX_ register GV *gv) sv_setsv(GvSVn(gv),sv); SvSETMAGIC(GvSV(gv)); PL_oldname = SvPVx(GvSV(gv), oldlen); - if (do_open(gv,PL_oldname,oldlen,PL_inplace!=0,O_RDONLY,0,Nullfp)) { + if (do_open(gv,PL_oldname,oldlen,PL_inplace!=0,O_RDONLY,0,NULL)) { if (PL_inplace) { TAINT_PROPER("inplace open"); if (oldlen == 1 && *PL_oldname == '-') { - setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO)); + setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, + SVt_PVIO)); return IoIFP(GvIOp(gv)); } #ifndef FLEXFILENAMES @@ -831,7 +834,7 @@ Perl_nextargv(pTHX_ register GV *gv) (void)PerlLIO_unlink(SvPVX_const(sv)); (void)PerlLIO_rename(PL_oldname,SvPVX_const(sv)); do_open(gv,(char*)SvPVX_const(sv),SvCUR(sv),PL_inplace!=0, - O_RDONLY,0,Nullfp); + O_RDONLY,0,NULL); #endif /* DOSISH */ #else (void)UNLINK(SvPVX_const(sv)); @@ -868,11 +871,11 @@ Perl_nextargv(pTHX_ register GV *gv) SETERRNO(0,0); /* in case sprintf set errno */ #ifdef VMS if (!do_open(PL_argvoutgv,(char*)SvPVX_const(sv),SvCUR(sv), - PL_inplace!=0,O_WRONLY|O_CREAT|O_TRUNC,0,Nullfp)) + PL_inplace!=0,O_WRONLY|O_CREAT|O_TRUNC,0,NULL)) #else if (!do_open(PL_argvoutgv,(char*)SvPVX_const(sv),SvCUR(sv), PL_inplace!=0,O_WRONLY|O_CREAT|OPEN_EXCL,0666, - Nullfp)) + NULL)) #endif { if (ckWARN_d(WARN_INPLACE)) @@ -930,17 +933,18 @@ Perl_nextargv(pTHX_ register GV *gv) GV *oldout = (GV*)av_pop(PL_argvout_stack); setdefout(oldout); SvREFCNT_dec(oldout); - return Nullfp; + return NULL; } - setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO)); + setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO)); } - return Nullfp; + return NULL; } /* explicit renamed to avoid C++ conflict -- kja */ bool Perl_do_close(pTHX_ GV *gv, bool not_implicit) { + dVAR; bool retval; IO *io; @@ -973,6 +977,7 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit) bool Perl_io_close(pTHX_ IO *io, bool not_implicit) { + dVAR; bool retval = FALSE; if (IoIFP(io)) { @@ -990,16 +995,16 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit) retval = TRUE; else { if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { /* a socket */ - bool prev_err = PerlIO_error(IoOFP(io)); + const bool prev_err = PerlIO_error(IoOFP(io)); retval = (PerlIO_close(IoOFP(io)) != EOF && !prev_err); PerlIO_close(IoIFP(io)); /* clear stdio, fd already closed */ } else { - bool prev_err = PerlIO_error(IoIFP(io)); + const bool prev_err = PerlIO_error(IoIFP(io)); retval = (PerlIO_close(IoIFP(io)) != EOF && !prev_err); } } - IoOFP(io) = IoIFP(io) = Nullfp; + IoOFP(io) = IoIFP(io) = NULL; } else if (not_implicit) { SETERRNO(EBADF,SS_IVCHAN); @@ -1011,10 +1016,8 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit) bool Perl_do_eof(pTHX_ GV *gv) { - register IO *io; - int ch; - - io = GvIO(gv); + dVAR; + register IO * const io = GvIO(gv); if (!io) return TRUE; @@ -1022,21 +1025,22 @@ Perl_do_eof(pTHX_ GV *gv) report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY); while (IoIFP(io)) { - int saverrno; - if (PerlIO_has_cntptr(IoIFP(io))) { /* (the code works without this) */ if (PerlIO_get_cnt(IoIFP(io)) > 0) /* cheat a little, since */ return FALSE; /* this is the most usual case */ } - saverrno = errno; /* getc and ungetc can stomp on errno */ - ch = PerlIO_getc(IoIFP(io)); - if (ch != EOF) { - (void)PerlIO_ungetc(IoIFP(io),ch); + { + /* getc and ungetc can stomp on errno */ + const int saverrno = errno; + const int ch = PerlIO_getc(IoIFP(io)); + if (ch != EOF) { + (void)PerlIO_ungetc(IoIFP(io),ch); + errno = saverrno; + return FALSE; + } errno = saverrno; - return FALSE; } - errno = saverrno; if (PerlIO_has_cntptr(IoIFP(io)) && PerlIO_canset_cnt(IoIFP(io))) { if (PerlIO_get_cnt(IoIFP(io)) < -1) @@ -1055,7 +1059,8 @@ Perl_do_eof(pTHX_ GV *gv) Off_t Perl_do_tell(pTHX_ GV *gv) { - register IO *io = 0; + dVAR; + register IO *io = NULL; register PerlIO *fp; if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) { @@ -1074,7 +1079,8 @@ Perl_do_tell(pTHX_ GV *gv) bool Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence) { - register IO *io = 0; + dVAR; + register IO *io = NULL; register PerlIO *fp; if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) { @@ -1093,7 +1099,8 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence) Off_t Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) { - register IO *io = 0; + dVAR; + register IO *io = NULL; register PerlIO *fp; if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) @@ -1217,6 +1224,7 @@ my_chsize(int fd, Off_t length) bool Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) { + dVAR; register const char *tmps; STRLEN len; @@ -1268,6 +1276,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) I32 Perl_my_stat(pTHX) { + dVAR; dSP; IO *io; GV* gv; @@ -1288,7 +1297,7 @@ Perl_my_stat(pTHX) return PL_laststatval; if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) report_evil_fh(gv, io, PL_op->op_type); - PL_statgv = Nullgv; + PL_statgv = NULL; sv_setpvn(PL_statname,"", 0); return (PL_laststatval = -1); } @@ -1297,7 +1306,7 @@ Perl_my_stat(pTHX) return PL_laststatval; } else { - SV* sv = POPs; + SV* const sv = POPs; const char *s; STRLEN len; PUTBACK; @@ -1311,7 +1320,7 @@ Perl_my_stat(pTHX) } s = SvPV_const(sv, len); - PL_statgv = Nullgv; + PL_statgv = NULL; sv_setpvn(PL_statname, s, len); s = SvPVX_const(PL_statname); /* s now NUL-terminated */ PL_laststype = OP_STAT; @@ -1322,11 +1331,12 @@ Perl_my_stat(pTHX) } } -static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat"; I32 Perl_my_lstat(pTHX) { + dVAR; + static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat"; dSP; SV *sv; if (PL_op->op_flags & OPf_REF) { @@ -1347,7 +1357,7 @@ Perl_my_lstat(pTHX) Perl_croak(aTHX_ no_prev_lstat); PL_laststype = OP_LSTAT; - PL_statgv = Nullgv; + PL_statgv = NULL; sv = POPs; PUTBACK; if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV && ckWARN(WARN_IO)) { @@ -1373,7 +1383,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, #else if (sp > mark) { char **a; - const char *tmps = Nullch; + const char *tmps = NULL; Newx(PL_Argv, sp - mark + 1, char*); a = PL_Argv; @@ -1383,7 +1393,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, else *a++ = ""; } - *a = Nullch; + *a = NULL; if (really) tmps = SvPV_nolen_const(really); if ((!really && *PL_Argv[0] != '/') || @@ -1399,7 +1409,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s", (really ? tmps : PL_Argv[0]), Strerror(errno)); if (do_report) { - int e = errno; + const int e = errno; PerlLIO_write(fd, (void*)&e, sizeof(int)); PerlLIO_close(fd); @@ -1413,10 +1423,11 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, void Perl_do_execfree(pTHX) { + dVAR; Safefree(PL_Argv); - PL_Argv = Null(char **); + PL_Argv = NULL; Safefree(PL_Cmd); - PL_Cmd = Nullch; + PL_Cmd = NULL; } #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION @@ -1428,10 +1439,9 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) register char **a; register char *s; char *cmd; - int cmdlen; /* Make a copy so we can change it */ - cmdlen = strlen(incmd); + const int cmdlen = strlen(incmd); Newx(cmd, cmdlen+1, char); strncpy(cmd, incmd, cmdlen); cmd[cmdlen] = 0; @@ -1463,7 +1473,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) if (*s == ' ') s++; if (*s++ == '\'') { - char *ncmd = s; + char * const ncmd = s; while (*s) s++; @@ -1536,7 +1546,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) if (*s) *s++ = '\0'; } - *a = Nullch; + *a = NULL; if (PL_Argv[0]) { PERL_FPU_PRE_EXEC PerlProc_execvp(PL_Argv[0],PL_Argv); @@ -1545,15 +1555,13 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) do_execfree(); goto doshell; } - { - if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s", - PL_Argv[0], Strerror(errno)); - if (do_report) { - int e = errno; - PerlLIO_write(fd, (void*)&e, sizeof(int)); - PerlLIO_close(fd); - } + if (ckWARN(WARN_EXEC)) + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s", + PL_Argv[0], Strerror(errno)); + if (do_report) { + const int e = errno; + PerlLIO_write(fd, (const void*)&e, sizeof(int)); + PerlLIO_close(fd); } } do_execfree(); @@ -1566,9 +1574,10 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) I32 Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) { + dVAR; register I32 val; register I32 tot = 0; - const char *what; + const char *const what = PL_op_name[type]; const char *s; SV ** const oldmark = mark; @@ -1577,11 +1586,11 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) platforms where kill was not defined. */ #ifndef HAS_KILL if (type == OP_KILL) - Perl_die(aTHX_ PL_no_func, "kill"); + Perl_die(aTHX_ PL_no_func, what); #endif #ifndef HAS_CHOWN if (type == OP_CHOWN) - Perl_die(aTHX_ PL_no_func, "chown"); + Perl_die(aTHX_ PL_no_func, what); #endif @@ -1602,7 +1611,6 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) } switch (type) { case OP_CHMOD: - what = "chmod"; APPLY_TAINT_PROPER(); if (++mark <= sp) { val = SvIVx(*mark); @@ -1641,7 +1649,6 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) break; #ifdef HAS_CHOWN case OP_CHOWN: - what = "chown"; APPLY_TAINT_PROPER(); if (sp - mark > 2) { register I32 val2; @@ -1689,7 +1696,6 @@ nothing in the core. */ #ifdef HAS_KILL case OP_KILL: - what = "kill"; APPLY_TAINT_PROPER(); if (mark == sp) break; @@ -1738,7 +1744,7 @@ nothing in the core. if (val < 0) { val = -val; while (++mark <= sp) { - I32 proc = SvIVx(*mark); + const I32 proc = SvIVx(*mark); APPLY_TAINT_PROPER(); #ifdef HAS_KILLPG if (PerlProc_killpg(proc,val)) /* BSD */ @@ -1750,7 +1756,7 @@ nothing in the core. } else { while (++mark <= sp) { - I32 proc = SvIVx(*mark); + const I32 proc = SvIVx(*mark); APPLY_TAINT_PROPER(); if (PerlProc_kill(proc, val)) tot--; @@ -1759,7 +1765,6 @@ nothing in the core. break; #endif case OP_UNLINK: - what = "unlink"; APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { @@ -1781,7 +1786,6 @@ nothing in the core. break; #if defined(HAS_UTIME) || defined(HAS_FUTIMES) case OP_UTIME: - what = "utime"; APPLY_TAINT_PROPER(); if (sp - mark > 2) { #if defined(HAS_FUTIMES) @@ -1798,8 +1802,8 @@ nothing in the core. void *utbufp = &utbuf; #endif - SV* accessed = *++mark; - SV* modified = *++mark; + SV* const accessed = *++mark; + SV* const modified = *++mark; /* Be like C, and if both times are undefined, let the C * library figure out what to do. This usually means @@ -1847,7 +1851,7 @@ nothing in the core. goto do_futimes; } else { - const char *name = SvPV_nolen_const(*mark); + const char * const name = SvPV_nolen_const(*mark); APPLY_TAINT_PROPER(); #ifdef HAS_FUTIMES if (utimes(name, utbufp)) @@ -1877,6 +1881,7 @@ Perl_cando(pTHX_ Mode_t mode, bool effective, register const Stat_t *statbufp) * is in the list of groups returned from getgroups(). */ { + dVAR; #ifdef DOSISH /* [Comments and code from Len Reed] * MS-DOS "user" is similar to UNIX's "superuser," but can't write @@ -1933,24 +1938,31 @@ Perl_ingroup(pTHX_ Gid_t testgid, bool effective) /* This is simply not correct for AppleShare, but fix it yerself. */ return TRUE; #else + dVAR; if (testgid == (effective ? PL_egid : PL_gid)) return TRUE; #ifdef HAS_GETGROUPS -#ifndef NGROUPS -#define NGROUPS 32 -#endif { - Groups_t gary[NGROUPS]; + Groups_t *gary = NULL; I32 anum; + bool rc = FALSE; - anum = getgroups(NGROUPS,gary); + anum = getgroups(0, gary); + Newx(gary, anum, Groups_t); + anum = getgroups(anum, gary); while (--anum >= 0) - if (gary[anum] == testgid) - return TRUE; + if (gary[anum] == testgid) { + rc = TRUE; + break; + } + + Safefree(gary); + return rc; } -#endif +#else return FALSE; #endif +#endif } #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) @@ -1958,10 +1970,12 @@ Perl_ingroup(pTHX_ Gid_t testgid, bool effective) I32 Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp) { - key_t key = (key_t)SvNVx(*++mark); + dVAR; + const key_t key = (key_t)SvNVx(*++mark); const I32 n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark); const I32 flags = SvIVx(*++mark); - (void)sp; + + PERL_UNUSED_ARG(sp); SETERRNO(0,0); switch (optype) @@ -1989,19 +2003,17 @@ Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp) I32 Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) { - SV *astr; + dVAR; char *a; - STRLEN infosize; - I32 getinfo; I32 ret = -1; const I32 id = SvIVx(*++mark); const I32 n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; const I32 cmd = SvIVx(*++mark); - PERL_UNUSED_ARG(sp); + SV * const astr = *++mark; + STRLEN infosize = 0; + I32 getinfo = (cmd == IPC_STAT); - astr = *++mark; - infosize = 0; - getinfo = (cmd == IPC_STAT); + PERL_UNUSED_ARG(sp); switch (optype) { @@ -2069,7 +2081,7 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) } else { - IV i = SvIV(astr); + const IV i = SvIV(astr); a = INT2PTR(char *,i); /* ouch */ } SETERRNO(0,0); @@ -2114,18 +2126,18 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) I32 Perl_do_msgsnd(pTHX_ SV **mark, SV **sp) { + dVAR; #ifdef HAS_MSG - SV *mstr; - const char *mbuf; - I32 msize, flags; STRLEN len; const I32 id = SvIVx(*++mark); + SV * const mstr = *++mark; + const I32 flags = SvIVx(*++mark); + const char * const mbuf = SvPV_const(mstr, len); + const I32 msize = len - sizeof(long); + PERL_UNUSED_ARG(sp); - mstr = *++mark; - flags = SvIVx(*++mark); - mbuf = SvPV_const(mstr, len); - if ((msize = len - sizeof(long)) < 0) + if (msize < 0) Perl_croak(aTHX_ "Arg too short for msgsnd"); SETERRNO(0,0); return msgsnd(id, (struct msgbuf *)mbuf, msize, flags); @@ -2138,14 +2150,14 @@ I32 Perl_do_msgrcv(pTHX_ SV **mark, SV **sp) { #ifdef HAS_MSG - SV *mstr; + dVAR; char *mbuf; long mtype; I32 msize, flags, ret; const I32 id = SvIVx(*++mark); + SV * const mstr = *++mark; PERL_UNUSED_ARG(sp); - mstr = *++mark; /* suppress warning when reading into undef var --jhi */ if (! SvOK(mstr)) sv_setpvn(mstr, "", 0); @@ -2175,14 +2187,13 @@ I32 Perl_do_semop(pTHX_ SV **mark, SV **sp) { #ifdef HAS_SEM - SV *opstr; - const char *opbuf; + dVAR; STRLEN opsize; const I32 id = SvIVx(*++mark); + SV * const opstr = *++mark; + const char * const opbuf = SvPV_const(opstr, opsize); PERL_UNUSED_ARG(sp); - opstr = *++mark; - opbuf = SvPV_const(opstr, opsize); if (opsize < 3 * SHORTSIZE || (opsize % (3 * SHORTSIZE))) { SETERRNO(EINVAL,LIB_INVARG); @@ -2193,7 +2204,7 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp) { const int nsops = opsize / (3 * sizeof (short)); int i = nsops; - short *ops = (short *) opbuf; + short * const ops = (short *) opbuf; short *o = ops; struct sembuf *temps, *t; I32 result; @@ -2228,16 +2239,15 @@ I32 Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) { #ifdef HAS_SHM - SV *mstr; + dVAR; char *shm; - I32 mpos, msize; struct shmid_ds shmds; const I32 id = SvIVx(*++mark); + SV * const mstr = *++mark; + const I32 mpos = SvIVx(*++mark); + const I32 msize = SvIVx(*++mark); PERL_UNUSED_ARG(sp); - mstr = *++mark; - mpos = SvIVx(*++mark); - msize = SvIVx(*++mark); SETERRNO(0,0); if (shmctl(id, IPC_STAT, &shmds) == -1) return -1; @@ -2301,95 +2311,20 @@ PerlIO * Perl_start_glob (pTHX_ SV *tmpglob, IO *io) { dVAR; - SV * const tmpcmd = NEWSV(55, 0); + SV * const tmpcmd = newSV(0); PerlIO *fp; ENTER; SAVEFREESV(tmpcmd); #ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */ /* since spawning off a process is a real performance hit */ - { -#include -#include -#include -#include - char rslt[NAM$C_MAXRSS+1+sizeof(unsigned short int)] = {'\0','\0'}; - char vmsspec[NAM$C_MAXRSS+1]; - char * const rstr = rslt + sizeof(unsigned short int); - char *begin, *end, *cp; - $DESCRIPTOR(dfltdsc,"SYS$DISK:[]*.*;"); - PerlIO *tmpfp; - STRLEN i; - struct dsc$descriptor_s wilddsc - = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; - struct dsc$descriptor_vs rsdsc - = {sizeof rslt, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, rslt}; - unsigned long int cxt = 0, sts = 0, ok = 1, hasdir = 0, hasver = 0, isunix = 0; - - /* We could find out if there's an explicit dev/dir or version - by peeking into lib$find_file's internal context at - ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb - but that's unsupported, so I don't want to do it now and - have it bite someone in the future. */ - cp = SvPV(tmpglob,i); - for (; i; i--) { - if (cp[i] == ';') hasver = 1; - if (cp[i] == '.') { - if (sts) hasver = 1; - else sts = 1; - } - if (cp[i] == '/') { - hasdir = isunix = 1; - break; - } - if (cp[i] == ']' || cp[i] == '>' || cp[i] == ':') { - hasdir = 1; - break; - } - } - if ((tmpfp = PerlIO_tmpfile()) != NULL) { - Stat_t st; - if (!PerlLIO_stat(SvPVX_const(tmpglob),&st) && S_ISDIR(st.st_mode)) - ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX(tmpglob),vmsspec)) != NULL); - else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL); - if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer); - for (cp=wilddsc.dsc$a_pointer; ok && cp && *cp; cp++) - if (*cp == '?') *cp = '%'; /* VMS style single-char wildcard */ - while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt, - &dfltdsc,NULL,NULL,NULL))&1)) { - /* with varying string, 1st word of buffer contains result length */ - end = rstr + *((unsigned short int*)rslt); - if (!hasver) while (*end != ';' && end > rstr) end--; - *(end++) = '\n'; *end = '\0'; - for (cp = rstr; *cp; cp++) *cp = _tolower(*cp); - if (hasdir) { - if (isunix) trim_unixpath(rstr,SvPVX(tmpglob),1); - begin = rstr; - } - else { - begin = end; - while (*(--begin) != ']' && *begin != '>') ; - ++begin; - } - ok = (PerlIO_puts(tmpfp,begin) != EOF); - } - if (cxt) (void)lib$find_file_end(&cxt); - if (ok && sts != RMS$_NMF && - sts != RMS$_DNF && sts != RMS_FNF) ok = 0; - if (!ok) { - if (!(sts & 1)) { - SETERRNO((sts == RMS$_SYN ? EINVAL : EVMSERR),sts); - } - PerlIO_close(tmpfp); - fp = NULL; - } - else { - PerlIO_rewind(tmpfp); - IoTYPE(io) = IoTYPE_RDONLY; - IoIFP(io) = fp = tmpfp; - IoFLAGS(io) &= ~IOf_UNTAINT; /* maybe redundant */ - } - } - } + +PerlIO * +Perl_vms_start_glob + (pTHX_ SV *tmpglob, + IO *io); + + fp = Perl_vms_start_glob(aTHX_ tmpglob, io); + #else /* !VMS */ #ifdef MACOS_TRADITIONAL sv_setpv(tmpcmd, "glob "); @@ -2429,7 +2364,7 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io) #endif /* !DOSISH */ #endif /* MACOS_TRADITIONAL */ (void)do_open(PL_last_in_gv, (char*)SvPVX_const(tmpcmd), SvCUR(tmpcmd), - FALSE, O_RDONLY, 0, Nullfp); + FALSE, O_RDONLY, 0, NULL); fp = IoIFP(io); #endif /* !VMS */ LEAVE;