perl 3.0 beta kit [9/23]
Larry Wall
lwall at jato.Jpl.Nasa.Gov
Sun Sep 3 11:55:12 AEST 1989
#! /bin/sh
# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 23 through sh. When all 23 kits have been run, read README.
echo "This is perl 3.0 kit 9 (of 23). If kit 9 is complete, the line"
echo '"'"End of kit 9 (of 23)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir t 2>/dev/null
echo Extracting cons.c
sed >cons.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header$
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$
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X#include "perly.h"
X
Xextern char *tokename[];
Xextern int yychar;
X
Xstatic int cmd_tosave();
Xstatic int arg_tosave();
Xstatic int spat_tosave();
X
Xstatic bool saw_return;
X
XSUBR *
Xmake_sub(name,cmd)
Xchar *name;
XCMD *cmd;
X{
X register SUBR *sub;
X STAB *stab = stabent(name,TRUE);
X
X Newz(101,sub,1,SUBR);
X if (stab_sub(stab)) {
X if (dowarn) {
X line_t oldline = line;
X
X if (cmd)
X line = cmd->c_line;
X warn("Subroutine %s redefined",name);
X line = oldline;
X }
X cmd_free(stab_sub(stab)->cmd);
X afree(stab_sub(stab)->tosave);
X Safefree(stab_sub(stab));
X }
X sub->filename = filename;
X saw_return = FALSE;
X tosave = anew(Nullstab);
X tosave->ary_fill = 0; /* make 1 based */
X (void)cmd_tosave(cmd,FALSE); /* this builds the tosave array */
X sub->tosave = tosave;
X if (saw_return) {
X struct compcmd mycompblock;
X
X mycompblock.comp_true = cmd;
X mycompblock.comp_alt = Nullcmd;
X cmd = add_label(savestr("SUB"),make_ccmd(C_BLOCK,Nullarg,mycompblock));
X saw_return = FALSE;
X }
X sub->cmd = cmd;
X stab_sub(stab) = sub;
X if (perldb) {
X STR *str = str_nmake((double)subline);
X
X str_cat(str,"-");
X sprintf(buf,"%ld",(long)line);
X str_cat(str,buf);
X name = str_get(subname);
X hstore(stab_xhash(DBsub),name,strlen(name),str,0);
X subline = 0;
X str_set(subname,"main");
X }
X}
X
XCMD *
Xblock_head(tail)
Xregister CMD *tail;
X{
X CMD *head;
X register int opt;
X register int last_opt = 0;
X register STAB *last_stab = Nullstab;
X register int count = 0;
X register CMD *switchbeg;
X
X if (tail == Nullcmd) {
X return tail;
X }
X head = tail->c_head;
X
X for (tail = head; tail; tail = tail->c_next) {
X
X /* save one measly dereference at runtime */
X if (tail->c_type == C_IF)
X tail->ucmd.ccmd.cc_alt = tail->ucmd.ccmd.cc_alt->c_next;
X
X /* now do a little optimization on case-ish structures */
X switch(tail->c_flags & (CF_OPTIMIZE|CF_FIRSTNEG|CF_INVERT)) {
X case CFT_ANCHOR:
X if (stabent("*",FALSE)) { /* bad assumption here!!! */
X opt = 0;
X break;
X }
X /* FALL THROUGH */
X case CFT_STROP:
X opt = (tail->c_flags & CF_NESURE) ? CFT_STROP : 0;
X break;
X case CFT_CCLASS:
X opt = CFT_STROP;
X break;
X case CFT_NUMOP:
X opt = (tail->c_slen == O_NE ? 0 : CFT_NUMOP);
X if ((tail->c_flags&(CF_NESURE|CF_EQSURE)) != (CF_NESURE|CF_EQSURE))
X opt = 0;
X break;
X default:
X opt = 0;
X }
X if (opt && opt == last_opt && tail->c_stab == last_stab)
X count++;
X else {
X if (count >= 3) { /* is this the breakeven point? */
X if (last_opt == CFT_NUMOP)
X make_nswitch(switchbeg,count);
X else
X make_cswitch(switchbeg,count);
X }
X if (opt) {
X count = 1;
X switchbeg = tail;
X }
X else
X count = 0;
X }
X last_opt = opt;
X last_stab = tail->c_stab;
X }
X if (count >= 3) { /* is this the breakeven point? */
X if (last_opt == CFT_NUMOP)
X make_nswitch(switchbeg,count);
X else
X make_cswitch(switchbeg,count);
X }
X return head;
X}
X
X/* We've spotted a sequence of CMDs that all test the value of the same
X * spat. Thus we can insert a SWITCH in front and jump directly
X * to the correct one.
X */
Xmake_cswitch(head,count)
Xregister CMD *head;
Xint count;
X{
X register CMD *cur;
X register CMD **loc;
X register int i;
X register int min = 255;
X register int max = 0;
X
X /* make a new head in the exact same spot */
X New(102,cur, 1, CMD);
X#ifdef STRUCTCOPY
X *cur = *head;
X#else
X Copy(head,cur,1,CMD);
X#endif
X Zero(head,1,CMD);
X head->c_type = C_CSWITCH;
X head->c_next = cur; /* insert new cmd at front of list */
X head->c_stab = cur->c_stab;
X
X Newz(103,loc,258,CMD*);
X loc++; /* lie a little */
X while (count--) {
X if ((cur->c_flags && CF_OPTIMIZE) == CFT_CCLASS) {
X for (i = 0; i <= 255; i++) {
X if (!loc[i] && cur->c_short->str_ptr[i>>3] & (1 << (i&7))) {
X loc[i] = cur;
X if (i < min)
X min = i;
X if (i > max)
X max = i;
X }
X }
X }
X else {
X i = *cur->c_short->str_ptr & 255;
X if (!loc[i]) {
X loc[i] = cur;
X if (i < min)
X min = i;
X if (i > max)
X max = i;
X }
X }
X cur = cur->c_next;
X }
X max++;
X if (min > 0)
X Copy(&loc[min],&loc[0], max - min, CMD*);
X loc--;
X min--;
X max -= min;
X for (i = 0; i <= max; i++)
X if (!loc[i])
X loc[i] = cur;
X Renew(loc,max+1,CMD*); /* chop it down to size */
X head->ucmd.scmd.sc_offset = min;
X head->ucmd.scmd.sc_max = max;
X head->ucmd.scmd.sc_next = loc;
X}
X
Xmake_nswitch(head,count)
Xregister CMD *head;
Xint count;
X{
X register CMD *cur = head;
X register CMD **loc;
X register int i;
X register int min = 32767;
X register int max = -32768;
X int origcount = count;
X double value; /* or your money back! */
X short changed; /* so triple your money back! */
X
X while (count--) {
X i = (int)str_gnum(cur->c_short);
X value = (double)i;
X if (value != cur->c_short->str_u.str_nval)
X return; /* fractional values--just forget it */
X changed = i;
X if (changed != i)
X return; /* too big for a short */
X if (cur->c_slen == O_LE)
X i++;
X else if (cur->c_slen == O_GE) /* we only do < or > here */
X i--;
X if (i < min)
X min = i;
X if (i > max)
X max = i;
X cur = cur->c_next;
X }
X count = origcount;
X if (max - min > count * 2 + 10) /* too sparse? */
X return;
X
X /* now make a new head in the exact same spot */
X New(104,cur, 1, CMD);
X#ifdef STRUCTCOPY
X *cur = *head;
X#else
X Copy(head,cur,1,CMD);
X#endif
X Zero(head,1,CMD);
X head->c_type = C_NSWITCH;
X head->c_next = cur; /* insert new cmd at front of list */
X head->c_stab = cur->c_stab;
X
X Newz(105,loc, max - min + 3, CMD*);
X loc++;
X while (count--) {
X i = (int)str_gnum(cur->c_short);
X i -= min;
X max -= min;
X max++;
X switch(cur->c_slen) {
X case O_LE:
X i++;
X case O_LT:
X for (i--; i >= -1; i--)
X if (!loc[i])
X loc[i] = cur;
X break;
X case O_GE:
X i--;
X case O_GT:
X for (i++; i <= max; i++)
X if (!loc[i])
X loc[i] = cur;
X break;
X case O_EQ:
X if (!loc[i])
X loc[i] = cur;
X break;
X }
X cur = cur->c_next;
X }
X loc--;
X min--;
X for (i = 0; i <= max; i++)
X if (!loc[i])
X loc[i] = cur;
X head->ucmd.scmd.sc_offset = min;
X head->ucmd.scmd.sc_max = max;
X head->ucmd.scmd.sc_next = loc;
X}
X
XCMD *
Xappend_line(head,tail)
Xregister CMD *head;
Xregister CMD *tail;
X{
X if (tail == Nullcmd)
X return head;
X if (!tail->c_head) /* make sure tail is well formed */
X tail->c_head = tail;
X if (head != Nullcmd) {
X tail = tail->c_head; /* get to start of tail list */
X if (!head->c_head)
X head->c_head = head; /* start a new head list */
X while (head->c_next) {
X head->c_next->c_head = head->c_head;
X head = head->c_next; /* get to end of head list */
X }
X head->c_next = tail; /* link to end of old list */
X tail->c_head = head->c_head; /* propagate head pointer */
X }
X while (tail->c_next) {
X tail->c_next->c_head = tail->c_head;
X tail = tail->c_next;
X }
X return tail;
X}
X
XCMD *
Xdodb(cur)
XCMD *cur;
X{
X register CMD *cmd;
X register CMD *head = cur->c_head;
X register ARG *arg;
X STR *str;
X
X if (!head)
X head = cur;
X if (!head->c_line)
X return cur;
X str = afetch(lineary,(int)head->c_line,FALSE);
X if (!str || str->str_nok)
X return cur;
X str->str_u.str_nval = (double)head->c_line;
X str->str_nok = 1;
X Newz(106,cmd,1,CMD);
X cmd->c_type = C_EXPR;
X cmd->ucmd.acmd.ac_stab = Nullstab;
X cmd->ucmd.acmd.ac_expr = Nullarg;
X arg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg,0);
X arg[1].arg_type = A_SINGLE;
X arg[1].arg_ptr.arg_str = str_nmake((double)head->c_line);
X cmd->c_expr = make_op(O_SUBR, 2,
X stab2arg(A_WORD,DBstab),
X make_list(arg),
X Nullarg,1);
X opt_arg(cmd,1,1);
X cmd->c_flags |= CF_COND;
X cmd->c_line = head->c_line;
X cmd->c_label = head->c_label;
X cmd->c_file = filename;
X return append_line(cmd, cur);
X}
X
XCMD *
Xmake_acmd(type,stab,cond,arg)
Xint type;
XSTAB *stab;
XARG *cond;
XARG *arg;
X{
X register CMD *cmd;
X
X Newz(107,cmd,1,CMD);
X cmd->c_type = type;
X cmd->ucmd.acmd.ac_stab = stab;
X cmd->ucmd.acmd.ac_expr = arg;
X cmd->c_expr = cond;
X if (cond) {
X opt_arg(cmd,1,1);
X cmd->c_flags |= CF_COND;
X }
X if (cmdline != NOLINE) {
X cmd->c_line = cmdline;
X cmdline = NOLINE;
X }
X cmd->c_file = filename;
X if (perldb)
X cmd = dodb(cmd);
X return cmd;
X}
X
XCMD *
Xmake_ccmd(type,arg,cblock)
Xint type;
XARG *arg;
Xstruct compcmd cblock;
X{
X register CMD *cmd;
X
X Newz(108,cmd, 1, CMD);
X cmd->c_type = type;
X cmd->c_expr = arg;
X cmd->ucmd.ccmd.cc_true = cblock.comp_true;
X cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
X if (arg) {
X opt_arg(cmd,1,0);
X cmd->c_flags |= CF_COND;
X }
X if (cmdline != NOLINE) {
X cmd->c_line = cmdline;
X cmdline = NOLINE;
X }
X if (perldb)
X cmd = dodb(cmd);
X return cmd;
X}
X
XCMD *
Xmake_icmd(type,arg,cblock)
Xint type;
XARG *arg;
Xstruct compcmd cblock;
X{
X register CMD *cmd;
X register CMD *alt;
X register CMD *cur;
X register CMD *head;
X struct compcmd ncblock;
X
X Newz(109,cmd, 1, CMD);
X head = cmd;
X cmd->c_type = type;
X cmd->c_expr = arg;
X cmd->ucmd.ccmd.cc_true = cblock.comp_true;
X cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
X if (arg) {
X opt_arg(cmd,1,0);
X cmd->c_flags |= CF_COND;
X }
X if (cmdline != NOLINE) {
X cmd->c_line = cmdline;
X cmdline = NOLINE;
X }
X cur = cmd;
X alt = cblock.comp_alt;
X while (alt && alt->c_type == C_ELSIF) {
X cur = alt;
X alt = alt->ucmd.ccmd.cc_alt;
X }
X if (alt) { /* a real life ELSE at the end? */
X ncblock.comp_true = alt;
X ncblock.comp_alt = Nullcmd;
X alt = append_line(cur,make_ccmd(C_ELSE,Nullarg,ncblock));
X cur->ucmd.ccmd.cc_alt = alt;
X }
X else
X alt = cur; /* no ELSE, so cur is proxy ELSE */
X
X cur = cmd;
X while (cmd) { /* now point everyone at the ELSE */
X cur = cmd;
X cmd = cur->ucmd.ccmd.cc_alt;
X cur->c_head = head;
X if (cur->c_type == C_ELSIF)
X cur->c_type = C_IF;
X if (cur->c_type == C_IF)
X cur->ucmd.ccmd.cc_alt = alt;
X if (cur == alt)
X break;
X cur->c_next = cmd;
X }
X if (perldb)
X cur = dodb(cur);
X return cur;
X}
X
Xvoid
Xopt_arg(cmd,fliporflop,acmd)
Xregister CMD *cmd;
Xint fliporflop;
Xint acmd;
X{
X register ARG *arg;
X int opt = CFT_EVAL;
X int sure = 0;
X ARG *arg2;
X int context = 0; /* 0 = normal, 1 = before &&, 2 = before || */
X int flp = fliporflop;
X
X if (!cmd)
X return;
X arg = cmd->c_expr;
X
X /* Can we turn && and || into if and unless? */
X
X if (acmd && !cmd->ucmd.acmd.ac_expr &&
X (arg->arg_type == O_AND || arg->arg_type == O_OR) ) {
X dehoist(arg,1);
X arg[2].arg_type &= A_MASK; /* don't suppress eval */
X dehoist(arg,2);
X cmd->ucmd.acmd.ac_expr = arg[2].arg_ptr.arg_arg;
X cmd->c_expr = arg[1].arg_ptr.arg_arg;
X if (arg->arg_type == O_OR)
X cmd->c_flags ^= CF_INVERT; /* || is like unless */
X arg->arg_len = 0;
X free_arg(arg);
X arg = cmd->c_expr;
X }
X
X /* Turn "if (!expr)" into "unless (expr)" */
X
X while (arg->arg_type == O_NOT) {
X dehoist(arg,1);
X cmd->c_flags ^= CF_INVERT; /* flip sense of cmd */
X cmd->c_expr = arg[1].arg_ptr.arg_arg; /* hoist the rest of expr */
X free_arg(arg);
X arg = cmd->c_expr; /* here we go again */
X }
X
X if (!arg->arg_len) { /* sanity check */
X cmd->c_flags |= opt;
X return;
X }
X
X /* for "cond .. cond" we set up for the initial check */
X
X if (arg->arg_type == O_FLIP)
X context |= 4;
X
X /* for "cond && expr" and "cond || expr" we can ignore expr, sort of */
X
X morecontext:
X if (arg->arg_type == O_AND)
X context |= 1;
X else if (arg->arg_type == O_OR)
X context |= 2;
X if (context && (arg[flp].arg_type & A_MASK) == A_EXPR) {
X arg = arg[flp].arg_ptr.arg_arg;
X flp = 1;
X if (arg->arg_type == O_AND || arg->arg_type == O_OR)
X goto morecontext;
X }
X if ((context & 3) == 3)
X return;
X
X if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
X cmd->c_flags |= opt;
X return; /* side effect, can't optimize */
X }
X
X if (arg->arg_type == O_ITEM || arg->arg_type == O_FLIP ||
X arg->arg_type == O_AND || arg->arg_type == O_OR) {
X if ((arg[flp].arg_type & A_MASK) == A_SINGLE) {
X opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE);
X cmd->c_short = str_smake(arg[flp].arg_ptr.arg_str);
X goto literal;
X }
X else if ((arg[flp].arg_type & A_MASK) == A_STAB ||
X (arg[flp].arg_type & A_MASK) == A_LVAL) {
X cmd->c_stab = arg[flp].arg_ptr.arg_stab;
X opt = CFT_REG;
X literal:
X if (!context) { /* no && or ||? */
X free_arg(arg);
X cmd->c_expr = Nullarg;
X }
X if (!(context & 1))
X cmd->c_flags |= CF_EQSURE;
X if (!(context & 2))
X cmd->c_flags |= CF_NESURE;
X }
X }
X else if (arg->arg_type == O_MATCH || arg->arg_type == O_SUBST ||
X arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
X if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
X (arg[2].arg_type & A_MASK) == A_SPAT &&
X arg[2].arg_ptr.arg_spat->spat_short ) {
X cmd->c_stab = arg[1].arg_ptr.arg_stab;
X cmd->c_short = str_smake(arg[2].arg_ptr.arg_spat->spat_short);
X cmd->c_slen = arg[2].arg_ptr.arg_spat->spat_slen;
X if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ALL &&
X !(arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ONCE) &&
X (arg->arg_type == O_MATCH || arg->arg_type == O_NMATCH) )
X sure |= CF_EQSURE; /* (SUBST must be forced even */
X /* if we know it will work.) */
X if (arg->arg_type != O_SUBST) {
X arg[2].arg_ptr.arg_spat->spat_short = Nullstr;
X arg[2].arg_ptr.arg_spat->spat_slen = 0; /* only one chk */
X }
X sure |= CF_NESURE; /* normally only sure if it fails */
X if (arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST)
X cmd->c_flags |= CF_FIRSTNEG;
X if (context & 1) { /* only sure if thing is false */
X if (cmd->c_flags & CF_FIRSTNEG)
X sure &= ~CF_NESURE;
X else
X sure &= ~CF_EQSURE;
X }
X else if (context & 2) { /* only sure if thing is true */
X if (cmd->c_flags & CF_FIRSTNEG)
X sure &= ~CF_EQSURE;
X else
X sure &= ~CF_NESURE;
X }
X if (sure & (CF_EQSURE|CF_NESURE)) { /* if we know anything*/
X if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANFIRST)
X opt = CFT_SCAN;
X else
X opt = CFT_ANCHOR;
X if (sure == (CF_EQSURE|CF_NESURE) /* really sure? */
X && arg->arg_type == O_MATCH
X && context & 4
X && fliporflop == 1) {
X spat_free(arg[2].arg_ptr.arg_spat);
X arg[2].arg_ptr.arg_spat = Nullspat; /* don't do twice */
X }
X cmd->c_flags |= sure;
X }
X }
X }
X else if (arg->arg_type == O_SEQ || arg->arg_type == O_SNE ||
X arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
X if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
X if (arg[2].arg_type == A_SINGLE) {
X cmd->c_stab = arg[1].arg_ptr.arg_stab;
X cmd->c_short = str_smake(arg[2].arg_ptr.arg_str);
X cmd->c_slen = cmd->c_short->str_cur+1;
X switch (arg->arg_type) {
X case O_SLT: case O_SGT:
X sure |= CF_EQSURE;
X cmd->c_flags |= CF_FIRSTNEG;
X break;
X case O_SNE:
X cmd->c_flags |= CF_FIRSTNEG;
X /* FALL THROUGH */
X case O_SEQ:
X sure |= CF_NESURE|CF_EQSURE;
X break;
X }
X if (context & 1) { /* only sure if thing is false */
X if (cmd->c_flags & CF_FIRSTNEG)
X sure &= ~CF_NESURE;
X else
X sure &= ~CF_EQSURE;
X }
X else if (context & 2) { /* only sure if thing is true */
X if (cmd->c_flags & CF_FIRSTNEG)
X sure &= ~CF_EQSURE;
X else
X sure &= ~CF_NESURE;
X }
X if (sure & (CF_EQSURE|CF_NESURE)) {
X opt = CFT_STROP;
X cmd->c_flags |= sure;
X }
X }
X }
X }
X else if (arg->arg_type == O_EQ || arg->arg_type == O_NE ||
X arg->arg_type == O_LE || arg->arg_type == O_GE ||
X arg->arg_type == O_LT || arg->arg_type == O_GT) {
X if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
X if (arg[2].arg_type == A_SINGLE) {
X cmd->c_stab = arg[1].arg_ptr.arg_stab;
X if (dowarn) {
X STR *str = arg[2].arg_ptr.arg_str;
X
X if ((!str->str_nok && !looks_like_number(str)))
X warn("Possible use of == on string value");
X }
X cmd->c_short = str_nmake(str_gnum(arg[2].arg_ptr.arg_str));
X cmd->c_slen = arg->arg_type;
X sure |= CF_NESURE|CF_EQSURE;
X if (context & 1) { /* only sure if thing is false */
X sure &= ~CF_EQSURE;
X }
X else if (context & 2) { /* only sure if thing is true */
X sure &= ~CF_NESURE;
X }
X if (sure & (CF_EQSURE|CF_NESURE)) {
X opt = CFT_NUMOP;
X cmd->c_flags |= sure;
X }
X }
X }
X }
X else if (arg->arg_type == O_ASSIGN &&
X (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
X arg[1].arg_ptr.arg_stab == defstab &&
X 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 opt = CFT_GETS;
X cmd->c_stab = arg2[1].arg_ptr.arg_stab;
X if (!(stab_io(arg2[1].arg_ptr.arg_stab)->flags & IOF_ARGV)) {
X free_arg(arg2);
X free_arg(arg);
X cmd->c_expr = Nullarg;
X }
X }
X }
X else if (arg->arg_type == O_CHOP &&
X (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) ) {
X opt = CFT_CHOP;
X cmd->c_stab = arg[1].arg_ptr.arg_stab;
X free_arg(arg);
X cmd->c_expr = Nullarg;
X }
X if (context & 4)
X opt |= CF_FLIP;
X cmd->c_flags |= opt;
X
X if (cmd->c_flags & CF_FLIP) {
X if (fliporflop == 1) {
X arg = cmd->c_expr; /* get back to O_FLIP arg */
X New(110,arg[3].arg_ptr.arg_cmd, 1, CMD);
X Copy(cmd, arg[3].arg_ptr.arg_cmd, 1, CMD);
X New(111,arg[4].arg_ptr.arg_cmd,1,CMD);
X Copy(cmd, arg[4].arg_ptr.arg_cmd, 1, CMD);
X opt_arg(arg[4].arg_ptr.arg_cmd,2,acmd);
X arg->arg_len = 2; /* this is a lie */
X }
X else {
X if ((opt & CF_OPTIMIZE) == CFT_EVAL)
X cmd->c_flags = (cmd->c_flags & ~CF_OPTIMIZE) | CFT_UNFLIP;
X }
X }
X}
X
XCMD *
Xadd_label(lbl,cmd)
Xchar *lbl;
Xregister CMD *cmd;
X{
X if (cmd)
X cmd->c_label = lbl;
X return cmd;
X}
X
XCMD *
Xaddcond(cmd, arg)
Xregister CMD *cmd;
Xregister ARG *arg;
X{
X cmd->c_expr = arg;
X opt_arg(cmd,1,0);
X cmd->c_flags |= CF_COND;
X return cmd;
X}
X
XCMD *
Xaddloop(cmd, arg)
Xregister CMD *cmd;
Xregister ARG *arg;
X{
X void while_io();
X
X cmd->c_expr = arg;
X opt_arg(cmd,1,0);
X cmd->c_flags |= CF_COND|CF_LOOP;
X
X if (!(cmd->c_flags & CF_INVERT))
X while_io(cmd); /* add $_ =, if necessary */
X
X if (cmd->c_type == C_BLOCK)
X cmd->c_flags &= ~CF_COND;
X else {
X arg = cmd->ucmd.acmd.ac_expr;
X if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
X cmd->c_flags &= ~CF_COND; /* "do {} while" happens at least once */
X if (arg && arg->arg_type == O_SUBR)
X cmd->c_flags &= ~CF_COND; /* likewise for "do subr() while" */
X }
X return cmd;
X}
X
XCMD *
Xinvert(cmd)
Xregister CMD *cmd;
X{
X if (cmd->c_head)
X cmd->c_head->c_flags ^= CF_INVERT;
X else
X cmd->c_flags ^= CF_INVERT;
X return cmd;
X}
X
Xyyerror(s)
Xchar *s;
X{
X char tmpbuf[258];
X char tmp2buf[258];
X char *tname = tmpbuf;
X
X if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
X oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
X strncpy(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
X tmp2buf[bufptr - oldoldbufptr] = '\0';
X sprintf(tname,"next 2 tokens \"%s\"",tmp2buf);
X }
X else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
X oldbufptr != bufptr) {
X strncpy(tmp2buf, oldbufptr, bufptr - oldbufptr);
X tmp2buf[bufptr - oldbufptr] = '\0';
X sprintf(tname,"next token \"%s\"",tmp2buf);
X }
X else if (yychar > 256)
X tname = "next token ???";
X else if (!yychar)
X (void)strcpy(tname,"at EOF");
X else if (yychar < 32)
X (void)sprintf(tname,"next char ^%c",yychar+64);
X else if (yychar == 127)
X (void)strcpy(tname,"at EOF");
X else
X (void)sprintf(tname,"next char %c",yychar);
X (void)sprintf(buf, "%s in file %s at line %d, %s\n",
X s,filename,line,tname);
X if (line == multi_end && multi_start < multi_end)
X sprintf(buf+strlen(buf),
X " (Might be a runaway multi-line %c%c string starting on line %d)\n",
X multi_open,multi_close,multi_start);
X if (in_eval)
X str_cat(stab_val(stabent("@",TRUE)),buf);
X else
X fputs(buf,stderr);
X if (++error_count >= 10)
X fatal("Too many errors\n");
X}
X
Xvoid
Xwhile_io(cmd)
Xregister CMD *cmd;
X{
X register ARG *arg = cmd->c_expr;
X STAB *asgnstab;
X
X /* hoist "while (<channel>)" up into command block */
X
X if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_READ) {
X cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
X cmd->c_flags |= CFT_GETS; /* and set it to do the input */
X cmd->c_stab = arg[1].arg_ptr.arg_stab;
X if (stab_io(arg[1].arg_ptr.arg_stab)->flags & IOF_ARGV) {
X cmd->c_expr = l(make_op(O_ASSIGN, 2, /* fake up "$_ =" */
X stab2arg(A_LVAL,defstab), arg, Nullarg,1 ));
X }
X else {
X free_arg(arg);
X cmd->c_expr = Nullarg;
X }
X }
X else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_INDREAD) {
X cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
X cmd->c_flags |= CFT_INDGETS; /* and set it to do the input */
X cmd->c_stab = arg[1].arg_ptr.arg_stab;
X free_arg(arg);
X cmd->c_expr = Nullarg;
X }
X else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_GLOB) {
X if ((cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY)
X asgnstab = cmd->c_stab;
X else
X asgnstab = defstab;
X cmd->c_expr = l(make_op(O_ASSIGN, 2, /* fake up "$foo =" */
X stab2arg(A_LVAL,asgnstab), arg, Nullarg,1 ));
X cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
X }
X}
X
XCMD *
Xwopt(cmd)
Xregister CMD *cmd;
X{
X register CMD *tail;
X CMD *newtail;
X register int i;
X
X while_io(cmd); /* add $_ =, if necessary */
X
X /* First find the end of the true list */
X
X tail = cmd->ucmd.ccmd.cc_true;
X if (tail == Nullcmd)
X return cmd;
X New(112,newtail, 1, CMD); /* guaranteed continue */
X for (;;) {
X /* optimize "next" to point directly to continue block */
X if (tail->c_type == C_EXPR &&
X tail->ucmd.acmd.ac_expr &&
X tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
X (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
X (cmd->c_label &&
X strEQ(cmd->c_label,
X tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
X {
X arg_free(tail->ucmd.acmd.ac_expr);
X tail->c_type = C_NEXT;
X if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
X tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
X else
X tail->ucmd.ccmd.cc_alt = newtail;
X tail->ucmd.ccmd.cc_true = Nullcmd;
X }
X else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
X if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
X tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
X else
X tail->ucmd.ccmd.cc_alt = newtail;
X }
X else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
X if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
X for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
X if (!tail->ucmd.scmd.sc_next[i])
X tail->ucmd.scmd.sc_next[i] = cmd->ucmd.ccmd.cc_alt;
X }
X else {
X for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
X if (!tail->ucmd.scmd.sc_next[i])
X tail->ucmd.scmd.sc_next[i] = newtail;
X }
X }
X
X if (!tail->c_next)
X break;
X tail = tail->c_next;
X }
X
X /* if there's a continue block, link it to true block and find end */
X
X if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
X tail->c_next = cmd->ucmd.ccmd.cc_alt;
X tail = tail->c_next;
X for (;;) {
X /* optimize "next" to point directly to continue block */
X if (tail->c_type == C_EXPR &&
X tail->ucmd.acmd.ac_expr &&
X tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
X (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
X (cmd->c_label &&
X strEQ(cmd->c_label,
X tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
X {
X arg_free(tail->ucmd.acmd.ac_expr);
X tail->c_type = C_NEXT;
X tail->ucmd.ccmd.cc_alt = newtail;
X tail->ucmd.ccmd.cc_true = Nullcmd;
X }
X else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
X tail->ucmd.ccmd.cc_alt = newtail;
X }
X else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
X for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
X if (!tail->ucmd.scmd.sc_next[i])
X tail->ucmd.scmd.sc_next[i] = newtail;
X }
X
X if (!tail->c_next)
X break;
X tail = tail->c_next;
X }
X for ( ; tail->c_next; tail = tail->c_next) ;
X }
X
X /* Here's the real trick: link the end of the list back to the beginning,
X * inserting a "last" block to break out of the loop. This saves one or
X * two procedure calls every time through the loop, because of how cmd_exec
X * does tail recursion.
X */
X
X tail->c_next = newtail;
X tail = newtail;
X if (!cmd->ucmd.ccmd.cc_alt)
X cmd->ucmd.ccmd.cc_alt = tail; /* every loop has a continue now */
X
X#ifndef lint
X (void)bcopy((char *)cmd, (char *)tail, sizeof(CMD));
X#endif
X tail->c_type = C_EXPR;
X tail->c_flags ^= CF_INVERT; /* turn into "last unless" */
X tail->c_next = tail->ucmd.ccmd.cc_true; /* loop directly back to top */
X tail->ucmd.acmd.ac_expr = make_op(O_LAST,0,Nullarg,Nullarg,Nullarg,0);
X tail->ucmd.acmd.ac_stab = Nullstab;
X return cmd;
X}
X
XCMD *
Xover(eachstab,cmd)
XSTAB *eachstab;
Xregister CMD *cmd;
X{
X /* hoist "for $foo (@bar)" up into command block */
X
X cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
X cmd->c_flags |= CFT_ARRAY; /* and set it to do the iteration */
X cmd->c_stab = eachstab;
X
X return cmd;
X}
X
Xcmd_free(cmd)
Xregister CMD *cmd;
X{
X register CMD *tofree;
X register CMD *head = cmd;
X
X while (cmd) {
X if (cmd->c_type != C_WHILE) { /* WHILE block is duplicated */
X if (cmd->c_label)
X Safefree(cmd->c_label);
X if (cmd->c_short)
X str_free(cmd->c_short);
X if (cmd->c_spat)
X spat_free(cmd->c_spat);
X if (cmd->c_expr)
X arg_free(cmd->c_expr);
X }
X switch (cmd->c_type) {
X case C_WHILE:
X case C_BLOCK:
X case C_ELSE:
X case C_IF:
X if (cmd->ucmd.ccmd.cc_true)
X cmd_free(cmd->ucmd.ccmd.cc_true);
X break;
X case C_EXPR:
X if (cmd->ucmd.acmd.ac_expr)
X arg_free(cmd->ucmd.acmd.ac_expr);
X break;
X }
X tofree = cmd;
X cmd = cmd->c_next;
X Safefree(tofree);
X if (cmd && cmd == head) /* reached end of while loop */
X break;
X }
X}
X
Xarg_free(arg)
Xregister ARG *arg;
X{
X register int i;
X
X for (i = 1; i <= arg->arg_len; i++) {
X switch (arg[i].arg_type & A_MASK) {
X case A_NULL:
X break;
X case A_LEXPR:
X case A_EXPR:
X arg_free(arg[i].arg_ptr.arg_arg);
X break;
X case A_CMD:
X cmd_free(arg[i].arg_ptr.arg_cmd);
X break;
X case A_WORD:
X case A_STAB:
X case A_LVAL:
X case A_READ:
X case A_GLOB:
X case A_ARYLEN:
X case A_LARYLEN:
X case A_ARYSTAB:
X case A_LARYSTAB:
X break;
X case A_SINGLE:
X case A_DOUBLE:
X case A_BACKTICK:
X str_free(arg[i].arg_ptr.arg_str);
X break;
X case A_SPAT:
X spat_free(arg[i].arg_ptr.arg_spat);
X break;
X }
X }
X free_arg(arg);
X}
X
Xspat_free(spat)
Xregister SPAT *spat;
X{
X register SPAT *sp;
X HENT *entry;
X
X if (spat->spat_runtime)
X arg_free(spat->spat_runtime);
X if (spat->spat_repl) {
X arg_free(spat->spat_repl);
X }
X if (spat->spat_short) {
X str_free(spat->spat_short);
X }
X if (spat->spat_regexp) {
X regfree(spat->spat_regexp);
X }
X
X /* now unlink from spat list */
X
X for (entry = defstash->tbl_array['_']; entry; entry = entry->hent_next) {
X register HASH *stash;
X STAB *stab = (STAB*)entry->hent_val;
X
X if (!stab)
X continue;
X stash = stab_hash(stab);
X if (!stash || stash->tbl_spatroot == Null(SPAT*))
X continue;
X if (stash->tbl_spatroot == spat)
X stash->tbl_spatroot = spat->spat_next;
X else {
X for (sp = stash->tbl_spatroot;
X sp && sp->spat_next != spat;
X sp = sp->spat_next)
X ;
X if (sp)
X sp->spat_next = spat->spat_next;
X }
X }
X Safefree(spat);
X}
X
X/* Recursively descend a command sequence and push the address of any string
X * that needs saving on recursion onto the tosave array.
X */
X
Xstatic int
Xcmd_tosave(cmd,willsave)
Xregister CMD *cmd;
Xint willsave; /* willsave passes down the tree */
X{
X register CMD *head = cmd;
X int shouldsave = FALSE; /* shouldsave passes up the tree */
X int tmpsave;
X register CMD *lastcmd = Nullcmd;
X
X while (cmd) {
X if (cmd->c_spat)
X shouldsave |= spat_tosave(cmd->c_spat);
X if (cmd->c_expr)
X shouldsave |= arg_tosave(cmd->c_expr,willsave);
X switch (cmd->c_type) {
X case C_WHILE:
X if (cmd->ucmd.ccmd.cc_true) {
X tmpsave = cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
X
X /* Here we check to see if the temporary array generated for
X * a foreach needs to be localized because of recursion.
X */
X if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY &&
X lastcmd &&
X lastcmd->c_type == C_EXPR &&
X lastcmd->ucmd.acmd.ac_expr) {
X ARG *arg = lastcmd->ucmd.acmd.ac_expr;
X
X if (arg->arg_type == O_ASSIGN &&
X arg[1].arg_type == A_LEXPR &&
X arg[1].arg_ptr.arg_arg->arg_type == O_LARRAY &&
X strnEQ("_GEN_",
X stab_name(arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab),
X 5)) { /* array generated for foreach */
X (void)localize(arg[1].arg_ptr.arg_arg);
X }
X }
X shouldsave |= tmpsave;
X }
X break;
X case C_BLOCK:
X case C_ELSE:
X case C_IF:
X if (cmd->ucmd.ccmd.cc_true)
X shouldsave |= cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
X break;
X case C_EXPR:
X if (cmd->ucmd.acmd.ac_expr)
X shouldsave |= arg_tosave(cmd->ucmd.acmd.ac_expr,willsave);
X break;
X }
X lastcmd = cmd;
X cmd = cmd->c_next;
X if (cmd && cmd == head) /* reached end of while loop */
X break;
X }
X return shouldsave;
X}
X
Xstatic int
Xarg_tosave(arg,willsave)
Xregister ARG *arg;
Xint willsave;
X{
X register int i;
X int shouldsave = FALSE;
X
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 shouldsave |= arg_tosave(arg[i].arg_ptr.arg_arg,shouldsave);
X break;
X case A_CMD:
X shouldsave |= cmd_tosave(arg[i].arg_ptr.arg_cmd,shouldsave);
X break;
X case A_WORD:
X case A_STAB:
X case A_LVAL:
X case A_READ:
X case A_GLOB:
X case A_ARYLEN:
X case A_SINGLE:
X case A_DOUBLE:
X case A_BACKTICK:
X break;
X case A_SPAT:
X shouldsave |= spat_tosave(arg[i].arg_ptr.arg_spat);
X break;
X }
X }
X switch (arg->arg_type) {
X case O_RETURN:
X saw_return = TRUE;
X break;
X case O_EVAL:
X case O_SUBR:
X shouldsave = TRUE;
X break;
X }
X if (willsave)
X (void)apush(tosave,arg->arg_ptr.arg_str);
X return shouldsave;
X}
X
Xstatic int
Xspat_tosave(spat)
Xregister SPAT *spat;
X{
X int shouldsave = FALSE;
X
X if (spat->spat_runtime)
X shouldsave |= arg_tosave(spat->spat_runtime,FALSE);
X if (spat->spat_repl) {
X shouldsave |= arg_tosave(spat->spat_repl,FALSE);
X }
X
X return shouldsave;
X}
X
!STUFFY!FUNK!
echo Extracting arg.h
sed >arg.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: arg.h,v 2.0.1.2 88/11/18 23:45:37 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 */
X
X#define O_NULL 0
X#define O_ITEM 1
X#define O_ITEM2 2
X#define O_ITEM3 3
X#define O_CONCAT 4
X#define O_MATCH 5
X#define O_NMATCH 6
X#define O_SUBST 7
X#define O_NSUBST 8
X#define O_ASSIGN 9
X#define O_MULTIPLY 10
X#define O_DIVIDE 11
X#define O_MODULO 12
X#define O_ADD 13
X#define O_SUBTRACT 14
X#define O_LEFT_SHIFT 15
X#define O_RIGHT_SHIFT 16
X#define O_LT 17
X#define O_GT 18
X#define O_LE 19
X#define O_GE 20
X#define O_EQ 21
X#define O_NE 22
X#define O_BIT_AND 23
X#define O_XOR 24
X#define O_BIT_OR 25
X#define O_AND 26
X#define O_OR 27
X#define O_COND_EXPR 28
X#define O_COMMA 29
X#define O_NEGATE 30
X#define O_NOT 31
X#define O_COMPLEMENT 32
X#define O_WRITE 33
X#define O_OPEN 34
X#define O_TRANS 35
X#define O_NTRANS 36
X#define O_CLOSE 37
X#define O_ARRAY 38
X#define O_HASH 39
X#define O_LARRAY 40
X#define O_LHASH 41
X#define O_PUSH 42
X#define O_POP 43
X#define O_SHIFT 44
X#define O_SPLIT 45
X#define O_LENGTH 46
X#define O_SPRINTF 47
X#define O_SUBSTR 48
X#define O_JOIN 49
X#define O_SLT 50
X#define O_SGT 51
X#define O_SLE 52
X#define O_SGE 53
X#define O_SEQ 54
X#define O_SNE 55
X#define O_SUBR 56
X#define O_PRINT 57
X#define O_CHDIR 58
X#define O_DIE 59
X#define O_EXIT 60
X#define O_RESET 61
X#define O_LIST 62
X#define O_SELECT 63
X#define O_EOF 64
X#define O_TELL 65
X#define O_SEEK 66
X#define O_LAST 67
X#define O_NEXT 68
X#define O_REDO 69
X#define O_GOTO 70
X#define O_INDEX 71
X#define O_TIME 72
X#define O_TMS 73
X#define O_LOCALTIME 74
X#define O_GMTIME 75
X#define O_STAT 76
X#define O_CRYPT 77
X#define O_EXP 78
X#define O_LOG 79
X#define O_SQRT 80
X#define O_INT 81
X#define O_PRTF 82
X#define O_ORD 83
X#define O_SLEEP 84
X#define O_FLIP 85
X#define O_FLOP 86
X#define O_KEYS 87
X#define O_VALUES 88
X#define O_EACH 89
X#define O_CHOP 90
X#define O_FORK 91
X#define O_EXEC 92
X#define O_SYSTEM 93
X#define O_OCT 94
X#define O_HEX 95
X#define O_CHMOD 96
X#define O_CHOWN 97
X#define O_KILL 98
X#define O_RENAME 99
X#define O_UNLINK 100
X#define O_UMASK 101
X#define O_UNSHIFT 102
X#define O_LINK 103
X#define O_REPEAT 104
X#define O_EVAL 105
X#define O_FTEREAD 106
X#define O_FTEWRITE 107
X#define O_FTEEXEC 108
X#define O_FTEOWNED 109
X#define O_FTRREAD 110
X#define O_FTRWRITE 111
X#define O_FTREXEC 112
X#define O_FTROWNED 113
X#define O_FTIS 114
X#define O_FTZERO 115
X#define O_FTSIZE 116
X#define O_FTFILE 117
X#define O_FTDIR 118
X#define O_FTLINK 119
X#define O_SYMLINK 120
X#define O_FTPIPE 121
X#define O_FTSOCK 122
X#define O_FTBLK 123
X#define O_FTCHR 124
X#define O_FTSUID 125
X#define O_FTSGID 126
X#define O_FTSVTX 127
X#define O_FTTTY 128
X#define O_DOFILE 129
X#define O_FTTEXT 130
X#define O_FTBINARY 131
X#define O_UTIME 132
X#define O_WAIT 133
X#define O_SORT 134
X#define O_DELETE 135
X#define O_STUDY 136
X#define O_ATAN2 137
X#define O_SIN 138
X#define O_COS 139
X#define O_RAND 140
X#define O_SRAND 141
X#define O_POW 142
X#define O_RETURN 143
X#define O_GETC 144
X#define O_MKDIR 145
X#define O_RMDIR 146
X#define O_GETPPID 147
X#define O_GETPGRP 148
X#define O_SETPGRP 149
X#define O_GETPRIORITY 150
X#define O_SETPRIORITY 151
X#define O_CHROOT 152
X#define O_IOCTL 153
X#define O_FCNTL 154
X#define O_FLOCK 155
X#define O_RINDEX 156
X#define O_PACK 157
X#define O_UNPACK 158
X#define O_READ 159
X#define O_WARN 160
X#define O_DBMOPEN 161
X#define O_DBMCLOSE 162
X#define O_ASLICE 163
X#define O_HSLICE 164
X#define O_LASLICE 165
X#define O_LHSLICE 166
X#define O_F_OR_R 167
X#define O_RANGE 168
X#define O_RCAT 169
X#define O_AASSIGN 170
X#define O_SASSIGN 171
X#define O_DUMP 172
X#define O_REVERSE 173
X#define O_ADDROF 174
X#define O_SOCKET 175
X#define O_BIND 176
X#define O_CONNECT 177
X#define O_LISTEN 178
X#define O_ACCEPT 179
X#define O_SEND 180
X#define O_RECV 181
X#define O_SSELECT 182
X#define O_SOCKETPAIR 183
X#define O_DBSUBR 184
X#define O_DEFINED 185
X#define O_UNDEF 186
X#define O_READLINK 187
X#define O_LSTAT 188
X#define O_AELEM 189
X#define O_HELEM 190
X#define O_LAELEM 191
X#define O_LHELEM 192
X#define O_LOCAL 193
X#define O_WANTARRAY 194
X#define O_FILENO 195
X#define O_GHBYNAME 196
X#define O_GHBYADDR 197
X#define O_GHOSTENT 198
X#define O_SHOSTENT 199
X#define O_EHOSTENT 200
X#define O_GSBYNAME 201
X#define O_GSBYPORT 202
X#define O_GSERVENT 203
X#define O_SSERVENT 204
X#define O_ESERVENT 205
X#define O_GPBYNAME 206
X#define O_GPBYNUMBER 207
X#define O_GPROTOENT 208
X#define O_SPROTOENT 209
X#define O_EPROTOENT 210
X#define O_GNBYNAME 211
X#define O_GNBYADDR 212
X#define O_GNETENT 213
X#define O_SNETENT 214
X#define O_ENETENT 215
X#define O_VEC 216
X#define O_GREP 217
X#define MAXO 218
X
X#ifndef DOINIT
Xextern char *opname[];
X#else
Xchar *opname[] = {
X "NULL",
X "ITEM",
X "ITEM2",
X "ITEM3",
X "CONCAT",
X "MATCH",
X "NMATCH",
X "SUBST",
X "NSUBST",
X "ASSIGN",
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 "BIT_AND",
X "XOR",
X "BIT_OR",
X "AND",
X "OR",
X "COND_EXPR",
X "COMMA",
X "NEGATE",
X "NOT",
X "COMPLEMENT",
X "WRITE",
X "OPEN",
X "TRANS",
X "NTRANS",
X "CLOSE",
X "ARRAY",
X "HASH",
X "LARRAY",
X "LHASH",
X "PUSH",
X "POP",
X "SHIFT",
X "SPLIT",
X "LENGTH",
X "SPRINTF",
X "SUBSTR",
X "JOIN",
X "SLT",
X "SGT",
X "SLE",
X "SGE",
X "SEQ",
X "SNE",
X "SUBR",
X "PRINT",
X "CHDIR",
X "DIE",
X "EXIT",
X "RESET",
X "LIST",
X "SELECT",
X "EOF",
X "TELL",
X "SEEK",
X "LAST",
X "NEXT",
X "REDO",
X "GOTO",/* shudder */
X "INDEX",
X "TIME",
X "TIMES",
X "LOCALTIME",
X "GMTIME",
X "STAT",
X "CRYPT",
X "EXP",
X "LOG",
X "SQRT",
X "INT",
X "PRINTF",
X "ORD",
X "SLEEP",
X "FLIP",
X "FLOP",
X "KEYS",
X "VALUES",
X "EACH",
X "CHOP",
X "FORK",
X "EXEC",
X "SYSTEM",
X "OCT",
X "HEX",
X "CHMOD",
X "CHOWN",
X "KILL",
X "RENAME",
X "UNLINK",
X "UMASK",
X "UNSHIFT",
X "LINK",
X "REPEAT",
X "EVAL",
X "FTEREAD",
X "FTEWRITE",
X "FTEEXEC",
X "FTEOWNED",
X "FTRREAD",
X "FTRWRITE",
X "FTREXEC",
X "FTROWNED",
X "FTIS",
X "FTZERO",
X "FTSIZE",
X "FTFILE",
X "FTDIR",
X "FTLINK",
X "SYMLINK",
X "FTPIPE",
X "FTSOCK",
X "FTBLK",
X "FTCHR",
X "FTSUID",
X "FTSGID",
X "FTSVTX",
X "FTTTY",
X "DOFILE",
X "FTTEXT",
X "FTBINARY",
X "UTIME",
X "WAIT",
X "SORT",
X "DELETE",
X "STUDY",
X "ATAN2",
X "SIN",
X "COS",
X "RAND",
X "SRAND",
X "POW",
X "RETURN",
X "GETC",
X "MKDIR",
X "RMDIR",
X "GETPPID",
X "GETPGRP",
X "SETPGRP",
X "GETPRIORITY",
X "SETPRIORITY",
X "CHROOT",
X "IOCTL",
X "FCNTL",
X "FLOCK",
X "RINDEX",
X "PACK",
X "UNPACK",
X "READ",
X "WARN",
X "DBMOPEN",
X "DBMCLOSE",
X "ASLICE",
X "HSLICE",
X "LASLICE",
X "LHSLICE",
X "FLIP_OR_RANGE",
X "RANGE",
X "RCAT",
X "AASSIGN",
X "SASSIGN",
X "DUMP",
X "REVERSE",
X "ADDRESS_OF",
X "SOCKET",
X "BIND",
X "CONNECT",
X "LISTEN",
X "ACCEPT",
X "SEND",
X "RECV",
X "SSELECT",
X "SOCKETPAIR",
X "DBSUBR",
X "DEFINED",
X "UNDEF",
X "READLINK",
X "LSTAT",
X "AELEM",
X "HELEM",
X "LAELEM",
X "LHELEM",
X "LOCAL",
X "WANTARRAY",
X "FILENO",
X "GHBYNAME",
X "GHBYADDR",
X "GHOSTENT",
X "SHOSTENT",
X "EHOSTENT",
X "GSBYNAME",
X "GSBYPORT",
X "GSERVENT",
X "SSERVENT",
X "ESERVENT",
X "GPBYNAME",
X "GPBYNUMBER",
X "GPROTOENT",
X "SPROTOENT",
X "EPROTOENT",
X "GNBYNAME",
X "GNBYADDR",
X "GNETENT",
X "SNETENT",
X "ENETENT",
X "VEC",
X "GREP",
X "218"
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
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 "20"
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 0, /* 20 */
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 char arg_type;
X unsigned char 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_UNUSED 32 /* */
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 char opargs[MAXO+1];
X#else
X#define A(e1,e2,e3) (e1+(e2<<2)+(e3<<4))
Xchar opargs[MAXO+1] = {
X A(0,0,0), /* NULL */
X A(1,0,0), /* ITEM */
X A(0,0,0), /* ITEM2 */
X A(0,0,0), /* ITEM3 */
X A(1,1,0), /* CONCAT */
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,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), /* 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), /* WRITE */
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), /* ARRAY */
X A(0,0,0), /* HASH */
X A(0,0,0), /* LARRAY */
X A(0,0,0), /* LHASH */
X A(0,3,0), /* PUSH */
X A(0,0,0), /* POP */
X A(0,0,0), /* SHIFT */
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), /* 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(0,3,0), /* SUBR */
X A(1,3,0), /* PRINT */
X A(1,0,0), /* CHDIR */
X A(0,3,0), /* DIE */
X A(1,0,0), /* EXIT */
X A(1,0,0), /* RESET */
X A(3,0,0), /* LIST */
X A(0,0,0), /* SELECT */
X A(1,0,0), /* EOF */
X A(1,0,0), /* TELL */
X A(1,1,1), /* SEEK */
X A(0,0,0), /* LAST */
X A(0,0,0), /* NEXT */
X A(0,0,0), /* REDO */
X A(0,0,0), /* GOTO */
X A(1,1,0), /* INDEX */
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,0,0), /* STAT */
X A(1,1,0), /* CRYPT */
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,3,0), /* PRINTF */
X A(1,0,0), /* ORD */
X A(1,0,0), /* SLEEP */
X A(1,0,0), /* FLIP */
X A(0,1,0), /* FLOP */
X A(0,0,0), /* KEYS */
X A(0,0,0), /* VALUES */
X A(0,0,0), /* EACH */
X A(3,0,0), /* CHOP */
X A(0,0,0), /* FORK */
X A(1,3,0), /* EXEC */
X A(1,3,0), /* SYSTEM */
X A(1,0,0), /* OCT */
X A(1,0,0), /* HEX */
X A(0,3,0), /* CHMOD */
X A(0,3,0), /* CHOWN */
X A(0,3,0), /* KILL */
X A(1,1,0), /* RENAME */
X A(0,3,0), /* UNLINK */
X A(1,0,0), /* UMASK */
X A(0,3,0), /* UNSHIFT */
X A(1,1,0), /* LINK */
X A(1,1,0), /* REPEAT */
X A(1,0,0), /* EVAL */
X A(1,0,0), /* FTEREAD */
X A(1,0,0), /* FTEWRITE */
X A(1,0,0), /* FTEEXEC */
X A(1,0,0), /* FTEOWNED */
X A(1,0,0), /* FTRREAD */
X A(1,0,0), /* FTRWRITE */
X A(1,0,0), /* FTREXEC */
X A(1,0,0), /* FTROWNED */
X A(1,0,0), /* FTIS */
X A(1,0,0), /* FTZERO */
X A(1,0,0), /* FTSIZE */
X A(1,0,0), /* FTFILE */
X A(1,0,0), /* FTDIR */
X A(1,0,0), /* FTLINK */
X A(1,1,0), /* SYMLINK */
X A(1,0,0), /* FTPIPE */
X A(1,0,0), /* FTSOCK */
X A(1,0,0), /* FTBLK */
X A(1,0,0), /* FTCHR */
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), /* DOFILE */
X A(1,0,0), /* FTTEXT */
X A(1,0,0), /* FTBINARY */
X A(0,3,0), /* UTIME */
X A(0,0,0), /* WAIT */
X A(0,3,0), /* SORT */
X A(0,1,0), /* DELETE */
X A(1,0,0), /* STUDY */
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,1,0), /* POW */
X A(3,0,0), /* RETURN */
X A(1,0,0), /* GETC */
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), /* IOCTL */
X A(1,1,1), /* FCNTL */
X A(1,1,0), /* FLOCK */
X A(1,1,0), /* RINDEX */
X A(1,3,0), /* PACK */
X A(1,1,0), /* UNPACK */
X A(1,1,1), /* READ */
X A(0,3,0), /* WARN */
X A(1,1,1), /* DBMOPEN */
X A(1,0,0), /* DBMCLOSE */
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(1,0,0), /* F_OR_R */
X A(1,1,0), /* RANGE */
X A(1,1,0), /* RCAT */
X A(3,3,0), /* AASSIGN */
X A(0,0,0), /* SASSIGN */
X A(0,0,0), /* DUMP */
X A(0,0,0), /* REVERSE */
X A(1,0,0), /* ADDROF */
X A(1,1,1), /* 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,1,2), /* SEND */
X A(1,1,1), /* RECV */
X A(1,1,1), /* SSELECT */
X A(1,1,1), /* SOCKETPAIR */
X A(0,3,0), /* DBSUBR */
X A(1,0,0), /* DEFINED */
X A(1,0,0), /* UNDEF */
X A(1,0,0), /* READLINK */
X A(1,0,0), /* LSTAT */
X A(0,1,0), /* AELEM */
X A(0,1,0), /* HELEM */
X A(0,1,0), /* LAELEM */
X A(0,1,0), /* LHELEM */
X A(1,0,0), /* LOCAL */
X A(0,0,0), /* WANTARRAY */
X A(1,0,0), /* FILENO */
X A(1,0,0), /* GHBYNAME */
X A(1,1,0), /* GHBYADDR */
X A(0,0,0), /* GHOSTENT */
X A(1,0,0), /* SHOSTENT */
X A(0,0,0), /* EHOSTENT */
X A(1,1,0), /* GSBYNAME */
X A(1,1,0), /* GSBYPORT */
X A(0,0,0), /* GSERVENT */
X A(1,0,0), /* SSERVENT */
X A(0,0,0), /* ESERVENT */
X A(1,0,0), /* GPBYNAME */
X A(1,0,0), /* GPBYNUMBER */
X A(0,0,0), /* GPROTOENT */
X A(1,0,0), /* SPROTOENT */
X A(0,0,0), /* EPROTOENT */
X A(1,0,0), /* GNBYNAME */
X A(1,1,0), /* GNBYADDR */
X A(0,0,0), /* GNETENT */
X A(1,0,0), /* SNETENT */
X A(0,0,0), /* ENETENT */
X A(1,1,1), /* VEC */
X A(0,3,0), /* GREP */
X 0
X};
X#undef A
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 Extracting t/op.exec
sed >t/op.exec <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.exec,v 2.0 88/06/05 00:13:46 root Exp $
X
X$| = 1; # flush stdout
Xprint "1..8\n";
X
Xprint "not ok 1\n" if system "echo ok \\1"; # shell interpreted
Xprint "not ok 2\n" if system "echo ok 2"; # split and directly called
Xprint "not ok 3\n" if system "echo", "ok", "3"; # directly called
X
Xif (system "true") {print "not ok 4\n";} else {print "ok 4\n";}
X
Xif ((system "/bin/sh -c 'exit 1'") != 256) { print "not "; }
Xprint "ok 5\n";
X
Xif ((system "lskdfj") == 255 << 8) {print "ok 6\n";} else {print "not ok 6\n";}
X
Xunless (exec "lskdjfalksdjfdjfkls") {print "ok 7\n";} else {print "not ok 7\n";}
X
Xexec "echo","ok","8";
!STUFFY!FUNK!
echo ""
echo "End of kit 9 (of 23)"
cat /dev/null >kit9isdone
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; 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
More information about the Alt.sources
mailing list