home *** CD-ROM | disk | FTP | other *** search
- 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 <lwall@jpl-devvax.jpl.nasa.gov>
- 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 <varargs.h>
- 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 (<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 && (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; 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(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 <sys/time.h> rather than <time.h>. 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 <sys/time.h>.
- 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 <stdio.h>
- 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; j<i; j++) /* copy environment */
- X tmpenv[j] = environ[j];
- X environ = tmpenv; /* tell exec where it is now */
- X }
- X#ifndef lint
- X else
- X environ = (char**) saferealloc((char*) environ,
- X (i+2) * sizeof(char*));
- X /* just expand it a bit */
- X#endif /* lint */
- X environ[i+1] = Nullch; /* make sure it's null terminated */
- X }
- X environ[i] = safemalloc(strlen(nam) + strlen(val) + 2);
- X /* this may or may not be in */
- X /* the old environ structure */
- X sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
- X}
- X
- Xint
- Xenvix(nam)
- Xchar *nam;
- X{
- X register int i, len = strlen(nam);
- X
- X for (i = 0; environ[i]; i++) {
- X if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
- X break; /* strnEQ must come first to avoid */
- X } /* potential SEGV's */
- X return i;
- X}
- !STUFFY!FUNK!
- echo Extracting t/op.push
- sed >t/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
-
-