This patch describes the changes made in ActivePerl build 635 over the official Perl v5.6.1 sources from CPAN. Summary of changes in build 635: * 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 AP635_source/BuildInfo.h --- perl-5.6.1/BuildInfo.h Wed Dec 31 16:00:00 1969 +++ AP635_source/BuildInfo.h Tue Feb 4 22:51:59 2003 @@ -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 "635" +#define PERLFILEVERSION "5,6,1,635\0" +#define PERLRC_VERSION 5,6,1,635 +#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 AP635_source/Configure --- perl-5.6.1/Configure Sun Mar 18 19:03:33 2001 +++ AP635_source/Configure Tue Feb 4 22:52:04 2003 @@ -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 < testcompile; cd utils; $(MAKE) compile; @@ -322,6 +324,7 @@ # Phony target to force checking subdirectories. # Apparently some makes require an action for the FORCE target. +.PHONY: FORCE FORCE: @sh -c true !NO!SUBS! @@ -533,6 +536,7 @@ # We have to call our ./makedir because Ultrix 4.3 make can't handle the line # test -d lib/auto || mkdir lib/auto # +.PHONY: preplibrary preplibrary: miniperl lib/Config.pm @sh ./makedir lib/auto @echo " AutoSplitting perl library" @@ -567,6 +571,9 @@ done -@test -f vms/perlvms.pod && cd pod && $(LNS) ../vms/perlvms.pod perlvms.pod && cd .. && echo "pod/perlvms.pod" >> extra.pods +.PHONY: install install-strip install-all install-verbose install-silent \ + no-install install.perl install.man install.html + install-strip: $(MAKE) STRIPFLAGS=-s install @@ -616,6 +623,8 @@ # to run with precisely the same version of byacc as I use. You # normally shouldn't remake perly.[ch]. +.PHONY: run_byacc + run_byacc: FORCE $(BYACC) -d perly.y -chmod 664 perly.c perly.h @@ -668,6 +677,8 @@ warnings.h lib/warnings.pm \ vms/perly_c.vms vms/perly_h.vms +.PHONY: regen_headers regen_pods regen_all + regen_headers: FORCE -$(CHMOD_W) $(AUTOGEN_FILES) -perl keywords.pl @@ -707,6 +718,10 @@ n_dummy $(nonxs_ext): miniperl preplibrary $(DYNALOADER) FORCE @$(LDLIBPTH) sh ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) +.PHONY: clean _tidy _mopup _cleaner1 _cleaner2 \ + realclean _realcleaner clobber _clobber \ + distclean veryclean _verycleaner + clean: _tidy _mopup realclean: _realcleaner _mopup @@ -778,6 +793,7 @@ # If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message # for that spot. +.PHONY: lint lint: $(c) lint $(lintflags) $(defs) perly.c $(c) > perl.fuzz @@ -794,6 +810,7 @@ $(SHELL) config_h.SH # When done, touch perlmain.c so that it doesn't get remade each time. +.PHONY: depend depend: makedepend sh ./makedepend MAKE=$(MAKE) - test -s perlmain.c && touch perlmain.c @@ -803,6 +820,13 @@ makedepend: makedepend.SH config.sh sh ./makedepend.SH +.PHONY: test check test_prep test_prep_nodll test_prep_pre _test_prep \ + test_tty test-tty _test_tty test_notty test-notty _test_notty \ + utest ucheck test.utf8 check.utf8 test.torture torturetest \ + test.third check.third utest.third ucheck.third test_notty.third \ + test.deparse test_notty.deparse \ + minitest coretest + # Cannot delegate rebuilding of t/perl to make to allow interlaced # test and minitest test-prep: miniperl perl preplibrary utilities $(dynamic_ext) $(nonxs_ext) $(TEST_PERL_DLL) @@ -841,6 +865,9 @@ # installed perlbug. We don't re-run the tests here - we trust the user. # Please *don't* use this unless all tests pass. # If you want to report test failures, use "make nok" instead. + +.PHONY: ok okfile oknack okfilenack nok nokfile noknack nokfilenack + ok: utilities $(LDLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)' @@ -865,6 +892,8 @@ nokfilenack: utilities $(LDLIBPTH) ./perl -Ilib utils/perlbug -nok -s '(UNINSTALLED)' -F perl.nok -A +.PHONY: clist hlist shlist pllist + clist: $(c) echo $(c) | tr ' ' $(TRNL) >.clist @@ -880,13 +909,17 @@ Makefile: Makefile.SH ./config.sh $(SHELL) Makefile.SH +.PHONY: distcheck distcheck: FORCE perl '-MExtUtils::Manifest=&fullcheck' -e 'fullcheck()' +.PHONY: elc elc: emacs/cperl-mode.elc emacs/cperl-mode.elc: emacs/cperl-mode.el -cd emacs; emacs -batch -q -no-site-file -f batch-byte-compile cperl-mode.el + +.PHONY: etags etags: TAGS diff -ruN perl-5.6.1/Porting/Glossary AP635_source/Porting/Glossary --- perl-5.6.1/Porting/Glossary Sat Mar 3 11:53:20 2001 +++ AP635_source/Porting/Glossary Tue Feb 4 22:52:04 2003 @@ -1171,6 +1171,11 @@ The 'U' in the name is to separate this from d_PRIx64 so that even case-blind systems can see the difference. +d_pthread_atfork (d_pthread_atfork.U): + This variable conditionally defines the HAS_PTHREAD_ATFORK symbol, + which indicates to the C program that the pthread_atfork() + routine is available. + d_pthread_yield (d_pthread_y.U): This variable conditionally defines the HAS_PTHREAD_YIELD symbol if the pthread_yield routine is available to yield diff -ruN perl-5.6.1/Porting/config.sh AP635_source/Porting/config.sh --- perl-5.6.1/Porting/config.sh Sat Mar 3 11:53:20 2001 +++ AP635_source/Porting/config.sh Tue Feb 4 22:52:04 2003 @@ -267,6 +267,7 @@ d_pipe='define' d_poll='define' d_portable='define' +d_pthread_atfork='define' d_pthread_yield='undef' d_pwage='undef' d_pwchange='undef' diff -ruN perl-5.6.1/Porting/config_H AP635_source/Porting/config_H --- perl-5.6.1/Porting/config_H Sat Mar 3 11:53:20 2001 +++ AP635_source/Porting/config_H Tue Feb 4 22:52:04 2003 @@ -3220,4 +3220,10 @@ */ #define HAS_SBRK_PROTO /**/ +/* HAS_PTHREAD_ATFORK: + * This symbol, if defined, indicates that the pthread_atfork routine + * is available setup fork handlers. + */ +#define HAS_PTHREAD_ATFORK /**/ + #endif diff -ruN perl-5.6.1/Todo-5.6 AP635_source/Todo-5.6 --- perl-5.6.1/Todo-5.6 Tue Mar 20 09:40:22 2001 +++ AP635_source/Todo-5.6 Tue Feb 4 22:52:05 2003 @@ -139,7 +139,6 @@ make Thread::Signal work under useithreads Win32 stuff - sort out the spawnvp() mess for system('a','b','c') compatibility work out DLL versioning Miscellaneous diff -ruN perl-5.6.1/XSUB.h AP635_source/XSUB.h --- perl-5.6.1/XSUB.h Thu Feb 22 18:57:53 2001 +++ AP635_source/XSUB.h Tue Feb 4 22:52:05 2003 @@ -394,6 +394,18 @@ # define shutdown PerlSock_shutdown # define socket PerlSock_socket # define socketpair PerlSock_socketpair +# ifdef USE_SOCKETS_AS_HANDLES +# undef fd_set +# undef FD_SET +# undef FD_CLR +# undef FD_ISSET +# undef FD_ZERO +# define fd_set Perl_fd_set +# define FD_SET(n,p) PERL_FD_SET(n,p) +# define FD_CLR(n,p) PERL_FD_CLR(n,p) +# define FD_ISSET(n,p) PERL_FD_ISSET(n,p) +# define FD_ZERO(p) PERL_FD_ZERO(p) +# endif /* USE_SOCKETS_AS_HANDLES */ # endif /* NO_XSLOCKS */ #endif /* PERL_CAPI */ diff -ruN perl-5.6.1/av.c AP635_source/av.c --- perl-5.6.1/av.c Wed Mar 21 21:05:02 2001 +++ AP635_source/av.c Tue Feb 4 22:52:05 2003 @@ -115,7 +115,7 @@ bytes = (newmax + 1) * sizeof(SV*); #define MALLOC_OVERHEAD 16 itmp = MALLOC_OVERHEAD; - while (itmp - MALLOC_OVERHEAD < bytes) + while ((MEM_SIZE)(itmp - MALLOC_OVERHEAD) < bytes) itmp += itmp; itmp -= MALLOC_OVERHEAD; itmp /= sizeof(SV*); @@ -760,6 +760,7 @@ else { sv = AvARRAY(av)[key]; if (key == AvFILLp(av)) { + AvARRAY(av)[key] = &PL_sv_undef; do { AvFILLp(av)--; } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef); diff -ruN perl-5.6.1/config_h.SH AP635_source/config_h.SH --- perl-5.6.1/config_h.SH Sat Mar 3 11:53:20 2001 +++ AP635_source/config_h.SH Tue Feb 4 22:52:05 2003 @@ -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 AP635_source/configure.com --- perl-5.6.1/configure.com Sat Mar 3 11:53:20 2001 +++ AP635_source/configure.com Tue Feb 4 22:52:05 2003 @@ -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 AP635_source/cop.h --- perl-5.6.1/cop.h Wed Mar 21 21:05:02 2001 +++ AP635_source/cop.h Tue Feb 4 22:52:05 2003 @@ -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 AP635_source/doio.c --- perl-5.6.1/doio.c Wed Mar 21 21:05:02 2001 +++ AP635_source/doio.c Tue Feb 4 22:52:05 2003 @@ -51,6 +51,81 @@ #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__) +# if defined(_LP64) + /* On solaris, if _LP64 is defined, the FILE structure is this: + * + * struct FILE { + * long __pad[16]; + * }; + * + * It turns out that the fd is stored in the top 32 bits of + * file->__pad[4]. The lower 32 bits contain flags. file->pad[5] appears + * to contain a pointer or offset into another structure. All the + * remaining fields are zero. + * + * We set the top bits to -1 (0xFFFFFFFF). + */ + ((FILE*)f)->__pad[4] |= 0xffffffff00000000L; + assert(PerlIO_fileno(f) == 0xffffffff); +# else /* !defined(_LP64) */ + /* _file is just a char :-( */ + ((FILE*)f)->_file = PerlLIO_dup(fd); +# endif /* defined(_LP64) */ +# elif defined(__hpux) + ((FILE*)f)->__fileH = 0xff; + ((FILE*)f)->__fileL = 0xff; +# elif defined(__FreeBSD__) || defined(__APPLE__) + ((FILE*)f)->_file = -1; +# elif defined(WIN32) +# if defined(__BORLANDC__) + ((FILE*)f)->fd = PerlLIO_dup(fd); +# else + ((FILE*)f)->_file = -1; +# endif +# elif defined(_AIX) + ((FILE*)f)->_file = -1; +# 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 +174,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 +530,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 +872,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 +946,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 +1485,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 AP635_source/doop.c --- perl-5.6.1/doop.c Thu Apr 5 21:38:46 2001 +++ AP635_source/doop.c Tue Feb 4 22:52:05 2003 @@ -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 AP635_source/dump.c --- perl-5.6.1/dump.c Wed Mar 21 21:05:02 2001 +++ AP635_source/dump.c Tue Feb 4 22:52:06 2003 @@ -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 AP635_source/embed.h --- perl-5.6.1/embed.h Thu Apr 5 21:38:46 2001 +++ AP635_source/embed.h Tue Feb 4 22:52:07 2003 @@ -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 AP635_source/embed.pl --- perl-5.6.1/embed.pl Thu Apr 5 21:38:46 2001 +++ AP635_source/embed.pl Tue Feb 4 22:52:07 2003 @@ -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 AP635_source/epoc/config.sh --- perl-5.6.1/epoc/config.sh Sat Mar 3 11:53:20 2001 +++ AP635_source/epoc/config.sh Tue Feb 4 22:52:07 2003 @@ -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 AP635_source/ext/B/B.xs --- perl-5.6.1/ext/B/B.xs Thu Apr 5 21:38:46 2001 +++ AP635_source/ext/B/B.xs Tue Feb 4 22:52:07 2003 @@ -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 AP635_source/ext/DB_File/DB_File.pm --- perl-5.6.1/ext/DB_File/DB_File.pm Thu Feb 22 18:57:53 2001 +++ AP635_source/ext/DB_File/DB_File.pm Tue Feb 4 22:52:07 2003 @@ -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 AP635_source/ext/DB_File/DB_File.xs --- perl-5.6.1/ext/DB_File/DB_File.xs Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/DB_File/DB_File.xs Tue Feb 4 22:52:07 2003 @@ -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/DProf/DProf.xs AP635_source/ext/Devel/DProf/DProf.xs --- perl-5.6.1/ext/Devel/DProf/DProf.xs Thu Apr 5 21:38:46 2001 +++ AP635_source/ext/Devel/DProf/DProf.xs Tue Feb 4 22:52:08 2003 @@ -280,7 +280,7 @@ SV *Sub = GvSV(PL_DBsub); /* name of current sub */ if (g_SAVE_STACK) { - if (g_profstack_ix + 5 > g_profstack_max) { + if (g_profstack_ix + 10 > g_profstack_max) { g_profstack_max = g_profstack_max * 3 / 2; Renew(g_profstack, g_profstack_max, PROFANY); } diff -ruN perl-5.6.1/ext/Devel/Peek/Peek.xs AP635_source/ext/Devel/Peek/Peek.xs --- perl-5.6.1/ext/Devel/Peek/Peek.xs Thu Apr 5 21:38:46 2001 +++ AP635_source/ext/Devel/Peek/Peek.xs Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/DynaLoader/dl_beos.xs --- perl-5.6.1/ext/DynaLoader/dl_beos.xs Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/DynaLoader/dl_beos.xs Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/DynaLoader/dl_dld.xs --- perl-5.6.1/ext/DynaLoader/dl_dld.xs Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/DynaLoader/dl_dld.xs Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/DynaLoader/dl_dllload.xs --- perl-5.6.1/ext/DynaLoader/dl_dllload.xs Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/DynaLoader/dl_dllload.xs Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/DynaLoader/dl_dlopen.xs --- perl-5.6.1/ext/DynaLoader/dl_dlopen.xs Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/DynaLoader/dl_dlopen.xs Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/DynaLoader/dl_dyld.xs --- perl-5.6.1/ext/DynaLoader/dl_dyld.xs Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/DynaLoader/dl_dyld.xs Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/DynaLoader/dl_hpux.xs --- perl-5.6.1/ext/DynaLoader/dl_hpux.xs Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/DynaLoader/dl_hpux.xs Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/DynaLoader/dl_mac.xs --- perl-5.6.1/ext/DynaLoader/dl_mac.xs Sun Mar 18 19:03:34 2001 +++ AP635_source/ext/DynaLoader/dl_mac.xs Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/DynaLoader/dl_mpeix.xs --- perl-5.6.1/ext/DynaLoader/dl_mpeix.xs Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/DynaLoader/dl_mpeix.xs Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/DynaLoader/dl_next.xs --- perl-5.6.1/ext/DynaLoader/dl_next.xs Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/DynaLoader/dl_next.xs Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/DynaLoader/dl_vmesa.xs --- perl-5.6.1/ext/DynaLoader/dl_vmesa.xs Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/DynaLoader/dl_vmesa.xs Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/DynaLoader/dl_vms.xs --- perl-5.6.1/ext/DynaLoader/dl_vms.xs Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/DynaLoader/dl_vms.xs Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/DynaLoader/dlutils.c --- perl-5.6.1/ext/DynaLoader/dlutils.c Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/DynaLoader/dlutils.c Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/Fcntl/Fcntl.pm --- perl-5.6.1/ext/Fcntl/Fcntl.pm Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/Fcntl/Fcntl.pm Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/File/Glob/Glob.pm --- perl-5.6.1/ext/File/Glob/Glob.pm Sun Apr 1 22:18:41 2001 +++ AP635_source/ext/File/Glob/Glob.pm Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/File/Glob/Glob.xs --- perl-5.6.1/ext/File/Glob/Glob.xs Thu Apr 5 21:38:46 2001 +++ AP635_source/ext/File/Glob/Glob.xs Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/File/Glob/bsd_glob.c --- perl-5.6.1/ext/File/Glob/bsd_glob.c Sun Apr 1 22:18:41 2001 +++ AP635_source/ext/File/Glob/bsd_glob.c Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/File/Glob/bsd_glob.h --- perl-5.6.1/ext/File/Glob/bsd_glob.h Tue Mar 20 09:39:30 2001 +++ AP635_source/ext/File/Glob/bsd_glob.h Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/GDBM_File/GDBM_File.pm --- perl-5.6.1/ext/GDBM_File/GDBM_File.pm Mon Mar 19 00:11:17 2001 +++ AP635_source/ext/GDBM_File/GDBM_File.pm Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/IO/lib/IO/Pipe.pm --- perl-5.6.1/ext/IO/lib/IO/Pipe.pm Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/IO/lib/IO/Pipe.pm Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/IO/lib/IO/Seekable.pm --- perl-5.6.1/ext/IO/lib/IO/Seekable.pm Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/IO/lib/IO/Seekable.pm Tue Feb 4 22:52:08 2003 @@ -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/lib/IO/Socket/INET.pm AP635_source/ext/IO/lib/IO/Socket/INET.pm --- perl-5.6.1/ext/IO/lib/IO/Socket/INET.pm Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/IO/lib/IO/Socket/INET.pm Tue Feb 4 22:52:08 2003 @@ -84,7 +84,8 @@ my $err = shift; { local($!); - $@ = join("",ref($sock),": ",@_); + my $title = ref($sock).": "; + $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_); close($sock) if(defined fileno($sock)); } @@ -189,12 +190,13 @@ # my $timeout = ${*$sock}{'io_socket_timeout'}; # my $before = time() if $timeout; + $@ = ""; if ($sock->connect(pack_sockaddr_in($rport, $raddr))) { # ${*$sock}{'io_socket_timeout'} = $timeout; return $sock; } - return _error($sock, $!, "Timeout") + return _error($sock, $!, $@ || "Timeout") unless @raddr; # if ($timeout) { diff -ruN perl-5.6.1/ext/IO/poll.c AP635_source/ext/IO/poll.c --- perl-5.6.1/ext/IO/poll.c Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/IO/poll.c Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/ODBM_File/ODBM_File.xs --- perl-5.6.1/ext/ODBM_File/ODBM_File.xs Sat Mar 3 11:53:20 2001 +++ AP635_source/ext/ODBM_File/ODBM_File.xs Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/Opcode/Opcode.xs --- perl-5.6.1/ext/Opcode/Opcode.xs Thu Apr 5 21:38:46 2001 +++ AP635_source/ext/Opcode/Opcode.xs Tue Feb 4 22:52:08 2003 @@ -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/Opcode/Safe.pm AP635_source/ext/Opcode/Safe.pm --- perl-5.6.1/ext/Opcode/Safe.pm Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/Opcode/Safe.pm Tue Feb 4 22:52:08 2003 @@ -154,7 +154,7 @@ my $no_record = shift || 0; my $root = $obj->root(); croak("vars not an array ref") unless ref $vars eq 'ARRAY'; - no strict 'refs'; + no strict 'refs'; # Check that 'from' package actually exists croak("Package \"$pkg\" does not exist") unless keys %{"$pkg\::"}; @@ -189,7 +189,7 @@ sub share_redo { my $obj = shift; my $shares = \%{$obj->{Shares} ||= {}}; - my($var, $pkg); + my($var, $pkg); while(($var, $pkg) = each %$shares) { # warn "share_redo $pkg\:: $var"; $obj->share_from($pkg, [ $var ], 1); @@ -213,11 +213,11 @@ # Create anon sub ref in root of compartment. # Uses a closure (on $expr) to pass in the code to be executed. # (eval on one line to keep line numbers as expected by caller) - my $evalcode = sprintf('package %s; sub { eval $expr; }', $root); + my $evalcode = sprintf('package %s; sub { @_ = (); eval $expr; }', $root); my $evalsub; - if ($strict) { use strict; $evalsub = eval $evalcode; } - else { no strict; $evalsub = eval $evalcode; } + if ($strict) { use strict; $evalsub = eval $evalcode; } + else { no strict; $evalsub = eval $evalcode; } return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); } @@ -227,7 +227,7 @@ my $root = $obj->{Root}; my $evalsub = eval - sprintf('package %s; sub { do $file }', $root); + sprintf('package %s; sub { @_ = (); do $file }', $root); return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); } diff -ruN perl-5.6.1/ext/POSIX/POSIX.xs AP635_source/ext/POSIX/POSIX.xs --- perl-5.6.1/ext/POSIX/POSIX.xs Thu Apr 5 21:38:46 2001 +++ AP635_source/ext/POSIX/POSIX.xs Tue Feb 4 22:52:08 2003 @@ -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 AP635_source/ext/Socket/Socket.pm --- perl-5.6.1/ext/Socket/Socket.pm Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/Socket/Socket.pm Tue Feb 4 22:52:09 2003 @@ -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 AP635_source/ext/Socket/Socket.xs --- perl-5.6.1/ext/Socket/Socket.xs Sat Apr 7 23:09:16 2001 +++ AP635_source/ext/Socket/Socket.xs Tue Feb 4 22:52:09 2003 @@ -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 AP635_source/ext/Sys/Syslog/Syslog.pm --- perl-5.6.1/ext/Sys/Syslog/Syslog.pm Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/Sys/Syslog/Syslog.pm Tue Feb 4 22:52:09 2003 @@ -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 AP635_source/ext/Thread/Thread/Queue.pm --- perl-5.6.1/ext/Thread/Thread/Queue.pm Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/Thread/Thread/Queue.pm Tue Feb 4 22:52:09 2003 @@ -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 AP635_source/ext/Thread/Thread/Semaphore.pm --- perl-5.6.1/ext/Thread/Thread/Semaphore.pm Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/Thread/Thread/Semaphore.pm Tue Feb 4 22:52:09 2003 @@ -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 AP635_source/ext/Thread/Thread/Signal.pm --- perl-5.6.1/ext/Thread/Thread/Signal.pm Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/Thread/Thread/Signal.pm Tue Feb 4 22:52:09 2003 @@ -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 AP635_source/ext/Thread/Thread/Specific.pm --- perl-5.6.1/ext/Thread/Thread/Specific.pm Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/Thread/Thread/Specific.pm Tue Feb 4 22:52:09 2003 @@ -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 AP635_source/ext/Thread/Thread.pm --- perl-5.6.1/ext/Thread/Thread.pm Sun Apr 8 17:31:55 2001 +++ AP635_source/ext/Thread/Thread.pm Tue Feb 4 22:52:09 2003 @@ -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 AP635_source/ext/re/re.xs --- perl-5.6.1/ext/re/re.xs Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/re/re.xs Tue Feb 4 22:52:09 2003 @@ -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 AP635_source/ext/util/make_ext --- perl-5.6.1/ext/util/make_ext Thu Feb 22 18:57:54 2001 +++ AP635_source/ext/util/make_ext Tue Feb 4 22:52:09 2003 @@ -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 AP635_source/global.sym --- perl-5.6.1/global.sym Thu Apr 5 21:38:46 2001 +++ AP635_source/global.sym Tue Feb 4 22:52:09 2003 @@ -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 AP635_source/globals.c --- perl-5.6.1/globals.c Thu Mar 15 07:25:20 2001 +++ AP635_source/globals.c Tue Feb 4 22:52:09 2003 @@ -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 AP635_source/gv.c --- perl-5.6.1/gv.c Wed Mar 28 09:16:01 2001 +++ AP635_source/gv.c Tue Feb 4 22:52:09 2003 @@ -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 | grep gcc`" = X; then # Cify libswanted. - set `echo X "$libswanted "| sed -e 's/ c / C c /'` + set `echo X "$libswanted "| sed -e 's/ c / C c /'` shift libswanted="$*" # Cify lddlflags. - set `echo X "$lddlflags "| sed -e 's/ -lc / -lC -lc /'` + set `echo X "$lddlflags "| sed -e 's/ -lc / -lC -lc /'` shift lddlflags="$*" fi diff -ruN perl-5.6.1/hints/darwin.sh AP635_source/hints/darwin.sh --- perl-5.6.1/hints/darwin.sh Thu Feb 22 18:57:55 2001 +++ AP635_source/hints/darwin.sh Tue Feb 4 22:52:09 2003 @@ -8,19 +8,39 @@ ## # BSD paths -prefix='/usr'; -siteprefix='/usr/local'; -vendorprefix='/usr/local'; usevendorprefix='define'; - -# 4BSD uses /usr/share/man, not /usr/man. -# Don't put man pages in /usr/lib; that's goofy. -man1dir='/usr/share/man/man1'; -man3dir='/usr/share/man/man3'; - -# Where to put modules. -privlib='/System/Library/Perl'; -sitelib='/Local/Library/Perl'; -vendorlib='/Network/Library/Perl'; +case "$prefix" in +'') + # Default install; use non-system directories + prefix='/usr/local'; # Built-in perl uses /usr + siteprefix='/usr/local'; + vendorprefix='/usr/local'; usevendorprefix='define'; + + # Where to put modules. + privlib='/Library/Perl'; # Built-in perl uses /System/Library/Perl + sitelib='/Library/Perl'; + vendorlib='/Network/Library/Perl'; + + # 4BSD uses ${prefix}/share/man, not ${prefix}/man. + man1dir="${prefix}/share/man/man1"; + man3dir="${prefix}/share/man/man3"; + + ;; +'/usr') + # We are building/replacing the built-in perl + siteprefix='/usr/local'; + vendorprefix='/usr/local'; usevendorprefix='define'; + + # Where to put modules. + privlib='/System/Library/Perl'; + sitelib='/Library/Perl'; + vendorlib='/Network/Library/Perl'; + + # 4BSD uses ${prefix}/share/man, not ${prefix}/man. + man1dir="${prefix}/share/man/man1"; + man3dir="${prefix}/share/man/man3"; + + ;; +esac ## # Tool chain settings @@ -48,16 +68,21 @@ dlext='bundle'; dlsrc='dl_dyld.xs'; usedl='define'; cccdlflags=' '; # space, not empty, because otherwise we get -fpic +case "$osvers" in +1.[0-3].*) ;; +*) ldflags="${ldflags} -flat_namespace" ;; +esac lddlflags="${ldflags} -bundle -undefined suppress"; ldlibpthname='DYLD_LIBRARY_PATH'; -useshrplib='true'; +useshrplib="${useshrplib:-true}"; +firstmakefile='GNUmakefile' ## # System libraries ## # vfork works -usevfork='true'; +usevfork="${usevfork:-true}"; # malloc works -usemymalloc='n'; +usemymalloc="${usemymalloc:-n}"; diff -ruN perl-5.6.1/hints/hpux.sh AP635_source/hints/hpux.sh --- perl-5.6.1/hints/hpux.sh Thu Mar 15 07:25:20 2001 +++ AP635_source/hints/hpux.sh Tue Feb 4 22:52:09 2003 @@ -73,7 +73,7 @@ # Check if you're using the bundled C compiler. This compiler doesn't support # ANSI C (the -Aa flag) and so is not suitable for perl 5.5 and later. case "$cc" in -'') if cc $ccflags -Aa 2>&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 AP635_source/hints/linux.sh --- perl-5.6.1/hints/linux.sh Thu Feb 22 18:57:55 2001 +++ AP635_source/hints/linux.sh Tue Feb 4 22:52:09 2003 @@ -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 AP635_source/hints/solaris_2.sh --- perl-5.6.1/hints/solaris_2.sh Thu Feb 22 18:57:55 2001 +++ AP635_source/hints/solaris_2.sh Tue Feb 4 22:52:09 2003 @@ -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 AP635_source/hints/svr5.sh --- perl-5.6.1/hints/svr5.sh Thu Feb 22 18:57:55 2001 +++ AP635_source/hints/svr5.sh Tue Feb 4 22:52:09 2003 @@ -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