MAGIC *find_shadow_magic(SV *p6cb, SV *static_class, SV *obj) {
SV * const obj_deref = SvRV(obj);
MAGIC * mg = mg_find(obj_deref, '~');
if (mg == NULL || ((_perl6_magic*)(mg->mg_ptr))->key != PERL6_EXTENSION_MAGIC_KEY) {
/* need to create the shadow object here */
AV * method_args = newAV();
SV * method_args_rv = newRV_noinc((SV *) method_args);
av_extend(method_args, 1);
SvREFCNT_inc(obj);
av_store(method_args, 0, obj);
AV * args = newAV();
av_extend(args, 3);
SvREFCNT_inc(static_class);
av_store(args, 0, static_class);
av_store(args, 1, newSVpvs("new_shadow_of_p5_object"));
av_store(args, 2, method_args_rv);
MAGIC * const p6cb_mg = mg_find(SvRV(p6cb), '~');
_perl6_magic* const p6cb_p6mg = (_perl6_magic*)(p6cb_mg->mg_ptr);
SV *err = NULL;
SV * const args_rv = newRV_noinc((SV *) args);
declare_cbs;
cbs->call_p6_method(p6cb_p6mg->index, "invoke", 1, args_rv, &err);
SvREFCNT_dec(args_rv);
handle_p6_error(err);
mg = mg_find(obj_deref, '~');
}
return mg;
}
SV *pop_return_values(PerlInterpreter *my_perl, SV **sp, I32 count, I32 *type) {
SV * retval = NULL;
I32 i;
if (count == 1) {
retval = POPs;
SvREFCNT_inc(retval);
*type = p5_get_type(my_perl, retval);
}
else {
if (count > 1) {
retval = (SV *)newAV();
av_extend((AV *)retval, count - 1);
}
for (i = count - 1; i >= 0; i--) {
SV * const next = POPs;
SvREFCNT_inc(next);
if (av_store((AV *)retval, i, next) == NULL)
SvREFCNT_dec(next); /* see perlguts Working with AVs */
}
}
PUTBACK;
return retval;
}
static JSBool
PerlArray(
JSContext *cx,
JSObject *obj,
uintN argc,
jsval *argv,
jsval *rval
) {
dTHX;
AV *av = newAV();
SV *ref = newRV_noinc((SV *)av);
uintN arg;
JSBool ok = JS_FALSE;
SV *sv;
/* If the path fails, the object will be finalized */
JS_SetPrivate(cx, obj, (void *)newRV(&PL_sv_undef));
av_extend(av, argc);
for(arg = 0; arg < argc; arg++) {
if(!PJS_ReflectJS2Perl(aTHX_ cx, argv[arg], &sv, 1) ||
!av_store(av, arg, sv)) goto fail;
}
if(SvTRUE(get_sv(NAMESPACE"PerlArray::construct_blessed", 0)))
sv_bless(ref, gv_stashpv(PerlArrayPkg,0));
ok = PJS_CreateJSVis(aTHX_ cx, obj, ref) != NULL;
fail:
sv_free(ref);
return ok;
}
SV*
Line::to_SV_pureperl() const {
AV* av = newAV();
av_extend(av, 1);
av_store(av, 0, this->a.to_SV_pureperl());
av_store(av, 1, this->b.to_SV_pureperl());
return newRV_noinc((SV*)av);
}
SV*
Line::to_AV() {
AV* av = newAV();
av_extend(av, 1);
av_store(av, 0, perl_to_SV_ref(this->a));
av_store(av, 1, perl_to_SV_ref(this->b));
return newRV_noinc((SV*)av);
}
SV*
MultiPoint::to_SV_pureperl() const {
const unsigned int num_points = this->points.size();
AV* av = newAV();
av_extend(av, num_points-1);
for (unsigned int i = 0; i < num_points; i++) {
av_store(av, i, this->points[i].to_SV_pureperl());
}
return newRV_noinc((SV*)av);
}
MP_INLINE void modperl_perl_av_push_elts_ref(pTHX_ AV *dst, AV *src)
{
I32 i, j, src_fill = AvFILLp(src), dst_fill = AvFILLp(dst);
av_extend(dst, src_fill);
AvFILLp(dst) += src_fill+1;
for (i=dst_fill+1, j=0; j<=AvFILLp(src); i++, j++) {
AvARRAY(dst)[i] = SvREFCNT_inc(AvARRAY(src)[j]);
}
}
SV*
polynode_children_2_perl(const ClipperLib::PolyNode& node)
{
AV* av = newAV();
const unsigned int len = node.ChildCount();
av_extend(av, len-1);
for (int i = 0; i < len; ++i) {
av_store(av, i, polynode2perl(*node.Childs[i]));
}
return (SV*)newRV_noinc((SV*)av);
}
AV *create_args_array(const I32 ax, I32 items, I32 num_fixed_args) {
AV * args = newAV();
av_extend(args, items - num_fixed_args);
int i;
for (i = 0; i < items - num_fixed_args; i++) {
SV * const next = SvREFCNT_inc(ST(i + num_fixed_args));
if (av_store(args, i, next) == NULL)
SvREFCNT_dec(next); /* see perlguts Working with AVs */
}
return args;
}
SV*
ExPolygon::to_SV_pureperl() const
{
const unsigned int num_holes = this->holes.size();
AV* av = newAV();
av_extend(av, num_holes); // -1 +1
av_store(av, 0, this->contour.to_SV_pureperl());
for (unsigned int i = 0; i < num_holes; i++) {
av_store(av, i+1, this->holes[i].to_SV_pureperl());
}
return newRV_noinc((SV*)av);
}
/* convert array header of modperl_handlers_t's to AV ref of CV refs */
SV *modperl_handler_perl_get_handlers(pTHX_ MpAV **handp, apr_pool_t *p)
{
AV *av = newAV();
int i;
modperl_handler_t **handlers;
if (!(handp && *handp)) {
return &PL_sv_undef;
}
av_extend(av, (*handp)->nelts - 1);
handlers = (modperl_handler_t **)(*handp)->elts;
for (i=0; i<(*handp)->nelts; i++) {
modperl_handler_t *handler = NULL;
GV *gv;
if (MpHandlerPARSED(handlers[i])) {
handler = handlers[i];
}
else {
#ifdef USE_ITHREADS
if (!MpHandlerDYNAMIC(handlers[i])) {
handler = modperl_handler_dup(p, handlers[i]);
}
#endif
if (!handler) {
handler = handlers[i];
}
if (!modperl_mgv_resolve(aTHX_ handler, p, handler->name, TRUE)) {
MP_TRACE_h(MP_FUNC, "failed to resolve handler %s",
handler->name);
}
}
if (handler->mgv_cv) {
if ((gv = modperl_mgv_lookup(aTHX_ handler->mgv_cv))) {
CV *cv = modperl_mgv_cv(gv);
av_push(av, newRV_inc((SV*)cv));
}
}
else {
av_push(av, newSVpv(handler->name, 0));
}
}
return newRV_noinc((SV*)av);
}
SV*
Line::to_AV() {
AV* av = newAV();
av_extend(av, 1);
SV* sv = newSV(0);
sv_setref_pv( sv, "Slic3r::Point::Ref", &(this->a) );
av_store(av, 0, sv);
sv = newSV(0);
sv_setref_pv( sv, "Slic3r::Point::Ref", &(this->b) );
av_store(av, 1, sv);
return newRV_noinc((SV*)av);
}
SV*
Line::to_AV() {
AV* av = newAV();
av_extend(av, 1);
SV* sv = newSV(0);
sv_setref_pv( sv, perl_class_name_ref(&this->a), &(this->a) );
av_store(av, 0, sv);
sv = newSV(0);
sv_setref_pv( sv, perl_class_name_ref(&this->b), &(this->b) );
av_store(av, 1, sv);
return newRV_noinc((SV*)av);
}
AV *p5_call_method(PerlInterpreter *my_perl, char *package, SV *obj, char *name, int len, SV *args[]) {
dSP;
int i;
AV * const retval = newAV();
int flags = G_ARRAY | G_EVAL;
PERL_SET_CONTEXT(my_perl);
ENTER;
SAVETMPS;
HV * const pkg = package != NULL ? gv_stashpv(package, 0) : SvSTASH((SV*)SvRV(obj));
GV * const gv = Perl_gv_fetchmethod_autoload(aTHX_ pkg, name, TRUE);
if (gv && isGV(gv)) {
I32 count;
PUSHMARK(SP);
for (i = 0; i < len; i++) {
XPUSHs(sv_2mortal(args[i]));
}
PUTBACK;
SV * const rv = sv_2mortal(newRV((SV*)GvCV(gv)));
count = call_sv(rv, flags);
SPAGAIN;
if (count > 0)
av_extend(retval, count - 1);
for (i = count - 1; i >= 0; i--) {
SV * const next = POPs;
SvREFCNT_inc(next);
if (av_store(retval, i, next) == NULL)
SvREFCNT_dec(next); /* see perlguts Working with AVs */
}
}
else {
ERRSV = newSVpvf("Could not find method \"%s\" of \"%s\" object", name, HvNAME(pkg));
}
PUTBACK;
FREETMPS;
LEAVE;
return retval;
}
AV *p5_call_package_method(PerlInterpreter *my_perl, char *package, char *name, int len, SV *args[]) {
dSP;
int i;
I32 count;
AV * const retval = newAV();
int flags = G_ARRAY | G_EVAL;
PERL_SET_CONTEXT(my_perl);
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(newSVpv(package, 0));
for (i = 0; i < len; i++) {
XPUSHs(sv_2mortal(args[i]));
}
PUTBACK;
count = call_method(name, flags);
SPAGAIN;
if (count > 0)
av_extend(retval, count - 1);
for (i = count - 1; i >= 0; i--) {
SV * const next = POPs;
SvREFCNT_inc(next);
if (av_store(retval, i, next) == NULL)
SvREFCNT_dec(next); /* see perlguts Working with AVs */
}
PUTBACK;
FREETMPS;
LEAVE;
return retval;
}
SV *get_single_hook(pTHX_ const SingleHook *hook)
{
SV *sv;
assert(hook != NULL);
sv = hook->sub;
if (sv == NULL)
return NULL;
sv = newRV_inc(sv);
if (hook->arg)
{
AV *av = newAV();
int j, len = 1 + av_len(hook->arg);
av_extend(av, len);
if (av_store(av, 0, sv) == NULL)
fatal("av_store() failed in get_hooks()");
for (j = 0; j < len; j++)
{
SV **pSV = av_fetch(hook->arg, j, 0);
if (pSV == NULL)
fatal("NULL returned by av_fetch() in get_hooks()");
SvREFCNT_inc(*pSV);
if (av_store(av, j+1, *pSV) == NULL)
fatal("av_store() failed in get_hooks()");
}
sv = newRV_noinc((SV *) av);
}
return sv;
}
static SV *
fold_results(I32 count)
{
dSP;
SV *retval = &PL_sv_undef;
if (count > 1) {
/* convert multiple return items into a list reference */
AV *av = newAV();
SV *last_sv = &PL_sv_undef;
SV *sv = &PL_sv_undef;
I32 i;
av_extend(av, count - 1);
for(i = 1; i <= count; i++) {
last_sv = sv;
sv = POPs;
if (SvOK(sv) && !av_store(av, count - i, SvREFCNT_inc(sv)))
SvREFCNT_dec(sv);
}
PUTBACK;
retval = sv_2mortal((SV *) newRV_noinc((SV *) av));
if (!SvOK(sv) || sv == &PL_sv_undef) {
/* if first element was undef, die */
croak(ERRMSG "Call error");
}
return retval;
}
else {
if (count)
retval = POPs;
PUTBACK;
return retval;
}
}
SV *
toPerl(USER_OBJECT_ val, Rboolean perlOwned)
{
int n = GET_LENGTH(val);
dTHX;
SV *sv = &sv_undef;
if(val == NULL_USER_OBJECT)
return(sv);
if(isRSReferenceObject(val)){
return(getForeignPerlReference(val));
}
if(GET_LENGTH(GET_CLASS(val))) {
SV *o = userLevelConversionToPerl(val);
if(!o)
return(o);
}
if(n == 1) {
if(IS_CHARACTER(val))
sv = newSVpv(CHAR_DEREF(STRING_ELT(val, 0)), 0);
else if(IS_LOGICAL(val))
sv = newSViv(LOGICAL_DATA(val)[0]);
else if(IS_INTEGER(val))
sv = newSViv(INTEGER_DATA(val)[0]);
else if(IS_NUMERIC(val))
sv = newSVnv(NUMERIC_DATA(val)[0]);
else if(IS_FUNCTION(val))
sv = RPerl_createRProxy(val);
} else {
AV *arr;
int i;
arr = newAV();
SvREFCNT_inc(arr);
if(n > 0)
av_extend(arr, n);
/* Did try using av_make() and storing the SVs in an array first, but didn't fix the problem
of bizarre array.
*/
for(i = 0; i < n ; i++) {
if(IS_CHARACTER(val))
sv = newSVpv(CHAR_DEREF(STRING_ELT(val, i)), 0);
else if(IS_LOGICAL(val))
sv = newSViv(LOGICAL_DATA(val)[i]);
else if(IS_INTEGER(val))
sv = newSViv(INTEGER_DATA(val)[i]);
else if(IS_NUMERIC(val))
sv = newSVnv(NUMERIC_DATA(val)[i]);
SvREFCNT_inc(sv);
av_push(arr, sv);
}
sv = (SV *) arr;
SvREFCNT_dec(arr);
#if 0
{SV *rv = newSVrv(arr, NULL);
sv = rv;
}
#endif
}
if(perlOwned)
#if 0 /*XXX Just experimenting */
sv = sv_2mortal(sv);
#else
sv = SvREFCNT_inc(sv);
#endif
return(sv);
}
SV * parse_in_chunks(char * filepath, size_t filesize) {
char *buf;
size_t bytes_read = 0;
int max_buf = 1000;
char *err_msg;
int block = BLOCK_HEADER;
int cur_event_type = 0;
int event_type = 0;
char event_block = 0;
char *brnl, *breq;
AV * data;
AV * datawrapper;
AV * events;
char *line;
char * nl = "\n";
char * eq = "=";
int rewind_pos = 0;
size_t cur_fpos = 0;
SV * pbuf;
SV * pmax_buf;
AV * HANDLERS = get_av("Opsview::Utils::NDOLogsImporter::HANDLERS", 0);
AV * INPUT_DATA_TYPE = get_av("Opsview::Utils::NDOLogsImporter::INPUT_DATA_TYPE", 0);
int init_last_pos;
int init_block;
if ( first_read ) {
if ( ! ( fh = PerlIO_open( filepath, "rb" ) ) ) {
croak("Could not open file: %s\n", strerror(errno));
}
bytes_left = filesize;
init_last_pos = prev_pos = first_read = 0;
init_block = block = BLOCK_HEADER;
} else {
init_block = block = BLOCK_EVENTS;
init_last_pos = prev_pos;
}
read_begin:
brnl = NULL;
breq = NULL;
pbuf = get_sv("Opsview::Utils::NDOLogsImporter::PARSE_BUF", 0);
pmax_buf = get_sv("Opsview::Utils::NDOLogsImporter::MAX_BUF_SIZE", 0);
buf = SvPVX(pbuf);
max_buf = SvIVX(pmax_buf);
if ( max_buf < 1024 * 1024 && ! automated_tests ) {
max_buf = 1024*1024;
SvIV_set( pmax_buf, max_buf );
SvGROW( pbuf, max_buf + 1);
SvCUR_set( pbuf, max_buf);
}
if ( bytes_left > 0 ) {
bytes_read = PerlIO_read(fh, buf + prev_pos, max_buf-prev_pos);
cur_fpos = PerlIO_tell(fh);
if ( bytes_read < 0 ) {
err_msg = strerror(errno);
PerlIO_close( fh );
croak("Could not read file: %s\n", err_msg);
}
bytes_left -= bytes_read;
events = (AV *)sv_2mortal((SV *)newAV());
rewind_pos = last_999(buf+prev_pos, bytes_read);
prev_pos = bytes_read + prev_pos - rewind_pos;
buf[prev_pos] = '\0';
// avg ratio events:file_size = 0.21%
if ( prev_pos > 1000 ) {
av_extend( events, (int)(prev_pos * 0.0021) );
}
for ( line = strtok_r(buf, nl, &brnl); line != NULL; line = strtok_r(NULL, nl, &brnl) )
{
switch(block) {
case BLOCK_HEADER:
{
if ( strEQ(line, "STARTDATADUMP") ) {
block = BLOCK_EVENTS;
}
}
break;
case BLOCK_EVENTS:
{
if ( strEQ(line, "1000") ) { /* NDO_API_ENDDATADUMP */
block = BLOCK_FOOTER;
continue;
}
cur_event_type = atoi(line);
/* ignore events we are not handling */
if ( ! av_exists(HANDLERS, cur_event_type) ) {
block = BLOCK_IGNORE_EVENT;
continue;
}
event_block = BLOCK_EVENT_STARTED;
if ( cur_event_type != event_type ) {
datawrapper = (AV *)sv_2mortal((SV *)newAV());
data = (AV *)sv_2mortal((SV *)newAV());
av_push( events, newSViv( cur_event_type ) );
av_push( datawrapper, newRV( (SV *)data ) );
av_push( events, newRV( (SV *)datawrapper ) );
event_type = cur_event_type;
} else {
data = (AV *)sv_2mortal((SV *)newAV());
av_push( datawrapper, newRV( (SV *)data ) );
}
block = BLOCK_EVENT;
}
break;
case BLOCK_EVENT:
{
if ( strEQ(line, "999") ) { /* NDO_API_ENDDATA */
block = BLOCK_EVENTS;
event_block = BLOCK_EVENT_ENDED;
} else {
char *k;
char *v;
int key;
int key_type = 0;
int v_len = 0;
k = strtok_r(line, eq, &breq);
v = strtok_r(NULL, "\0", &breq);
key = atoi(k);
/* invalid key, skip parsing */
if ( key == 0 ) {
goto remove_invalid;
}
SV ** const k_type = av_fetch(INPUT_DATA_TYPE, key, 0 );
if ( k_type ) {
key_type = SvIVx( *k_type );
}
if ( v ) {
if ( key_type & 1 ) {
v_len = ndo_unescape_buffer( v );
} else {
v_len = strlen(v);
}
}
if ( key_type & 2 ) {
AV * datanstptr;
SV ** const datanst = av_fetch(data, key, 0 );
if ( datanst ) {
datanstptr = (AV *)SvRV( *datanst );
} else {
datanstptr = (AV *)sv_2mortal((SV *)newAV());
av_store( data, key, newRV( (SV *)datanstptr ) );
}
if ( v ) {
av_push( datanstptr, newSVpvn(v, v_len) );
} else {
av_push( datanstptr, newSVpvn("", 0) );
}
} else {
if ( v ) {
av_store( data, key, newSVpvn(v, v_len) );
} else {
av_store( data, key, newSVpvn("", 0) );
}
}
}
}
break;
case BLOCK_FOOTER:
{
if ( strEQ(line, "GOODBYE") ) {
block = BLOCK_HEADER;
}
}
break;
case BLOCK_IGNORE_EVENT:
{
if ( strEQ(line, "999") ) { /* NDO_API_ENDDATA */
block = BLOCK_EVENTS; // go back to EVENTS
continue;
}
}
break;
}
};
/* there were some events */
if ( event_block != BLOCK_HEADER ) {
if ( event_block != BLOCK_EVENT_ENDED ) {
remove_invalid:
av_pop( datawrapper );
}
/* remove whole block if the last block has no events */
if ( av_len( datawrapper ) == -1 ) {
av_pop( events );
av_pop( events );
}
}
if ( av_len(events) > 0 ) {
if ( rewind_pos > 0 && cur_fpos < filesize ) {
memmove(buf, buf+prev_pos+1, rewind_pos-1);
}
prev_pos = rewind_pos - 1;
return newRV_inc((SV *) events);
} else {
if ( cur_fpos < filesize && event_block != BLOCK_HEADER && event_block != BLOCK_EVENT_ENDED ) {
int new_max_buf = max_buf * 2;
SvIV_set( pmax_buf, new_max_buf );
SvGROW( pbuf, new_max_buf + 1);
SvCUR_set( pbuf, new_max_buf);
//start again as previous buffer would be tokenized already
prev_pos = 0;
block = init_block;
event_type = 0;
PerlIO_close( fh );
if ( ! ( fh = PerlIO_open( filepath, "rb" ) ) ) {
croak("Could not re-open file: %s\n", strerror(errno));
}
PerlIO_seek(fh, cur_fpos-bytes_read-init_last_pos, SEEK_SET);
bytes_left += bytes_read + init_last_pos;
goto read_begin;
}
}
}
parser_reset_iterator();
return &PL_sv_undef;
}
static void
report_event(PSTATE* p_state,
event_id_t event,
char *beg, char *end, U32 utf8,
token_pos_t *tokens, int num_tokens,
SV* self
)
{
struct p_handler *h;
dTHX;
dSP;
AV *array;
STRLEN my_na;
char *argspec;
char *s;
#ifdef UNICODE_HTML_PARSER
#define CHR_DIST(a,b) (utf8 ? utf8_distance((U8*)(a),(U8*)(b)) : (a) - (b))
#else
#define CHR_DIST(a,b) ((a) - (b))
#endif
/* capture offsets */
STRLEN offset = p_state->offset;
STRLEN line = p_state->line;
STRLEN column = p_state->column;
#if 0
{ /* used for debugging at some point */
char *s = beg;
int i;
/* print debug output */
switch(event) {
case E_DECLARATION: printf("DECLARATION"); break;
case E_COMMENT: printf("COMMENT"); break;
case E_START: printf("START"); break;
case E_END: printf("END"); break;
case E_TEXT: printf("TEXT"); break;
case E_PROCESS: printf("PROCESS"); break;
case E_NONE: printf("NONE"); break;
default: printf("EVENT #%d", event); break;
}
printf(" [");
while (s < end) {
if (*s == '\n') {
putchar('\\'); putchar('n');
}
else
putchar(*s);
s++;
}
printf("] %d\n", end - beg);
for (i = 0; i < num_tokens; i++) {
printf(" token %d: %d %d\n",
i,
tokens[i].beg - beg,
tokens[i].end - tokens[i].beg);
}
}
#endif
if (p_state->pending_end_tag && event != E_TEXT && event != E_COMMENT) {
token_pos_t t;
char dummy;
t.beg = p_state->pending_end_tag;
t.end = p_state->pending_end_tag + strlen(p_state->pending_end_tag);
p_state->pending_end_tag = 0;
report_event(p_state, E_END, &dummy, &dummy, 0, &t, 1, self);
SPAGAIN;
}
/* update offsets */
p_state->offset += CHR_DIST(end, beg);
if (line) {
char *s = beg;
char *nl = NULL;
while (s < end) {
if (*s == '\n') {
p_state->line++;
nl = s;
}
s++;
}
if (nl)
p_state->column = CHR_DIST(end, nl) - 1;
else
p_state->column += CHR_DIST(end, beg);
}
if (event == E_NONE)
goto IGNORE_EVENT;
#ifdef MARKED_SECTION
if (p_state->ms == MS_IGNORE)
goto IGNORE_EVENT;
#endif
/* tag filters */
if (p_state->ignore_tags || p_state->report_tags || p_state->ignore_elements) {
if (event == E_START || event == E_END) {
SV* tagname = p_state->tmp;
assert(num_tokens >= 1);
sv_setpvn(tagname, tokens[0].beg, tokens[0].end - tokens[0].beg);
if (utf8)
SvUTF8_on(tagname);
else
SvUTF8_off(tagname);
if (!CASE_SENSITIVE(p_state))
sv_lower(aTHX_ tagname);
if (p_state->ignoring_element) {
if (sv_eq(p_state->ignoring_element, tagname)) {
if (event == E_START)
p_state->ignore_depth++;
else if (--p_state->ignore_depth == 0) {
SvREFCNT_dec(p_state->ignoring_element);
p_state->ignoring_element = 0;
}
}
goto IGNORE_EVENT;
}
if (p_state->ignore_elements &&
hv_fetch_ent(p_state->ignore_elements, tagname, 0, 0))
{
p_state->ignoring_element = newSVsv(tagname);
p_state->ignore_depth = 1;
goto IGNORE_EVENT;
}
if (p_state->ignore_tags &&
hv_fetch_ent(p_state->ignore_tags, tagname, 0, 0))
{
goto IGNORE_EVENT;
}
if (p_state->report_tags &&
!hv_fetch_ent(p_state->report_tags, tagname, 0, 0))
{
goto IGNORE_EVENT;
}
}
else if (p_state->ignoring_element) {
goto IGNORE_EVENT;
}
}
h = &p_state->handlers[event];
if (!h->cb) {
/* event = E_DEFAULT; */
h = &p_state->handlers[E_DEFAULT];
if (!h->cb)
goto IGNORE_EVENT;
}
if (SvTYPE(h->cb) != SVt_PVAV && !SvTRUE(h->cb)) {
/* FALSE scalar ('' or 0) means IGNORE this event */
return;
}
if (p_state->unbroken_text && event == E_TEXT) {
/* should buffer text */
if (!p_state->pend_text)
p_state->pend_text = newSV(256);
if (SvOK(p_state->pend_text)) {
if (p_state->is_cdata != p_state->pend_text_is_cdata) {
flush_pending_text(p_state, self);
SPAGAIN;
goto INIT_PEND_TEXT;
}
}
else {
INIT_PEND_TEXT:
p_state->pend_text_offset = offset;
p_state->pend_text_line = line;
p_state->pend_text_column = column;
p_state->pend_text_is_cdata = p_state->is_cdata;
sv_setpvn(p_state->pend_text, "", 0);
if (!utf8)
SvUTF8_off(p_state->pend_text);
}
#ifdef UNICODE_HTML_PARSER
if (utf8 && !SvUTF8(p_state->pend_text))
sv_utf8_upgrade(p_state->pend_text);
if (utf8 || !SvUTF8(p_state->pend_text)) {
sv_catpvn(p_state->pend_text, beg, end - beg);
}
else {
SV *tmp = newSVpvn(beg, end - beg);
sv_utf8_upgrade(tmp);
sv_catsv(p_state->pend_text, tmp);
SvREFCNT_dec(tmp);
}
#else
sv_catpvn(p_state->pend_text, beg, end - beg);
#endif
return;
}
else if (p_state->pend_text && SvOK(p_state->pend_text)) {
flush_pending_text(p_state, self);
SPAGAIN;
}
/* At this point we have decided to generate an event callback */
argspec = h->argspec ? SvPV(h->argspec, my_na) : "";
if (SvTYPE(h->cb) == SVt_PVAV) {
if (*argspec == ARG_FLAG_FLAT_ARRAY) {
argspec++;
array = (AV*)h->cb;
}
else {
/* start sub-array for accumulator array */
array = newAV();
}
}
else {
array = 0;
if (*argspec == ARG_FLAG_FLAT_ARRAY)
argspec++;
/* start argument stack for callback */
ENTER;
SAVETMPS;
PUSHMARK(SP);
}
for (s = argspec; *s; s++) {
SV* arg = 0;
int push_arg = 1;
enum argcode argcode = (enum argcode)*s;
switch( argcode ) {
case ARG_SELF:
arg = sv_mortalcopy(self);
break;
case ARG_TOKENS:
if (num_tokens >= 1) {
AV* av = newAV();
SV* prev_token = &PL_sv_undef;
int i;
av_extend(av, num_tokens);
for (i = 0; i < num_tokens; i++) {
if (tokens[i].beg) {
prev_token = newSVpvn(tokens[i].beg, tokens[i].end-tokens[i].beg);
if (utf8)
SvUTF8_on(prev_token);
av_push(av, prev_token);
}
else { /* boolean */
av_push(av, p_state->bool_attr_val
? newSVsv(p_state->bool_attr_val)
: newSVsv(prev_token));
}
}
arg = sv_2mortal(newRV_noinc((SV*)av));
}
break;
case ARG_TOKENPOS:
if (num_tokens >= 1 && tokens[0].beg >= beg) {
AV* av = newAV();
int i;
av_extend(av, num_tokens*2);
for (i = 0; i < num_tokens; i++) {
if (tokens[i].beg) {
av_push(av, newSViv(CHR_DIST(tokens[i].beg, beg)));
av_push(av, newSViv(CHR_DIST(tokens[i].end, tokens[i].beg)));
}
else { /* boolean tag value */
av_push(av, newSViv(0));
av_push(av, newSViv(0));
}
}
arg = sv_2mortal(newRV_noinc((SV*)av));
}
break;
case ARG_TOKEN0:
case ARG_TAGNAME:
/* fall through */
case ARG_TAG:
if (num_tokens >= 1) {
arg = sv_2mortal(newSVpvn(tokens[0].beg,
tokens[0].end - tokens[0].beg));
if (utf8)
SvUTF8_on(arg);
if (!CASE_SENSITIVE(p_state) && argcode != ARG_TOKEN0)
sv_lower(aTHX_ arg);
if (argcode == ARG_TAG && event != E_START) {
char *e_type = "!##/#?#";
sv_insert(arg, 0, 0, &e_type[event], 1);
}
}
break;
case ARG_ATTR:
case ARG_ATTRARR:
if (event == E_START) {
HV* hv;
int i;
if (argcode == ARG_ATTR) {
hv = newHV();
arg = sv_2mortal(newRV_noinc((SV*)hv));
}
else {
#ifdef __GNUC__
/* gcc -Wall reports this variable as possibly used uninitialized */
hv = 0;
#endif
push_arg = 0; /* deal with argument pushing here */
}
for (i = 1; i < num_tokens; i += 2) {
SV* attrname = newSVpvn(tokens[i].beg,
tokens[i].end-tokens[i].beg);
SV* attrval;
if (utf8)
SvUTF8_on(attrname);
if (tokens[i+1].beg) {
char *beg = tokens[i+1].beg;
STRLEN len = tokens[i+1].end - beg;
if (*beg == '"' || *beg == '\'') {
assert(len >= 2 && *beg == beg[len-1]);
beg++; len -= 2;
}
attrval = newSVpvn(beg, len);
if (utf8)
SvUTF8_on(attrval);
if (!p_state->attr_encoded) {
#ifdef UNICODE_HTML_PARSER
if (p_state->utf8_mode)
sv_utf8_decode(attrval);
#endif
decode_entities(aTHX_ attrval, p_state->entity2char, 0);
if (p_state->utf8_mode)
SvUTF8_off(attrval);
}
}
else { /* boolean */
if (p_state->bool_attr_val)
attrval = newSVsv(p_state->bool_attr_val);
else
attrval = newSVsv(attrname);
}
if (!CASE_SENSITIVE(p_state))
sv_lower(aTHX_ attrname);
if (argcode == ARG_ATTR) {
if (hv_exists_ent(hv, attrname, 0) ||
!hv_store_ent(hv, attrname, attrval, 0)) {
SvREFCNT_dec(attrval);
}
SvREFCNT_dec(attrname);
}
else { /* ARG_ATTRARR */
if (array) {
av_push(array, attrname);
av_push(array, attrval);
}
else {
XPUSHs(sv_2mortal(attrname));
XPUSHs(sv_2mortal(attrval));
}
}
}
}
else if (argcode == ARG_ATTRARR) {
push_arg = 0;
}
break;
case ARG_ATTRSEQ: /* (v2 compatibility stuff) */
if (event == E_START) {
AV* av = newAV();
int i;
for (i = 1; i < num_tokens; i += 2) {
SV* attrname = newSVpvn(tokens[i].beg,
tokens[i].end-tokens[i].beg);
if (utf8)
SvUTF8_on(attrname);
if (!CASE_SENSITIVE(p_state))
sv_lower(aTHX_ attrname);
av_push(av, attrname);
}
arg = sv_2mortal(newRV_noinc((SV*)av));
}
break;
case ARG_TEXT:
arg = sv_2mortal(newSVpvn(beg, end - beg));
if (utf8)
SvUTF8_on(arg);
break;
case ARG_DTEXT:
if (event == E_TEXT) {
arg = sv_2mortal(newSVpvn(beg, end - beg));
if (utf8)
SvUTF8_on(arg);
if (!p_state->is_cdata) {
#ifdef UNICODE_HTML_PARSER
if (p_state->utf8_mode)
sv_utf8_decode(arg);
#endif
decode_entities(aTHX_ arg, p_state->entity2char, 1);
if (p_state->utf8_mode)
SvUTF8_off(arg);
}
}
break;
case ARG_IS_CDATA:
if (event == E_TEXT) {
arg = boolSV(p_state->is_cdata);
}
break;
case ARG_SKIPPED_TEXT:
arg = sv_2mortal(p_state->skipped_text);
p_state->skipped_text = newSVpvn("", 0);
break;
case ARG_OFFSET:
arg = sv_2mortal(newSViv(offset));
break;
case ARG_OFFSET_END:
arg = sv_2mortal(newSViv(offset + CHR_DIST(end, beg)));
break;
case ARG_LENGTH:
arg = sv_2mortal(newSViv(CHR_DIST(end, beg)));
break;
case ARG_LINE:
arg = sv_2mortal(newSViv(line));
break;
case ARG_COLUMN:
arg = sv_2mortal(newSViv(column));
break;
case ARG_EVENT:
assert(event >= 0 && event < EVENT_COUNT);
arg = sv_2mortal(newSVpv(event_id_str[event], 0));
break;
case ARG_LITERAL:
{
int len = (unsigned char)s[1];
arg = sv_2mortal(newSVpvn(s+2, len));
if (SvUTF8(h->argspec))
SvUTF8_on(arg);
s += len + 1;
}
break;
case ARG_UNDEF:
arg = sv_mortalcopy(&PL_sv_undef);
break;
default:
arg = sv_2mortal(newSVpvf("Bad argspec %d", *s));
break;
}
if (push_arg) {
if (!arg)
arg = sv_mortalcopy(&PL_sv_undef);
if (array) {
/* have to fix mortality here or add mortality to
* XPUSHs after removing it from the switch cases.
*/
av_push(array, SvREFCNT_inc(arg));
}
else {
XPUSHs(arg);
}
}
}
if (array) {
if (array != (AV*)h->cb)
av_push((AV*)h->cb, newRV_noinc((SV*)array));
}
else {
PUTBACK;
if ((enum argcode)*argspec == ARG_SELF && !SvROK(h->cb)) {
char *method = SvPV(h->cb, my_na);
perl_call_method(method, G_DISCARD | G_EVAL | G_VOID);
}
else {
perl_call_sv(h->cb, G_DISCARD | G_EVAL | G_VOID);
}
if (SvTRUE(ERRSV)) {
RETHROW;
}
FREETMPS;
LEAVE;
}
if (p_state->skipped_text)
SvCUR_set(p_state->skipped_text, 0);
return;
IGNORE_EVENT:
if (p_state->skipped_text) {
if (event != E_TEXT && p_state->pend_text && SvOK(p_state->pend_text))
flush_pending_text(p_state, self);
#ifdef UNICODE_HTML_PARSER
if (utf8 && !SvUTF8(p_state->skipped_text))
sv_utf8_upgrade(p_state->skipped_text);
if (utf8 || !SvUTF8(p_state->skipped_text)) {
#endif
sv_catpvn(p_state->skipped_text, beg, end - beg);
#ifdef UNICODE_HTML_PARSER
}
else {
SV *tmp = newSVpvn(beg, end - beg);
sv_utf8_upgrade(tmp);
sv_catsv(p_state->pend_text, tmp);
SvREFCNT_dec(tmp);
}
#endif
}
#undef CHR_DIST
return;
}
/*
=for apidoc mro_get_linear_isa
Returns the mro linearisation for the given stash. By default, this
will be whatever C<mro_get_linear_isa_dfs> returns unless some
other MRO is in effect for the stash. The return value is a
read-only AV*.
You are responsible for C<SvREFCNT_inc()> on the
return value if you plan to store it anywhere
semi-permanently (otherwise it might be deleted
out from under you the next time the cache is
invalidated).
=cut
*/
AV*
Perl_mro_get_linear_isa(pTHX_ HV *stash)
{
struct mro_meta* meta;
AV *isa;
PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA;
if(!SvOOK(stash))
Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
meta = HvMROMETA(stash);
if (!meta->mro_which)
Perl_croak(aTHX_ "panic: invalid MRO!");
isa = meta->mro_which->resolve(aTHX_ stash, 0);
if (meta->mro_which != &dfs_alg) { /* skip for dfs, for speed */
SV * const namesv =
(HvENAME(stash)||HvNAME(stash))
? newSVhek(HvENAME_HEK(stash)
? HvENAME_HEK(stash)
: HvNAME_HEK(stash))
: NULL;
if(namesv && (AvFILLp(isa) == -1 || !sv_eq(*AvARRAY(isa), namesv)))
{
AV * const old = isa;
SV **svp;
SV **ovp = AvARRAY(old);
SV * const * const oend = ovp + AvFILLp(old) + 1;
isa = (AV *)sv_2mortal((SV *)newAV());
av_extend(isa, AvFILLp(isa) = AvFILLp(old)+1);
*AvARRAY(isa) = namesv;
svp = AvARRAY(isa)+1;
while (ovp < oend) *svp++ = SvREFCNT_inc(*ovp++);
}
else SvREFCNT_dec(namesv);
}
if (!meta->isa) {
HV *const isa_hash = newHV();
/* Linearisation didn't build it for us, so do it here. */
SV *const *svp = AvARRAY(isa);
SV *const *const svp_end = svp + AvFILLp(isa) + 1;
const HEK *canon_name = HvENAME_HEK(stash);
if (!canon_name) canon_name = HvNAME_HEK(stash);
while (svp < svp_end) {
(void) hv_store_ent(isa_hash, *svp++, &PL_sv_undef, 0);
}
(void) hv_common(isa_hash, NULL, HEK_KEY(canon_name),
HEK_LEN(canon_name), HEK_FLAGS(canon_name),
HV_FETCH_ISSTORE, &PL_sv_undef,
HEK_HASH(canon_name));
(void) hv_store(isa_hash, "UNIVERSAL", 9, &PL_sv_undef, 0);
SvREADONLY_on(isa_hash);
meta->isa = isa_hash;
}
return isa;
}
static int perl_init_aaaa()
{
dTARG;
dSP;
listop_list[0].op_ppaddr = PL_ppaddr[OP_LEAVE];
op_list[0].op_ppaddr = PL_ppaddr[OP_ENTER];
cop_list[0].op_ppaddr = PL_ppaddr[OP_NEXTSTATE];
cop_list[0].cop_warnings = pWARN_STD;
CopFILE_set(&cop_list[0], "hello.p");
CopSTASHPV_set(&cop_list[0], "main");
listop_list[1].op_ppaddr = PL_ppaddr[OP_PRINT];
op_list[1].op_ppaddr = PL_ppaddr[OP_PUSHMARK];
svop_list[0].op_ppaddr = PL_ppaddr[OP_CONST];
gv_list[0] = gv_fetchpv("main::/", TRUE, SVt_PV);
SvFLAGS(gv_list[0]) = 0x600d;
GvFLAGS(gv_list[0]) = 0xa;
GvLINE(gv_list[0]) = 0;
SvPVX(gv_list[0]) = emptystring;
SvREFCNT(gv_list[0]) += 4;
GvREFCNT(gv_list[0]) += 1;
gv_list[1] = gv_fetchpv("main::stderr", TRUE, SVt_PV);
SvFLAGS(gv_list[1]) = 0x600d;
GvFLAGS(gv_list[1]) = 0x2;
GvLINE(gv_list[1]) = 0;
SvPVX(gv_list[1]) = emptystring;
SvREFCNT(gv_list[1]) += 2;
GvREFCNT(gv_list[1]) += 1;
GvSV(gv_list[1]) = &sv_list[0];
GvFILE(gv_list[1]) = "hello.p";
IoIFP((IO*)&sv_list[1])=PerlIO_stderr();
IoOFP((IO*)&sv_list[1])=PerlIO_stderr();
hv0 = gv_stashpv("FileHandle", TRUE);
SvSTASH((IO*)&sv_list[1]) = hv0;
GvIOp(gv_list[1]) = (IO*)&sv_list[1];
gv_list[2] = gv_fetchpv("main::SIG", TRUE, SVt_PV);
SvFLAGS(gv_list[2]) = 0x600d;
GvFLAGS(gv_list[2]) = 0xa;
GvLINE(gv_list[2]) = 62;
SvPVX(gv_list[2]) = emptystring;
SvREFCNT(gv_list[2]) += 12;
GvREFCNT(gv_list[2]) += 1;
gv_list[3] = gv_fetchpv("main::,", TRUE, SVt_PV);
SvFLAGS(gv_list[3]) = 0x600d;
GvFLAGS(gv_list[3]) = 0xa;
GvLINE(gv_list[3]) = 474;
SvPVX(gv_list[3]) = emptystring;
SvREFCNT(gv_list[3]) += 6;
GvREFCNT(gv_list[3]) += 1;
gv_list[4] = gv_fetchpv("utf8::unicode_to_native", TRUE, SVt_PV);
SvFLAGS(gv_list[4]) = 0x600d;
GvFLAGS(gv_list[4]) = 0xa;
GvLINE(gv_list[4]) = 0;
SvPVX(gv_list[4]) = emptystring;
SvREFCNT(gv_list[4]) += 3;
GvREFCNT(gv_list[4]) += 1;
GvSV(gv_list[4]) = &sv_list[2];
GvCV(gv_list[4]) = (CV*)((perl_get_cv("utf8::unicode_to_native",TRUE)));
GvFILE(gv_list[4]) = "hello.p";
gv_list[5] = gv_fetchpv("utf8::encode", TRUE, SVt_PV);
SvFLAGS(gv_list[5]) = 0x600d;
GvFLAGS(gv_list[5]) = 0x2;
GvLINE(gv_list[5]) = 0;
SvPVX(gv_list[5]) = emptystring;
SvREFCNT(gv_list[5]) += 2;
GvREFCNT(gv_list[5]) += 1;
GvSV(gv_list[5]) = &sv_list[3];
GvCV(gv_list[5]) = (CV*)((perl_get_cv("utf8::encode",TRUE)));
GvFILE(gv_list[5]) = "hello.p";
gv_list[6] = gv_fetchpv("utf8::valid", TRUE, SVt_PV);
SvFLAGS(gv_list[6]) = 0x600d;
GvFLAGS(gv_list[6]) = 0x2;
GvLINE(gv_list[6]) = 0;
SvPVX(gv_list[6]) = emptystring;
SvREFCNT(gv_list[6]) += 2;
GvREFCNT(gv_list[6]) += 1;
GvSV(gv_list[6]) = &sv_list[4];
GvCV(gv_list[6]) = (CV*)((perl_get_cv("utf8::valid",TRUE)));
GvFILE(gv_list[6]) = "hello.p";
gv_list[7] = gv_fetchpv("utf8::native_to_unicode", TRUE, SVt_PV);
SvFLAGS(gv_list[7]) = 0x600d;
GvFLAGS(gv_list[7]) = 0x2;
GvLINE(gv_list[7]) = 0;
SvPVX(gv_list[7]) = emptystring;
SvREFCNT(gv_list[7]) += 2;
GvREFCNT(gv_list[7]) += 1;
GvSV(gv_list[7]) = &sv_list[5];
GvCV(gv_list[7]) = (CV*)((perl_get_cv("utf8::native_to_unicode",TRUE)));
GvFILE(gv_list[7]) = "hello.p";
gv_list[8] = gv_fetchpv("utf8::decode", TRUE, SVt_PV);
SvFLAGS(gv_list[8]) = 0x600d;
GvFLAGS(gv_list[8]) = 0x2;
GvLINE(gv_list[8]) = 0;
SvPVX(gv_list[8]) = emptystring;
SvREFCNT(gv_list[8]) += 2;
GvREFCNT(gv_list[8]) += 1;
GvSV(gv_list[8]) = &sv_list[6];
GvCV(gv_list[8]) = (CV*)((perl_get_cv("utf8::decode",TRUE)));
GvFILE(gv_list[8]) = "hello.p";
gv_list[9] = gv_fetchpv("utf8::downgrade", TRUE, SVt_PV);
SvFLAGS(gv_list[9]) = 0x600d;
GvFLAGS(gv_list[9]) = 0x2;
GvLINE(gv_list[9]) = 0;
SvPVX(gv_list[9]) = emptystring;
SvREFCNT(gv_list[9]) += 2;
GvREFCNT(gv_list[9]) += 1;
GvSV(gv_list[9]) = &sv_list[7];
GvCV(gv_list[9]) = (CV*)((perl_get_cv("utf8::downgrade",TRUE)));
GvFILE(gv_list[9]) = "hello.p";
gv_list[10] = gv_fetchpv("utf8::upgrade", TRUE, SVt_PV);
SvFLAGS(gv_list[10]) = 0x600d;
GvFLAGS(gv_list[10]) = 0x2;
GvLINE(gv_list[10]) = 0;
SvPVX(gv_list[10]) = emptystring;
SvREFCNT(gv_list[10]) += 2;
GvREFCNT(gv_list[10]) += 1;
GvSV(gv_list[10]) = &sv_list[8];
GvCV(gv_list[10]) = (CV*)((perl_get_cv("utf8::upgrade",TRUE)));
GvFILE(gv_list[10]) = "hello.p";
gv_list[11] = gv_fetchpv("utf8::is_utf8", TRUE, SVt_PV);
SvFLAGS(gv_list[11]) = 0x600d;
GvFLAGS(gv_list[11]) = 0x2;
GvLINE(gv_list[11]) = 0;
SvPVX(gv_list[11]) = emptystring;
SvREFCNT(gv_list[11]) += 2;
GvREFCNT(gv_list[11]) += 1;
GvSV(gv_list[11]) = &sv_list[9];
GvCV(gv_list[11]) = (CV*)((perl_get_cv("utf8::is_utf8",TRUE)));
GvFILE(gv_list[11]) = "hello.p";
gv_list[12] = gv_fetchpv("main::\"", TRUE, SVt_PV);
SvFLAGS(gv_list[12]) = 0x600d;
GvFLAGS(gv_list[12]) = 0xa;
GvLINE(gv_list[12]) = 0;
SvPVX(gv_list[12]) = emptystring;
SvREFCNT(gv_list[12]) += 10;
GvREFCNT(gv_list[12]) += 1;
gv_list[13] = gv_fetchpv("main::stdout", TRUE, SVt_PV);
SvFLAGS(gv_list[13]) = 0x600d;
GvFLAGS(gv_list[13]) = 0x2;
GvLINE(gv_list[13]) = 0;
SvPVX(gv_list[13]) = emptystring;
SvREFCNT(gv_list[13]) += 2;
GvREFCNT(gv_list[13]) += 1;
GvSV(gv_list[13]) = &sv_list[10];
GvFILE(gv_list[13]) = "hello.p";
IoIFP((IO*)&sv_list[11])=PerlIO_stdout();
IoOFP((IO*)&sv_list[11])=PerlIO_stdout();
SvSTASH((IO*)&sv_list[11]) = hv0;
GvIOp(gv_list[13]) = (IO*)&sv_list[11];
gv_list[14] = gv_fetchpv("main::\022", TRUE, SVt_PV);
SvFLAGS(gv_list[14]) = 0x600d;
GvFLAGS(gv_list[14]) = 0x2;
GvLINE(gv_list[14]) = 0;
SvPVX(gv_list[14]) = emptystring;
SvREFCNT(gv_list[14]) += 2;
GvREFCNT(gv_list[14]) += 1;
gv_list[15] = gv_fetchpv("main::|", TRUE, SVt_PV);
SvFLAGS(gv_list[15]) = 0x600d;
GvFLAGS(gv_list[15]) = 0xa;
GvLINE(gv_list[15]) = 466;
SvPVX(gv_list[15]) = emptystring;
SvREFCNT(gv_list[15]) += 5;
GvREFCNT(gv_list[15]) += 1;
gv_list[16] = gv_fetchpv("Regexp::DESTROY", TRUE, SVt_PV);
SvFLAGS(gv_list[16]) = 0x600d;
GvFLAGS(gv_list[16]) = 0x2;
GvLINE(gv_list[16]) = 0;
SvPVX(gv_list[16]) = emptystring;
SvREFCNT(gv_list[16]) += 2;
GvREFCNT(gv_list[16]) += 1;
GvSV(gv_list[16]) = &sv_list[12];
GvCV(gv_list[16]) = (CV*)((perl_get_cv("Regexp::DESTROY",TRUE)));
GvFILE(gv_list[16]) = "hello.p";
gv_list[17] = gv_fetchpv("main::\f", TRUE, SVt_PV);
SvFLAGS(gv_list[17]) = 0x600d;
GvFLAGS(gv_list[17]) = 0xa;
GvLINE(gv_list[17]) = 554;
SvPVX(gv_list[17]) = emptystring;
SvREFCNT(gv_list[17]) += 4;
GvREFCNT(gv_list[17]) += 1;
gv_list[18] = gv_fetchpv("main::^", TRUE, SVt_PV);
SvFLAGS(gv_list[18]) = 0x600d;
GvFLAGS(gv_list[18]) = 0xa;
GvLINE(gv_list[18]) = 538;
SvPVX(gv_list[18]) = emptystring;
SvREFCNT(gv_list[18]) += 4;
GvREFCNT(gv_list[18]) += 1;
gv_list[19] = gv_fetchpv("main::\001", TRUE, SVt_PV);
SvFLAGS(gv_list[19]) = 0x600d;
GvFLAGS(gv_list[19]) = 0xa;
GvLINE(gv_list[19]) = 562;
SvPVX(gv_list[19]) = emptystring;
SvREFCNT(gv_list[19]) += 5;
GvREFCNT(gv_list[19]) += 1;
gv_list[20] = gv_fetchpv("main::$", TRUE, SVt_PV);
SvFLAGS(gv_list[20]) = 0x600d;
GvFLAGS(gv_list[20]) = 0x2;
GvLINE(gv_list[20]) = 0;
SvPVX(gv_list[20]) = emptystring;
SvREFCNT(gv_list[20]) += 2;
GvREFCNT(gv_list[20]) += 1;
gv_list[21] = gv_fetchpv("main::\\", TRUE, SVt_PV);
SvFLAGS(gv_list[21]) = 0x600d;
GvFLAGS(gv_list[21]) = 0xa;
GvLINE(gv_list[21]) = 441;
SvPVX(gv_list[21]) = emptystring;
SvREFCNT(gv_list[21]) += 9;
GvREFCNT(gv_list[21]) += 1;
gv_list[22] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm", TRUE, SVt_PV);
SvFLAGS(gv_list[22]) = 0x600d;
GvFLAGS(gv_list[22]) = 0x2;
GvLINE(gv_list[22]) = 4294967295;
SvPVX(gv_list[22]) = emptystring;
SvREFCNT(gv_list[22]) += 2;
GvREFCNT(gv_list[22]) += 1;
xpv_list[0].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm", 56);
GvSV(gv_list[22]) = &sv_list[13];
GvFILE(gv_list[22]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[23] = gv_fetchpv("main::~", TRUE, SVt_PV);
SvFLAGS(gv_list[23]) = 0x600d;
GvFLAGS(gv_list[23]) = 0xa;
GvLINE(gv_list[23]) = 530;
SvPVX(gv_list[23]) = emptystring;
SvREFCNT(gv_list[23]) += 4;
GvREFCNT(gv_list[23]) += 1;
gv_list[24] = gv_fetchpv("main::-", TRUE, SVt_PV);
SvFLAGS(gv_list[24]) = 0x600d;
GvFLAGS(gv_list[24]) = 0xa;
GvLINE(gv_list[24]) = 0;
SvPVX(gv_list[24]) = emptystring;
SvREFCNT(gv_list[24]) += 4;
GvREFCNT(gv_list[24]) += 1;
gv_list[25] = gv_fetchpv("main::_<perlmain.c", TRUE, SVt_PV);
SvFLAGS(gv_list[25]) = 0x600d;
GvFLAGS(gv_list[25]) = 0x2;
GvLINE(gv_list[25]) = 0;
SvPVX(gv_list[25]) = emptystring;
SvREFCNT(gv_list[25]) += 2;
GvREFCNT(gv_list[25]) += 1;
xpv_list[1].xpv_pv = savepvn("perlmain.c", 10);
GvSV(gv_list[25]) = &sv_list[14];
GvFILE(gv_list[25]) = "hello.p";
gv_list[26] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/File/Spec/Unix.pm", TRUE, SVt_PV);
SvFLAGS(gv_list[26]) = 0x600d;
GvFLAGS(gv_list[26]) = 0x2;
GvLINE(gv_list[26]) = 98;
SvPVX(gv_list[26]) = emptystring;
SvREFCNT(gv_list[26]) += 2;
GvREFCNT(gv_list[26]) += 1;
xpv_list[2].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/File/Spec/Unix.pm", 38);
GvSV(gv_list[26]) = &sv_list[15];
GvFILE(gv_list[26]) = "x/\031\b q\024\b\332T\305";
gv_list[27] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/B/C/C.so", TRUE, SVt_PV);
SvFLAGS(gv_list[27]) = 0x600d;
GvFLAGS(gv_list[27]) = 0x2;
GvLINE(gv_list[27]) = 87;
SvPVX(gv_list[27]) = emptystring;
SvREFCNT(gv_list[27]) += 2;
GvREFCNT(gv_list[27]) += 1;
xpv_list[3].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/B/C/C.so", 58);
GvSV(gv_list[27]) = &sv_list[16];
GvFILE(gv_list[27]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[28] = gv_fetchpv("main::_<universal.c", TRUE, SVt_PV);
SvFLAGS(gv_list[28]) = 0x600d;
GvFLAGS(gv_list[28]) = 0x2;
GvLINE(gv_list[28]) = 0;
SvPVX(gv_list[28]) = emptystring;
SvREFCNT(gv_list[28]) += 2;
GvREFCNT(gv_list[28]) += 1;
xpv_list[4].xpv_pv = savepvn("universal.c", 11);
GvSV(gv_list[28]) = &sv_list[17];
GvFILE(gv_list[28]) = "hello.p";
gv_list[29] = gv_fetchpv("main::BEGIN", TRUE, SVt_PV);
SvFLAGS(gv_list[29]) = 0x600d;
GvFLAGS(gv_list[29]) = 0x2;
GvLINE(gv_list[29]) = 0;
SvPVX(gv_list[29]) = emptystring;
SvREFCNT(gv_list[29]) += 2;
GvREFCNT(gv_list[29]) += 1;
GvSV(gv_list[29]) = &sv_list[18];
GvFILE(gv_list[29]) = "hello.p";
gv_list[30] = gv_fetchpv("main::_<xsutils.c", TRUE, SVt_PV);
SvFLAGS(gv_list[30]) = 0x600d;
GvFLAGS(gv_list[30]) = 0x2;
GvLINE(gv_list[30]) = 0;
SvPVX(gv_list[30]) = emptystring;
SvREFCNT(gv_list[30]) += 2;
GvREFCNT(gv_list[30]) += 1;
xpv_list[5].xpv_pv = savepvn("xsutils.c", 9);
GvSV(gv_list[30]) = &sv_list[19];
GvFILE(gv_list[30]) = "hello.p";
gv_list[31] = gv_fetchpv("main::!", TRUE, SVt_PV);
SvFLAGS(gv_list[31]) = 0x600d;
GvFLAGS(gv_list[31]) = 0xa;
GvLINE(gv_list[31]) = 2054;
SvPVX(gv_list[31]) = emptystring;
SvREFCNT(gv_list[31]) += 3;
GvREFCNT(gv_list[31]) += 1;
GvFILE(gv_list[31]) = "";
gv_list[32] = gv_fetchpv("main::\024AINT", TRUE, SVt_PV);
SvFLAGS(gv_list[32]) = 0x600d;
GvFLAGS(gv_list[32]) = 0xa;
GvLINE(gv_list[32]) = 1589;
SvPVX(gv_list[32]) = emptystring;
SvREFCNT(gv_list[32]) += 3;
GvREFCNT(gv_list[32]) += 1;
sv_magic((SV*)&sv_list[20], (SV*)gv_list[32], '\000', "\024AINT", 5);
GvSV(gv_list[32]) = &sv_list[20];
GvFILE(gv_list[32]) = "";
gv_list[33] = gv_fetchpv("main::\017", TRUE, SVt_PV);
SvFLAGS(gv_list[33]) = 0x600d;
GvFLAGS(gv_list[33]) = 0xa;
GvLINE(gv_list[33]) = 55;
SvPVX(gv_list[33]) = emptystring;
SvREFCNT(gv_list[33]) += 4;
GvREFCNT(gv_list[33]) += 1;
gv_list[34] = gv_fetchpv("main::%", TRUE, SVt_PV);
SvFLAGS(gv_list[34]) = 0x600d;
GvFLAGS(gv_list[34]) = 0xa;
GvLINE(gv_list[34]) = 506;
SvPVX(gv_list[34]) = emptystring;
SvREFCNT(gv_list[34]) += 4;
GvREFCNT(gv_list[34]) += 1;
gv_list[35] = gv_fetchpv("main::\030", TRUE, SVt_PV);
SvFLAGS(gv_list[35]) = 0x600d;
GvFLAGS(gv_list[35]) = 0x2;
GvLINE(gv_list[35]) = 0;
SvPVX(gv_list[35]) = emptystring;
SvREFCNT(gv_list[35]) += 2;
GvREFCNT(gv_list[35]) += 1;
gv_list[36] = gv_fetchpv("main::_", TRUE, SVt_PV);
SvFLAGS(gv_list[36]) = 0x630d;
GvFLAGS(gv_list[36]) = 0xa;
GvLINE(gv_list[36]) = 0;
SvPVX(gv_list[36]) = emptystring;
SvREFCNT(gv_list[36]) += 470;
GvREFCNT(gv_list[36]) += 1;
gv_list[37] = gv_fetchpv("main::+", TRUE, SVt_PV);
SvFLAGS(gv_list[37]) = 0x600d;
GvFLAGS(gv_list[37]) = 0x2;
GvLINE(gv_list[37]) = 0;
SvPVX(gv_list[37]) = emptystring;
SvREFCNT(gv_list[37]) += 2;
GvREFCNT(gv_list[37]) += 1;
gv_list[38] = gv_fetchpv("Internals::SvREFCNT", TRUE, SVt_PV);
SvFLAGS(gv_list[38]) = 0x600d;
GvFLAGS(gv_list[38]) = 0x2;
GvLINE(gv_list[38]) = 0;
SvPVX(gv_list[38]) = emptystring;
SvREFCNT(gv_list[38]) += 2;
GvREFCNT(gv_list[38]) += 1;
GvSV(gv_list[38]) = &sv_list[21];
GvCV(gv_list[38]) = (CV*)((perl_get_cv("Internals::SvREFCNT",TRUE)));
GvFILE(gv_list[38]) = "hello.p";
gv_list[39] = gv_fetchpv("Internals::hv_clear_placeholders", TRUE, SVt_PV);
SvFLAGS(gv_list[39]) = 0x600d;
GvFLAGS(gv_list[39]) = 0x2;
GvLINE(gv_list[39]) = 0;
SvPVX(gv_list[39]) = emptystring;
SvREFCNT(gv_list[39]) += 2;
GvREFCNT(gv_list[39]) += 1;
GvSV(gv_list[39]) = &sv_list[22];
GvCV(gv_list[39]) = (CV*)((perl_get_cv("Internals::hv_clear_placeholders",TRUE)));
GvFILE(gv_list[39]) = "hello.p";
gv_list[40] = gv_fetchpv("Internals::hash_seed", TRUE, SVt_PV);
SvFLAGS(gv_list[40]) = 0x600d;
GvFLAGS(gv_list[40]) = 0x2;
GvLINE(gv_list[40]) = 0;
SvPVX(gv_list[40]) = emptystring;
SvREFCNT(gv_list[40]) += 2;
GvREFCNT(gv_list[40]) += 1;
GvSV(gv_list[40]) = &sv_list[23];
GvCV(gv_list[40]) = (CV*)((perl_get_cv("Internals::hash_seed",TRUE)));
GvFILE(gv_list[40]) = "hello.p";
gv_list[41] = gv_fetchpv("Internals::SvREADONLY", TRUE, SVt_PV);
SvFLAGS(gv_list[41]) = 0x600d;
GvFLAGS(gv_list[41]) = 0x2;
GvLINE(gv_list[41]) = 0;
SvPVX(gv_list[41]) = emptystring;
SvREFCNT(gv_list[41]) += 2;
GvREFCNT(gv_list[41]) += 1;
GvSV(gv_list[41]) = &sv_list[24];
GvCV(gv_list[41]) = (CV*)((perl_get_cv("Internals::SvREADONLY",TRUE)));
GvFILE(gv_list[41]) = "hello.p";
gv_list[42] = gv_fetchpv("Internals::HvREHASH", TRUE, SVt_PV);
SvFLAGS(gv_list[42]) = 0x600d;
GvFLAGS(gv_list[42]) = 0x2;
GvLINE(gv_list[42]) = 0;
SvPVX(gv_list[42]) = emptystring;
SvREFCNT(gv_list[42]) += 2;
GvREFCNT(gv_list[42]) += 1;
GvSV(gv_list[42]) = &sv_list[25];
GvCV(gv_list[42]) = (CV*)((perl_get_cv("Internals::HvREHASH",TRUE)));
GvFILE(gv_list[42]) = "hello.p";
gv_list[43] = gv_fetchpv("Internals::rehash_seed", TRUE, SVt_PV);
SvFLAGS(gv_list[43]) = 0x600d;
GvFLAGS(gv_list[43]) = 0x2;
GvLINE(gv_list[43]) = 0;
SvPVX(gv_list[43]) = emptystring;
SvREFCNT(gv_list[43]) += 2;
GvREFCNT(gv_list[43]) += 1;
GvSV(gv_list[43]) = &sv_list[26];
GvCV(gv_list[43]) = (CV*)((perl_get_cv("Internals::rehash_seed",TRUE)));
GvFILE(gv_list[43]) = "hello.p";
gv_list[44] = gv_fetchpv("main::STDIN", TRUE, SVt_PV);
SvFLAGS(gv_list[44]) = 0x600d;
GvFLAGS(gv_list[44]) = 0xa;
GvLINE(gv_list[44]) = 0;
SvPVX(gv_list[44]) = emptystring;
SvREFCNT(gv_list[44]) += 2;
GvREFCNT(gv_list[44]) += 1;
gv_list[45] = gv_fetchpv("DB::args", TRUE, SVt_PV);
SvFLAGS(gv_list[45]) = 0x600d;
GvFLAGS(gv_list[45]) = 0xa;
GvLINE(gv_list[45]) = 431;
SvPVX(gv_list[45]) = emptystring;
SvREFCNT(gv_list[45]) += 4;
GvREFCNT(gv_list[45]) += 1;
GvSV(gv_list[45]) = &sv_list[27];
GvAV(gv_list[45]) = (AV*)&sv_list[28];
GvFILE(gv_list[45]) = "\260\r\016\b";
gv_list[46] = gv_fetchpv("main::\026", TRUE, SVt_PV);
SvFLAGS(gv_list[46]) = 0x600d;
GvFLAGS(gv_list[46]) = 0xa;
GvLINE(gv_list[46]) = 30;
SvPVX(gv_list[46]) = emptystring;
SvREFCNT(gv_list[46]) += 2;
GvREFCNT(gv_list[46]) += 1;
gv_list[47] = gv_fetchpv("main::=", TRUE, SVt_PV);
SvFLAGS(gv_list[47]) = 0x600d;
GvFLAGS(gv_list[47]) = 0xa;
GvLINE(gv_list[47]) = 514;
SvPVX(gv_list[47]) = emptystring;
SvREFCNT(gv_list[47]) += 4;
GvREFCNT(gv_list[47]) += 1;
gv_list[48] = gv_fetchpv("main::2", TRUE, SVt_PV);
SvFLAGS(gv_list[48]) = 0x600d;
GvFLAGS(gv_list[48]) = 0xa;
GvLINE(gv_list[48]) = 257;
SvPVX(gv_list[48]) = emptystring;
SvREFCNT(gv_list[48]) += 6;
GvREFCNT(gv_list[48]) += 1;
gv_list[49] = gv_fetchpv("main::_<Fcntl.c", TRUE, SVt_PV);
SvFLAGS(gv_list[49]) = 0x600d;
GvFLAGS(gv_list[49]) = 0x2;
GvLINE(gv_list[49]) = 92;
SvPVX(gv_list[49]) = emptystring;
SvREFCNT(gv_list[49]) += 2;
GvREFCNT(gv_list[49]) += 1;
xpv_list[6].xpv_pv = savepvn("Fcntl.c", 7);
GvSV(gv_list[49]) = &sv_list[29];
GvFILE(gv_list[49]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[50] = gv_fetchpv("main::1", TRUE, SVt_PV);
SvFLAGS(gv_list[50]) = 0x600d;
GvFLAGS(gv_list[50]) = 0xa;
GvLINE(gv_list[50]) = 74;
SvPVX(gv_list[50]) = emptystring;
SvREFCNT(gv_list[50]) += 28;
GvREFCNT(gv_list[50]) += 1;
gv_list[51] = gv_fetchpv("main::_<IO.c", TRUE, SVt_PV);
SvFLAGS(gv_list[51]) = 0x600d;
GvFLAGS(gv_list[51]) = 0x2;
GvLINE(gv_list[51]) = 92;
SvPVX(gv_list[51]) = emptystring;
SvREFCNT(gv_list[51]) += 2;
GvREFCNT(gv_list[51]) += 1;
xpv_list[7].xpv_pv = savepvn("IO.c", 4);
GvSV(gv_list[51]) = &sv_list[30];
GvFILE(gv_list[51]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[52] = gv_fetchpv("main::\027ARNING_BITS", TRUE, SVt_PV);
SvFLAGS(gv_list[52]) = 0x600d;
GvFLAGS(gv_list[52]) = 0xa;
GvLINE(gv_list[52]) = 341;
SvPVX(gv_list[52]) = emptystring;
SvREFCNT(gv_list[52]) += 6;
GvREFCNT(gv_list[52]) += 1;
sv_magic((SV*)&sv_list[31], (SV*)gv_list[52], '\000', "\027ARNING_BITS", 12);
GvSV(gv_list[52]) = &sv_list[31];
GvFILE(gv_list[52]) = "\260\r\016\b";
gv_list[53] = gv_fetchpv("main::_<B.c", TRUE, SVt_PV);
SvFLAGS(gv_list[53]) = 0x600d;
GvFLAGS(gv_list[53]) = 0x2;
GvLINE(gv_list[53]) = 92;
SvPVX(gv_list[53]) = emptystring;
SvREFCNT(gv_list[53]) += 2;
GvREFCNT(gv_list[53]) += 1;
xpv_list[8].xpv_pv = savepvn("B.c", 3);
GvSV(gv_list[53]) = &sv_list[32];
GvFILE(gv_list[53]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[54] = gv_fetchpv("main::_<DynaLoader.c", TRUE, SVt_PV);
SvFLAGS(gv_list[54]) = 0x600d;
GvFLAGS(gv_list[54]) = 0x2;
GvLINE(gv_list[54]) = 16;
SvPVX(gv_list[54]) = emptystring;
SvREFCNT(gv_list[54]) += 2;
GvREFCNT(gv_list[54]) += 1;
xpv_list[9].xpv_pv = savepvn("DynaLoader.c", 12);
GvSV(gv_list[54]) = &sv_list[33];
GvFILE(gv_list[54]) = "\335\367\302";
gv_list[55] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/IO/IO.so", TRUE, SVt_PV);
SvFLAGS(gv_list[55]) = 0x600d;
GvFLAGS(gv_list[55]) = 0x2;
GvLINE(gv_list[55]) = 87;
SvPVX(gv_list[55]) = emptystring;
SvREFCNT(gv_list[55]) += 2;
GvREFCNT(gv_list[55]) += 1;
xpv_list[10].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/IO/IO.so", 58);
GvSV(gv_list[55]) = &sv_list[34];
GvFILE(gv_list[55]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[56] = gv_fetchpv("attributes::bootstrap", TRUE, SVt_PV);
SvFLAGS(gv_list[56]) = 0x600d;
GvFLAGS(gv_list[56]) = 0x2;
GvLINE(gv_list[56]) = 0;
SvPVX(gv_list[56]) = emptystring;
SvREFCNT(gv_list[56]) += 2;
GvREFCNT(gv_list[56]) += 1;
GvSV(gv_list[56]) = &sv_list[35];
GvFILE(gv_list[56]) = "hello.p";
gv_list[57] = gv_fetchpv("main::stdin", TRUE, SVt_PV);
SvFLAGS(gv_list[57]) = 0x600d;
GvFLAGS(gv_list[57]) = 0x2;
GvLINE(gv_list[57]) = 0;
SvPVX(gv_list[57]) = emptystring;
SvREFCNT(gv_list[57]) += 2;
GvREFCNT(gv_list[57]) += 1;
GvSV(gv_list[57]) = &sv_list[36];
GvFILE(gv_list[57]) = "hello.p";
IoIFP((IO*)&sv_list[37])=PerlIO_stdin();
IoOFP((IO*)&sv_list[37])=PerlIO_stdin();
SvSTASH((IO*)&sv_list[37]) = hv0;
GvIOp(gv_list[57]) = (IO*)&sv_list[37];
gv_list[58] = gv_fetchpv("main::ARGV", TRUE, SVt_PV);
SvFLAGS(gv_list[58]) = 0x600d;
GvFLAGS(gv_list[58]) = 0x2;
GvLINE(gv_list[58]) = 0;
SvPVX(gv_list[58]) = emptystring;
SvREFCNT(gv_list[58]) += 2;
GvREFCNT(gv_list[58]) += 1;
gv_list[59] = gv_fetchpv("main::INC", TRUE, SVt_PV);
SvFLAGS(gv_list[59]) = 0x600d;
GvFLAGS(gv_list[59]) = 0xa;
GvLINE(gv_list[59]) = 0;
SvPVX(gv_list[59]) = emptystring;
SvREFCNT(gv_list[59]) += 7;
GvREFCNT(gv_list[59]) += 1;
GvSV(gv_list[59]) = &sv_list[38];
xpv_list[11].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi", 44);
xpv_list[12].xpv_pv = savepvn("/usr/lib/perl5/5.8.5", 20);
xpv_list[13].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.5/i386-linux-thread-multi", 54);
xpv_list[14].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.4/i386-linux-thread-multi", 54);
xpv_list[15].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.3/i386-linux-thread-multi", 54);
xpv_list[16].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.2/i386-linux-thread-multi", 54);
xpv_list[17].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.1/i386-linux-thread-multi", 54);
xpv_list[18].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi", 54);
xpv_list[19].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.5", 30);
xpv_list[20].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.4", 30);
xpv_list[21].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.3", 30);
xpv_list[22].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.2", 30);
xpv_list[23].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.1", 30);
xpv_list[24].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.0", 30);
xpv_list[25].xpv_pv = savepvn("/usr/lib/perl5/site_perl", 24);
xpv_list[26].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.5/i386-linux-thread-multi", 56);
xpv_list[27].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.4/i386-linux-thread-multi", 56);
xpv_list[28].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.3/i386-linux-thread-multi", 56);
xpv_list[29].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.2/i386-linux-thread-multi", 56);
xpv_list[30].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.1/i386-linux-thread-multi", 56);
xpv_list[31].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.0/i386-linux-thread-multi", 56);
xpv_list[32].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.5", 32);
xpv_list[33].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.4", 32);
xpv_list[34].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.3", 32);
xpv_list[35].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.2", 32);
xpv_list[36].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.1", 32);
xpv_list[37].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.0", 32);
xpv_list[38].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl", 26);
xpv_list[39].xpv_pv = savepvn(".", 1);
xpv_list[40].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi", 44);
xpv_list[41].xpv_pv = savepvn("/usr/lib/perl5/5.8.5", 20);
xpv_list[42].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.5/i386-linux-thread-multi", 54);
xpv_list[43].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.4/i386-linux-thread-multi", 54);
xpv_list[44].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.3/i386-linux-thread-multi", 54);
xpv_list[45].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.2/i386-linux-thread-multi", 54);
xpv_list[46].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.1/i386-linux-thread-multi", 54);
xpv_list[47].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi", 54);
xpv_list[48].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.5", 30);
xpv_list[49].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.4", 30);
xpv_list[50].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.3", 30);
xpv_list[51].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.2", 30);
xpv_list[52].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.1", 30);
xpv_list[53].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.0", 30);
xpv_list[54].xpv_pv = savepvn("/usr/lib/perl5/site_perl", 24);
xpv_list[55].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.5/i386-linux-thread-multi", 56);
xpv_list[56].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.4/i386-linux-thread-multi", 56);
xpv_list[57].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.3/i386-linux-thread-multi", 56);
xpv_list[58].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.2/i386-linux-thread-multi", 56);
xpv_list[59].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.1/i386-linux-thread-multi", 56);
xpv_list[60].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.0/i386-linux-thread-multi", 56);
xpv_list[61].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.5", 32);
xpv_list[62].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.4", 32);
xpv_list[63].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.3", 32);
xpv_list[64].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.2", 32);
xpv_list[65].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.1", 32);
xpv_list[66].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.0", 32);
xpv_list[67].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl", 26);
xpv_list[68].xpv_pv = savepvn(".", 1);
{
SV **svp;
AV *av = (AV*)&sv_list[39];
av_extend(av, 57);
svp = AvARRAY(av);
*svp++ = (SV*)&sv_list[40];
*svp++ = (SV*)&sv_list[41];
*svp++ = (SV*)&sv_list[42];
*svp++ = (SV*)&sv_list[43];
*svp++ = (SV*)&sv_list[44];
*svp++ = (SV*)&sv_list[45];
*svp++ = (SV*)&sv_list[46];
*svp++ = (SV*)&sv_list[47];
*svp++ = (SV*)&sv_list[48];
*svp++ = (SV*)&sv_list[49];
*svp++ = (SV*)&sv_list[50];
*svp++ = (SV*)&sv_list[51];
*svp++ = (SV*)&sv_list[52];
*svp++ = (SV*)&sv_list[53];
*svp++ = (SV*)&sv_list[54];
*svp++ = (SV*)&sv_list[55];
*svp++ = (SV*)&sv_list[56];
*svp++ = (SV*)&sv_list[57];
*svp++ = (SV*)&sv_list[58];
*svp++ = (SV*)&sv_list[59];
*svp++ = (SV*)&sv_list[60];
*svp++ = (SV*)&sv_list[61];
*svp++ = (SV*)&sv_list[62];
*svp++ = (SV*)&sv_list[63];
*svp++ = (SV*)&sv_list[64];
*svp++ = (SV*)&sv_list[65];
*svp++ = (SV*)&sv_list[66];
*svp++ = (SV*)&sv_list[67];
*svp++ = (SV*)&sv_list[68];
*svp++ = (SV*)&sv_list[69];
*svp++ = (SV*)&sv_list[70];
*svp++ = (SV*)&sv_list[71];
*svp++ = (SV*)&sv_list[72];
*svp++ = (SV*)&sv_list[73];
*svp++ = (SV*)&sv_list[74];
*svp++ = (SV*)&sv_list[75];
*svp++ = (SV*)&sv_list[76];
*svp++ = (SV*)&sv_list[77];
*svp++ = (SV*)&sv_list[78];
*svp++ = (SV*)&sv_list[79];
*svp++ = (SV*)&sv_list[80];
*svp++ = (SV*)&sv_list[81];
*svp++ = (SV*)&sv_list[82];
*svp++ = (SV*)&sv_list[83];
*svp++ = (SV*)&sv_list[84];
*svp++ = (SV*)&sv_list[85];
*svp++ = (SV*)&sv_list[86];
*svp++ = (SV*)&sv_list[87];
*svp++ = (SV*)&sv_list[88];
*svp++ = (SV*)&sv_list[89];
*svp++ = (SV*)&sv_list[90];
*svp++ = (SV*)&sv_list[91];
*svp++ = (SV*)&sv_list[92];
*svp++ = (SV*)&sv_list[93];
*svp++ = (SV*)&sv_list[94];
*svp++ = (SV*)&sv_list[95];
*svp++ = (SV*)&sv_list[96];
*svp++ = (SV*)&sv_list[97];
AvFILLp(av) = 57;
}
GvAV(gv_list[59]) = (AV*)&sv_list[39];
GvHV(gv_list[59]) = (HV*)&sv_list[98];
GvFILE(gv_list[59]) = "";
gv_list[60] = gv_fetchpv("main::ENV", TRUE, SVt_PV);
SvFLAGS(gv_list[60]) = 0x600d;
GvFLAGS(gv_list[60]) = 0xa;
GvLINE(gv_list[60]) = 0;
SvPVX(gv_list[60]) = emptystring;
SvREFCNT(gv_list[60]) += 5;
GvREFCNT(gv_list[60]) += 1;
gv_list[61] = gv_fetchpv("main::_<perlio.c", TRUE, SVt_PV);
SvFLAGS(gv_list[61]) = 0x600d;
GvFLAGS(gv_list[61]) = 0x2;
GvLINE(gv_list[61]) = 0;
SvPVX(gv_list[61]) = emptystring;
SvREFCNT(gv_list[61]) += 2;
GvREFCNT(gv_list[61]) += 1;
xpv_list[69].xpv_pv = savepvn("perlio.c", 8);
GvSV(gv_list[61]) = &sv_list[99];
GvFILE(gv_list[61]) = "hello.p";
gv_list[62] = gv_fetchpv("main:::", TRUE, SVt_PV);
SvFLAGS(gv_list[62]) = 0x600d;
GvFLAGS(gv_list[62]) = 0xa;
GvLINE(gv_list[62]) = 546;
SvPVX(gv_list[62]) = emptystring;
SvREFCNT(gv_list[62]) += 4;
GvREFCNT(gv_list[62]) += 1;
gv_list[63] = gv_fetchpv("PerlIO::get_layers", TRUE, SVt_PV);
SvFLAGS(gv_list[63]) = 0x600d;
GvFLAGS(gv_list[63]) = 0x2;
GvLINE(gv_list[63]) = 0;
SvPVX(gv_list[63]) = emptystring;
SvREFCNT(gv_list[63]) += 2;
GvREFCNT(gv_list[63]) += 1;
GvSV(gv_list[63]) = &sv_list[100];
GvCV(gv_list[63]) = (CV*)((perl_get_cv("PerlIO::get_layers",TRUE)));
GvFILE(gv_list[63]) = "hello.p";
gv_list[64] = gv_fetchpv("PerlIO::Layer::NoWarnings", TRUE, SVt_PV);
SvFLAGS(gv_list[64]) = 0x600d;
GvFLAGS(gv_list[64]) = 0x2;
GvLINE(gv_list[64]) = 0;
SvPVX(gv_list[64]) = emptystring;
SvREFCNT(gv_list[64]) += 2;
GvREFCNT(gv_list[64]) += 1;
GvSV(gv_list[64]) = &sv_list[101];
GvCV(gv_list[64]) = (CV*)((perl_get_cv("PerlIO::Layer::NoWarnings",TRUE)));
GvFILE(gv_list[64]) = "hello.p";
gv_list[65] = gv_fetchpv("PerlIO::Layer::find", TRUE, SVt_PV);
SvFLAGS(gv_list[65]) = 0x600d;
GvFLAGS(gv_list[65]) = 0x2;
GvLINE(gv_list[65]) = 0;
SvPVX(gv_list[65]) = emptystring;
SvREFCNT(gv_list[65]) += 2;
GvREFCNT(gv_list[65]) += 1;
GvSV(gv_list[65]) = &sv_list[102];
GvCV(gv_list[65]) = (CV*)((perl_get_cv("PerlIO::Layer::find",TRUE)));
GvFILE(gv_list[65]) = "hello.p";
gv_list[66] = gv_fetchpv("main::0", TRUE, SVt_PV);
SvFLAGS(gv_list[66]) = 0x600d;
GvFLAGS(gv_list[66]) = 0xa;
GvLINE(gv_list[66]) = 0;
SvPVX(gv_list[66]) = emptystring;
SvREFCNT(gv_list[66]) += 5;
GvREFCNT(gv_list[66]) += 1;
gv_list[67] = gv_fetchpv("main::.", TRUE, SVt_PV);
SvFLAGS(gv_list[67]) = 0x600d;
GvFLAGS(gv_list[67]) = 0xa;
GvLINE(gv_list[67]) = 496;
SvPVX(gv_list[67]) = emptystring;
SvREFCNT(gv_list[67]) += 5;
GvREFCNT(gv_list[67]) += 1;
gv_list[68] = gv_fetchpv("main::\b", TRUE, SVt_PV);
SvFLAGS(gv_list[68]) = 0x600d;
GvFLAGS(gv_list[68]) = 0xa;
GvLINE(gv_list[68]) = 0;
SvPVX(gv_list[68]) = emptystring;
SvREFCNT(gv_list[68]) += 5;
GvREFCNT(gv_list[68]) += 1;
gv_list[69] = gv_fetchpv("main::@", TRUE, SVt_PV);
SvFLAGS(gv_list[69]) = 0x600d;
GvFLAGS(gv_list[69]) = 0xa;
GvLINE(gv_list[69]) = 0;
SvPVX(gv_list[69]) = emptystring;
SvREFCNT(gv_list[69]) += 13;
GvREFCNT(gv_list[69]) += 1;
gv_list[70] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/base.pm", TRUE, SVt_PV);
SvFLAGS(gv_list[70]) = 0x600d;
GvFLAGS(gv_list[70]) = 0x2;
GvLINE(gv_list[70]) = 8;
SvPVX(gv_list[70]) = emptystring;
SvREFCNT(gv_list[70]) += 2;
GvREFCNT(gv_list[70]) += 1;
xpv_list[70].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/base.pm", 28);
GvSV(gv_list[70]) = &sv_list[103];
GvFILE(gv_list[70]) = "\270/\r\b";
gv_list[71] = gv_fetchpv("main::STDOUT", TRUE, SVt_PV);
SvFLAGS(gv_list[71]) = 0x630d;
GvFLAGS(gv_list[71]) = 0xa;
GvLINE(gv_list[71]) = 0;
SvPVX(gv_list[71]) = emptystring;
SvREFCNT(gv_list[71]) += 13;
GvREFCNT(gv_list[71]) += 1;
gv_list[72] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/B/C.pm", TRUE, SVt_PV);
SvFLAGS(gv_list[72]) = 0x600d;
GvFLAGS(gv_list[72]) = 0x2;
GvLINE(gv_list[72]) = 1096;
SvPVX(gv_list[72]) = emptystring;
SvREFCNT(gv_list[72]) += 2;
GvREFCNT(gv_list[72]) += 1;
xpv_list[71].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/B/C.pm", 51);
GvSV(gv_list[72]) = &sv_list[104];
GvFILE(gv_list[72]) = "";
gv_list[73] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/B.pm", TRUE, SVt_PV);
SvFLAGS(gv_list[73]) = 0x600d;
GvFLAGS(gv_list[73]) = 0x2;
GvLINE(gv_list[73]) = 87;
SvPVX(gv_list[73]) = emptystring;
SvREFCNT(gv_list[73]) += 2;
GvREFCNT(gv_list[73]) += 1;
xpv_list[72].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/B.pm", 49);
GvSV(gv_list[73]) = &sv_list[105];
GvFILE(gv_list[73]) = "\210\327\a\b\b";
gv_list[74] = gv_fetchpv("main::]", TRUE, SVt_PV);
SvFLAGS(gv_list[74]) = 0x600d;
GvFLAGS(gv_list[74]) = 0xa;
GvLINE(gv_list[74]) = 41;
SvPVX(gv_list[74]) = emptystring;
SvREFCNT(gv_list[74]) += 2;
GvREFCNT(gv_list[74]) += 1;
gv_list[75] = gv_fetchpv("main::\027", TRUE, SVt_PV);
SvFLAGS(gv_list[75]) = 0x600d;
GvFLAGS(gv_list[75]) = 0xa;
GvLINE(gv_list[75]) = 227;
SvPVX(gv_list[75]) = emptystring;
SvREFCNT(gv_list[75]) += 4;
GvREFCNT(gv_list[75]) += 1;
gv_list[76] = gv_fetchpv("main::STDERR", TRUE, SVt_PV);
SvFLAGS(gv_list[76]) = 0x630d;
GvFLAGS(gv_list[76]) = 0xa;
GvLINE(gv_list[76]) = 0;
SvPVX(gv_list[76]) = emptystring;
SvREFCNT(gv_list[76]) += 4;
GvREFCNT(gv_list[76]) += 1;
gv_list[77] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/B/B.so", TRUE, SVt_PV);
SvFLAGS(gv_list[77]) = 0x600d;
GvFLAGS(gv_list[77]) = 0x2;
GvLINE(gv_list[77]) = 87;
SvPVX(gv_list[77]) = emptystring;
SvREFCNT(gv_list[77]) += 2;
GvREFCNT(gv_list[77]) += 1;
xpv_list[73].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/B/B.so", 56);
GvSV(gv_list[77]) = &sv_list[106];
GvFILE(gv_list[77]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[78] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/Fcntl/Fcntl.so", TRUE, SVt_PV);
SvFLAGS(gv_list[78]) = 0x600d;
GvFLAGS(gv_list[78]) = 0x2;
GvLINE(gv_list[78]) = 87;
SvPVX(gv_list[78]) = emptystring;
SvREFCNT(gv_list[78]) += 2;
GvREFCNT(gv_list[78]) += 1;
xpv_list[74].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/Fcntl/Fcntl.so", 64);
GvSV(gv_list[78]) = &sv_list[107];
GvFILE(gv_list[78]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
PL_dowarn = ( 0 ) ? G_WARN_ON : G_WARN_OFF;
PL_main_root = (OP*)&listop_list[0];
PL_main_start = &op_list[0];
PL_initav = (AV *) Nullsv;
PL_endav = (AV*) Nullsv;
xpv_list[75].xpv_pv = savepvn("Hello World\n", 12);
{
SV **svp;
AV *av = (AV*)&sv_list[109];
av_extend(av, 2);
svp = AvARRAY(av);
*svp++ = (SV*)&PL_sv_undef;
*svp++ = (SV*)&sv_list[110];
*svp++ = (SV*)&sv_list[111];
AvFILLp(av) = 2;
}
PL_curpad = AvARRAY((AV*)&sv_list[109]);
GvHV(PL_incgv) = (HV*)&sv_list[98];
GvAV(PL_incgv) = (AV*)&sv_list[39];
av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc((AV*)&sv_list[108]));
av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc((AV*)&sv_list[109]));
PL_amagic_generation= 0;
return 0;
}
/*
=for apidoc mro_get_linear_isa_dfs
Returns the Depth-First Search linearization of @ISA
the given stash. The return value is a read-only AV*.
C<level> should be 0 (it is used internally in this
function's recursion).
You are responsible for C<SvREFCNT_inc()> on the
return value if you plan to store it anywhere
semi-permanently (otherwise it might be deleted
out from under you the next time the cache is
invalidated).
=cut
*/
static AV*
S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
{
AV* retval;
GV** gvp;
GV* gv;
AV* av;
const HEK* stashhek;
struct mro_meta* meta;
SV *our_name;
HV *stored = NULL;
PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA_DFS;
assert(HvAUX(stash));
stashhek = HvNAME_HEK(stash);
if (!stashhek)
Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
if (level > 100)
Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
HEK_KEY(stashhek));
meta = HvMROMETA(stash);
/* return cache if valid */
if((retval = MUTABLE_AV(MRO_GET_PRIVATE_DATA(meta, &dfs_alg)))) {
return retval;
}
/* not in cache, make a new one */
retval = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
/* We use this later in this function, but don't need a reference to it
beyond the end of this function, so reference count is fine. */
our_name = newSVhek(stashhek);
av_push(retval, our_name); /* add ourselves at the top */
/* fetch our @ISA */
gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
av = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
/* "stored" is used to keep track of all of the classnames we have added to
the MRO so far, so we can do a quick exists check and avoid adding
duplicate classnames to the MRO as we go.
It's then retained to be re-used as a fast lookup for ->isa(), by adding
our own name and "UNIVERSAL" to it. */
if(av && AvFILLp(av) >= 0) {
SV **svp = AvARRAY(av);
I32 items = AvFILLp(av) + 1;
/* foreach(@ISA) */
while (items--) {
SV* const sv = *svp++;
HV* const basestash = gv_stashsv(sv, 0);
SV *const *subrv_p;
I32 subrv_items;
if (!basestash) {
/* if no stash exists for this @ISA member,
simply add it to the MRO and move on */
subrv_p = &sv;
subrv_items = 1;
}
else {
/* otherwise, recurse into ourselves for the MRO
of this @ISA member, and append their MRO to ours.
The recursive call could throw an exception, which
has memory management implications here, hence the use of
the mortal. */
const AV *const subrv
= mro_get_linear_isa_dfs(basestash, level + 1);
subrv_p = AvARRAY(subrv);
subrv_items = AvFILLp(subrv) + 1;
}
if (stored) {
while(subrv_items--) {
SV *const subsv = *subrv_p++;
/* LVALUE fetch will create a new undefined SV if necessary
*/
HE *const he = hv_fetch_ent(stored, subsv, 1, 0);
assert(he);
if(HeVAL(he) != &PL_sv_undef) {
/* It was newly created. Steal it for our new SV, and
replace it in the hash with the "real" thing. */
SV *const val = HeVAL(he);
HEK *const key = HeKEY_hek(he);
HeVAL(he) = &PL_sv_undef;
/* Save copying by making a shared hash key scalar. We
inline this here rather than calling
Perl_newSVpvn_share because we already have the
scalar, and we already have the hash key. */
assert(SvTYPE(val) == SVt_NULL);
sv_upgrade(val, SVt_PV);
SvPV_set(val, HEK_KEY(share_hek_hek(key)));
SvCUR_set(val, HEK_LEN(key));
SvREADONLY_on(val);
SvFAKE_on(val);
SvPOK_on(val);
if (HEK_UTF8(key))
SvUTF8_on(val);
av_push(retval, val);
}
}
} else {
/* We are the first (or only) parent. We can short cut the
complexity above, because our @ISA is simply us prepended
to our parent's @ISA, and our ->isa cache is simply our
parent's, with our name added. */
/* newSVsv() is slow. This code is only faster if we can avoid
it by ensuring that SVs in the arrays are shared hash key
scalar SVs, because we can "copy" them very efficiently.
Although to be fair, we can't *ensure* this, as a reference
to the internal array is returned by mro::get_linear_isa(),
so we'll have to be defensive just in case someone faffed
with it. */
if (basestash) {
SV **svp;
stored = MUTABLE_HV(sv_2mortal((SV*)newHVhv(HvMROMETA(basestash)->isa)));
av_extend(retval, subrv_items);
AvFILLp(retval) = subrv_items;
svp = AvARRAY(retval);
while(subrv_items--) {
SV *const val = *subrv_p++;
*++svp = SvIsCOW_shared_hash(val)
? newSVhek(SvSHARED_HEK_FROM_PV(SvPVX(val)))
: newSVsv(val);
}
} else {
/* They have no stash. So create ourselves an ->isa cache
as if we'd copied it from what theirs should be. */
stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
(void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0);
av_push(retval,
newSVhek(HeKEY_hek(hv_store_ent(stored, sv,
&PL_sv_undef, 0))));
}
}
}
} else {
/* We have no parents. */
stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
(void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0);
}
(void) hv_store_ent(stored, our_name, &PL_sv_undef, 0);
SvREFCNT_inc_simple_void_NN(stored);
SvTEMP_off(stored);
SvREADONLY_on(stored);
meta->isa = stored;
/* now that we're past the exception dangers, grab our own reference to
the AV we're about to use for the result. The reference owned by the
mortals' stack will be released soon, so everything will balance. */
SvREFCNT_inc_simple_void_NN(retval);
SvTEMP_off(retval);
/* we don't want anyone modifying the cache entry but us,
and we do so by replacing it completely */
SvREADONLY_on(retval);
return MUTABLE_AV(Perl_mro_set_private_data(aTHX_ meta, &dfs_alg,
MUTABLE_SV(retval)));
}
SV* /* AV if want_pos or want_all, PV otherwise */
lcss(
int wide, /* s and t are in the UTF8=1 format */
const char* s, /* Format determined by utf8 parameter */
STRLEN s_len, /* Byte length of s */
const char* t, /* Format determined by utf8 parameter */
STRLEN t_len, /* Byte length of t */
int min, /* Ignore substrings shorter than this */
int want_pos, /* Return positions as well as strings */
int want_all /* Return all matches, or just one */
) {
UV found; /* Number of longest substrings */
STRLEN z; /* Length of longuest substr */
int swapped; /* If s and t were swapped */
STRLEN* pos_s; /* 1-based char pos of the start of each longest substring in s */
STRLEN* pos_t; /* 1-based char pos of the start of each longest substring in t */
size_t allocated;
STRLEN* K; /* Previous row */
STRLEN* L; /* Current row */
SV* rv;
/* To save memory */
swapped = s_len < t_len;
if (swapped) {
SWAP(const char*, s, t);
SWAP(STRLEN, s_len, t_len);
}
/* This is potentially longer than needed when wide */
CALLOC(K, STRLEN, t_len + 1);
CALLOC(L, STRLEN, t_len + 1);
z = min - 1;
found = 0;
allocated = want_all ? 256 : 1;
MALLOC(pos_s, STRLEN, allocated);
MALLOC(pos_t, STRLEN, allocated);
/* Compute matrix */
if (wide) {
STRLEN s_pos; STRLEN t_pos; /* 1-based current char pos */
const U8* s_cur; const U8* t_cur; /* Pointer to current char */
STRLEN s_rem; STRLEN t_rem; /* Bytes remaining */
UV s_ch; UV t_ch; /* Current character */
for (s_pos=1, s_cur=(const U8*)s, s_rem=s_len; s_rem; ++s_pos) {
GRAB_AND_ADVANCE_ONE(s_ch, s_cur, s_rem);
for (t_pos=1, t_cur=(const U8*)t, t_rem=t_len; t_rem; ++t_pos) {
GRAB_AND_ADVANCE_ONE(t_ch, t_cur, t_rem);
if (s_ch == t_ch) {
L[t_pos] = K[t_pos - 1] + 1;
if (L[t_pos] > z) {
z = L[t_pos];
pos_s[0] = s_pos - z;
pos_t[0] = t_pos - z;
found = 1;
} else if (want_all & L[t_pos] == z && found) {
/* Maybe we need some more space */
if (found >= allocated) {
allocated += 256;
REALLOC(pos_s, STRLEN, allocated);
REALLOC(pos_t, STRLEN, allocated);
}
pos_s[found] = s_pos - z;
pos_t[found] = t_pos - z;
++found;
}
} else {
L[t_pos] = 0;
}
}
SWAP(STRLEN*, K, L);
}
} else {
STRLEN s_pos; /* 1-based current char pos */
STRLEN t_pos;
for (s_pos = 1; s_pos <= s_len; ++s_pos) {
for (t_pos = 1; t_pos <= t_len; ++t_pos) {
if (s[s_pos - 1] == t[t_pos - 1]) {
L[t_pos] = K[t_pos - 1] + 1;
if (L[t_pos] > z) {
z = L[t_pos];
pos_s[0] = s_pos - z;
pos_t[0] = t_pos - z;
found = 1;
} else if (want_all & L[t_pos] == z && found) {
/* Maybe we need some more space */
if (found >= allocated) {
allocated += 256;
REALLOC(pos_s, STRLEN, allocated);
REALLOC(pos_t, STRLEN, allocated);
}
pos_s[found] = s_pos - z;
pos_t[found] = t_pos - z;
++found;
}
} else {
L[t_pos] = 0;
}
}
SWAP(STRLEN*, K, L);
}
}
FREE(K);
FREE(L);
if (want_all) {
AV* const av = newAV();
I32 i;
STRLEN cur_pos;
rv = (SV*)av;
av_extend(av, found-1);
for (cur_pos=0, i=0; i<found; ++i) {
AV* const inner_av = newAV();
av_store(av, i, newRV_noinc((SV*)inner_av));
av_extend(inner_av, 2);
if (wide) {
av_store(inner_av, 0, _get_utf8_str_iter((const U8**)&t, &t_len, pos_t[i]-cur_pos, z));
cur_pos = pos_t[i] + z;
} else {
av_store(inner_av, 0, newSVpvn_utf8(t+pos_t[i], z, 0));
}
if (swapped) {
av_store(inner_av, 2, newSViv(pos_s[i]));
av_store(inner_av, 1, newSViv(pos_t[i]));
} else {
av_store(inner_av, 1, newSViv(pos_s[i]));
av_store(inner_av, 2, newSViv(pos_t[i]));
}
}
}
else if (want_pos) {
AV* const av = newAV();
rv = (SV*)av;
if (found) {
av_extend(av, 2);
if (wide) {
av_store(av, 0, _get_utf8_str((const U8*)t, t_len, pos_t[0], z));
} else {
av_store(av, 0, newSVpvn_utf8(t+pos_t[0], z, 0));
}
if (swapped) {
av_store(av, 2, newSViv(pos_s[0]));
av_store(av, 1, newSViv(pos_t[0]));
} else {
av_store(av, 1, newSViv(pos_s[0]));
av_store(av, 2, newSViv(pos_t[0]));
}
}
}
else {
if (found) {
if (wide)
rv = _get_utf8_str((const U8*)t, t_len, pos_t[0], z);
else
rv = newSVpvn(t+pos_t[0], z);
}
else
rv = &PL_sv_undef;
}
FREE(pos_s);
FREE(pos_t);
return rv;
}
void single_hook_fill(pTHX_ const char *hook, const char *type, SingleHook *sth,
SV *sub, U32 allowed_args)
{
if (!DEFINED(sub))
{
sth->sub = NULL;
sth->arg = NULL;
}
else if (SvROK(sub))
{
SV *sv = SvRV(sub);
switch (SvTYPE(sv))
{
case SVt_PVCV:
sth->sub = sv;
sth->arg = NULL;
break;
case SVt_PVAV:
{
AV *in = (AV *) sv;
I32 len = av_len(in);
if (len < 0)
Perl_croak(aTHX_ "Need at least a code reference in %s hook for "
"type '%s'", hook, type);
else
{
SV **pSV = av_fetch(in, 0, 0);
if (pSV == NULL || !SvROK(*pSV) ||
SvTYPE(sv = SvRV(*pSV)) != SVt_PVCV)
Perl_croak(aTHX_ "%s hook defined for '%s' is not "
"a code reference", hook, type);
else
{
I32 ix;
AV *out;
for (ix = 0; ix < len; ++ix)
{
pSV = av_fetch(in, ix+1, 0);
if (pSV == NULL)
fatal("NULL returned by av_fetch() in single_hook_fill()");
if (SvROK(*pSV) && sv_isa(*pSV, ARGTYPE_PACKAGE))
{
HookArgType argtype = (HookArgType) SvIV(SvRV(*pSV));
#define CHECK_ARG_TYPE(type) \
case HOOK_ARG_ ## type: \
if ((allowed_args & SHF_ALLOW_ARG_ ## type) == 0) \
Perl_croak(aTHX_ #type " argument not allowed"); \
break
switch (argtype)
{
CHECK_ARG_TYPE(SELF);
CHECK_ARG_TYPE(TYPE);
CHECK_ARG_TYPE(DATA);
CHECK_ARG_TYPE(HOOK);
}
#undef CHECK_ARG_TYPE
}
}
sth->sub = sv;
out = newAV();
av_extend(out, len-1);
for (ix = 0; ix < len; ++ix)
{
pSV = av_fetch(in, ix+1, 0);
if (pSV == NULL)
fatal("NULL returned by av_fetch() in single_hook_fill()");
SvREFCNT_inc(*pSV);
if (av_store(out, ix, *pSV) == NULL)
SvREFCNT_dec(*pSV);
}
sth->arg = (AV *) sv_2mortal((SV *) out);
}
}
}
break;
default:
goto not_code_or_array_ref;
}
}
else
{
not_code_or_array_ref:
Perl_croak(aTHX_ "%s hook defined for '%s' is not "
"a code or array reference", hook, type);
}
}
