diff options
Diffstat (limited to 'eval')
| -rw-r--r-- | eval | 318 |
1 files changed, 0 insertions, 318 deletions
@@ -1,318 +0,0 @@ - -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; -} - |