From: Jarkko Hietaniemi Date: Wed, 7 Jun 2000 02:41:50 +0000 (+0000) Subject: Mopup for #6204. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d11915b82a23265566d9643e95935294732103a8;hp=b8b4c9f3cf6ef09c878a80ff97526a69902a44ca;p=p5sagit%2Fp5-mst-13.2.git Mopup for #6204. Under the 5005 threads the t/lib/b.t for B::Deparse fails: Can't locate object method "PV" via package "B::RV" at ../lib/B/Deparse.pm line 2360. This is comes from const() where POK isn't on when expected. p4raw-id: //depot/cfgperl@6211 --- diff --git a/embedvar.h b/embedvar.h index 889b4d4..87437e3 100644 --- a/embedvar.h +++ b/embedvar.h @@ -196,6 +196,7 @@ #define PL_argvoutgv (PERL_GET_INTERP->Iargvoutgv) #define PL_basetime (PERL_GET_INTERP->Ibasetime) #define PL_beginav (PERL_GET_INTERP->Ibeginav) +#define PL_beginav_save (PERL_GET_INTERP->Ibeginav_save) #define PL_bitcount (PERL_GET_INTERP->Ibitcount) #define PL_bufend (PERL_GET_INTERP->Ibufend) #define PL_bufptr (PERL_GET_INTERP->Ibufptr) @@ -246,6 +247,7 @@ #define PL_exitlistlen (PERL_GET_INTERP->Iexitlistlen) #define PL_expect (PERL_GET_INTERP->Iexpect) #define PL_fdpid (PERL_GET_INTERP->Ifdpid) +#define PL_fdpid_mutex (PERL_GET_INTERP->Ifdpid_mutex) #define PL_filemode (PERL_GET_INTERP->Ifilemode) #define PL_forkprocess (PERL_GET_INTERP->Iforkprocess) #define PL_formfeed (PERL_GET_INTERP->Iformfeed) @@ -377,6 +379,7 @@ #define PL_subname (PERL_GET_INTERP->Isubname) #define PL_sv_arenaroot (PERL_GET_INTERP->Isv_arenaroot) #define PL_sv_count (PERL_GET_INTERP->Isv_count) +#define PL_sv_lock_mutex (PERL_GET_INTERP->Isv_lock_mutex) #define PL_sv_mutex (PERL_GET_INTERP->Isv_mutex) #define PL_sv_no (PERL_GET_INTERP->Isv_no) #define PL_sv_objcount (PERL_GET_INTERP->Isv_objcount) @@ -461,6 +464,7 @@ #define PL_argvoutgv (vTHX->Iargvoutgv) #define PL_basetime (vTHX->Ibasetime) #define PL_beginav (vTHX->Ibeginav) +#define PL_beginav_save (vTHX->Ibeginav_save) #define PL_bitcount (vTHX->Ibitcount) #define PL_bufend (vTHX->Ibufend) #define PL_bufptr (vTHX->Ibufptr) @@ -511,6 +515,7 @@ #define PL_exitlistlen (vTHX->Iexitlistlen) #define PL_expect (vTHX->Iexpect) #define PL_fdpid (vTHX->Ifdpid) +#define PL_fdpid_mutex (vTHX->Ifdpid_mutex) #define PL_filemode (vTHX->Ifilemode) #define PL_forkprocess (vTHX->Iforkprocess) #define PL_formfeed (vTHX->Iformfeed) @@ -642,6 +647,7 @@ #define PL_subname (vTHX->Isubname) #define PL_sv_arenaroot (vTHX->Isv_arenaroot) #define PL_sv_count (vTHX->Isv_count) +#define PL_sv_lock_mutex (vTHX->Isv_lock_mutex) #define PL_sv_mutex (vTHX->Isv_mutex) #define PL_sv_no (vTHX->Isv_no) #define PL_sv_objcount (vTHX->Isv_objcount) @@ -863,6 +869,7 @@ #define PL_argvoutgv (aTHXo->interp.Iargvoutgv) #define PL_basetime (aTHXo->interp.Ibasetime) #define PL_beginav (aTHXo->interp.Ibeginav) +#define PL_beginav_save (aTHXo->interp.Ibeginav_save) #define PL_bitcount (aTHXo->interp.Ibitcount) #define PL_bufend (aTHXo->interp.Ibufend) #define PL_bufptr (aTHXo->interp.Ibufptr) @@ -913,6 +920,7 @@ #define PL_exitlistlen (aTHXo->interp.Iexitlistlen) #define PL_expect (aTHXo->interp.Iexpect) #define PL_fdpid (aTHXo->interp.Ifdpid) +#define PL_fdpid_mutex (aTHXo->interp.Ifdpid_mutex) #define PL_filemode (aTHXo->interp.Ifilemode) #define PL_forkprocess (aTHXo->interp.Iforkprocess) #define PL_formfeed (aTHXo->interp.Iformfeed) @@ -1044,6 +1052,7 @@ #define PL_subname (aTHXo->interp.Isubname) #define PL_sv_arenaroot (aTHXo->interp.Isv_arenaroot) #define PL_sv_count (aTHXo->interp.Isv_count) +#define PL_sv_lock_mutex (aTHXo->interp.Isv_lock_mutex) #define PL_sv_mutex (aTHXo->interp.Isv_mutex) #define PL_sv_no (aTHXo->interp.Isv_no) #define PL_sv_objcount (aTHXo->interp.Isv_objcount) @@ -1129,6 +1138,7 @@ #define PL_Iargvoutgv PL_argvoutgv #define PL_Ibasetime PL_basetime #define PL_Ibeginav PL_beginav +#define PL_Ibeginav_save PL_beginav_save #define PL_Ibitcount PL_bitcount #define PL_Ibufend PL_bufend #define PL_Ibufptr PL_bufptr @@ -1179,6 +1189,7 @@ #define PL_Iexitlistlen PL_exitlistlen #define PL_Iexpect PL_expect #define PL_Ifdpid PL_fdpid +#define PL_Ifdpid_mutex PL_fdpid_mutex #define PL_Ifilemode PL_filemode #define PL_Iforkprocess PL_forkprocess #define PL_Iformfeed PL_formfeed @@ -1310,6 +1321,7 @@ #define PL_Isubname PL_subname #define PL_Isv_arenaroot PL_sv_arenaroot #define PL_Isv_count PL_sv_count +#define PL_Isv_lock_mutex PL_sv_lock_mutex #define PL_Isv_mutex PL_sv_mutex #define PL_Isv_no PL_sv_no #define PL_Isv_objcount PL_sv_objcount diff --git a/ext/B/B.xs b/ext/B/B.xs index df5267e..bf54795 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -408,8 +408,10 @@ B_init_av() B::AV B_begin_av() + B::AV B_end_av() + B::CV B_main_cv() @@ -527,6 +529,7 @@ void save_BEGINs() CODE: PL_minus_c |= 0x10; + SV * cstring(sv) SV * sv diff --git a/ext/B/B/Asmdata.pm b/ext/B/B/Asmdata.pm index bc0eda9..314498d 100644 --- a/ext/B/B/Asmdata.pm +++ b/ext/B/B/Asmdata.pm @@ -15,7 +15,7 @@ use Exporter; our(%insn_data, @insn_name, @optype, @specialsv_name); @optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP); -@specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no); +@specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no pWARN_ALL pWARN_NONE); # XXX insn_data is initialised this way because with a large # %insn_data = (foo => [...], bar => [...], ...) initialiser @@ -138,6 +138,9 @@ $insn_data{cop_warnings} = [114, \&PUT_svindex, "GET_svindex"]; $insn_data{main_start} = [115, \&PUT_opindex, "GET_opindex"]; $insn_data{main_root} = [116, \&PUT_opindex, "GET_opindex"]; $insn_data{curpad} = [117, \&PUT_svindex, "GET_svindex"]; +$insn_data{push_begin} = [118, \&PUT_svindex, "GET_svindex"]; +$insn_data{push_init} = [119, \&PUT_svindex, "GET_svindex"]; +$insn_data{push_end} = [120, \&PUT_svindex, "GET_svindex"]; my ($insn_name, $insn_data); while (($insn_name, $insn_data) = each %insn_data) { diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h index 1621fed..d5bd32c 100644 --- a/ext/ByteLoader/bytecode.h +++ b/ext/ByteLoader/bytecode.h @@ -8,26 +8,29 @@ typedef OP *opindex; typedef IV IV64; #define BGET_FREAD(argp, len, nelem) \ - bs.pfread((char*)(argp),(len),(nelem),bs.data) -#define BGET_FGETC() bs.pfgetc(bs.data) + PerlIO_read(PL_rsfp,(char*)(argp),(len)*(nelem)) +#define BGET_FGETC() PerlIO_getc(PL_rsfp) #define BGET_U32(arg) \ - BGET_FREAD(&arg, sizeof(U32), 1); arg = PerlSock_ntohl((U32)arg) + BGET_FREAD(&arg, sizeof(U32), 1) #define BGET_I32(arg) \ - BGET_FREAD(&arg, sizeof(I32), 1); arg = (I32)PerlSock_ntohl((U32)arg) + BGET_FREAD(&arg, sizeof(I32), 1) #define BGET_U16(arg) \ - BGET_FREAD(&arg, sizeof(U16), 1); arg = PerlSock_ntohs((U16)arg) + BGET_FREAD(&arg, sizeof(U16), 1) #define BGET_U8(arg) arg = BGET_FGETC() -#define BGET_PV(arg) STMT_START { \ - BGET_U32(arg); \ - if (arg) \ - bs.pfreadpv(arg, bs.data, &bytecode_pv); \ - else { \ - bytecode_pv.xpv_pv = 0; \ - bytecode_pv.xpv_len = 0; \ - bytecode_pv.xpv_cur = 0; \ - } \ +#define BGET_PV(arg) STMT_START { \ + BGET_U32(arg); \ + if (arg) { \ + New(666, bytecode_pv.xpv_pv, arg, char); \ + PerlIO_read(PL_rsfp, (void*)bytecode_pv.xpv_pv, arg); \ + bytecode_pv.xpv_len = arg; \ + bytecode_pv.xpv_cur = arg - 1; \ + } else { \ + bytecode_pv.xpv_pv = 0; \ + bytecode_pv.xpv_len = 0; \ + bytecode_pv.xpv_cur = 0; \ + } \ } STMT_END #ifdef BYTELOADER_LOG_COMMENTS @@ -63,19 +66,17 @@ typedef IV IV64; arg = (I32)lo; \ } \ else { \ - bytecode_iv_overflows++; \ + bytecode_iv_overflows++; \ arg = 0; \ } \ } STMT_END -#define BGET_op_tr_array(arg) do { \ - unsigned short *ary; \ - int i; \ - New(666, ary, 256, unsigned short); \ - BGET_FREAD(ary, 256, 2); \ - for (i = 0; i < 256; i++) \ - ary[i] = PerlSock_ntohs(ary[i]); \ - arg = (char *) ary; \ +#define BGET_op_tr_array(arg) do { \ + unsigned short *ary; \ + int i; \ + New(666, ary, 256, unsigned short); \ + BGET_FREAD(ary, sizeof(unsigned short), 256); \ + arg = (char *) ary; \ } while (0) #define BGET_pvcontents(arg) arg = bytecode_pv.xpv_pv @@ -126,7 +127,13 @@ typedef IV IV64; #define BSET_pregcomp(o, arg) \ ((PMOP*)o)->op_pmregexp = arg ? \ CALLREGCOMP(aTHX_ arg, arg + bytecode_pv.xpv_cur, ((PMOP*)o)) : 0 -#define BSET_newsv(sv, arg) sv = NEWSV(666,0); SvUPGRADE(sv, arg) +#define BSET_newsv(sv, arg) \ + STMT_START { \ + sv = (arg == SVt_PVAV ? (SV*)newAV() : \ + arg == SVt_PVHV ? (SV*)newHV() : \ + NEWSV(666,0)); \ + SvUPGRADE(sv, arg); \ + } STMT_END #define BSET_newop(o, arg) ((o = (OP*)safemalloc(optype_size[arg])), \ memzero((char*)o,optype_size[arg])) #define BSET_newopn(o, arg) STMT_START { \ @@ -135,7 +142,12 @@ typedef IV IV64; oldop->op_next = o; \ } STMT_END -#define BSET_ret(foo) return +#define BSET_ret(foo) STMT_START { \ + if (bytecode_obj_list) \ + Safefree(bytecode_obj_list); \ + LEAVE; \ + return; \ + } STMT_END /* * Kludge special-case workaround for OP_MAPSTART @@ -152,10 +164,73 @@ typedef IV IV64; PL_comppad = (AV *)arg; \ pad = AvARRAY(arg); \ } STMT_END +/* this works now that Sarathy's changed the CopFILE_set macro to do the SvREFCNT_inc() + -- BKS 6-2-2000 */ #define BSET_cop_file(cop, arg) CopFILE_set(cop,arg) #define BSET_cop_line(cop, arg) CopLINE_set(cop,arg) #define BSET_cop_stashpv(cop, arg) CopSTASHPV_set(cop,arg) -#define BSET_OBJ_STORE(obj, ix) \ +/* this is simply stolen from the code in newATTRSUB() */ +#define BSET_push_begin(ary,cv) \ + STMT_START { \ + I32 oldscope = PL_scopestack_ix; \ + ENTER; \ + SAVECOPFILE(&PL_compiling); \ + SAVECOPLINE(&PL_compiling); \ + save_svref(&PL_rs); \ + sv_setsv(PL_rs, PL_nrs); \ + if (!PL_beginav) \ + PL_beginav = newAV(); \ + av_push(PL_beginav, cv); \ + call_list(oldscope, PL_beginav); \ + PL_curcop = &PL_compiling; \ + PL_compiling.op_private = PL_hints; \ + LEAVE; \ + } STMT_END +#define BSET_push_init(ary,cv) \ + STMT_START { \ + av_unshift((PL_initav ? PL_initav : (PL_initav = newAV(), PL_initav)), 1); \ + av_store(PL_initav, 0, cv); \ + } STMT_END +#define BSET_push_end(ary,cv) \ + STMT_START { \ + av_unshift((PL_endav ? PL_endav : (PL_endav = newAV(), PL_endav)), 1); \ + av_store(PL_endav, 0, cv); \ + } STMT_END +#define BSET_OBJ_STORE(obj, ix) \ (I32)ix > bytecode_obj_list_fill ? \ bset_obj_store(aTHXo_ obj, (I32)ix) : (bytecode_obj_list[ix] = obj) +#define BYTECODE_HEADER_CHECK \ + STMT_START { \ + U32 sz; \ + strconst str; \ + char *badpart; \ + \ + BGET_U32(sz); /* Magic: 'PLBC' */ \ + if (sz != 0x43424c50) { \ + badpart = "bad magic"; \ + goto bch_fail; \ + } \ + BGET_strconst(str); /* archname */ \ + if (strNE(str, ARCHNAME)) { \ + badpart = "wrong architecture"; \ + goto bch_fail; \ + } \ + BGET_U32(sz); /* ivsize */ \ + if (sz != IVSIZE) { \ + badpart = "different IVSIZE"; \ + goto bch_fail; \ + } \ + BGET_U32(sz); /* ptrsize */ \ + if (sz != PTRSIZE) { \ + badpart = "different PTRSIZE"; \ + goto bch_fail; \ + } \ + BGET_strconst(str); /* byteorder */ \ + if (strNE(str, STRINGIFY(BYTEORDER))) { \ + badpart = "different byteorder"; \ + bch_fail: \ + Perl_croak(aTHX_ "Invalid bytecode for this architecture: %s\n", \ + badpart); \ + } \ + } STMT_END diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c index a1044ab..091767e 100644 --- a/ext/ByteLoader/byterun.c +++ b/ext/ByteLoader/byterun.c @@ -26,7 +26,7 @@ #include "bytecode.h" -static int optype_size[] = { +static const int optype_size[] = { sizeof(OP), sizeof(UNOP), sizeof(BINOP), @@ -40,12 +40,8 @@ static int optype_size[] = { sizeof(COP) }; -static SV *specialsv_list[4]; - static int bytecode_iv_overflows = 0; -static SV *bytecode_sv; -static XPV bytecode_pv; -static void **bytecode_obj_list; +static void **bytecode_obj_list = Null(void**); static I32 bytecode_obj_list_fill = -1; void * @@ -53,9 +49,9 @@ bset_obj_store(pTHXo_ void *obj, I32 ix) { if (ix > bytecode_obj_list_fill) { if (bytecode_obj_list_fill == -1) - New(666, bytecode_obj_list, ix + 1, void*); + New(666, bytecode_obj_list, ix + 32, void*); else - Renew(bytecode_obj_list, ix + 1, void*); + Renew(bytecode_obj_list, ix + 32, void*); bytecode_obj_list_fill = ix; } bytecode_obj_list[ix] = obj; @@ -63,15 +59,26 @@ bset_obj_store(pTHXo_ void *obj, I32 ix) } void -byterun(pTHXo_ struct bytestream bs) +byterun(pTHXo) { dTHR; int insn; + SV *bytecode_sv; + XPV bytecode_pv; + SV *specialsv_list[6]; + ENTER; + SAVEVPTR(bytecode_obj_list); + SAVEI32(bytecode_obj_list_fill); + bytecode_obj_list = Null(void**); + bytecode_obj_list_fill = -1; + BYTECODE_HEADER_CHECK; /* croak if incorrect platform */ specialsv_list[0] = Nullsv; specialsv_list[1] = &PL_sv_undef; specialsv_list[2] = &PL_sv_yes; specialsv_list[3] = &PL_sv_no; + specialsv_list[4] = pWARN_ALL; + specialsv_list[5] = pWARN_NONE; while ((insn = BGET_FGETC()) != EOF) { switch (insn) { @@ -891,6 +898,27 @@ byterun(pTHXo_ struct bytestream bs) BSET_curpad(PL_curpad, arg); break; } + case INSN_PUSH_BEGIN: /* 118 */ + { + svindex arg; + BGET_svindex(arg); + BSET_push_begin(PL_beginav, arg); + break; + } + case INSN_PUSH_INIT: /* 119 */ + { + svindex arg; + BGET_svindex(arg); + BSET_push_init(PL_initav, arg); + break; + } + case INSN_PUSH_END: /* 120 */ + { + svindex arg; + BGET_svindex(arg); + BSET_push_end(PL_endav, arg); + break; + } default: Perl_croak(aTHX_ "Illegal bytecode instruction %d\n", insn); /* NOTREACHED */ diff --git a/ext/ByteLoader/byterun.h b/ext/ByteLoader/byterun.h index f0de6b4..52f6241 100644 --- a/ext/ByteLoader/byterun.h +++ b/ext/ByteLoader/byterun.h @@ -8,7 +8,7 @@ /* * This file is autogenerated from bytecode.pl. Changes made here will be lost. */ -struct bytestream { +struct bytestream { /* XXX: not currently used - too slow */ void *data; int (*pfgetc)(void *); int (*pfread)(char *, size_t, size_t, void *); @@ -134,7 +134,10 @@ enum { INSN_MAIN_START, /* 115 */ INSN_MAIN_ROOT, /* 116 */ INSN_CURPAD, /* 117 */ - MAX_INSN = 117 + INSN_PUSH_BEGIN, /* 118 */ + INSN_PUSH_INIT, /* 119 */ + INSN_PUSH_END, /* 120 */ + MAX_INSN = 120 }; enum { @@ -151,11 +154,4 @@ enum { OPt_COP /* 10 */ }; -extern void byterun(pTHXo_ struct bytestream bs); - -#define INIT_SPECIALSV_LIST STMT_START { \ - PL_specialsv_list[0] = Nullsv; \ - PL_specialsv_list[1] = &PL_sv_undef; \ - PL_specialsv_list[2] = &PL_sv_yes; \ - PL_specialsv_list[3] = &PL_sv_no; \ - } STMT_END +extern void byterun(pTHXo); diff --git a/perlapi.c b/perlapi.c index d3e2482..396e101 100755 --- a/perlapi.c +++ b/perlapi.c @@ -4025,6 +4025,13 @@ Perl_sys_intern_init(pTHXo) # if defined(LEAKTEST) # endif #endif + +#undef Perl_lock +SV* +Perl_lock(pTHXo_ SV *sv) +{ + return ((CPerlObj*)pPerl)->Perl_lock(sv); +} #if defined(PERL_OBJECT) #endif diff --git a/perlapi.h b/perlapi.h index 634634c..7d09904 100755 --- a/perlapi.h +++ b/perlapi.h @@ -130,6 +130,8 @@ START_EXTERN_C #define PL_basetime (*Perl_Ibasetime_ptr(aTHXo)) #undef PL_beginav #define PL_beginav (*Perl_Ibeginav_ptr(aTHXo)) +#undef PL_beginav_save +#define PL_beginav_save (*Perl_Ibeginav_save_ptr(aTHXo)) #undef PL_bitcount #define PL_bitcount (*Perl_Ibitcount_ptr(aTHXo)) #undef PL_bufend @@ -230,6 +232,8 @@ START_EXTERN_C #define PL_expect (*Perl_Iexpect_ptr(aTHXo)) #undef PL_fdpid #define PL_fdpid (*Perl_Ifdpid_ptr(aTHXo)) +#undef PL_fdpid_mutex +#define PL_fdpid_mutex (*Perl_Ifdpid_mutex_ptr(aTHXo)) #undef PL_filemode #define PL_filemode (*Perl_Ifilemode_ptr(aTHXo)) #undef PL_forkprocess @@ -492,6 +496,8 @@ START_EXTERN_C #define PL_sv_arenaroot (*Perl_Isv_arenaroot_ptr(aTHXo)) #undef PL_sv_count #define PL_sv_count (*Perl_Isv_count_ptr(aTHXo)) +#undef PL_sv_lock_mutex +#define PL_sv_lock_mutex (*Perl_Isv_lock_mutex_ptr(aTHXo)) #undef PL_sv_mutex #define PL_sv_mutex (*Perl_Isv_mutex_ptr(aTHXo)) #undef PL_sv_no diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 19ab71f..9b3d20a 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -1359,6 +1359,13 @@ Returns the size of the string buffer in the SV. See C. STRLEN SvLEN(SV* sv) +=item SvLOCK + +Aquires an internal mutex for a SV. Used to make sure multiple threads +don't stomp on the guts of an SV at the same time + + void SvLOCK(SV* sv) + =item SvNIOK Returns a boolean indicating whether the SV contains a number, integer or @@ -1604,17 +1611,17 @@ false, defined or undefined. Does not handle 'get' magic. bool SvTRUE(SV* sv) -=item svtype - -An enum of flags for Perl types. These are found in the file B -in the C enum. Test these flags with the C macro. - =item SvTYPE Returns the type of the SV. See C. svtype SvTYPE(SV* sv) +=item svtype + +An enum of flags for Perl types. These are found in the file B +in the C enum. Test these flags with the C macro. + =item SVt_IV Integer type flag for scalars. See C. @@ -1643,6 +1650,12 @@ Type flag for hashes. See C. Type flag for blessed scalars. See C. +=item SvUNLOCK + +Release the internal mutex for an SV. + + void SvUNLOCK(SV* sv) + =item SvUPGRADE Used to upgrade an SV to a more complex form. Uses C to