perl 3.0 beta kit [14/23]
Larry Wall
lwall at jato.Jpl.Nasa.Gov
Mon Sep 4 05:00:10 AEST 1989
#! /bin/sh
# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 23 through sh. When all 23 kits have been run, read README.
echo "This is perl 3.0 kit 14 (of 23). If kit 14 is complete, the line"
echo '"'"End of kit 14 (of 23)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir t 2>/dev/null
echo Extracting cmd.c
sed >cmd.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: cmd.c,v 2.0.1.4 88/11/18 23:52:06 lwall Locked $
X *
X * Copyright (c) 1989, Larry Wall
X *
X * You may distribute under the terms of the GNU General Public License
X * as specified in the README file that comes with the perl 3.0 kit.
X *
X * $Log: cmd.c,v $
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X
X#ifdef VARARGS
X# include <varargs.h>
X#endif
X
Xstatic STR str_chop;
X
X/* This is the main command loop. We try to spend as much time in this loop
X * as possible, so lots of optimizations do their activities in here. This
X * means things get a little sloppy.
X */
X
Xint
Xcmd_exec(cmd,gimme,sp)
X#ifdef cray /* nobody else has complained yet */
XCMD *cmd;
X#else
Xregister CMD *cmd;
X#endif
Xint gimme;
Xint sp;
X{
X SPAT *oldspat;
X int oldsave;
X int aryoptsave;
X#ifdef DEBUGGING
X int olddlevel;
X int entdlevel;
X#endif
X register STR *retstr = &str_undef;
X register char *tmps;
X register int cmdflags;
X register int match;
X register char *go_to = goto_targ;
X register int newsp = -2;
X register STR **st = stack->ary_array;
X FILE *fp;
X ARRAY *ar;
X
X lastsize = 0;
X#ifdef DEBUGGING
X entdlevel = dlevel;
X#endif
Xtail_recursion_entry:
X#ifdef DEBUGGING
X dlevel = entdlevel;
X#endif
X#ifdef TAINT
X tainted = 0; /* Each statement is presumed innocent */
X#endif
X if (cmd == Nullcmd) {
X if (gimme == G_ARRAY && newsp > -2)
X return newsp;
X else {
X st[++sp] = retstr;
X return sp;
X }
X }
X cmdflags = cmd->c_flags; /* hopefully load register */
X if (go_to) {
X if (cmd->c_label && strEQ(go_to,cmd->c_label))
X goto_targ = go_to = Nullch; /* here at last */
X else {
X switch (cmd->c_type) {
X case C_IF:
X oldspat = curspat;
X oldsave = savestack->ary_fill;
X#ifdef DEBUGGING
X olddlevel = dlevel;
X#endif
X retstr = &str_yes;
X newsp = -2;
X if (cmd->ucmd.ccmd.cc_true) {
X#ifdef DEBUGGING
X if (debug) {
X debname[dlevel] = 't';
X debdelim[dlevel++] = '_';
X }
X#endif
X newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
X st = stack->ary_array; /* possible reallocated */
X retstr = st[newsp];
X }
X if (!goto_targ)
X go_to = Nullch;
X curspat = oldspat;
X if (savestack->ary_fill > oldsave)
X restorelist(oldsave);
X#ifdef DEBUGGING
X dlevel = olddlevel;
X#endif
X cmd = cmd->ucmd.ccmd.cc_alt;
X goto tail_recursion_entry;
X case C_ELSE:
X oldspat = curspat;
X oldsave = savestack->ary_fill;
X#ifdef DEBUGGING
X olddlevel = dlevel;
X#endif
X retstr = &str_undef;
X newsp = -2;
X if (cmd->ucmd.ccmd.cc_true) {
X#ifdef DEBUGGING
X if (debug) {
X debname[dlevel] = 'e';
X debdelim[dlevel++] = '_';
X }
X#endif
X newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
X st = stack->ary_array; /* possible reallocated */
X retstr = st[newsp];
X }
X if (!goto_targ)
X go_to = Nullch;
X curspat = oldspat;
X if (savestack->ary_fill > oldsave)
X restorelist(oldsave);
X#ifdef DEBUGGING
X dlevel = olddlevel;
X#endif
X break;
X case C_BLOCK:
X case C_WHILE:
X if (!(cmdflags & CF_ONCE)) {
X cmdflags |= CF_ONCE;
X loop_ptr++;
X loop_stack[loop_ptr].loop_label = cmd->c_label;
X loop_stack[loop_ptr].loop_sp = sp;
X#ifdef DEBUGGING
X if (debug & 4) {
X deb("(Pushing label #%d %s)\n",
X loop_ptr, cmd->c_label ? cmd->c_label : "");
X }
X#endif
X }
X switch (setjmp(loop_stack[loop_ptr].loop_env)) {
X case O_LAST: /* not done unless go_to found */
X go_to = Nullch;
X st = stack->ary_array; /* possible reallocated */
X if (lastretstr) {
X retstr = lastretstr;
X newsp = -2;
X }
X else {
X newsp = sp + lastsize;
X retstr = st[newsp];
X }
X#ifdef DEBUGGING
X olddlevel = dlevel;
X#endif
X curspat = oldspat;
X if (savestack->ary_fill > oldsave)
X restorelist(oldsave);
X goto next_cmd;
X case O_NEXT: /* not done unless go_to found */
X go_to = Nullch;
X goto next_iter;
X case O_REDO: /* not done unless go_to found */
X go_to = Nullch;
X goto doit;
X }
X oldspat = curspat;
X oldsave = savestack->ary_fill;
X#ifdef DEBUGGING
X olddlevel = dlevel;
X#endif
X if (cmd->ucmd.ccmd.cc_true) {
X#ifdef DEBUGGING
X if (debug) {
X debname[dlevel] = 't';
X debdelim[dlevel++] = '_';
X }
X#endif
X newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
X st = stack->ary_array; /* possible reallocated */
X retstr = st[newsp];
X }
X if (!goto_targ) {
X go_to = Nullch;
X goto next_iter;
X }
X#ifdef DEBUGGING
X dlevel = olddlevel;
X#endif
X if (cmd->ucmd.ccmd.cc_alt) {
X#ifdef DEBUGGING
X if (debug) {
X debname[dlevel] = 'a';
X debdelim[dlevel++] = '_';
X }
X#endif
X newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme,sp);
X st = stack->ary_array; /* possible reallocated */
X retstr = st[newsp];
X }
X if (goto_targ)
X break;
X go_to = Nullch;
X goto finish_while;
X }
X cmd = cmd->c_next;
X if (cmd && cmd->c_head == cmd)
X /* reached end of while loop */
X return sp; /* targ isn't in this block */
X if (cmdflags & CF_ONCE) {
X#ifdef DEBUGGING
X if (debug & 4) {
X tmps = loop_stack[loop_ptr].loop_label;
X deb("(Popping label #%d %s)\n",loop_ptr,
X tmps ? tmps : "" );
X }
X#endif
X loop_ptr--;
X }
X goto tail_recursion_entry;
X }
X }
X
Xuntil_loop:
X
X /* Set line number so run-time errors can be located */
X
X line = cmd->c_line;
X
X#ifdef DEBUGGING
X if (debug) {
X if (debug & 2) {
X deb("%s (%lx) r%lx t%lx a%lx n%lx cs%lx\n",
X cmdname[cmd->c_type],cmd,cmd->c_expr,
X cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt,cmd->c_next,
X curspat);
X }
X debname[dlevel] = cmdname[cmd->c_type][0];
X debdelim[dlevel++] = '!';
X }
X#endif
X
X /* Here is some common optimization */
X
X if (cmdflags & CF_COND) {
X switch (cmdflags & CF_OPTIMIZE) {
X
X case CFT_FALSE:
X retstr = cmd->c_short;
X newsp = -2;
X match = FALSE;
X if (cmdflags & CF_NESURE)
X goto maybe;
X break;
X case CFT_TRUE:
X retstr = cmd->c_short;
X newsp = -2;
X match = TRUE;
X if (cmdflags & CF_EQSURE)
X goto flipmaybe;
X break;
X
X case CFT_REG:
X retstr = STAB_STR(cmd->c_stab);
X newsp = -2;
X match = str_true(retstr); /* => retstr = retstr, c2 should fix */
X if (cmdflags & (match ? CF_EQSURE : CF_NESURE))
X goto flipmaybe;
X break;
X
X case CFT_ANCHOR: /* /^pat/ optimization */
X if (multiline) {
X if (*cmd->c_short->str_ptr && !(cmdflags & CF_EQSURE))
X goto scanner; /* just unanchor it */
X else
X break; /* must evaluate */
X }
X /* FALL THROUGH */
X case CFT_STROP: /* string op optimization */
X retstr = STAB_STR(cmd->c_stab);
X newsp = -2;
X#ifndef I286
X if (*cmd->c_short->str_ptr == *str_get(retstr) &&
X bcmp(cmd->c_short->str_ptr, str_get(retstr),
X cmd->c_slen) == 0 ) {
X if (cmdflags & CF_EQSURE) {
X if (sawampersand && (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
X curspat = Nullspat;
X if (leftstab)
X str_nset(stab_val(leftstab),"",0);
X if (amperstab)
X str_sset(stab_val(amperstab),cmd->c_short);
X if (rightstab)
X str_nset(stab_val(rightstab),
X retstr->str_ptr + cmd->c_slen,
X retstr->str_cur - cmd->c_slen);
X }
X match = !(cmdflags & CF_FIRSTNEG);
X retstr = &str_yes;
X goto flipmaybe;
X }
X }
X else if (cmdflags & CF_NESURE) {
X match = cmdflags & CF_FIRSTNEG;
X retstr = &str_no;
X goto flipmaybe;
X }
X#else
X {
X char *zap1, *zap2, zap1c, zap2c;
X int zaplen;
X
X zap1 = cmd->c_short->str_ptr;
X zap2 = str_get(retstr);
X zap1c = *zap1;
X zap2c = *zap2;
X zaplen = cmd->c_slen;
X if ((zap1c == zap2c) && (bcmp(zap1, zap2, zaplen) == 0)) {
X if (cmdflags & CF_EQSURE) {
X if (sawampersand &&
X (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
X curspat = Nullspat;
X if (leftstab)
X str_nset(stab_val(leftstab),"",0);
X if (amperstab)
X str_sset(stab_val(amperstab),cmd->c_short);
X if (rightstab)
X str_nset(stab_val(rightstab),
X retstr->str_ptr + cmd->c_slen,
X retstr->str_cur - cmd->c_slen);
X }
X match = !(cmdflags & CF_FIRSTNEG);
X retstr = &str_yes;
X goto flipmaybe;
X }
X }
X else if (cmdflags & CF_NESURE) {
X match = cmdflags & CF_FIRSTNEG;
X retstr = &str_no;
X goto flipmaybe;
X }
X }
X#endif
X break; /* must evaluate */
X
X case CFT_SCAN: /* non-anchored search */
X scanner:
X retstr = STAB_STR(cmd->c_stab);
X newsp = -2;
X if (retstr->str_pok & SP_STUDIED)
X if (screamfirst[cmd->c_short->str_rare] >= 0)
X tmps = screaminstr(retstr, cmd->c_short);
X else
X tmps = Nullch;
X else {
X tmps = str_get(retstr); /* make sure it's pok */
X#ifndef lint
X tmps = fbminstr((unsigned char*)tmps,
X (unsigned char*)tmps + retstr->str_cur, cmd->c_short);
X#endif
X }
X if (tmps) {
X if (cmdflags & CF_EQSURE) {
X ++cmd->c_short->str_u.str_useful;
X if (sawampersand) {
X curspat = Nullspat;
X if (leftstab)
X str_nset(stab_val(leftstab),retstr->str_ptr,
X tmps - retstr->str_ptr);
X if (amperstab)
X str_sset(stab_val(amperstab),cmd->c_short);
X if (rightstab)
X str_nset(stab_val(rightstab),
X tmps + cmd->c_short->str_cur,
X retstr->str_cur - (tmps - retstr->str_ptr) -
X cmd->c_short->str_cur);
X }
X match = !(cmdflags & CF_FIRSTNEG);
X retstr = &str_yes;
X goto flipmaybe;
X }
X else
X hint = tmps;
X }
X else {
X if (cmdflags & CF_NESURE) {
X ++cmd->c_short->str_u.str_useful;
X match = cmdflags & CF_FIRSTNEG;
X retstr = &str_no;
X goto flipmaybe;
X }
X }
X if (--cmd->c_short->str_u.str_useful < 0) {
X str_free(cmd->c_short);
X cmd->c_short = Nullstr;
X cmdflags &= ~CF_OPTIMIZE;
X cmdflags |= CFT_EVAL; /* never try this optimization again */
X cmd->c_flags = cmdflags;
X }
X break; /* must evaluate */
X
X case CFT_NUMOP: /* numeric op optimization */
X retstr = STAB_STR(cmd->c_stab);
X newsp = -2;
X switch (cmd->c_slen) {
X case O_EQ:
X if (dowarn) {
X if ((!retstr->str_nok && !looks_like_number(retstr)))
X warn("Possible use of == on string value");
X }
X match = (str_gnum(retstr) == cmd->c_short->str_u.str_nval);
X break;
X case O_NE:
X match = (str_gnum(retstr) != cmd->c_short->str_u.str_nval);
X break;
X case O_LT:
X match = (str_gnum(retstr) < cmd->c_short->str_u.str_nval);
X break;
X case O_LE:
X match = (str_gnum(retstr) <= cmd->c_short->str_u.str_nval);
X break;
X case O_GT:
X match = (str_gnum(retstr) > cmd->c_short->str_u.str_nval);
X break;
X case O_GE:
X match = (str_gnum(retstr) >= cmd->c_short->str_u.str_nval);
X break;
X }
X if (match) {
X if (cmdflags & CF_EQSURE) {
X retstr = &str_yes;
X goto flipmaybe;
X }
X }
X else if (cmdflags & CF_NESURE) {
X retstr = &str_no;
X goto flipmaybe;
X }
X break; /* must evaluate */
X
X case CFT_INDGETS: /* while (<$foo>) */
X last_in_stab = stabent(str_get(STAB_STR(cmd->c_stab)),TRUE);
X if (!stab_io(last_in_stab))
X stab_io(last_in_stab) = stio_new();
X goto dogets;
X case CFT_GETS: /* really a while (<file>) */
X last_in_stab = cmd->c_stab;
X dogets:
X fp = stab_io(last_in_stab)->ifp;
X retstr = stab_val(defstab);
X newsp = -2;
X if (fp && str_gets(retstr, fp, 0)) {
X if (*retstr->str_ptr == '0' && retstr->str_cur == 1)
X match = FALSE;
X else
X match = TRUE;
X stab_io(last_in_stab)->lines++;
X }
X else if (stab_io(last_in_stab)->flags & IOF_ARGV)
X goto doeval; /* doesn't necessarily count as EOF yet */
X else {
X retstr = &str_undef;
X match = FALSE;
X }
X goto flipmaybe;
X case CFT_EVAL:
X break;
X case CFT_UNFLIP:
X while (tmps_max > tmps_base) /* clean up after last eval */
X str_free(tmps_list[tmps_max--]);
X newsp = eval(cmd->c_expr,gimme,sp);
X st = stack->ary_array; /* possible reallocated */
X retstr = st[newsp];
X match = str_true(retstr);
X if (cmd->c_expr->arg_type == O_FLIP) /* undid itself? */
X cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
X goto maybe;
X case CFT_CHOP:
X retstr = stab_val(cmd->c_stab);
X newsp = -2;
X match = (retstr->str_cur != 0);
X tmps = str_get(retstr);
X tmps += retstr->str_cur - match;
X str_nset(&str_chop,tmps,match);
X *tmps = '\0';
X retstr->str_nok = 0;
X retstr->str_cur = tmps - retstr->str_ptr;
X retstr = &str_chop;
X goto flipmaybe;
X case CFT_ARRAY:
X ar = stab_array(cmd->c_expr[1].arg_ptr.arg_stab);
X match = ar->ary_index; /* just to get register */
X
X if (match < 0) { /* first time through here? */
X aryoptsave = savestack->ary_fill;
X savesptr(&stab_val(cmd->c_stab));
X saveint(&ar->ary_index);
X }
X
X if (match >= ar->ary_fill) { /* we're in LAST, probably */
X retstr = &str_undef;
X ar->ary_index = -1; /* this is actually redundant */
X match = FALSE;
X }
X else {
X match++;
X retstr = stab_val(cmd->c_stab) = ar->ary_array[match];
X ar->ary_index = match;
X match = TRUE;
X }
X newsp = -2;
X goto maybe;
X }
X
X /* we have tried to make this normal case as abnormal as possible */
X
X doeval:
X if (gimme == G_ARRAY) {
X lastretstr = Nullstr;
X lastspbase = sp;
X lastsize = newsp - sp;
X }
X else
X lastretstr = retstr;
X while (tmps_max > tmps_base) /* clean up after last eval */
X str_free(tmps_list[tmps_max--]);
X newsp = eval(cmd->c_expr,gimme,sp);
X st = stack->ary_array; /* possible reallocated */
X retstr = st[newsp];
X if (newsp > sp)
X match = str_true(retstr);
X else
X match = FALSE;
X goto maybe;
X
X /* if flipflop was true, flop it */
X
X flipmaybe:
X if (match && cmdflags & CF_FLIP) {
X while (tmps_max > tmps_base) /* clean up after last eval */
X str_free(tmps_list[tmps_max--]);
X if (cmd->c_expr->arg_type == O_FLOP) { /* currently toggled? */
X newsp = eval(cmd->c_expr,G_SCALAR,sp);/*let eval undo it*/
X cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
X }
X else {
X newsp = eval(cmd->c_expr,G_SCALAR,sp);/* let eval do it */
X if (cmd->c_expr->arg_type == O_FLOP) /* still toggled? */
X cmdflags = copyopt(cmd,cmd->c_expr[4].arg_ptr.arg_cmd);
X }
X }
X else if (cmdflags & CF_FLIP) {
X if (cmd->c_expr->arg_type == O_FLOP) { /* currently toggled? */
X match = TRUE; /* force on */
X }
X }
X
X /* at this point, match says whether our expression was true */
X
X maybe:
X if (cmdflags & CF_INVERT)
X match = !match;
X if (!match)
X goto next_cmd;
X }
X#ifdef TAINT
X tainted = 0; /* modifier doesn't affect regular expression */
X#endif
X
X /* now to do the actual command, if any */
X
X switch (cmd->c_type) {
X case C_NULL:
X fatal("panic: cmd_exec");
X case C_EXPR: /* evaluated for side effects */
X if (cmd->ucmd.acmd.ac_expr) { /* more to do? */
X if (gimme == G_ARRAY) {
X lastretstr = Nullstr;
X lastspbase = sp;
X lastsize = newsp - sp;
X }
X else
X lastretstr = retstr;
X while (tmps_max > tmps_base) /* clean up after last eval */
X str_free(tmps_list[tmps_max--]);
X newsp = eval(cmd->ucmd.acmd.ac_expr,gimme,sp);
X st = stack->ary_array; /* possible reallocated */
X retstr = st[newsp];
X }
X break;
X case C_NSWITCH:
X match = (int)str_gnum(STAB_STR(cmd->c_stab));
X goto doswitch;
X case C_CSWITCH:
X match = *(str_get(STAB_STR(cmd->c_stab))) & 255;
X doswitch:
X match -= cmd->ucmd.scmd.sc_offset;
X if (match < 0)
X match = 0;
X else if (match > cmd->ucmd.scmd.sc_max)
X match = cmd->c_slen;
X cmd = cmd->ucmd.scmd.sc_next[match];
X goto tail_recursion_entry;
X case C_NEXT:
X cmd = cmd->ucmd.ccmd.cc_alt;
X goto tail_recursion_entry;
X case C_ELSIF:
X fatal("panic: ELSIF");
X case C_IF:
X oldspat = curspat;
X oldsave = savestack->ary_fill;
X#ifdef DEBUGGING
X olddlevel = dlevel;
X#endif
X retstr = &str_yes;
X newsp = -2;
X if (cmd->ucmd.ccmd.cc_true) {
X#ifdef DEBUGGING
X if (debug) {
X debname[dlevel] = 't';
X debdelim[dlevel++] = '_';
X }
X#endif
X newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
X st = stack->ary_array; /* possible reallocated */
X retstr = st[newsp];
X }
X curspat = oldspat;
X if (savestack->ary_fill > oldsave)
X restorelist(oldsave);
X#ifdef DEBUGGING
X dlevel = olddlevel;
X#endif
X cmd = cmd->ucmd.ccmd.cc_alt;
X goto tail_recursion_entry;
X case C_ELSE:
X oldspat = curspat;
X oldsave = savestack->ary_fill;
X#ifdef DEBUGGING
X olddlevel = dlevel;
X#endif
X retstr = &str_undef;
X newsp = -2;
X if (cmd->ucmd.ccmd.cc_true) {
X#ifdef DEBUGGING
X if (debug) {
X debname[dlevel] = 'e';
X debdelim[dlevel++] = '_';
X }
X#endif
X newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
X st = stack->ary_array; /* possible reallocated */
X retstr = st[newsp];
X }
X curspat = oldspat;
X if (savestack->ary_fill > oldsave)
X restorelist(oldsave);
X#ifdef DEBUGGING
X dlevel = olddlevel;
X#endif
X break;
X case C_BLOCK:
X case C_WHILE:
X if (!(cmdflags & CF_ONCE)) { /* first time through here? */
X cmdflags |= CF_ONCE;
X loop_ptr++;
X loop_stack[loop_ptr].loop_label = cmd->c_label;
X loop_stack[loop_ptr].loop_sp = sp;
X#ifdef DEBUGGING
X if (debug & 4) {
X deb("(Pushing label #%d %s)\n",
X loop_ptr, cmd->c_label ? cmd->c_label : "");
X }
X#endif
X }
X switch (setjmp(loop_stack[loop_ptr].loop_env)) {
X case O_LAST:
X /* retstr = lastretstr; */
X st = stack->ary_array; /* possible reallocated */
X if (lastretstr) {
X retstr = lastretstr;
X newsp = -2;
X }
X else {
X newsp = sp + lastsize;
X retstr = st[newsp];
X }
X curspat = oldspat;
X if (savestack->ary_fill > oldsave)
X restorelist(oldsave);
X goto next_cmd;
X case O_NEXT:
X goto next_iter;
X case O_REDO:
X#ifdef DEBUGGING
X dlevel = olddlevel;
X#endif
X goto doit;
X }
X oldspat = curspat;
X oldsave = savestack->ary_fill;
X#ifdef DEBUGGING
X olddlevel = dlevel;
X#endif
X doit:
X if (cmd->ucmd.ccmd.cc_true) {
X#ifdef DEBUGGING
X if (debug) {
X debname[dlevel] = 't';
X debdelim[dlevel++] = '_';
X }
X#endif
X newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
X st = stack->ary_array; /* possible reallocated */
X retstr = st[newsp];
X }
X /* actually, this spot is rarely reached anymore since the above
X * cmd_exec() returns through longjmp(). Hooray for structure.
X */
X next_iter:
X#ifdef DEBUGGING
X dlevel = olddlevel;
X#endif
X if (cmd->ucmd.ccmd.cc_alt) {
X#ifdef DEBUGGING
X if (debug) {
X debname[dlevel] = 'a';
X debdelim[dlevel++] = '_';
X }
X#endif
X newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme,sp);
X st = stack->ary_array; /* possible reallocated */
X retstr = st[newsp];
X }
X finish_while:
X curspat = oldspat;
X if (savestack->ary_fill > oldsave)
X restorelist(oldsave);
X#ifdef DEBUGGING
X dlevel = olddlevel - 1;
X#endif
X if (cmd->c_type != C_BLOCK)
X goto until_loop; /* go back and evaluate conditional again */
X }
X if (cmdflags & CF_LOOP) {
X cmdflags |= CF_COND; /* now test the condition */
X#ifdef DEBUGGING
X dlevel = entdlevel;
X#endif
X goto until_loop;
X }
X next_cmd:
X if (cmdflags & CF_ONCE) {
X#ifdef DEBUGGING
X if (debug & 4) {
X tmps = loop_stack[loop_ptr].loop_label;
X deb("(Popping label #%d %s)\n",loop_ptr, tmps ? tmps : "");
X }
X#endif
X loop_ptr--;
X if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY)
X restorelist(aryoptsave);
X }
X cmd = cmd->c_next;
X goto tail_recursion_entry;
X}
X
X#ifdef DEBUGGING
X# ifndef VARARGS
X/*VARARGS1*/
Xdeb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
Xchar *pat;
X{
X register int i;
X
X fprintf(stderr,"%-4ld",(long)line);
X for (i=0; i<dlevel; i++)
X fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
X fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8);
X}
X# else
X/*VARARGS1*/
Xdeb(va_alist)
Xva_dcl
X{
X va_list args;
X char *pat;
X register int i;
X
X va_start(args);
X fprintf(stderr,"%-4ld",(long)line);
X for (i=0; i<dlevel; i++)
X fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
X
X pat = va_arg(args, char *);
X (void) vfprintf(stderr,pat,args);
X va_end( args );
X}
X# endif
X#endif
X
Xcopyopt(cmd,which)
Xregister CMD *cmd;
Xregister CMD *which;
X{
X cmd->c_flags &= CF_ONCE|CF_COND|CF_LOOP;
X cmd->c_flags |= which->c_flags;
X cmd->c_short = which->c_short;
X cmd->c_slen = which->c_slen;
X cmd->c_stab = which->c_stab;
X return cmd->c_flags;
X}
X
XARRAY *
Xsaveary(stab)
XSTAB *stab;
X{
X register STR *str;
X
X str = str_new(0);
X str->str_state = SS_SARY;
X str->str_u.str_stab = stab;
X if (str->str_ptr) {
X Safefree(str->str_ptr);
X str->str_len = 0;
X }
X str->str_ptr = (char*)stab_array(stab);
X (void)apush(savestack,str); /* save array ptr */
X stab_xarray(stab) = Null(ARRAY*);
X return stab_xarray(aadd(stab));
X}
X
XHASH *
Xsavehash(stab)
XSTAB *stab;
X{
X register STR *str;
X
X str = str_new(0);
X str->str_state = SS_SHASH;
X str->str_u.str_stab = stab;
X if (str->str_ptr) {
X Safefree(str->str_ptr);
X str->str_len = 0;
X }
X str->str_ptr = (char*)stab_hash(stab);
X (void)apush(savestack,str); /* save hash ptr */
X stab_xhash(stab) = Null(HASH*);
X return stab_xhash(hadd(stab));
X}
X
Xvoid
Xsaveitem(item)
Xregister STR *item;
X{
X register STR *str;
X
X (void)apush(savestack,item); /* remember the pointer */
X str = str_new(0);
X str_sset(str,item);
X (void)apush(savestack,str); /* remember the value */
X}
X
Xvoid
Xsaveint(intp)
Xint *intp;
X{
X register STR *str;
X
X str = str_new(0);
X str->str_state = SS_SINT;
X str->str_u.str_useful = (long)*intp; /* remember value */
X if (str->str_ptr) {
X Safefree(str->str_ptr);
X str->str_len = 0;
X }
X str->str_ptr = (char*)intp; /* remember pointer */
X (void)apush(savestack,str);
X}
X
Xvoid
Xsavelong(longp)
Xlong *longp;
X{
X register STR *str;
X
X str = str_new(0);
X str->str_state = SS_SLONG;
X str->str_u.str_useful = *longp; /* remember value */
X if (str->str_ptr) {
X Safefree(str->str_ptr);
X str->str_len = 0;
X }
X str->str_ptr = (char*)longp; /* remember pointer */
X (void)apush(savestack,str);
X}
X
Xvoid
Xsavesptr(sptr)
XSTR **sptr;
X{
X register STR *str;
X
X str = str_new(0);
X str->str_state = SS_SSTRP;
X str->str_magic = *sptr; /* remember value */
X if (str->str_ptr) {
X Safefree(str->str_ptr);
X str->str_len = 0;
X }
X str->str_ptr = (char*)sptr; /* remember pointer */
X (void)apush(savestack,str);
X}
X
Xvoid
Xsavenostab(stab)
XSTAB *stab;
X{
X register STR *str;
X
X str = str_new(0);
X str->str_state = SS_SNSTAB;
X str->str_magic = (STR*)stab; /* remember which stab to free */
X (void)apush(savestack,str);
X}
X
Xvoid
Xsavehptr(hptr)
XHASH **hptr;
X{
X register STR *str;
X
X str = str_new(0);
X str->str_state = SS_SHPTR;
X str->str_u.str_hash = *hptr; /* remember value */
X if (str->str_ptr) {
X Safefree(str->str_ptr);
X str->str_len = 0;
X }
X str->str_ptr = (char*)hptr; /* remember pointer */
X (void)apush(savestack,str);
X}
X
Xvoid
Xsavelist(sarg,maxsarg)
Xregister STR **sarg;
Xint maxsarg;
X{
X register STR *str;
X register int i;
X
X for (i = 1; i <= maxsarg; i++) {
X (void)apush(savestack,sarg[i]); /* remember the pointer */
X str = str_new(0);
X str_sset(str,sarg[i]);
X (void)apush(savestack,str); /* remember the value */
X }
X}
X
Xvoid
Xrestorelist(base)
Xint base;
X{
X register STR *str;
X register STR *value;
X register STAB *stab;
X
X if (base < -1)
X fatal("panic: corrupt saved stack index");
X while (savestack->ary_fill > base) {
X value = apop(savestack);
X switch (value->str_state) {
X case SS_NORM: /* normal string */
X case SS_INCR:
X str = apop(savestack);
X str_replace(str,value);
X STABSET(str);
X break;
X case SS_SARY: /* array reference */
X stab = value->str_u.str_stab;
X afree(stab_xarray(stab));
X stab_xarray(stab) = (ARRAY*)value->str_ptr;
X value->str_ptr = Nullch;
X str_free(value);
X break;
X case SS_SHASH: /* hash reference */
X stab = value->str_u.str_stab;
X (void)hfree(stab_xhash(stab));
X stab_xhash(stab) = (HASH*)value->str_ptr;
X value->str_ptr = Nullch;
X str_free(value);
X break;
X case SS_SINT: /* int reference */
X *((int*)value->str_ptr) = (int)value->str_u.str_useful;
X value->str_ptr = Nullch;
X str_free(value);
X break;
X case SS_SLONG: /* long reference */
X *((long*)value->str_ptr) = value->str_u.str_useful;
X value->str_ptr = Nullch;
X str_free(value);
X break;
X case SS_SSTRP: /* STR* reference */
X *((STR**)value->str_ptr) = value->str_magic;
X value->str_magic = Nullstr;
X value->str_ptr = Nullch;
X str_free(value);
X break;
X case SS_SHPTR: /* HASH* reference */
X *((HASH**)value->str_ptr) = value->str_u.str_hash;
X value->str_ptr = Nullch;
X str_free(value);
X break;
X case SS_SNSTAB:
X stab = (STAB*)value->str_magic;
X value->str_magic = Nullstr;
X (void)stab_clear(stab);
X str_free(value);
X break;
X default:
X fatal("panic: restorelist inconsistency");
X }
X }
X}
!STUFFY!FUNK!
echo Extracting str.c
sed >str.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: str.c,v 2.0.1.5 88/11/22 01:18:37 lwall Locked $
X *
X * Copyright (c) 1989, Larry Wall
X *
X * You may distribute under the terms of the GNU General Public License
X * as specified in the README file that comes with the perl 3.0 kit.
X *
X * $Log: str.c,v $
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X
Xextern char **environ;
X
X#ifndef str_get
Xchar *
Xstr_get(str)
XSTR *str;
X{
X#ifdef TAINT
X tainted |= str->str_tainted;
X#endif
X return str->str_pok ? str->str_ptr : str_2ptr(str);
X}
X#endif
X
Xchar *
Xstr_grow(str,newlen)
Xregister STR *str;
Xregister int newlen;
X{
X register char *s = str->str_ptr;
X
X if (str->str_state == SS_INCR) { /* data before str_ptr? */
X str->str_len += str->str_u.str_useful;
X str->str_ptr -= str->str_u.str_useful;
X str->str_u.str_useful = 0L;
X bcopy(s, str->str_ptr, str->str_cur+1);
X s = str->str_ptr;
X str->str_state = SS_NORM; /* normal again */
X if (newlen > str->str_len)
X newlen += 10 * (newlen - str->str_cur); /* avoid copy each time */
X }
X if (newlen > str->str_len) { /* need more room? */
X if (str->str_len)
X Renew(s,newlen,char);
X else
X New(703,s,newlen,char);
X str->str_ptr = s;
X str->str_len = newlen;
X }
X return s;
X}
X
Xstr_numset(str,num)
Xregister STR *str;
Xdouble num;
X{
X str->str_u.str_nval = num;
X str->str_state = SS_NORM;
X str->str_pok = 0; /* invalidate pointer */
X str->str_nok = 1; /* validate number */
X#ifdef TAINT
X str->str_tainted = tainted;
X#endif
X}
X
Xextern int errno;
X
Xchar *
Xstr_2ptr(str)
Xregister STR *str;
X{
X register char *s;
X int olderrno;
X
X if (!str)
X return "";
X if (str->str_nok) {
X STR_GROW(str, 24);
X s = str->str_ptr;
X olderrno = errno; /* some Xenix systems wipe out errno here */
X#if defined(scs) && defined(ns32000)
X gcvt(str->str_u.str_nval,20,s);
X#else
X#ifdef apollo
X if (str->str_u.str_nval == 0.0)
X (void)strcpy(s,"0");
X else
X#endif /*apollo*/
X (void)sprintf(s,"%.20g",str->str_u.str_nval);
X#endif /*scs*/
X errno = olderrno;
X while (*s) s++;
X }
X else {
X if (str == &str_undef)
X return No;
X if (dowarn)
X warn("Use of uninitialized variable");
X STR_GROW(str, 24);
X s = str->str_ptr;
X }
X *s = '\0';
X str->str_cur = s - str->str_ptr;
X str->str_pok = 1;
X#ifdef DEBUGGING
X if (debug & 32)
X fprintf(stderr,"0x%lx ptr(%s)\n",str,str->str_ptr);
X#endif
X return str->str_ptr;
X}
X
Xdouble
Xstr_2num(str)
Xregister STR *str;
X{
X if (!str)
X return 0.0;
X str->str_state = SS_NORM;
X if (str->str_len && str->str_pok)
X str->str_u.str_nval = atof(str->str_ptr);
X else {
X if (str == &str_undef)
X return 0.0;
X if (dowarn)
X warn("Use of uninitialized variable");
X str->str_u.str_nval = 0.0;
X }
X str->str_nok = 1;
X#ifdef DEBUGGING
X if (debug & 32)
X fprintf(stderr,"0x%lx num(%g)\n",str,str->str_u.str_nval);
X#endif
X return str->str_u.str_nval;
X}
X
Xstr_sset(dstr,sstr)
XSTR *dstr;
Xregister STR *sstr;
X{
X#ifdef TAINT
X tainted |= sstr->str_tainted;
X#endif
X if (!sstr)
X dstr->str_pok = dstr->str_nok = 0;
X else if (sstr->str_pok) {
X str_nset(dstr,sstr->str_ptr,sstr->str_cur);
X if (sstr->str_nok) {
X dstr->str_u.str_nval = sstr->str_u.str_nval;
X dstr->str_nok = 1;
X dstr->str_state = SS_NORM;
X }
X }
X else if (sstr->str_nok)
X str_numset(dstr,sstr->str_u.str_nval);
X else
X dstr->str_pok = dstr->str_nok = 0;
X}
X
Xstr_nset(str,ptr,len)
Xregister STR *str;
Xregister char *ptr;
Xregister int len;
X{
X STR_GROW(str, len + 1);
X (void)bcopy(ptr,str->str_ptr,len);
X str->str_cur = len;
X *(str->str_ptr+str->str_cur) = '\0';
X str->str_nok = 0; /* invalidate number */
X str->str_pok = 1; /* validate pointer */
X#ifdef TAINT
X str->str_tainted = tainted;
X#endif
X}
X
Xstr_set(str,ptr)
Xregister STR *str;
Xregister char *ptr;
X{
X register int len;
X
X if (!ptr)
X ptr = "";
X len = strlen(ptr);
X STR_GROW(str, len + 1);
X (void)bcopy(ptr,str->str_ptr,len+1);
X str->str_cur = len;
X str->str_nok = 0; /* invalidate number */
X str->str_pok = 1; /* validate pointer */
X#ifdef TAINT
X str->str_tainted = tainted;
X#endif
X}
X
Xstr_chop(str,ptr) /* like set but assuming ptr is in str */
Xregister STR *str;
Xregister char *ptr;
X{
X register int delta;
X
X if (!(str->str_pok))
X fatal("str_chop: internal inconsistency");
X delta = ptr - str->str_ptr;
X str->str_len -= delta;
X str->str_cur -= delta;
X str->str_ptr += delta;
X if (str->str_state == SS_INCR)
X str->str_u.str_useful += delta;
X else {
X str->str_u.str_useful = delta;
X str->str_state = SS_INCR;
X }
X str->str_nok = 0; /* invalidate number */
X str->str_pok = 1; /* validate pointer (and unstudy str) */
X}
X
Xstr_ncat(str,ptr,len)
Xregister STR *str;
Xregister char *ptr;
Xregister int len;
X{
X if (!(str->str_pok))
X (void)str_2ptr(str);
X STR_GROW(str, str->str_cur + len + 1);
X (void)bcopy(ptr,str->str_ptr+str->str_cur,len);
X str->str_cur += len;
X *(str->str_ptr+str->str_cur) = '\0';
X str->str_nok = 0; /* invalidate number */
X str->str_pok = 1; /* validate pointer */
X#ifdef TAINT
X str->str_tainted |= tainted;
X#endif
X}
X
Xstr_scat(dstr,sstr)
XSTR *dstr;
Xregister STR *sstr;
X{
X#ifdef TAINT
X tainted |= sstr->str_tainted;
X#endif
X if (!sstr)
X return;
X if (!(sstr->str_pok))
X (void)str_2ptr(sstr);
X if (sstr)
X str_ncat(dstr,sstr->str_ptr,sstr->str_cur);
X}
X
Xstr_cat(str,ptr)
Xregister STR *str;
Xregister char *ptr;
X{
X register int len;
X
X if (!ptr)
X return;
X if (!(str->str_pok))
X (void)str_2ptr(str);
X len = strlen(ptr);
X STR_GROW(str, str->str_cur + len + 1);
X (void)bcopy(ptr,str->str_ptr+str->str_cur,len+1);
X str->str_cur += len;
X str->str_nok = 0; /* invalidate number */
X str->str_pok = 1; /* validate pointer */
X#ifdef TAINT
X str->str_tainted |= tainted;
X#endif
X}
X
Xchar *
Xstr_append_till(str,from,fromend,delim,keeplist)
Xregister STR *str;
Xregister char *from;
Xregister char *fromend;
Xregister int delim;
Xchar *keeplist;
X{
X register char *to;
X register int len;
X
X if (!from)
X return Nullch;
X len = fromend - from;
X STR_GROW(str, str->str_cur + len + 1);
X str->str_nok = 0; /* invalidate number */
X str->str_pok = 1; /* validate pointer */
X to = str->str_ptr+str->str_cur;
X for (; from < fromend; from++,to++) {
X if (*from == '\\' && from+1 < fromend && delim != '\\') {
X if (!keeplist) {
X if (from[1] == delim || from[1] == '\\')
X from++;
X else
X *to++ = *from++;
X }
X else if (index(keeplist,from[1]))
X *to++ = *from++;
X else
X from++;
X }
X else if (*from == delim)
X break;
X *to = *from;
X }
X *to = '\0';
X str->str_cur = to - str->str_ptr;
X return from;
X}
X
XSTR *
Xstr_new(len)
Xint len;
X{
X register STR *str;
X
X if (freestrroot) {
X str = freestrroot;
X freestrroot = str->str_magic;
X str->str_magic = Nullstr;
X str->str_state = SS_NORM;
X }
X else {
X Newz(701,str,1,STR);
X }
X if (len)
X STR_GROW(str, len + 1);
X return str;
X}
X
Xvoid
Xstr_magic(str, stab, how, name, namlen)
Xregister STR *str;
XSTAB *stab;
Xint how;
Xchar *name;
Xint namlen;
X{
X if (str->str_magic)
X return;
X str->str_magic = str_new(namlen);
X str = str->str_magic;
X str->str_u.str_stab = stab;
X str->str_rare = how;
X if (name)
X str_nset(str,name,namlen);
X}
X
Xvoid
Xstr_insert(bigstr,offset,len,little,littlelen)
XSTR *bigstr;
Xint offset;
Xint len;
Xchar *little;
Xint littlelen;
X{
X register char *big;
X register char *mid;
X register char *midend;
X register char *bigend;
X register int i;
X
X i = littlelen - len;
X if (i > 0) { /* string might grow */
X STR_GROW(bigstr, bigstr->str_cur + i + 1);
X big = bigstr->str_ptr;
X mid = big + offset + len;
X midend = bigend = big + bigstr->str_cur;
X bigend += i;
X *bigend = '\0';
X while (midend > mid) /* shove everything down */
X *--bigend = *--midend;
X (void)bcopy(little,big+offset,littlelen);
X bigstr->str_cur += i;
X return;
X }
X else if (i == 0) {
X (void)bcopy(little,bigstr->str_ptr+offset,len);
X return;
X }
X
X big = bigstr->str_ptr;
X mid = big + offset;
X midend = mid + len;
X bigend = big + bigstr->str_cur;
X
X if (midend > bigend)
X fatal("panic: str_insert");
X
X bigstr->str_pok = SP_VALID; /* disable possible screamer */
X
X if (mid - big > bigend - midend) { /* faster to shorten from end */
X if (littlelen) {
X (void)bcopy(little, mid, littlelen);
X mid += littlelen;
X }
X i = bigend - midend;
X if (i > 0) {
X (void)bcopy(midend, mid, i);
X mid += i;
X }
X *mid = '\0';
X bigstr->str_cur = mid - big;
X }
X else if (i = mid - big) { /* faster from front */
X midend -= littlelen;
X mid = midend;
X str_chop(bigstr,midend-i);
X big += i;
X while (i--)
X *--midend = *--big;
X if (littlelen)
X (void)bcopy(little, mid, littlelen);
X }
X else if (littlelen) {
X midend -= littlelen;
X str_chop(bigstr,midend);
X (void)bcopy(little,midend,littlelen);
X }
X else {
X str_chop(bigstr,midend);
X }
X STABSET(bigstr);
X}
X
X/* make str point to what nstr did */
X
Xvoid
Xstr_replace(str,nstr)
Xregister STR *str;
Xregister STR *nstr;
X{
X if (str->str_state == SS_INCR)
X str_grow(str,0); /* just force copy down */
X if (nstr->str_state == SS_INCR)
X str_grow(nstr,0);
X if (str->str_ptr)
X Safefree(str->str_ptr);
X str->str_ptr = nstr->str_ptr;
X str->str_len = nstr->str_len;
X str->str_cur = nstr->str_cur;
X str->str_pok = nstr->str_pok;
X str->str_nok = nstr->str_nok;
X#ifdef STRUCTCOPY
X str->str_u = nstr->str_u;
X#else
X str->str_u.str_nval = nstr->str_u.str_nval;
X#endif
X#ifdef TAINT
X str->str_tainted = nstr->str_tainted;
X#endif
X Safefree(nstr);
X}
X
Xvoid
Xstr_free(str)
Xregister STR *str;
X{
X if (!str)
X return;
X if (str->str_state) {
X if (str->str_state == SS_FREE) /* already freed */
X return;
X if (str->str_state == SS_INCR && !(str->str_pok & 2)) {
X str->str_ptr -= str->str_u.str_useful;
X str->str_len += str->str_u.str_useful;
X }
X }
X if (str->str_magic)
X str_free(str->str_magic);
X if (str->str_len) {
X if (str->str_len > 127) { /* next user not likely to want more */
X Safefree(str->str_ptr); /* so give it back to malloc */
X str->str_ptr = Nullch;
X str->str_len = 0;
X }
X else
X str->str_ptr[0] = '\0';
X }
X if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
X arg_free(str->str_u.str_args);
X str->str_cur = 0;
X str->str_nok = 0;
X str->str_pok = 0;
X str->str_state = SS_FREE;
X#ifdef TAINT
X str->str_tainted = 0;
X#endif
X str->str_magic = freestrroot;
X freestrroot = str;
X}
X
Xstr_len(str)
Xregister STR *str;
X{
X if (!str)
X return 0;
X if (!(str->str_pok))
X (void)str_2ptr(str);
X if (str->str_ptr)
X return str->str_cur;
X else
X return 0;
X}
X
Xstr_eq(str1,str2)
Xregister STR *str1;
Xregister STR *str2;
X{
X if (!str1)
X return str2 == Nullstr;
X if (!str2)
X return 0;
X
X if (!str1->str_pok)
X (void)str_2ptr(str1);
X if (!str2->str_pok)
X (void)str_2ptr(str2);
X
X if (str1->str_cur != str2->str_cur)
X return 0;
X
X return !bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur);
X}
X
Xstr_cmp(str1,str2)
Xregister STR *str1;
Xregister STR *str2;
X{
X int retval;
X
X if (!str1)
X return str2 == Nullstr;
X if (!str2)
X return 0;
X
X if (!str1->str_pok)
X (void)str_2ptr(str1);
X if (!str2->str_pok)
X (void)str_2ptr(str2);
X
X if (str1->str_cur < str2->str_cur) {
X if (retval = bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
X return retval;
X else
X return 1;
X }
X else if (retval = bcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
X return retval;
X else if (str1->str_cur == str2->str_cur)
X return 0;
X else
X return -1;
X}
X
Xchar *
Xstr_gets(str,fp,append)
Xregister STR *str;
Xregister FILE *fp;
Xint append;
X{
X#ifdef STDSTDIO /* Here is some breathtakingly efficient cheating */
X
X register char *bp; /* we're going to steal some values */
X register int cnt; /* from the stdio struct and put EVERYTHING */
X register STDCHAR *ptr; /* in the innermost loop into registers */
X register char newline = record_separator;/* (assuming >= 6 registers) */
X int i;
X int bpx;
X int obpx;
X register int get_paragraph;
X register char *oldbp;
X
X if (get_paragraph = !rslen) { /* yes, that's an assignment */
X newline = '\n';
X oldbp = Nullch; /* remember last \n position (none) */
X }
X cnt = fp->_cnt; /* get count into register */
X str->str_nok = 0; /* invalidate number */
X str->str_pok = 1; /* validate pointer */
X if (str->str_len <= cnt + 1) /* make sure we have the room */
X STR_GROW(str, append+cnt+2); /* (remembering cnt can be -1) */
X bp = str->str_ptr + append; /* move these two too to registers */
X ptr = fp->_ptr;
X for (;;) {
X screamer:
X while (--cnt >= 0) { /* this */ /* eat */
X if ((*bp++ = *ptr++) == newline) /* really */ /* dust */
X goto thats_all_folks; /* screams */ /* sed :-) */
X }
X
X fp->_cnt = cnt; /* deregisterize cnt and ptr */
X fp->_ptr = ptr;
X i = _filbuf(fp); /* get more characters */
X cnt = fp->_cnt;
X ptr = fp->_ptr; /* reregisterize cnt and ptr */
X
X bpx = bp - str->str_ptr; /* prepare for possible relocation */
X if (get_paragraph && oldbp)
X obpx = oldbp - str->str_ptr;
X STR_GROW(str, bpx + cnt + 2);
X bp = str->str_ptr + bpx; /* reconstitute our pointer */
X if (get_paragraph && oldbp)
X oldbp = str->str_ptr + obpx;
X
X if (i == newline) { /* all done for now? */
X *bp++ = i;
X goto thats_all_folks;
X }
X else if (i == EOF) /* all done for ever? */
X goto thats_really_all_folks;
X *bp++ = i; /* now go back to screaming loop */
X }
X
Xthats_all_folks:
X if (get_paragraph && bp - 1 != oldbp) {
X oldbp = bp; /* remember where this newline was */
X goto screamer; /* and go back to the fray */
X }
Xthats_really_all_folks:
X fp->_cnt = cnt; /* put these back or we're in trouble */
X fp->_ptr = ptr;
X *bp = '\0';
X str->str_cur = bp - str->str_ptr; /* set length */
X
X#else /* !STDSTDIO */ /* The big, slow, and stupid way */
X
X static char buf[4192];
X
X if (fgets(buf, sizeof buf, fp) != Nullch)
X str_set(str, buf);
X else
X str_set(str, No);
X
X#endif /* STDSTDIO */
X
X return str->str_cur - append ? str->str_ptr : Nullch;
X}
X
XARG *
Xparselist(str)
XSTR *str;
X{
X register CMD *cmd;
X register ARG *arg;
X line_t oldline = line;
X int retval;
X
X str_sset(linestr,str);
X in_eval++;
X oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
X bufend = bufptr + linestr->str_cur;
X if (setjmp(eval_env)) {
X in_eval = 0;
X fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr);
X }
X error_count = 0;
X retval = yyparse();
X in_eval--;
X if (retval || error_count)
X fatal("Invalid component in string or format");
X cmd = eval_root;
X arg = cmd->c_expr;
X if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST)
X fatal("panic: error in parselist %d %x %d", cmd->c_type,
X cmd->c_next, arg ? arg->arg_type : -1);
X line = oldline;
X Safefree(cmd);
X return arg;
X}
X
Xvoid
Xintrpcompile(src)
XSTR *src;
X{
X register char *s = str_get(src);
X register char *send = s + src->str_cur;
X register STR *str;
X register char *t;
X STR *toparse;
X int len;
X register int brackets;
X STAB *stab;
X
X toparse = str_new(0);
X str = str_new(0);
X
X str_nset(str,"",0);
X str_nset(toparse,"",0);
X t = s;
X while (s < send) {
X if (*s == '\\' && index("$@[{\\",s[1])) {
X str_ncat(str, t, s - t);
X str_ncat(str, "$b", 2);
X str_ncat(str, ++s, 1);
X ++s;
X t = s;
X }
X else if ((*s == '@' || (*s == '$' && !index(nointrp,s[1]))) &&
X s+1 < send) {
X str_ncat(str,t,s-t);
X t = s;
X if (*s == '$' && s[1] == '#' && isalpha(s[2]) || s[2] == '_')
X s++;
X s = scanreg(s,send,tokenbuf);
X if (*t == '@' &&
X (!(stab = stabent(tokenbuf,FALSE)) || !stab_xarray(stab)) ) {
X str_ncat(str,"@",1);
X s = ++t;
X continue; /* grandfather @ from old scripts */
X }
X str_ncat(str,"$a",2);
X str_ncat(toparse,",",1);
X if (*s == '[' || *s == '{' /* } */ ) {
X brackets = 0;
X do {
X switch (*s) {
X case '[': case '{':
X brackets++;
X break;
X case ']': case '}':
X brackets--;
X break;
X case '\'':
X case '"':
X if (s[-1] != '$') {
X s = cpytill(tokenbuf,s+1,send,*s,&len);
X if (s >= send)
X fatal("Unterminated string");
X }
X break;
X }
X s++;
X } while (brackets > 0 && s < send);
X if (s > send)
X fatal("Unmatched brackets in string");
X }
X if (*t == '@')
X str_ncat(toparse, "join($\",", 8);
X str_ncat(toparse, t, s - t);
X if (*t == '@')
X str_ncat(toparse, ")", 1);
X t = s;
X }
X else
X s++;
X }
X str_ncat(str,t,s-t);
X if (toparse->str_ptr && *toparse->str_ptr == ',') {
X *toparse->str_ptr = '(';
X str_ncat(toparse,",$$);",5);
X str->str_u.str_args = parselist(toparse);
X str->str_u.str_args->arg_len--; /* ignore $$ reference */
X }
X else
X str->str_u.str_args = Nullarg;
X str_free(toparse);
X str->str_pok |= SP_INTRP;
X str->str_nok = 0;
X str_replace(src,str);
X}
X
XSTR *
Xinterp(str,src,sp)
Xregister STR *str;
XSTR *src;
Xint sp;
X{
X register char *s;
X register char *t;
X register char *send;
X register STR **elem;
X
X if (!(src->str_pok & SP_INTRP)) {
X int oldsave = savestack->ary_fill;
X
X (void)savehptr(&curstash);
X curstash = src->str_u.str_hash; /* so stabent knows right package */
X intrpcompile(src);
X restorelist(oldsave);
X }
X s = src->str_ptr; /* assumed valid since str_pok set */
X t = s;
X send = s + src->str_cur;
X
X if (src->str_u.str_args) {
X (void)eval(src->str_u.str_args,G_ARRAY,sp);
X /* Assuming we have correct # of args */
X elem = stack->ary_array + sp;
X }
X
X str_nset(str,"",0);
X while (s < send) {
X if (*s == '$' && s+1 < send) {
X str_ncat(str,t,s-t);
X switch(*++s) {
X case 'a':
X str_scat(str,*++elem);
X break;
X case 'b':
X str_ncat(str,++s,1);
X break;
X }
X t = ++s;
X }
X else
X s++;
X }
X str_ncat(str,t,s-t);
X return str;
X}
X
Xvoid
Xstr_inc(str)
Xregister STR *str;
X{
X register char *d;
X
X if (!str)
X return;
X if (str->str_nok) {
X str->str_u.str_nval += 1.0;
X str->str_pok = 0;
X return;
X }
X if (!str->str_pok || !*str->str_ptr) {
X str->str_u.str_nval = 1.0;
X str->str_nok = 1;
X str->str_pok = 0;
X return;
X }
X d = str->str_ptr;
X while (isalpha(*d)) d++;
X while (isdigit(*d)) d++;
X if (*d) {
X str_numset(str,atof(str->str_ptr) + 1.0); /* punt */
X return;
X }
X d--;
X while (d >= str->str_ptr) {
X if (isdigit(*d)) {
X if (++*d <= '9')
X return;
X *(d--) = '0';
X }
X else {
X ++*d;
X if (isalpha(*d))
X return;
X *(d--) -= 'z' - 'a' + 1;
X }
X }
X /* oh,oh, the number grew */
X STR_GROW(str, str->str_cur + 2);
X str->str_cur++;
X for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--)
X *d = d[-1];
X if (isdigit(d[1]))
X *d = '1';
X else
X *d = d[1];
X}
X
Xvoid
Xstr_dec(str)
Xregister STR *str;
X{
X if (!str)
X return;
X if (str->str_nok) {
X str->str_u.str_nval -= 1.0;
X str->str_pok = 0;
X return;
X }
X if (!str->str_pok) {
X str->str_u.str_nval = -1.0;
X str->str_nok = 1;
X return;
X }
X str_numset(str,atof(str->str_ptr) - 1.0);
X}
X
X/* Make a string that will exist for the duration of the expression
X * evaluation. Actually, it may have to last longer than that, but
X * hopefully cmd_exec won't free it until it has been assigned to a
X * permanent location. */
X
XSTR *
Xstr_static(oldstr)
XSTR *oldstr;
X{
X register STR *str = str_new(0);
X static long tmps_size = -1;
X
X str_sset(str,oldstr);
X if (++tmps_max > tmps_size) {
X tmps_size = tmps_max;
X if (!(tmps_size & 127)) {
X if (tmps_size)
X Renew(tmps_list, tmps_size + 128, STR*);
X else
X New(702,tmps_list, 128, STR*);
X }
X }
X tmps_list[tmps_max] = str;
X return str;
X}
X
XSTR *
Xstr_make(s,len)
Xchar *s;
Xint len;
X{
X register STR *str = str_new(0);
X
X if (!len)
X len = strlen(s);
X str_nset(str,s,len);
X return str;
X}
X
XSTR *
Xstr_nmake(n)
Xdouble n;
X{
X register STR *str = str_new(0);
X
X str_numset(str,n);
X return str;
X}
X
X/* make an exact duplicate of old */
X
XSTR *
Xstr_smake(old)
Xregister STR *old;
X{
X register STR *new = str_new(0);
X
X if (!old)
X return Nullstr;
X if (old->str_state == SS_FREE) {
X warn("semi-panic: attempt to dup freed string");
X return Nullstr;
X }
X if (old->str_state == SS_INCR && !(old->str_pok & 2))
X str_grow(old,0);
X if (new->str_ptr)
X Safefree(new->str_ptr);
X Copy(old,new,1,STR);
X if (old->str_ptr)
X new->str_ptr = nsavestr(old->str_ptr,old->str_len);
X return new;
X}
X
Xstr_reset(s,stash)
Xregister char *s;
XHASH *stash;
X{
X register HENT *entry;
X register STAB *stab;
X register STR *str;
X register int i;
X register SPAT *spat;
X register int max;
X
X if (!*s) { /* reset ?? searches */
X for (spat = stash->tbl_spatroot;
X spat != Nullspat;
X spat = spat->spat_next) {
X spat->spat_flags &= ~SPAT_USED;
X }
X return;
X }
X
X /* reset variables */
X
X while (*s) {
X i = *s;
X if (s[1] == '-') {
X s += 2;
X }
X max = *s++;
X for ( ; i <= max; i++) {
X for (entry = stash->tbl_array[i];
X entry;
X entry = entry->hent_next) {
X stab = (STAB*)entry->hent_val;
X str = stab_val(stab);
X str->str_cur = 0;
X str->str_nok = 0;
X#ifdef TAINT
X str->str_tainted = tainted;
X#endif
X if (str->str_ptr != Nullch)
X str->str_ptr[0] = '\0';
X if (stab_xarray(stab)) {
X aclear(stab_xarray(stab));
X }
X if (stab_xhash(stab)) {
X hclear(stab_xhash(stab));
X if (stab == envstab)
X environ[0] = Nullch;
X }
X }
X }
X }
X}
X
X#ifdef TAINT
Xtaintproper(s)
Xchar *s;
X{
X#ifdef DEBUGGING
X if (debug & 2048)
X fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid);
X#endif
X if (tainted && (!euid || euid != uid)) {
X if (!unsafe)
X fatal("%s", s);
X else if (dowarn)
X warn("%s", s);
X }
X}
X
Xtaintenv()
X{
X register STR *envstr;
X
X envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE);
X if (!envstr || envstr->str_tainted) {
X tainted = 1;
X taintproper("Insecure PATH");
X }
X envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE);
X if (envstr && envstr->str_tainted) {
X tainted = 1;
X taintproper("Insecure IFS");
X }
X}
X#endif /* TAINT */
!STUFFY!FUNK!
echo Extracting t/op.sleep
sed >t/op.sleep <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.sleep,v 2.0 88/06/05 00:14:35 root Exp $
X
Xprint "1..1\n";
X
X$x = sleep 2;
Xif ($x == 2) {print "ok 1\n";} else {print "not ok 1\n";}
!STUFFY!FUNK!
echo ""
echo "End of kit 14 (of 23)"
cat /dev/null >kit14isdone
run=''
config=''
for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23; do
if test -f kit${iskit}isdone; then
run="$run $iskit"
else
todo="$todo $iskit"
fi
done
case $todo in
'')
echo "You have run all your kits. Please read README and then type Configure."
chmod 755 Configure
;;
*) echo "You have run$run."
echo "You still need to run$todo."
;;
esac
: Someone might mail this, so...
exit
More information about the Alt.sources
mailing list