lwall@netlabs.com (Larry Wall) (04/17/91)
Submitted-by: Larry Wall <lwall@netlabs.com>
Posting-number: Volume 18, Issue 38
Archive-name: perl/part20
[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 20 (of 36). If kit 20 is complete, the line"
echo '"'"End of kit 20 (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 consarg.c
sed >consarg.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $RCSfile: consarg.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:38:34 $
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: consarg.c,v $
X * Revision 4.0.1.1 91/04/11 17:38:34 lwall
X * patch1: fixed "Bad free" error
X *
X * Revision 4.0 91/03/20 01:06:15 lwall
X * 4.0 baseline.
X *
X */
X
X#include "EXTERN.h"
X#include "perl.h"
Xstatic int nothing_in_common();
Xstatic int arg_common();
Xstatic int spat_common();
X
XARG *
Xmake_split(stab,arg,limarg)
Xregister STAB *stab;
Xregister ARG *arg;
XARG *limarg;
X{
X register SPAT *spat;
X
X if (arg->arg_type != O_MATCH) {
X Newz(201,spat,1,SPAT);
X spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
X curstash->tbl_spatroot = spat;
X
X spat->spat_runtime = arg;
X arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
X }
X Renew(arg,4,ARG);
X arg->arg_len = 3;
X if (limarg) {
X if (limarg->arg_type == O_ITEM) {
X Copy(limarg+1,arg+3,1,ARG);
X limarg[1].arg_type = A_NULL;
X arg_free(limarg);
X }
X else {
X arg[3].arg_flags = 0;
X arg[3].arg_type = A_EXPR;
X arg[3].arg_ptr.arg_arg = limarg;
X }
X }
X else
X arg[3].arg_type = A_NULL;
X arg->arg_type = O_SPLIT;
X spat = arg[2].arg_ptr.arg_spat;
X spat->spat_repl = stab2arg(A_STAB,aadd(stab));
X if (spat->spat_short) { /* exact match can bypass regexec() */
X if (!((spat->spat_flags & SPAT_SCANFIRST) &&
X (spat->spat_flags & SPAT_ALL) )) {
X str_free(spat->spat_short);
X spat->spat_short = Nullstr;
X }
X }
X return arg;
X}
X
XARG *
Xmod_match(type,left,pat)
Xregister ARG *left;
Xregister ARG *pat;
X{
X
X register SPAT *spat;
X register ARG *newarg;
X
X if (!pat)
X return Nullarg;
X
X if ((pat->arg_type == O_MATCH ||
X pat->arg_type == O_SUBST ||
X pat->arg_type == O_TRANS ||
X pat->arg_type == O_SPLIT
X ) &&
X pat[1].arg_ptr.arg_stab == defstab ) {
X switch (pat->arg_type) {
X case O_MATCH:
X newarg = make_op(type == O_MATCH ? O_MATCH : O_NMATCH,
X pat->arg_len,
X left,Nullarg,Nullarg);
X break;
X case O_SUBST:
X newarg = l(make_op(type == O_MATCH ? O_SUBST : O_NSUBST,
X pat->arg_len,
X left,Nullarg,Nullarg));
X break;
X case O_TRANS:
X newarg = l(make_op(type == O_MATCH ? O_TRANS : O_NTRANS,
X pat->arg_len,
X left,Nullarg,Nullarg));
X break;
X case O_SPLIT:
X newarg = make_op(type == O_MATCH ? O_SPLIT : O_SPLIT,
X pat->arg_len,
X left,Nullarg,Nullarg);
X break;
X }
X if (pat->arg_len >= 2) {
X newarg[2].arg_type = pat[2].arg_type;
X newarg[2].arg_ptr = pat[2].arg_ptr;
X newarg[2].arg_len = pat[2].arg_len;
X newarg[2].arg_flags = pat[2].arg_flags;
X if (pat->arg_len >= 3) {
X newarg[3].arg_type = pat[3].arg_type;
X newarg[3].arg_ptr = pat[3].arg_ptr;
X newarg[3].arg_len = pat[3].arg_len;
X newarg[3].arg_flags = pat[3].arg_flags;
X }
X }
X free_arg(pat);
X }
X else {
X Newz(202,spat,1,SPAT);
X spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
X curstash->tbl_spatroot = spat;
X
X spat->spat_runtime = pat;
X newarg = make_op(type,2,left,Nullarg,Nullarg);
X newarg[2].arg_type = A_SPAT | A_DONT;
X newarg[2].arg_ptr.arg_spat = spat;
X }
X
X return newarg;
X}
X
XARG *
Xmake_op(type,newlen,arg1,arg2,arg3)
Xint type;
Xint newlen;
XARG *arg1;
XARG *arg2;
XARG *arg3;
X{
X register ARG *arg;
X register ARG *chld;
X register unsigned doarg;
X register int i;
X extern ARG *arg4; /* should be normal arguments, really */
X extern ARG *arg5;
X
X arg = op_new(newlen);
X arg->arg_type = type;
X if (chld = arg1) {
X if (chld->arg_type == O_ITEM &&
X (hoistable[ i = (chld[1].arg_type&A_MASK)] || i == A_LVAL ||
X (i == A_LEXPR &&
X (chld[1].arg_ptr.arg_arg->arg_type == O_LIST ||
X chld[1].arg_ptr.arg_arg->arg_type == O_ARRAY ||
X chld[1].arg_ptr.arg_arg->arg_type == O_HASH ))))
X {
X arg[1].arg_type = chld[1].arg_type;
X arg[1].arg_ptr = chld[1].arg_ptr;
X arg[1].arg_flags |= chld[1].arg_flags;
X arg[1].arg_len = chld[1].arg_len;
X free_arg(chld);
X }
X else {
X arg[1].arg_type = A_EXPR;
X arg[1].arg_ptr.arg_arg = chld;
X }
X }
X if (chld = arg2) {
X if (chld->arg_type == O_ITEM &&
X (hoistable[chld[1].arg_type&A_MASK] ||
X (type == O_ASSIGN &&
X ((chld[1].arg_type == A_READ && !(arg[1].arg_type & A_DONT))
X ||
X (chld[1].arg_type == A_INDREAD && !(arg[1].arg_type & A_DONT))
X ||
X (chld[1].arg_type == A_GLOB && !(arg[1].arg_type & A_DONT))
X ) ) ) ) {
X arg[2].arg_type = chld[1].arg_type;
X arg[2].arg_ptr = chld[1].arg_ptr;
X arg[2].arg_len = chld[1].arg_len;
X free_arg(chld);
X }
X else {
X arg[2].arg_type = A_EXPR;
X arg[2].arg_ptr.arg_arg = chld;
X }
X }
X if (chld = arg3) {
X if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
X arg[3].arg_type = chld[1].arg_type;
X arg[3].arg_ptr = chld[1].arg_ptr;
X arg[3].arg_len = chld[1].arg_len;
X free_arg(chld);
X }
X else {
X arg[3].arg_type = A_EXPR;
X arg[3].arg_ptr.arg_arg = chld;
X }
X }
X if (newlen >= 4 && (chld = arg4)) {
X if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
X arg[4].arg_type = chld[1].arg_type;
X arg[4].arg_ptr = chld[1].arg_ptr;
X arg[4].arg_len = chld[1].arg_len;
X free_arg(chld);
X }
X else {
X arg[4].arg_type = A_EXPR;
X arg[4].arg_ptr.arg_arg = chld;
X }
X }
X if (newlen >= 5 && (chld = arg5)) {
X if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
X arg[5].arg_type = chld[1].arg_type;
X arg[5].arg_ptr = chld[1].arg_ptr;
X arg[5].arg_len = chld[1].arg_len;
X free_arg(chld);
X }
X else {
X arg[5].arg_type = A_EXPR;
X arg[5].arg_ptr.arg_arg = chld;
X }
X }
X doarg = opargs[type];
X for (i = 1; i <= newlen; ++i) {
X if (!(doarg & 1))
X arg[i].arg_type |= A_DONT;
X if (doarg & 2)
X arg[i].arg_flags |= AF_ARYOK;
X doarg >>= 2;
X }
X#ifdef DEBUGGING
X if (debug & 16) {
X fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]);
X if (arg1)
X fprintf(stderr,",%s=%lx",
X argname[arg[1].arg_type&A_MASK],arg[1].arg_ptr.arg_arg);
X if (arg2)
X fprintf(stderr,",%s=%lx",
X argname[arg[2].arg_type&A_MASK],arg[2].arg_ptr.arg_arg);
X if (arg3)
X fprintf(stderr,",%s=%lx",
X argname[arg[3].arg_type&A_MASK],arg[3].arg_ptr.arg_arg);
X if (newlen >= 4)
X fprintf(stderr,",%s=%lx",
X argname[arg[4].arg_type&A_MASK],arg[4].arg_ptr.arg_arg);
X if (newlen >= 5)
X fprintf(stderr,",%s=%lx",
X argname[arg[5].arg_type&A_MASK],arg[5].arg_ptr.arg_arg);
X fprintf(stderr,")\n");
X }
X#endif
X evalstatic(arg); /* see if we can consolidate anything */
X return arg;
X}
X
Xvoid
Xevalstatic(arg)
Xregister ARG *arg;
X{
X register STR *str;
X register STR *s1;
X register STR *s2;
X double value; /* must not be register */
X register char *tmps;
X int i;
X unsigned long tmplong;
X long tmp2;
X double exp(), log(), sqrt(), modf();
X char *crypt();
X double sin(), cos(), atan2(), pow();
X
X if (!arg || !arg->arg_len)
X return;
X
X if ((arg[1].arg_type == A_SINGLE || arg->arg_type == O_AELEM) &&
X (arg->arg_len == 1 || arg[2].arg_type == A_SINGLE) ) {
X str = Str_new(20,0);
X s1 = arg[1].arg_ptr.arg_str;
X if (arg->arg_len > 1)
X s2 = arg[2].arg_ptr.arg_str;
X else
X s2 = Nullstr;
X switch (arg->arg_type) {
X case O_AELEM:
X i = (int)str_gnum(s2);
X if (i < 32767 && i >= 0) {
X arg->arg_type = O_ITEM;
X arg->arg_len = 1;
X arg[1].arg_type = A_ARYSTAB; /* $abc[123] is hoistable now */
X arg[1].arg_len = i;
X str_free(s2);
X arg[2].arg_type = A_NULL;
X arg[2].arg_ptr.arg_str = Nullstr;
X }
X /* FALL THROUGH */
X default:
X str_free(str);
X str = Nullstr; /* can't be evaluated yet */
X break;
X case O_CONCAT:
X str_sset(str,s1);
X str_scat(str,s2);
X break;
X case O_REPEAT:
X i = (int)str_gnum(s2);
X tmps = str_get(s1);
X str_nset(str,"",0);
X STR_GROW(str, i * s1->str_cur + 1);
X repeatcpy(str->str_ptr, tmps, s1->str_cur, i);
X str->str_cur = i * s1->str_cur;
X str->str_ptr[str->str_cur] = '\0';
X break;
X case O_MULTIPLY:
X value = str_gnum(s1);
X str_numset(str,value * str_gnum(s2));
X break;
X case O_DIVIDE:
X value = str_gnum(s2);
X if (value == 0.0)
X yyerror("Illegal division by constant zero");
X else
X#ifdef cray
X /* insure that 20./5. == 4. */
X {
X double x;
X int k;
X x = str_gnum(s1);
X if ((double)(int)x == x &&
X (double)(int)value == value &&
X (k = (int)x/(int)value)*(int)value == (int)x) {
X value = k;
X } else {
X value = x/value;
X }
X str_numset(str,value);
X }
X#else
X str_numset(str,str_gnum(s1) / value);
X#endif
X break;
X case O_MODULO:
X tmplong = (unsigned long)str_gnum(s2);
X if (tmplong == 0L) {
X yyerror("Illegal modulus of constant zero");
X break;
X }
X tmp2 = (long)str_gnum(s1);
X#ifndef lint
X if (tmp2 >= 0)
X str_numset(str,(double)(tmp2 % tmplong));
X else
X str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1));
X#else
X tmp2 = tmp2;
X#endif
X break;
X case O_ADD:
X value = str_gnum(s1);
X str_numset(str,value + str_gnum(s2));
X break;
X case O_SUBTRACT:
X value = str_gnum(s1);
X str_numset(str,value - str_gnum(s2));
X break;
X case O_LEFT_SHIFT:
X value = str_gnum(s1);
X i = (int)str_gnum(s2);
X#ifndef lint
X str_numset(str,(double)(((long)value) << i));
X#endif
X break;
X case O_RIGHT_SHIFT:
X value = str_gnum(s1);
X i = (int)str_gnum(s2);
X#ifndef lint
X str_numset(str,(double)(((long)value) >> i));
X#endif
X break;
X case O_LT:
X value = str_gnum(s1);
X str_numset(str,(value < str_gnum(s2)) ? 1.0 : 0.0);
X break;
X case O_GT:
X value = str_gnum(s1);
X str_numset(str,(value > str_gnum(s2)) ? 1.0 : 0.0);
X break;
X case O_LE:
X value = str_gnum(s1);
X str_numset(str,(value <= str_gnum(s2)) ? 1.0 : 0.0);
X break;
X case O_GE:
X value = str_gnum(s1);
X str_numset(str,(value >= str_gnum(s2)) ? 1.0 : 0.0);
X break;
X case O_EQ:
X if (dowarn) {
X if ((!s1->str_nok && !looks_like_number(s1)) ||
X (!s2->str_nok && !looks_like_number(s2)) )
X warn("Possible use of == on string value");
X }
X value = str_gnum(s1);
X str_numset(str,(value == str_gnum(s2)) ? 1.0 : 0.0);
X break;
X case O_NE:
X value = str_gnum(s1);
X str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0);
X break;
X case O_NCMP:
X value = str_gnum(s1);
X value -= str_gnum(s2);
X if (value > 0.0)
X value = 1.0;
X else if (value < 0.0)
X value = -1.0;
X str_numset(str,value);
X break;
X case O_BIT_AND:
X value = str_gnum(s1);
X#ifndef lint
X str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
X#endif
X break;
X case O_XOR:
X value = str_gnum(s1);
X#ifndef lint
X str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
X#endif
X break;
X case O_BIT_OR:
X value = str_gnum(s1);
X#ifndef lint
X str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
X#endif
X break;
X case O_AND:
X if (str_true(s1))
X str_sset(str,s2);
X else
X str_sset(str,s1);
X break;
X case O_OR:
X if (str_true(s1))
X str_sset(str,s1);
X else
X str_sset(str,s2);
X break;
X case O_COND_EXPR:
X if ((arg[3].arg_type & A_MASK) != A_SINGLE) {
X str_free(str);
X str = Nullstr;
X }
X else {
X if (str_true(s1))
X str_sset(str,s2);
X else
X str_sset(str,arg[3].arg_ptr.arg_str);
X str_free(arg[3].arg_ptr.arg_str);
X arg[3].arg_ptr.arg_str = Nullstr;
X }
X break;
X case O_NEGATE:
X str_numset(str,(double)(-str_gnum(s1)));
X break;
X case O_NOT:
X str_numset(str,(double)(!str_true(s1)));
X break;
X case O_COMPLEMENT:
X#ifndef lint
X str_numset(str,(double)(~U_L(str_gnum(s1))));
X#endif
X break;
X case O_SIN:
X str_numset(str,sin(str_gnum(s1)));
X break;
X case O_COS:
X str_numset(str,cos(str_gnum(s1)));
X break;
X case O_ATAN2:
X value = str_gnum(s1);
X str_numset(str,atan2(value, str_gnum(s2)));
X break;
X case O_POW:
X value = str_gnum(s1);
X str_numset(str,pow(value, str_gnum(s2)));
X break;
X case O_LENGTH:
X str_numset(str, (double)str_len(s1));
X break;
X case O_SLT:
X str_numset(str,(double)(str_cmp(s1,s2) < 0));
X break;
X case O_SGT:
X str_numset(str,(double)(str_cmp(s1,s2) > 0));
X break;
X case O_SLE:
X str_numset(str,(double)(str_cmp(s1,s2) <= 0));
X break;
X case O_SGE:
X str_numset(str,(double)(str_cmp(s1,s2) >= 0));
X break;
X case O_SEQ:
X str_numset(str,(double)(str_eq(s1,s2)));
X break;
X case O_SNE:
X str_numset(str,(double)(!str_eq(s1,s2)));
X break;
X case O_SCMP:
X str_numset(str,(double)(str_cmp(s1,s2)));
X break;
X case O_CRYPT:
X#ifdef HAS_CRYPT
X tmps = str_get(s1);
X str_set(str,crypt(tmps,str_get(s2)));
X#else
X yyerror(
X "The crypt() function is unimplemented due to excessive paranoia.");
X#endif
X break;
X case O_EXP:
X str_numset(str,exp(str_gnum(s1)));
X break;
X case O_LOG:
X str_numset(str,log(str_gnum(s1)));
X break;
X case O_SQRT:
X str_numset(str,sqrt(str_gnum(s1)));
X break;
X case O_INT:
X value = str_gnum(s1);
X if (value >= 0.0)
X (void)modf(value,&value);
X else {
X (void)modf(-value,&value);
X value = -value;
X }
X str_numset(str,value);
X break;
X case O_ORD:
X#ifndef I286
X str_numset(str,(double)(*str_get(s1)));
X#else
X {
X int zapc;
X char *zaps;
X
X zaps = str_get(s1);
X zapc = (int) *zaps;
X str_numset(str,(double)(zapc));
X }
X#endif
X break;
X }
X if (str) {
X arg->arg_type = O_ITEM; /* note arg1 type is already SINGLE */
X str_free(s1);
X arg[1].arg_ptr.arg_str = str;
X if (s2) {
X str_free(s2);
X arg[2].arg_ptr.arg_str = Nullstr;
X arg[2].arg_type = A_NULL;
X }
X }
X }
X}
X
XARG *
Xl(arg)
Xregister ARG *arg;
X{
X register int i;
X register ARG *arg1;
X register ARG *arg2;
X SPAT *spat;
X int arghog = 0;
X
X i = arg[1].arg_type & A_MASK;
X
X arg->arg_flags |= AF_COMMON; /* assume something in common */
X /* which forces us to copy things */
X
X if (i == A_ARYLEN) {
X arg[1].arg_type = A_LARYLEN;
X return arg;
X }
X if (i == A_ARYSTAB) {
X arg[1].arg_type = A_LARYSTAB;
X return arg;
X }
X
X /* see if it's an array reference */
X
X if (i == A_EXPR || i == A_LEXPR) {
X arg1 = arg[1].arg_ptr.arg_arg;
X
X if (arg1->arg_type == O_LIST || arg1->arg_type == O_ITEM) {
X /* assign to list */
X if (arg->arg_len > 1) {
X dehoist(arg,2);
X arg2 = arg[2].arg_ptr.arg_arg;
X if (nothing_in_common(arg1,arg2))
X arg->arg_flags &= ~AF_COMMON;
X if (arg->arg_type == O_ASSIGN) {
X if (arg1->arg_flags & AF_LOCAL)
X arg->arg_flags |= AF_LOCAL;
X arg[1].arg_flags |= AF_ARYOK;
X arg[2].arg_flags |= AF_ARYOK;
X }
X }
X else if (arg->arg_type != O_CHOP)
X arg->arg_type = O_ASSIGN; /* possible local(); */
X for (i = arg1->arg_len; i >= 1; i--) {
X switch (arg1[i].arg_type) {
X case A_STAR: case A_LSTAR:
X arg1[i].arg_type = A_LSTAR;
X break;
X case A_STAB: case A_LVAL:
X arg1[i].arg_type = A_LVAL;
X break;
X case A_ARYLEN: case A_LARYLEN:
X arg1[i].arg_type = A_LARYLEN;
X break;
X case A_ARYSTAB: case A_LARYSTAB:
X arg1[i].arg_type = A_LARYSTAB;
X break;
X case A_EXPR: case A_LEXPR:
X arg1[i].arg_type = A_LEXPR;
X switch(arg1[i].arg_ptr.arg_arg->arg_type) {
X case O_ARRAY: case O_LARRAY:
X arg1[i].arg_ptr.arg_arg->arg_type = O_LARRAY;
X arghog = 1;
X break;
X case O_AELEM: case O_LAELEM:
X arg1[i].arg_ptr.arg_arg->arg_type = O_LAELEM;
X break;
X case O_HASH: case O_LHASH:
X arg1[i].arg_ptr.arg_arg->arg_type = O_LHASH;
X arghog = 1;
X break;
X case O_HELEM: case O_LHELEM:
X arg1[i].arg_ptr.arg_arg->arg_type = O_LHELEM;
X break;
X case O_ASLICE: case O_LASLICE:
X arg1[i].arg_ptr.arg_arg->arg_type = O_LASLICE;
X break;
X case O_HSLICE: case O_LHSLICE:
X arg1[i].arg_ptr.arg_arg->arg_type = O_LHSLICE;
X break;
X default:
X goto ill_item;
X }
X break;
X default:
X ill_item:
X (void)sprintf(tokenbuf, "Illegal item (%s) as lvalue",
X argname[arg1[i].arg_type&A_MASK]);
X yyerror(tokenbuf);
X }
X }
X if (arg->arg_len > 1) {
X if (arg2->arg_type == O_SPLIT && !arg2[3].arg_type && !arghog) {
X arg2[3].arg_type = A_SINGLE;
X arg2[3].arg_ptr.arg_str =
X str_nmake((double)arg1->arg_len + 1); /* limit split len*/
X }
X }
X }
X else if (arg1->arg_type == O_AELEM || arg1->arg_type == O_LAELEM)
X if (arg->arg_type == O_DEFINED)
X arg1->arg_type = O_AELEM;
X else
X arg1->arg_type = O_LAELEM;
X else if (arg1->arg_type == O_ARRAY || arg1->arg_type == O_LARRAY) {
X arg1->arg_type = O_LARRAY;
X if (arg->arg_len > 1) {
X dehoist(arg,2);
X arg2 = arg[2].arg_ptr.arg_arg;
X if (arg2->arg_type == O_SPLIT) { /* use split's builtin =?*/
X spat = arg2[2].arg_ptr.arg_spat;
X if (!(spat->spat_flags & SPAT_ONCE) &&
X nothing_in_common(arg1,spat->spat_repl)) {
X spat->spat_repl[1].arg_ptr.arg_stab =
X arg1[1].arg_ptr.arg_stab;
X arg1[1].arg_ptr.arg_stab = Nullstab;
X spat->spat_flags |= SPAT_ONCE;
X arg_free(arg1); /* recursive */
X arg[1].arg_ptr.arg_arg = Nullarg;
X free_arg(arg); /* non-recursive */
X return arg2; /* split has builtin assign */
X }
X }
X else if (nothing_in_common(arg1,arg2))
X arg->arg_flags &= ~AF_COMMON;
X if (arg->arg_type == O_ASSIGN) {
X arg[1].arg_flags |= AF_ARYOK;
X arg[2].arg_flags |= AF_ARYOK;
X }
X }
X else if (arg->arg_type == O_ASSIGN)
X arg[1].arg_flags |= AF_ARYOK;
X }
X else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
X if (arg->arg_type == O_DEFINED)
X arg1->arg_type = O_HELEM; /* avoid creating one */
X else
X arg1->arg_type = O_LHELEM;
X else if (arg1->arg_type == O_HASH || arg1->arg_type == O_LHASH) {
X arg1->arg_type = O_LHASH;
X if (arg->arg_len > 1) {
X dehoist(arg,2);
X arg2 = arg[2].arg_ptr.arg_arg;
X if (nothing_in_common(arg1,arg2))
X arg->arg_flags &= ~AF_COMMON;
X if (arg->arg_type == O_ASSIGN) {
X arg[1].arg_flags |= AF_ARYOK;
X arg[2].arg_flags |= AF_ARYOK;
X }
X }
X else if (arg->arg_type == O_ASSIGN)
X arg[1].arg_flags |= AF_ARYOK;
X }
X else if (arg1->arg_type == O_ASLICE) {
X arg1->arg_type = O_LASLICE;
X if (arg->arg_type == O_ASSIGN) {
X dehoist(arg,2);
X arg[1].arg_flags |= AF_ARYOK;
X arg[2].arg_flags |= AF_ARYOK;
X }
X }
X else if (arg1->arg_type == O_HSLICE) {
X arg1->arg_type = O_LHSLICE;
X if (arg->arg_type == O_ASSIGN) {
X dehoist(arg,2);
X arg[1].arg_flags |= AF_ARYOK;
X arg[2].arg_flags |= AF_ARYOK;
X }
X }
X else if ((arg->arg_type == O_DEFINED || arg->arg_type == O_UNDEF) &&
X (arg1->arg_type == (perldb ? O_DBSUBR : O_SUBR)) ) {
X arg[1].arg_type |= A_DONT;
X }
X else if (arg1->arg_type == O_SUBSTR || arg1->arg_type == O_VEC) {
X (void)l(arg1);
X Renewc(arg1->arg_ptr.arg_str, 1, struct lstring, STR);
X /* grow string struct to hold an lstring struct */
X }
X else if (arg1->arg_type == O_ASSIGN) {
X/* if (arg->arg_type == O_CHOP)
X arg[1].arg_flags &= ~AF_ARYOK; /* grandfather chop idiom */
X }
X else {
X (void)sprintf(tokenbuf,
X "Illegal expression (%s) as lvalue",opname[arg1->arg_type]);
X yyerror(tokenbuf);
X }
X arg[1].arg_type = A_LEXPR | (arg[1].arg_type & A_DONT);
X if (arg->arg_type == O_ASSIGN && (arg1[1].arg_flags & AF_ARYOK)) {
X arg[1].arg_flags |= AF_ARYOK;
X if (arg->arg_len > 1)
X arg[2].arg_flags |= AF_ARYOK;
X }
X#ifdef DEBUGGING
X if (debug & 16)
X fprintf(stderr,"lval LEXPR\n");
X#endif
X return arg;
X }
X if (i == A_STAR || i == A_LSTAR) {
X arg[1].arg_type = A_LSTAR | (arg[1].arg_type & A_DONT);
X return arg;
X }
X
X /* not an array reference, should be a register name */
X
X if (i != A_STAB && i != A_LVAL) {
X (void)sprintf(tokenbuf,
X "Illegal item (%s) as lvalue",argname[arg[1].arg_type&A_MASK]);
X yyerror(tokenbuf);
X }
X arg[1].arg_type = A_LVAL | (arg[1].arg_type & A_DONT);
X#ifdef DEBUGGING
X if (debug & 16)
X fprintf(stderr,"lval LVAL\n");
X#endif
X return arg;
X}
X
XARG *
Xfixl(type,arg)
Xint type;
XARG *arg;
X{
X if (type == O_DEFINED || type == O_UNDEF) {
X if (arg->arg_type != O_ITEM)
X arg = hide_ary(arg);
X if (arg->arg_type == O_ITEM) {
X type = arg[1].arg_type & A_MASK;
X if (type == A_EXPR || type == A_LEXPR)
X arg[1].arg_type = A_LEXPR|A_DONT;
X }
X }
X return arg;
X}
X
Xdehoist(arg,i)
XARG *arg;
X{
X ARG *tmparg;
X
X if (arg[i].arg_type != A_EXPR) { /* dehoist */
X tmparg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg);
X tmparg[1] = arg[i];
X arg[i].arg_ptr.arg_arg = tmparg;
X arg[i].arg_type = A_EXPR;
X }
X}
X
XARG *
Xaddflags(i,flags,arg)
Xregister ARG *arg;
X{
X arg[i].arg_flags |= flags;
X return arg;
X}
X
XARG *
Xhide_ary(arg)
XARG *arg;
X{
X if (arg->arg_type == O_ARRAY || arg->arg_type == O_HASH)
X return make_op(O_ITEM,1,arg,Nullarg,Nullarg);
X return arg;
X}
X
X/* maybe do a join on multiple array dimensions */
X
XARG *
Xjmaybe(arg)
Xregister ARG *arg;
X{
X if (arg && arg->arg_type == O_COMMA) {
X arg = listish(arg);
X arg = make_op(O_JOIN, 2,
X stab2arg(A_STAB,stabent(";",TRUE)),
X make_list(arg),
X Nullarg);
X }
X return arg;
X}
X
XARG *
Xmake_list(arg)
Xregister ARG *arg;
X{
X register int i;
X register ARG *node;
X register ARG *nxtnode;
X register int j;
X STR *tmpstr;
X
X if (!arg) {
X arg = op_new(0);
X arg->arg_type = O_LIST;
X }
X if (arg->arg_type != O_COMMA) {
X if (arg->arg_type != O_ARRAY)
X arg->arg_flags |= AF_LISTISH; /* see listish() below */
X arg->arg_flags |= AF_LISTISH; /* see listish() below */
X return arg;
X }
X for (i = 2, node = arg; ; i++) {
X if (node->arg_len < 2)
X break;
X if (node[1].arg_type != A_EXPR)
X break;
X node = node[1].arg_ptr.arg_arg;
X if (node->arg_type != O_COMMA)
X break;
X }
X if (i > 2) {
X node = arg;
X arg = op_new(i);
X tmpstr = arg->arg_ptr.arg_str;
X#ifdef STRUCTCOPY
X *arg = *node; /* copy everything except the STR */
X#else
X (void)bcopy((char *)node, (char *)arg, sizeof(ARG));
X#endif
X arg->arg_ptr.arg_str = tmpstr;
X for (j = i; ; ) {
X#ifdef STRUCTCOPY
X arg[j] = node[2];
X#else
X (void)bcopy((char *)(node+2), (char *)(arg+j), sizeof(ARG));
X#endif
X arg[j].arg_flags |= AF_ARYOK;
X --j; /* Bug in Xenix compiler */
X if (j < 2) {
X#ifdef STRUCTCOPY
X arg[1] = node[1];
X#else
X (void)bcopy((char *)(node+1), (char *)(arg+1), sizeof(ARG));
X#endif
X free_arg(node);
X break;
X }
X nxtnode = node[1].arg_ptr.arg_arg;
X free_arg(node);
X node = nxtnode;
X }
X }
X arg[1].arg_flags |= AF_ARYOK;
X arg[2].arg_flags |= AF_ARYOK;
X arg->arg_type = O_LIST;
X arg->arg_len = i;
X return arg;
X}
X
X/* turn a single item into a list */
X
XARG *
Xlistish(arg)
XARG *arg;
X{
X if (arg->arg_flags & AF_LISTISH)
X arg = make_op(O_LIST,1,arg,Nullarg,Nullarg);
X return arg;
X}
X
XARG *
Xmaybelistish(optype, arg)
Xint optype;
XARG *arg;
X{
X ARG *tmparg = arg;
X
X if (optype == O_RETURN && arg->arg_type == O_ITEM &&
X arg[1].arg_type == A_EXPR && (tmparg = arg[1].arg_ptr.arg_arg) &&
X ((tmparg->arg_flags & AF_LISTISH) || (tmparg->arg_type == O_ARRAY) )) {
X tmparg = listish(tmparg);
X free_arg(arg);
X arg = tmparg;
X }
X else if (optype == O_PRTF ||
X (arg->arg_type == O_ASLICE || arg->arg_type == O_HSLICE ||
X arg->arg_type == O_F_OR_R) )
X arg = listish(arg);
X return arg;
X}
X
X/* mark list of local variables */
X
XARG *
Xlocalize(arg)
XARG *arg;
X{
X arg->arg_flags |= AF_LOCAL;
X return arg;
X}
X
XARG *
Xrcatmaybe(arg)
XARG *arg;
X{
X ARG *arg2;
X
X if (arg->arg_type == O_CONCAT && arg[2].arg_type == A_EXPR) {
X arg2 = arg[2].arg_ptr.arg_arg;
X if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
X arg->arg_type = O_RCAT;
X arg[2].arg_type = arg2[1].arg_type;
X arg[2].arg_ptr = arg2[1].arg_ptr;
X free_arg(arg2);
X }
X }
X return arg;
X}
X
XARG *
Xstab2arg(atype,stab)
Xint atype;
Xregister STAB *stab;
X{
X register ARG *arg;
X
X arg = op_new(1);
X arg->arg_type = O_ITEM;
X arg[1].arg_type = atype;
X arg[1].arg_ptr.arg_stab = stab;
X return arg;
X}
X
XARG *
Xcval_to_arg(cval)
Xregister char *cval;
X{
X register ARG *arg;
X
X arg = op_new(1);
X arg->arg_type = O_ITEM;
X arg[1].arg_type = A_SINGLE;
X arg[1].arg_ptr.arg_str = str_make(cval,0);
X Safefree(cval);
X return arg;
X}
X
XARG *
Xop_new(numargs)
Xint numargs;
X{
X register ARG *arg;
X
X Newz(203,arg, numargs + 1, ARG);
X arg->arg_ptr.arg_str = Str_new(21,0);
X arg->arg_len = numargs;
X return arg;
X}
X
Xvoid
Xfree_arg(arg)
XARG *arg;
X{
X str_free(arg->arg_ptr.arg_str);
X Safefree(arg);
X}
X
XARG *
Xmake_match(type,expr,spat)
Xint type;
XARG *expr;
XSPAT *spat;
X{
X register ARG *arg;
X
X arg = make_op(type,2,expr,Nullarg,Nullarg);
X
X arg[2].arg_type = A_SPAT|A_DONT;
X arg[2].arg_ptr.arg_spat = spat;
X#ifdef DEBUGGING
X if (debug & 16)
X fprintf(stderr,"make_match SPAT=%lx\n",(long)spat);
X#endif
X
X if (type == O_SUBST || type == O_NSUBST) {
X if (arg[1].arg_type != A_STAB) {
X yyerror("Illegal lvalue");
X }
X arg[1].arg_type = A_LVAL;
X }
X return arg;
X}
X
XARG *
Xcmd_to_arg(cmd)
XCMD *cmd;
X{
X register ARG *arg;
X
X arg = op_new(1);
X arg->arg_type = O_ITEM;
X arg[1].arg_type = A_CMD;
X arg[1].arg_ptr.arg_cmd = cmd;
X return arg;
X}
X
X/* Check two expressions to see if there is any identifier in common */
X
Xstatic int
Xnothing_in_common(arg1,arg2)
XARG *arg1;
XARG *arg2;
X{
X static int thisexpr = 0; /* I don't care if this wraps */
X
X thisexpr++;
X if (arg_common(arg1,thisexpr,1))
X return 0; /* hit eval or do {} */
X stab_lastexpr(defstab) = thisexpr; /* pretend to hit @_ */
X if (arg_common(arg2,thisexpr,0))
X return 0; /* hit identifier again */
X return 1;
X}
X
X/* Recursively descend an expression and mark any identifier or check
X * it to see if it was marked already.
X */
X
Xstatic int
Xarg_common(arg,exprnum,marking)
Xregister ARG *arg;
Xint exprnum;
Xint marking;
X{
X register int i;
X
X if (!arg)
X return 0;
X for (i = arg->arg_len; i >= 1; i--) {
X switch (arg[i].arg_type & A_MASK) {
X case A_NULL:
X break;
X case A_LEXPR:
X case A_EXPR:
X if (arg_common(arg[i].arg_ptr.arg_arg,exprnum,marking))
X return 1;
X break;
X case A_CMD:
X return 1; /* assume hanky panky */
X case A_STAR:
X case A_LSTAR:
X case A_STAB:
X case A_LVAL:
X case A_ARYLEN:
X case A_LARYLEN:
X if (marking)
X stab_lastexpr(arg[i].arg_ptr.arg_stab) = exprnum;
X else if (stab_lastexpr(arg[i].arg_ptr.arg_stab) == exprnum)
X return 1;
X break;
X case A_DOUBLE:
X case A_BACKTICK:
X {
X register char *s = arg[i].arg_ptr.arg_str->str_ptr;
X register char *send = s + arg[i].arg_ptr.arg_str->str_cur;
X register STAB *stab;
X
X while (*s) {
X if (*s == '$' && s[1]) {
X s = scanident(s,send,tokenbuf);
X stab = stabent(tokenbuf,TRUE);
X if (marking)
X stab_lastexpr(stab) = exprnum;
X else if (stab_lastexpr(stab) == exprnum)
X return 1;
X continue;
X }
X else if (*s == '\\' && s[1])
X s++;
X s++;
X }
X }
X break;
X case A_SPAT:
X if (spat_common(arg[i].arg_ptr.arg_spat,exprnum,marking))
X return 1;
X break;
X case A_READ:
X case A_INDREAD:
X case A_GLOB:
X case A_WORD:
X case A_SINGLE:
X break;
X }
X }
X switch (arg->arg_type) {
X case O_ARRAY:
X case O_LARRAY:
X if ((arg[1].arg_type & A_MASK) == A_STAB)
X (void)aadd(arg[1].arg_ptr.arg_stab);
X break;
X case O_HASH:
X case O_LHASH:
X if ((arg[1].arg_type & A_MASK) == A_STAB)
X (void)hadd(arg[1].arg_ptr.arg_stab);
X break;
X case O_EVAL:
X case O_SUBR:
X case O_DBSUBR:
X return 1;
X }
X return 0;
X}
X
Xstatic int
Xspat_common(spat,exprnum,marking)
Xregister SPAT *spat;
Xint exprnum;
Xint marking;
X{
X if (spat->spat_runtime)
X if (arg_common(spat->spat_runtime,exprnum,marking))
X return 1;
X if (spat->spat_repl) {
X if (arg_common(spat->spat_repl,exprnum,marking))
X return 1;
X }
X return 0;
X}
!STUFFY!FUNK!
echo Extracting arg.h
sed >arg.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: arg.h,v 4.0 91/03/20 01:03:09 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: arg.h,v $
X * Revision 4.0 91/03/20 01:03:09 lwall
X * 4.0 baseline.
X *
X */
X
X#define O_NULL 0
X#define O_RCAT 1
X#define O_ITEM 2
X#define O_SCALAR 3
X#define O_ITEM2 4
X#define O_ITEM3 5
X#define O_CONCAT 6
X#define O_REPEAT 7
X#define O_MATCH 8
X#define O_NMATCH 9
X#define O_SUBST 10
X#define O_NSUBST 11
X#define O_ASSIGN 12
X#define O_LOCAL 13
X#define O_AASSIGN 14
X#define O_SASSIGN 15
X#define O_CHOP 16
X#define O_DEFINED 17
X#define O_UNDEF 18
X#define O_STUDY 19
X#define O_POW 20
X#define O_MULTIPLY 21
X#define O_DIVIDE 22
X#define O_MODULO 23
X#define O_ADD 24
X#define O_SUBTRACT 25
X#define O_LEFT_SHIFT 26
X#define O_RIGHT_SHIFT 27
X#define O_LT 28
X#define O_GT 29
X#define O_LE 30
X#define O_GE 31
X#define O_EQ 32
X#define O_NE 33
X#define O_NCMP 34
X#define O_BIT_AND 35
X#define O_XOR 36
X#define O_BIT_OR 37
X#define O_AND 38
X#define O_OR 39
X#define O_COND_EXPR 40
X#define O_COMMA 41
X#define O_NEGATE 42
X#define O_NOT 43
X#define O_COMPLEMENT 44
X#define O_SELECT 45
X#define O_WRITE 46
X#define O_DBMOPEN 47
X#define O_DBMCLOSE 48
X#define O_OPEN 49
X#define O_TRANS 50
X#define O_NTRANS 51
X#define O_CLOSE 52
X#define O_EACH 53
X#define O_VALUES 54
X#define O_KEYS 55
X#define O_LARRAY 56
X#define O_ARRAY 57
X#define O_AELEM 58
X#define O_DELETE 59
X#define O_LHASH 60
X#define O_HASH 61
X#define O_HELEM 62
X#define O_LAELEM 63
X#define O_LHELEM 64
X#define O_LSLICE 65
X#define O_ASLICE 66
X#define O_HSLICE 67
X#define O_LASLICE 68
X#define O_LHSLICE 69
X#define O_SPLICE 70
X#define O_PUSH 71
X#define O_POP 72
X#define O_SHIFT 73
X#define O_UNPACK 74
X#define O_SPLIT 75
X#define O_LENGTH 76
X#define O_SPRINTF 77
X#define O_SUBSTR 78
X#define O_PACK 79
X#define O_GREP 80
X#define O_JOIN 81
X#define O_SLT 82
X#define O_SGT 83
X#define O_SLE 84
X#define O_SGE 85
X#define O_SEQ 86
X#define O_SNE 87
X#define O_SCMP 88
X#define O_SUBR 89
X#define O_DBSUBR 90
X#define O_CALLER 91
X#define O_SORT 92
X#define O_REVERSE 93
X#define O_WARN 94
X#define O_DIE 95
X#define O_PRTF 96
X#define O_PRINT 97
X#define O_CHDIR 98
X#define O_EXIT 99
X#define O_RESET 100
X#define O_LIST 101
X#define O_EOF 102
X#define O_GETC 103
X#define O_TELL 104
X#define O_RECV 105
X#define O_READ 106
X#define O_SYSREAD 107
X#define O_SYSWRITE 108
X#define O_SEND 109
X#define O_SEEK 110
X#define O_RETURN 111
X#define O_REDO 112
X#define O_NEXT 113
X#define O_LAST 114
X#define O_DUMP 115
X#define O_GOTO 116
X#define O_INDEX 117
X#define O_RINDEX 118
X#define O_TIME 119
X#define O_TMS 120
X#define O_LOCALTIME 121
X#define O_GMTIME 122
X#define O_TRUNCATE 123
X#define O_LSTAT 124
X#define O_STAT 125
X#define O_CRYPT 126
X#define O_ATAN2 127
X#define O_SIN 128
X#define O_COS 129
X#define O_RAND 130
X#define O_SRAND 131
X#define O_EXP 132
X#define O_LOG 133
X#define O_SQRT 134
X#define O_INT 135
X#define O_ORD 136
X#define O_ALARM 137
X#define O_SLEEP 138
X#define O_RANGE 139
X#define O_F_OR_R 140
X#define O_FLIP 141
X#define O_FLOP 142
X#define O_FORK 143
X#define O_WAIT 144
X#define O_WAITPID 145
X#define O_SYSTEM 146
X#define O_EXEC_OP 147
X#define O_HEX 148
X#define O_OCT 149
X#define O_CHOWN 150
X#define O_KILL 151
X#define O_UNLINK 152
X#define O_CHMOD 153
X#define O_UTIME 154
X#define O_UMASK 155
X#define O_MSGGET 156
X#define O_SHMGET 157
X#define O_SEMGET 158
X#define O_MSGCTL 159
X#define O_SHMCTL 160
X#define O_SEMCTL 161
X#define O_MSGSND 162
X#define O_MSGRCV 163
X#define O_SEMOP 164
X#define O_SHMREAD 165
X#define O_SHMWRITE 166
X#define O_RENAME 167
X#define O_LINK 168
X#define O_MKDIR 169
X#define O_RMDIR 170
X#define O_GETPPID 171
X#define O_GETPGRP 172
X#define O_SETPGRP 173
X#define O_GETPRIORITY 174
X#define O_SETPRIORITY 175
X#define O_CHROOT 176
X#define O_FCNTL 177
X#define O_IOCTL 178
X#define O_FLOCK 179
X#define O_UNSHIFT 180
X#define O_REQUIRE 181
X#define O_DOFILE 182
X#define O_EVAL 183
X#define O_FTRREAD 184
X#define O_FTRWRITE 185
X#define O_FTREXEC 186
X#define O_FTEREAD 187
X#define O_FTEWRITE 188
X#define O_FTEEXEC 189
X#define O_FTIS 190
X#define O_FTEOWNED 191
X#define O_FTROWNED 192
X#define O_FTZERO 193
X#define O_FTSIZE 194
X#define O_FTMTIME 195
X#define O_FTATIME 196
X#define O_FTCTIME 197
X#define O_FTSOCK 198
X#define O_FTCHR 199
X#define O_FTBLK 200
X#define O_FTFILE 201
X#define O_FTDIR 202
X#define O_FTPIPE 203
X#define O_FTLINK 204
X#define O_SYMLINK 205
X#define O_READLINK 206
X#define O_FTSUID 207
X#define O_FTSGID 208
X#define O_FTSVTX 209
X#define O_FTTTY 210
X#define O_FTTEXT 211
X#define O_FTBINARY 212
X#define O_SOCKET 213
X#define O_BIND 214
X#define O_CONNECT 215
X#define O_LISTEN 216
X#define O_ACCEPT 217
X#define O_GHBYNAME 218
X#define O_GHBYADDR 219
X#define O_GHOSTENT 220
X#define O_GNBYNAME 221
X#define O_GNBYADDR 222
X#define O_GNETENT 223
X#define O_GPBYNAME 224
X#define O_GPBYNUMBER 225
X#define O_GPROTOENT 226
X#define O_GSBYNAME 227
X#define O_GSBYPORT 228
X#define O_GSERVENT 229
X#define O_SHOSTENT 230
X#define O_SNETENT 231
X#define O_SPROTOENT 232
X#define O_SSERVENT 233
X#define O_EHOSTENT 234
X#define O_ENETENT 235
X#define O_EPROTOENT 236
X#define O_ESERVENT 237
X#define O_SOCKPAIR 238
X#define O_SHUTDOWN 239
X#define O_GSOCKOPT 240
X#define O_SSOCKOPT 241
X#define O_GETSOCKNAME 242
X#define O_GETPEERNAME 243
X#define O_SSELECT 244
X#define O_FILENO 245
X#define O_BINMODE 246
X#define O_VEC 247
X#define O_GPWNAM 248
X#define O_GPWUID 249
X#define O_GPWENT 250
X#define O_SPWENT 251
X#define O_EPWENT 252
X#define O_GGRNAM 253
X#define O_GGRGID 254
X#define O_GGRENT 255
X#define O_SGRENT 256
X#define O_EGRENT 257
X#define O_GETLOGIN 258
X#define O_OPENDIR 259
X#define O_READDIR 260
X#define O_TELLDIR 261
X#define O_SEEKDIR 262
X#define O_REWINDDIR 263
X#define O_CLOSEDIR 264
X#define O_SYSCALL 265
X#define O_PIPE 266
X#define MAXO 267
X
X#ifndef DOINIT
Xextern char *opname[];
X#else
Xchar *opname[] = {
X "NULL",
X "RCAT",
X "ITEM",
X "SCALAR",
X "ITEM2",
X "ITEM3",
X "CONCAT",
X "REPEAT",
X "MATCH",
X "NMATCH",
X "SUBST",
X "NSUBST",
X "ASSIGN",
X "LOCAL",
X "AASSIGN",
X "SASSIGN",
X "CHOP",
X "DEFINED",
X "UNDEF",
X "STUDY",
X "POW",
X "MULTIPLY",
X "DIVIDE",
X "MODULO",
X "ADD",
X "SUBTRACT",
X "LEFT_SHIFT",
X "RIGHT_SHIFT",
X "LT",
X "GT",
X "LE",
X "GE",
X "EQ",
X "NE",
X "NCMP",
X "BIT_AND",
X "XOR",
X "BIT_OR",
X "AND",
X "OR",
X "COND_EXPR",
X "COMMA",
X "NEGATE",
X "NOT",
X "COMPLEMENT",
X "SELECT",
X "WRITE",
X "DBMOPEN",
X "DBMCLOSE",
X "OPEN",
X "TRANS",
X "NTRANS",
X "CLOSE",
X "EACH",
X "VALUES",
X "KEYS",
X "LARRAY",
X "ARRAY",
X "AELEM",
X "DELETE",
X "LHASH",
X "HASH",
X "HELEM",
X "LAELEM",
X "LHELEM",
X "LSLICE",
X "ASLICE",
X "HSLICE",
X "LASLICE",
X "LHSLICE",
X "SPLICE",
X "PUSH",
X "POP",
X "SHIFT",
X "UNPACK",
X "SPLIT",
X "LENGTH",
X "SPRINTF",
X "SUBSTR",
X "PACK",
X "GREP",
X "JOIN",
X "SLT",
X "SGT",
X "SLE",
X "SGE",
X "SEQ",
X "SNE",
X "SCMP",
X "SUBR",
X "DBSUBR",
X "CALLER",
X "SORT",
X "REVERSE",
X "WARN",
X "DIE",
X "PRINTF",
X "PRINT",
X "CHDIR",
X "EXIT",
X "RESET",
X "LIST",
X "EOF",
X "GETC",
X "TELL",
X "RECV",
X "READ",
X "SYSREAD",
X "SYSWRITE",
X "SEND",
X "SEEK",
X "RETURN",
X "REDO",
X "NEXT",
X "LAST",
X "DUMP",
X "GOTO",/* shudder */
X "INDEX",
X "RINDEX",
X "TIME",
X "TIMES",
X "LOCALTIME",
X "GMTIME",
X "TRUNCATE",
X "LSTAT",
X "STAT",
X "CRYPT",
X "ATAN2",
X "SIN",
X "COS",
X "RAND",
X "SRAND",
X "EXP",
X "LOG",
X "SQRT",
X "INT",
X "ORD",
X "ALARM",
X "SLEEP",
X "RANGE",
X "FLIP_OR_RANGE",
X "FLIP",
X "FLOP",
X "FORK",
X "WAIT",
X "WAITPID",
X "SYSTEM",
X "EXEC",
X "HEX",
X "OCT",
X "CHOWN",
X "KILL",
X "UNLINK",
X "CHMOD",
X "UTIME",
X "UMASK",
X "MSGGET",
X "SHMGET",
X "SEMGET",
X "MSGCTL",
X "SHMCTL",
X "SEMCTL",
X "MSGSND",
X "MSGRCV",
X "SEMOP",
X "SHMREAD",
X "SHMWRITE",
X "RENAME",
X "LINK",
X "MKDIR",
X "RMDIR",
X "GETPPID",
X "GETPGRP",
X "SETPGRP",
X "GETPRIORITY",
X "SETPRIORITY",
X "CHROOT",
X "FCNTL",
X "SYSIOCTL",
X "FLOCK",
X "UNSHIFT",
X "REQUIRE",
X "DOFILE",
X "EVAL",
X "FTRREAD",
X "FTRWRITE",
X "FTREXEC",
X "FTEREAD",
X "FTEWRITE",
X "FTEEXEC",
X "FTIS",
X "FTEOWNED",
X "FTROWNED",
X "FTZERO",
X "FTSIZE",
X "FTMTIME",
X "FTATIME",
X "FTCTIME",
X "FTSOCK",
X "FTCHR",
X "FTBLK",
X "FTFILE",
X "FTDIR",
X "FTPIPE",
X "FTLINK",
X "SYMLINK",
X "READLINK",
X "FTSUID",
X "FTSGID",
X "FTSVTX",
X "FTTTY",
X "FTTEXT",
X "FTBINARY",
X "SOCKET",
X "BIND",
X "CONNECT",
X "LISTEN",
X "ACCEPT",
X "GHBYNAME",
X "GHBYADDR",
X "GHOSTENT",
X "GNBYNAME",
X "GNBYADDR",
X "GNETENT",
X "GPBYNAME",
X "GPBYNUMBER",
X "GPROTOENT",
X "GSBYNAME",
X "GSBYPORT",
X "GSERVENT",
X "SHOSTENT",
X "SNETENT",
X "SPROTOENT",
X "SSERVENT",
X "EHOSTENT",
X "ENETENT",
X "EPROTOENT",
X "ESERVENT",
X "SOCKPAIR",
X "SHUTDOWN",
X "GSOCKOPT",
X "SSOCKOPT",
X "GETSOCKNAME",
X "GETPEERNAME",
X "SSELECT",
X "FILENO",
X "BINMODE",
X "VEC",
X "GPWNAM",
X "GPWUID",
X "GPWENT",
X "SPWENT",
X "EPWENT",
X "GGRNAM",
X "GGRGID",
X "GGRENT",
X "SGRENT",
X "EGRENT",
X "GETLOGIN",
X "OPENDIR",
X "READDIR",
X "TELLDIR",
X "SEEKDIR",
X "REWINDDIR",
X "CLOSEDIR",
X "SYSCALL",
X "PIPE",
X "267"
X};
X#endif
X
X#define A_NULL 0
X#define A_EXPR 1
X#define A_CMD 2
X#define A_STAB 3
X#define A_LVAL 4
X#define A_SINGLE 5
X#define A_DOUBLE 6
X#define A_BACKTICK 7
X#define A_READ 8
X#define A_SPAT 9
X#define A_LEXPR 10
X#define A_ARYLEN 11
X#define A_ARYSTAB 12
X#define A_LARYLEN 13
X#define A_GLOB 14
X#define A_WORD 15
X#define A_INDREAD 16
X#define A_LARYSTAB 17
X#define A_STAR 18
X#define A_LSTAR 19
X#define A_WANTARRAY 20
X
X#define A_MASK 31
X#define A_DONT 32 /* or this into type to suppress evaluation */
X
X#ifndef DOINIT
Xextern char *argname[];
X#else
Xchar *argname[] = {
X "A_NULL",
X "EXPR",
X "CMD",
X "STAB",
X "LVAL",
X "SINGLE",
X "DOUBLE",
X "BACKTICK",
X "READ",
X "SPAT",
X "LEXPR",
X "ARYLEN",
X "ARYSTAB",
X "LARYLEN",
X "GLOB",
X "WORD",
X "INDREAD",
X "LARYSTAB",
X "STAR",
X "LSTAR",
X "WANTARRAY",
X "21"
X};
X#endif
X
X#ifndef DOINIT
Xextern bool hoistable[];
X#else
Xbool hoistable[] =
X {0, /* A_NULL */
X 0, /* EXPR */
X 1, /* CMD */
X 1, /* STAB */
X 0, /* LVAL */
X 1, /* SINGLE */
X 0, /* DOUBLE */
X 0, /* BACKTICK */
X 0, /* READ */
X 0, /* SPAT */
X 0, /* LEXPR */
X 1, /* ARYLEN */
X 1, /* ARYSTAB */
X 0, /* LARYLEN */
X 0, /* GLOB */
X 1, /* WORD */
X 0, /* INDREAD */
X 0, /* LARYSTAB */
X 1, /* STAR */
X 1, /* LSTAR */
X 1, /* WANTARRAY */
X 0, /* 21 */
X};
X#endif
X
Xunion argptr {
X ARG *arg_arg;
X char *arg_cval;
X STAB *arg_stab;
X SPAT *arg_spat;
X CMD *arg_cmd;
X STR *arg_str;
X HASH *arg_hash;
X};
X
Xstruct arg {
X union argptr arg_ptr;
X short arg_len;
X unsigned short arg_type;
X unsigned short arg_flags;
X};
X
X#define AF_ARYOK 1 /* op can handle multiple values here */
X#define AF_POST 2 /* post *crement this item */
X#define AF_PRE 4 /* pre *crement this item */
X#define AF_UP 8 /* increment rather than decrement */
X#define AF_COMMON 16 /* left and right have symbols in common */
X#define AF_DEPR 32 /* an older form of the construct */
X#define AF_LISTISH 64 /* turn into list if important */
X#define AF_LOCAL 128 /* list of local variables */
X
X/*
X * Most of the ARG pointers are used as pointers to arrays of ARG. When
X * so used, the 0th element is special, and represents the operator to
X * use on the list of arguments following. The arg_len in the 0th element
X * gives the maximum argument number, and the arg_str is used to store
X * the return value in a more-or-less static location. Sorry it's not
X * re-entrant (yet), but it sure makes it efficient. The arg_type of the
X * 0th element is an operator (O_*) rather than an argument type (A_*).
X */
X
X#define Nullarg Null(ARG*)
X
X#ifndef DOINIT
XEXT unsigned short opargs[MAXO+1];
X#else
X#define A(e1,e2,e3) (e1+(e2<<2)+(e3<<4))
X#define A5(e1,e2,e3,e4,e5) (e1+(e2<<2)+(e3<<4)+(e4<<6)+(e5<<8))
Xunsigned short opargs[MAXO+1] = {
X A(0,0,0), /* NULL */
X A(1,1,0), /* RCAT */
X A(1,0,0), /* ITEM */
X A(1,0,0), /* SCALAR */
X A(0,0,0), /* ITEM2 */
X A(0,0,0), /* ITEM3 */
X A(1,1,0), /* CONCAT */
X A(3,1,0), /* REPEAT */
X A(1,0,0), /* MATCH */
X A(1,0,0), /* NMATCH */
X A(1,0,0), /* SUBST */
X A(1,0,0), /* NSUBST */
X A(1,1,0), /* ASSIGN */
X A(1,0,0), /* LOCAL */
X A(3,3,0), /* AASSIGN */
X A(0,0,0), /* SASSIGN */
X A(3,0,0), /* CHOP */
X A(1,0,0), /* DEFINED */
X A(1,0,0), /* UNDEF */
X A(1,0,0), /* STUDY */
X A(1,1,0), /* POW */
X A(1,1,0), /* MULTIPLY */
X A(1,1,0), /* DIVIDE */
X A(1,1,0), /* MODULO */
X A(1,1,0), /* ADD */
X A(1,1,0), /* SUBTRACT */
X A(1,1,0), /* LEFT_SHIFT */
X A(1,1,0), /* RIGHT_SHIFT */
X A(1,1,0), /* LT */
X A(1,1,0), /* GT */
X A(1,1,0), /* LE */
X A(1,1,0), /* GE */
X A(1,1,0), /* EQ */
X A(1,1,0), /* NE */
X A(1,1,0), /* NCMP */
X A(1,1,0), /* BIT_AND */
X A(1,1,0), /* XOR */
X A(1,1,0), /* BIT_OR */
X A(1,0,0), /* AND */
X A(1,0,0), /* OR */
X A(1,0,0), /* COND_EXPR */
X A(1,1,0), /* COMMA */
X A(1,0,0), /* NEGATE */
X A(1,0,0), /* NOT */
X A(1,0,0), /* COMPLEMENT */
X A(1,0,0), /* SELECT */
X A(1,0,0), /* WRITE */
X A(1,1,1), /* DBMOPEN */
X A(1,0,0), /* DBMCLOSE */
X A(1,1,0), /* OPEN */
X A(1,0,0), /* TRANS */
X A(1,0,0), /* NTRANS */
X A(1,0,0), /* CLOSE */
X A(0,0,0), /* EACH */
X A(0,0,0), /* VALUES */
X A(0,0,0), /* KEYS */
X A(0,0,0), /* LARRAY */
X A(0,0,0), /* ARRAY */
X A(0,1,0), /* AELEM */
X A(0,1,0), /* DELETE */
X A(0,0,0), /* LHASH */
X A(0,0,0), /* HASH */
X A(0,1,0), /* HELEM */
X A(0,1,0), /* LAELEM */
X A(0,1,0), /* LHELEM */
X A(0,3,3), /* LSLICE */
X A(0,3,0), /* ASLICE */
X A(0,3,0), /* HSLICE */
X A(0,3,0), /* LASLICE */
X A(0,3,0), /* LHSLICE */
X A(0,3,1), /* SPLICE */
X A(0,3,0), /* PUSH */
X A(0,0,0), /* POP */
X A(0,0,0), /* SHIFT */
X A(1,1,0), /* UNPACK */
X A(1,0,1), /* SPLIT */
X A(1,0,0), /* LENGTH */
X A(3,0,0), /* SPRINTF */
X A(1,1,1), /* SUBSTR */
X A(1,3,0), /* PACK */
X A(0,3,0), /* GREP */
X A(1,3,0), /* JOIN */
X A(1,1,0), /* SLT */
X A(1,1,0), /* SGT */
X A(1,1,0), /* SLE */
X A(1,1,0), /* SGE */
X A(1,1,0), /* SEQ */
X A(1,1,0), /* SNE */
X A(1,1,0), /* SCMP */
X A(0,3,0), /* SUBR */
X A(0,3,0), /* DBSUBR */
X A(1,0,0), /* CALLER */
X A(1,3,0), /* SORT */
X A(0,3,0), /* REVERSE */
X A(0,3,0), /* WARN */
X A(0,3,0), /* DIE */
X A(1,3,0), /* PRINTF */
X A(1,3,0), /* PRINT */
X A(1,0,0), /* CHDIR */
X A(1,0,0), /* EXIT */
X A(1,0,0), /* RESET */
X A(3,0,0), /* LIST */
X A(1,0,0), /* EOF */
X A(1,0,0), /* GETC */
X A(1,0,0), /* TELL */
X A5(1,1,1,1,0), /* RECV */
X A(1,1,3), /* READ */
X A(1,1,3), /* SYSREAD */
X A(1,1,3), /* SYSWRITE */
X A(1,1,3), /* SEND */
X A(1,1,1), /* SEEK */
X A(0,3,0), /* RETURN */
X A(0,0,0), /* REDO */
X A(0,0,0), /* NEXT */
X A(0,0,0), /* LAST */
X A(0,0,0), /* DUMP */
X A(0,0,0), /* GOTO */
X A(1,1,1), /* INDEX */
X A(1,1,1), /* RINDEX */
X A(0,0,0), /* TIME */
X A(0,0,0), /* TIMES */
X A(1,0,0), /* LOCALTIME */
X A(1,0,0), /* GMTIME */
X A(1,1,0), /* TRUNCATE */
X A(1,0,0), /* LSTAT */
X A(1,0,0), /* STAT */
X A(1,1,0), /* CRYPT */
X A(1,1,0), /* ATAN2 */
X A(1,0,0), /* SIN */
X A(1,0,0), /* COS */
X A(1,0,0), /* RAND */
X A(1,0,0), /* SRAND */
X A(1,0,0), /* EXP */
X A(1,0,0), /* LOG */
X A(1,0,0), /* SQRT */
X A(1,0,0), /* INT */
X A(1,0,0), /* ORD */
X A(1,0,0), /* ALARM */
X A(1,0,0), /* SLEEP */
X A(1,1,0), /* RANGE */
X A(1,0,0), /* F_OR_R */
X A(1,0,0), /* FLIP */
X A(0,1,0), /* FLOP */
X A(0,0,0), /* FORK */
X A(0,0,0), /* WAIT */
X A(1,1,0), /* WAITPID */
X A(1,3,0), /* SYSTEM */
X A(1,3,0), /* EXEC */
X A(1,0,0), /* HEX */
X A(1,0,0), /* OCT */
X A(0,3,0), /* CHOWN */
X A(0,3,0), /* KILL */
X A(0,3,0), /* UNLINK */
X A(0,3,0), /* CHMOD */
X A(0,3,0), /* UTIME */
X A(1,0,0), /* UMASK */
X A(1,1,0), /* MSGGET */
X A(1,1,1), /* SHMGET */
X A(1,1,1), /* SEMGET */
X A(1,1,1), /* MSGCTL */
X A(1,1,1), /* SHMCTL */
X A5(1,1,1,1,0), /* SEMCTL */
X A(1,1,1), /* MSGSND */
X A5(1,1,1,1,1), /* MSGRCV */
X A(1,1,1), /* SEMOP */
X A5(1,1,1,1,0), /* SHMREAD */
X A5(1,1,1,1,0), /* SHMWRITE */
X A(1,1,0), /* RENAME */
X A(1,1,0), /* LINK */
X A(1,1,0), /* MKDIR */
X A(1,0,0), /* RMDIR */
X A(0,0,0), /* GETPPID */
X A(1,0,0), /* GETPGRP */
X A(1,1,0), /* SETPGRP */
X A(1,1,0), /* GETPRIORITY */
X A(1,1,1), /* SETPRIORITY */
X A(1,0,0), /* CHROOT */
X A(1,1,1), /* FCNTL */
X A(1,1,1), /* SYSIOCTL */
X A(1,1,0), /* FLOCK */
X A(0,3,0), /* UNSHIFT */
X A(1,0,0), /* REQUIRE */
X A(1,0,0), /* DOFILE */
X A(1,0,0), /* EVAL */
X A(1,0,0), /* FTRREAD */
X A(1,0,0), /* FTRWRITE */
X A(1,0,0), /* FTREXEC */
X A(1,0,0), /* FTEREAD */
X A(1,0,0), /* FTEWRITE */
X A(1,0,0), /* FTEEXEC */
X A(1,0,0), /* FTIS */
X A(1,0,0), /* FTEOWNED */
X A(1,0,0), /* FTROWNED */
X A(1,0,0), /* FTZERO */
X A(1,0,0), /* FTSIZE */
X A(1,0,0), /* FTMTIME */
X A(1,0,0), /* FTATIME */
X A(1,0,0), /* FTCTIME */
X A(1,0,0), /* FTSOCK */
X A(1,0,0), /* FTCHR */
X A(1,0,0), /* FTBLK */
X A(1,0,0), /* FTFILE */
X A(1,0,0), /* FTDIR */
X A(1,0,0), /* FTPIPE */
X A(1,0,0), /* FTLINK */
X A(1,1,0), /* SYMLINK */
X A(1,0,0), /* READLINK */
X A(1,0,0), /* FTSUID */
X A(1,0,0), /* FTSGID */
X A(1,0,0), /* FTSVTX */
X A(1,0,0), /* FTTTY */
X A(1,0,0), /* FTTEXT */
X A(1,0,0), /* FTBINARY */
X A5(1,1,1,1,0), /* SOCKET */
X A(1,1,0), /* BIND */
X A(1,1,0), /* CONNECT */
X A(1,1,0), /* LISTEN */
X A(1,1,0), /* ACCEPT */
X A(1,0,0), /* GHBYNAME */
X A(1,1,0), /* GHBYADDR */
X A(0,0,0), /* GHOSTENT */
X A(1,0,0), /* GNBYNAME */
X A(1,1,0), /* GNBYADDR */
X A(0,0,0), /* GNETENT */
X A(1,0,0), /* GPBYNAME */
X A(1,0,0), /* GPBYNUMBER */
X A(0,0,0), /* GPROTOENT */
X A(1,1,0), /* GSBYNAME */
X A(1,1,0), /* GSBYPORT */
X A(0,0,0), /* GSERVENT */
X A(1,0,0), /* SHOSTENT */
X A(1,0,0), /* SNETENT */
X A(1,0,0), /* SPROTOENT */
X A(1,0,0), /* SSERVENT */
X A(0,0,0), /* EHOSTENT */
X A(0,0,0), /* ENETENT */
X A(0,0,0), /* EPROTOENT */
X A(0,0,0), /* ESERVENT */
X A5(1,1,1,1,1), /* SOCKPAIR */
X A(1,1,0), /* SHUTDOWN */
X A(1,1,1), /* GSOCKOPT */
X A5(1,1,1,1,0), /* SSOCKOPT */
X A(1,0,0), /* GETSOCKNAME */
X A(1,0,0), /* GETPEERNAME */
X A5(1,1,1,1,0), /* SSELECT */
X A(1,0,0), /* FILENO */
X A(1,0,0), /* BINMODE */
X A(1,1,1), /* VEC */
X A(1,0,0), /* GPWNAM */
X A(1,0,0), /* GPWUID */
X A(0,0,0), /* GPWENT */
X A(0,0,0), /* SPWENT */
X A(0,0,0), /* EPWENT */
X A(1,0,0), /* GGRNAM */
X A(1,0,0), /* GGRGID */
X A(0,0,0), /* GGRENT */
X A(0,0,0), /* SGRENT */
X A(0,0,0), /* EGRENT */
X A(0,0,0), /* GETLOGIN */
X A(1,1,0), /* OPENDIR */
X A(1,0,0), /* READDIR */
X A(1,0,0), /* TELLDIR */
X A(1,1,0), /* SEEKDIR */
X A(1,0,0), /* REWINDDIR */
X A(1,0,0), /* CLOSEDIR */
X A(1,3,0), /* SYSCALL */
X A(1,1,0), /* PIPE */
X 0
X};
X#undef A
X#undef A5
X#endif
X
Xint do_trans();
Xint do_split();
Xbool do_eof();
Xlong do_tell();
Xbool do_seek();
Xint do_tms();
Xint do_time();
Xint do_stat();
XSTR *do_push();
XFILE *nextargv();
XSTR *do_fttext();
Xint do_slice();
!STUFFY!FUNK!
echo " "
echo "End of kit 20 (of 36)"
cat /dev/null >kit20isdone
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.