This patch describes the changes made in ActivePerl build 633 over the official Perl v5.6.1 sources from CPAN. Summary of changes in build 633: * Make "perl -V" output reflect ActiveState build. * Add Win32::BuildNumber() for compatibility. * Add resources to perl.exe and perl56.dll. Detailed logs are at the end of this file. The ActivePerl Release Notes contain an informal summary of these changes. These can be viewed at: http://www.ActiveState.com/ActivePerl/docs/CHANGES.html The included patch may be applied to Perl v5.6.1 sources using the GNU patch utility. e.g: % cd perl-5.6.1 % patch -lNp1 < this_file --------------------------------------------------------------------------- diff -ruN perl-5.6.1/BuildInfo.h AP633_source/BuildInfo.h --- perl-5.6.1/BuildInfo.h Wed Dec 31 16:00:00 1969 +++ AP633_source/BuildInfo.h Mon Jun 17 21:27:56 2002 @@ -0,0 +1,25 @@ +/* BuildInfo.h + * + * Copyright (c) 1998-2002 ActiveState Corp. All rights reserved. + * + */ + +#ifndef ___BuildInfo__h___ +#define ___BuildInfo__h___ + +#define PRODUCT_BUILD_NUMBER "633" +#define PERLFILEVERSION "5,6,1,633\0" +#define PERLRC_VERSION 5,6,1,633 +#define ACTIVEPERL_CHANGELIST "" +#define PERLPRODUCTVERSION "Build " PRODUCT_BUILD_NUMBER ACTIVEPERL_CHANGELIST "\0" +#define PERLPRODUCTNAME "ActivePerl\0" + +#define PERL_VENDORLIB_NAME "ActiveState" + +#define ACTIVEPERL_VERSION "Built "##__TIME__##" "##__DATE__##"\n" +#define ACTIVEPERL_LOCAL_PATCHES_ENTRY "ActivePerl Build " PRODUCT_BUILD_NUMBER ACTIVEPERL_CHANGELIST +#define BINARY_BUILD_NOTICE printf("\n\ +Binary build " PRODUCT_BUILD_NUMBER ACTIVEPERL_CHANGELIST " provided by ActiveState Corp. http://www.ActiveState.com\n\ +" ACTIVEPERL_VERSION "\n"); + +#endif /* ___BuildInfo__h___ */ diff -ruN perl-5.6.1/Configure AP633_source/Configure --- perl-5.6.1/Configure Sun Mar 18 19:03:33 2001 +++ AP633_source/Configure Mon Jun 17 21:27:58 2002 @@ -464,6 +464,7 @@ d_portable='' d_old_pthread_create_joinable='' old_pthread_create_joinable='' +d_pthread_atfork='' d_pthread_yield='' d_sched_yield='' sched_yield='' @@ -6357,7 +6358,7 @@ fi ;; $undef) dflt='none' ;; -*) dflt="$inc_version_list" ;; +*) dflt=`echo $inc_version_list|sed 's,$archname,'$archname',g'` ;; esac case "$dflt" in ''|' ') dflt=none ;; @@ -7947,24 +7948,29 @@ eval $inlibc : Look for GNU-cc style attribute checking -echo " " -echo "Checking whether your compiler can handle __attribute__ ..." >&4 -$cat >attrib.c <<'EOCP' +case "$d_attribut" in +'') + echo " " + echo "Checking whether your compiler can handle __attribute__ ..." >&4 + $cat >attrib.c <<'EOCP' #include void croak (char* pat,...) __attribute__((format(printf,1,2),noreturn)); EOCP -if $cc $ccflags -c attrib.c >attrib.out 2>&1 ; then - if $contains 'warning' attrib.out >/dev/null 2>&1; then - echo "Your C compiler doesn't fully support __attribute__." - val="$undef" + if $cc $ccflags -c attrib.c >attrib.out 2>&1 ; then + if $contains 'warning' attrib.out >/dev/null 2>&1; then + echo "Your C compiler doesn't fully support __attribute__." + val="$undef" + else + echo "Your C compiler supports __attribute__." + val="$define" + fi else - echo "Your C compiler supports __attribute__." - val="$define" + echo "Your C compiler doesn't seem to understand __attribute__ at all." + val="$undef" fi -else - echo "Your C compiler doesn't seem to understand __attribute__ at all." - val="$undef" -fi + ;; +*) val="$d_attribut" ;; +esac set d_attribut eval $setvar $rm -f attrib* @@ -10609,6 +10615,10 @@ set poll d_poll eval $inlibc +: see if pthread_atfork exists +set pthread_atfork d_pthread_atfork +eval $inlibc + : see whether the various POSIXish _yields exist $cat >try.c <= 0 && AvARRAY(av)[key] == &PL_sv_undef); diff -ruN perl-5.6.1/config_h.SH AP633_source/config_h.SH --- perl-5.6.1/config_h.SH Sat Mar 3 11:53:20 2001 +++ AP633_source/config_h.SH Mon Jun 17 21:27:59 2002 @@ -3234,5 +3234,11 @@ */ #$d_sbrkproto HAS_SBRK_PROTO /**/ +/* HAS_PTHREAD_ATFORK: + * This symbol, if defined, indicates that the pthread_atfork routine + * is available setup fork handlers. + */ +#$d_pthread_atfork HAS_PTHREAD_ATFORK /**/ + #endif !GROK!THIS! diff -ruN perl-5.6.1/configure.com AP633_source/configure.com --- perl-5.6.1/configure.com Sat Mar 3 11:53:20 2001 +++ AP633_source/configure.com Mon Jun 17 21:27:59 2002 @@ -4959,6 +4959,7 @@ $ WC "d_phostname='" + d_phostname + "'" $ WC "d_pipe='define'" $ WC "d_poll='undef'" +$ WC "d_pthread_atfork='undef'" $ WC "d_pthread_yield='" + d_pthread_yield + "'" $ WC "d_pthreads_created_joinable='" + d_pthreads_created_joinable + "'" $ WC "d_pwage='undef'" diff -ruN perl-5.6.1/cop.h AP633_source/cop.h --- perl-5.6.1/cop.h Wed Mar 21 21:05:02 2001 +++ AP633_source/cop.h Mon Jun 17 21:27:59 2002 @@ -85,7 +85,7 @@ #define PUSHSUB(cx) \ cx->blk_sub.cv = cv; \ - cx->blk_sub.olddepth = CvDEPTH(cv); \ + cx->blk_sub.olddepth = (U16)CvDEPTH(cv); \ cx->blk_sub.hasargs = hasargs; \ cx->blk_sub.lval = PL_op->op_private & \ (OPpLVAL_INTRO|OPpENTERSUB_INARGS); @@ -155,6 +155,7 @@ SV * old_namesv; OP * old_eval_root; SV * cur_text; + CV * cv; }; #define PUSHEVAL(cx,n,fgv) \ @@ -164,6 +165,7 @@ cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : Nullsv); \ cx->blk_eval.old_eval_root = PL_eval_root; \ cx->blk_eval.cur_text = PL_linestr; \ + cx->blk_eval.cv = Nullcv; /* set by doeval(), as applicable */ \ } STMT_END #define POPEVAL(cx) \ @@ -270,7 +272,7 @@ cx->blk_oldscopesp = PL_scopestack_ix, \ cx->blk_oldretsp = PL_retstack_ix, \ cx->blk_oldpm = PL_curpm, \ - cx->blk_gimme = gimme; \ + cx->blk_gimme = (U8)gimme; \ DEBUG_l( PerlIO_printf(Perl_debug_log, "Entering block %ld, type %s\n", \ (long)cxstack_ix, PL_block_type[CxTYPE(cx)]); ) diff -ruN perl-5.6.1/doio.c AP633_source/doio.c --- perl-5.6.1/doio.c Wed Mar 21 21:05:02 2001 +++ AP633_source/doio.c Mon Jun 17 21:27:59 2002 @@ -51,6 +51,61 @@ #include #endif +#if defined(USE_ITHREADS) +STATIC void +S_invalidate_fileno(pTHX_ PerlIO *f) +{ + int fd = PerlIO_fileno(f); + PerlIO_flush(f); +# if defined(USE_SFIO) +# error "dont know how to set FILE.fileno under sfio" +# endif + /* XXX this could use PerlIO_canset_fileno() and + * PerlIO_set_fileno() support from Configure */ +# if defined(__GLIBC__) + ((FILE*)f)->_fileno = -1; +# elif defined(__sun__) + /* _file is just a char :-( */ + ((FILE*)f)->_file = PerlLIO_dup(fd); +# elif defined(__hpux) + ((FILE*)f)->__fileH = 0xff; + ((FILE*)f)->__fileL = 0xff; +# elif defined(__FreeBSD__) + ((FILE*)f)->_file = -1; +# elif defined(WIN32) +# if defined(__BORLANDC__) + ((FILE*)f)->fd = PerlLIO_dup(fd); +# else + ((FILE*)f)->_file = -1; +# endif +# else +# error "dont know how to set FILE.fileno on your platform" +# endif +} +#endif + +STATIC int +S_io_sock_close(pTHX_ IO *io) +{ + int result; + +#if defined(USE_ITHREADS) + /* Avoid race condition: without this, the second fclose() will + * attempt to close() the same fd, and that fd could have been + * allocated by another thread between the two fclose() calls. + * It is potentially better to keep the two fds separate by making + * one a dup() of the other, but doing so muddies the perl-level + * semantics more than this hack. What should fileno(SOCK) return + * in that case? How about fcntl(SOCK,...)? Etc. */ + if (PerlIO_fileno(IoIFP(io)) == PerlIO_fileno(IoOFP(io))) + invalidate_fileno(IoIFP(io)); +#endif + result = PerlIO_close(IoOFP(io)); + PerlIO_close(IoIFP(io)); /* clear stdio, fd already closed */ + + return result; +} + bool Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp) @@ -99,10 +154,8 @@ else if (IoTYPE(io) == IoTYPE_PIPE) result = PerlProc_pclose(IoIFP(io)); else if (IoIFP(io) != IoOFP(io)) { - if (IoOFP(io)) { - result = PerlIO_close(IoOFP(io)); - PerlIO_close(IoIFP(io)); /* clear stdio, fd already closed */ - } + if (IoOFP(io)) + result = io_sock_close(io); else result = PerlIO_close(IoIFP(io)); } @@ -457,38 +510,67 @@ fd = PerlIO_fileno(saveifp); if (saveofp) { PerlIO_flush(saveofp); /* emulate PerlIO_close() */ - if (saveofp != saveifp) { /* was a socket? */ + if (saveofp != saveifp) { /* was a socket? */ +#if defined(USE_ITHREADS) + if (fd == PerlIO_fileno(saveofp)) + invalidate_fileno(saveofp); +#endif PerlIO_close(saveofp); - if (fd > 2) - Safefree(saveofp); } } if (fd != PerlIO_fileno(fp)) { - Pid_t pid; - SV *sv; - PerlLIO_dup2(PerlIO_fileno(fp), fd); #ifdef VMS if (fd != PerlIO_fileno(PerlIO_stdin())) { - char newname[FILENAME_MAX+1]; - if (fgetname(fp, newname)) { - if (fd == PerlIO_fileno(PerlIO_stdout())) Perl_vmssetuserlnm("SYS$OUTPUT", newname); - if (fd == PerlIO_fileno(PerlIO_stderr())) Perl_vmssetuserlnm("SYS$ERROR", newname); - } - } -#endif - LOCK_FDPID_MUTEX; - sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE); - (void)SvUPGRADE(sv, SVt_IV); - pid = SvIVX(sv); - SvIVX(sv) = 0; - sv = *av_fetch(PL_fdpid,fd,TRUE); - UNLOCK_FDPID_MUTEX; - (void)SvUPGRADE(sv, SVt_IV); - SvIVX(sv) = pid; - if (!was_fdopen) - PerlIO_close(fp); + char newname[FILENAME_MAX+1]; + if (fgetname(fp, newname)) { + if (fd == PerlIO_fileno(PerlIO_stdout())) + Perl_vmssetuserlnm("SYS$OUTPUT", newname); + if (fd == PerlIO_fileno(PerlIO_stderr())) + Perl_vmssetuserlnm("SYS$ERROR", newname); + } + } +#endif + +#if !defined(WIN32) + /* PL_fdpid isn't used on Windows, so avoid this useless work. + * XXX Probably the same for a lot of other places. */ + { + Pid_t pid; + SV *sv; + + LOCK_FDPID_MUTEX; + sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE); + (void)SvUPGRADE(sv, SVt_IV); + pid = SvIVX(sv); + SvIVX(sv) = 0; + sv = *av_fetch(PL_fdpid,fd,TRUE); + (void)SvUPGRADE(sv, SVt_IV); + SvIVX(sv) = pid; + UNLOCK_FDPID_MUTEX; + } +#endif + if (was_fdopen) { + /* need to close fp without closing underlying fd */ +#if defined(USE_THREADS) + /* we do do this only in the non-ithreads case because of + * the platform-specific nature of invalidate_fileno() */ + invalidate_fileno(fp); + PerlIO_close(fp); +#else + int ofd = PerlIO_fileno(fp); + int dupfd = PerlLIO_dup(ofd); + PerlIO_close(fp); + /* there is a race condition here that makes this code + * thread-unsafe. ofd could have been allocated by + * another thread at this point. */ + PerlLIO_dup2(dupfd,ofd); + PerlLIO_close(dupfd); +#endif + } + else + PerlIO_close(fp); } fp = saveifp; PerlIO_clearerr(fp); @@ -770,6 +852,7 @@ goto badexit; IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"); IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"); + IoOFP(rstio) = IoIFP(rstio); IoIFP(wstio) = IoOFP(wstio); IoTYPE(rstio) = IoTYPE_RDONLY; IoTYPE(wstio) = IoTYPE_WRONLY; @@ -843,10 +926,8 @@ else if (IoTYPE(io) == IoTYPE_STD) retval = TRUE; else { - if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { /* a socket */ - retval = (PerlIO_close(IoOFP(io)) != EOF); - PerlIO_close(IoIFP(io)); /* clear stdio, fd already closed */ - } + if (IoOFP(io) && IoOFP(io) != IoIFP(io)) /* a socket */ + retval = (io_sock_close(io) != EOF); else retval = (PerlIO_close(IoIFP(io)) != EOF); } @@ -1384,7 +1465,7 @@ while (*t && isSPACE(*t)) ++t; - if (!*t && (dup2(1,2) != -1)) { + if (!*t && (PerlLIO_dup2(1,2) != -1)) { s[-2] = '\0'; break; } diff -ruN perl-5.6.1/doop.c AP633_source/doop.c --- perl-5.6.1/doop.c Thu Apr 5 21:38:46 2001 +++ AP633_source/doop.c Mon Jun 17 21:27:59 2002 @@ -44,7 +44,7 @@ while (s < send) { if ((ch = tbl[*s]) >= 0) { matches++; - *s++ = ch; + *s++ = (U8)ch; } else s++; @@ -68,7 +68,7 @@ if (c < 0x100 && (ch = tbl[c]) >= 0) { matches++; if (UTF8_IS_ASCII(ch)) - *d++ = ch; + *d++ = (U8)ch; else d = uv_to_utf8(d,ch); s += ulen; @@ -154,7 +154,7 @@ U8* p = send; while (s < send) { if ((ch = tbl[*s]) >= 0) { - *d = ch; + *d = (U8)ch; matches++; if (p != d - 1 || *p != *d) p = d++; @@ -170,7 +170,7 @@ while (s < send) { if ((ch = tbl[*s]) >= 0) { matches++; - *d++ = ch; + *d++ = (U8)ch; } else if (ch == -1) /* -1 is unmapped character */ *d++ = *s; @@ -206,9 +206,9 @@ } else if ((ch = tbl[comp]) >= 0) { matches++; - if (ch != pch) { - d = uv_to_utf8(d, ch); - pch = ch; + if ((UV)ch != pch) { + d = uv_to_utf8(d, (UV)ch); + pch = (UV)ch; } s += len; continue; @@ -668,18 +668,18 @@ else { offset >>= 3; /* turn into byte offset */ if (size == 16) { - if (offset >= srclen) + if ((STRLEN)offset >= srclen) retnum = 0; else retnum = (UV) s[offset] << 8; } else if (size == 32) { - if (offset >= srclen) + if ((STRLEN)offset >= srclen) retnum = 0; - else if (offset + 1 >= srclen) + else if ((STRLEN)(offset + 1) >= srclen) retnum = ((UV) s[offset ] << 24); - else if (offset + 2 >= srclen) + else if ((STRLEN)(offset + 2) >= srclen) retnum = ((UV) s[offset ] << 24) + ((UV) s[offset + 1] << 16); @@ -834,30 +834,30 @@ else { offset >>= 3; /* turn into byte offset */ if (size == 8) - s[offset ] = lval & 0xff; + s[offset ] = (U8)( lval & 0xff); else if (size == 16) { - s[offset ] = (lval >> 8) & 0xff; - s[offset+1] = lval & 0xff; + s[offset ] = (U8)((lval >> 8) & 0xff); + s[offset+1] = (U8)( lval & 0xff); } else if (size == 32) { - s[offset ] = (lval >> 24) & 0xff; - s[offset+1] = (lval >> 16) & 0xff; - s[offset+2] = (lval >> 8) & 0xff; - s[offset+3] = lval & 0xff; + s[offset ] = (U8)((lval >> 24) & 0xff); + s[offset+1] = (U8)((lval >> 16) & 0xff); + s[offset+2] = (U8)((lval >> 8) & 0xff); + s[offset+3] = (U8)( lval & 0xff); } #ifdef UV_IS_QUAD else if (size == 64) { if (ckWARN(WARN_PORTABLE)) Perl_warner(aTHX_ WARN_PORTABLE, "Bit vector size > 32 non-portable"); - s[offset ] = (lval >> 56) & 0xff; - s[offset+1] = (lval >> 48) & 0xff; - s[offset+2] = (lval >> 40) & 0xff; - s[offset+3] = (lval >> 32) & 0xff; - s[offset+4] = (lval >> 24) & 0xff; - s[offset+5] = (lval >> 16) & 0xff; - s[offset+6] = (lval >> 8) & 0xff; - s[offset+7] = lval & 0xff; + s[offset ] = (U8)((lval >> 56) & 0xff); + s[offset+1] = (U8)((lval >> 48) & 0xff); + s[offset+2] = (U8)((lval >> 40) & 0xff); + s[offset+3] = (U8)((lval >> 32) & 0xff); + s[offset+4] = (U8)((lval >> 24) & 0xff); + s[offset+5] = (U8)((lval >> 16) & 0xff); + s[offset+6] = (U8)((lval >> 8) & 0xff); + s[offset+7] = (U8)( lval & 0xff); } #endif } @@ -932,6 +932,7 @@ { register I32 count; STRLEN len; + STRLEN n_a; char *s; if (RsSNARF(PL_rs)) @@ -963,8 +964,6 @@ else if (SvREADONLY(sv)) Perl_croak(aTHX_ PL_no_modify); s = SvPV(sv, len); - if (len && !SvPOKp(sv)) - s = SvPV_force(sv, len); if (s && len) { s += --len; if (RsPARA(PL_rs)) { @@ -995,12 +994,13 @@ count += rslen; } } - *s = '\0'; + s = SvPV_force(sv, n_a); SvCUR_set(sv, len); + *SvEND(sv) = '\0'; SvNIOK_off(sv); + SvSETMAGIC(sv); } nope: - SvSETMAGIC(sv); return count; } @@ -1043,8 +1043,8 @@ else if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) { STRLEN n_a; dc = SvPV_force(sv, n_a); - if (SvCUR(sv) < len) { - dc = SvGROW(sv, len + 1); + if (SvCUR(sv) < (STRLEN)len) { + dc = SvGROW(sv, (STRLEN)(len + 1)); (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1); } if (optype != OP_BIT_AND && (left_utf || right_utf)) @@ -1182,9 +1182,9 @@ *dc++ = *lc++ | *rc++; mop_up: len = lensave; - if (rightlen > len) + if (rightlen > (STRLEN)len) sv_catpvn(sv, rsave + len, rightlen - len); - else if (leftlen > len) + else if (leftlen > (STRLEN)len) sv_catpvn(sv, lsave + len, leftlen - len); else *SvEND(sv) = '\0'; diff -ruN perl-5.6.1/dump.c AP633_source/dump.c --- perl-5.6.1/dump.c Wed Mar 21 21:05:02 2001 +++ AP633_source/dump.c Mon Jun 17 21:27:59 2002 @@ -1016,7 +1016,7 @@ PerlIO_printf(file, " ("); Zero(freq, FREQ_MAX + 1, int); - for (i = 0; i <= HvMAX(sv); i++) { + for (i = 0; (STRLEN)i <= HvMAX(sv); i++) { HE* h; int count = 0; for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h)) count++; diff -ruN perl-5.6.1/embed.h AP633_source/embed.h --- perl-5.6.1/embed.h Thu Apr 5 21:38:46 2001 +++ AP633_source/embed.h Mon Jun 17 21:27:59 2002 @@ -166,6 +166,11 @@ #define do_close Perl_do_close #define do_eof Perl_do_eof #define do_exec Perl_do_exec +#if defined(WIN32) +#define do_aspawn Perl_do_aspawn +#define do_spawn Perl_do_spawn +#define do_spawn_nowait Perl_do_spawn_nowait +#endif #if !defined(WIN32) #define do_exec3 Perl_do_exec3 #endif @@ -420,6 +425,9 @@ #define my_exit Perl_my_exit #define my_failure_exit Perl_my_failure_exit #define my_fflush_all Perl_my_fflush_all +#define my_fork Perl_my_fork +#define atfork_lock Perl_atfork_lock +#define atfork_unlock Perl_atfork_unlock #define my_lstat Perl_my_lstat #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) #define my_memcmp Perl_my_memcmp @@ -863,6 +871,12 @@ #define avhv_index_sv S_avhv_index_sv #define avhv_index S_avhv_index #endif +#if defined(PERL_IN_DOIO_C) || defined(PERL_DECL_PROT) +#define io_sock_close S_io_sock_close +#if defined(USE_ITHREADS) +#define invalidate_fileno S_invalidate_fileno +#endif +#endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) #define do_trans_simple S_do_trans_simple #define do_trans_count S_do_trans_count @@ -1160,7 +1174,6 @@ #define ck_exit Perl_ck_exit #define ck_ftst Perl_ck_ftst #define ck_fun Perl_ck_fun -#define ck_fun_locale Perl_ck_fun_locale #define ck_glob Perl_ck_glob #define ck_grep Perl_ck_grep #define ck_index Perl_ck_index @@ -1178,7 +1191,6 @@ #define ck_rfun Perl_ck_rfun #define ck_rvconst Perl_ck_rvconst #define ck_sassign Perl_ck_sassign -#define ck_scmp Perl_ck_scmp #define ck_select Perl_ck_select #define ck_shift Perl_ck_shift #define ck_sort Perl_ck_sort @@ -1638,6 +1650,11 @@ #define do_close(a,b) Perl_do_close(aTHX_ a,b) #define do_eof(a) Perl_do_eof(aTHX_ a) #define do_exec(a) Perl_do_exec(aTHX_ a) +#if defined(WIN32) +#define do_aspawn(a,b,c) Perl_do_aspawn(aTHX_ a,b,c) +#define do_spawn(a) Perl_do_spawn(aTHX_ a) +#define do_spawn_nowait(a) Perl_do_spawn_nowait(aTHX_ a) +#endif #if !defined(WIN32) #define do_exec3(a,b,c) Perl_do_exec3(aTHX_ a,b,c) #endif @@ -1889,6 +1906,9 @@ #define my_exit(a) Perl_my_exit(aTHX_ a) #define my_failure_exit() Perl_my_failure_exit(aTHX) #define my_fflush_all() Perl_my_fflush_all(aTHX) +#define my_fork Perl_my_fork +#define atfork_lock Perl_atfork_lock +#define atfork_unlock Perl_atfork_unlock #define my_lstat() Perl_my_lstat(aTHX) #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) #define my_memcmp Perl_my_memcmp @@ -2323,6 +2343,12 @@ #define avhv_index_sv(a) S_avhv_index_sv(aTHX_ a) #define avhv_index(a,b,c) S_avhv_index(aTHX_ a,b,c) #endif +#if defined(PERL_IN_DOIO_C) || defined(PERL_DECL_PROT) +#define io_sock_close(a) S_io_sock_close(aTHX_ a) +#if defined(USE_ITHREADS) +#define invalidate_fileno(a) S_invalidate_fileno(aTHX_ a) +#endif +#endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) #define do_trans_simple(a) S_do_trans_simple(aTHX_ a) #define do_trans_count(a) S_do_trans_count(aTHX_ a) @@ -2619,7 +2645,6 @@ #define ck_exit(a) Perl_ck_exit(aTHX_ a) #define ck_ftst(a) Perl_ck_ftst(aTHX_ a) #define ck_fun(a) Perl_ck_fun(aTHX_ a) -#define ck_fun_locale(a) Perl_ck_fun_locale(aTHX_ a) #define ck_glob(a) Perl_ck_glob(aTHX_ a) #define ck_grep(a) Perl_ck_grep(aTHX_ a) #define ck_index(a) Perl_ck_index(aTHX_ a) @@ -2637,7 +2662,6 @@ #define ck_rfun(a) Perl_ck_rfun(aTHX_ a) #define ck_rvconst(a) Perl_ck_rvconst(aTHX_ a) #define ck_sassign(a) Perl_ck_sassign(aTHX_ a) -#define ck_scmp(a) Perl_ck_scmp(aTHX_ a) #define ck_select(a) Perl_ck_select(aTHX_ a) #define ck_shift(a) Perl_ck_shift(aTHX_ a) #define ck_sort(a) Perl_ck_sort(aTHX_ a) @@ -3004,11 +3028,11 @@ # if defined(PERL_IMPLICIT_SYS) # endif #endif -#if defined(MYMALLOC) #define malloc Perl_malloc #define calloc Perl_calloc #define realloc Perl_realloc #define mfree Perl_mfree +#if defined(MYMALLOC) #define malloced_size Perl_malloced_size #endif #define get_context Perl_get_context @@ -3214,6 +3238,14 @@ #define do_eof Perl_do_eof #define Perl_do_exec CPerlObj::Perl_do_exec #define do_exec Perl_do_exec +#if defined(WIN32) +#define Perl_do_aspawn CPerlObj::Perl_do_aspawn +#define do_aspawn Perl_do_aspawn +#define Perl_do_spawn CPerlObj::Perl_do_spawn +#define do_spawn Perl_do_spawn +#define Perl_do_spawn_nowait CPerlObj::Perl_do_spawn_nowait +#define do_spawn_nowait Perl_do_spawn_nowait +#endif #if !defined(WIN32) #define Perl_do_exec3 CPerlObj::Perl_do_exec3 #define do_exec3 Perl_do_exec3 @@ -3702,6 +3734,12 @@ #define my_failure_exit Perl_my_failure_exit #define Perl_my_fflush_all CPerlObj::Perl_my_fflush_all #define my_fflush_all Perl_my_fflush_all +#define Perl_my_fork CPerlObj::Perl_my_fork +#define my_fork Perl_my_fork +#define Perl_atfork_lock CPerlObj::Perl_atfork_lock +#define atfork_lock Perl_atfork_lock +#define Perl_atfork_unlock CPerlObj::Perl_atfork_unlock +#define atfork_unlock Perl_atfork_unlock #define Perl_my_lstat CPerlObj::Perl_my_lstat #define my_lstat Perl_my_lstat #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) @@ -4548,6 +4586,14 @@ #define S_avhv_index CPerlObj::S_avhv_index #define avhv_index S_avhv_index #endif +#if defined(PERL_IN_DOIO_C) || defined(PERL_DECL_PROT) +#define S_io_sock_close CPerlObj::S_io_sock_close +#define io_sock_close S_io_sock_close +#if defined(USE_ITHREADS) +#define S_invalidate_fileno CPerlObj::S_invalidate_fileno +#define invalidate_fileno S_invalidate_fileno +#endif +#endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) #define S_do_trans_simple CPerlObj::S_do_trans_simple #define do_trans_simple S_do_trans_simple @@ -5082,8 +5128,6 @@ #define ck_ftst Perl_ck_ftst #define Perl_ck_fun CPerlObj::Perl_ck_fun #define ck_fun Perl_ck_fun -#define Perl_ck_fun_locale CPerlObj::Perl_ck_fun_locale -#define ck_fun_locale Perl_ck_fun_locale #define Perl_ck_glob CPerlObj::Perl_ck_glob #define ck_glob Perl_ck_glob #define Perl_ck_grep CPerlObj::Perl_ck_grep @@ -5118,8 +5162,6 @@ #define ck_rvconst Perl_ck_rvconst #define Perl_ck_sassign CPerlObj::Perl_ck_sassign #define ck_sassign Perl_ck_sassign -#define Perl_ck_scmp CPerlObj::Perl_ck_scmp -#define ck_scmp Perl_ck_scmp #define Perl_ck_select CPerlObj::Perl_ck_select #define ck_select Perl_ck_select #define Perl_ck_shift CPerlObj::Perl_ck_shift diff -ruN perl-5.6.1/embed.pl AP633_source/embed.pl --- perl-5.6.1/embed.pl Thu Apr 5 21:38:46 2001 +++ AP633_source/embed.pl Mon Jun 17 21:27:59 2002 @@ -1354,11 +1354,11 @@ # endif #endif -#if defined(MYMALLOC) Ajnop |Malloc_t|malloc |MEM_SIZE nbytes Ajnop |Malloc_t|calloc |MEM_SIZE elements|MEM_SIZE size Ajnop |Malloc_t|realloc |Malloc_t where|MEM_SIZE nbytes Ajnop |Free_t |mfree |Malloc_t where +#if defined(MYMALLOC) jnp |MEM_SIZE|malloced_size |void *p #endif @@ -1486,7 +1486,12 @@ p |void |do_chop |SV* asv|SV* sv Ap |bool |do_close |GV* gv|bool not_implicit p |bool |do_eof |GV* gv -p |bool |do_exec |char* cmd +Ap |bool |do_exec |char* cmd +#if defined(WIN32) +Ap |int |do_aspawn |SV* really|SV** mark|SV** sp +Ap |int |do_spawn |char* cmd +Ap |int |do_spawn_nowait|char* cmd +#endif #if !defined(WIN32) p |bool |do_exec3 |char* cmd|int fd|int flag #endif @@ -1751,6 +1756,9 @@ Apr |void |my_exit |U32 status Apr |void |my_failure_exit Ap |I32 |my_fflush_all +Anp |Pid_t |my_fork +Anp |void |atfork_lock +Anp |void |atfork_unlock Ap |I32 |my_lstat #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) Anp |I32 |my_memcmp |const char* s1|const char* s2|I32 len @@ -2230,6 +2238,13 @@ #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) s |I32 |avhv_index_sv |SV* sv s |I32 |avhv_index |AV* av|SV* sv|U32 hash +#endif + +#if defined(PERL_IN_DOIO_C) || defined(PERL_DECL_PROT) +s |int |io_sock_close |IO *io +#if defined(USE_ITHREADS) +s |void |invalidate_fileno|PerlIO *f +#endif #endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) diff -ruN perl-5.6.1/epoc/config.sh AP633_source/epoc/config.sh --- perl-5.6.1/epoc/config.sh Sat Mar 3 11:53:20 2001 +++ AP633_source/epoc/config.sh Mon Jun 17 21:27:59 2002 @@ -255,6 +255,7 @@ d_pipe='undef' d_poll='undef' d_portable='undef' +d_pthread_atfork='undef' d_pthread_yield='undef' d_pwage='undef' d_pwchange='undef' diff -ruN perl-5.6.1/ext/B/B.xs AP633_source/ext/B/B.xs --- perl-5.6.1/ext/B/B.xs Thu Apr 5 21:38:46 2001 +++ AP633_source/ext/B/B.xs Mon Jun 17 21:28:00 2002 @@ -79,9 +79,17 @@ "B::COP" }; -static int walkoptree_debug = 0; /* Flag for walkoptree debug hook */ +#define MY_CXT_KEY "B::_guts" XS_VERSION -static SV *specialsv_list[6]; +typedef struct { + int x_walkoptree_debug; /* Flag for walkoptree debug hook */ + SV * x_specialsv_list[6]; +} my_cxt_t; + +START_MY_CXT + +#define walkoptree_debug (MY_CXT.x_walkoptree_debug) +#define specialsv_list (MY_CXT.x_specialsv_list) static opclass cc_opclass(pTHX_ OP *o) @@ -201,6 +209,7 @@ { char *type = 0; IV iv; + dMY_CXT; for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) { if (sv == specialsv_list[iv]) { @@ -321,7 +330,8 @@ { dSP; OP *o; - + dMY_CXT; + if (!SvROK(opsv)) croak("opsv is not a reference"); opsv = sv_mortalcopy(opsv); @@ -382,6 +392,7 @@ { HV *stash = gv_stashpvn("B", 1, TRUE); AV *export_ok = perl_get_av("B::EXPORT_OK",TRUE); + MY_CXT_INIT; specialsv_list[0] = Nullsv; specialsv_list[1] = &PL_sv_undef; specialsv_list[2] = &PL_sv_yes; @@ -449,6 +460,7 @@ int walkoptree_debug(...) CODE: + dMY_CXT; RETVAL = walkoptree_debug; if (items > 0 && SvTRUE(ST(1))) walkoptree_debug = 1; diff -ruN perl-5.6.1/ext/DB_File/DB_File.pm AP633_source/ext/DB_File/DB_File.pm --- perl-5.6.1/ext/DB_File/DB_File.pm Thu Feb 22 18:57:53 2001 +++ AP633_source/ext/DB_File/DB_File.pm Mon Jun 17 21:28:00 2002 @@ -210,6 +210,7 @@ sub AUTOLOAD { my($constname); ($constname = $AUTOLOAD) =~ s/.*:://; + local $! = 0; my $val = constant($constname, @_ ? $_[0] : 0); if ($! != 0) { if ($! =~ /Invalid/ || $!{EINVAL}) { diff -ruN perl-5.6.1/ext/DB_File/DB_File.xs AP633_source/ext/DB_File/DB_File.xs --- perl-5.6.1/ext/DB_File/DB_File.xs Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/DB_File/DB_File.xs Mon Jun 17 21:28:00 2002 @@ -420,10 +420,21 @@ /* Internal Global Data */ -static recno_t Value ; -static recno_t zero = 0 ; -static DB_File CurrentDB ; -static DBTKEY empty ; +#define MY_CXT_KEY "DB_File::_guts" XS_VERSION + +typedef struct { + recno_t x_Value; + recno_t x_zero; + DB_File x_CurrentDB; + DBTKEY x_empty; +} my_cxt_t; + +START_MY_CXT + +#define Value (MY_CXT.x_Value) +#define zero (MY_CXT.x_zero) +#define CurrentDB (MY_CXT.x_CurrentDB) +#define empty (MY_CXT.x_empty) #ifdef DB_VERSION_MAJOR @@ -517,6 +528,7 @@ dTHX; #endif dSP ; + dMY_CXT; void * data1, * data2 ; int retval ; int count ; @@ -588,6 +600,7 @@ dTHX; #endif dSP ; + dMY_CXT; void * data1, * data2 ; int retval ; int count ; @@ -666,6 +679,7 @@ dTHX; #endif dSP ; + dMY_CXT; int retval ; int count ; @@ -841,6 +855,7 @@ void * openinfo = NULL ; INFO * info = &RETVAL->info ; STRLEN n_a; + dMY_CXT; /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */ Zero(RETVAL, 1, DB_File_type) ; @@ -1114,6 +1129,7 @@ DB * dbp ; STRLEN n_a; int status ; + dMY_CXT; /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */ Zero(RETVAL, 1, DB_File_type) ; @@ -1596,6 +1612,7 @@ BOOT: { + MY_CXT_INIT; __getBerkeleyDBInfo() ; DBT_clear(empty) ; @@ -1637,6 +1654,8 @@ int db_DESTROY(db) DB_File db + PREINIT: + dMY_CXT; INIT: CurrentDB = db ; CLEANUP: @@ -1668,6 +1687,8 @@ DB_File db DBTKEY key u_int flags + PREINIT: + dMY_CXT; INIT: CurrentDB = db ; @@ -1676,6 +1697,8 @@ db_EXISTS(db, key) DB_File db DBTKEY key + PREINIT: + dMY_CXT; CODE: { DBT value ; @@ -1692,6 +1715,8 @@ DB_File db DBTKEY key u_int flags + PREINIT: + dMY_CXT; CODE: { DBT value ; @@ -1710,6 +1735,8 @@ DBTKEY key DBT value u_int flags + PREINIT: + dMY_CXT; INIT: CurrentDB = db ; @@ -1717,6 +1744,8 @@ int db_FIRSTKEY(db) DB_File db + PREINIT: + dMY_CXT; CODE: { DBTKEY key ; @@ -1734,6 +1763,8 @@ db_NEXTKEY(db, key) DB_File db DBTKEY key + PREINIT: + dMY_CXT; CODE: { DBT value ; @@ -1753,6 +1784,8 @@ unshift(db, ...) DB_File db ALIAS: UNSHIFT = 1 + PREINIT: + dMY_CXT; CODE: { DBTKEY key ; @@ -1794,6 +1827,8 @@ I32 pop(db) DB_File db + PREINIT: + dMY_CXT; ALIAS: POP = 1 CODE: { @@ -1821,6 +1856,8 @@ I32 shift(db) DB_File db + PREINIT: + dMY_CXT; ALIAS: SHIFT = 1 CODE: { @@ -1848,6 +1885,8 @@ I32 push(db, ...) DB_File db + PREINIT: + dMY_CXT; ALIAS: PUSH = 1 CODE: { @@ -1890,6 +1929,8 @@ I32 length(db) DB_File db + PREINIT: + dMY_CXT; ALIAS: FETCHSIZE = 1 CODE: CurrentDB = db ; @@ -1907,6 +1948,8 @@ DB_File db DBTKEY key u_int flags + PREINIT: + dMY_CXT; CODE: CurrentDB = db ; RETVAL = db_del(db, key, flags) ; @@ -1926,6 +1969,8 @@ DBTKEY key DBT value = NO_INIT u_int flags + PREINIT: + dMY_CXT; CODE: CurrentDB = db ; DBT_clear(value) ; @@ -1946,6 +1991,8 @@ DBTKEY key DBT value u_int flags + PREINIT: + dMY_CXT; CODE: CurrentDB = db ; RETVAL = db_put(db, key, value, flags) ; @@ -1963,6 +2010,8 @@ db_fd(db) DB_File db int status = 0 ; + PREINIT: + dMY_CXT; CODE: CurrentDB = db ; #ifdef DB_VERSION_MAJOR @@ -1984,6 +2033,8 @@ db_sync(db, flags=0) DB_File db u_int flags + PREINIT: + dMY_CXT; CODE: CurrentDB = db ; RETVAL = db_sync(db, flags) ; @@ -2001,6 +2052,8 @@ DBTKEY key DBT value = NO_INIT u_int flags + PREINIT: + dMY_CXT; CODE: CurrentDB = db ; DBT_clear(value) ; diff -ruN perl-5.6.1/ext/Devel/Peek/Peek.xs AP633_source/ext/Devel/Peek/Peek.xs --- perl-5.6.1/ext/Devel/Peek/Peek.xs Thu Apr 5 21:38:46 2001 +++ AP633_source/ext/Devel/Peek/Peek.xs Mon Jun 17 21:28:00 2002 @@ -332,7 +332,8 @@ SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", FALSE); I32 save_dumpindent = PL_dumpindent; PL_dumpindent = 2; - do_sv_dump(0, Perl_debug_log, sv, 0, lim, dumpop && SvTRUE(dumpop), pv_lim); + do_sv_dump(0, Perl_debug_log, sv, 0, lim, + (bool)(dumpop && SvTRUE(dumpop)), pv_lim); PL_dumpindent = save_dumpindent; } @@ -350,7 +351,8 @@ for (i=1; inext) + for (mp = dl_modList; mp; mp = mp->next) if (strcmp(mp->name, path) == 0) { mp->refCnt++; return mp; } Newz(1000,mp,1,Module); if (mp == NULL) { - errvalid++; - strcpy(errbuf, "Newz: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "Newz: "); + strerrorcat(dl_errbuf, errno); return NULL; } if ((mp->name = savepv(path)) == NULL) { - errvalid++; - strcpy(errbuf, "savepv: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "savepv: "); + strerrorcat(dl_errbuf, errno); safefree(mp); return NULL; } @@ -248,10 +260,10 @@ safefree(mp->name); safefree(mp); - errvalid++; - strcpy(errbuf, "dlopen: "); - strcat(errbuf, path); - strcat(errbuf, ": "); + dl_errvalid++; + strcpy(dl_errbuf, "dlopen: "); + strcat(dl_errbuf, path); + strcat(dl_errbuf, ": "); /* * If AIX says the file is not executable, the error * can be further described by querying the loader about @@ -260,19 +272,19 @@ if (saverrno == ENOEXEC) { char *moreinfo[BUFSIZ/sizeof(char *)]; if (loadquery(L_GETMESSAGES, moreinfo, sizeof(moreinfo)) == -1) - strerrorcpy(errbuf, saverrno); + strerrorcpy(dl_errbuf, saverrno); else { char **p; for (p = moreinfo; *p; p++) caterr(*p); } } else - strerrorcat(errbuf, saverrno); + strerrorcat(dl_errbuf, saverrno); return NULL; } mp->refCnt = 1; - mp->next = modList; - modList = mp; + mp->next = dl_modList; + dl_modList = mp; /* * Assume anonymous exports come from the module this dlopen * is linked into, that holds true as long as dlopen and all @@ -282,13 +294,13 @@ * also reference Apache symbols. */ if (loadbind(0, (void *)dlopen, mp->entry) == -1 || - loadbind(0, mainModule, mp->entry)) { + loadbind(0, dl_mainModule, mp->entry)) { int saverrno = errno; dlclose(mp); - errvalid++; - strcpy(errbuf, "loadbind: "); - strerrorcat(errbuf, saverrno); + dl_errvalid++; + strcpy(dl_errbuf, "loadbind: "); + strerrorcat(dl_errbuf, saverrno); return NULL; } if (readExports(mp) == -1) { @@ -304,41 +316,45 @@ */ static void caterr(char *s) { + dTHX; + dMY_CXT; register char *p = s; while (*p >= '0' && *p <= '9') p++; switch(atoi(s)) { case L_ERROR_TOOMANY: - strcat(errbuf, "too many errors"); + strcat(dl_errbuf, "too many errors"); break; case L_ERROR_NOLIB: - strcat(errbuf, "can't load library"); - strcat(errbuf, p); + strcat(dl_errbuf, "can't load library"); + strcat(dl_errbuf, p); break; case L_ERROR_UNDEF: - strcat(errbuf, "can't find symbol"); - strcat(errbuf, p); + strcat(dl_errbuf, "can't find symbol"); + strcat(dl_errbuf, p); break; case L_ERROR_RLDBAD: - strcat(errbuf, "bad RLD"); - strcat(errbuf, p); + strcat(dl_errbuf, "bad RLD"); + strcat(dl_errbuf, p); break; case L_ERROR_FORMAT: - strcat(errbuf, "bad exec format in"); - strcat(errbuf, p); + strcat(dl_errbuf, "bad exec format in"); + strcat(dl_errbuf, p); break; case L_ERROR_ERRNO: - strerrorcat(errbuf, atoi(++p)); + strerrorcat(dl_errbuf, atoi(++p)); break; default: - strcat(errbuf, s); + strcat(dl_errbuf, s); break; } } void *dlsym(void *handle, const char *symbol) { + dTHX; + dMY_CXT; register ModulePtr mp = (ModulePtr)handle; register ExportPtr ep; register int i; @@ -350,23 +366,27 @@ for (ep = mp->exports, i = mp->nExports; i; i--, ep++) if (strcmp(ep->name, symbol) == 0) return ep->addr; - errvalid++; - strcpy(errbuf, "dlsym: undefined symbol "); - strcat(errbuf, symbol); + dl_errvalid++; + strcpy(dl_errbuf, "dlsym: undefined symbol "); + strcat(dl_errbuf, symbol); return NULL; } char *dlerror(void) { - if (errvalid) { - errvalid = 0; - return errbuf; + dTHX; + dMY_CXT; + if (dl_errvalid) { + dl_errvalid = 0; + return dl_errbuf; } return NULL; } int dlclose(void *handle) { + dTHX; + dMY_CXT; register ModulePtr mp = (ModulePtr)handle; int result; register ModulePtr mp1; @@ -375,8 +395,8 @@ return 0; result = UNLOAD(mp->entry); if (result == -1) { - errvalid++; - strerrorcpy(errbuf, errno); + dl_errvalid++; + strerrorcpy(dl_errbuf, errno); } if (mp->exports) { register ExportPtr ep; @@ -386,10 +406,10 @@ safefree(ep->name); safefree(mp->exports); } - if (mp == modList) - modList = mp->next; + if (mp == dl_modList) + dl_modList = mp->next; else { - for (mp1 = modList; mp1; mp1 = mp1->next) + for (mp1 = dl_modList; mp1; mp1 = mp1->next) if (mp1->next == mp) { mp1->next = mp->next; break; @@ -421,6 +441,7 @@ static int readExports(ModulePtr mp) { dTHX; + dMY_CXT; LDFILE *ldp = NULL; AIX_SCNHDR sh; AIX_LDHDR *lhp; @@ -434,9 +455,9 @@ char *buf; int size = 4*1024; if (errno != ENOENT) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: "); + strerrorcat(dl_errbuf, errno); return -1; } /* @@ -445,25 +466,25 @@ * module using L_GETINFO. */ if ((buf = safemalloc(size)) == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: "); + strerrorcat(dl_errbuf, errno); return -1; } while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) { safefree(buf); size += 4*1024; if ((buf = safemalloc(size)) == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: "); + strerrorcat(dl_errbuf, errno); return -1; } } if (i == -1) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: "); + strerrorcat(dl_errbuf, errno); safefree(buf); return -1; } @@ -485,9 +506,9 @@ } safefree(buf); if (!ldp) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: "); + strerrorcat(dl_errbuf, errno); return -1; } } @@ -496,15 +517,15 @@ #else if (TYPE(ldp) != U802TOCMAGIC) { #endif - errvalid++; - strcpy(errbuf, "readExports: bad magic"); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: bad magic"); while(ldclose(ldp) == FAILURE) ; return -1; } if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) { - errvalid++; - strcpy(errbuf, "readExports: cannot read loader section header"); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: cannot read loader section header"); while(ldclose(ldp) == FAILURE) ; return -1; @@ -514,16 +535,16 @@ * finding long symbol names residing in the string table easier. */ if ((ldbuf = (char *)safemalloc(sh.s_size)) == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: "); + strerrorcat(dl_errbuf, errno); while(ldclose(ldp) == FAILURE) ; return -1; } if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) { - errvalid++; - strcpy(errbuf, "readExports: cannot seek to loader section"); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: cannot seek to loader section"); safefree(ldbuf); while(ldclose(ldp) == FAILURE) ; @@ -532,8 +553,8 @@ /* This first case is a hack, since it assumes that the 3rd parameter to FREAD is 1. See the redefinition of FREAD above to see how this works. */ if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) { - errvalid++; - strcpy(errbuf, "readExports: cannot read loader section"); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: cannot read loader section"); safefree(ldbuf); while(ldclose(ldp) == FAILURE) ; @@ -551,9 +572,9 @@ } Newz(1001, mp->exports, mp->nExports, Export); if (mp->exports == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "readExports: "); + strerrorcat(dl_errbuf, errno); safefree(ldbuf); while(ldclose(ldp) == FAILURE) ; @@ -593,6 +614,8 @@ */ static void * findMain(void) { + dTHX; + dMY_CXT; struct ld_info *lp; char *buf; int size = 4*1024; @@ -600,25 +623,25 @@ void *ret; if ((buf = safemalloc(size)) == NULL) { - errvalid++; - strcpy(errbuf, "findMain: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "findMain: "); + strerrorcat(dl_errbuf, errno); return NULL; } while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) { safefree(buf); size += 4*1024; if ((buf = safemalloc(size)) == NULL) { - errvalid++; - strcpy(errbuf, "findMain: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "findMain: "); + strerrorcat(dl_errbuf, errno); return NULL; } } if (i == -1) { - errvalid++; - strcpy(errbuf, "findMain: "); - strerrorcat(errbuf, errno); + dl_errvalid++; + strcpy(dl_errbuf, "findMain: "); + strerrorcat(dl_errbuf, errno); safefree(buf); return NULL; } @@ -654,9 +677,6 @@ */ -#include "dlutils.c" /* SaveError() etc */ - - static void dl_private_init(pTHX) { @@ -737,7 +757,8 @@ char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff -ruN perl-5.6.1/ext/DynaLoader/dl_beos.xs AP633_source/ext/DynaLoader/dl_beos.xs --- perl-5.6.1/ext/DynaLoader/dl_beos.xs Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/DynaLoader/dl_beos.xs Mon Jun 17 21:28:00 2002 @@ -110,7 +110,8 @@ char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff -ruN perl-5.6.1/ext/DynaLoader/dl_dld.xs AP633_source/ext/DynaLoader/dl_dld.xs --- perl-5.6.1/ext/DynaLoader/dl_dld.xs Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/DynaLoader/dl_dld.xs Mon Jun 17 21:28:00 2002 @@ -42,31 +42,41 @@ #include /* GNU DLD header file */ #include +typedef struct { + AV * x_resolve_using; + AV * x_require_symbols; +} my_cxtx_t; /* this *must* be named my_cxtx_t */ + +#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ #include "dlutils.c" /* for SaveError() etc */ -static AV *dl_resolve_using = Nullav; -static AV *dl_require_symbols = Nullav; +#define dl_resolve_using (dl_cxtx.x_resolve_using) +#define dl_require_symbols (dl_cxtx.x_require_symbols) static void dl_private_init(pTHX) { - int dlderr; dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); - dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI); + { + int dlderr; + dMY_CXT; + + dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); + dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI); #ifdef __linux__ - dlderr = dld_init("/proc/self/exe"); - if (dlderr) { + dlderr = dld_init("/proc/self/exe"); + if (dlderr) { #endif - dlderr = dld_init(dld_find_executable(PL_origargv[0])); - if (dlderr) { - char *msg = dld_strerror(dlderr); - SaveError(aTHX_ "dld_init(%s) failed: %s", PL_origargv[0], msg); - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", LastError)); - } + dlderr = dld_init(dld_find_executable(PL_origargv[0])); + if (dlderr) { + char *msg = dld_strerror(dlderr); + SaveError(aTHX_ "dld_init(%s) failed: %s", PL_origargv[0], msg); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", dl_last_error)); + } #ifdef __linux__ - } + } #endif + } } @@ -83,6 +93,7 @@ PREINIT: int dlderr,x,max; GV *gv; + dMY_CXT; CODE: RETVAL = filename; DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); @@ -170,7 +181,8 @@ char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff -ruN perl-5.6.1/ext/DynaLoader/dl_dllload.xs AP633_source/ext/DynaLoader/dl_dllload.xs --- perl-5.6.1/ext/DynaLoader/dl_dllload.xs Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/DynaLoader/dl_dllload.xs Mon Jun 17 21:28:00 2002 @@ -182,7 +182,8 @@ char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff -ruN perl-5.6.1/ext/DynaLoader/dl_dlopen.xs AP633_source/ext/DynaLoader/dl_dlopen.xs --- perl-5.6.1/ext/DynaLoader/dl_dlopen.xs Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/DynaLoader/dl_dlopen.xs Mon Jun 17 21:28:00 2002 @@ -174,8 +174,11 @@ } #endif #ifdef RTLD_NOW - if (dl_nonlazy) - mode = RTLD_NOW; + { + dMY_CXT; + if (dl_nonlazy) + mode = RTLD_NOW; + } #endif if (flags & 0x01) #ifdef RTLD_GLOBAL @@ -252,7 +255,8 @@ char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff -ruN perl-5.6.1/ext/DynaLoader/dl_dyld.xs AP633_source/ext/DynaLoader/dl_dyld.xs --- perl-5.6.1/ext/DynaLoader/dl_dyld.xs Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/DynaLoader/dl_dyld.xs Mon Jun 17 21:28:00 2002 @@ -41,19 +41,16 @@ #include "perl.h" #include "XSUB.h" -#define DL_LOADONCEONLY - -#include "dlutils.c" /* SaveError() etc */ +#include "dlutils.c" /* for SaveError() etc */ #undef environ #undef bool #import -static char * dl_last_error = (char *) 0; -static AV *dl_resolve_using = Nullav; - static char *dlerror() { + dTHX; + dMY_CXT; return dl_last_error; } @@ -72,6 +69,7 @@ (const char *path, enum dyldErrorSource type, int number) { dTHX; + dMY_CXT; char *error; unsigned int index; static char *OFIErrorStrings[] = @@ -147,7 +145,6 @@ dl_private_init(pTHX) { (void)dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); } MODULE = DynaLoader PACKAGE = DynaLoader @@ -219,7 +216,8 @@ char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff -ruN perl-5.6.1/ext/DynaLoader/dl_hpux.xs AP633_source/ext/DynaLoader/dl_hpux.xs --- perl-5.6.1/ext/DynaLoader/dl_hpux.xs Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/DynaLoader/dl_hpux.xs Mon Jun 17 21:28:00 2002 @@ -26,17 +26,23 @@ #include "perl.h" #include "XSUB.h" +typedef struct { + AV * x_resolve_using; +} my_cxtx_t; /* this *must* be named my_cxtx_t */ +#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ #include "dlutils.c" /* for SaveError() etc */ -static AV *dl_resolve_using = Nullav; - +#define dl_resolve_using (dl_cxtx.x_resolve_using) static void dl_private_init(pTHX) { (void)dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); + { + dMY_CXT; + dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); + } } MODULE = DynaLoader PACKAGE = DynaLoader @@ -52,6 +58,7 @@ PREINIT: shl_t obj = NULL; int i, max, bind_type; + dMY_CXT; CODE: DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); if (flags & 0x01) @@ -152,7 +159,8 @@ char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff -ruN perl-5.6.1/ext/DynaLoader/dl_mac.xs AP633_source/ext/DynaLoader/dl_mac.xs --- perl-5.6.1/ext/DynaLoader/dl_mac.xs Sun Mar 18 19:03:34 2001 +++ AP633_source/ext/DynaLoader/dl_mac.xs Mon Jun 17 21:28:00 2002 @@ -23,21 +23,27 @@ #include +typedef CFragConnectionID ConnectionID; -#include "dlutils.c" /* SaveError() etc */ +typedef struct { + ConnectionID ** x_connections; +} my_cxtx_t; /* this *must* be named my_cxtx_t */ -typedef CFragConnectionID ConnectionID; +#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ +#include "dlutils.c" /* SaveError() etc */ -static ConnectionID ** connections; +#define dl_connections (dl_cxtx.x_connections) static void terminate(void) { - int size = GetHandleSize((Handle) connections) / sizeof(ConnectionID); - HLock((Handle) connections); + dTHX; + dMY_CXT; + int size = GetHandleSize((Handle) dl_connections) / sizeof(ConnectionID); + HLock((Handle) dl_connections); while (size) - CloseConnection(*connections + --size); - DisposeHandle((Handle) connections); - connections = nil; + CloseConnection(*dl_connections + --size); + DisposeHandle((Handle) dl_connections); + dl_connections = nil; } static void @@ -70,11 +76,12 @@ GetDiskFragment( &spec, 0, 0, spec.name, kLoadCFrag, &connID, &mainAddr, errName); if (!err) { - if (!connections) { - connections = (ConnectionID **)NewHandle(0); + dMY_CXT; + if (!dl_connections) { + dl_connections = (ConnectionID **)NewHandle(0); atexit(terminate); } - PtrAndHand((Ptr) &connID, (Handle) connections, sizeof(ConnectionID)); + PtrAndHand((Ptr) &connID, (Handle) dl_connections, sizeof(ConnectionID)); RETVAL = connID; } else RETVAL = (ConnectionID) 0; @@ -130,7 +137,8 @@ char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff -ruN perl-5.6.1/ext/DynaLoader/dl_mpeix.xs AP633_source/ext/DynaLoader/dl_mpeix.xs --- perl-5.6.1/ext/DynaLoader/dl_mpeix.xs Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/DynaLoader/dl_mpeix.xs Mon Jun 17 21:28:00 2002 @@ -30,13 +30,10 @@ char filename[PATH_MAX + 3]; } t_mpe_dld, *p_mpe_dld; -static AV *dl_resolve_using = Nullav; - static void dl_private_init(pTHX) { (void)dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); } MODULE = DynaLoader PACKAGE = DynaLoader @@ -124,7 +121,8 @@ char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff -ruN perl-5.6.1/ext/DynaLoader/dl_next.xs AP633_source/ext/DynaLoader/dl_next.xs --- perl-5.6.1/ext/DynaLoader/dl_next.xs Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/DynaLoader/dl_next.xs Mon Jun 17 21:28:00 2002 @@ -44,14 +44,19 @@ #define DL_LOADONCEONLY -#include "dlutils.c" /* SaveError() etc */ +typedef struct { + AV * x_resolve_using; +} my_cxtx_t; /* this *must* be named my_cxtx_t */ +#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ +#include "dlutils.c" /* SaveError() etc */ -static char * dl_last_error = (char *) 0; -static AV *dl_resolve_using = Nullav; +#define dl_resolve_using (dl_cxtx.x_resolve_using) static char *dlerror() { + dTHX; + dMY_CXT; return dl_last_error; } @@ -73,6 +78,7 @@ (const char *path, enum dyldErrorSource type, int number) { dTHX; + dMY_CXT; char *error; unsigned int index; static char *OFIErrorStrings[] = @@ -150,6 +156,8 @@ { char *buffer; int len, maxlen; + dTHX; + dMY_CXT; if ( dl_last_error ) { Safefree(dl_last_error); @@ -174,6 +182,8 @@ char *result; char **p; STRLEN n_a; + dTHX; + dMY_CXT; /* Do not load what is already loaded into this process */ if (hv_fetch(dl_loaded_files, path, strlen(path), 0)) @@ -226,7 +236,10 @@ dl_private_init(pTHX) { (void)dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); + { + dMY_CXT; + dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); + } } MODULE = DynaLoader PACKAGE = DynaLoader @@ -300,7 +313,8 @@ char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff -ruN perl-5.6.1/ext/DynaLoader/dl_vmesa.xs AP633_source/ext/DynaLoader/dl_vmesa.xs --- perl-5.6.1/ext/DynaLoader/dl_vmesa.xs Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/DynaLoader/dl_vmesa.xs Mon Jun 17 21:28:00 2002 @@ -168,7 +168,8 @@ char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff -ruN perl-5.6.1/ext/DynaLoader/dl_vms.xs AP633_source/ext/DynaLoader/dl_vms.xs --- perl-5.6.1/ext/DynaLoader/dl_vms.xs Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/DynaLoader/dl_vms.xs Mon Jun 17 21:28:00 2002 @@ -49,12 +49,8 @@ #include "perl.h" #include "XSUB.h" -#include "dlutils.c" /* dl_debug, LastError; SaveError not used */ - -static AV *dl_require_symbols = Nullav; - /* N.B.: - * dl_debug and LastError are static vars; you'll need to deal + * dl_debug and dl_last_error are static vars; you'll need to deal * with them appropriately if you need context independence */ @@ -78,35 +74,50 @@ struct dsc$descriptor_s defspec; }; -/* Static data for dl_expand_filespec() - This is static to save +typedef struct { + AV * x_require_symbols; +/* "Static" data for dl_expand_filespec() - This is static to save * initialization on each call; if you need context-independence, * just make these auto variables in dl_expandspec() and dl_load_file() */ -static char dlesa[NAM$C_MAXRSS], dlrsa[NAM$C_MAXRSS]; -static struct FAB dlfab; -static struct NAM dlnam; + char x_esa[NAM$C_MAXRSS]; + char x_rsa[NAM$C_MAXRSS]; + struct FAB x_fab; + struct NAM x_nam; +} my_cxtx_t; /* this *must* be named my_cxtx_t */ + +#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ +#include "dlutils.c" /* dl_debug, dl_last_error; SaveError not used */ + +#define dl_require_symbols (dl_cxtx.x_require_symbols) +#define dl_esa (dl_cxtx.x_esa) +#define dl_rsa (dl_cxtx.x_rsa) +#define dl_fab (dl_cxtx.x_fab) +#define dl_nam (dl_cxtx.x_nam) -/* $PutMsg action routine - records error message in LastError */ +/* $PutMsg action routine - records error message in dl_last_error */ static vmssts copy_errmsg(msg,unused) struct dsc$descriptor_s * msg; vmssts unused; { + dTHX; + dMY_CXT; if (*(msg->dsc$a_pointer) == '%') { /* first line */ - if (LastError) - strncpy((LastError = saferealloc(LastError,msg->dsc$w_length+1)), + if (dl_last_error) + strncpy((dl_last_error = saferealloc(dl_last_error,msg->dsc$w_length+1)), msg->dsc$a_pointer, msg->dsc$w_length); else - strncpy((LastError = safemalloc(msg->dsc$w_length+1)), + strncpy((dl_last_error = safemalloc(msg->dsc$w_length+1)), msg->dsc$a_pointer, msg->dsc$w_length); - LastError[msg->dsc$w_length] = '\0'; + dl_last_error[msg->dsc$w_length] = '\0'; } else { /* continuation line */ - int errlen = strlen(LastError); - LastError = saferealloc(LastError, errlen + msg->dsc$w_length + 2); - LastError[errlen] = '\n'; LastError[errlen+1] = '\0'; - strncat(LastError, msg->dsc$a_pointer, msg->dsc$w_length); - LastError[errlen+msg->dsc$w_length+1] = '\0'; + int errlen = strlen(dl_last_error); + dl_last_error = saferealloc(dl_last_error, errlen + msg->dsc$w_length + 2); + dl_last_error[errlen] = '\n'; dl_last_error[errlen+1] = '\0'; + strncat(dl_last_error, msg->dsc$a_pointer, msg->dsc$w_length); + dl_last_error[errlen+msg->dsc$w_length+1] = '\0'; } return 0; } @@ -134,7 +145,7 @@ myvec[0] = args = usig[0] > 10 ? 9 : usig[0] - 1; while (--args) myvec[args] = usig[args]; _ckvmssts(sys$putmsg(myvec,copy_errmsg,0,0)); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "findsym_handler: received\n\t%s\n",LastError)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "findsym_handler: received\n\t%s\n",dl_last_error)); return SS$_CONTINUE; } @@ -157,15 +168,18 @@ dl_private_init(pTHX) { dl_generic_private_init(aTHX); - dl_require_symbols = get_av("DynaLoader::dl_require_symbols", 0x4); - /* Set up the static control blocks for dl_expand_filespec() */ - dlfab = cc$rms_fab; - dlnam = cc$rms_nam; - dlfab.fab$l_nam = &dlnam; - dlnam.nam$l_esa = dlesa; - dlnam.nam$b_ess = sizeof dlesa; - dlnam.nam$l_rsa = dlrsa; - dlnam.nam$b_rss = sizeof dlrsa; + { + dMY_CXT; + dl_require_symbols = get_av("DynaLoader::dl_require_symbols", 0x4); + /* Set up the static control blocks for dl_expand_filespec() */ + dl_fab = cc$rms_fab; + dl_nam = cc$rms_nam; + dl_fab.fab$l_nam = &dl_nam; + dl_nam.nam$l_esa = dl_esa; + dl_nam.nam$b_ess = sizeof dl_esa; + dl_nam.nam$l_rsa = dl_rsa; + dl_nam.nam$b_rss = sizeof dl_rsa; + } } MODULE = DynaLoader PACKAGE = DynaLoader @@ -179,54 +193,55 @@ char vmsspec[NAM$C_MAXRSS], defspec[NAM$C_MAXRSS]; size_t deflen; vmssts sts; + dMY_CXT; tovmsspec(filespec,vmsspec); - dlfab.fab$l_fna = vmsspec; - dlfab.fab$b_fns = strlen(vmsspec); - dlfab.fab$l_dna = 0; - dlfab.fab$b_dns = 0; + dl_fab.fab$l_fna = vmsspec; + dl_fab.fab$b_fns = strlen(vmsspec); + dl_fab.fab$l_dna = 0; + dl_fab.fab$b_dns = 0; DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_expand_filespec(%s):\n",vmsspec)); /* On the first pass, just parse the specification string */ - dlnam.nam$b_nop = NAM$M_SYNCHK; - sts = sys$parse(&dlfab); + dl_nam.nam$b_nop = NAM$M_SYNCHK; + sts = sys$parse(&dl_fab); DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tSYNCHK sys$parse = %d\n",sts)); if (!(sts & 1)) { - dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv); + dl_set_error(dl_fab.fab$l_sts,dl_fab.fab$l_stv); ST(0) = &PL_sv_undef; } else { /* Now set up a default spec - everything but the name */ - deflen = dlnam.nam$l_name - dlesa; - memcpy(defspec,dlesa,deflen); - memcpy(defspec+deflen,dlnam.nam$l_type, - dlnam.nam$b_type + dlnam.nam$b_ver); - deflen += dlnam.nam$b_type + dlnam.nam$b_ver; - memcpy(vmsspec,dlnam.nam$l_name,dlnam.nam$b_name); + deflen = dl_nam.nam$l_name - dl_esa; + memcpy(defspec,dl_esa,deflen); + memcpy(defspec+deflen,dl_nam.nam$l_type, + dl_nam.nam$b_type + dl_nam.nam$b_ver); + deflen += dl_nam.nam$b_type + dl_nam.nam$b_ver; + memcpy(vmsspec,dl_nam.nam$l_name,dl_nam.nam$b_name); DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsplit filespec: name = %.*s, default = %.*s\n", - dlnam.nam$b_name,vmsspec,deflen,defspec)); + dl_nam.nam$b_name,vmsspec,deflen,defspec)); /* . . . and go back to expand it */ - dlnam.nam$b_nop = 0; - dlfab.fab$l_dna = defspec; - dlfab.fab$b_dns = deflen; - dlfab.fab$b_fns = dlnam.nam$b_name; - sts = sys$parse(&dlfab); + dl_nam.nam$b_nop = 0; + dl_fab.fab$l_dna = defspec; + dl_fab.fab$b_dns = deflen; + dl_fab.fab$b_fns = dl_nam.nam$b_name; + sts = sys$parse(&dl_fab); DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tname/default sys$parse = %d\n",sts)); if (!(sts & 1)) { - dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv); + dl_set_error(dl_fab.fab$l_sts,dl_fab.fab$l_stv); ST(0) = &PL_sv_undef; } else { /* Now find the actual file */ - sts = sys$search(&dlfab); + sts = sys$search(&dl_fab); DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsys$search = %d\n",sts)); if (!(sts & 1)) { - dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv); + dl_set_error(dl_fab.fab$l_sts,dl_fab.fab$l_stv); ST(0) = &PL_sv_undef; } else { - ST(0) = sv_2mortal(newSVpvn(dlnam.nam$l_rsa,dlnam.nam$b_rsl)); + ST(0) = sv_2mortal(newSVpvn(dl_nam.nam$l_rsa,dl_nam.nam$b_rsl)); DLDEBUG(1,PerlIO_printf(Perl_debug_log, "\tresult = \\%.*s\\\n", - dlnam.nam$b_rsl,dlnam.nam$l_rsa)); + dl_nam.nam$b_rsl,dl_nam.nam$l_rsa)); } } } @@ -237,6 +252,7 @@ int flags PREINIT: dTHX; + dMY_CXT; char vmsspec[NAM$C_MAXRSS]; SV *reqSV, **reqSVhndl; STRLEN deflen; @@ -360,7 +376,8 @@ char * dl_error() CODE: - RETVAL = LastError ; + dMY_CXT; + RETVAL = dl_last_error ; OUTPUT: RETVAL diff -ruN perl-5.6.1/ext/DynaLoader/dlutils.c AP633_source/ext/DynaLoader/dlutils.c --- perl-5.6.1/ext/DynaLoader/dlutils.c Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/DynaLoader/dlutils.c Mon Jun 17 21:28:00 2002 @@ -8,23 +8,49 @@ * files when the interpreter exits */ +#ifndef XS_VERSION +# define XS_VERSION "0" +#endif +#define MY_CXT_KEY "DynaLoader::_guts" XS_VERSION -/* pointer to allocated memory for last error message */ -static char *LastError = (char*)NULL; +typedef struct { + char * x_dl_last_error; /* pointer to allocated memory for + last error message */ + int x_dl_nonlazy; /* flag for immediate rather than lazy + linking (spots unresolved symbol) */ +#ifdef DL_LOADONCEONLY + HV * x_dl_loaded_files; /* only needed on a few systems */ +#endif +#ifdef DL_CXT_EXTRA + my_cxtx_t x_dl_cxtx; /* extra platform-specific data */ +#endif +#ifdef DEBUGGING + int x_dl_debug; /* value copied from $DynaLoader::dl_debug */ +#endif +} my_cxt_t; -/* flag for immediate rather than lazy linking (spots unresolved symbol) */ -static int dl_nonlazy = 0; +START_MY_CXT +#define dl_last_error (MY_CXT.x_dl_last_error) +#define dl_nonlazy (MY_CXT.x_dl_nonlazy) #ifdef DL_LOADONCEONLY -static HV *dl_loaded_files = Nullhv; /* only needed on a few systems */ +#define dl_loaded_files (MY_CXT.x_dl_loaded_files) +#endif +#ifdef DL_CXT_EXTRA +#define dl_cxtx (MY_CXT.x_dl_cxtx) +#endif +#ifdef DEBUGGING +#define dl_debug (MY_CXT.x_dl_debug) #endif - #ifdef DEBUGGING -static int dl_debug = 0; /* value copied from $DynaLoader::dl_debug */ -#define DLDEBUG(level,code) if (dl_debug>=level) { code; } +#define DLDEBUG(level,code) \ + STMT_START { \ + dMY_CXT; \ + if (dl_debug>=level) { code; } \ + } STMT_END #else -#define DLDEBUG(level,code) +#define DLDEBUG(level,code) NOOP #endif @@ -57,9 +83,18 @@ dl_generic_private_init(pTHXo) /* called by dl_*.xs dl_private_init() */ { char *perl_dl_nonlazy; + MY_CXT_INIT; + + dl_last_error = NULL; + dl_nonlazy = 0; +#ifdef DL_LOADONCEONLY + dl_loaded_files = Nullhv; +#endif #ifdef DEBUGGING - SV *sv = get_sv("DynaLoader::dl_debug", 0); - dl_debug = sv ? SvIV(sv) : 0; + { + SV *sv = get_sv("DynaLoader::dl_debug", 0); + dl_debug = sv ? SvIV(sv) : 0; + } #endif if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL ) dl_nonlazy = atoi(perl_dl_nonlazy); @@ -75,10 +110,11 @@ } -/* SaveError() takes printf style args and saves the result in LastError */ +/* SaveError() takes printf style args and saves the result in dl_last_error */ static void SaveError(pTHXo_ char* pat, ...) { + dMY_CXT; va_list args; SV *msv; char *message; @@ -94,13 +130,13 @@ len++; /* include terminating null char */ /* Allocate some memory for the error message */ - if (LastError) - LastError = (char*)saferealloc(LastError, len) ; + if (dl_last_error) + dl_last_error = (char*)saferealloc(dl_last_error, len); else - LastError = (char *) safemalloc(len) ; + dl_last_error = (char*)safemalloc(len); - /* Copy message into LastError (including terminating null char) */ - strncpy(LastError, message, len) ; - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",LastError)); + /* Copy message into dl_last_error (including terminating null char) */ + strncpy(dl_last_error, message, len) ; + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error)); } diff -ruN perl-5.6.1/ext/Fcntl/Fcntl.pm AP633_source/ext/Fcntl/Fcntl.pm --- perl-5.6.1/ext/Fcntl/Fcntl.pm Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/Fcntl/Fcntl.pm Mon Jun 17 21:28:00 2002 @@ -201,6 +201,7 @@ sub AUTOLOAD { (my $constname = $AUTOLOAD) =~ s/.*:://; + local $! = 0; my $val = constant($constname, 0); if ($! != 0) { if ($! =~ /Invalid/ || $!{EINVAL}) { diff -ruN perl-5.6.1/ext/File/Glob/Glob.pm AP633_source/ext/File/Glob/Glob.pm --- perl-5.6.1/ext/File/Glob/Glob.pm Sun Apr 1 22:18:41 2001 +++ AP633_source/ext/File/Glob/Glob.pm Mon Jun 17 21:28:00 2002 @@ -25,6 +25,7 @@ GLOB_CSH GLOB_ERR GLOB_ERROR + GLOB_LIMIT GLOB_MARK GLOB_NOCASE GLOB_NOCHECK @@ -44,6 +45,7 @@ GLOB_CSH GLOB_ERR GLOB_ERROR + GLOB_LIMIT GLOB_MARK GLOB_NOCASE GLOB_NOCHECK @@ -57,7 +59,7 @@ ) ], ); -$VERSION = '0.991'; +$VERSION = '1.0'; sub import { my $i = 1; @@ -84,6 +86,7 @@ my $constname; ($constname = $AUTOLOAD) =~ s/.*:://; + local $! = 0; my $val = constant($constname, @_ ? $_[0] : 0); if ($! != 0) { if ($! =~ /Invalid/) { @@ -241,6 +244,15 @@ Force bsd_glob() to return an error when it encounters a directory it cannot open or read. Ordinarily bsd_glob() continues to find matches. + +=item C + +Make bsd_glob() return an error (GLOB_NOSPACE) when the pattern expands +to a size bigger than the system constant C (usually found in +limits.h). If your system does not define this constant, bsd_glob() uses +C or C<_POSIX_ARG_MAX> where available (in that +order). You can inspect these values using the standard C +extension. =item C diff -ruN perl-5.6.1/ext/File/Glob/Glob.xs AP633_source/ext/File/Glob/Glob.xs --- perl-5.6.1/ext/File/Glob/Glob.xs Thu Apr 5 21:38:46 2001 +++ AP633_source/ext/File/Glob/Glob.xs Mon Jun 17 21:28:00 2002 @@ -4,8 +4,15 @@ #include "bsd_glob.h" -/* XXX: need some thread awareness */ -static int GLOB_ERROR = 0; +#define MY_CXT_KEY "File::Glob::_guts" XS_VERSION + +typedef struct { + int x_GLOB_ERROR; +} my_cxt_t; + +START_MY_CXT + +#define GLOB_ERROR (MY_CXT.x_GLOB_ERROR) static double constant(char *name, int arg) @@ -53,8 +60,11 @@ #else goto not_there; #endif - if (strEQ(name, "GLOB_ERROR")) + if (strEQ(name, "GLOB_ERROR")) { + dTHX; + dMY_CXT; return GLOB_ERROR; + } break; case 'F': break; @@ -69,6 +79,12 @@ case 'K': break; case 'L': + if (strEQ(name, "GLOB_LIMIT")) +#ifdef GLOB_LIMIT + return GLOB_LIMIT; +#else + goto not_there; +#endif break; case 'M': if (strEQ(name, "GLOB_MARK")) @@ -166,6 +182,11 @@ MODULE = File::Glob PACKAGE = File::Glob +BOOT: +{ + MY_CXT_INIT; +} + void doglob(pattern,...) char *pattern @@ -178,6 +199,8 @@ SV *tmp; PPCODE: { + dMY_CXT; + /* allow for optional flags argument */ if (items > 1) { flags = (int) SvIV(ST(1)); diff -ruN perl-5.6.1/ext/File/Glob/bsd_glob.c AP633_source/ext/File/Glob/bsd_glob.c --- perl-5.6.1/ext/File/Glob/bsd_glob.c Sun Apr 1 22:18:41 2001 +++ AP633_source/ext/File/Glob/bsd_glob.c Mon Jun 17 21:28:00 2002 @@ -32,6 +32,9 @@ #if defined(LIBC_SCCS) && !defined(lint) static char sccsid[] = "@(#)glob.c 8.3 (Berkeley) 10/13/93"; +/* most changes between the version above and the one below have been ported: +static char sscsid[]= "$OpenBSD: glob.c,v 1.8.10.1 2001/04/10 jason Exp $"; + */ #endif /* LIBC_SCCS and not lint */ /* @@ -87,6 +90,26 @@ # endif #endif +#ifdef I_LIMITS +#include +#endif + +#ifndef ARG_MAX +# ifdef _SC_ARG_MAX +# define ARG_MAX (sysconf(_SC_ARG_MAX)) +# else +# ifdef _POSIX_ARG_MAX +# define ARG_MAX _POSIX_ARG_MAX +# else +# ifdef WIN32 +# define ARG_MAX 14500 /* from VC's limits.h */ +# else +# define ARG_MAX 4096 /* from POSIX, be conservative */ +# endif +# endif +# endif +#endif + #define BG_DOLLAR '$' #define BG_DOT '.' #define BG_EOS '\0' @@ -146,20 +169,20 @@ static int compare(const void *, const void *); static int ci_compare(const void *, const void *); -static void g_Ctoc(const Char *, char *); +static int g_Ctoc(const Char *, char *, STRLEN); static int g_lstat(Char *, Stat_t *, glob_t *); static DIR *g_opendir(Char *, glob_t *); static Char *g_strchr(Char *, int); -#ifdef notdef -static Char *g_strcat(Char *, const Char *); -#endif static int g_stat(Char *, Stat_t *, glob_t *); static int glob0(const Char *, glob_t *); -static int glob1(Char *, glob_t *); -static int glob2(Char *, Char *, Char *, glob_t *); -static int glob3(Char *, Char *, Char *, Char *, glob_t *); -static int globextend(const Char *, glob_t *); -static const Char * globtilde(const Char *, Char *, glob_t *); +static int glob1(Char *, Char *, glob_t *, size_t *); +static int glob2(Char *, Char *, Char *, Char *, Char *, Char *, + glob_t *, size_t *); +static int glob3(Char *, Char *, Char *, Char *, Char *, Char *, + Char *, Char *, glob_t *, size_t *); +static int globextend(const Char *, glob_t *, size_t *); +static const Char * + globtilde(const Char *, Char *, size_t, glob_t *); static int globexp1(const Char *, glob_t *); static int globexp2(const Char *, const Char *, glob_t *, int *); static int match(Char *, Char *, Char *, int); @@ -185,7 +208,7 @@ { const U8 *patnext; int c; - Char *bufnext, *bufend, patbuf[MAXPATHLEN+1]; + Char *bufnext, *bufend, patbuf[MAXPATHLEN]; patnext = (U8 *) pattern; if (!(flags & GLOB_APPEND)) { @@ -199,7 +222,7 @@ pglob->gl_matchc = 0; bufnext = patbuf; - bufend = bufnext + MAXPATHLEN; + bufend = bufnext + MAXPATHLEN - 1; #ifdef DOSISH /* Nasty hack to treat patterns like "C:*" correctly. In this * case, the * should match any file in the current directory @@ -239,13 +262,11 @@ --patnext; } *bufnext++ = c | M_PROTECT; - } - else + } else *bufnext++ = c; - } - else - while (bufnext < bufend && (c = *patnext++) != BG_EOS) - *bufnext++ = c; + } else + while (bufnext < bufend && (c = *patnext++) != BG_EOS) + *bufnext++ = c; *bufnext = BG_EOS; if (flags & GLOB_BRACE) @@ -259,7 +280,8 @@ * invoke the standard globbing routine to glob the rest of the magic * characters */ -static int globexp1(const Char *pattern, glob_t *pglob) +static int +globexp1(const Char *pattern, glob_t *pglob) { const Char* ptr = pattern; int rv; @@ -281,17 +303,19 @@ * If it succeeds then it invokes globexp1 with the new pattern. * If it fails then it tries to glob the rest of the pattern and returns. */ -static int globexp2(const Char *ptr, const Char *pattern, - glob_t *pglob, int *rv) +static int +globexp2(const Char *ptr, const Char *pattern, + glob_t *pglob, int *rv) { int i; Char *lm, *ls; const Char *pe, *pm, *pl; - Char patbuf[MAXPATHLEN + 1]; + Char patbuf[MAXPATHLEN]; /* copy part up to the brace */ for (lm = patbuf, pm = pattern; pm != ptr; *lm++ = *pm++) - continue; + ; + *lm = BG_EOS; ls = lm; /* Find the balanced brace */ @@ -299,7 +323,7 @@ if (*pe == BG_LBRACKET) { /* Ignore everything between [] */ for (pm = pe++; *pe != BG_RBRACKET && *pe != BG_EOS; pe++) - continue; + ; if (*pe == BG_EOS) { /* * We could not find a matching BG_RBRACKET. @@ -307,8 +331,7 @@ */ pe = pm; } - } - else if (*pe == BG_LBRACE) + } else if (*pe == BG_LBRACE) i++; else if (*pe == BG_RBRACE) { if (i == 0) @@ -322,12 +345,12 @@ return 0; } - for (i = 0, pl = pm = ptr; pm <= pe; pm++) + for (i = 0, pl = pm = ptr; pm <= pe; pm++) { switch (*pm) { case BG_LBRACKET: /* Ignore everything between [] */ for (pl = pm++; *pm != BG_RBRACKET && *pm != BG_EOS; pm++) - continue; + ; if (*pm == BG_EOS) { /* * We could not find a matching BG_RBRACKET. @@ -343,8 +366,8 @@ case BG_RBRACE: if (i) { - i--; - break; + i--; + break; } /* FALLTHROUGH */ case BG_COMMA: @@ -353,13 +376,14 @@ else { /* Append the current string */ for (lm = ls; (pl < pm); *lm++ = *pl++) - continue; + ; + /* * Append the rest of the pattern after the * closing brace */ - for (pl = pe + 1; (*lm++ = *pl++) != BG_EOS;) - continue; + for (pl = pe + 1; (*lm++ = *pl++) != BG_EOS; ) + ; /* Expand the current pattern */ #ifdef GLOB_DEBUG @@ -375,6 +399,7 @@ default: break; } + } *rv = 0; return 0; } @@ -385,23 +410,41 @@ * expand tilde from the passwd file. */ static const Char * -globtilde(const Char *pattern, Char *patbuf, glob_t *pglob) +globtilde(const Char *pattern, Char *patbuf, size_t patbuf_len, glob_t *pglob) { struct passwd *pwd; char *h; const Char *p; - Char *b; + Char *b, *eb; +#if defined(USE_REENTRANT_API) + struct passwd pw_result; + char pw_buf[1024]; + /* getpwuid_r() and getpwnam_r() are standardized. */ +# define getpwuid(x) \ + ((errno = getpwuid_r(x,&pw_result,pw_buf,sizeof(pw_buf),&pwd)) == 0 \ + ? pwd : NULL) +# define getpwnam(x) \ + ((errno = getpwnam_r(x,&pw_result,pw_buf,sizeof(pw_buf),&pwd)) == 0 \ + ? pwd : NULL) +#endif + if (*pattern != BG_TILDE || !(pglob->gl_flags & GLOB_TILDE)) return pattern; /* Copy up to the end of the string or / */ - for (p = pattern + 1, h = (char *) patbuf; *p && *p != BG_SLASH; - *h++ = *p++) - continue; + eb = &patbuf[patbuf_len - 1]; + for (p = pattern + 1, h = (char *) patbuf; + h < (char*)eb && *p && *p != BG_SLASH; *h++ = *p++) + ; *h = BG_EOS; +#if 0 + if (h == (char *)eb) + return what; +#endif + if (((char *) patbuf)[0] == BG_EOS) { /* * handle a plain ~ or ~/ by expanding $HOME @@ -417,8 +460,7 @@ return pattern; #endif } - } - else { + } else { /* * Expand a ~user */ @@ -433,12 +475,13 @@ } /* Copy the home directory */ - for (b = patbuf; *h; *b++ = *h++) - continue; + for (b = patbuf; b < eb && *h; *b++ = *h++) + ; /* Append the rest of the pattern */ - while ((*b++ = *p++) != BG_EOS) - continue; + while (b < eb && (*b++ = *p++) != BG_EOS) + ; + *b = BG_EOS; return patbuf; } @@ -456,7 +499,8 @@ { const Char *qpat, *qpatnext; int c, err, oldflags, oldpathc; - Char *bufnext, patbuf[MAXPATHLEN+1]; + Char *bufnext, patbuf[MAXPATHLEN]; + size_t limit = 0; #ifdef MACOS_TRADITIONAL if ( (*pattern == BG_TILDE) && (pglob->gl_flags & GLOB_TILDE) ) { @@ -464,7 +508,7 @@ } #endif - qpat = globtilde(pattern, patbuf, pglob); + qpat = globtilde(pattern, patbuf, MAXPATHLEN, pglob); qpatnext = qpat; oldflags = pglob->gl_flags; oldpathc = pglob->gl_pathc; @@ -510,7 +554,7 @@ * to avoid exponential behavior */ if (bufnext == patbuf || bufnext[-1] != M_ALL) - *bufnext++ = M_ALL; + *bufnext++ = M_ALL; break; default: *bufnext++ = CHAR(c); @@ -522,7 +566,7 @@ qprintf("glob0:", patbuf); #endif /* GLOB_DEBUG */ - if ((err = glob1(patbuf, pglob)) != 0) { + if ((err = glob1(patbuf, patbuf+MAXPATHLEN-1, pglob, &limit)) != 0) { pglob->gl_flags = oldflags; return(err); } @@ -542,7 +586,7 @@ printf("calling globextend from glob0\n"); #endif /* GLOB_DEBUG */ pglob->gl_flags = oldflags; - return(globextend(qpat, pglob)); + return(globextend(qpat, pglob, &limit)); } else if (!(pglob->gl_flags & GLOB_NOSORT)) qsort(pglob->gl_pathv + pglob->gl_offs + oldpathc, @@ -556,19 +600,19 @@ static int ci_compare(const void *p, const void *q) { - const char *pp = *(const char **)p; - const char *qq = *(const char **)q; - int ci; - while (*pp && *qq) { - if (tolower(*pp) != tolower(*qq)) - break; - ++pp; - ++qq; - } - ci = tolower(*pp) - tolower(*qq); - if (ci == 0) - return compare(p, q); - return ci; + const char *pp = *(const char **)p; + const char *qq = *(const char **)q; + int ci; + while (*pp && *qq) { + if (tolower(*pp) != tolower(*qq)) + break; + ++pp; + ++qq; + } + ci = tolower(*pp) - tolower(*qq); + if (ci == 0) + return compare(p, q); + return ci; } static int @@ -578,14 +622,16 @@ } static int -glob1(Char *pattern, glob_t *pglob) +glob1(Char *pattern, Char *pattern_last, glob_t *pglob, size_t *limitp) { - Char pathbuf[MAXPATHLEN+1]; + Char pathbuf[MAXPATHLEN]; /* A null pathname is invalid -- POSIX 1003.1 sect. 2.4. */ if (*pattern == BG_EOS) return(0); - return(glob2(pathbuf, pathbuf, pattern, pglob)); + return(glob2(pathbuf, pathbuf+MAXPATHLEN-1, + pathbuf, pathbuf+MAXPATHLEN-1, + pattern, pattern_last, pglob, limitp)); } /* @@ -594,7 +640,8 @@ * meta characters. */ static int -glob2(Char *pathbuf, Char *pathend, Char *pattern, glob_t *pglob) +glob2(Char *pathbuf, Char *pathbuf_last, Char *pathend, Char *pathend_last, + Char *pattern, Char *pattern_last, glob_t *pglob, size_t *limitp) { Stat_t sb; Char *p, *q; @@ -607,7 +654,6 @@ for (anymeta = 0;;) { if (*pattern == BG_EOS) { /* End of pattern? */ *pathend = BG_EOS; - if (g_lstat(pathbuf, &sb, pglob)) return(0); @@ -616,10 +662,12 @@ #ifdef DOSISH && pathend[-1] != BG_SEP2 #endif - ) && (S_ISDIR(sb.st_mode) - || (S_ISLNK(sb.st_mode) && + ) && (S_ISDIR(sb.st_mode) || + (S_ISLNK(sb.st_mode) && (g_stat(pathbuf, &sb, pglob) == 0) && S_ISDIR(sb.st_mode)))) { + if (pathend+1 > pathend_last) + return (1); *pathend++ = BG_SEP; *pathend = BG_EOS; } @@ -627,7 +675,7 @@ #ifdef GLOB_DEBUG printf("calling globextend from glob2\n"); #endif /* GLOB_DEBUG */ - return(globextend(pathbuf, pglob)); + return(globextend(pathbuf, pglob, limitp)); } /* Find end of next segment, copy tentatively to pathend. */ @@ -640,6 +688,8 @@ ) { if (ismeta(*p)) anymeta = 1; + if (q+1 > pathend_last) + return (1); *q++ = *p++; } @@ -650,17 +700,24 @@ #ifdef DOSISH || *pattern == BG_SEP2 #endif - ) + ) { + if (pathend+1 > pathend_last) + return (1); *pathend++ = *pattern++; - } else /* Need expansion, recurse. */ - return(glob3(pathbuf, pathend, pattern, p, pglob)); + } + } else + /* Need expansion, recurse. */ + return(glob3(pathbuf, pathbuf_last, pathend, + pathend_last, pattern, pattern_last, + p, pattern_last, pglob, limitp)); } /* NOTREACHED */ } static int -glob3(Char *pathbuf, Char *pathend, Char *pattern, - Char *restpattern, glob_t *pglob) +glob3(Char *pathbuf, Char *pathbuf_last, Char *pathend, Char *pathend_last, + Char *pattern, Char *pattern_last, + Char *restpattern, Char *restpattern_last, glob_t *pglob, size_t *limitp) { register Direntry_t *dp; DIR *dirp; @@ -676,28 +733,32 @@ */ Direntry_t *(*readdirfunc)(DIR*); + if (pathend > pathend_last) + return (1); *pathend = BG_EOS; errno = 0; #ifdef VMS { - Char *q = pathend; - if (q - pathbuf > 5) { - q -= 5; - if (q[0] == '.' && tolower(q[1]) == 'd' && tolower(q[2]) == 'i' - && tolower(q[3]) == 'r' && q[4] == '/') - { - q[0] = '/'; - q[1] = BG_EOS; - pathend = q+1; - } - } + Char *q = pathend; + if (q - pathbuf > 5) { + q -= 5; + if (q[0] == '.' && + tolower(q[1]) == 'd' && tolower(q[2]) == 'i' && + tolower(q[3]) == 'r' && q[4] == '/') + { + q[0] = '/'; + q[1] = BG_EOS; + pathend = q+1; + } + } } #endif if ((dirp = g_opendir(pathbuf, pglob)) == NULL) { /* TODO: don't call for ENOENT or ENOTDIR? */ if (pglob->gl_errfunc) { - g_Ctoc(pathbuf, buf); + if (g_Ctoc(pathbuf, buf, sizeof(buf))) + return (GLOB_ABEND); if (pglob->gl_errfunc(buf, errno) || (pglob->gl_flags & GLOB_ERR)) return (GLOB_ABEND); @@ -710,7 +771,7 @@ /* Search directory for matching names. */ if (pglob->gl_flags & GLOB_ALTDIRFUNC) - readdirfunc = (Direntry_t *(*)(DIR *))pglob->gl_readdir; + readdirfunc = (Direntry_t *(*)(DIR *))pglob->gl_readdir; else readdirfunc = my_readdir; while ((dp = (*readdirfunc)(dirp))) { @@ -720,14 +781,22 @@ /* Initial BG_DOT must be matched literally. */ if (dp->d_name[0] == BG_DOT && *pattern != BG_DOT) continue; - for (sc = (U8 *) dp->d_name, dc = pathend; - (*dc++ = *sc++) != BG_EOS;) - continue; + dc = pathend; + sc = (U8 *) dp->d_name; + while (dc < pathend_last && (*dc++ = *sc++) != BG_EOS) + ; + if (dc >= pathend_last) { + *dc = BG_EOS; + err = 1; + break; + } + if (!match(pathend, pattern, restpattern, nocase)) { *pathend = BG_EOS; continue; } - err = glob2(pathbuf, --dc, restpattern, pglob); + err = glob2(pathbuf, pathbuf_last, --dc, pathend_last, + restpattern, restpattern_last, pglob, limitp); if (err) break; } @@ -755,10 +824,11 @@ * gl_pathv points to (gl_offs + gl_pathc + 1) items. */ static int -globextend(const Char *path, glob_t *pglob) +globextend(const Char *path, glob_t *pglob, size_t *limitp) { register char **pathv; register int i; + STRLEN newsize, len; char *copy; const Char *p; @@ -769,13 +839,18 @@ printf("\n"); #endif /* GLOB_DEBUG */ + newsize = sizeof(*pathv) * (2 + pglob->gl_pathc + pglob->gl_offs); if (pglob->gl_pathv) - pathv = Renew(pglob->gl_pathv, - (2 + pglob->gl_pathc + pglob->gl_offs),char*); + pathv = Renew(pglob->gl_pathv,newsize,char*); else - New(0,pathv,(2 + pglob->gl_pathc + pglob->gl_offs),char*); - if (pathv == NULL) + New(0,pathv,newsize,char*); + if (pathv == NULL) { + if (pglob->gl_pathv) { + Safefree(pglob->gl_pathv); + pglob->gl_pathv = NULL; + } return(GLOB_NOSPACE); + } if (pglob->gl_pathv == NULL && pglob->gl_offs > 0) { /* first time around -- clear initial gl_offs items */ @@ -786,13 +861,25 @@ pglob->gl_pathv = pathv; for (p = path; *p++;) - continue; + ; + len = (STRLEN)(p - path); + *limitp += len; New(0, copy, p-path, char); if (copy != NULL) { - g_Ctoc(path, copy); + if (g_Ctoc(path, copy, len)) { + Safefree(copy); + return(GLOB_NOSPACE); + } pathv[pglob->gl_offs + pglob->gl_pathc++] = copy; } pathv[pglob->gl_offs + pglob->gl_pathc] = NULL; + + if ((pglob->gl_flags & GLOB_LIMIT) && + newsize + *limitp >= ARG_MAX) { + errno = 0; + return(GLOB_NOSPACE); + } + return(copy == NULL ? GLOB_NOSPACE : 0); } @@ -816,7 +903,8 @@ do if (match(name, pat, patend, nocase)) return(1); - while (*name++ != BG_EOS); + while (*name++ != BG_EOS) + ; return(0); case M_ONE: if (*name++ == BG_EOS) @@ -866,6 +954,7 @@ if (*pp) Safefree(*pp); Safefree(pglob->gl_pathv); + pglob->gl_pathv = NULL; } } @@ -881,13 +970,14 @@ strcpy(buf, "."); #endif } else { - g_Ctoc(str, buf); + if (g_Ctoc(str, buf, sizeof(buf))) + return(NULL); } if (pglob->gl_flags & GLOB_ALTDIRFUNC) return((*pglob->gl_opendir)(buf)); - else - return(PerlDir_open(buf)); + + return(PerlDir_open(buf)); } static int @@ -895,7 +985,8 @@ { char buf[MAXPATHLEN]; - g_Ctoc(fn, buf); + if (g_Ctoc(fn, buf, sizeof(buf))) + return(-1); if (pglob->gl_flags & GLOB_ALTDIRFUNC) return((*pglob->gl_lstat)(buf, sb)); #ifdef HAS_LSTAT @@ -910,7 +1001,8 @@ { char buf[MAXPATHLEN]; - g_Ctoc(fn, buf); + if (g_Ctoc(fn, buf, sizeof(buf))) + return(-1); if (pglob->gl_flags & GLOB_ALTDIRFUNC) return((*pglob->gl_stat)(buf, sb)); return(PerlLIO_stat(buf, sb)); @@ -926,29 +1018,14 @@ return (NULL); } -#ifdef notdef -static Char * -g_strcat(Char *dst, const Char *src) -{ - Char *sdst = dst; - - while (*dst++) - continue; - --dst; - while((*dst++ = *src++) != BG_EOS) - continue; - - return (sdst); -} -#endif - -static void -g_Ctoc(register const Char *str, char *buf) +static int +g_Ctoc(register const Char *str, char *buf, STRLEN len) { - register char *dc; - - for (dc = buf; (*dc++ = *str++) != BG_EOS;) - continue; + while (len--) { + if ((*buf++ = *str++) == BG_EOS) + return (0); + } + return (1); } #ifdef GLOB_DEBUG diff -ruN perl-5.6.1/ext/File/Glob/bsd_glob.h AP633_source/ext/File/Glob/bsd_glob.h --- perl-5.6.1/ext/File/Glob/bsd_glob.h Tue Mar 20 09:39:30 2001 +++ AP633_source/ext/File/Glob/bsd_glob.h Mon Jun 17 21:28:00 2002 @@ -30,6 +30,7 @@ * SUCH DAMAGE. * * @(#)glob.h 8.1 (Berkeley) 6/2/93 + * [lots of perl-specific changes since then--see bsd_glob.c] */ #ifndef _BSD_GLOB_H_ @@ -73,6 +74,8 @@ #define GLOB_TILDE 0x0800 /* Expand tilde names from the passwd file. */ #define GLOB_NOCASE 0x1000 /* Treat filenames without regard for case. */ #define GLOB_ALPHASORT 0x2000 /* Alphabetic, not ASCII sort, like csh. */ +#define GLOB_LIMIT 0x4000 /* Limit pattern match output to ARG_MAX + (usually from limits.h). */ #define GLOB_NOSPACE (-1) /* Malloc call failed. */ #define GLOB_ABEND (-2) /* Unignored error. */ diff -ruN perl-5.6.1/ext/GDBM_File/GDBM_File.pm AP633_source/ext/GDBM_File/GDBM_File.pm --- perl-5.6.1/ext/GDBM_File/GDBM_File.pm Mon Mar 19 00:11:17 2001 +++ AP633_source/ext/GDBM_File/GDBM_File.pm Mon Jun 17 21:28:00 2002 @@ -66,6 +66,7 @@ sub AUTOLOAD { my($constname); ($constname = $AUTOLOAD) =~ s/.*:://; + local $! = 0; my $val = constant($constname, @_ ? $_[0] : 0); if ($! != 0) { if ($! =~ /Invalid/ || $!{EINVAL}) { diff -ruN perl-5.6.1/ext/IO/lib/IO/Pipe.pm AP633_source/ext/IO/lib/IO/Pipe.pm --- perl-5.6.1/ext/IO/lib/IO/Pipe.pm Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/IO/lib/IO/Pipe.pm Mon Jun 17 21:28:00 2002 @@ -38,7 +38,7 @@ (IO::Pipe::End->new(), IO::Pipe::End->new()); } -my $do_spawn = $^O eq 'os2'; +my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32'; sub _doit { my $me = shift; @@ -56,8 +56,11 @@ if ($do_spawn) { require Fcntl; $save = IO::Handle->new_from_fd($io, $mode); + my $handle = shift; # Close in child: - fcntl(shift, Fcntl::F_SETFD(), 1) or croak "fcntl: $!"; + unless ($^O eq 'MSWin32') { + fcntl($handle, Fcntl::F_SETFD(), 1) or croak "fcntl: $!"; + } $fh = $rw ? ${*$me}[0] : ${*$me}[1]; } else { shift; diff -ruN perl-5.6.1/ext/IO/lib/IO/Seekable.pm AP633_source/ext/IO/lib/IO/Seekable.pm --- perl-5.6.1/ext/IO/lib/IO/Seekable.pm Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/IO/lib/IO/Seekable.pm Mon Jun 17 21:28:00 2002 @@ -55,7 +55,7 @@ POS is an offset from the current position. (Seek relative to current) -=item WHENCE=1 (SEEK_END) +=item WHENCE=2 (SEEK_END) POS is an offset from the end of the file. (Seek relative to end) diff -ruN perl-5.6.1/ext/IO/poll.c AP633_source/ext/IO/poll.c --- perl-5.6.1/ext/IO/poll.c Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/IO/poll.c Mon Jun 17 21:28:00 2002 @@ -12,6 +12,8 @@ #include "EXTERN.h" #include "perl.h" +#include "XSUB.h" + #include "poll.h" #ifdef I_SYS_TIME # include diff -ruN perl-5.6.1/ext/ODBM_File/ODBM_File.xs AP633_source/ext/ODBM_File/ODBM_File.xs --- perl-5.6.1/ext/ODBM_File/ODBM_File.xs Sat Mar 3 11:53:20 2001 +++ AP633_source/ext/ODBM_File/ODBM_File.xs Mon Jun 17 21:28:00 2002 @@ -70,7 +70,15 @@ #define odbm_FIRSTKEY(db) firstkey() #define odbm_NEXTKEY(db,key) nextkey(key) -static int dbmrefcnt; +#define MY_CXT_KEY "ODBM_File::_guts" XS_VERSION + +typedef struct { + int x_dbmrefcnt; +} my_cxt_t; + +START_MY_CXT + +#define dbmrefcnt (MY_CXT.x_dbmrefcnt) #ifndef DBM_REPLACE #define DBM_REPLACE 0 @@ -78,6 +86,11 @@ MODULE = ODBM_File PACKAGE = ODBM_File PREFIX = odbm_ +BOOT: +{ + MY_CXT_INIT; +} + ODBM_File odbm_TIEHASH(dbtype, filename, flags, mode) char * dbtype @@ -88,6 +101,8 @@ { char *tmpbuf; void * dbp ; + dMY_CXT; + if (dbmrefcnt++) croak("Old dbm can only open one database"); New(0, tmpbuf, strlen(filename) + 5, char); @@ -115,6 +130,8 @@ void DESTROY(db) ODBM_File db + PREINIT: + dMY_CXT; CODE: dbmrefcnt--; dbmclose(); diff -ruN perl-5.6.1/ext/Opcode/Opcode.xs AP633_source/ext/Opcode/Opcode.xs --- perl-5.6.1/ext/Opcode/Opcode.xs Thu Apr 5 21:38:46 2001 +++ AP633_source/ext/Opcode/Opcode.xs Mon Jun 17 21:28:00 2002 @@ -7,10 +7,21 @@ #define OP_MASK_BUF_SIZE (MAXO + 100) /* XXX op_named_bits and opset_all are never freed */ -static HV *op_named_bits; /* cache shared for whole process */ -static SV *opset_all; /* mask with all bits set */ -static IV opset_len; /* length of opmasks in bytes */ -static int opcode_debug = 0; +#define MY_CXT_KEY "Opcode::_guts" XS_VERSION + +typedef struct { + HV * x_op_named_bits; /* cache shared for whole process */ + SV * x_opset_all; /* mask with all bits set */ + IV x_opset_len; /* length of opmasks in bytes */ + int x_opcode_debug; +} my_cxt_t; + +START_MY_CXT + +#define op_named_bits (MY_CXT.x_op_named_bits) +#define opset_all (MY_CXT.x_opset_all) +#define opset_len (MY_CXT.x_opset_len) +#define opcode_debug (MY_CXT.x_opcode_debug) static SV *new_opset (pTHX_ SV *old_opset); static int verify_opset (pTHX_ SV *opset, int fatal); @@ -34,6 +45,7 @@ STRLEN len; char **op_names; char *bitmap; + dMY_CXT; op_named_bits = newHV(); op_names = get_op_names(); @@ -66,6 +78,8 @@ put_op_bitspec(pTHX_ char *optag, STRLEN len, SV *mask) { SV **svp; + dMY_CXT; + verify_opset(aTHX_ mask,1); if (!len) len = strlen(optag); @@ -87,6 +101,8 @@ get_op_bitspec(pTHX_ char *opname, STRLEN len, int fatal) { SV **svp; + dMY_CXT; + if (!len) len = strlen(opname); svp = hv_fetch(op_named_bits, opname, len, 0); @@ -110,6 +126,8 @@ new_opset(pTHX_ SV *old_opset) { SV *opset; + dMY_CXT; + if (old_opset) { verify_opset(aTHX_ old_opset,1); opset = newSVsv(old_opset); @@ -129,6 +147,8 @@ verify_opset(pTHX_ SV *opset, int fatal) { char *err = Nullch; + dMY_CXT; + if (!SvOK(opset)) err = "undefined"; else if (!SvPOK(opset)) err = "wrong type"; else if (SvCUR(opset) != opset_len) err = "wrong size"; @@ -142,6 +162,7 @@ static void set_opset_bits(pTHX_ char *bitmap, SV *bitspec, int on, char *opname) { + dMY_CXT; if (SvIOK(bitspec)) { int myopcode = SvIV(bitspec); int offset = myopcode >> 3; @@ -180,6 +201,7 @@ char *bitmask; STRLEN len; int myopcode = 0; + dMY_CXT; verify_opset(aTHX_ opset,1); /* croaks on bad opset */ @@ -204,6 +226,8 @@ opmask_addlocal(pTHX_ SV *opset, char *op_mask_buf) /* Localise PL_op_mask then opmask_add() */ { char *orig_op_mask = PL_op_mask; + dMY_CXT; + SAVEVPTR(PL_op_mask); #if !defined(PERL_OBJECT) /* XXX casting to an ordinary function ptr from a member function ptr @@ -227,12 +251,14 @@ PROTOTYPES: ENABLE BOOT: +{ + MY_CXT_INIT; assert(PL_maxo < OP_MASK_BUF_SIZE); opset_len = (PL_maxo + 7) / 8; if (opcode_debug >= 1) warn("opset_len %ld\n", (long)opset_len); op_names_init(aTHX); - +} void _safe_call_sv(Package, mask, codesv) @@ -289,6 +315,8 @@ CODE: { char *bitmap; + dMY_CXT; + STRLEN len = opset_len; opset = sv_2mortal(new_opset(aTHX_ opset)); /* verify and clone opset */ bitmap = SvPVX(opset); @@ -311,6 +339,8 @@ int i, j, myopcode; char *bitmap = SvPV(opset, len); char **names = (desc) ? get_op_descs() : get_op_names(); + dMY_CXT; + verify_opset(aTHX_ opset,1); for (myopcode=0, i=0; i < opset_len; i++) { U16 bits = bitmap[i]; @@ -363,6 +393,7 @@ SV *bitspec, *mask; char *bitmap, *opname; STRLEN len; + dMY_CXT; if (!SvROK(safe) || !SvOBJECT(SvRV(safe)) || SvTYPE(SvRV(safe))!=SVt_PVHV) croak("Not a Safe object"); @@ -397,6 +428,7 @@ STRLEN len; SV **args; char **op_desc = get_op_descs(); + dMY_CXT; /* copy args to a scratch area since we may push output values onto */ /* the stack faster than we read values off it if masks are used. */ args = (SV**)SvPVX(sv_2mortal(newSVpvn((char*)&ST(0), items*sizeof(SV*)))); @@ -446,6 +478,7 @@ void full_opset() CODE: + dMY_CXT; ST(0) = sv_2mortal(new_opset(aTHX_ opset_all)); void diff -ruN perl-5.6.1/ext/POSIX/POSIX.xs AP633_source/ext/POSIX/POSIX.xs --- perl-5.6.1/ext/POSIX/POSIX.xs Thu Apr 5 21:38:46 2001 +++ AP633_source/ext/POSIX/POSIX.xs Mon Jun 17 21:28:00 2002 @@ -142,7 +142,9 @@ # define sigdelset(a,b) not_here("sigdelset") # define sigfillset(a) not_here("sigfillset") # define sigismember(a,b) not_here("sigismember") +# undef setuid # define setuid(a) not_here("setuid") +# undef setgid # define setgid(a) not_here("setgid") #else @@ -199,9 +201,11 @@ /* Possibly needed prototypes */ char *cuserid (char *); +#ifndef WIN32 double strtod (const char *, char **); long strtol (const char *, char **, int); unsigned long strtoul (const char *, char **, int); +#endif #ifndef HAS_CUSERID #define cuserid(a) (char *) not_here("cuserid") @@ -333,6 +337,10 @@ init_tm(struct tm *ptm) /* see mktime, strftime and asctime */ { Time_t now; +#if defined(USE_REENTRANT_API) + struct tm tm_result; +# define localtime(x) localtime_r(x, &tm_result) +#endif (void)time(&now); Copy(localtime(&now), ptm, 1, struct tm); } @@ -3589,6 +3597,8 @@ CODE: RETVAL = newSVpvn("", 0); SvGROW(RETVAL, L_tmpnam); + /* NOTE: this use of tmpnam() is MT-safe since the argument + * is always non-NULL */ len = strlen(tmpnam(SvPV(RETVAL, i))); SvCUR_set(RETVAL, len); OUTPUT: @@ -3755,6 +3765,11 @@ int wday int yday int isdst + PREINIT: +#if defined(USE_REENTRANT_API) + char asctime_buf[26]; +# define asctime(x) asctime_r(x, asctime_buf) +#endif CODE: { struct tm mytm; @@ -3779,6 +3794,11 @@ char * ctime(time) Time_t &time + PREINIT: +#if defined(USE_REENTRANT_API) + char ctime_buf[26]; +# define ctime(x) ctime_r(x, ctime_buf) +#endif void times() @@ -3948,3 +3968,9 @@ char * ttyname(fd) int fd + PREINIT: +#if defined(USE_REENTRANT_API) + char name[1024]; /* big enough for POSIX_PATH_MAX || TTY_NAME_MAX */ +# define ttyname(x) \ + ((errno = ttyname_r(x, name, sizeof(name))) == 0 ? name : NULL) +#endif diff -ruN perl-5.6.1/ext/Socket/Socket.pm AP633_source/ext/Socket/Socket.pm --- perl-5.6.1/ext/Socket/Socket.pm Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/Socket/Socket.pm Mon Jun 17 21:28:00 2002 @@ -439,6 +439,7 @@ sub AUTOLOAD { my($constname); ($constname = $AUTOLOAD) =~ s/.*:://; + local $! = 0; my $val = constant($constname, @_ ? $_[0] : 0); if ($! != 0) { my ($pack,$file,$line) = caller; diff -ruN perl-5.6.1/ext/Socket/Socket.xs AP633_source/ext/Socket/Socket.xs --- perl-5.6.1/ext/Socket/Socket.xs Sat Apr 7 23:09:16 2001 +++ AP633_source/ext/Socket/Socket.xs Mon Jun 17 21:28:00 2002 @@ -916,6 +916,19 @@ { struct in_addr ip_address; struct hostent * phe; +#if defined(USE_REENTRANT_API) + struct hostent he; + char buf[2048]; + int h_err = 0; +# if defined(__linux__) +# define gethostbyname(n) \ + (gethostbyname_r(n,&he,buf,sizeof(buf),&phe,&h_err),phe) +# else +# if defined(__sun__) +# define gethostbyname(n) gethostbyname_r(n,&he,buf,sizeof(buf),&h_err) +# endif +# endif +#endif int ok = inet_aton(host, &ip_address); if (!ok && (phe = gethostbyname(host))) { @@ -936,7 +949,7 @@ { STRLEN addrlen; struct in_addr addr; - char * addr_str; + SV *addr_sv; char * ip_address = SvPV(ip_address_sv,addrlen); if (addrlen != sizeof(addr)) { croak("Bad arg length for %s, length is %d, should be %d", @@ -944,10 +957,18 @@ addrlen, sizeof(addr)); } - Copy( ip_address, &addr, sizeof addr, char ); - addr_str = inet_ntoa(addr); - - ST(0) = sv_2mortal(newSVpvn(addr_str, strlen(addr_str))); + if (addrlen == 4) { + addr_sv = Perl_newSVpvf(aTHX_ "%vd", ip_address_sv); + } + else { + char * addr_str; + Copy( ip_address, &addr, sizeof addr, char ); + OP_REFCNT_LOCK; + addr_str = inet_ntoa(addr); + addr_sv = newSVpvn(addr_str, strlen(addr_str)); + OP_REFCNT_UNLOCK; + } + ST(0) = sv_2mortal(addr_sv); } void diff -ruN perl-5.6.1/ext/Sys/Syslog/Syslog.pm AP633_source/ext/Sys/Syslog/Syslog.pm --- perl-5.6.1/ext/Sys/Syslog/Syslog.pm Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/Sys/Syslog/Syslog.pm Mon Jun 17 21:28:00 2002 @@ -129,6 +129,7 @@ our $AUTOLOAD; ($constname = $AUTOLOAD) =~ s/.*:://; croak "& not defined" if $constname eq 'constant'; + local $! = 0; my $val = constant($constname); if ($! != 0) { croak "Your vendor has not defined Sys::Syslog macro $constname"; diff -ruN perl-5.6.1/ext/Thread/Thread/Queue.pm AP633_source/ext/Thread/Thread/Queue.pm --- perl-5.6.1/ext/Thread/Thread/Queue.pm Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/Thread/Thread/Queue.pm Mon Jun 17 21:28:00 2002 @@ -5,6 +5,10 @@ Thread::Queue - thread-safe queues +=head1 SUPPORTED PLATFORMS + +none + =head1 SYNOPSIS use Thread::Queue; diff -ruN perl-5.6.1/ext/Thread/Thread/Semaphore.pm AP633_source/ext/Thread/Thread/Semaphore.pm --- perl-5.6.1/ext/Thread/Thread/Semaphore.pm Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/Thread/Thread/Semaphore.pm Mon Jun 17 21:28:00 2002 @@ -5,6 +5,10 @@ Thread::Semaphore - thread-safe semaphores +=head1 SUPPORTED PLATFORMS + +none + =head1 SYNOPSIS use Thread::Semaphore; diff -ruN perl-5.6.1/ext/Thread/Thread/Signal.pm AP633_source/ext/Thread/Thread/Signal.pm --- perl-5.6.1/ext/Thread/Thread/Signal.pm Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/Thread/Thread/Signal.pm Mon Jun 17 21:28:00 2002 @@ -5,6 +5,10 @@ Thread::Signal - Start a thread which runs signal handlers reliably +=head1 SUPPORTED PLATFORMS + +none + =head1 SYNOPSIS use Thread::Signal; diff -ruN perl-5.6.1/ext/Thread/Thread/Specific.pm AP633_source/ext/Thread/Thread/Specific.pm --- perl-5.6.1/ext/Thread/Thread/Specific.pm Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/Thread/Thread/Specific.pm Mon Jun 17 21:28:00 2002 @@ -4,6 +4,10 @@ Thread::Specific - thread-specific keys +=head1 SUPPORTED PLATFORMS + +none + =head1 SYNOPSIS use Thread::Specific; diff -ruN perl-5.6.1/ext/Thread/Thread.pm AP633_source/ext/Thread/Thread.pm --- perl-5.6.1/ext/Thread/Thread.pm Sun Apr 8 17:31:55 2001 +++ AP633_source/ext/Thread/Thread.pm Mon Jun 17 21:28:00 2002 @@ -12,6 +12,10 @@ Thread - manipulate threads in Perl (EXPERIMENTAL, subject to change) +=head1 SUPPORTED PLATFORMS + +none + =head1 CAVEAT The Thread extension requires Perl to be built in a particular way to diff -ruN perl-5.6.1/ext/re/re.xs AP633_source/ext/re/re.xs --- perl-5.6.1/ext/re/re.xs Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/re/re.xs Mon Jun 17 21:28:01 2002 @@ -18,44 +18,59 @@ struct re_scream_pos_data_s *data); extern SV* my_re_intuit_string (pTHX_ regexp *prog); -static int oldfl; +#define MY_CXT_KEY "re::_guts" XS_VERSION + +typedef struct { + int x_oldflag; /* debug flag */ +} my_cxt_t; + +START_MY_CXT + +#define oldflag (MY_CXT.x_oldflag) #define R_DB 512 static void -deinstall(pTHX) +uninstall(pTHX) { + dMY_CXT; PL_regexecp = Perl_regexec_flags; PL_regcompp = Perl_pregcomp; PL_regint_start = Perl_re_intuit_start; PL_regint_string = Perl_re_intuit_string; PL_regfree = Perl_pregfree; - if (!oldfl) + if (!oldflag) PL_debug &= ~R_DB; } static void install(pTHX) { + dMY_CXT; PL_colorset = 0; /* Allow reinspection of ENV. */ PL_regexecp = &my_regexec; PL_regcompp = &my_regcomp; PL_regint_start = &my_re_intuit_start; PL_regint_string = &my_re_intuit_string; PL_regfree = &my_regfree; - oldfl = PL_debug & R_DB; + oldflag = PL_debug & R_DB; PL_debug |= R_DB; } MODULE = re PACKAGE = re +BOOT: +{ + MY_CXT_INIT; +} + void install() CODE: install(aTHX); void -deinstall() +uninstall() CODE: - deinstall(aTHX); + uninstall(aTHX); diff -ruN perl-5.6.1/ext/util/make_ext AP633_source/ext/util/make_ext --- perl-5.6.1/ext/util/make_ext Thu Feb 22 18:57:54 2001 +++ AP633_source/ext/util/make_ext Mon Jun 17 21:28:01 2002 @@ -88,7 +88,12 @@ # check link type and do any preliminaries case "$target" in # convert 'static' or 'dynamic' into 'all LINKTYPE=XXX' -static) makeargs="LINKTYPE=static CCCDLFLAGS=" +static) case "$mname" in + # For Apache, DynaLoader needs the CCCDLFLAGS variable + # (+z/+Z/-fpic/-fPIC) to stick around + *DynaLoader*) makeargs="LINKTYPE=static" ;; + *) makeargs="LINKTYPE=static CCCDLFLAGS=" ;; + esac target=all ;; dynamic) makeargs="LINKTYPE=dynamic"; diff -ruN perl-5.6.1/global.sym AP633_source/global.sym --- perl-5.6.1/global.sym Thu Apr 5 21:38:46 2001 +++ AP633_source/global.sym Mon Jun 17 21:28:01 2002 @@ -89,6 +89,10 @@ Perl_dounwind Perl_do_binmode Perl_do_close +Perl_do_exec +Perl_do_aspawn +Perl_do_spawn +Perl_do_spawn_nowait Perl_do_join Perl_do_open Perl_do_open9 @@ -227,6 +231,9 @@ Perl_my_exit Perl_my_failure_exit Perl_my_fflush_all +Perl_my_fork +Perl_atfork_lock +Perl_atfork_unlock Perl_my_lstat Perl_my_memcmp Perl_my_memset diff -ruN perl-5.6.1/globals.c AP633_source/globals.c --- perl-5.6.1/globals.c Thu Mar 15 07:25:20 2001 +++ AP633_source/globals.c Mon Jun 17 21:28:01 2002 @@ -54,20 +54,6 @@ } #endif -#ifdef WIN32 /* XXX why are these needed? */ -bool -Perl_do_exec(char *cmd) -{ - return PerlProc_Cmd(cmd); -} - -int -CPerlObj::do_aspawn(void *vreally, void **vmark, void **vsp) -{ - return PerlProc_aspawn(vreally, vmark, vsp); -} -#endif /* WIN32 */ - #endif /* PERL_OBJECT */ int diff -ruN perl-5.6.1/gv.c AP633_source/gv.c --- perl-5.6.1/gv.c Wed Mar 28 09:16:01 2001 +++ AP633_source/gv.c Mon Jun 17 21:28:01 2002 @@ -398,8 +398,8 @@ GV* Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) { - static char autoload[] = "AUTOLOAD"; - static STRLEN autolen = 8; + char autoload[] = "AUTOLOAD"; + STRLEN autolen = sizeof(autoload)-1; GV* gv; CV* cv; HV* varstash; @@ -1149,15 +1149,14 @@ MAGIC* mg=mg_find((SV*)stash,'c'); AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL; AMT amt; - STRLEN n_a; #ifdef OVERLOAD_VIA_HASH GV** gvp; HV* hv; #endif if (mg && amtp->was_ok_am == PL_amagic_generation - && amtp->was_ok_sub == PL_sub_generation) - return AMT_AMAGIC(amtp); + && amtp->was_ok_sub == (long)PL_sub_generation) + return (bool)AMT_AMAGIC(amtp); if (amtp && AMT_AMAGIC(amtp)) { /* Have table. */ int i; for (i=1; i&1 | $contains 'option' >/dev/null +''|cc) if cc $ccflags -Aa 2>&1 | $contains 'option' >/dev/null then cat <<'EOM' >&4 @@ -137,8 +137,8 @@ # up to date with new CPU/OS releases. xxcpu=`getconf CPU_VERSION`; # Get the number. xxcpu=`printf '0x%x' $xxcpu`; # convert to hex - archname=`sed -n -e "s/^#[ \t]*define[ \t]*CPU_//p" /usr/include/sys/unistd.h | - sed -n -e "s/[ \t]*$xxcpu[ \t].*//p" | + archname=`sed -n -e "s/^#[ ]*define[ ]*CPU_//p" /usr/include/sys/unistd.h | + sed -n -e "s/[ ]*$xxcpu[ ].*//p" | sed -e s/_RISC/-RISC/ -e s/HP_// -e s/_/./`; else # This system is running <= 9.x @@ -169,22 +169,24 @@ # Without the 64-bit libc we cannot do much. libc='/lib/pa20_64/libc.sl' - if [ ! -f "$libc" ]; then - cat <&4 - -*** You do not seem to have the 64-bit libraries in /lib/pa20_64. -*** Most importantly, I cannot find the $libc. -*** Cannot continue, aborting. -EOM - exit 1 +# if [ ! -f "$libc" ]; then +# cat <&4 +# +#*** You do not seem to have the 64-bit libraries in /lib/pa20_64. +#*** Most importantly, I cannot find the $libc. +#*** Cannot continue, aborting. +#EOM +# exit 1 +# fi + + if test -z "$ccisgcc"; then + ccflags="$ccflags +DD64" + ldflags="$ldflags +DD64" fi - - ccflags="$ccflags +DD64" - ldflags="$ldflags +DD64" test -d /lib/pa20_64 && loclibpth="$loclibpth /lib/pa20_64" libswanted="$libswanted pthread" libscheck='case "`/usr/bin/file $xxx`" in -*LP64*|*PA-RISC2.0*) ;; +*LP64*|*PA-RISC2.0*|*IA64*) ;; *) xxx=/no/64-bit$xxx ;; esac' if test -n "$ccisgcc" -o -n "$gccversion"; then @@ -211,10 +213,53 @@ esac case "$ccisgcc" in -# Even if you use gcc, prefer the HP math library over the GNU one. -"$define") test -d /lib/pa1.1 && ccflags="$ccflags -L/lib/pa1.1" ;; +"$define") + case "$archname" in + IA64*) + case "$use64bitint" in + $define|true|[yY]*) + ccflags="$ccflags -mlp64 -L/lib/hpux64" + ldflags="$ldflags -mlp64" + lddlflags='-mlp64 -shared' + libpth="/lib/hpux64" + loclibpth="/usr/local/lib/hpux64 /lib/hpux64 $loclibpth" + libc='/lib/hpux64/libc.so' + set `echo " $libswanted " | sed -e 's@ nm @ @'` + libswanted="$*" + ;; + *) + ccflags="$ccflags -L/lib/hpux32" + lddlflags='-shared' + loclibpth="/usr/local/lib/hpux32 /lib/hpux32 $loclibpth" + libc='/lib/hpux32/libc.so' + # no odbm libs + i_dbm=$undef + ;; + esac + so="so" + dlext="$so" + ;; + *) # PA_RISC + case "$use64bitint" in + $define|true|[yY]*) + #ccflags="$ccflags -mlp64 -L/lib/pa20_64" + #ldflags="$ldflags -mlp64" + #lddlflags='-mlp64 -shared' + lddlflags='-shared' + test -d /lib/pa20_64 && ccflags="$ccflags -L/lib/pa20_64" + ;; + *) + # Even if you use gcc, prefer the HP math library over the GNU one. + test -d /lib/pa1.1 && ccflags="$ccflags -L/lib/pa1.1" + # the version of gcc we have doesn't do -shared, but uses -b, + # which is the default + ;; + esac + ;; + esac + ;; esac - + case "$ccisgcc" in "$define") ;; *) case "`getconf KERNEL_BITS 2>/dev/null`" in @@ -246,7 +291,8 @@ # adding the "nonfatal" option. # ccdlflags="-Wl,-E -Wl,-B,immediate $ccdlflags" # ccdlflags="-Wl,-E -Wl,-B,immediate,-B,nonfatal $ccdlflags" -ccdlflags="-Wl,-E -Wl,-B,deferred $ccdlflags" +ccdlflags="-Wl,-E $ccdlflags" +#ccdlflags="-Wl,-E -Wl,-B,deferred $ccdlflags" case "$usemymalloc" in '') usemymalloc='y' ;; @@ -257,7 +303,11 @@ nm_opt='-p' # When HP-UX runs a script with "#!", it sets argv[0] to the script name. +case "$toke_cflags" in +'') toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"' + ;; +esac # If your compile complains about FLT_MIN, uncomment the next line # POSIX_cflags='ccflags="$ccflags -DFLT_MIN=1.17549435E-38"' @@ -391,6 +441,7 @@ ;; 11 | 12) # 12 may want upping the _POSIX_C_SOURCE datestamp... ccflags=" -D_POSIX_C_SOURCE=199506L $ccflags" + ccflags="-DUSE_REENTRANT_API $ccflags" set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` shift libswanted="$*" @@ -403,13 +454,19 @@ case "$uselargefiles-$ccisgcc" in "$define-$define"|'-define') - cat <&4 + case `$cc --version`"" in + # newer gcc versions support this + 2.9-hppa*|3*) ;; + *) + cat <&4 *** I'm ignoring large files for this build because -*** I don't know how to do use large files in HP-UX using gcc. +*** I don't know how to do use large files in HP-UX using gcc $gccversion. EOM - uselargefiles="$undef" + uselargefiles="$undef" + ;; + esac ;; esac diff -ruN perl-5.6.1/hints/linux.sh AP633_source/hints/linux.sh --- perl-5.6.1/hints/linux.sh Thu Feb 22 18:57:55 2001 +++ AP633_source/hints/linux.sh Mon Jun 17 21:28:01 2002 @@ -269,7 +269,8 @@ cat > UU/usethreads.cbu <<'EOCBU' case "$usethreads" in $define|true|[yY]*) - ccflags="-D_REENTRANT $ccflags" + ccflags="-D_GNU_SOURCE -D_REENTRANT $ccflags" + ccflags="-DUSE_REENTRANT_API $ccflags" set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` shift libswanted="$*" diff -ruN perl-5.6.1/hints/solaris_2.sh AP633_source/hints/solaris_2.sh --- perl-5.6.1/hints/solaris_2.sh Thu Feb 22 18:57:55 2001 +++ AP633_source/hints/solaris_2.sh Mon Jun 17 21:28:01 2002 @@ -1,5 +1,5 @@ # hints/solaris_2.sh -# Last modified: Tue Jan 2 10:16:35 2001 +# Last modified: Mon Jan 29 12:52:28 2001 # Lupe Christoph # Based on version by: # Andy Dougherty @@ -26,9 +26,16 @@ # these ought to be harmless. See below for more details. # See man vfork. -usevfork=false +usevfork=${usevfork:-false} -d_suidsafe=define +# Solaris has secure SUID scripts +d_suidsafe=${d_suidsafe:-define} + +# Several people reported problems with perl's malloc, especially +# when use64bitall is defined or when using gcc. +# http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-01/msg01318.html +# http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-01/msg00465.html +usemymalloc=${usemymalloc:-false} # Avoid all libraries in /usr/ucblib. # /lib is just a symlink to /usr/lib @@ -335,7 +342,10 @@ # after it has prompted the user for whether to use threads. case "$usethreads" in $define|true|[yY]*) - ccflags="-D_REENTRANT $ccflags" + # -D_POSIX_C_SOURCE=199506L doesn't compile with gcc 2.95.2 :-( + #ccflags="-D_POSIX_C_SOURCE=199506L -D_REENTRANT $ccflags" + ccflags="-D_POSIX_PTHREAD_SEMANTICS -D_REENTRANT $ccflags" + ccflags="-DUSE_REENTRANT_API $ccflags" # sched_yield is in -lposix4 up to Solaris 2.6, in -lrt starting with Solaris 2.7 case `uname -r` in diff -ruN perl-5.6.1/hints/svr5.sh AP633_source/hints/svr5.sh --- perl-5.6.1/hints/svr5.sh Thu Feb 22 18:57:55 2001 +++ AP633_source/hints/svr5.sh Mon Jun 17 21:28:01 2002 @@ -83,7 +83,7 @@ # remove /shlib and /lib from library search path as both symlink to /usr/lib # where runtime shared libc is -glibpth=`echo " $glibpth " | sed -e 's/ \/shlib / /' -e 's/ \/lib / /` +glibpth=`echo " $glibpth " | sed -e 's/ \/shlib / /' -e 's/ \/lib / /'` # Don't use BSD emulation pieces (/usr/ucblib) regardless # these would probably be autonondetected anyway but ... @@ -156,8 +156,10 @@ # cccdlflags: must tell the compiler to generate relocatable code # lddlflags : must tell the linker to output a shared library -# use shared perl lib -useshrplib='true' +# use shared perl lib if the user doesn't choose otherwise +if test "x$useshrplib" = "x"; then + useshrplib='true' +fi case "$cc" in *gcc*) diff -ruN perl-5.6.1/hv.c AP633_source/hv.c --- perl-5.6.1/hv.c Wed Mar 21 21:05:02 2001 +++ AP633_source/hv.c Mon Jun 17 21:28:01 2002 @@ -188,7 +188,7 @@ for (; entry; entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -296,7 +296,7 @@ for (; entry; entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -399,7 +399,7 @@ for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -420,7 +420,7 @@ xhv->xhv_keys++; if (i) { /* initial entry? */ ++xhv->xhv_fill; - if (xhv->xhv_keys > xhv->xhv_max) + if (xhv->xhv_keys > (IV)xhv->xhv_max) hsplit(hv); } @@ -499,7 +499,7 @@ for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -520,7 +520,7 @@ xhv->xhv_keys++; if (i) { /* initial entry? */ ++xhv->xhv_fill; - if (xhv->xhv_keys > xhv->xhv_max) + if (xhv->xhv_keys > (IV)xhv->xhv_max) hsplit(hv); } @@ -586,7 +586,7 @@ for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -673,7 +673,7 @@ for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -747,7 +747,7 @@ for (; entry; entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -827,7 +827,7 @@ for (; entry; entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -894,7 +894,7 @@ continue; bep = aep+oldsize; for (oentry = aep, entry = *aep; entry; entry = *oentry) { - if ((HeHASH(entry) & newsize) != i) { + if ((HeHASH(entry) & newsize) != (U32)i) { *oentry = HeNEXT(entry); HeNEXT(entry) = *bep; if (!*bep) @@ -1280,7 +1280,7 @@ entry = HeNEXT(entry); while (!entry) { ++xhv->xhv_riter; - if (xhv->xhv_riter > xhv->xhv_max) { + if (xhv->xhv_riter > (I32)xhv->xhv_max) { xhv->xhv_riter = -1; break; } @@ -1489,7 +1489,7 @@ xhv->xhv_keys++; if (i) { /* initial entry? */ ++xhv->xhv_fill; - if (xhv->xhv_keys > xhv->xhv_max) + if (xhv->xhv_keys > (IV)xhv->xhv_max) hsplit(PL_strtab); } } diff -ruN perl-5.6.1/iperlsys.h AP633_source/iperlsys.h --- perl-5.6.1/iperlsys.h Thu Mar 15 07:25:20 2001 +++ AP633_source/iperlsys.h Mon Jun 17 21:28:01 2002 @@ -692,11 +692,6 @@ #define PerlEnv_putenv(str) putenv((str)) #define PerlEnv_getenv(str) getenv((str)) #define PerlEnv_getenv_len(str,l) getenv_len((str), (l)) -#define PerlEnv_clearenv() clearenv() -#define PerlEnv_get_childenv() get_childenv() -#define PerlEnv_free_childenv(e) free_childenv((e)) -#define PerlEnv_get_childdir() get_childdir() -#define PerlEnv_free_childdir(d) free_childdir((d)) #ifdef HAS_ENVGETENV # define PerlEnv_ENVgetenv(str) ENVgetenv((str)) # define PerlEnv_ENVgetenv_len(str,l) ENVgetenv_len((str), (l)) @@ -712,6 +707,17 @@ #define PerlEnv_sitelib_path(str) win32_get_sitelib(str) #define PerlEnv_vendorlib_path(str) win32_get_vendorlib(str) #define PerlEnv_get_child_IO(ptr) win32_get_child_IO(ptr) +#define PerlEnv_clearenv() win32_clearenv() +#define PerlEnv_get_childenv() win32_get_childenv() +#define PerlEnv_free_childenv(e) win32_free_childenv((e)) +#define PerlEnv_get_childdir() win32_get_childdir() +#define PerlEnv_free_childdir(d) win32_free_childdir((d)) +#else +#define PerlEnv_clearenv() clearenv() +#define PerlEnv_get_childenv() get_childenv() +#define PerlEnv_free_childenv(e) free_childenv((e)) +#define PerlEnv_get_childdir() get_childdir() +#define PerlEnv_free_childdir(d) free_childdir((d)) #endif #endif /* PERL_IMPLICIT_SYS */ @@ -1050,12 +1056,8 @@ typedef void* (*LPProcDynaLoader)(struct IPerlProc*, const char*); typedef void (*LPProcGetOSError)(struct IPerlProc*, SV* sv, DWORD dwErr); -typedef void (*LPProcFreeBuf)(struct IPerlProc*, char*); -typedef BOOL (*LPProcDoCmd)(struct IPerlProc*, char*); -typedef int (*LPProcSpawn)(struct IPerlProc*, char*); typedef int (*LPProcSpawnvp)(struct IPerlProc*, int, const char*, const char*const*); -typedef int (*LPProcASpawn)(struct IPerlProc*, void*, void**, void**); #endif struct IPerlProc @@ -1090,10 +1092,10 @@ #ifdef WIN32 LPProcDynaLoader pDynaLoader; LPProcGetOSError pGetOSError; - LPProcDoCmd pDoCmd; - LPProcSpawn pSpawn; - LPProcSpawnvp pSpawnvp; - LPProcASpawn pASpawn; + void * __unused1; /* XXX unused, retained for bincompat */ + void * __unused2; + LPProcSpawnvp pSpawnvp; /* XXX unused, retained for bincompat */ + void * __unused3; /* XXX unused, retained for bincompat */ #endif }; @@ -1165,14 +1167,8 @@ (*PL_Proc->pDynaLoader)(PL_Proc, (f)) #define PerlProc_GetOSError(s,e) \ (*PL_Proc->pGetOSError)(PL_Proc, (s), (e)) -#define PerlProc_Cmd(s) \ - (*PL_Proc->pDoCmd)(PL_Proc, (s)) -#define do_spawn(s) \ - (*PL_Proc->pSpawn)(PL_Proc, (s)) -#define do_spawnvp(m, c, a) \ +#define PerlProc_spawnvp(m, c, a) \ (*PL_Proc->pSpawnvp)(PL_Proc, (m), (c), (a)) -#define PerlProc_aspawn(m,c,a) \ - (*PL_Proc->pASpawn)(PL_Proc, (m), (c), (a)) #endif #else /* PERL_IMPLICIT_SYS */ @@ -1205,7 +1201,7 @@ #define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) #define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) #define PerlProc_signal(n, h) signal((n), (h)) -#define PerlProc_fork() fork() +#define PerlProc_fork() my_fork() #define PerlProc_getpid() getpid() #ifdef WIN32 @@ -1213,6 +1209,8 @@ win32_dynaload((f)) #define PerlProc_GetOSError(s,e) \ win32_str_os_error((s), (e)) +#define PerlProc_spawnvp(m, c, a) \ + win32_spawnvp((m), (c), (a)) #endif #endif /* PERL_IMPLICIT_SYS */ diff -ruN perl-5.6.1/lib/AutoLoader.pm AP633_source/lib/AutoLoader.pm --- perl-5.6.1/lib/AutoLoader.pm Thu Feb 22 18:57:55 2001 +++ AP633_source/lib/AutoLoader.pm Mon Jun 17 21:28:01 2002 @@ -245,6 +245,7 @@ sub AUTOLOAD { my $sub = $AUTOLOAD; (my $constname = $sub) =~ s/.*:://; + local $! = 0; my $val = constant($constname, @_ ? $_[0] : 0); if ($! != 0) { if ($! =~ /Invalid/ || $!{EINVAL}) { diff -ruN perl-5.6.1/lib/AutoSplit.pm AP633_source/lib/AutoSplit.pm --- perl-5.6.1/lib/AutoSplit.pm Thu Feb 22 18:57:55 2001 +++ AP633_source/lib/AutoSplit.pm Mon Jun 17 21:28:01 2002 @@ -54,7 +54,7 @@ The fourth argument, I<$check>, instructs C to check the module -currently being split to ensure that it does include a C +currently being split to ensure that it includes a C specification for the AutoLoader module, and skips the module if AutoLoader is not detected. $check defaults to 1. @@ -338,13 +338,14 @@ if ($Verbose>=1); } push(@outfiles, $path); + my $lineno = $fnr - @cache; print OUT <$expires) if $expires; push(@param,'-secure'=>$secure) if $secure; - return new CGI::Cookie(@param); + return CGI::Cookie->new(@param); } END_OF_FUNC diff -ruN perl-5.6.1/lib/Carp/Heavy.pm AP633_source/lib/Carp/Heavy.pm --- perl-5.6.1/lib/Carp/Heavy.pm Thu Feb 22 18:57:55 2001 +++ AP633_source/lib/Carp/Heavy.pm Mon Jun 17 21:28:01 2002 @@ -53,7 +53,7 @@ # subsequent times: $mess .= $sub $error at $file line $line # ^^^^^^ # "called" - if ($error =~ m/\n$/) { + if ($error =~ m/\n\z/) { $mess .= $error; } else { # Build a string, $sub, which names the sub-routine called. @@ -226,12 +226,18 @@ # OK! We've got a candidate package. Time to construct the # relevant error message and return it. my $msg; - $msg = "$error at $file line $line"; - if (defined &Thread::tid) { - my $tid = Thread->self->tid; - $msg .= " thread $tid" if $tid; + # make sure we don't add debug info if it ends with a newline + if ($error =~ /\n\z/) { + $msg = $error; + } + else { + $msg = "$error at $file line $line"; + if (defined &Thread::tid) { + my $tid = Thread->self->tid; + $msg .= " thread $tid" if $tid; + } + $msg .= "\n"; } - $msg .= "\n"; return $msg; } } diff -ruN perl-5.6.1/lib/Devel/SelfStubber.pm AP633_source/lib/Devel/SelfStubber.pm --- perl-5.6.1/lib/Devel/SelfStubber.pm Thu Feb 22 18:57:55 2001 +++ AP633_source/lib/De