This patch describes the changes made in ActivePerl build 630 over the official Perl v5.6.1 sources from CPAN. Summary of changes in build 630: * 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 AP630_source/BuildInfo.h --- perl-5.6.1/BuildInfo.h Wed Dec 31 16:00:00 1969 +++ AP630_source/BuildInfo.h Thu Nov 1 06:45:47 2001 @@ -0,0 +1,25 @@ +/* BuildInfo.h + * + * (c) 1998 ActiveState Tool Corp. All rights reserved. + * + */ + +#ifndef ___BuildInfo__h___ +#define ___BuildInfo__h___ + +#define PRODUCT_BUILD_NUMBER "630" +#define PERLFILEVERSION "5,6,1,630\0" +#define PERLRC_VERSION 5,6,1,630 +#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 Tool Corp. http://www.ActiveState.com\n\ +" ACTIVEPERL_VERSION "\n"); + +#endif /* ___BuildInfo__h___ */ diff -ruN perl-5.6.1/Configure AP630_source/Configure --- perl-5.6.1/Configure Sun Mar 18 19:03:33 2001 +++ AP630_source/Configure Thu Nov 1 06:45:49 2001 @@ -6357,7 +6357,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 ;; diff -ruN perl-5.6.1/MANIFEST AP630_source/MANIFEST --- perl-5.6.1/MANIFEST Sun Apr 8 11:38:40 2001 +++ AP630_source/MANIFEST Thu Nov 1 06:45:49 2001 @@ -1470,6 +1470,7 @@ t/op/numconvert.t See if accessing fields does not change numeric values t/op/oct.t See if oct and hex work t/op/ord.t See if ord works +t/op/override.t See if operator overriding works t/op/pack.t See if pack and unpack work t/op/pat.t See if esoteric patterns work t/op/pos.t See if pos works @@ -1501,6 +1502,8 @@ t/op/subst_wamp.t See if substitution works with $& present t/op/substr.t See if substr works t/op/sysio.t See if sysread and syswrite work +t/op/system.t See if system works +t/op/system_tests Test runner for system.t t/op/taint.t See if tainting works t/op/tie.t See if tie/untie functions work t/op/tiearray.t See if tie for arrays works diff -ruN perl-5.6.1/Todo-5.6 AP630_source/Todo-5.6 --- perl-5.6.1/Todo-5.6 Tue Mar 20 09:40:22 2001 +++ AP630_source/Todo-5.6 Thu Nov 1 06:45:49 2001 @@ -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/av.c AP630_source/av.c --- perl-5.6.1/av.c Wed Mar 21 21:05:02 2001 +++ AP630_source/av.c Thu Nov 1 06:45:49 2001 @@ -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/cop.h AP630_source/cop.h --- perl-5.6.1/cop.h Wed Mar 21 21:05:02 2001 +++ AP630_source/cop.h Thu Nov 1 06:45:49 2001 @@ -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/doop.c AP630_source/doop.c --- perl-5.6.1/doop.c Thu Apr 5 21:38:46 2001 +++ AP630_source/doop.c Thu Nov 1 06:45:49 2001 @@ -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 AP630_source/dump.c --- perl-5.6.1/dump.c Wed Mar 21 21:05:02 2001 +++ AP630_source/dump.c Thu Nov 1 06:45:49 2001 @@ -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 AP630_source/embed.h --- perl-5.6.1/embed.h Thu Apr 5 21:38:46 2001 +++ AP630_source/embed.h Thu Nov 1 06:45:50 2001 @@ -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 @@ -1160,7 +1165,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 +1182,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 +1641,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 @@ -2619,7 +2627,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 +2644,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 +3010,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 +3220,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 @@ -5082,8 +5096,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 +5130,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 AP630_source/embed.pl --- perl-5.6.1/embed.pl Thu Apr 5 21:38:46 2001 +++ AP630_source/embed.pl Thu Nov 1 06:45:50 2001 @@ -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 diff -ruN perl-5.6.1/ext/B/B.xs AP630_source/ext/B/B.xs --- perl-5.6.1/ext/B/B.xs Thu Apr 5 21:38:46 2001 +++ AP630_source/ext/B/B.xs Thu Nov 1 06:45:50 2001 @@ -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.xs AP630_source/ext/DB_File/DB_File.xs --- perl-5.6.1/ext/DB_File/DB_File.xs Thu Feb 22 18:57:54 2001 +++ AP630_source/ext/DB_File/DB_File.xs Thu Nov 1 06:45:50 2001 @@ -420,10 +420,21 @@ /* Internal Global Data */ -static recno_t Value ; -static recno_t zero = 0 ; -static DB_File CurrentDB ; -static DBTKEY empty ; +#define MY_CXT_KEY "DB_File::_guts" XS_VERSION + +typedef struct { + recno_t x_Value; + recno_t x_zero; + DB_File x_CurrentDB; + DBTKEY x_empty; +} my_cxt_t; + +START_MY_CXT + +#define Value (MY_CXT.x_Value) +#define zero (MY_CXT.x_zero) +#define CurrentDB (MY_CXT.x_CurrentDB) +#define empty (MY_CXT.x_empty) #ifdef DB_VERSION_MAJOR @@ -517,6 +528,7 @@ dTHX; #endif dSP ; + dMY_CXT; void * data1, * data2 ; int retval ; int count ; @@ -588,6 +600,7 @@ dTHX; #endif dSP ; + dMY_CXT; void * data1, * data2 ; int retval ; int count ; @@ -666,6 +679,7 @@ dTHX; #endif dSP ; + dMY_CXT; int retval ; int count ; @@ -841,6 +855,7 @@ void * openinfo = NULL ; INFO * info = &RETVAL->info ; STRLEN n_a; + dMY_CXT; /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */ Zero(RETVAL, 1, DB_File_type) ; @@ -1114,6 +1129,7 @@ DB * dbp ; STRLEN n_a; int status ; + dMY_CXT; /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */ Zero(RETVAL, 1, DB_File_type) ; @@ -1596,6 +1612,7 @@ BOOT: { + MY_CXT_INIT; __getBerkeleyDBInfo() ; DBT_clear(empty) ; @@ -1637,6 +1654,8 @@ int db_DESTROY(db) DB_File db + PREINIT: + dMY_CXT; INIT: CurrentDB = db ; CLEANUP: @@ -1668,6 +1687,8 @@ DB_File db DBTKEY key u_int flags + PREINIT: + dMY_CXT; INIT: CurrentDB = db ; @@ -1676,6 +1697,8 @@ db_EXISTS(db, key) DB_File db DBTKEY key + PREINIT: + dMY_CXT; CODE: { DBT value ; @@ -1692,6 +1715,8 @@ DB_File db DBTKEY key u_int flags + PREINIT: + dMY_CXT; CODE: { DBT value ; @@ -1710,6 +1735,8 @@ DBTKEY key DBT value u_int flags + PREINIT: + dMY_CXT; INIT: CurrentDB = db ; @@ -1717,6 +1744,8 @@ int db_FIRSTKEY(db) DB_File db + PREINIT: + dMY_CXT; CODE: { DBTKEY key ; @@ -1734,6 +1763,8 @@ db_NEXTKEY(db, key) DB_File db DBTKEY key + PREINIT: + dMY_CXT; CODE: { DBT value ; @@ -1753,6 +1784,8 @@ unshift(db, ...) DB_File db ALIAS: UNSHIFT = 1 + PREINIT: + dMY_CXT; CODE: { DBTKEY key ; @@ -1794,6 +1827,8 @@ I32 pop(db) DB_File db + PREINIT: + dMY_CXT; ALIAS: POP = 1 CODE: { @@ -1821,6 +1856,8 @@ I32 shift(db) DB_File db + PREINIT: + dMY_CXT; ALIAS: SHIFT = 1 CODE: { @@ -1848,6 +1885,8 @@ I32 push(db, ...) DB_File db + PREINIT: + dMY_CXT; ALIAS: PUSH = 1 CODE: { @@ -1890,6 +1929,8 @@ I32 length(db) DB_File db + PREINIT: + dMY_CXT; ALIAS: FETCHSIZE = 1 CODE: CurrentDB = db ; @@ -1907,6 +1948,8 @@ DB_File db DBTKEY key u_int flags + PREINIT: + dMY_CXT; CODE: CurrentDB = db ; RETVAL = db_del(db, key, flags) ; @@ -1926,6 +1969,8 @@ DBTKEY key DBT value = NO_INIT u_int flags + PREINIT: + dMY_CXT; CODE: CurrentDB = db ; DBT_clear(value) ; @@ -1946,6 +1991,8 @@ DBTKEY key DBT value u_int flags + PREINIT: + dMY_CXT; CODE: CurrentDB = db ; RETVAL = db_put(db, key, value, flags) ; @@ -1963,6 +2010,8 @@ db_fd(db) DB_File db int status = 0 ; + PREINIT: + dMY_CXT; CODE: CurrentDB = db ; #ifdef DB_VERSION_MAJOR @@ -1984,6 +2033,8 @@ db_sync(db, flags=0) DB_File db u_int flags + PREINIT: + dMY_CXT; CODE: CurrentDB = db ; RETVAL = db_sync(db, flags) ; @@ -2001,6 +2052,8 @@ DBTKEY key DBT value = NO_INIT u_int flags + PREINIT: + dMY_CXT; CODE: CurrentDB = db ; DBT_clear(value) ; diff -ruN perl-5.6.1/ext/Devel/Peek/Peek.xs AP630_source/ext/Devel/Peek/Peek.xs --- perl-5.6.1/ext/Devel/Peek/Peek.xs Thu Apr 5 21:38:46 2001 +++ AP630_source/ext/Devel/Peek/Peek.xs Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/ext/DynaLoader/dl_beos.xs --- perl-5.6.1/ext/DynaLoader/dl_beos.xs Thu Feb 22 18:57:54 2001 +++ AP630_source/ext/DynaLoader/dl_beos.xs Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/ext/DynaLoader/dl_dld.xs --- perl-5.6.1/ext/DynaLoader/dl_dld.xs Thu Feb 22 18:57:54 2001 +++ AP630_source/ext/DynaLoader/dl_dld.xs Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/ext/DynaLoader/dl_dllload.xs --- perl-5.6.1/ext/DynaLoader/dl_dllload.xs Thu Feb 22 18:57:54 2001 +++ AP630_source/ext/DynaLoader/dl_dllload.xs Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/ext/DynaLoader/dl_dlopen.xs --- perl-5.6.1/ext/DynaLoader/dl_dlopen.xs Thu Feb 22 18:57:54 2001 +++ AP630_source/ext/DynaLoader/dl_dlopen.xs Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/ext/DynaLoader/dl_dyld.xs --- perl-5.6.1/ext/DynaLoader/dl_dyld.xs Thu Feb 22 18:57:54 2001 +++ AP630_source/ext/DynaLoader/dl_dyld.xs Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/ext/DynaLoader/dl_hpux.xs --- perl-5.6.1/ext/DynaLoader/dl_hpux.xs Thu Feb 22 18:57:54 2001 +++ AP630_source/ext/DynaLoader/dl_hpux.xs Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/ext/DynaLoader/dl_mac.xs --- perl-5.6.1/ext/DynaLoader/dl_mac.xs Sun Mar 18 19:03:34 2001 +++ AP630_source/ext/DynaLoader/dl_mac.xs Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/ext/DynaLoader/dl_mpeix.xs --- perl-5.6.1/ext/DynaLoader/dl_mpeix.xs Thu Feb 22 18:57:54 2001 +++ AP630_source/ext/DynaLoader/dl_mpeix.xs Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/ext/DynaLoader/dl_next.xs --- perl-5.6.1/ext/DynaLoader/dl_next.xs Thu Feb 22 18:57:54 2001 +++ AP630_source/ext/DynaLoader/dl_next.xs Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/ext/DynaLoader/dl_vmesa.xs --- perl-5.6.1/ext/DynaLoader/dl_vmesa.xs Thu Feb 22 18:57:54 2001 +++ AP630_source/ext/DynaLoader/dl_vmesa.xs Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/ext/DynaLoader/dl_vms.xs --- perl-5.6.1/ext/DynaLoader/dl_vms.xs Thu Feb 22 18:57:54 2001 +++ AP630_source/ext/DynaLoader/dl_vms.xs Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/ext/DynaLoader/dlutils.c --- perl-5.6.1/ext/DynaLoader/dlutils.c Thu Feb 22 18:57:54 2001 +++ AP630_source/ext/DynaLoader/dlutils.c Thu Nov 1 06:45:50 2001 @@ -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/File/Glob/Glob.pm AP630_source/ext/File/Glob/Glob.pm --- perl-5.6.1/ext/File/Glob/Glob.pm Sun Apr 1 22:18:41 2001 +++ AP630_source/ext/File/Glob/Glob.pm Thu Nov 1 06:45:50 2001 @@ -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; @@ -241,6 +243,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 AP630_source/ext/File/Glob/Glob.xs --- perl-5.6.1/ext/File/Glob/Glob.xs Thu Apr 5 21:38:46 2001 +++ AP630_source/ext/File/Glob/Glob.xs Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/ext/File/Glob/bsd_glob.c --- perl-5.6.1/ext/File/Glob/bsd_glob.c Sun Apr 1 22:18:41 2001 +++ AP630_source/ext/File/Glob/bsd_glob.c Thu Nov 1 06:45:50 2001 @@ -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,29 @@ * 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 (*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 +448,7 @@ return pattern; #endif } - } - else { + } else { /* * Expand a ~user */ @@ -433,12 +463,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 +487,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 +496,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 +542,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 +554,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 +574,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 +588,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 +610,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 +628,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 +642,6 @@ for (anymeta = 0;;) { if (*pattern == BG_EOS) { /* End of pattern? */ *pathend = BG_EOS; - if (g_lstat(pathbuf, &sb, pglob)) return(0); @@ -616,10 +650,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 +663,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 +676,8 @@ ) { if (ismeta(*p)) anymeta = 1; + if (q+1 > pathend_last) + return (1); *q++ = *p++; } @@ -650,17 +688,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 +721,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 +759,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 +769,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 +812,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 +827,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 +849,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 +891,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 +942,7 @@ if (*pp) Safefree(*pp); Safefree(pglob->gl_pathv); + pglob->gl_pathv = NULL; } } @@ -881,13 +958,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 +973,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 +989,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 +1006,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 AP630_source/ext/File/Glob/bsd_glob.h --- perl-5.6.1/ext/File/Glob/bsd_glob.h Tue Mar 20 09:39:30 2001 +++ AP630_source/ext/File/Glob/bsd_glob.h Thu Nov 1 06:45:50 2001 @@ -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/IO/lib/IO/Seekable.pm AP630_source/ext/IO/lib/IO/Seekable.pm --- perl-5.6.1/ext/IO/lib/IO/Seekable.pm Thu Feb 22 18:57:54 2001 +++ AP630_source/ext/IO/lib/IO/Seekable.pm Thu Nov 1 06:45:50 2001 @@ -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/ODBM_File/ODBM_File.xs AP630_source/ext/ODBM_File/ODBM_File.xs --- perl-5.6.1/ext/ODBM_File/ODBM_File.xs Sat Mar 3 11:53:20 2001 +++ AP630_source/ext/ODBM_File/ODBM_File.xs Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/ext/Opcode/Opcode.xs --- perl-5.6.1/ext/Opcode/Opcode.xs Thu Apr 5 21:38:46 2001 +++ AP630_source/ext/Opcode/Opcode.xs Thu Nov 1 06:45:50 2001 @@ -7,10 +7,21 @@ #define OP_MASK_BUF_SIZE (MAXO + 100) /* XXX op_named_bits and opset_all are never freed */ -static HV *op_named_bits; /* cache shared for whole process */ -static SV *opset_all; /* mask with all bits set */ -static IV opset_len; /* length of opmasks in bytes */ -static int opcode_debug = 0; +#define MY_CXT_KEY "Opcode::_guts" XS_VERSION + +typedef struct { + HV * x_op_named_bits; /* cache shared for whole process */ + SV * x_opset_all; /* mask with all bits set */ + IV x_opset_len; /* length of opmasks in bytes */ + int x_opcode_debug; +} my_cxt_t; + +START_MY_CXT + +#define op_named_bits (MY_CXT.x_op_named_bits) +#define opset_all (MY_CXT.x_opset_all) +#define opset_len (MY_CXT.x_opset_len) +#define opcode_debug (MY_CXT.x_opcode_debug) static SV *new_opset (pTHX_ SV *old_opset); static int verify_opset (pTHX_ SV *opset, int fatal); @@ -34,6 +45,7 @@ STRLEN len; char **op_names; char *bitmap; + dMY_CXT; op_named_bits = newHV(); op_names = get_op_names(); @@ -66,6 +78,8 @@ put_op_bitspec(pTHX_ char *optag, STRLEN len, SV *mask) { SV **svp; + dMY_CXT; + verify_opset(aTHX_ mask,1); if (!len) len = strlen(optag); @@ -87,6 +101,8 @@ get_op_bitspec(pTHX_ char *opname, STRLEN len, int fatal) { SV **svp; + dMY_CXT; + if (!len) len = strlen(opname); svp = hv_fetch(op_named_bits, opname, len, 0); @@ -110,6 +126,8 @@ new_opset(pTHX_ SV *old_opset) { SV *opset; + dMY_CXT; + if (old_opset) { verify_opset(aTHX_ old_opset,1); opset = newSVsv(old_opset); @@ -129,6 +147,8 @@ verify_opset(pTHX_ SV *opset, int fatal) { char *err = Nullch; + dMY_CXT; + if (!SvOK(opset)) err = "undefined"; else if (!SvPOK(opset)) err = "wrong type"; else if (SvCUR(opset) != opset_len) err = "wrong size"; @@ -142,6 +162,7 @@ static void set_opset_bits(pTHX_ char *bitmap, SV *bitspec, int on, char *opname) { + dMY_CXT; if (SvIOK(bitspec)) { int myopcode = SvIV(bitspec); int offset = myopcode >> 3; @@ -180,6 +201,7 @@ char *bitmask; STRLEN len; int myopcode = 0; + dMY_CXT; verify_opset(aTHX_ opset,1); /* croaks on bad opset */ @@ -204,6 +226,8 @@ opmask_addlocal(pTHX_ SV *opset, char *op_mask_buf) /* Localise PL_op_mask then opmask_add() */ { char *orig_op_mask = PL_op_mask; + dMY_CXT; + SAVEVPTR(PL_op_mask); #if !defined(PERL_OBJECT) /* XXX casting to an ordinary function ptr from a member function ptr @@ -227,12 +251,14 @@ PROTOTYPES: ENABLE BOOT: +{ + MY_CXT_INIT; assert(PL_maxo < OP_MASK_BUF_SIZE); opset_len = (PL_maxo + 7) / 8; if (opcode_debug >= 1) warn("opset_len %ld\n", (long)opset_len); op_names_init(aTHX); - +} void _safe_call_sv(Package, mask, codesv) @@ -289,6 +315,8 @@ CODE: { char *bitmap; + dMY_CXT; + STRLEN len = opset_len; opset = sv_2mortal(new_opset(aTHX_ opset)); /* verify and clone opset */ bitmap = SvPVX(opset); @@ -311,6 +339,8 @@ int i, j, myopcode; char *bitmap = SvPV(opset, len); char **names = (desc) ? get_op_descs() : get_op_names(); + dMY_CXT; + verify_opset(aTHX_ opset,1); for (myopcode=0, i=0; i < opset_len; i++) { U16 bits = bitmap[i]; @@ -363,6 +393,7 @@ SV *bitspec, *mask; char *bitmap, *opname; STRLEN len; + dMY_CXT; if (!SvROK(safe) || !SvOBJECT(SvRV(safe)) || SvTYPE(SvRV(safe))!=SVt_PVHV) croak("Not a Safe object"); @@ -397,6 +428,7 @@ STRLEN len; SV **args; char **op_desc = get_op_descs(); + dMY_CXT; /* copy args to a scratch area since we may push output values onto */ /* the stack faster than we read values off it if masks are used. */ args = (SV**)SvPVX(sv_2mortal(newSVpvn((char*)&ST(0), items*sizeof(SV*)))); @@ -446,6 +478,7 @@ void full_opset() CODE: + dMY_CXT; ST(0) = sv_2mortal(new_opset(aTHX_ opset_all)); void diff -ruN perl-5.6.1/ext/POSIX/POSIX.xs AP630_source/ext/POSIX/POSIX.xs --- perl-5.6.1/ext/POSIX/POSIX.xs Thu Apr 5 21:38:46 2001 +++ AP630_source/ext/POSIX/POSIX.xs Thu Nov 1 06:45:50 2001 @@ -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); } @@ -3755,6 +3763,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; diff -ruN perl-5.6.1/ext/re/re.xs AP630_source/ext/re/re.xs --- perl-5.6.1/ext/re/re.xs Thu Feb 22 18:57:54 2001 +++ AP630_source/ext/re/re.xs Thu Nov 1 06:45:50 2001 @@ -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/global.sym AP630_source/global.sym --- perl-5.6.1/global.sym Thu Apr 5 21:38:46 2001 +++ AP630_source/global.sym Thu Nov 1 06:45:50 2001 @@ -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 diff -ruN perl-5.6.1/globals.c AP630_source/globals.c --- perl-5.6.1/globals.c Thu Mar 15 07:25:20 2001 +++ AP630_source/globals.c Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/gv.c --- perl-5.6.1/gv.c Wed Mar 28 09:16:01 2001 +++ AP630_source/gv.c Thu Nov 1 06:45:50 2001 @@ -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 UU/usethreads.cbu <<'EOCBU' case "$usethreads" in $define|true|[yY]*) - ccflags="-D_REENTRANT $ccflags" + ccflags="-D_POSIX_C_SOURCE=199506L -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 AP630_source/hints/solaris_2.sh --- perl-5.6.1/hints/solaris_2.sh Thu Feb 22 18:57:55 2001 +++ AP630_source/hints/solaris_2.sh Thu Nov 1 06:45:50 2001 @@ -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 AP630_source/hints/svr5.sh --- perl-5.6.1/hints/svr5.sh Thu Feb 22 18:57:55 2001 +++ AP630_source/hints/svr5.sh Thu Nov 1 06:45:50 2001 @@ -83,7 +83,7 @@ # remove /shlib and /lib from library search path as both symlink to /usr/lib # where runtime shared libc is -glibpth=`echo " $glibpth " | sed -e 's/ \/shlib / /' -e 's/ \/lib / /` +glibpth=`echo " $glibpth " | sed -e 's/ \/shlib / /' -e 's/ \/lib / /'` # Don't use BSD emulation pieces (/usr/ucblib) regardless # these would probably be autonondetected anyway but ... @@ -156,8 +156,10 @@ # cccdlflags: must tell the compiler to generate relocatable code # lddlflags : must tell the linker to output a shared library -# use shared perl lib -useshrplib='true' +# use shared perl lib if the user doesn't choose otherwise +if test "x$useshrplib" = "x"; then + useshrplib='true' +fi case "$cc" in *gcc*) diff -ruN perl-5.6.1/hv.c AP630_source/hv.c --- perl-5.6.1/hv.c Wed Mar 21 21:05:02 2001 +++ AP630_source/hv.c Thu Nov 1 06:45:51 2001 @@ -188,7 +188,7 @@ for (; entry; entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -296,7 +296,7 @@ for (; entry; entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -399,7 +399,7 @@ for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -420,7 +420,7 @@ xhv->xhv_keys++; if (i) { /* initial entry? */ ++xhv->xhv_fill; - if (xhv->xhv_keys > xhv->xhv_max) + if (xhv->xhv_keys > (IV)xhv->xhv_max) hsplit(hv); } @@ -499,7 +499,7 @@ for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -520,7 +520,7 @@ xhv->xhv_keys++; if (i) { /* initial entry? */ ++xhv->xhv_fill; - if (xhv->xhv_keys > xhv->xhv_max) + if (xhv->xhv_keys > (IV)xhv->xhv_max) hsplit(hv); } @@ -586,7 +586,7 @@ for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -673,7 +673,7 @@ for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -747,7 +747,7 @@ for (; entry; entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -827,7 +827,7 @@ for (; entry; entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (HeKLEN(entry) != klen) + if (HeKLEN(entry) != (I32)klen) continue; if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; @@ -894,7 +894,7 @@ continue; bep = aep+oldsize; for (oentry = aep, entry = *aep; entry; entry = *oentry) { - if ((HeHASH(entry) & newsize) != i) { + if ((HeHASH(entry) & newsize) != (U32)i) { *oentry = HeNEXT(entry); HeNEXT(entry) = *bep; if (!*bep) @@ -1280,7 +1280,7 @@ entry = HeNEXT(entry); while (!entry) { ++xhv->xhv_riter; - if (xhv->xhv_riter > xhv->xhv_max) { + if (xhv->xhv_riter > (I32)xhv->xhv_max) { xhv->xhv_riter = -1; break; } @@ -1489,7 +1489,7 @@ xhv->xhv_keys++; if (i) { /* initial entry? */ ++xhv->xhv_fill; - if (xhv->xhv_keys > xhv->xhv_max) + if (xhv->xhv_keys > (IV)xhv->xhv_max) hsplit(PL_strtab); } } diff -ruN perl-5.6.1/iperlsys.h AP630_source/iperlsys.h --- perl-5.6.1/iperlsys.h Thu Mar 15 07:25:20 2001 +++ AP630_source/iperlsys.h Thu Nov 1 06:45:51 2001 @@ -692,11 +692,6 @@ #define PerlEnv_putenv(str) putenv((str)) #define PerlEnv_getenv(str) getenv((str)) #define PerlEnv_getenv_len(str,l) getenv_len((str), (l)) -#define PerlEnv_clearenv() clearenv() -#define PerlEnv_get_childenv() get_childenv() -#define PerlEnv_free_childenv(e) free_childenv((e)) -#define PerlEnv_get_childdir() get_childdir() -#define PerlEnv_free_childdir(d) free_childdir((d)) #ifdef HAS_ENVGETENV # define PerlEnv_ENVgetenv(str) ENVgetenv((str)) # define PerlEnv_ENVgetenv_len(str,l) ENVgetenv_len((str), (l)) @@ -712,6 +707,17 @@ #define PerlEnv_sitelib_path(str) win32_get_sitelib(str) #define PerlEnv_vendorlib_path(str) win32_get_vendorlib(str) #define PerlEnv_get_child_IO(ptr) win32_get_child_IO(ptr) +#define PerlEnv_clearenv() win32_clearenv() +#define PerlEnv_get_childenv() win32_get_childenv() +#define PerlEnv_free_childenv(e) win32_free_childenv((e)) +#define PerlEnv_get_childdir() win32_get_childdir() +#define PerlEnv_free_childdir(d) win32_free_childdir((d)) +#else +#define PerlEnv_clearenv() clearenv() +#define PerlEnv_get_childenv() get_childenv() +#define PerlEnv_free_childenv(e) free_childenv((e)) +#define PerlEnv_get_childdir() get_childdir() +#define PerlEnv_free_childdir(d) free_childdir((d)) #endif #endif /* PERL_IMPLICIT_SYS */ @@ -1050,12 +1056,8 @@ typedef void* (*LPProcDynaLoader)(struct IPerlProc*, const char*); typedef void (*LPProcGetOSError)(struct IPerlProc*, SV* sv, DWORD dwErr); -typedef void (*LPProcFreeBuf)(struct IPerlProc*, char*); -typedef BOOL (*LPProcDoCmd)(struct IPerlProc*, char*); -typedef int (*LPProcSpawn)(struct IPerlProc*, char*); typedef int (*LPProcSpawnvp)(struct IPerlProc*, int, const char*, const char*const*); -typedef int (*LPProcASpawn)(struct IPerlProc*, void*, void**, void**); #endif struct IPerlProc @@ -1090,10 +1092,10 @@ #ifdef WIN32 LPProcDynaLoader pDynaLoader; LPProcGetOSError pGetOSError; - LPProcDoCmd pDoCmd; - LPProcSpawn pSpawn; - LPProcSpawnvp pSpawnvp; - LPProcASpawn pASpawn; + void * __unused1; /* XXX unused, retained for bincompat */ + void * __unused2; + LPProcSpawnvp pSpawnvp; /* XXX unused, retained for bincompat */ + void * __unused3; /* XXX unused, retained for bincompat */ #endif }; @@ -1165,14 +1167,8 @@ (*PL_Proc->pDynaLoader)(PL_Proc, (f)) #define PerlProc_GetOSError(s,e) \ (*PL_Proc->pGetOSError)(PL_Proc, (s), (e)) -#define PerlProc_Cmd(s) \ - (*PL_Proc->pDoCmd)(PL_Proc, (s)) -#define do_spawn(s) \ - (*PL_Proc->pSpawn)(PL_Proc, (s)) -#define do_spawnvp(m, c, a) \ +#define PerlProc_spawnvp(m, c, a) \ (*PL_Proc->pSpawnvp)(PL_Proc, (m), (c), (a)) -#define PerlProc_aspawn(m,c,a) \ - (*PL_Proc->pASpawn)(PL_Proc, (m), (c), (a)) #endif #else /* PERL_IMPLICIT_SYS */ @@ -1213,6 +1209,8 @@ win32_dynaload((f)) #define PerlProc_GetOSError(s,e) \ win32_str_os_error((s), (e)) +#define PerlProc_spawnvp(m, c, a) \ + win32_spawnvp((m), (c), (a)) #endif #endif /* PERL_IMPLICIT_SYS */ diff -ruN perl-5.6.1/lib/AutoSplit.pm AP630_source/lib/AutoSplit.pm --- perl-5.6.1/lib/AutoSplit.pm Thu Feb 22 18:57:55 2001 +++ AP630_source/lib/AutoSplit.pm Thu Nov 1 06:45:51 2001 @@ -54,7 +54,7 @@ The fourth argument, I<$check>, instructs C to check the module -currently being split to ensure that it does include a C +currently being split to ensure that it includes a C specification for the AutoLoader module, and skips the module if AutoLoader is not detected. $check defaults to 1. @@ -338,13 +338,14 @@ if ($Verbose>=1); } push(@outfiles, $path); + my $lineno = $fnr - @cache; print OUT <$expires) if $expires; push(@param,'-secure'=>$secure) if $secure; - return new CGI::Cookie(@param); + return CGI::Cookie->new(@param); } END_OF_FUNC diff -ruN perl-5.6.1/lib/Devel/SelfStubber.pm AP630_source/lib/Devel/SelfStubber.pm --- perl-5.6.1/lib/Devel/SelfStubber.pm Thu Feb 22 18:57:55 2001 +++ AP630_source/lib/Devel/SelfStubber.pm Thu Nov 1 06:45:51 2001 @@ -3,7 +3,8 @@ @ISA = qw(SelfLoader); @EXPORT = 'AUTOLOAD'; $JUST_STUBS = 1; -$VERSION = 1.01; sub Version {$VERSION} +$VERSION = '1.02'; +sub Version {$VERSION} # Use as # perl -e 'use Devel::SelfStubber;Devel::SelfStubber->stub(MODULE_NAME,LIB)' diff -ruN perl-5.6.1/lib/ExtUtils/Install.pm AP630_source/lib/ExtUtils/Install.pm --- perl-5.6.1/lib/ExtUtils/Install.pm Thu Feb 22 18:57:55 2001 +++ AP630_source/lib/ExtUtils/Install.pm Thu Nov 1 06:45:51 2001 @@ -120,7 +120,6 @@ return unless -f _; return if $_ eq ".exists"; my $targetdir = MY->catdir($targetroot, $File::Find::dir); - my $origfile = $_; my $targetfile = MY->catfile($targetdir, $_); my $diff = 0; @@ -156,7 +155,7 @@ } else { inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0 } - $packlist->{$origfile}++; + $packlist->{$targetfile}++; }, "."); chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!"); @@ -264,16 +263,15 @@ sub run_filter { my ($cmd, $src, $dest) = @_; - local *SRC, *CMD; - open(CMD, "|$cmd >$dest") || die "Cannot fork: $!"; - open(SRC, $src) || die "Cannot open $src: $!"; + open(my $CMD, "|$cmd >$dest") || die "Cannot fork: $!"; + open(my $SRC, $src) || die "Cannot open $src: $!"; my $buf; my $sz = 1024; - while (my $len = sysread(SRC, $buf, $sz)) { - syswrite(CMD, $buf, $len); + while (my $len = sysread($SRC, $buf, $sz)) { + syswrite($CMD, $buf, $len); } - close SRC; - close CMD or die "Filter command '$cmd' failed for $src"; + close $SRC; + close $CMD or die "Filter command '$cmd' failed for $src"; } sub pm_to_blib { diff -ruN perl-5.6.1/lib/ExtUtils/Installed.pm AP630_source/lib/ExtUtils/Installed.pm --- perl-5.6.1/lib/ExtUtils/Installed.pm Thu Feb 22 18:57:55 2001 +++ AP630_source/lib/ExtUtils/Installed.pm Thu Nov 1 06:45:51 2001 @@ -8,7 +8,28 @@ use Config; use File::Find; use File::Basename; -our $VERSION = '0.02'; +our $VERSION = '0.03'; + +my $DOSISH = ($^O =~ /^(MSWin\d\d|os2|dos|mint)$/); + +sub _is_prefix +{ +my ($self, $path, $prefix) = @_; +if (substr($path, 0, length($prefix)) eq $prefix) + { + return(1); + } +if ($DOSISH) + { + $path =~ s|\\|/|g; + $prefix =~ s|\\|/|g; + if ($path =~ m{^\Q$prefix\E}i) + { + return(1); + } + } +return(0); +} sub _is_type($$$) { @@ -16,22 +37,18 @@ return(1) if ($type eq "all"); if ($type eq "doc") { - return(substr($path, 0, length($Config{installman1dir})) - eq $Config{installman1dir} + return($self->_is_prefix($path, $Config{installman1dir}) || - substr($path, 0, length($Config{installman3dir})) - eq $Config{installman3dir} + $self->_is_prefix($path, $Config{installman3dir}) ? 1 : 0) } if ($type eq "prog") { - return(substr($path, 0, length($Config{prefix})) eq $Config{prefix} + return($self->_is_prefix($path, $Config{prefix}) && - substr($path, 0, length($Config{installman1dir})) - ne $Config{installman1dir} + !$self->_is_prefix($path, $Config{installman1dir}) && - substr($path, 0, length($Config{installman3dir})) - ne $Config{installman3dir} + !$self->_is_prefix($path, $Config{installman3dir}) ? 1 : 0); } return(0); @@ -43,7 +60,7 @@ $under[0] = "" if (! @under); foreach my $dir (@under) { - return(1) if (substr($path, 0, length($dir)) eq $dir); + return(1) if ($self->_is_prefix($path, $dir)); } return(0); } @@ -54,21 +71,32 @@ $class = ref($class) || $class; my $self = {}; +my $installarchlib = $Config{installarchlib}; +my $archlib = $Config{archlib}; +my $sitearch = $Config{sitearch}; + +if ($DOSISH) + { + $installarchlib =~ s|\\|/|g; + $archlib =~ s|\\|/|g; + $sitearch =~ s|\\|/|g; + } + # Read the core packlist $self->{Perl}{packlist} = - ExtUtils::Packlist->new("$Config{installarchlib}/.packlist"); + ExtUtils::Packlist->new("$installarchlib/.packlist"); $self->{Perl}{version} = $Config{version}; # Read the module packlists my $sub = sub { # Only process module .packlists - return if ($_) ne ".packlist" || $File::Find::dir eq $Config{installarchlib}; + return if ($_) ne ".packlist" || $File::Find::dir eq $installarchlib; # Hack of the leading bits of the paths & convert to a module name my $module = $File::Find::name; - $module =~ s!$Config{archlib}/auto/(.*)/.packlist!$1!s; - $module =~ s!$Config{sitearch}/auto/(.*)/.packlist!$1!s; + $module =~ s!\Q$archlib\E/auto/(.*)/.packlist!$1!s; + $module =~ s!\Q$sitearch\E/auto/(.*)/.packlist!$1!s; my $modfile = "$module.pm"; $module =~ s!/!::!g; @@ -87,7 +115,7 @@ # Read the .packlist $self->{$module}{packlist} = ExtUtils::Packlist->new($File::Find::name); }; -find($sub, $Config{archlib}, $Config{sitearch}); +find($sub, $archlib, $sitearch); return(bless($self, $class)); } diff -ruN perl-5.6.1/lib/ExtUtils/MakeMaker.pm AP630_source/lib/ExtUtils/MakeMaker.pm --- perl-5.6.1/lib/ExtUtils/MakeMaker.pm Thu Feb 22 18:57:55 2001 +++ AP630_source/lib/ExtUtils/MakeMaker.pm Thu Nov 1 06:45:51 2001 @@ -133,7 +133,7 @@ my $ans; local $|=1; print "$mess $dispdef"; - if ($ISA_TTY) { + if ($ISA_TTY && !$ENV{PERL_MM_USE_DEFAULT}) { chomp($ans = ); } else { print "$def\n"; @@ -2074,6 +2074,11 @@ Command line options used by Cnew()>, and thus by C. The string is split on whitespace, and the result is processed before any actual command line arguments are processed. + +=item PERL_MM_USE_DEFAULT + +If set to a true value then MakeMaker's prompt function will +always return the default without waiting for user input. =back diff -ruN perl-5.6.1/lib/Tie/Array.pm AP630_source/lib/Tie/Array.pm --- perl-5.6.1/lib/Tie/Array.pm Thu Feb 22 18:57:55 2001 +++ AP630_source/lib/Tie/Array.pm Thu Nov 1 06:45:51 2001 @@ -11,7 +11,6 @@ sub EXTEND { } sub UNSHIFT { scalar shift->SPLICE(0,0,@_) } sub SHIFT { shift->SPLICE(0,1) } -#sub SHIFT { (shift->SPLICE(0,1))[0] } sub CLEAR { shift->STORESIZE(0) } sub PUSH @@ -70,7 +69,7 @@ for (my $i=0; $i < @_; $i++) { $obj->STORE($off+$i,$_[$i]); } - return @result; + return wantarray ? @result : pop @result; } sub EXISTS { diff -ruN perl-5.6.1/lib/locale.pm AP630_source/lib/locale.pm --- perl-5.6.1/lib/locale.pm Thu Feb 22 18:57:55 2001 +++ AP630_source/lib/locale.pm Thu Nov 1 06:45:52 2001 @@ -25,7 +25,7 @@ =cut -$locale::hint_bits = 0x800; +$locale::hint_bits = 0x4; sub import { $^H |= $locale::hint_bits; diff -ruN perl-5.6.1/makedef.pl AP630_source/makedef.pl --- perl-5.6.1/makedef.pl Mon Mar 19 00:49:53 2001 +++ AP630_source/makedef.pl Thu Nov 1 06:45:53 2001 @@ -241,13 +241,19 @@ PL_cshlen PL_cshname PL_opsave - Perl_do_exec Perl_getenv_len Perl_my_pclose Perl_my_popen )]; } -elsif ($PLATFORM eq 'aix') { +else { + skip_symbols [qw( + Perl_do_spawn + Perl_do_spawn_nowait + Perl_do_aspawn + )]; +} +if ($PLATFORM eq 'aix') { skip_symbols([qw( Perl_dump_fds Perl_ErrorNo @@ -398,10 +404,6 @@ emit_symbols [qw( Perl_dump_mstats Perl_get_mstats - Perl_malloc - Perl_mfree - Perl_realloc - Perl_calloc Perl_strdup Perl_putenv )]; @@ -421,10 +423,6 @@ PL_malloc_mutex Perl_dump_mstats Perl_get_mstats - Perl_malloc - Perl_mfree - Perl_realloc - Perl_calloc Perl_malloced_size )]; } @@ -807,6 +805,11 @@ win32_getpid win32_crypt win32_dynaload + win32_get_childenv + win32_free_childenv + win32_clearenv + win32_get_childdir + win32_free_childdir )) { try_symbol($symbol); diff -ruN perl-5.6.1/mg.c AP630_source/mg.c --- perl-5.6.1/mg.c Wed Mar 21 21:05:02 2001 +++ AP630_source/mg.c Thu Nov 1 06:45:53 2001 @@ -356,7 +356,7 @@ paren = mg->mg_len; if (paren < 0) return 0; - if (paren <= rx->nparens && + if (paren <= (I32)rx->nparens && (s = rx->startp[paren]) != -1 && (t = rx->endp[paren]) != -1) { @@ -393,7 +393,7 @@ paren = atoi(mg->mg_ptr); getparen: - if (paren <= rx->nparens && + if (paren <= (I32)rx->nparens && (s1 = rx->startp[paren]) != -1 && (t1 = rx->endp[paren]) != -1) { @@ -562,6 +562,8 @@ (void)SvOK_off(sv); else if (PL_in_eval) sv_setiv(sv, PL_in_eval & ~(EVAL_INREQUIRE)); + else + sv_setiv(sv, 0); } break; case '\024': /* ^T */ @@ -602,7 +604,7 @@ */ paren = atoi(mg->mg_ptr); getparen: - if (paren <= rx->nparens && + if (paren <= (I32)rx->nparens && (s1 = rx->startp[paren]) != -1 && (t1 = rx->endp[paren]) != -1) { @@ -661,7 +663,7 @@ case '.': #ifndef lint if (GvIO(PL_last_in_gv)) { - sv_setiv(sv, (IV)IoLINES(GvIO(PL_last_in_gv))); + sv_setiv(sv, (IV)IoLINES(GvIOp(PL_last_in_gv))); } #endif break; @@ -797,7 +799,6 @@ register char *s; char *ptr; STRLEN len, klen; - I32 i; s = SvPV(sv,len); ptr = MgPV(mg,klen); @@ -850,6 +851,7 @@ while (s < strend) { char tmpbuf[256]; struct stat st; + I32 i; s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf, s, strend, ':', &i); s++; @@ -902,26 +904,9 @@ #if defined(VMS) || defined(EPOC) Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system"); #else -# ifdef PERL_IMPLICIT_SYS +# if defined(PERL_IMPLICIT_SYS) || defined(WIN32) PerlEnv_clearenv(); # else -# ifdef WIN32 - char *envv = GetEnvironmentStrings(); - char *cur = envv; - STRLEN len; - while (*cur) { - char *end = strchr(cur,'='); - if (end && end != cur) { - *end = '\0'; - my_setenv(cur,Nullch); - *end = '='; - cur = end + strlen(end+1)+2; - } - else if ((len = strlen(cur))) - cur += len+1; - } - FreeEnvironmentStrings(envv); -# else #if !defined(MACOS_TRADITIONAL) # ifndef PERL_USE_SAFE_PUTENV I32 i; @@ -936,7 +921,6 @@ environ[0] = Nullch; #endif /* !defined(MACOS_TRADITIONAL) */ -# endif /* WIN32 */ # endif /* PERL_IMPLICIT_SYS */ #endif /* VMS */ return 0; @@ -1261,7 +1245,7 @@ svp = av_fetch(GvAV(gv), atoi(MgPV(mg,n_a)), FALSE); if (svp && SvIOKp(*svp) && (o = INT2PTR(OP*,SvIVX(*svp)))) - o->op_private = i; + o->op_private = (U8)i; return 0; } @@ -1335,7 +1319,7 @@ if (pos < 0) pos = 0; } - else if (pos > len) + else if (pos > (SSize_t)len) pos = len; if (ulen) { @@ -1395,9 +1379,9 @@ if (SvUTF8(lsv)) sv_pos_u2b(lsv, &offs, &rem); - if (offs > len) + if (offs > (I32)len) offs = len; - if (rem + offs > len) + if (rem + offs > (I32)len) rem = len - offs; sv_setpvn(sv, tmps + offs, (STRLEN)rem); if (SvUTF8(lsv)) @@ -1420,7 +1404,7 @@ sv_insert(lsv, lvoff, lvlen, tmps, len); SvUTF8_on(lsv); } - else if (SvUTF8(lsv)) { + else if (lsv && SvUTF8(lsv)) { sv_pos_u2b(lsv, &lvoff, &lvlen); tmps = (char*)bytes_to_utf8((U8*)tmps, &len); sv_insert(lsv, lvoff, lvlen, tmps, len); @@ -1662,7 +1646,7 @@ sv_setsv(PL_bodytarget, sv); break; case '\003': /* ^C */ - PL_minus_c = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); + PL_minus_c = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '\004': /* ^D */ @@ -1798,6 +1782,8 @@ case '|': { IO *io = GvIOp(PL_defoutgv); + if (!io) + break; if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) == 0) IoFLAGS(io) &= ~IOf_FLUSH; else { @@ -2060,7 +2046,7 @@ } s = SvPV_force(sv,len); i = len; - if (i >= PL_origalen) { + if (i >= (I32)PL_origalen) { i = PL_origalen; /* don't allow system to limit $0 seen by script */ /* SvCUR_set(sv, i); *SvEND(sv) = '\0'; */ @@ -2072,7 +2058,7 @@ Copy(s, PL_origargv[0], i, char); s = PL_origargv[0]+i; *s++ = '\0'; - while (++i < PL_origalen) + while (++i < (I32)PL_origalen) *s++ = ' '; s = PL_origargv[0]+i; for (i = 1; i < PL_origargc; i++) @@ -2123,7 +2109,9 @@ return 0; } +#if !defined(PERL_IMPLICIT_CONTEXT) static SV* sig_sv; +#endif Signal_t Perl_sighandler(int sig) @@ -2193,7 +2181,9 @@ if(PL_psig_name[sig]) { sv = SvREFCNT_inc(PL_psig_name[sig]); flags |= 64; +#if !defined(PERL_IMPLICIT_CONTEXT) sig_sv = sv; +#endif } else { sv = sv_newmortal(); sv_setpv(sv,PL_sig_name[sig]); @@ -2279,6 +2269,8 @@ if (flags & 1) PL_savestack_ix -= 5; /* Unprotect save in progress. */ /* cxstack_ix-- Not needed, die already unwound it. */ +#if !defined(PERL_IMPLICIT_CONTEXT) if (flags & 64) SvREFCNT_dec(sig_sv); +#endif } diff -ruN perl-5.6.1/objXSUB.h AP630_source/objXSUB.h --- perl-5.6.1/objXSUB.h Thu Apr 5 21:38:46 2001 +++ AP630_source/objXSUB.h Thu Nov 1 06:45:53 2001 @@ -313,6 +313,24 @@ #define Perl_do_close pPerl->Perl_do_close #undef do_close #define do_close Perl_do_close +#undef Perl_do_exec +#define Perl_do_exec pPerl->Perl_do_exec +#undef do_exec +#define do_exec Perl_do_exec +#if defined(WIN32) +#undef Perl_do_aspawn +#define Perl_do_aspawn pPerl->Perl_do_aspawn +#undef do_aspawn +#define do_aspawn Perl_do_aspawn +#undef Perl_do_spawn +#define Perl_do_spawn pPerl->Perl_do_spawn +#undef do_spawn +#define do_spawn Perl_do_spawn +#undef Perl_do_spawn_nowait +#define Perl_do_spawn_nowait pPerl->Perl_do_spawn_nowait +#undef do_spawn_nowait +#define do_spawn_nowait Perl_do_spawn_nowait +#endif #if !defined(WIN32) #endif #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) diff -ruN perl-5.6.1/op.c AP630_source/op.c --- perl-5.6.1/op.c Sat Apr 7 23:09:16 2001 +++ AP630_source/op.c Thu Nov 1 06:45:53 2001 @@ -22,10 +22,10 @@ /* #define PL_OP_SLAB_ALLOC */ -#ifdef PL_OP_SLAB_ALLOC +#if defined(PL_OP_SLAB_ALLOC) && !defined(PERL_IMPLICIT_CONTEXT) #define SLAB_SIZE 8192 -static char *PL_OpPtr = NULL; -static int PL_OpSpace = 0; +static char *PL_OpPtr = NULL; /* XXX threadead */ +static int PL_OpSpace = 0; /* XXX threadead */ #define NewOp(m,var,c,type) do { if ((PL_OpSpace -= c*sizeof(type)) >= 0) \ var = (type *)(PL_OpPtr -= c*sizeof(type)); \ else \ @@ -165,7 +165,7 @@ SV **svp = AvARRAY(PL_comppad_name); HV *ourstash = (PL_curstash ? PL_curstash : PL_defstash); PADOFFSET top = AvFILLp(PL_comppad_name); - for (off = top; off > PL_comppad_name_floor; off--) { + for (off = top; (I32)off > PL_comppad_name_floor; off--) { if ((sv = svp[off]) && sv != &PL_sv_undef && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0) @@ -280,8 +280,8 @@ for (off = AvFILLp(curname); off > 0; off--) { if ((sv = svp[off]) && sv != &PL_sv_undef && - seq <= SvIVX(sv) && - seq > I_32(SvNVX(sv)) && + seq <= (U32)SvIVX(sv) && + seq > (U32)I_32(SvNVX(sv)) && strEQ(SvPVX(sv), name)) { I32 depth; @@ -372,15 +372,24 @@ switch (CxTYPE(cx)) { default: if (i == 0 && saweval) { - seq = cxstack[saweval].blk_oldcop->cop_seq; return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval, 0); } break; case CXt_EVAL: switch (cx->blk_eval.old_op_type) { case OP_ENTEREVAL: - if (CxREALEVAL(cx)) + if (CxREALEVAL(cx)) { + PADOFFSET off; saweval = i; + seq = cxstack[i].blk_oldcop->cop_seq; + startcv = cxstack[i].blk_eval.cv; + if (startcv && CvOUTSIDE(startcv)) { + off = pad_findlex(name, newoff, seq, CvOUTSIDE(startcv), + i-1, saweval, 0); + if (off) /* continue looking if not found here */ + return off; + } + } break; case OP_DOFILE: case OP_REQUIRE: @@ -395,9 +404,9 @@ cv = cx->blk_sub.cv; if (PL_debstash && CvSTASH(cv) == PL_debstash) { /* ignore DB'* scope */ saweval = i; /* so we know where we were called from */ + seq = cxstack[i].blk_oldcop->cop_seq; continue; } - seq = cxstack[saweval].blk_oldcop->cop_seq; return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH); } } @@ -434,8 +443,8 @@ if ((sv = svp[off]) && sv != &PL_sv_undef && (!SvIVX(sv) || - (seq <= SvIVX(sv) && - seq > I_32(SvNVX(sv)))) && + (seq <= (U32)SvIVX(sv) && + seq > (U32)I_32(SvNVX(sv)))) && strEQ(SvPVX(sv), name)) { if (SvIVX(sv) || SvFLAGS(sv) & SVpad_OUR) @@ -740,7 +749,7 @@ } type = o->op_type; if (type == OP_NULL) - type = o->op_targ; + type = (OPCODE)o->op_targ; /* COP* is not cleared by op_clear() so that we may track line * numbers etc even after null() */ @@ -1352,31 +1361,6 @@ PL_modcount++; return o; case OP_CONST: - if (o->op_private & (OPpCONST_BARE) && - !(type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)) { - SV *sv = ((SVOP*)o)->op_sv; - GV *gv; - - /* Could be a filehandle */ - if (gv = gv_fetchpv(SvPV_nolen(sv), FALSE, SVt_PVIO)) { - OP* gvio = newUNOP(OP_RV2GV, 0, newGVOP(OP_GV, 0, gv)); - op_free(o); - o = gvio; - } else { - /* OK, it's a sub */ - OP* enter; - gv = gv_fetchpv(SvPV_nolen(sv), TRUE, SVt_PVCV); - - enter = newUNOP(OP_ENTERSUB,0, - newUNOP(OP_RV2CV, 0, - newGVOP(OP_GV, 0, gv) - )); - enter->op_private |= OPpLVAL_INTRO; - op_free(o); - o = enter; - } - break; - } if (!(o->op_private & (OPpCONST_ARYBASE))) goto nomod; if (PL_eval_start && PL_eval_start->op_type == OP_CONST) { @@ -2034,9 +2018,15 @@ right->op_type == OP_SUBST || right->op_type == OP_TRANS)) { right->op_flags |= OPf_STACKED; - if (right->op_type != OP_MATCH && - ! (right->op_type == OP_TRANS && - right->op_private & OPpTRANS_IDENTICAL)) + if ((right->op_type != OP_MATCH && + ! (right->op_type == OP_TRANS && + right->op_private & OPpTRANS_IDENTICAL)) || + /* if SV has magic, then match on original SV, not on its copy. + see note in pp_helem() */ + (right->op_type == OP_MATCH && + (left->op_type == OP_AELEM || + left->op_type == OP_HELEM || + left->op_type == OP_AELEMFAST))) left = mod(left, right->op_type); if (right->op_type == OP_TRANS) o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right); @@ -2129,7 +2119,7 @@ OP* retval = scalarseq(seq); LEAVE_SCOPE(floor); PL_pad_reset_pending = FALSE; - PL_compiling.op_private = PL_hints; + PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK); if (needblockscope) PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */ pad_leavemy(PL_comppad_name_fill); @@ -2269,8 +2259,8 @@ case OP_SLE: case OP_SGE: case OP_SCMP: - - if (o->op_private & OPpLOCALE) + /* XXX what about the numeric ops? */ + if (PL_hints & HINT_LOCALE) goto nope; } @@ -2378,7 +2368,6 @@ OP * Perl_convert(pTHX_ I32 type, I32 flags, OP *o) { - OP *kid; OP *last = 0; if (!o || o->op_type != OP_LIST) @@ -2389,7 +2378,7 @@ if (!(PL_opargs[type] & OA_MARK)) null(cLISTOPo->op_first); - o->op_type = type; + o->op_type = (OPCODE)type; o->op_ppaddr = PL_ppaddr[type]; o->op_flags |= flags; @@ -2506,11 +2495,11 @@ NewOp(1101, listop, 1, LISTOP); - listop->op_type = type; + listop->op_type = (OPCODE)type; listop->op_ppaddr = PL_ppaddr[type]; if (first || last) flags |= OPf_KIDS; - listop->op_flags = flags; + listop->op_flags = (U8)flags; if (!last && first) last = first; @@ -2538,12 +2527,12 @@ { OP *o; NewOp(1101, o, 1, OP); - o->op_type = type; + o->op_type = (OPCODE)type; o->op_ppaddr = PL_ppaddr[type]; - o->op_flags = flags; + o->op_flags = (U8)flags; o->op_next = o; - o->op_private = 0 + (flags >> 8); + o->op_private = (U8)(0 | (flags >> 8)); if (PL_opargs[type] & OA_RETSCALAR) scalar(o); if (PL_opargs[type] & OA_TARGET) @@ -2562,11 +2551,11 @@ first = force_list(first); NewOp(1101, unop, 1, UNOP); - unop->op_type = type; + unop->op_type = (OPCODE)type; unop->op_ppaddr = PL_ppaddr[type]; unop->op_first = first; unop->op_flags = flags | OPf_KIDS; - unop->op_private = 1 | (flags >> 8); + unop->op_private = (U8)(1 | (flags >> 8)); unop = (UNOP*) CHECKOP(type, unop); if (unop->op_next) return (OP*)unop; @@ -2583,21 +2572,21 @@ if (!first) first = newOP(OP_NULL, 0); - binop->op_type = type; + binop->op_type = (OPCODE)type; binop->op_ppaddr = PL_ppaddr[type]; binop->op_first = first; binop->op_flags = flags | OPf_KIDS; if (!last) { last = first; - binop->op_private = 1 | (flags >> 8); + binop->op_private = (U8)(1 | (flags >> 8)); } else { - binop->op_private = 2 | (flags >> 8); + binop->op_private = (U8)(2 | (flags >> 8)); first->op_sibling = last; } binop = (BINOP*)CHECKOP(type, binop); - if (binop->op_next || binop->op_type != type) + if (binop->op_next || binop->op_type != (OPCODE)type) return (OP*)binop; binop->op_last = binop->op_first->op_sibling; @@ -2672,7 +2661,6 @@ if (complement) { U8 tmpbuf[UTF8_MAXLEN+1]; U8** cp; - I32* cl; UV nextmin = 0; New(1109, cp, tlen, U8*); i = 0; @@ -2833,17 +2821,17 @@ tbl = (short*)cPVOPo->op_pv; if (complement) { Zero(tbl, 256, short); - for (i = 0; i < tlen; i++) + for (i = 0; i < (I32)tlen; i++) tbl[t[i]] = -1; for (i = 0, j = 0; i < 256; i++) { if (!tbl[i]) { - if (j >= rlen) { + if (j >= (I32)rlen) { if (del) tbl[i] = -2; else if (rlen) tbl[i] = r[j-1]; else - tbl[i] = i; + tbl[i] = (short)i; } else { if (i < 128 && r[j] >= 128) @@ -2861,8 +2849,8 @@ } for (i = 0; i < 256; i++) tbl[i] = -1; - for (i = 0, j = 0; i < tlen; i++,j++) { - if (j >= rlen) { + for (i = 0, j = 0; i < (I32)tlen; i++,j++) { + if (j >= (I32)rlen) { if (del) { if (tbl[t[i]] == -1) tbl[t[i]] = -2; @@ -2891,10 +2879,10 @@ PMOP *pmop; NewOp(1101, pmop, 1, PMOP); - pmop->op_type = type; + pmop->op_type = (OPCODE)type; pmop->op_ppaddr = PL_ppaddr[type]; - pmop->op_flags = flags; - pmop->op_private = 0 | (flags >> 8); + pmop->op_flags = (U8)flags; + pmop->op_private = (U8)(0 | (flags >> 8)); if (PL_hints & HINT_RE_TAINT) pmop->op_pmpermflags |= PMf_RETAINT; @@ -2977,7 +2965,7 @@ if (pm->op_pmflags & PMf_EVAL) { curop = 0; if (CopLINE(PL_curcop) < PL_multi_end) - CopLINE_set(PL_curcop, PL_multi_end); + CopLINE_set(PL_curcop, (line_t)PL_multi_end); } #ifdef USE_THREADS else if (repl->op_type == OP_THREADSV @@ -3069,11 +3057,11 @@ { SVOP *svop; NewOp(1101, svop, 1, SVOP); - svop->op_type = type; + svop->op_type = (OPCODE)type; svop->op_ppaddr = PL_ppaddr[type]; svop->op_sv = sv; svop->op_next = (OP*)svop; - svop->op_flags = flags; + svop->op_flags = (U8)flags; if (PL_opargs[type] & OA_RETSCALAR) scalar((OP*)svop); if (PL_opargs[type] & OA_TARGET) @@ -3086,14 +3074,14 @@ { PADOP *padop; NewOp(1101, padop, 1, PADOP); - padop->op_type = type; + padop->op_type = (OPCODE)type; padop->op_ppaddr = PL_ppaddr[type]; padop->op_padix = pad_alloc(type, SVs_PADTMP); SvREFCNT_dec(PL_curpad[padop->op_padix]); PL_curpad[padop->op_padix] = sv; SvPADTMP_on(sv); padop->op_next = (OP*)padop; - padop->op_flags = flags; + padop->op_flags = (U8)flags; if (PL_opargs[type] & OA_RETSCALAR) scalar((OP*)padop); if (PL_opargs[type] & OA_TARGET) @@ -3117,11 +3105,11 @@ { PVOP *pvop; NewOp(1101, pvop, 1, PVOP); - pvop->op_type = type; + pvop->op_type = (OPCODE)type; pvop->op_ppaddr = PL_ppaddr[type]; pvop->op_pv = pv; pvop->op_next = (OP*)pvop; - pvop->op_flags = flags; + pvop->op_flags = (U8)flags; if (PL_opargs[type] & OA_RETSCALAR) scalar((OP*)pvop); if (PL_opargs[type] & OA_TARGET) @@ -3158,10 +3146,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg) { OP *pack; - OP *rqop; OP *imop; OP *veop; - GV *gv; if (id->op_type != OP_CONST) Perl_croak(aTHX_ "Module name must be constant"); @@ -3219,22 +3205,6 @@ newSVOP(OP_METHOD_NAMED, 0, meth))); } - /* Fake up a require, handle override, if any */ - gv = gv_fetchpv("require", FALSE, SVt_PVCV); - if (!(gv && GvIMPORTED_CV(gv))) - gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV); - - if (gv && GvIMPORTED_CV(gv)) { - rqop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED, - append_elem(OP_LIST, id, - scalar(newUNOP(OP_RV2CV, 0, - newGVOP(OP_GV, 0, - gv)))))); - } - else { - rqop = newUNOP(OP_REQUIRE, 0, id); - } - /* Fake up the BEGIN {}, which does its thing immediately. */ newATTRSUB(floor, newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)), @@ -3242,7 +3212,7 @@ Nullop, append_elem(OP_LINESEQ, append_elem(OP_LINESEQ, - newSTATEOP(0, Nullch, rqop), + newSTATEOP(0, Nullch, newUNOP(OP_REQUIRE, 0, id)), newSTATEOP(0, Nullch, veop)), newSTATEOP(0, Nullch, imop) )); @@ -3407,7 +3377,7 @@ } curop = list(force_list(left)); o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop); - o->op_private = 0 | (flags >> 8); + o->op_private = (U8)(0 | (flags >> 8)); for (curop = ((LISTOP*)curop)->op_first; curop; curop = curop->op_sibling) { @@ -3424,7 +3394,7 @@ if (PL_opargs[curop->op_type] & OA_DANGEROUS) { if (curop->op_type == OP_GV) { GV *gv = cGVOPx_gv(curop); - if (gv == PL_defgv || SvCUR(gv) == PL_generation) + if (gv == PL_defgv || (int)SvCUR(gv) == PL_generation) break; SvCUR(gv) = PL_generation; } @@ -3434,7 +3404,7 @@ curop->op_type == OP_PADANY) { SV **svp = AvARRAY(PL_comppad_name); SV *sv = svp[curop->op_targ]; - if (SvCUR(sv) == PL_generation) + if ((int)SvCUR(sv) == PL_generation) break; SvCUR(sv) = PL_generation; /* (SvCUR not used any more) */ } @@ -3454,7 +3424,7 @@ #else GV *gv = (GV*)((PMOP*)curop)->op_pmreplroot; #endif - if (gv == PL_defgv || SvCUR(gv) == PL_generation) + if (gv == PL_defgv || (int)SvCUR(gv) == PL_generation) break; SvCUR(gv) = PL_generation; } @@ -3545,8 +3515,8 @@ cop->op_type = OP_NEXTSTATE; cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ]; } - cop->op_flags = flags; - cop->op_private = (PL_hints & HINT_BYTE); + cop->op_flags = (U8)flags; + cop->op_private = (U8)(PL_hints & (HINT_BYTE|HINT_LOCALE)); #ifdef NATIVE_HINTS cop->op_private |= NATIVE_HINTS; #endif @@ -3687,7 +3657,7 @@ || k1->op_type == OP_EACH) { warnop = ((k1->op_type == OP_NULL) - ? k1->op_targ : k1->op_type); + ? (OPCODE)k1->op_targ : k1->op_type); } break; } @@ -3711,12 +3681,12 @@ NewOp(1101, logop, 1, LOGOP); - logop->op_type = type; + logop->op_type = (OPCODE)type; logop->op_ppaddr = PL_ppaddr[type]; logop->op_first = first; logop->op_flags = flags | OPf_KIDS; logop->op_other = LINKLIST(other); - logop->op_private = 1 | (flags >> 8); + logop->op_private = (U8)(1 | (flags >> 8)); /* establish postfix order */ logop->op_next = LINKLIST(first); @@ -3763,7 +3733,7 @@ logop->op_ppaddr = PL_ppaddr[OP_COND_EXPR]; logop->op_first = first; logop->op_flags = flags | OPf_KIDS; - logop->op_private = 1 | (flags >> 8); + logop->op_private = (U8)(1 | (flags >> 8)); logop->op_other = LINKLIST(trueop); logop->op_next = LINKLIST(falseop); @@ -3799,7 +3769,7 @@ range->op_flags = OPf_KIDS; leftstart = LINKLIST(left); range->op_other = LINKLIST(right); - range->op_private = 1 | (flags >> 8); + range->op_private = (U8)(1 | (flags >> 8)); left->op_sibling = right; @@ -3933,7 +3903,7 @@ next = unstack; cont = append_elem(OP_LINESEQ, cont, unstack); if ((line_t)whileline != NOLINE) { - PL_copline = whileline; + PL_copline = (line_t)whileline; cont = append_elem(OP_LINESEQ, cont, newSTATEOP(0, Nullch, Nullop)); } @@ -3943,7 +3913,7 @@ redo = LINKLIST(listop); if (expr) { - PL_copline = whileline; + PL_copline = (line_t)whileline; scalar(listop); o = new_logop(OP_AND, 0, &expr, &listop); if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) { @@ -4135,9 +4105,15 @@ * CV, they don't hold a refcount on the outside CV. This avoids * the refcount loop between the outer CV (which keeps a refcount to * the closure prototype in the pad entry for pp_anoncode()) and the - * closure prototype, and the ensuing memory leak. --GSAR */ - if (!CvANON(cv) || CvCLONED(cv)) + * closure prototype, and the ensuing memory leak. This does not + * apply to closures generated within eval"", since eval"" CVs are + * ephemeral. --GSAR */ + if (!CvANON(cv) || CvCLONED(cv) + || (CvOUTSIDE(cv) && SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV + && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv)))) + { SvREFCNT_dec(CvOUTSIDE(cv)); + } CvOUTSIDE(cv) = Nullcv; if (CvPADLIST(cv)) { /* may be during global destruction */ @@ -4514,7 +4490,7 @@ if (!block) goto withattrs; if ((const_sv = cv_const_sv(cv))) - const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv)); + const_changed = (bool)sv_cmp(const_sv, op_const_sv(block, Nullcv)); if ((const_sv || const_changed) && ckWARN(WARN_REDEFINE)) { line_t oldline = CopLINE(PL_curcop); @@ -4694,12 +4670,17 @@ } } - /* If a potential closure prototype, don't keep a refcount on outer CV. + /* If a potential closure prototype, don't keep a refcount on + * outer CV, unless the latter happens to be a passing eval"". * This is okay as the lifetime of the prototype is tied to the * lifetime of the outer CV. Avoids memory leak due to reference * loop. --GSAR */ - if (!name) + if (!name && CvOUTSIDE(cv) + && !(SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV + && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv)))) + { SvREFCNT_dec(CvOUTSIDE(cv)); + } if (name || aname) { char *s; @@ -4753,7 +4734,7 @@ call_list(oldscope, PL_beginav); PL_curcop = &PL_compiling; - PL_compiling.op_private = PL_hints; + PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK); LEAVE; } else if (strEQ(s, "END") && !PL_error_count) { @@ -5147,7 +5128,7 @@ OP * Perl_ck_bitop(pTHX_ OP *o) { - o->op_private = PL_hints; + o->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK); return o; } @@ -5471,13 +5452,6 @@ else o = newUNOP(type, 0, newDEFSVOP()); } -#ifdef USE_LOCALE - if (type == OP_FTTEXT || type == OP_FTBINARY) { - o->op_private = 0; - if (PL_hints & HINT_LOCALE) - o->op_private |= OPpLOCALE; - } -#endif return o; } @@ -5878,29 +5852,7 @@ if (!kid) append_elem(o->op_type, o, newDEFSVOP()); - o = listkids(o); - - o->op_private = 0; -#ifdef USE_LOCALE - if (PL_hints & HINT_LOCALE) - o->op_private |= OPpLOCALE; -#endif - - return o; -} - -OP * -Perl_ck_fun_locale(pTHX_ OP *o) -{ - o = ck_fun(o); - - o->op_private = 0; -#ifdef USE_LOCALE - if (PL_hints & HINT_LOCALE) - o->op_private |= OPpLOCALE; -#endif - - return o; + return listkids(o