lwall@jato.Jpl.Nasa.Gov (Larry Wall) (09/03/89)
#! /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