#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)
#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)
#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)
#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)
#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)
#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)
#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)
#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)
#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)
#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
#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
#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
B::AV
B_begin_av()
+
B::AV
B_end_av()
+
B::CV
B_main_cv()
save_BEGINs()
CODE:
PL_minus_c |= 0x10;
+
SV *
cstring(sv)
SV * sv
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
$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) {
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
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
#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 { \
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
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
#include "bytecode.h"
-static int optype_size[] = {
+static const int optype_size[] = {
sizeof(OP),
sizeof(UNOP),
sizeof(BINOP),
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 *
{
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;
}
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) {
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 */
/*
* 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 *);
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 {
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);
# 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
#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
#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
#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
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
bool SvTRUE(SV* sv)
-=item svtype
-
-An enum of flags for Perl types. These are found in the file B<sv.h>
-in the C<svtype> enum. Test these flags with the C<SvTYPE> macro.
-
=item SvTYPE
Returns the type of the SV. See C<svtype>.
svtype SvTYPE(SV* sv)
+=item svtype
+
+An enum of flags for Perl types. These are found in the file B<sv.h>
+in the C<svtype> enum. Test these flags with the C<SvTYPE> macro.
+
=item SVt_IV
Integer type flag for scalars. See C<svtype>.
Type flag for blessed scalars. See C<svtype>.
+=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<sv_upgrade> to
projects / p5sagit/p5-mst-13.2.git / commitdiff