Subject: v20i098: Perl, a language with features of C/sed/awk/shell/etc, Part15/24 Newsgroups: comp.sources.unix Sender: sources Approved: rsalz@uunet.UU.NET Submitted-by: Larry Wall Posting-number: Volume 20, Issue 98 Archive-name: perl3.0/part15 #! /bin/sh # Make a new directory for the perl sources, cd to it, and run kits 1 # thru 24 through sh. When all 24 kits have been run, read README. echo "This is perl 3.0 kit 15 (of 24). If kit 15 is complete, the line" echo '"'"End of kit 15 (of 24)"'" will echo at the end.' echo "" export PATH || (echo "You didn't use sh, you clunch." ; kill $$) mkdir t x2p 2>/dev/null echo Extracting cmd.c sed >cmd.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: cmd.c,v 3.0 89/10/18 15:09:02 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 * Revision 3.0 89/10/18 15:09:02 lwall X * 3.0 baseline X * X */ X X#include "EXTERN.h" X#include "perl.h" X X#ifdef I_VARARGS X# include X#endif X Xstatic STR str_chop; X Xvoid grow_dlevel(); 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 if (++dlevel >= dlmax) X grow_dlevel(); X } X#endif X newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp); X st = stack->ary_array; /* possibly 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 if (++dlevel >= dlmax) X grow_dlevel(); X } X#endif X newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp); X st = stack->ary_array; /* possibly 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 if (++loop_ptr >= loop_max) { X loop_max += 128; X Renew(loop_stack, loop_max, struct loop); X } 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; /* possibly 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 if (++dlevel >= dlmax) X grow_dlevel(); X } X#endif X newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp); X st = stack->ary_array; /* possibly 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 if (++dlevel >= dlmax) X grow_dlevel(); X } X#endif X newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme,sp); X st = stack->ary_array; /* possibly 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 if (++dlevel >= dlmax) X grow_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 () */ 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 && (cmdflags & CF_TERM),sp); X st = stack->ary_array; /* possibly 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 && (cmdflags & CF_TERM),sp); X st = stack->ary_array; /* possibly 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 && (cmdflags&CF_TERM),sp); X st = stack->ary_array; /* possibly 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 if (++dlevel >= dlmax) X grow_dlevel(); X } X#endif X newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp); X st = stack->ary_array; /* possibly 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 if (++dlevel >= dlmax) X grow_dlevel(); X } X#endif X newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp); X st = stack->ary_array; /* possibly 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 if (++loop_ptr >= loop_max) { X loop_max += 128; X Renew(loop_stack, loop_max, struct loop); X } 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; /* possibly 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 if (++dlevel >= dlmax) X grow_dlevel(); X } X#endif X newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp); X st = stack->ary_array; /* possibly 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 if (++dlevel >= dlmax) X grow_dlevel(); X } X#endif X newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme,sp); X st = stack->ary_array; /* possibly 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; ic_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(10,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(11,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(12,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(13,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(14,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(15,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(16,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(17,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(18,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} X Xvoid Xgrow_dlevel() X{ X dlmax += 128; X Renew(debname, dlmax, char); X Renew(debdelim, dlmax, char); X} !STUFFY!FUNK! echo Extracting config.H sed >config.H <<'!STUFFY!FUNK!' -e 's/X//' X/* config.h X * This file was produced by running the config.h.SH script, which X * gets its values from config.sh, which is generally produced by X * running Configure. X * X * Feel free to modify any of this as the need arises. Note, however, X * that running config.h.SH again will wipe out any changes you've made. X * For a more permanent change edit config.sh and rerun config.h.SH. X */ X X X/* EUNICE: X * This symbol, if defined, indicates that the program is being compiled X * under the EUNICE package under VMS. The program will need to handle X * things like files that don't go away the first time you unlink them, X * due to version numbering. It will also need to compensate for lack X * of a respectable link() command. X */ X/* VMS: X * This symbol, if defined, indicates that the program is running under X * VMS. It is currently only set in conjunction with the EUNICE symbol. X */ X/*#undef EUNICE /**/ X/*#undef VMS /**/ X X/* BIN: X * This symbol holds the name of the directory in which the user wants X * to put publicly executable images for the package in question. It X * is most often a local directory such as /usr/local/bin. X */ X#define BIN "/usr/local/bin" /**/ X X/* BYTEORDER: X * This symbol contains an encoding of the order of bytes in a long. X * Usual values (in octal) are 01234, 04321, 02143, 03412... X */ X#define BYTEORDER 01234 /**/ X X/* CPPSTDIN: X * This symbol contains the first part of the string which will invoke X * the C preprocessor on the standard input and produce to standard X * output. Typical value of "cc -E" or "/lib/cpp". X */ X/* CPPMINUS: X * This symbol contains the second part of the string which will invoke X * the C preprocessor on the standard input and produce to standard X * output. This symbol will have the value "-" if CPPSTDIN needs a minus X * to specify standard input, otherwise the value is "". X */ X#define CPPSTDIN "/lib/cpp" X#define CPPMINUS "" X X/* BCMP: X * This symbol, if defined, indicates that the bcmp routine is available X * to compare blocks of memory. If undefined, use memcmp. If that's X * not available, roll your own. X */ X#define BCMP /**/ X X/* BCOPY: X * This symbol, if defined, indicates that the bcopy routine is available X * to copy blocks of memory. Otherwise you should probably use memcpy(). X */ X#define BCOPY /**/ X X/* CHARSPRINTF: X * This symbol is defined if this system declares "char *sprintf()" in X * stdio.h. The trend seems to be to declare it as "int sprintf()". It X * is up to the package author to declare sprintf correctly based on the X * symbol. X */ X#define CHARSPRINTF /**/ X X/* CRYPT: X * This symbol, if defined, indicates that the crypt routine is available X * to encrypt passwords and the like. X */ X#define CRYPT /**/ X X/* DOSUID: X * This symbol, if defined, indicates that the C program should X * check the script that it is executing for setuid/setgid bits, and X * attempt to emulate setuid/setgid on systems that have disabled X * setuid #! scripts because the kernel can't do it securely. X * It is up to the package designer to make sure that this emulation X * is done securely. Among other things, it should do an fstat on X * the script it just opened to make sure it really is a setuid/setgid X * script, it should make sure the arguments passed correspond exactly X * to the argument on the #! line, and it should not trust any X * subprocesses to which it must pass the filename rather than the X * file descriptor of the script to be executed. X */ X#define DOSUID /**/ X X/* DUP2: X * This symbol, if defined, indicates that the dup2 routine is available X * to dup file descriptors. Otherwise you should use dup(). X */ X#define DUP2 /**/ X X/* FCHMOD: X * This symbol, if defined, indicates that the fchmod routine is available X * to change mode of opened files. If unavailable, use chmod(). X */ X#define FCHMOD /**/ X X/* FCHOWN: X * This symbol, if defined, indicates that the fchown routine is available X * to change ownership of opened files. If unavailable, use chown(). X */ X#define FCHOWN /**/ X X/* FCNTL: X * This symbol, if defined, indicates to the C program that it should X * include fcntl.h. X */ X#define FCNTL /**/ X X/* FLOCK: X * This symbol, if defined, indicates that the flock() routine is X * available to do file locking. X */ X#define FLOCK /**/ X X/* GETGROUPS: X * This symbol, if defined, indicates that the getgroups() routine is X * available to get the list of process groups. If unavailable, multiple X * groups are probably not supported. X */ X#define GETGROUPS /**/ X X/* GETHOSTENT: X * This symbol, if defined, indicates that the gethostent() routine is X * available to lookup host names in some data base or other. X */ X#define GETHOSTENT /**/ X X/* GETPGRP: X * This symbol, if defined, indicates that the getpgrp() routine is X * available to get the current process group. X */ X#define GETPGRP /**/ X X/* GETPRIORITY: X * This symbol, if defined, indicates that the getpriority() routine is X * available to get a process's priority. X */ X#define GETPRIORITY /**/ X X/* HTONS: X * This symbol, if defined, indicates that the htons routine (and friends) X * are available to do network order byte swapping. X */ X/* HTONL: X * This symbol, if defined, indicates that the htonl routine (and friends) X * are available to do network order byte swapping. X */ X/* NTOHS: X * This symbol, if defined, indicates that the ntohs routine (and friends) X * are available to do network order byte swapping. X */ X/* NTOHL: X * This symbol, if defined, indicates that the ntohl routine (and friends) X * are available to do network order byte swapping. X */ X#define HTONS /**/ X#define HTONL /**/ X#define NTOHS /**/ X#define NTOHL /**/ X X/* index: X * This preprocessor symbol is defined, along with rindex, if the system X * uses the strchr and strrchr routines instead. X */ X/* rindex: X * This preprocessor symbol is defined, along with index, if the system X * uses the strchr and strrchr routines instead. X */ X/*#undef index strchr /* cultural */ X/*#undef rindex strrchr /* differences? */ X X/* IOCTL: X * This symbol, if defined, indicates that sys/ioctl.h exists and should X * be included. X */ X#define IOCTL /**/ X X/* KILLPG: X * This symbol, if defined, indicates that the killpg routine is available X * to kill process groups. If unavailable, you probably should use kill X * with a negative process number. X */ X#define KILLPG /**/ X X/* MEMCMP: X * This symbol, if defined, indicates that the memcmp routine is available X * to compare blocks of memory. If undefined, roll your own. X */ X#define MEMCMP /**/ X X/* MEMCPY: X * This symbol, if defined, indicates that the memcpy routine is available X * to copy blocks of memory. Otherwise you should probably use bcopy(). X * If neither is defined, roll your own. X */ X#define MEMCPY /**/ X X/* MKDIR: X * This symbol, if defined, indicates that the mkdir routine is available X * to create directories. Otherwise you should fork off a new process to X * exec /bin/mkdir. X */ X#define MKDIR /**/ X X/* NDBM: X * This symbol, if defined, indicates that ndbm.h exists and should X * be included. X */ X#define NDBM /**/ X X/* ODBM: X * This symbol, if defined, indicates that dbm.h exists and should X * be included. X */ X#define ODBM /**/ X X/* READDIR: X * This symbol, if defined, indicates that the readdir routine is available X * from the C library to create directories. X */ X#define READDIR /**/ X X/* RENAME: X * This symbol, if defined, indicates that the rename routine is available X * to rename files. Otherwise you should do the unlink(), link(), unlink() X * trick. X */ X#define RENAME /**/ X X/* RMDIR: X * This symbol, if defined, indicates that the rmdir routine is available X * to remove directories. Otherwise you should fork off a new process to X * exec /bin/rmdir. X */ X#define RMDIR /**/ X X/* SETEGID: X * This symbol, if defined, indicates that the setegid routine is available X * to change the effective gid of the current program. X */ X#define SETEGID /**/ X X/* SETEUID: X * This symbol, if defined, indicates that the seteuid routine is available X * to change the effective uid of the current program. X */ X#define SETEUID /**/ X X/* SETPGRP: X * This symbol, if defined, indicates that the setpgrp() routine is X * available to set the current process group. X */ X#define SETPGRP /**/ X X/* SETPRIORITY: X * This symbol, if defined, indicates that the setpriority() routine is X * available to set a process's priority. X */ X#define SETPRIORITY /**/ X X/* SETREGID: X * This symbol, if defined, indicates that the setregid routine is available X * to change the real and effective gid of the current program. X */ X#define SETREGID /**/ X X/* SETREUID: X * This symbol, if defined, indicates that the setreuid routine is available X * to change the real and effective uid of the current program. X */ X#define SETREUID /**/ X X/* SETRGID: X * This symbol, if defined, indicates that the setrgid routine is available X * to change the real gid of the current program. X */ X#define SETRGID /**/ X X/* SETRUID: X * This symbol, if defined, indicates that the setruid routine is available X * to change the real uid of the current program. X */ X#define SETRUID /**/ X X/* SOCKET: X * This symbol, if defined, indicates that the BSD socket interface is X * supported. X */ X/* SOCKETPAIR: X * This symbol, if defined, indicates that the BSD socketpair call is X * supported. X */ X/* OLDSOCKET: X * This symbol, if defined, indicates that the 4.1c BSD socket interface X * is supported instead of the 4.2/4.3 BSD socket interface. X */ X#define SOCKET /**/ X X#define SOCKETPAIR /**/ X X/*#undef OLDSOCKET /**/ X X/* STATBLOCKS: X * This symbol is defined if this system has a stat structure declaring X * st_blksize and st_blocks. X */ X#define STATBLOCKS /**/ X X/* STDSTDIO: X * This symbol is defined if this system has a FILE structure declaring X * _ptr and _cnt in stdio.h. X */ X#define STDSTDIO /**/ X X/* STRUCTCOPY: X * This symbol, if defined, indicates that this C compiler knows how X * to copy structures. If undefined, you'll need to use a block copy X * routine of some sort instead. X */ X#define STRUCTCOPY /**/ X X/* SYMLINK: X * This symbol, if defined, indicates that the symlink routine is available X * to create symbolic links. X */ X#define SYMLINK /**/ X X/* SYSCALL: X * This symbol, if defined, indicates that the syscall routine is available X * to call arbitrary system calls. If undefined, that's tough. X */ X#define SYSCALL /**/ X X/* TMINSYS: X * This symbol is defined if this system declares "struct tm" in X * in rather than . We can't just say X * -I/usr/include/sys because some systems have both time files, and X * the -I trick gets the wrong one. X */ X/* I_SYSTIME: X * This symbol is defined if this system has the file . X */ X/*#undef TMINSYS /**/ X#define I_SYSTIME /**/ X X/* VARARGS: X * This symbol, if defined, indicates to the C program that it should X * include varargs.h. X */ X#define VARARGS /**/ X X/* vfork: X * This symbol, if defined, remaps the vfork routine to fork if the X * vfork() routine isn't supported here. X */ X/*#undef vfork fork /**/ X X/* VOIDSIG: X * This symbol is defined if this system declares "void (*signal())()" in X * signal.h. The old way was to declare it as "int (*signal())()". It X * is up to the package author to declare things correctly based on the X * symbol. X */ X/*#undef VOIDSIG /**/ X X/* VPRINTF: X * This symbol, if defined, indicates that the vprintf routine is available X * to printf with a pointer to an argument list. If unavailable, you X * may need to write your own, probably in terms of _doprnt(). X */ X/* CHARVSPRINTF: X * This symbol is defined if this system has vsprintf() returning type X * (char*). The trend seems to be to declare it as "int vsprintf()". It X * is up to the package author to declare vsprintf correctly based on the X * symbol. X */ X/*#undef VPRINTF /**/ X/*#undef CHARVSPRINTF /**/ X X/* GIDTYPE: X * This symbol has a value like gid_t, int, ushort, or whatever type is X * used to declare group ids in the kernel. X */ X#define GIDTYPE gid_t /**/ X X/* I_DIRENT: X * This symbol, if defined, indicates to the C program that it should X * include dirent.h. X */ X/* DIRNAMLEN: X * This symbol, if defined, indicates to the C program that the length X * of directory entry names is provided by a d_namlen field. Otherwise X * you need to do strlen() on the d_name field. X */ X/*#undef I_DIRENT /**/ X#define DIRNAMLEN /**/ X X/* I_FCNTL: X * This symbol, if defined, indicates to the C program that it should X * include fcntl.h. X */ X#define I_FCNTL /**/ X X/* I_GRP: X * This symbol, if defined, indicates to the C program that it should X * include grp.h. X */ X#define I_GRP /**/ X X/* I_PWD: X * This symbol, if defined, indicates to the C program that it should X * include pwd.h. X */ X/* PWQUOTA: X * This symbol, if defined, indicates to the C program that struct passwd X * contains pw_quota. X */ X/* PWAGE: X * This symbol, if defined, indicates to the C program that struct passwd X * contains pw_age. X */ X#define I_PWD /**/ X#define PWQUOTA /**/ X/*#undef PWAGE /**/ X X/* I_SYSDIR: X * This symbol, if defined, indicates to the C program that it should X * include sys/dir.h. X */ X#define I_SYSDIR /**/ X X/* I_SYSIOCTL: X * This symbol, if defined, indicates that sys/ioctl.h exists and should X * be included. X */ X#define I_SYSIOCTL /**/ X X/* I_VARARGS: X * This symbol, if defined, indicates to the C program that it should X * include varargs.h. X */ X#define I_VARARGS /**/ X X/* INTSIZE: X * This symbol contains the size of an int, so that the C preprocessor X * can make decisions based on it. X */ X#define INTSIZE 4 /**/ X X/* RANDBITS: X * This symbol contains the number of bits of random number the rand() X * function produces. Usual values are 15, 16, and 31. X */ X#define RANDBITS 31 /**/ X X/* SIG_NAME: X * This symbol contains an list of signal names in order. X */ X#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","IOT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","URG","STOP","TSTP","CONT","CHLD","TTIN","TTOU","IO","XCPU","XFSZ","VTALRM","PROF","WINCH","USR1","USR2" /**/ X X/* STDCHAR: X * This symbol is defined to be the type of char used in stdio.h. X * It has the values "unsigned char" or "char". X */ X#define STDCHAR char /**/ X X/* UIDTYPE: X * This symbol has a value like uid_t, int, ushort, or whatever type is X * used to declare user ids in the kernel. X */ X#define UIDTYPE uid_t /**/ X X/* VOIDFLAGS: X * This symbol indicates how much support of the void type is given by this X * compiler. What various bits mean: X * X * 1 = supports declaration of void X * 2 = supports arrays of pointers to functions returning void X * 4 = supports comparisons between pointers to void functions and X * addresses of void functions X * X * The package designer should define VOIDUSED to indicate the requirements X * of the package. This can be done either by #defining VOIDUSED before X * including config.h, or by defining defvoidused in Myinit.U. If the X * latter approach is taken, only those flags will be tested. If the X * level of void support necessary is not present, defines void to int. X */ X#ifndef VOIDUSED X#define VOIDUSED 7 X#endif X#define VOIDFLAGS 7 X#if (VOIDFLAGS & VOIDUSED) != VOIDUSED X#define void int /* is void to be avoided? */ X#define M_VOID /* Xenix strikes again */ X#endif X X/* PRIVLIB: X * This symbol contains the name of the private library for this package. X * The library is private in the sense that it needn't be in anyone's X * execution path, but it should be accessible by the world. The program X * should be prepared to do ~ expansion. X */ X#define PRIVLIB "/usr/local/lib/perl" /**/ X !STUFFY!FUNK! echo Extracting x2p/util.c sed >x2p/util.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: util.c,v 3.0 89/10/18 15:35:35 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: util.c,v $ X * Revision 3.0 89/10/18 15:35:35 lwall X * 3.0 baseline X * X */ X X#include X X#include "handy.h" X#include "EXTERN.h" X#include "a2p.h" X#include "INTERN.h" X#include "util.h" X X#define FLUSH X#define MEM_SIZE unsigned int X Xstatic char nomem[] = "Out of memory!\n"; X X/* paranoid version of malloc */ X Xstatic int an = 0; X Xchar * Xsafemalloc(size) XMEM_SIZE size; X{ X char *ptr; X char *malloc(); X X ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */ X#ifdef DEBUGGING X if (debug & 128) X fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",ptr,an++,size); X#endif X if (ptr != Nullch) X return ptr; X else { X fputs(nomem,stdout) FLUSH; X exit(1); X } X /*NOTREACHED*/ X} X X/* paranoid version of realloc */ X Xchar * Xsaferealloc(where,size) Xchar *where; XMEM_SIZE size; X{ X char *ptr; X char *realloc(); X X ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */ X#ifdef DEBUGGING X if (debug & 128) { X fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++); X fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",ptr,an++,size); X } X#endif X if (ptr != Nullch) X return ptr; X else { X fputs(nomem,stdout) FLUSH; X exit(1); X } X /*NOTREACHED*/ X} X X/* safe version of free */ X Xsafefree(where) Xchar *where; X{ X#ifdef DEBUGGING X if (debug & 128) X fprintf(stderr,"0x%x: (%05d) free\n",where,an++); X#endif X free(where); X} X X/* safe version of string copy */ X Xchar * Xsafecpy(to,from,len) Xchar *to; Xregister char *from; Xregister int len; X{ X register char *dest = to; X X if (from != Nullch) X for (len--; len && (*dest++ = *from++); len--) ; X *dest = '\0'; X return to; X} X X#ifdef undef X/* safe version of string concatenate, with \n deletion and space padding */ X Xchar * Xsafecat(to,from,len) Xchar *to; Xregister char *from; Xregister int len; X{ X register char *dest = to; X X len--; /* leave room for null */ X if (*dest) { X while (len && *dest++) len--; X if (len) { X len--; X *(dest-1) = ' '; X } X } X if (from != Nullch) X while (len && (*dest++ = *from++)) len--; X if (len) X dest--; X if (*(dest-1) == '\n') X dest--; X *dest = '\0'; X return to; X} X#endif X X/* copy a string up to some (non-backslashed) delimiter, if any */ X Xchar * Xcpytill(to,from,delim) Xregister char *to, *from; Xregister int delim; X{ X for (; *from; from++,to++) { X if (*from == '\\') { X if (from[1] == delim) X from++; X else if (from[1] == '\\') X *to++ = *from++; X } X else if (*from == delim) X break; X *to = *from; X } X *to = '\0'; X return from; X} X X Xchar * Xcpy2(to,from,delim) Xregister char *to, *from; Xregister int delim; X{ X for (; *from; from++,to++) { X if (*from == '\\') X *to++ = *from++; X else if (*from == '$') X *to++ = '\\'; X else if (*from == delim) X break; X *to = *from; X } X *to = '\0'; X return from; X} X X/* return ptr to little string in big string, NULL if not found */ X Xchar * Xinstr(big, little) Xchar *big, *little; X X{ X register char *t, *s, *x; X X for (t = big; *t; t++) { X for (x=t,s=little; *s; x++,s++) { X if (!*x) X return Nullch; X if (*s != *x) X break; X } X if (!*s) X return t; X } X return Nullch; X} X X/* copy a string to a safe spot */ X Xchar * Xsavestr(str) Xchar *str; X{ X register char *newaddr = safemalloc((MEM_SIZE)(strlen(str)+1)); X X (void)strcpy(newaddr,str); X return newaddr; X} X X/* grow a static string to at least a certain length */ X Xvoid Xgrowstr(strptr,curlen,newlen) Xchar **strptr; Xint *curlen; Xint newlen; X{ X if (newlen > *curlen) { /* need more room? */ X if (*curlen) X *strptr = saferealloc(*strptr,(MEM_SIZE)newlen); X else X *strptr = safemalloc((MEM_SIZE)newlen); X *curlen = newlen; X } X} X X/*VARARGS1*/ Xfatal(pat,a1,a2,a3,a4) Xchar *pat; X{ X fprintf(stderr,pat,a1,a2,a3,a4); X exit(1); X} X X/*VARARGS1*/ Xwarn(pat,a1,a2,a3,a4) Xchar *pat; X{ X fprintf(stderr,pat,a1,a2,a3,a4); X} X Xstatic bool firstsetenv = TRUE; Xextern char **environ; X Xvoid Xsetenv(nam,val) Xchar *nam, *val; X{ X register int i=envix(nam); /* where does it go? */ X X if (!environ[i]) { /* does not exist yet */ X if (firstsetenv) { /* need we copy environment? */ X int j; X#ifndef lint X char **tmpenv = (char**) /* point our wand at memory */ X safemalloc((i+2) * sizeof(char*)); X#else X char **tmpenv = Null(char **); X#endif /* lint */ X X firstsetenv = FALSE; X for (j=0; jt/op.push <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.push,v 3.0 89/10/18 15:30:48 lwall Locked $ X Xprint "1..2\n"; X X@x = (1,2,3); Xpush(@x,@x); Xif (join(':',@x) eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";} Xpush(x,4); Xif (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";} !STUFFY!FUNK! echo "" echo "End of kit 15 (of 24)" cat /dev/null >kit15isdone 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 24; 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