void dualize(SV* arg, const char* string) { svtype sv_type; sv_type = SvTYPE(arg); switch(sv_type) { case SVt_IV: SvUPGRADE(arg, SVt_PVIV); sv_setpv(arg, string); SvIOK_on(arg); break; case SVt_NV: SvUPGRADE(arg, SVt_PVNV); sv_setpv(arg, string); SvNOK_on(arg); break; // how do we do this for blessed refs? // this doesn't work case SVt_PVMG: sv_setpv(arg, string); break; default: DEBUGME(2, "Got svtype of %d", sv_type); } }
static void pe_tracevar(pe_watcher *wa, SV *sv, int got) { /* Adapted from tkGlue.c We are a "magic" set processor. So we are (I think) supposed to look at "private" flags and set the public ones if appropriate. e.g. "chop" sets SvPOKp as a hint but not SvPOK presumably other operators set other private bits. Question are successive "magics" called in correct order? i.e. if we are tracing a tied variable should we call some magic list or be careful how we insert ourselves in the list? */ pe_ioevent *ev; if (SvPOKp(sv)) SvPOK_on(sv); if (SvNOKp(sv)) SvNOK_on(sv); if (SvIOKp(sv)) SvIOK_on(sv); ev = (pe_ioevent*) (*wa->vtbl->new_event)(wa); ++ev->base.hits; ev->got |= got; queueEvent((pe_event*) ev); }
int ithread_mg_get(pTHX_ SV *sv, MAGIC *mg) { ithread *thread = (ithread *) mg->mg_ptr; SvIVX(sv) = PTR2IV(thread); SvIOK_on(sv); return 0; }
static SV *err_to_SV(pTHX_ int err) { SV *ret = sv_newmortal(); SvUPGRADE(ret, SVt_PVNV); if(err) { const char *error = gai_strerror(err); sv_setpv(ret, error); } else { sv_setpv(ret, ""); } SvIV_set(ret, err); SvIOK_on(ret); return ret; }
STATIC char * S_skipspace(pTHX_ register char *s, int incline) { if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) { while (s < PL_bufend && SPACE_OR_TAB(*s)) s++; return s; } for (;;) { STRLEN prevlen; SSize_t oldprevlen, oldoldprevlen; SSize_t oldloplen = 0, oldunilen = 0; while (s < PL_bufend && isSPACE(*s)) { if (*s++ == '\n' && ((incline == 2) || (PL_in_eval && !PL_rsfp && !incline))) incline(s); } /* comment */ if (s < PL_bufend && *s == '#') { while (s < PL_bufend && *s != '\n') s++; if (s < PL_bufend) { s++; if (PL_in_eval && !PL_rsfp && !incline) { incline(s); continue; } } } /* also skip leading whitespace on the beginning of a line before deciding * whether or not to recharge the linestr. --rafl */ while (s < PL_bufend && isSPACE(*s)) { if (*s++ == '\n' && PL_in_eval && !PL_rsfp && !incline) incline(s); } /* only continue to recharge the buffer if we're at the end * of the buffer, we're not reading from a source filter, and * we're in normal lexing mode */ if (s < PL_bufend || !PL_rsfp || PL_lex_inwhat || PL_lex_state == LEX_FORMLINE) return s; /* try to recharge the buffer */ if ((s = filter_gets(PL_linestr, PL_rsfp, (prevlen = SvCUR(PL_linestr)))) == Nullch) { /* end of file. Add on the -p or -n magic */ if (PL_minus_p) { sv_setpv(PL_linestr, ";}continue{print or die qq(-p destination: $!\\n);}"); PL_minus_n = PL_minus_p = 0; } else if (PL_minus_n) { sv_setpvn(PL_linestr, ";}", 2); PL_minus_n = 0; } else sv_setpvn(PL_linestr,";", 1); /* reset variables for next time we lex */ PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); PL_last_lop = PL_last_uni = Nullch; /* In perl versions previous to p4-rawid: //depot/perl@32954 -P * preprocessors were supported here. We don't support -P at all, even * on perls that support it, and use the following chunk from blead * perl. (rafl) */ /* Close the filehandle. Could be from * STDIN, or a regular file. If we were reading code from * STDIN (because the commandline held no -e or filename) * then we don't close it, we reset it so the code can * read from STDIN too. */ if ((PerlIO*)PL_rsfp == PerlIO_stdin()) PerlIO_clearerr(PL_rsfp); else (void)PerlIO_close(PL_rsfp); PL_rsfp = Nullfp; return s; } /* not at end of file, so we only read another line */ /* make corresponding updates to old pointers, for yyerror() */ oldprevlen = PL_oldbufptr - PL_bufend; oldoldprevlen = PL_oldoldbufptr - PL_bufend; if (PL_last_uni) oldunilen = PL_last_uni - PL_bufend; if (PL_last_lop) oldloplen = PL_last_lop - PL_bufend; PL_linestart = PL_bufptr = s + prevlen; PL_bufend = s + SvCUR(PL_linestr); s = PL_bufptr; PL_oldbufptr = s + oldprevlen; PL_oldoldbufptr = s + oldoldprevlen; if (PL_last_uni) PL_last_uni = s + oldunilen; if (PL_last_lop) PL_last_lop = s + oldloplen; if (!incline) incline(s); /* debugger active and we're not compiling the debugger code, * so store the line into the debugger's array of lines */ if (PERLDB_LINE && PL_curstash != PL_debstash) { AV *fileav = CopFILEAV(PL_curcop); if (fileav) { SV * const sv = NEWSV(85,0); sv_upgrade(sv, SVt_PVMG); sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr); (void)SvIOK_on(sv); SvIV_set(sv, 0); av_store(fileav,(I32)CopLINE(PL_curcop),sv); } } } }