diff options
Diffstat (limited to 'eval')
| -rw-r--r-- | eval | 318 |
1 files changed, 318 insertions, 0 deletions
@@ -0,0 +1,318 @@ + +void +save_lines(array, sv) +AV *array; +SV *sv; +{ + register char *s = sv->sv_ptr; + register char *send = sv->sv_ptr + sv->sv_cur; + register char *t; + register int line = 1; + + while (s && s < send) { + SV *tmpstr = NEWSV(85,0); + + t = index(s, '\n'); + if (t) + t++; + else + t = send; + + sv_setpvn(tmpstr, s, t - s); + av_store(array, line++, tmpstr); + s = t; + } +} + +int +do_eval(sv,optype,stash,savecmd,gimme,arglast) +SV *sv; +int optype; +HV *stash; +int savecmd; +int gimme; +int *arglast; +{ + SV **st = stack->av_array; + int retval; + COP *myroot = Nullcop; + AV *ar; + int i; + COP * VOL oldcurcmd = curcmd; + VOL int oldtmps_floor = tmps_floor; + VOL int oldsave = savestack->av_fill; + VOL int oldperldb = perldb; + PM * VOL oldspat = curspat; + PM * VOL oldlspat = lastspat; + + VOL int sp = arglast[0]; + char *specfilename; + char *tmpfilename; + int parsing = 1; + + tmps_floor = tmps_ix; + if (curstash != stash) { + (void)save_hptr(&curstash); + curstash = stash; + } + sv_setpv(GvSV(gv_fetchpv("@",TRUE)),""); + if (curcmd->cop_line == 0) /* don't debug debugger... */ + perldb = FALSE; + curcmd = &compiling; + if (optype == OP_EVAL) { /* normal oldeval */ + curcmd->cop_filestab = gv_fetchfile("(oldeval)"); + curcmd->cop_line = 1; + sv_setsv(linestr,sv); + sv_catpv(linestr,";\n;\n"); /* be kind to them */ + if (perldb) + save_lines(GvAV(curcmd->cop_filestab), linestr); + } + else { + if (last_root && !in_eval) { + Safefree(last_eval); + last_eval = Nullch; + cop_free(last_root); + last_root = Nullcop; + } + specfilename = SvPV(sv); + sv_setpv(linestr,""); + if (optype == OP_REQUIRE && &sv_undef != + hv_fetch(GvHVn(incstab), specfilename, strlen(specfilename), 0)) { + curcmd = oldcurcmd; + tmps_floor = oldtmps_floor; + st[++sp] = &sv_yes; + perldb = oldperldb; + return sp; + } + tmpfilename = savestr(specfilename); + if (*tmpfilename == '/' || + (*tmpfilename == '.' && + (tmpfilename[1] == '/' || + (tmpfilename[1] == '.' && tmpfilename[2] == '/')))) + { + rsfp = fopen(tmpfilename,"r"); + } + else { + ar = GvAVn(incstab); + for (i = 0; i <= ar->av_fill; i++) { + (void)sprintf(buf, "%s/%s", + SvPV(av_fetch(ar,i,TRUE)), specfilename); + rsfp = fopen(buf,"r"); + if (rsfp) { + char *s = buf; + + if (*s == '.' && s[1] == '/') + s += 2; + Safefree(tmpfilename); + tmpfilename = savestr(s); + break; + } + } + } + curcmd->cop_filestab = gv_fetchfile(tmpfilename); + Safefree(tmpfilename); + tmpfilename = Nullch; + if (!rsfp) { + curcmd = oldcurcmd; + tmps_floor = oldtmps_floor; + if (optype == OP_REQUIRE) { + sprintf(tokenbuf,"Can't locate %s in @INC", specfilename); + if (instr(tokenbuf,".h ")) + strcat(tokenbuf," (change .h to .ph maybe?)"); + if (instr(tokenbuf,".ph ")) + strcat(tokenbuf," (did you run h2ph?)"); + fatal("%s",tokenbuf); + } + if (gimme != G_ARRAY) + st[++sp] = &sv_undef; + perldb = oldperldb; + return sp; + } + curcmd->cop_line = 0; + } + in_eval++; + oldoldbufptr = oldbufptr = bufptr = SvPV(linestr); + bufend = bufptr + linestr->sv_cur; + if (++cxstack_ix >= block_max) { + block_max += 128; + Renew(block_stack, block_max, struct loop); + } + block_stack[cxstack_ix].block_label = "_EVAL_"; + block_stack[cxstack_ix].block_sp = sp; +#ifdef DEBUGGING + if (debug & 4) { + deb("(Pushing label #%d _EVAL_)\n", cxstack_ix); + } +#endif + eval_root = Nullcop; + if (setjmp(block_stack[cxstack_ix].block_env)) { + retval = 1; + } + else { + error_count = 0; + if (rsfp) { + retval = yyparse(); + retval |= error_count; + } + else if (last_root && last_elen == bufend - bufptr + && *bufptr == *last_eval && !bcmp(bufptr,last_eval,last_elen)){ + retval = 0; + eval_root = last_root; /* no point in reparsing */ + } + else if (in_eval == 1 && !savecmd) { + if (last_root) { + Safefree(last_eval); + last_eval = Nullch; + cop_free(last_root); + } + last_root = Nullcop; + last_elen = bufend - bufptr; + last_eval = nsavestr(bufptr, last_elen); + retval = yyparse(); + retval |= error_count; + if (!retval) + last_root = eval_root; + if (!last_root) { + Safefree(last_eval); + last_eval = Nullch; + } + } + else + retval = yyparse(); + } + myroot = eval_root; /* in case cop_exec does another oldeval! */ + + if (retval || error_count) { + st = stack->av_array; + sp = arglast[0]; + if (gimme != G_ARRAY) + st[++sp] = &sv_undef; + if (parsing) { +#ifndef MANGLEDPARSE +#ifdef DEBUGGING + if (debug & 128) + fprintf(stderr,"Freeing eval_root %lx\n",(long)eval_root); +#endif + cop_free(eval_root); +#endif + /*SUPPRESS 29*/ /*SUPPRESS 30*/ + if ((COP*)eval_root == last_root) + last_root = Nullcop; + eval_root = myroot = Nullcop; + } + if (rsfp) { + fclose(rsfp); + rsfp = 0; + } + } + else { + parsing = 0; + sp = cop_exec(eval_root,gimme,sp); + st = stack->av_array; + for (i = arglast[0] + 1; i <= sp; i++) + st[i] = sv_mortalcopy(st[i]); + /* if we don't save result, free zaps it */ + if (savecmd) + eval_root = myroot; + else if (in_eval != 1 && myroot != last_root) + cop_free(myroot); + } + + perldb = oldperldb; + in_eval--; +#ifdef DEBUGGING + if (debug & 4) { + char *tmps = block_stack[cxstack_ix].block_label; + deb("(Popping label #%d %s)\n",cxstack_ix, + tmps ? tmps : "" ); + } +#endif + cxstack_ix--; + tmps_floor = oldtmps_floor; + curspat = oldspat; + lastspat = oldlspat; + if (savestack->av_fill > oldsave) /* let them use local() */ + leave_scope(oldsave); + + if (optype != OP_EVAL) { + if (retval) { + if (optype == OP_REQUIRE) + fatal("%s", SvPV(GvSV(gv_fetchpv("@",TRUE)))); + } + else { + curcmd = oldcurcmd; + if (gimme == G_SCALAR ? SvTRUE(st[sp]) : sp > arglast[0]) { + (void)hv_store(GvHVn(incstab), specfilename, + strlen(specfilename), newSVsv(GvSV(curcmd->cop_filestab)), + 0 ); + } + else if (optype == OP_REQUIRE) + fatal("%s did not return a true value", specfilename); + } + } + curcmd = oldcurcmd; + return sp; +} + +int +do_try(cmd,gimme,arglast) +COP *cmd; +int gimme; +int *arglast; +{ + SV **st = stack->av_array; + + COP * VOL oldcurcmd = curcmd; + VOL int oldtmps_floor = tmps_floor; + VOL int oldsave = savestack->av_fill; + PM * VOL oldspat = curspat; + PM * VOL oldlspat = lastspat; + VOL int sp = arglast[0]; + + tmps_floor = tmps_ix; + sv_setpv(GvSV(gv_fetchpv("@",TRUE)),""); + in_eval++; + if (++cxstack_ix >= block_max) { + block_max += 128; + Renew(block_stack, block_max, struct loop); + } + block_stack[cxstack_ix].block_label = "_EVAL_"; + block_stack[cxstack_ix].block_sp = sp; +#ifdef DEBUGGING + if (debug & 4) { + deb("(Pushing label #%d _EVAL_)\n", cxstack_ix); + } +#endif + if (setjmp(block_stack[cxstack_ix].block_env)) { + st = stack->av_array; + sp = arglast[0]; + if (gimme != G_ARRAY) + st[++sp] = &sv_undef; + } + else { + sp = cop_exec(cmd,gimme,sp); + st = stack->av_array; +/* for (i = arglast[0] + 1; i <= sp; i++) + st[i] = sv_mortalcopy(st[i]); not needed, I think */ + /* if we don't save result, free zaps it */ + } + + in_eval--; +#ifdef DEBUGGING + if (debug & 4) { + char *tmps = block_stack[cxstack_ix].block_label; + deb("(Popping label #%d %s)\n",cxstack_ix, + tmps ? tmps : "" ); + } +#endif + cxstack_ix--; + tmps_floor = oldtmps_floor; + curspat = oldspat; + lastspat = oldlspat; + curcmd = oldcurcmd; + if (savestack->av_fill > oldsave) /* let them use local() */ + leave_scope(oldsave); + + return sp; +} + |