develooper Front page | perl.perl5.porters | Postings from December 2000

[PATCH] move startglob out of pp_hot.c

Thread Next
From:
Nicholas Clark
Date:
December 11, 2000 15:16
Subject:
[PATCH] move startglob out of pp_hot.c
Message ID:
20001211231638.A55550@plum.flirble.org
On the basis that the csh glob starting code isn't even used outside
miniperl now, and then even there I'd assume that it's not called to
start a glob as much as other uses of do_readline, I assumed that
moving it out of the middle of do_readline in pp_hot.c would speed things
up slightly. (by making the function smaller, and by making the hot code
smaller)

However, timing the regression tests on two architectures suggest that it
doesn't really have much effect either way, apart from optimising for
maintainability. So I'm not sure if it should go in. I offer it for
p5p's comments (and benchmarking)


Nicholas Clark

--- pp_hot.c.orig	Sat Dec  9 15:56:35 2000
+++ pp_hot.c	Sun Dec 10 18:46:16 2000
@@ -1243,138 +1243,8 @@
 		    (void)do_close(PL_last_in_gv, FALSE); /* now it does*/
 		}
 	    }
-	    else if (type == OP_GLOB) {
-		SV *tmpcmd = NEWSV(55, 0);
-		SV *tmpglob = POPs;
-		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 <descrip.h>
-#include <lib$routines.h>
-#include <nam.h>
-#include <rmsdef.h>
-		    char rslt[NAM$C_MAXRSS+1+sizeof(unsigned short int)] = {'\0','\0'};
-		    char vmsspec[NAM$C_MAXRSS+1];
-		    char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp;
-		    char tmpfnam[L_tmpnam] = "SYS$SCRATCH:";
-		    $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. */
-		    strcat(tmpfnam,PerlLIO_tmpnam(NULL));
-		    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_open(tmpfnam,"w+","fop=dlt")) != NULL) {
-		        Stat_t st;
-		        if (!PerlLIO_stat(SvPVX(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);
-		        while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
-		                                    &dfltdsc,NULL,NULL,NULL))&1)) {
-		            end = rstr + (unsigned long int) *rslt;
-		            if (!hasver) while (*end != ';') 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 */
-		        }
-		    }
-		}
-#else /* !VMS */
-#ifdef MACOS_TRADITIONAL
-		sv_setpv(tmpcmd, "glob ");
-		sv_catsv(tmpcmd, tmpglob);
-		sv_catpv(tmpcmd, " |");
-#else
-#ifdef DOSISH
-#ifdef OS2
-		sv_setpv(tmpcmd, "for a in ");
-		sv_catsv(tmpcmd, tmpglob);
-		sv_catpv(tmpcmd, "; do echo \"$a\\0\\c\"; done |");
-#else
-#ifdef DJGPP
-		sv_setpv(tmpcmd, "/dev/dosglob/"); /* File System Extension */
-		sv_catsv(tmpcmd, tmpglob);
-#else
-		sv_setpv(tmpcmd, "perlglob ");
-		sv_catsv(tmpcmd, tmpglob);
-		sv_catpv(tmpcmd, " |");
-#endif /* !DJGPP */
-#endif /* !OS2 */
-#else /* !DOSISH */
-#if defined(CSH)
-		sv_setpvn(tmpcmd, PL_cshname, PL_cshlen);
-		sv_catpv(tmpcmd, " -cf 'set nonomatch; glob ");
-		sv_catsv(tmpcmd, tmpglob);
-		sv_catpv(tmpcmd, "' 2>/dev/null |");
-#else
-		sv_setpv(tmpcmd, "echo ");
-		sv_catsv(tmpcmd, tmpglob);
-#if 'z' - 'a' == 25
-		sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
-#else
-		sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|");
-#endif
-#endif /* !CSH */
-#endif /* !DOSISH */
-#endif /* MACOS_TRADITIONAL */
-		(void)do_open(PL_last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
-			      FALSE, O_RDONLY, 0, Nullfp);
-		fp = IoIFP(io);
-#endif /* !VMS */
-		LEAVE;
-	    }
+	    else if (type == OP_GLOB)
+		fp = Perl_start_glob(aTHX_ POPs, io);
 	}
 	else if (type == OP_GLOB)
 	    SP--;
--- doio.c.orig	Sat Dec  9 20:56:42 2000
+++ doio.c	Sun Dec 10 18:46:04 2000
@@ -2011,4 +2011,149 @@
 
 #endif /* SYSV IPC */
 
+/*
+=for apidoc start_glob
 
+Function called by C<do_readline> to spawn a glob (or do the glob inside
+perl on VMS). This code used to be inline, but now perl uses C<File::Glob>
+this glob starter is only used by miniperl during the build proccess.
+Moving it away shrinks pp_hot.c; shrinking pp_hot.c helps speed perl up.
+
+=cut
+*/
+
+PerlIO *
+Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
+{
+    SV *tmpcmd = NEWSV(55, 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 <descrip.h>
+#include <lib$routines.h>
+#include <nam.h>
+#include <rmsdef.h>
+	char rslt[NAM$C_MAXRSS+1+sizeof(unsigned short int)] = {'\0','\0'};
+	char vmsspec[NAM$C_MAXRSS+1];
+	char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp;
+	char tmpfnam[L_tmpnam] = "SYS$SCRATCH:";
+	$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. */
+	strcat(tmpfnam,PerlLIO_tmpnam(NULL));
+	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_open(tmpfnam,"w+","fop=dlt")) != NULL) {
+	    Stat_t st;
+	    if (!PerlLIO_stat(SvPVX(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);
+	    while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
+					       &dfltdsc,NULL,NULL,NULL))&1)) {
+		end = rstr + (unsigned long int) *rslt;
+		if (!hasver) while (*end != ';') 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 */
+	    }
+	}
+    }
+#else /* !VMS */
+#ifdef MACOS_TRADITIONAL
+    sv_setpv(tmpcmd, "glob ");
+    sv_catsv(tmpcmd, tmpglob);
+    sv_catpv(tmpcmd, " |");
+#else
+#ifdef DOSISH
+#ifdef OS2
+    sv_setpv(tmpcmd, "for a in ");
+    sv_catsv(tmpcmd, tmpglob);
+    sv_catpv(tmpcmd, "; do echo \"$a\\0\\c\"; done |");
+#else
+#ifdef DJGPP
+    sv_setpv(tmpcmd, "/dev/dosglob/"); /* File System Extension */
+    sv_catsv(tmpcmd, tmpglob);
+#else
+    sv_setpv(tmpcmd, "perlglob ");
+    sv_catsv(tmpcmd, tmpglob);
+    sv_catpv(tmpcmd, " |");
+#endif /* !DJGPP */
+#endif /* !OS2 */
+#else /* !DOSISH */
+#if defined(CSH)
+    sv_setpvn(tmpcmd, PL_cshname, PL_cshlen);
+    sv_catpv(tmpcmd, " -cf 'set nonomatch; glob ");
+    sv_catsv(tmpcmd, tmpglob);
+    sv_catpv(tmpcmd, "' 2>/dev/null |");
+#else
+    sv_setpv(tmpcmd, "echo ");
+    sv_catsv(tmpcmd, tmpglob);
+#if 'z' - 'a' == 25
+    sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
+#else
+    sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|");
+#endif
+#endif /* !CSH */
+#endif /* !DOSISH */
+#endif /* MACOS_TRADITIONAL */
+    (void)do_open(PL_last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
+		  FALSE, O_RDONLY, 0, Nullfp);
+    fp = IoIFP(io);
+#endif /* !VMS */
+    LEAVE;
+    return fp;
+}
--- embed.pl.orig	Sat Dec  9 20:51:41 2000
+++ embed.pl	Sun Dec 10 19:15:01 2000
@@ -2532,6 +2532,10 @@
 #  endif
 #endif
 
+#if defined(PERL_IN_DOIO_C) || defined(PERL_DECL_PROT)
+dopM	|PerlIO*|start_glob	|SV* pattern|IO *io
+#endif
+
 #if defined(PERL_OBJECT)
 };
 #endif

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About