perl 5.000perl-5.000

[editor's note: this commit combines approximate 4 months of furious
releases of Andy Dougherty and Larry Wall - see pod/perlhist.pod for
details.  Andy notes that;
 
Alas neither my "Irwin AccuTrack" nor my DC 600A quarter-inch cartridge 
backup tapes from that era seem to be readable anymore.  I guess 13 years 
exceeds the shelf life for that backup technology :-(.
]

1 files changed, 0 insertions, 318 deletions

diff --git a/eval b/eval
deleted file mode 100644
index 21cebafe50..0000000000
--- a/eval
+++ /dev/null
@@ -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;
-}
-