lwall@netlabs.com (Larry Wall) (04/17/91)
Submitted-by: Larry Wall <lwall@netlabs.com>
Posting-number: Volume 18, Issue 37
Archive-name: perl/part19
[There are 36 kits for perl version 4.0.]
#! /bin/sh
# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 36 through sh. When all 36 kits have been run, read README.
echo "This is perl 4.0 kit 19 (of 36). If kit 19 is complete, the line"
echo '"'"End of kit 19 (of 36)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir 2>/dev/null
echo Extracting cmd.c
sed >cmd.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $RCSfile: cmd.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:36:16 $
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 4.0.1.1 91/04/11 17:36:16 lwall
X * patch1: you may now use "die" and "caller" in a signal handler
X *
X * Revision 4.0 91/03/20 01:04:18 lwall
X * 4.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/* do longjmps() clobber register variables? */
X
X#if defined(cray) || defined(__STDC__)
X#define JMPCLOBBER
X#endif
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(cmdparm,gimme,sp)
XCMD *VOLATILE cmdparm;
XVOLATILE int gimme;
XVOLATILE int sp;
X{
X register CMD *cmd = cmdparm;
X SPAT *VOLATILE oldspat;
X VOLATILE int firstsave = savestack->ary_fill;
X VOLATILE int oldsave;
X VOLATILE int aryoptsave;
X#ifdef DEBUGGING
X VOLATILE int olddlevel;
X VOLATILE 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 *VOLATILE fp;
X ARRAY *VOLATILE 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 && (cmdflags & CF_TERM),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 && (cmdflags & CF_TERM),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#ifdef JMPCLOBBER
X cmdparm = cmd;
X#endif
X match = setjmp(loop_stack[loop_ptr].loop_env);
X if (match) {
X st = stack->ary_array; /* possibly reallocated */
X#ifdef JMPCLOBBER
X cmd = cmdparm;
X cmdflags = cmd->c_flags|CF_ONCE;
X#endif
X if (savestack->ary_fill > oldsave)
X restorelist(oldsave);
X switch (match) {
X default:
X fatal("longjmp returned bad value (%d)",match);
X case O_LAST: /* not done unless go_to found */
X go_to = Nullch;
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 goto next_cmd;
X case O_NEXT: /* not done unless go_to found */
X go_to = Nullch;
X#ifdef JMPCLOBBER
X newsp = -2;
X retstr = &str_undef;
X#endif
X goto next_iter;
X case O_REDO: /* not done unless go_to found */
X go_to = Nullch;
X#ifdef JMPCLOBBER
X newsp = -2;
X retstr = &str_undef;
X#endif
X goto doit;
X }
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 && (cmdflags & CF_TERM),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 && (cmdflags & CF_TERM),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 curcmd = cmd;
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 if (cmd->c_spat)
X lastspat = cmd->c_spat;
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 if (cmd->c_spat)
X lastspat = cmd->c_spat;
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_nset(stab_val(amperstab),
X tmps, cmd->c_short->str_cur);
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 lastspat = cmd->c_spat;
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 cmdflags &= ~CF_OPTIMIZE;
X cmdflags |= CFT_EVAL; /* never try this optimization again */
X cmd->c_flags = (cmdflags & ~CF_ONCE);
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 keepgoing:
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 if (!fp)
X goto doeval; /* first time through */
X fp = nextargv(last_in_stab);
X if (fp)
X goto keepgoing;
X (void)do_close(last_in_stab,FALSE);
X stab_io(last_in_stab)->flags |= IOF_START;
X retstr = &str_undef;
X match = FALSE;
X }
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 tmps_list[tmps_max--] = Nullstr;
X }
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 STABSET(retstr);
X retstr = &str_chop;
X goto flipmaybe;
X case CFT_ARRAY:
X match = cmd->c_short->str_u.str_useful; /* just to get register */
X
X if (match < 0) { /* first time through here? */
X ar = stab_array(cmd->c_expr[1].arg_ptr.arg_stab);
X aryoptsave = savestack->ary_fill;
X savesptr(&stab_val(cmd->c_stab));
X savelong(&cmd->c_short->str_u.str_useful);
X }
X else {
X ar = stab_xarray(cmd->c_expr[1].arg_ptr.arg_stab);
X if (cmd->c_type != C_WHILE && savestack->ary_fill > firstsave)
X restorelist(firstsave);
X }
X
X if (match >= ar->ary_fill) { /* we're in LAST, probably */
X retstr = &str_undef;
X cmd->c_short->str_u.str_useful = -1; /* actually redundant */
X match = FALSE;
X }
X else {
X match++;
X if (!(retstr = ar->ary_array[match]))
X retstr = afetch(ar,match,TRUE);
X stab_val(cmd->c_stab) = retstr;
X cmd->c_short->str_u.str_useful = match;
X match = TRUE;
X }
X newsp = -2;
X goto maybe;
X case CFT_D1:
X break;
X case CFT_D0:
X if (DBsingle->str_u.str_nval != 0)
X break;
X if (DBsignal->str_u.str_nval != 0)
X break;
X if (DBtrace->str_u.str_nval != 0)
X break;
X goto next_cmd;
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 if (lastsize < 0)
X lastsize = 0;
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 tmps_list[tmps_max--] = Nullstr;
X }
X newsp = eval(cmd->c_expr,
X gimme && (cmdflags & CF_TERM) && cmd->c_type == C_EXPR &&
X !cmd->ucmd.acmd.ac_expr,
X sp);
X st = stack->ary_array; /* possibly reallocated */
X retstr = st[newsp];
X if (newsp > sp && retstr)
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 tmps_list[tmps_max--] = Nullstr;
X }
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 if (lastsize < 0)
X lastsize = 0;
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 tmps_list[tmps_max--] = Nullstr;
X }
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 {
X double value = str_gnum(STAB_STR(cmd->c_stab));
X
X match = (int)value;
X if (value < 0.0) {
X if (((double)match) > value)
X --match; /* was fractional--truncate other way */
X }
X }
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->ucmd.scmd.sc_max;
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 && (cmdflags & CF_TERM),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 && (cmdflags & CF_TERM),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#ifdef JMPCLOBBER
X cmdparm = cmd;
X#endif
X match = setjmp(loop_stack[loop_ptr].loop_env);
X if (match) {
X st = stack->ary_array; /* possibly reallocated */
X#ifdef JMPCLOBBER
X cmd = cmdparm;
X cmdflags = cmd->c_flags|CF_ONCE;
X go_to = goto_targ;
X#endif
X if (savestack->ary_fill > oldsave)
X restorelist(oldsave);
X switch (match) {
X default:
X fatal("longjmp returned bad value (%d)",match);
X case O_LAST:
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 goto next_cmd;
X case O_NEXT:
X#ifdef JMPCLOBBER
X newsp = -2;
X retstr = &str_undef;
X#endif
X goto next_iter;
X case O_REDO:
X#ifdef DEBUGGING
X dlevel = olddlevel;
X#endif
X#ifdef JMPCLOBBER
X newsp = -2;
X retstr = &str_undef;
X#endif
X goto doit;
X }
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 && (cmdflags & CF_TERM),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 && (cmdflags & CF_TERM),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 if (cmdflags & CF_TERM) {
X for (match = sp + 1; match <= newsp; match++)
X st[match] = str_mortal(st[match]);
X retstr = st[newsp];
X }
X restorelist(oldsave);
X }
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 savestack->ary_fill > aryoptsave)
X restorelist(aryoptsave);
X }
X cmd = cmd->c_next;
X goto tail_recursion_entry;
X}
X
X#ifdef DEBUGGING
X# ifndef I_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)curcmd->c_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)curcmd->c_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_ptr = Nullch;
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_ptr = Nullch;
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
Xsaveaptr(aptr)
XARRAY **aptr;
X{
X register STR *str;
X
X str = Str_new(17,0);
X str->str_state = SS_SAPTR;
X str->str_u.str_array = *aptr; /* remember value */
X if (str->str_ptr) {
X Safefree(str->str_ptr);
X str->str_len = 0;
X }
X str->str_ptr = (char*)aptr; /* 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 sarg[i]->str_u.str_useful = -1;
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), FALSE);
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_SAPTR: /* ARRAY* reference */
X *((ARRAY**)value->str_ptr) = value->str_u.str_array;
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 case SS_SCSV: /* callsave structure */
X {
X CSV *csv = (CSV*) value->str_ptr;
X
X curcmd = csv->curcmd;
X curcsv = csv->curcsv;
X csv->sub->depth = csv->depth;
X if (csv->hasargs) { /* put back old @_ */
X afree(csv->argarray);
X stab_xarray(defstab) = csv->savearray;
X }
X str_free(value);
X }
X break;
X default:
X fatal("panic: restorelist inconsistency");
X }
X }
X}
X
X#ifdef DEBUGGING
Xvoid
Xgrow_dlevel()
X{
X dlmax += 128;
X Renew(debname, dlmax, char);
X Renew(debdelim, dlmax, char);
X}
X#endif
!STUFFY!FUNK!
echo Extracting perl.h
sed >perl.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $RCSfile: perl.h,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:49:51 $
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: perl.h,v $
X * Revision 4.0.1.1 91/04/11 17:49:51 lwall
X * patch1: hopefully straightened out some of the Xenix mess
X *
X * Revision 4.0 91/03/20 01:37:56 lwall
X * 4.0 baseline.
X *
X */
X
X#define VOIDWANT 1
X#include "config.h"
X
X#ifdef MSDOS
X/* This stuff now in the MS-DOS config.h file. */
X#else /* !MSDOS */
X
X/*
X * The following symbols are defined if your operating system supports
X * functions by that name. All Unixes I know of support them, thus they
X * are not checked by the configuration script, but are directly defined
X * here.
X */
X#define HAS_ALARM
X#define HAS_CHOWN
X#define HAS_CHROOT
X#define HAS_FORK
X#define HAS_GETLOGIN
X#define HAS_GETPPID
X#define HAS_KILL
X#define HAS_LINK
X#define HAS_PIPE
X#define HAS_WAIT
X#define HAS_UMASK
X/*
X * The following symbols are defined if your operating system supports
X * password and group functions in general. All Unix systems do.
X */
X#define HAS_GROUP
X#define HAS_PASSWD
X
X#endif /* !MSDOS */
X
X#if defined(HASVOLATILE) || defined(__STDC__)
X#define VOLATILE volatile
X#else
X#define VOLATILE
X#endif
X
X#ifdef IAMSUID
X# ifndef TAINT
X# define TAINT
X# endif
X#endif
X
X#ifndef HAS_VFORK
X# define vfork fork
X#endif
X
X#ifdef HAS_GETPGRP2
X# ifndef HAS_GETPGRP
X# define HAS_GETPGRP
X# endif
X# define getpgrp getpgrp2
X#endif
X
X#ifdef HAS_SETPGRP2
X# ifndef HAS_SETPGRP
X# define HAS_SETPGRP
X# endif
X# define setpgrp setpgrp2
X#endif
X
X#include <stdio.h>
X#include <ctype.h>
X#include <setjmp.h>
X#ifndef MSDOS
X#include <sys/param.h> /* if this needs types.h we're still wrong */
X#endif
X#ifdef __STDC__
X/* Use all the "standard" definitions */
X#include <stdlib.h>
X#include <string.h>
X#endif /* __STDC__ */
X
X#if defined(HAS_MEMCMP) && defined(mips) && BYTEORDER == 0x1234
X#undef HAS_MEMCMP
X#endif
X
X#ifdef HAS_MEMCPY
X
X# ifndef __STDC__
X# ifndef memcpy
Xextern char * memcpy(), *memset();
Xextern int memcmp();
X# endif /* ndef memcpy */
X# endif /* ndef __STDC__ */
X
X#define bcopy(s1,s2,l) memcpy(s2,s1,l)
X#define bzero(s,l) memset(s,0,l)
X#endif /* HAS_MEMCPY */
X
X#ifndef HAS_BCMP /* prefer bcmp slightly 'cuz it doesn't order */
X#define bcmp(s1,s2,l) memcmp(s1,s2,l)
X#endif
X
X#ifndef _TYPES_ /* If types.h defines this it's easy. */
X#ifndef major /* Does everyone's types.h define this? */
X#include <sys/types.h>
X#endif
X#endif
X
X#ifdef I_NETINET_IN
X#include <netinet/in.h>
X#endif
X
X#include <sys/stat.h>
X
X#ifdef I_TIME
X# include <time.h>
X#endif
X
X#ifdef I_SYS_TIME
X# ifdef SYSTIMEKERNEL
X# define KERNEL
X# endif
X# include <sys/time.h>
X# ifdef SYSTIMEKERNEL
X# undef KERNEL
X# endif
X#endif
X
X#ifndef MSDOS
X#include <sys/times.h>
X#endif
X
X#if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR))
X#undef HAS_STRERROR
X#endif
X
X#include <errno.h>
X#ifndef MSDOS
X#ifndef errno
Xextern int errno; /* ANSI allows errno to be an lvalue expr */
X#endif
X#endif
X
X#ifndef strerror
X#ifdef HAS_STRERROR
Xchar *strerror();
X#else
Xextern int sys_nerr;
Xextern char *sys_errlist[];
X#define strerror(e) ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
X#endif
X#endif
X
X#ifdef I_SYSIOCTL
X#ifndef _IOCTL_
X#include <sys/ioctl.h>
X#endif
X#endif
X
X#if defined(mc300) || defined(mc500) || defined(mc700) /* MASSCOMP */
X#ifdef HAS_SOCKETPAIR
X#undef HAS_SOCKETPAIR
X#endif
X#ifdef HAS_NDBM
X#undef HAS_NDBM
X#endif
X#endif
X
X#ifdef HAS_GDBM
X#ifdef I_GDBM
X#include <gdbm.h>
X#endif
X#define SOME_DBM
X#ifdef HAS_NDBM
X#undef HAS_NDBM
X#endif
X#ifdef HAS_ODBM
X#undef HAS_ODBM
X#endif
X#else
X#ifdef HAS_NDBM
X#include <ndbm.h>
X#define SOME_DBM
X#ifdef HAS_ODBM
X#undef HAS_ODBM
X#endif
X#else
X#ifdef HAS_ODBM
X#ifdef NULL
X#undef NULL /* suppress redefinition message */
X#endif
X#include <dbm.h>
X#ifdef NULL
X#undef NULL
X#endif
X#define NULL 0 /* silly thing is, we don't even use this */
X#define SOME_DBM
X#define dbm_fetch(db,dkey) fetch(dkey)
X#define dbm_delete(db,dkey) delete(dkey)
X#define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent)
X#define dbm_close(db) dbmclose()
X#define dbm_firstkey(db) firstkey()
X#endif /* HAS_ODBM */
X#endif /* HAS_NDBM */
X#endif /* HAS_GDBM */
X#ifdef SOME_DBM
XEXT char *dbmkey;
XEXT int dbmlen;
X#endif
X
X#if INTSIZE == 2
X#define htoni htons
X#define ntohi ntohs
X#else
X#define htoni htonl
X#define ntohi ntohl
X#endif
X
X#if defined(I_DIRENT)
X# include <dirent.h>
X# define DIRENT dirent
X#else
X# ifdef I_SYS_NDIR
X# include <sys/ndir.h>
X# define DIRENT direct
X# else
X# ifdef I_SYS_DIR
X# ifdef hp9000s500
X# include <ndir.h> /* may be wrong in the future */
X# else
X# include <sys/dir.h>
X# endif
X# define DIRENT direct
X# endif
X# endif
X#endif
X
X/*
X * The following gobbledygook brought to you on behalf of __STDC__.
X * (I could just use #ifndef __STDC__, but this is more bulletproof
X * in the face of half-implementations.)
X */
X
X#ifndef S_IFMT
X# ifdef _S_IFMT
X# define S_IFMT _S_IFMT
X# else
X# define S_IFMT 0170000
X# endif
X#endif
X
X#ifndef S_ISDIR
X# define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR)
X#endif
X
X#ifndef S_ISCHR
X# define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR)
X#endif
X
X#ifndef S_ISBLK
X# ifdef S_IFBLK
X# define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK)
X# else
X# define S_ISBLK(m) (0)
X# endif
X#endif
X
X#ifndef S_ISREG
X# define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
X#endif
X
X#ifndef S_ISFIFO
X# ifdef S_IFIFO
X# define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO)
X# else
X# define S_ISFIFO(m) (0)
X# endif
X#endif
X
X#ifndef S_ISLNK
X# ifdef _S_ISLNK
X# define S_ISLNK(m) _S_ISLNK(m)
X# else
X# ifdef _S_IFLNK
X# define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
X# else
X# ifdef S_IFLNK
X# define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
X# else
X# define S_ISLNK(m) (0)
X# endif
X# endif
X# endif
X#endif
X
X#ifndef S_ISSOCK
X# ifdef _S_ISSOCK
X# define S_ISSOCK(m) _S_ISSOCK(m)
X# else
X# ifdef _S_IFSOCK
X# define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
X# else
X# ifdef S_IFSOCK
X# define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
X# else
X# define S_ISSOCK(m) (0)
X# endif
X# endif
X# endif
X#endif
X
X#ifndef S_IRUSR
X# ifdef S_IREAD
X# define S_IRUSR S_IREAD
X# define S_IWUSR S_IWRITE
X# define S_IXUSR S_IEXEC
X# else
X# define S_IRUSR 0400
X# define S_IWUSR 0200
X# define S_IXUSR 0100
X# endif
X# define S_IRGRP (S_IRUSR>>3)
X# define S_IWGRP (S_IWUSR>>3)
X# define S_IXGRP (S_IXUSR>>3)
X# define S_IROTH (S_IRUSR>>6)
X# define S_IWOTH (S_IWUSR>>6)
X# define S_IXOTH (S_IXUSR>>6)
X#endif
X
X#ifndef S_ISUID
X# define S_ISUID 04000
X#endif
X
X#ifndef S_ISGID
X# define S_ISGID 02000
X#endif
X
Xtypedef unsigned int STRLEN;
X
Xtypedef struct arg ARG;
Xtypedef struct cmd CMD;
Xtypedef struct formcmd FCMD;
Xtypedef struct scanpat SPAT;
Xtypedef struct stio STIO;
Xtypedef struct sub SUBR;
Xtypedef struct string STR;
Xtypedef struct atbl ARRAY;
Xtypedef struct htbl HASH;
Xtypedef struct regexp REGEXP;
Xtypedef struct stabptrs STBP;
Xtypedef struct stab STAB;
Xtypedef struct callsave CSV;
X
X#include "handy.h"
X#include "regexp.h"
X#include "str.h"
X#include "util.h"
X#include "form.h"
X#include "stab.h"
X#include "spat.h"
X#include "arg.h"
X#include "cmd.h"
X#include "array.h"
X#include "hash.h"
X
X#if defined(iAPX286) || defined(M_I286) || defined(I80286)
X# define I286
X#endif
X
X#ifndef __STDC__
X#ifdef CHARSPRINTF
X char *sprintf();
X#else
X int sprintf();
X#endif
X#endif
X
XEXT char *Yes INIT("1");
XEXT char *No INIT("");
X
X/* "gimme" values */
X
X/* Note: cmd.c assumes that it can use && to produce one of these values! */
X#define G_SCALAR 0
X#define G_ARRAY 1
X
X#ifdef CRIPPLED_CC
Xint str_true();
X#else /* !CRIPPLED_CC */
X#define str_true(str) (Str = (str), \
X (Str->str_pok ? \
X ((*Str->str_ptr > '0' || \
X Str->str_cur > 1 || \
X (Str->str_cur && *Str->str_ptr != '0')) ? 1 : 0) \
X : \
X (Str->str_nok ? (Str->str_u.str_nval != 0.0) : 0 ) ))
X#endif /* CRIPPLED_CC */
X
X#ifdef DEBUGGING
X#define str_peek(str) (Str = (str), \
X (Str->str_pok ? \
X Str->str_ptr : \
X (Str->str_nok ? \
X (sprintf(tokenbuf,"num(%g)",Str->str_u.str_nval), \
X (char*)tokenbuf) : \
X "" )))
X#endif
X
X#ifdef CRIPPLED_CC
Xchar *str_get();
X#else
X#ifdef TAINT
X#define str_get(str) (Str = (str), tainted |= Str->str_tainted, \
X (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
X#else
X#define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
X#endif /* TAINT */
X#endif /* CRIPPLED_CC */
X
X#ifdef CRIPPLED_CC
Xdouble str_gnum();
X#else /* !CRIPPLED_CC */
X#ifdef TAINT
X#define str_gnum(str) (Str = (str), tainted |= Str->str_tainted, \
X (Str->str_nok ? Str->str_u.str_nval : str_2num(Str)))
X#else /* !TAINT */
X#define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_u.str_nval : str_2num(Str)))
X#endif /* TAINT*/
X#endif /* CRIPPLED_CC */
XEXT STR *Str;
X
X#define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
X
X#ifndef MSDOS
X#define STR_GROW(str,len) if ((str)->str_len < (len)) str_grow(str,len)
X#define Str_Grow str_grow
X#else
X/* extra parentheses intentionally NOT placed around "len"! */
X#define STR_GROW(str,len) if ((str)->str_len < (unsigned long)len) \
X str_grow(str,(unsigned long)len)
X#define Str_Grow(str,len) str_grow(str,(unsigned long)(len))
X#endif /* MSDOS */
X
X#ifndef BYTEORDER
X#define BYTEORDER 0x1234
X#endif
X
X#if defined(htonl) && !defined(HAS_HTONL)
X#define HAS_HTONL
X#endif
X#if defined(htons) && !defined(HAS_HTONS)
X#define HAS_HTONS
X#endif
X#if defined(ntohl) && !defined(HAS_NTOHL)
X#define HAS_NTOHL
X#endif
X#if defined(ntohs) && !defined(HAS_NTOHS)
X#define HAS_NTOHS
X#endif
X#ifndef HAS_HTONL
X#if (BYTEORDER & 0xffff) != 0x4321
X#define HAS_HTONS
X#define HAS_HTONL
X#define HAS_NTOHS
X#define HAS_NTOHL
X#define MYSWAP
X#define htons my_swap
X#define htonl my_htonl
X#define ntohs my_swap
X#define ntohl my_ntohl
X#endif
X#else
X#if (BYTEORDER & 0xffff) == 0x4321
X#undef HAS_HTONS
X#undef HAS_HTONL
X#undef HAS_NTOHS
X#undef HAS_NTOHL
X#endif
X#endif
X
X#ifdef CASTNEGFLOAT
X#define U_S(what) ((unsigned short)(what))
X#define U_I(what) ((unsigned int)(what))
X#define U_L(what) ((unsigned long)(what))
X#else
Xunsigned long castulong();
X#define U_S(what) ((unsigned int)castulong(what))
X#define U_I(what) ((unsigned int)castulong(what))
X#define U_L(what) (castulong(what))
X#endif
X
XCMD *add_label();
XCMD *block_head();
XCMD *append_line();
XCMD *make_acmd();
XCMD *make_ccmd();
XCMD *make_icmd();
XCMD *invert();
XCMD *addcond();
XCMD *addloop();
XCMD *wopt();
XCMD *over();
X
XSTAB *stabent();
XSTAB *genstab();
X
XARG *stab2arg();
XARG *op_new();
XARG *make_op();
XARG *make_match();
XARG *make_split();
XARG *rcatmaybe();
XARG *listish();
XARG *maybelistish();
XARG *localize();
XARG *fixeval();
XARG *jmaybe();
XARG *l();
XARG *fixl();
XARG *mod_match();
XARG *make_list();
XARG *cmd_to_arg();
XARG *addflags();
XARG *hide_ary();
XARG *cval_to_arg();
X
XSTR *str_new();
XSTR *stab_str();
X
Xint do_each();
Xint do_subr();
Xint do_match();
Xint do_unpack();
Xint eval(); /* this evaluates expressions */
Xint do_eval(); /* this evaluates eval operator */
Xint do_assign();
X
XSUBR *make_sub();
X
XFCMD *load_format();
X
Xchar *scanpat();
Xchar *scansubst();
Xchar *scantrans();
Xchar *scanstr();
Xchar *scanident();
Xchar *str_append_till();
Xchar *str_gets();
Xchar *str_grow();
X
Xbool do_open();
Xbool do_close();
Xbool do_print();
Xbool do_aprint();
Xbool do_exec();
Xbool do_aexec();
X
Xint do_subst();
Xint cando();
Xint ingroup();
X
Xvoid str_replace();
Xvoid str_inc();
Xvoid str_dec();
Xvoid str_free();
Xvoid stab_clear();
Xvoid do_join();
Xvoid do_sprintf();
Xvoid do_accept();
Xvoid do_pipe();
Xvoid do_vecset();
Xvoid do_unshift();
Xvoid do_execfree();
Xvoid magicalize();
Xvoid magicname();
Xvoid savelist();
Xvoid saveitem();
Xvoid saveint();
Xvoid savelong();
Xvoid savesptr();
Xvoid savehptr();
Xvoid restorelist();
Xvoid repeatcpy();
XHASH *savehash();
XARRAY *saveary();
X
XEXT char **origargv;
XEXT int origargc;
XEXT char **origenviron;
Xextern char **environ;
X
XEXT line_t subline INIT(0);
XEXT STR *subname INIT(Nullstr);
XEXT int arybase INIT(0);
X
Xstruct outrec {
X long o_lines;
X char *o_str;
X int o_len;
X};
X
XEXT struct outrec outrec;
XEXT struct outrec toprec;
X
XEXT STAB *stdinstab INIT(Nullstab);
XEXT STAB *last_in_stab INIT(Nullstab);
XEXT STAB *defstab INIT(Nullstab);
XEXT STAB *argvstab INIT(Nullstab);
XEXT STAB *envstab INIT(Nullstab);
XEXT STAB *sigstab INIT(Nullstab);
XEXT STAB *defoutstab INIT(Nullstab);
XEXT STAB *curoutstab INIT(Nullstab);
XEXT STAB *argvoutstab INIT(Nullstab);
XEXT STAB *incstab INIT(Nullstab);
XEXT STAB *leftstab INIT(Nullstab);
XEXT STAB *amperstab INIT(Nullstab);
XEXT STAB *rightstab INIT(Nullstab);
XEXT STAB *DBstab INIT(Nullstab);
XEXT STAB *DBline INIT(Nullstab);
XEXT STAB *DBsub INIT(Nullstab);
X
XEXT HASH *defstash; /* main symbol table */
XEXT HASH *curstash; /* symbol table for current package */
XEXT HASH *debstash; /* symbol table for perldb package */
X
XEXT STR *curstname; /* name of current package */
X
XEXT STR *freestrroot INIT(Nullstr);
XEXT STR *lastretstr INIT(Nullstr);
XEXT STR *DBsingle INIT(Nullstr);
XEXT STR *DBtrace INIT(Nullstr);
XEXT STR *DBsignal INIT(Nullstr);
X
XEXT int lastspbase;
XEXT int lastsize;
X
XEXT char *hexdigit INIT("0123456789abcdef0123456789ABCDEF");
XEXT char *origfilename;
XEXT FILE * VOLATILE rsfp;
XEXT char buf[1024];
XEXT char *bufptr;
XEXT char *oldbufptr;
XEXT char *oldoldbufptr;
XEXT char *bufend;
X
XEXT STR *linestr INIT(Nullstr);
X
XEXT char *rs INIT("\n");
XEXT int rschar INIT('\n'); /* final char of rs, or 0777 if none */
XEXT int rslen INIT(1);
XEXT char *ofs INIT(Nullch);
XEXT int ofslen INIT(0);
XEXT char *ors INIT(Nullch);
XEXT int orslen INIT(0);
XEXT char *ofmt INIT(Nullch);
XEXT char *inplace INIT(Nullch);
XEXT char *nointrp INIT("");
X
XEXT bool preprocess INIT(FALSE);
XEXT bool minus_n INIT(FALSE);
XEXT bool minus_p INIT(FALSE);
XEXT bool minus_l INIT(FALSE);
XEXT bool minus_a INIT(FALSE);
XEXT bool doswitches INIT(FALSE);
XEXT bool dowarn INIT(FALSE);
XEXT bool doextract INIT(FALSE);
XEXT bool allstabs INIT(FALSE); /* init all customary symbols in symbol table?*/
XEXT bool sawampersand INIT(FALSE); /* must save all match strings */
XEXT bool sawstudy INIT(FALSE); /* do fbminstr on all strings */
XEXT bool sawi INIT(FALSE); /* study must assume case insensitive */
XEXT bool sawvec INIT(FALSE);
XEXT bool localizing INIT(FALSE); /* are we processing a local() list? */
X
X#ifdef CSH
Xchar *cshname INIT(CSH);
Xint cshlen INIT(0);
X#endif /* CSH */
X
X#ifdef TAINT
XEXT bool tainted INIT(FALSE); /* using variables controlled by $< */
X#endif
X
X#ifndef MSDOS
X#define TMPPATH "/tmp/perl-eXXXXXX"
X#else
X#define TMPPATH "plXXXXXX"
X#endif /* MSDOS */
XEXT char *e_tmpname;
XEXT FILE *e_fp INIT(Nullfp);
X
XEXT char tokenbuf[256];
XEXT int expectterm INIT(TRUE); /* how to interpret ambiguous tokens */
XEXT VOLATILE int in_eval INIT(FALSE); /* trap fatal errors? */
XEXT int multiline INIT(0); /* $*--do strings hold >1 line? */
XEXT int forkprocess; /* so do_open |- can return proc# */
XEXT int do_undump INIT(0); /* -u or dump seen? */
XEXT int error_count INIT(0); /* how many errors so far, max 10 */
XEXT int multi_start INIT(0); /* 1st line of multi-line string */
XEXT int multi_end INIT(0); /* last line of multi-line string */
XEXT int multi_open INIT(0); /* delimiter of said string */
XEXT int multi_close INIT(0); /* delimiter of said string */
X
XFILE *popen();
X/* char *str_get(); */
XSTR *interp();
Xvoid free_arg();
XSTIO *stio_new();
X
XEXT struct stat statbuf;
XEXT struct stat statcache;
XSTAB *statstab INIT(Nullstab);
XSTR *statname;
X#ifndef MSDOS
XEXT struct tms timesbuf;
X#endif
XEXT int uid;
XEXT int euid;
XEXT int gid;
XEXT int egid;
XUIDTYPE getuid();
XUIDTYPE geteuid();
XGIDTYPE getgid();
XGIDTYPE getegid();
XEXT int unsafe;
X
X#ifdef DEBUGGING
XEXT VOLATILE int debug INIT(0);
XEXT int dlevel INIT(0);
XEXT int dlmax INIT(128);
XEXT char *debname;
XEXT char *debdelim;
X#define YYDEBUG 1
X#endif
XEXT int perldb INIT(0);
X#define YYMAXDEPTH 300
X
XEXT line_t cmdline INIT(NOLINE);
X
XEXT STR str_undef;
XEXT STR str_no;
XEXT STR str_yes;
X
X/* runtime control stuff */
X
XEXT struct loop {
X char *loop_label; /* what the loop was called, if anything */
X int loop_sp; /* stack pointer to copy stuff down to */
X jmp_buf loop_env;
X} *loop_stack;
X
XEXT int loop_ptr INIT(-1);
XEXT int loop_max INIT(128);
X
XEXT jmp_buf top_env;
X
XEXT char * VOLATILE goto_targ INIT(Nullch); /* cmd_exec gets strange when set */
X
Xstruct ufuncs {
X int (*uf_val)();
X int (*uf_set)();
X int uf_index;
X};
X
XEXT ARRAY *stack; /* THE STACK */
X
XEXT ARRAY * VOLATILE savestack; /* to save non-local values on */
X
XEXT ARRAY *tosave; /* strings to save on recursive subroutine */
X
XEXT ARRAY *lineary; /* lines of script for debugger */
XEXT ARRAY *dbargs; /* args to call listed by caller function */
X
XEXT ARRAY *fdpid; /* keep fd-to-pid mappings for mypopen */
XEXT HASH *pidstatus; /* keep pid-to-status mappings for waitpid */
X
XEXT int *di; /* for tmp use in debuggers */
XEXT char *dc;
XEXT short *ds;
X
X/* Fix these up for __STDC__ */
XEXT long basetime INIT(0);
Xchar *mktemp();
X#ifndef __STDC__
X/* All of these are in stdlib.h or time.h for ANSI C */
Xdouble atof();
Xlong time();
Xstruct tm *gmtime(), *localtime();
Xchar *index(), *rindex();
Xchar *strcpy(), *strcat();
X#endif /* ! __STDC__ */
X
X#ifdef EUNICE
X#define UNLINK unlnk
Xint unlnk();
X#else
X#define UNLINK unlink
X#endif
X
X#ifndef HAS_SETREUID
X#ifdef HAS_SETRESUID
X#define setreuid(r,e) setresuid(r,e,-1)
X#define HAS_SETREUID
X#endif
X#endif
X#ifndef HAS_SETREGID
X#ifdef HAS_SETRESGID
X#define setregid(r,e) setresgid(r,e,-1)
X#define HAS_SETREGID
X#endif
X#endif
!STUFFY!FUNK!
echo Extracting patchlevel.h
sed >patchlevel.h <<'!STUFFY!FUNK!' -e 's/X//'
X#define PATCHLEVEL 3
!STUFFY!FUNK!
echo " "
echo "End of kit 19 (of 36)"
cat /dev/null >kit19isdone
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 25 26 27 28 29 30 31 32 33 34 35 36; 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."
for combo in *:AA; do
if test -f "$combo"; then
realfile=`basename $combo :AA`
cat $realfile:[A-Z][A-Z] >$realfile
rm -rf $realfile:[A-Z][A-Z]
fi
done
rm -rf kit*isdone
chmod 755 Configure
;;
*) echo "You have run$run."
echo "You still need to run$todo."
;;
esac
: Someone might mail this, so...
exit
exit 0 # Just in case...
--
Kent Landfield INTERNET: kent@sparky.IMD.Sterling.COM
Sterling Software, IMD UUCP: uunet!sparky!kent
Phone: (402) 291-8300 FAX: (402) 291-4362
Please send comp.sources.misc-related mail to kent@uunet.uu.net.