home *** CD-ROM | disk | FTP | other *** search
- Path: bbn.com!rsalz
- From: rsalz@uunet.uu.net (Rich Salz)
- Newsgroups: comp.sources.unix
- Subject: v20i097: Perl, a language with features of C/sed/awk/shell/etc, Part14/24
- Message-ID: <2117@papaya.bbn.com>
- Date: 31 Oct 89 20:13:37 GMT
- Lines: 1853
- Approved: rsalz@uunet.UU.NET
-
- Submitted-by: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
- Posting-number: Volume 20, Issue 97
- Archive-name: perl3.0/part14
-
- #! /bin/sh
-
- # Make a new directory for the perl sources, cd to it, and run kits 1
- # thru 24 through sh. When all 24 kits have been run, read README.
-
- echo "This is perl 3.0 kit 14 (of 24). If kit 14 is complete, the line"
- echo '"'"End of kit 14 (of 24)"'" 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/* $Header: consarg.c,v 3.0 89/10/18 15:10:30 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: consarg.c,v $
- X * Revision 3.0 89/10/18 15:10:30 lwall
- X * 3.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_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->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_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_flags = pat[3].arg_flags;
- X }
- X }
- X Safefree(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 int doarg;
- 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 doarg = opargs[type];
- X if (chld = arg1) {
- X if (chld->arg_type == O_ITEM &&
- X (hoistable[chld[1].arg_type] || chld[1].arg_type == A_LVAL ||
- X (chld[1].arg_type == 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 if (!(doarg & 1))
- X arg[1].arg_type |= A_DONT;
- X if (doarg & 2)
- X arg[1].arg_flags |= AF_ARYOK;
- X }
- X doarg >>= 2;
- X if (chld = arg2) {
- X if (chld->arg_type == O_ITEM &&
- X (hoistable[chld[1].arg_type] ||
- 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 if (!(doarg & 1))
- X arg[2].arg_type |= A_DONT;
- X if (doarg & 2)
- X arg[2].arg_flags |= AF_ARYOK;
- X }
- X doarg >>= 2;
- X if (chld = arg3) {
- X if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) {
- 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 if (!(doarg & 1))
- X arg[3].arg_type |= A_DONT;
- X if (doarg & 2)
- X arg[3].arg_flags |= AF_ARYOK;
- X }
- X if (newlen >= 4 && (chld = arg4)) {
- X if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) {
- 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]) {
- 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#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 arg[1].arg_ptr = arg[1].arg_ptr; /* get stab pointer */
- X str_free(s2);
- 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 while (i-- > 0)
- X str_scat(str,s1);
- 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 str_numset(str,str_gnum(s1) / value);
- X break;
- X case O_MODULO:
- X tmplong = (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 % tmplong)));
- 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_BIT_AND:
- X value = str_gnum(s1);
- X#ifndef lint
- X str_numset(str,(double)(((long)value) & ((long)str_gnum(s2))));
- X#endif
- X break;
- X case O_XOR:
- X value = str_gnum(s1);
- X#ifndef lint
- X str_numset(str,(double)(((long)value) ^ ((long)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)(((long)value) | ((long)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 }
- 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)(~(long)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_CRYPT:
- X#ifdef 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 str_free(s2);
- X arg[1].arg_ptr.arg_str = str;
- 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 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_repl[1].arg_ptr.arg_stab == defstab &&
- 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 arg_free(arg1); /* recursive */
- 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 }
- X else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
- 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 }
- X else if (arg1->arg_type == O_ASLICE) {
- X arg1->arg_type = O_LASLICE;
- 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 (arg1->arg_type == O_HSLICE) {
- X arg1->arg_type = O_LHSLICE;
- 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_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 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 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 *
- Xfixeval(arg)
- XARG *arg;
- X{
- X Renew(arg, 3, ARG);
- X arg->arg_len = 2;
- X arg[2].arg_ptr.arg_hash = curstash;
- X arg[2].arg_type = A_NULL;
- X return arg;
- X}
- X
- XARG *
- Xrcatmaybe(arg)
- XARG *arg;
- X{
- X if (arg->arg_type == O_CONCAT && arg[2].arg_type == A_READ) {
- X arg->arg_type = O_RCAT;
- X arg[2].arg_type = arg[2].arg_ptr.arg_arg[1].arg_type;
- X arg[2].arg_ptr = arg[2].arg_ptr.arg_arg[1].arg_ptr;
- X free_arg(arg[2].arg_ptr.arg_arg);
- 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 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 = scanreg(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 config.h.SH
- sed >config.h.SH <<'!STUFFY!FUNK!' -e 's/X//'
- Xcase $CONFIG in
- X'')
- X if test ! -f config.sh; then
- X ln ../config.sh . || \
- X ln ../../config.sh . || \
- X ln ../../../config.sh . || \
- X (echo "Can't find config.sh."; exit 1)
- X echo "Using config.sh from above..."
- X fi
- X . ./config.sh
- X ;;
- Xesac
- Xecho "Extracting config.h (with variable substitutions)"
- Xsed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!'
- X/* config.h
- X * This file was produced by running the config.h.SH script, which
- X * gets its values from config.sh, which is generally produced by
- X * running Configure.
- X *
- X * Feel free to modify any of this as the need arises. Note, however,
- X * that running config.h.SH again will wipe out any changes you've made.
- X * For a more permanent change edit config.sh and rerun config.h.SH.
- X */
- X
- X
- X/* EUNICE:
- X * This symbol, if defined, indicates that the program is being compiled
- X * under the EUNICE package under VMS. The program will need to handle
- X * things like files that don't go away the first time you unlink them,
- X * due to version numbering. It will also need to compensate for lack
- X * of a respectable link() command.
- X */
- X/* VMS:
- X * This symbol, if defined, indicates that the program is running under
- X * VMS. It is currently only set in conjunction with the EUNICE symbol.
- X */
- X#$d_eunice EUNICE /**/
- X#$d_eunice VMS /**/
- X
- X/* BIN:
- X * This symbol holds the name of the directory in which the user wants
- X * to put publicly executable images for the package in question. It
- X * is most often a local directory such as /usr/local/bin.
- X */
- X#define BIN "$bin" /**/
- X
- X/* BYTEORDER:
- X * This symbol contains an encoding of the order of bytes in a long.
- X * Usual values (in octal) are 01234, 04321, 02143, 03412...
- X */
- X#define BYTEORDER 0$byteorder /**/
- X
- X/* CPPSTDIN:
- X * This symbol contains the first part of the string which will invoke
- X * the C preprocessor on the standard input and produce to standard
- X * output. Typical value of "cc -E" or "/lib/cpp".
- X */
- X/* CPPMINUS:
- X * This symbol contains the second part of the string which will invoke
- X * the C preprocessor on the standard input and produce to standard
- X * output. This symbol will have the value "-" if CPPSTDIN needs a minus
- X * to specify standard input, otherwise the value is "".
- X */
- X#define CPPSTDIN "$cppstdin"
- X#define CPPMINUS "$cppminus"
- X
- X/* BCMP:
- X * This symbol, if defined, indicates that the bcmp routine is available
- X * to compare blocks of memory. If undefined, use memcmp. If that's
- X * not available, roll your own.
- X */
- X#$d_bcmp BCMP /**/
- X
- X/* BCOPY:
- X * This symbol, if defined, indicates that the bcopy routine is available
- X * to copy blocks of memory. Otherwise you should probably use memcpy().
- X */
- X#$d_bcopy BCOPY /**/
- X
- X/* CHARSPRINTF:
- X * This symbol is defined if this system declares "char *sprintf()" in
- X * stdio.h. The trend seems to be to declare it as "int sprintf()". It
- X * is up to the package author to declare sprintf correctly based on the
- X * symbol.
- X */
- X#$d_charsprf CHARSPRINTF /**/
- X
- X/* CRYPT:
- X * This symbol, if defined, indicates that the crypt routine is available
- X * to encrypt passwords and the like.
- X */
- X#$d_crypt CRYPT /**/
- X
- X/* DOSUID:
- X * This symbol, if defined, indicates that the C program should
- X * check the script that it is executing for setuid/setgid bits, and
- X * attempt to emulate setuid/setgid on systems that have disabled
- X * setuid #! scripts because the kernel can't do it securely.
- X * It is up to the package designer to make sure that this emulation
- X * is done securely. Among other things, it should do an fstat on
- X * the script it just opened to make sure it really is a setuid/setgid
- X * script, it should make sure the arguments passed correspond exactly
- X * to the argument on the #! line, and it should not trust any
- X * subprocesses to which it must pass the filename rather than the
- X * file descriptor of the script to be executed.
- X */
- X#$d_dosuid DOSUID /**/
- X
- X/* DUP2:
- X * This symbol, if defined, indicates that the dup2 routine is available
- X * to dup file descriptors. Otherwise you should use dup().
- X */
- X#$d_dup2 DUP2 /**/
- X
- X/* FCHMOD:
- X * This symbol, if defined, indicates that the fchmod routine is available
- X * to change mode of opened files. If unavailable, use chmod().
- X */
- X#$d_fchmod FCHMOD /**/
- X
- X/* FCHOWN:
- X * This symbol, if defined, indicates that the fchown routine is available
- X * to change ownership of opened files. If unavailable, use chown().
- X */
- X#$d_fchown FCHOWN /**/
- X
- X/* FCNTL:
- X * This symbol, if defined, indicates to the C program that it should
- X * include fcntl.h.
- X */
- X#$d_fcntl FCNTL /**/
- X
- X/* FLOCK:
- X * This symbol, if defined, indicates that the flock() routine is
- X * available to do file locking.
- X */
- X#$d_flock FLOCK /**/
- X
- X/* GETGROUPS:
- X * This symbol, if defined, indicates that the getgroups() routine is
- X * available to get the list of process groups. If unavailable, multiple
- X * groups are probably not supported.
- X */
- X#$d_getgrps GETGROUPS /**/
- X
- X/* GETHOSTENT:
- X * This symbol, if defined, indicates that the gethostent() routine is
- X * available to lookup host names in some data base or other.
- X */
- X#$d_gethent GETHOSTENT /**/
- X
- X/* GETPGRP:
- X * This symbol, if defined, indicates that the getpgrp() routine is
- X * available to get the current process group.
- X */
- X#$d_getpgrp GETPGRP /**/
- X
- X/* GETPRIORITY:
- X * This symbol, if defined, indicates that the getpriority() routine is
- X * available to get a process's priority.
- X */
- X#$d_getprior GETPRIORITY /**/
- X
- X/* HTONS:
- X * This symbol, if defined, indicates that the htons routine (and friends)
- X * are available to do network order byte swapping.
- X */
- X/* HTONL:
- X * This symbol, if defined, indicates that the htonl routine (and friends)
- X * are available to do network order byte swapping.
- X */
- X/* NTOHS:
- X * This symbol, if defined, indicates that the ntohs routine (and friends)
- X * are available to do network order byte swapping.
- X */
- X/* NTOHL:
- X * This symbol, if defined, indicates that the ntohl routine (and friends)
- X * are available to do network order byte swapping.
- X */
- X#$d_htonl HTONS /**/
- X#$d_htonl HTONL /**/
- X#$d_htonl NTOHS /**/
- X#$d_htonl NTOHL /**/
- X
- X/* index:
- X * This preprocessor symbol is defined, along with rindex, if the system
- X * uses the strchr and strrchr routines instead.
- X */
- X/* rindex:
- X * This preprocessor symbol is defined, along with index, if the system
- X * uses the strchr and strrchr routines instead.
- X */
- X#$d_index index strchr /* cultural */
- X#$d_index rindex strrchr /* differences? */
- X
- X/* IOCTL:
- X * This symbol, if defined, indicates that sys/ioctl.h exists and should
- X * be included.
- X */
- X#$d_ioctl IOCTL /**/
- X
- X/* KILLPG:
- X * This symbol, if defined, indicates that the killpg routine is available
- X * to kill process groups. If unavailable, you probably should use kill
- X * with a negative process number.
- X */
- X#$d_killpg KILLPG /**/
- X
- X/* MEMCMP:
- X * This symbol, if defined, indicates that the memcmp routine is available
- X * to compare blocks of memory. If undefined, roll your own.
- X */
- X#$d_memcmp MEMCMP /**/
- X
- X/* MEMCPY:
- X * This symbol, if defined, indicates that the memcpy routine is available
- X * to copy blocks of memory. Otherwise you should probably use bcopy().
- X * If neither is defined, roll your own.
- X */
- X#$d_memcpy MEMCPY /**/
- X
- X/* MKDIR:
- X * This symbol, if defined, indicates that the mkdir routine is available
- X * to create directories. Otherwise you should fork off a new process to
- X * exec /bin/mkdir.
- X */
- X#$d_mkdir MKDIR /**/
- X
- X/* NDBM:
- X * This symbol, if defined, indicates that ndbm.h exists and should
- X * be included.
- X */
- X#$d_ndbm NDBM /**/
- X
- X/* ODBM:
- X * This symbol, if defined, indicates that dbm.h exists and should
- X * be included.
- X */
- X#$d_odbm ODBM /**/
- X
- X/* READDIR:
- X * This symbol, if defined, indicates that the readdir routine is available
- X * from the C library to create directories.
- X */
- X#$d_readdir READDIR /**/
- X
- X/* RENAME:
- X * This symbol, if defined, indicates that the rename routine is available
- X * to rename files. Otherwise you should do the unlink(), link(), unlink()
- X * trick.
- X */
- X#$d_rename RENAME /**/
- X
- X/* RMDIR:
- X * This symbol, if defined, indicates that the rmdir routine is available
- X * to remove directories. Otherwise you should fork off a new process to
- X * exec /bin/rmdir.
- X */
- X#$d_rmdir RMDIR /**/
- X
- X/* SETEGID:
- X * This symbol, if defined, indicates that the setegid routine is available
- X * to change the effective gid of the current program.
- X */
- X#$d_setegid SETEGID /**/
- X
- X/* SETEUID:
- X * This symbol, if defined, indicates that the seteuid routine is available
- X * to change the effective uid of the current program.
- X */
- X#$d_seteuid SETEUID /**/
- X
- X/* SETPGRP:
- X * This symbol, if defined, indicates that the setpgrp() routine is
- X * available to set the current process group.
- X */
- X#$d_setpgrp SETPGRP /**/
- X
- X/* SETPRIORITY:
- X * This symbol, if defined, indicates that the setpriority() routine is
- X * available to set a process's priority.
- X */
- X#$d_setprior SETPRIORITY /**/
- X
- X/* SETREGID:
- X * This symbol, if defined, indicates that the setregid routine is
- X * available to change the real and effective gid of the current program.
- X */
- X/* SETRESGID:
- X * This symbol, if defined, indicates that the setresgid routine is
- X * available to change the real, effective and saved gid of the current
- X * program.
- X */
- X#$d_setregid SETREGID /**/
- X#$d_setresgid SETRESGID /**/
- X
- X/* SETREUID:
- X * This symbol, if defined, indicates that the setreuid routine is
- X * available to change the real and effective uid of the current program.
- X */
- X/* SETRESUID:
- X * This symbol, if defined, indicates that the setresuid routine is
- X * available to change the real, effective and saved uid of the current
- X * program.
- X */
- X#$d_setreuid SETREUID /**/
- X#$d_setresuid SETRESUID /**/
- X
- X/* SETRGID:
- X * This symbol, if defined, indicates that the setrgid routine is available
- X * to change the real gid of the current program.
- X */
- X#$d_setrgid SETRGID /**/
- X
- X/* SETRUID:
- X * This symbol, if defined, indicates that the setruid routine is available
- X * to change the real uid of the current program.
- X */
- X#$d_setruid SETRUID /**/
- X
- X/* SOCKET:
- X * This symbol, if defined, indicates that the BSD socket interface is
- X * supported.
- X */
- X/* SOCKETPAIR:
- X * This symbol, if defined, indicates that the BSD socketpair call is
- X * supported.
- X */
- X/* OLDSOCKET:
- X * This symbol, if defined, indicates that the 4.1c BSD socket interface
- X * is supported instead of the 4.2/4.3 BSD socket interface.
- X */
- X#$d_socket SOCKET /**/
- X
- X#$d_sockpair SOCKETPAIR /**/
- X
- X#$d_oldsock OLDSOCKET /**/
- X
- X/* STATBLOCKS:
- X * This symbol is defined if this system has a stat structure declaring
- X * st_blksize and st_blocks.
- X */
- X#$d_statblks STATBLOCKS /**/
- X
- X/* STDSTDIO:
- X * This symbol is defined if this system has a FILE structure declaring
- X * _ptr and _cnt in stdio.h.
- X */
- X#$d_stdstdio STDSTDIO /**/
- X
- X/* STRUCTCOPY:
- X * This symbol, if defined, indicates that this C compiler knows how
- X * to copy structures. If undefined, you'll need to use a block copy
- X * routine of some sort instead.
- X */
- X#$d_strctcpy STRUCTCOPY /**/
- X
- X/* SYMLINK:
- X * This symbol, if defined, indicates that the symlink routine is available
- X * to create symbolic links.
- X */
- X#$d_symlink SYMLINK /**/
- X
- X/* SYSCALL:
- X * This symbol, if defined, indicates that the syscall routine is available
- X * to call arbitrary system calls. If undefined, that's tough.
- X */
- X#$d_syscall SYSCALL /**/
- X
- X/* TMINSYS:
- X * This symbol is defined if this system declares "struct tm" in
- X * in <sys/time.h> rather than <time.h>. We can't just say
- X * -I/usr/include/sys because some systems have both time files, and
- X * the -I trick gets the wrong one.
- X */
- X/* I_SYSTIME:
- X * This symbol is defined if this system has the file <sys/time.h>.
- X */
- X#$d_tminsys TMINSYS /**/
- X#$i_systime I_SYSTIME /**/
- X
- X/* VARARGS:
- X * This symbol, if defined, indicates to the C program that it should
- X * include varargs.h.
- X */
- X#$d_varargs VARARGS /**/
- X
- X/* vfork:
- X * This symbol, if defined, remaps the vfork routine to fork if the
- X * vfork() routine isn't supported here.
- X */
- X#$d_vfork vfork fork /**/
- X
- X/* VOIDSIG:
- X * This symbol is defined if this system declares "void (*signal())()" in
- X * signal.h. The old way was to declare it as "int (*signal())()". It
- X * is up to the package author to declare things correctly based on the
- X * symbol.
- X */
- X#$d_voidsig VOIDSIG /**/
- X
- X/* VPRINTF:
- X * This symbol, if defined, indicates that the vprintf routine is available
- X * to printf with a pointer to an argument list. If unavailable, you
- X * may need to write your own, probably in terms of _doprnt().
- X */
- X/* CHARVSPRINTF:
- X * This symbol is defined if this system has vsprintf() returning type
- X * (char*). The trend seems to be to declare it as "int vsprintf()". It
- X * is up to the package author to declare vsprintf correctly based on the
- X * symbol.
- X */
- X#$d_vprintf VPRINTF /**/
- X#$d_charvspr CHARVSPRINTF /**/
- X
- X/* GIDTYPE:
- X * This symbol has a value like gid_t, int, ushort, or whatever type is
- X * used to declare group ids in the kernel.
- X */
- X#define GIDTYPE $gidtype /**/
- X
- X/* I_DIRENT:
- X * This symbol, if defined, indicates to the C program that it should
- X * include dirent.h.
- X */
- X/* DIRNAMLEN:
- X * This symbol, if defined, indicates to the C program that the length
- X * of directory entry names is provided by a d_namlen field. Otherwise
- X * you need to do strlen() on the d_name field.
- X */
- X#$i_dirent I_DIRENT /**/
- X#$d_dirnamlen DIRNAMLEN /**/
- X
- X/* I_FCNTL:
- X * This symbol, if defined, indicates to the C program that it should
- X * include fcntl.h.
- X */
- X#$i_fcntl I_FCNTL /**/
- X
- X/* I_GRP:
- X * This symbol, if defined, indicates to the C program that it should
- X * include grp.h.
- X */
- X#$i_grp I_GRP /**/
- X
- X/* I_PWD:
- X * This symbol, if defined, indicates to the C program that it should
- X * include pwd.h.
- X */
- X/* PWQUOTA:
- X * This symbol, if defined, indicates to the C program that struct passwd
- X * contains pw_quota.
- X */
- X/* PWAGE:
- X * This symbol, if defined, indicates to the C program that struct passwd
- X * contains pw_age.
- X */
- X#$i_pwd I_PWD /**/
- X#$d_pwquota PWQUOTA /**/
- X#$d_pwage PWAGE /**/
- X
- X/* I_SYSDIR:
- X * This symbol, if defined, indicates to the C program that it should
- X * include sys/dir.h.
- X */
- X#$i_sysdir I_SYSDIR /**/
- X
- X/* I_SYSIOCTL:
- X * This symbol, if defined, indicates that sys/ioctl.h exists and should
- X * be included.
- X */
- X#$i_sysioctl I_SYSIOCTL /**/
- X
- X/* I_VARARGS:
- X * This symbol, if defined, indicates to the C program that it should
- X * include varargs.h.
- X */
- X#$i_varargs I_VARARGS /**/
- X
- X/* I_VFORK:
- X * This symbol, if defined, indicates to the C program that it should
- X * include vfork.h.
- X */
- X#$i_vfork I_VFORK /**/
- X
- X/* INTSIZE:
- X * This symbol contains the size of an int, so that the C preprocessor
- X * can make decisions based on it.
- X */
- X#define INTSIZE $intsize /**/
- X
- X/* RANDBITS:
- X * This symbol contains the number of bits of random number the rand()
- X * function produces. Usual values are 15, 16, and 31.
- X */
- X#define RANDBITS $randbits /**/
- X
- X/* SIG_NAME:
- X * This symbol contains an list of signal names in order.
- X */
- X#define SIG_NAME "`echo $sig_name | sed 's/ /","/g'`" /**/
- X
- X/* STDCHAR:
- X * This symbol is defined to be the type of char used in stdio.h.
- X * It has the values "unsigned char" or "char".
- X */
- X#define STDCHAR $stdchar /**/
- X
- X/* UIDTYPE:
- X * This symbol has a value like uid_t, int, ushort, or whatever type is
- X * used to declare user ids in the kernel.
- X */
- X#define UIDTYPE $uidtype /**/
- X
- X/* VOIDFLAGS:
- X * This symbol indicates how much support of the void type is given by this
- X * compiler. What various bits mean:
- X *
- X * 1 = supports declaration of void
- X * 2 = supports arrays of pointers to functions returning void
- X * 4 = supports comparisons between pointers to void functions and
- X * addresses of void functions
- X *
- X * The package designer should define VOIDUSED to indicate the requirements
- X * of the package. This can be done either by #defining VOIDUSED before
- X * including config.h, or by defining defvoidused in Myinit.U. If the
- X * latter approach is taken, only those flags will be tested. If the
- X * level of void support necessary is not present, defines void to int.
- X */
- X#ifndef VOIDUSED
- X#define VOIDUSED $defvoidused
- X#endif
- X#define VOIDFLAGS $voidflags
- X#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
- X#$define void int /* is void to be avoided? */
- X#$define M_VOID /* Xenix strikes again */
- X#endif
- X
- X/* PRIVLIB:
- X * This symbol contains the name of the private library for this package.
- X * The library is private in the sense that it needn't be in anyone's
- X * execution path, but it should be accessible by the world. The program
- X * should be prepared to do ~ expansion.
- X */
- X#define PRIVLIB "$privlib" /**/
- X
- X!GROK!THIS!
- !STUFFY!FUNK!
- echo Extracting str.h
- sed >str.h <<'!STUFFY!FUNK!' -e 's/X//'
- X/* $Header: str.h,v 3.0 89/10/18 15:23:49 lwall Locked $
- X *
- X * Copyright (c) 1989, Larry Wall
- X *
- X * You may distribute under the terms of the GNU General Public License
- X * as specified in the README file that comes with the perl 3.0 kit.
- X *
- X * $Log: str.h,v $
- X * Revision 3.0 89/10/18 15:23:49 lwall
- X * 3.0 baseline
- X *
- X */
- X
- Xstruct string {
- X char * str_ptr; /* pointer to malloced string */
- X union {
- X double str_nval; /* numeric value, if any */
- X STAB *str_stab; /* magic stab for magic "key" string */
- X long str_useful; /* is this search optimization effective? */
- X ARG *str_args; /* list of args for interpreted string */
- X HASH *str_hash; /* string represents an assoc array (stab?) */
- X ARRAY *str_array; /* string represents an array */
- X } str_u;
- X int str_len; /* allocated size */
- X int str_cur; /* length of str_ptr as a C string */
- X STR *str_magic; /* while free, link to next free str */
- X /* while in use, ptr to "key" for magic items */
- X char str_pok; /* state of str_ptr */
- X char str_nok; /* state of str_nval */
- X unsigned char str_rare; /* used by search strings */
- X unsigned char str_state; /* one of SS_* below */
- X /* also used by search strings for backoff */
- X#ifdef TAINT
- X bool str_tainted; /* 1 if possibly under control of $< */
- X#endif
- X};
- X
- Xstruct stab { /* should be identical, except for str_ptr */
- X STBP * str_ptr; /* pointer to malloced string */
- X union {
- X double str_nval; /* numeric value, if any */
- X STAB *str_stab; /* magic stab for magic "key" string */
- X long str_useful; /* is this search optimization effective? */
- X ARG *str_args; /* list of args for interpreted string */
- X HASH *str_hash; /* string represents an assoc array (stab?) */
- X ARRAY *str_array; /* string represents an array */
- X } str_u;
- X int str_len; /* allocated size */
- X int str_cur; /* length of str_ptr as a C string */
- X STR *str_magic; /* while free, link to next free str */
- X /* while in use, ptr to "key" for magic items */
- X char str_pok; /* state of str_ptr */
- X char str_nok; /* state of str_nval */
- X unsigned char str_rare; /* used by search strings */
- X unsigned char str_state; /* one of SS_* below */
- X /* also used by search strings for backoff */
- X#ifdef TAINT
- X bool str_tainted; /* 1 if possibly under control of $< */
- X#endif
- X};
- X
- X/* some extra info tacked to some lvalue strings */
- X
- Xstruct lstring {
- X struct string lstr;
- X int lstr_offset;
- X int lstr_len;
- X};
- X
- X/* These are the values of str_pok: */
- X#define SP_VALID 1 /* str_ptr is valid */
- X#define SP_FBM 2 /* string was compiled for fbm search */
- X#define SP_STUDIED 4 /* string was studied */
- X#define SP_CASEFOLD 8 /* case insensitive fbm search */
- X#define SP_INTRP 16 /* string was compiled for interping */
- X#define SP_TAIL 32 /* fbm string is tail anchored: /foo$/ */
- X#define SP_MULTI 64 /* symbol table entry probably isn't a typo */
- X
- X#define Nullstr Null(STR*)
- X
- X/* These are the values of str_state: */
- X#define SS_NORM 0 /* normal string */
- X#define SS_INCR 1 /* normal string, incremented ptr */
- X#define SS_SARY 2 /* array on save stack */
- X#define SS_SHASH 3 /* associative array on save stack */
- X#define SS_SINT 4 /* integer on save stack */
- X#define SS_SLONG 5 /* long on save stack */
- X#define SS_SSTRP 6 /* STR* on save stack */
- X#define SS_SHPTR 7 /* HASH* on save stack */
- X#define SS_SNSTAB 8 /* non-stab on save stack */
- X#define SS_HASH 253 /* carrying an hash */
- X#define SS_ARY 254 /* carrying an array */
- X#define SS_FREE 255 /* in free list */
- X/* str_state may have any value 0-255 when used to hold fbm pattern, in which */
- X/* case it indicates offset to rarest character in screaminstr key */
- X
- X/* the following macro updates any magic values this str is associated with */
- X
- X#ifdef TAINT
- X#define STABSET(x) \
- X (x)->str_tainted |= tainted; \
- X if ((x)->str_magic) \
- X stabset((x)->str_magic,(x))
- X#else
- X#define STABSET(x) \
- X if ((x)->str_magic) \
- X stabset((x)->str_magic,(x))
- X#endif
- X
- X#define STR_SSET(dst,src) if (dst != src) str_sset(dst,src)
- X
- XEXT STR **tmps_list;
- XEXT int tmps_max INIT(-1);
- XEXT int tmps_base INIT(-1);
- X
- Xchar *str_2ptr();
- Xdouble str_2num();
- XSTR *str_static();
- XSTR *str_2static();
- XSTR *str_make();
- XSTR *str_nmake();
- XSTR *str_smake();
- Xint str_cmp();
- Xint str_eq();
- Xvoid str_magic();
- Xvoid str_insert();
- !STUFFY!FUNK!
- echo ""
- echo "End of kit 14 (of 24)"
- cat /dev/null >kit14isdone
- run=''
- config=''
- for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24; do
- if test -f kit${iskit}isdone; then
- run="$run $iskit"
- else
- todo="$todo $iskit"
- fi
- done
- case $todo in
- '')
- echo "You have run all your kits. Please read README and then type Configure."
- chmod 755 Configure
- ;;
- *) echo "You have run$run."
- echo "You still need to run$todo."
- ;;
- esac
- : Someone might mail this, so...
- exit
-
- --
- Please send comp.sources.unix-related mail to rsalz@uunet.uu.net.
- Use a domain-based address or give alternate paths, or you may lose out.
-