X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=0380085995a31357753a26556f9a185f031ff1f4;hb=377729033bd4c3e2f6c0ac6b0d2bde9a83c5da6d;hp=ab6ddd7d614a87e986178aab749842e632cd4b38;hpb=161b471ac314d8d6343f9f351e5fb9ef816168a8;p=p5sagit%2Fp5-mst-13.2.git diff --git a/util.c b/util.c index ab6ddd7..0380085 100644 --- a/util.c +++ b/util.c @@ -822,18 +822,20 @@ fbm_compile(SV *sv) sv_upgrade(sv, SVt_PVBM); if (len > 255 || len == 0) /* TAIL might be on on a zero-length string. */ return; /* can't have offsets that big */ - Sv_Grow(sv,len+258); - table = (unsigned char*)(SvPVX(sv) + len + 1); - s = table - 2; - for (i = 0; i < 256; i++) { - table[i] = len; - } - i = 0; - while (s >= (unsigned char*)(SvPVX(sv))) - { - if (table[*s] == len) - table[*s] = i; - s--,i++; + if (len > 2) { + Sv_Grow(sv,len + 258); + table = (unsigned char*)(SvPVX(sv) + len + 1); + s = table - 2; + for (i = 0; i < 256; i++) { + table[i] = len; + } + i = 0; + while (s >= (unsigned char*)(SvPVX(sv))) + { + if (table[*s] == len) + table[*s] = i; + s--,i++; + } } sv_magic(sv, Nullsv, 'B', Nullch, 0); /* deep magic */ SvVALID_on(sv); @@ -865,7 +867,15 @@ fbm_instr(unsigned char *big, register unsigned char *bigend, SV *littlestr) STRLEN len; char *l = SvPV(littlestr,len); if (!len) { - if (SvTAIL(littlestr)) { + if (SvTAIL(littlestr)) { /* Can be only 0-len constant + substr => we can ignore SvVALID */ + if (multiline) { + char *t = "\n"; + if ((s = (unsigned char*)ninstr((char*)big, (char*)bigend, + t, t + len))) { + return (char*)s; + } + } if (bigend > big && bigend[-1] == '\n') return (char *)(bigend - 1); else @@ -882,13 +892,32 @@ fbm_instr(unsigned char *big, register unsigned char *bigend, SV *littlestr) return Nullch; little = (unsigned char*)SvPVX(littlestr); s = bigend - littlelen; - if (*s == *little && memEQ((char*)s,(char*)little,littlelen)) + if (s > big + && bigend[-1] == '\n' + && s[-1] == *little && memEQ((char*)s - 1,(char*)little,littlelen)) + return (char*)s - 1; /* how sweet it is */ + else if (*s == *little && memEQ((char*)s,(char*)little,littlelen)) return (char*)s; /* how sweet it is */ - else if (bigend[-1] == '\n' && little[littlelen-1] != '\n' - && s > big) { - s--; - if (*s == *little && memEQ((char*)s,(char*)little,littlelen)) + return Nullch; + } + if (littlelen <= 2) { + unsigned char c1 = (unsigned char)SvPVX(littlestr)[0]; + unsigned char c2 = (unsigned char)SvPVX(littlestr)[1]; + /* This may do extra comparisons if littlelen == 2, but this + should be hidden in the noise since we do less indirection. */ + + s = big; + bigend -= littlelen; + while (s <= bigend) { + if (s[0] == c1 + && (littlelen == 1 || s[1] == c2) + && (!SvTAIL(littlestr) + || s == bigend + || s[littlelen] == '\n')) /* Automatically multiline */ + { return (char*)s; + } + s++; } return Nullch; } @@ -1984,7 +2013,7 @@ rsignal_restore(int signo, Sigsave_t *save) /* VMS' my_pclose() is in VMS.c; same with OS/2 */ #if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) I32 -my_pclose(FILE *ptr) +my_pclose(PerlIO *ptr) { Sigsave_t hstat, istat, qstat; int status; @@ -1995,6 +2024,9 @@ my_pclose(FILE *ptr) #ifdef VMS int saved_vaxc_errno; #endif +#ifdef WIN32 + int saved_win32_errno; +#endif svp = av_fetch(fdpid,PerlIO_fileno(ptr),TRUE); pid = (int)SvIVX(*svp); @@ -2010,6 +2042,9 @@ my_pclose(FILE *ptr) #ifdef VMS saved_vaxc_errno = vaxc$errno; #endif +#ifdef WIN32 + saved_win32_errno = GetLastError(); +#endif } #ifdef UTS if(kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */ @@ -2031,7 +2066,7 @@ my_pclose(FILE *ptr) } #endif /* !DOSISH */ -#if !defined(DOSISH) || defined(OS2) +#if !defined(DOSISH) || defined(OS2) || defined(WIN32) I32 wait4pid(int pid, int *statusp, int flags) { @@ -2089,7 +2124,7 @@ wait4pid(int pid, int *statusp, int flags) } #endif } -#endif /* !DOSISH */ +#endif /* !DOSISH || OS2 || WIN32 */ void /*SUPPRESS 590*/ @@ -2322,7 +2357,7 @@ void perl_cond_signal(cp) perl_cond *cp; { - perl_thread t; + perl_os_thread t; perl_cond cond = *cp; if (!cond) @@ -2343,7 +2378,7 @@ void perl_cond_broadcast(cp) perl_cond *cp; { - perl_thread t; + perl_os_thread t; perl_cond cond, cond_next; for (cond = *cp; cond; cond = cond_next) { @@ -2382,14 +2417,14 @@ perl_cond *cp; #endif /* FAKE_THREADS */ #ifdef OLD_PTHREADS_API -struct thread * +struct perl_thread * getTHR _((void)) { pthread_addr_t t; if (pthread_getspecific(thr_key, &t)) croak("panic: pthread_getspecific"); - return (struct thread *) t; + return (struct perl_thread *) t; } #endif /* OLD_PTHREADS_API */ @@ -2438,20 +2473,20 @@ condpair_magic(SV *sv) * called. The use by ext/Thread/Thread.xs in core perl (where t is the * thread calling new_struct_thread) clearly satisfies this constraint. */ -struct thread * -new_struct_thread(struct thread *t) +struct perl_thread * +new_struct_thread(struct perl_thread *t) { - struct thread *thr; + struct perl_thread *thr; SV *sv; SV **svp; I32 i; sv = newSVpv("", 0); - SvGROW(sv, sizeof(struct thread) + 1); - SvCUR_set(sv, sizeof(struct thread)); + SvGROW(sv, sizeof(struct perl_thread) + 1); + SvCUR_set(sv, sizeof(struct perl_thread)); thr = (Thread) SvPVX(sv); /* debug */ - memset(thr, 0xab, sizeof(struct thread)); + memset(thr, 0xab, sizeof(struct perl_thread)); markstack = 0; scopestack = 0; savestack = 0; @@ -2508,7 +2543,7 @@ new_struct_thread(struct thread *t) /* Initialise all per-thread SVs that the template thread used */ svp = AvARRAY(t->threadsv); - for (i = 0; i <= AvFILL(t->threadsv); i++, svp++) { + for (i = 0; i <= AvFILLp(t->threadsv); i++, svp++) { if (*svp && *svp != &sv_undef) { SV *sv = newSVsv(*svp); av_store(thr->threadsv, i, sv); @@ -2547,4 +2582,22 @@ Perl_huge(void) } #endif +#ifdef PERL_GLOBAL_STRUCT +struct perl_vars * +Perl_GetVars(void) +{ + return &Perl_Vars; +} +#endif +char ** +get_op_names(void) +{ + return op_name; +} + +char ** +get_op_descs(void) +{ + return op_desc; +}