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; }