Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/unix/volume20/perl3.0/part16

Internet Message Format | 1989-11-01 | 49.3 KB

Subject:  v20i099:  Perl, a language with features of C/sed/awk/shell/etc, Part16/24
Newsgroups: comp.sources.unix
Sender: sources
Approved: [e-mail]

Submitted-by: Larry Wall <[e-mail]>
Posting-number: Volume 20, Issue 99
Archive-name: perl3.0/part16

#! /bin/sh

# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 24 through sh.  When all 24 kits have been run, read README.

echo "This is perl 3.0 kit 16 (of 24).  If kit 16 is complete, the line"
echo '"'"End of kit 16 (of 24)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir x2p 2>/dev/null
echo Extracting x2p/a2py.c
sed >x2p/a2py.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: a2py.c,v 3.0 89/10/18 15:34:35 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:    a2py.c,v $
X * Revision 3.0  89/10/18  15:34:35  lwall
X * 3.0 baseline
X *
X */
X
X#include "util.h"
Xchar *index();
X
Xchar *filename;
X
Xint checkers = 0;
XSTR *walk();
X
Xmain(argc,argv,env)
Xregister int argc;
Xregister char **argv;
Xregister char **env;
X{
X    register STR *str;
X    register char *s;
X    int i;
X    STR *tmpstr;
X
X    linestr = str_new(80);
X    str = str_new(0);        /* first used for -I flags */
X    for (argc--,argv++; argc; argc--,argv++) {
X    if (argv[0][0] != '-' || !argv[0][1])
X        break;
X      reswitch:
X    switch (argv[0][1]) {
X#ifdef DEBUGGING
X    case 'D':
X        debug = atoi(argv[0]+2);
X#ifdef YYDEBUG
X        yydebug = (debug & 1);
X#endif
X        break;
X#endif
X    case '0': case '1': case '2': case '3': case '4':
X    case '5': case '6': case '7': case '8': case '9':
X        maxfld = atoi(argv[0]+1);
X        absmaxfld = TRUE;
X        break;
X    case 'F':
X        fswitch = argv[0][2];
X        break;
X    case 'n':
X        namelist = savestr(argv[0]+2);
X        break;
X    case '-':
X        argc--,argv++;
X        goto switch_end;
X    case 0:
X        break;
X    default:
X        fatal("Unrecognized switch: %s\n",argv[0]);
X    }
X    }
X  switch_end:
X
X    /* open script */
X
X    if (argv[0] == Nullch)
X    argv[0] = "-";
X    filename = savestr(argv[0]);
X    if (strEQ(filename,"-"))
X    argv[0] = "";
X    if (!*argv[0])
X    rsfp = stdin;
X    else
X    rsfp = fopen(argv[0],"r");
X    if (rsfp == Nullfp)
X    fatal("Awk script \"%s\" doesn't seem to exist.\n",filename);
X
X    /* init tokener */
X
X    bufptr = str_get(linestr);
X    symtab = hnew();
X    curarghash = hnew();
X
X    /* now parse the report spec */
X
X    if (yyparse())
X    fatal("Translation aborted due to syntax errors.\n");
X
X#ifdef DEBUGGING
X    if (debug & 2) {
X    int type, len;
X
X    for (i=1; i<mop;) {
X        type = ops[i].ival;
X        len = type >> 8;
X        type &= 255;
X        printf("%d\t%d\t%d\t%-10s",i++,type,len,opname[type]);
X        if (type == OSTRING)
X        printf("\t\"%s\"\n",ops[i].cval),i++;
X        else {
X        while (len--) {
X            printf("\t%d",ops[i].ival),i++;
X        }
X        putchar('\n');
X        }
X    }
X    }
X    if (debug & 8)
X    dump(root);
X#endif
X
X    /* first pass to look for numeric variables */
X
X    prewalk(0,0,root,&i);
X
X    /* second pass to produce new program */
X
X    tmpstr = walk(0,0,root,&i,P_MIN);
X    str = str_make("#!");
X    str_cat(str, BIN);
X    str_cat(str, "/perl\neval \"exec ");
X    str_cat(str, BIN);
X    str_cat(str, "/perl -S $0 $*\"\n\
X    if $running_under_some_shell;\n\
X            # this emulates #! processing on NIH machines.\n\
X            # (remove #! line above if indigestible)\n\n");
X    str_cat(str,
X      "eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;\n");
X    str_cat(str,
X      "            # process any FOO=bar switches\n\n");
X    if (do_opens && opens) {
X    str_scat(str,opens);
X    str_free(opens);
X    str_cat(str,"\n");
X    }
X    str_scat(str,tmpstr);
X    str_free(tmpstr);
X#ifdef DEBUGGING
X    if (!(debug & 16))
X#endif
X    fixup(str);
X    putlines(str);
X    if (checkers) {
X    fprintf(stderr,
X      "Please check my work on the %d line%s I've marked with \"#???\".\n",
X        checkers, checkers == 1 ? "" : "s" );
X    fprintf(stderr,
X      "The operation I've selected may be wrong for the operand types.\n");
X    }
X    exit(0);
X}
X
X#define RETURN(retval) return (bufptr = s,retval)
X#define XTERM(retval) return (expectterm = TRUE,bufptr = s,retval)
X#define XOP(retval) return (expectterm = FALSE,bufptr = s,retval)
X#define ID(x) return (yylval=string(x,0),expectterm = FALSE,bufptr = s,idtype)
X
Xint idtype;
X
Xyylex()
X{
X    register char *s = bufptr;
X    register char *d;
X    register int tmp;
X
X  retry:
X#ifdef YYDEBUG
X    if (yydebug)
X    if (index(s,'\n'))
X        fprintf(stderr,"Tokener at %s",s);
X    else
X        fprintf(stderr,"Tokener at %s\n",s);
X#endif
X    switch (*s) {
X    default:
X    fprintf(stderr,
X        "Unrecognized character %c in file %s line %d--ignoring.\n",
X         *s++,filename,line);
X    goto retry;
X    case '\\':
X    case 0:
X    s = str_get(linestr);
X    *s = '\0';
X    if (!rsfp)
X        RETURN(0);
X    line++;
X    if ((s = str_gets(linestr, rsfp)) == Nullch) {
X        if (rsfp != stdin)
X        fclose(rsfp);
X        rsfp = Nullfp;
X        s = str_get(linestr);
X        RETURN(0);
X    }
X    goto retry;
X    case ' ': case '\t':
X    s++;
X    goto retry;
X    case '\n':
X    *s = '\0';
X    XTERM(NEWLINE);
X    case '#':
X    yylval = string(s,0);
X    *s = '\0';
X    XTERM(COMMENT);
X    case ';':
X    tmp = *s++;
X    if (*s == '\n') {
X        s++;
X        XTERM(SEMINEW);
X    }
X    XTERM(tmp);
X    case '(':
X    tmp = *s++;
X    XTERM(tmp);
X    case '{':
X    case '[':
X    case ')':
X    case ']':
X    case '?':
X    case ':':
X    tmp = *s++;
X    XOP(tmp);
X    case 127:
X    s++;
X    XTERM('}');
X    case '}':
X    for (d = s + 1; isspace(*d); d++) ;
X    if (!*d)
X        s = d - 1;
X    *s = 127;
X    XTERM(';');
X    case ',':
X    tmp = *s++;
X    XTERM(tmp);
X    case '~':
X    s++;
X    yylval = string("~",1);
X    XTERM(MATCHOP);
X    case '+':
X    case '-':
X    if (s[1] == *s) {
X        s++;
X        if (*s++ == '+')
X        XTERM(INCR);
X        else
X        XTERM(DECR);
X    }
X    /* FALL THROUGH */
X    case '*':
X    case '%':
X    case '^':
X    tmp = *s++;
X    if (*s == '=') {
X        if (tmp == '^')
X        yylval = string("**=",3);
X        else
X        yylval = string(s-1,2);
X        s++;
X        XTERM(ASGNOP);
X    }
X    XTERM(tmp);
X    case '&':
X    s++;
X    tmp = *s++;
X    if (tmp == '&')
X        XTERM(ANDAND);
X    s--;
X    XTERM('&');
X    case '|':
X    s++;
X    tmp = *s++;
X    if (tmp == '|')
X        XTERM(OROR);
X    s--;
X    while (*s == ' ' || *s == '\t')
X        s++;
X    if (strnEQ(s,"getline",7))
X        XTERM('p');
X    else
X        XTERM('|');
X    case '=':
X    s++;
X    tmp = *s++;
X    if (tmp == '=') {
X        yylval = string("==",2);
X        XTERM(RELOP);
X    }
X    s--;
X    yylval = string("=",1);
X    XTERM(ASGNOP);
X    case '!':
X    s++;
X    tmp = *s++;
X    if (tmp == '=') {
X        yylval = string("!=",2);
X        XTERM(RELOP);
X    }
X    if (tmp == '~') {
X        yylval = string("!~",2);
X        XTERM(MATCHOP);
X    }
X    s--;
X    XTERM(NOT);
X    case '<':
X    s++;
X    tmp = *s++;
X    if (tmp == '=') {
X        yylval = string("<=",2);
X        XTERM(RELOP);
X    }
X    s--;
X    XTERM('<');
X    case '>':
X    s++;
X    tmp = *s++;
X    if (tmp == '>') {
X        yylval = string(">>",2);
X        XTERM(GRGR);
X    }
X    if (tmp == '=') {
X        yylval = string(">=",2);
X        XTERM(RELOP);
X    }
X    s--;
X    XTERM('>');
X
X#define SNARFWORD \
X    d = tokenbuf; \
X    while (isalpha(*s) || isdigit(*s) || *s == '_') \
X        *d++ = *s++; \
X    *d = '\0'; \
X    d = tokenbuf; \
X    if (*s == '(') \
X        idtype = USERFUN; \
X    else \
X        idtype = VAR;
X
X    case '$':
X    s++;
X    if (*s == '0') {
X        s++;
X        do_chop = TRUE;
X        need_entire = TRUE;
X        idtype = VAR;
X        ID("0");
X    }
X    do_split = TRUE;
X    if (isdigit(*s)) {
X        for (d = s; isdigit(*s); s++) ;
X        yylval = string(d,s-d);
X        tmp = atoi(d);
X        if (tmp > maxfld)
X        maxfld = tmp;
X        XOP(FIELD);
X    }
X    split_to_array = set_array_base = TRUE;
X    XOP(VFIELD);
X
X    case '/':            /* may either be division or pattern */
X    if (expectterm) {
X        s = scanpat(s);
X        XTERM(REGEX);
X    }
X    tmp = *s++;
X    if (*s == '=') {
X        yylval = string("/=",2);
X        s++;
X        XTERM(ASGNOP);
X    }
X    XTERM(tmp);
X
X    case '0': case '1': case '2': case '3': case '4':
X    case '5': case '6': case '7': case '8': case '9': case '.':
X    s = scannum(s);
X    XOP(NUMBER);
X    case '"':
X    s++;
X    s = cpy2(tokenbuf,s,s[-1]);
X    if (!*s)
X        fatal("String not terminated:\n%s",str_get(linestr));
X    s++;
X    yylval = string(tokenbuf,0);
X    XOP(STRING);
X
X    case 'a': case 'A':
X    SNARFWORD;
X    if (strEQ(d,"ARGC"))
X        set_array_base = TRUE;
X    if (strEQ(d,"ARGV")) {
X        yylval=numary(string("ARGV",0));
X        XOP(VAR);
X    }
X    if (strEQ(d,"atan2")) {
X        yylval = OATAN2;
X        XTERM(FUNN);
X    }
X    ID(d);
X    case 'b': case 'B':
X    SNARFWORD;
X    if (strEQ(d,"break"))
X        XTERM(BREAK);
X    if (strEQ(d,"BEGIN"))
X        XTERM(BEGIN);
X    ID(d);
X    case 'c': case 'C':
X    SNARFWORD;
X    if (strEQ(d,"continue"))
X        XTERM(CONTINUE);
X    if (strEQ(d,"cos")) {
X        yylval = OCOS;
X        XTERM(FUN1);
X    }
X    if (strEQ(d,"close")) {
X        do_fancy_opens = 1;
X        yylval = OCLOSE;
X        XTERM(FUN1);
X    }
X    if (strEQ(d,"chdir"))
X        *d = toupper(*d);
X    else if (strEQ(d,"crypt"))
X        *d = toupper(*d);
X    else if (strEQ(d,"chop"))
X        *d = toupper(*d);
X    else if (strEQ(d,"chmod"))
X        *d = toupper(*d);
X    else if (strEQ(d,"chown"))
X        *d = toupper(*d);
X    ID(d);
X    case 'd': case 'D':
X    SNARFWORD;
X    if (strEQ(d,"do"))
X        XTERM(DO);
X    if (strEQ(d,"delete"))
X        XTERM(DELETE);
X    if (strEQ(d,"die"))
X        *d = toupper(*d);
X    ID(d);
X    case 'e': case 'E':
X    SNARFWORD;
X    if (strEQ(d,"END"))
X        XTERM(END);
X    if (strEQ(d,"else"))
X        XTERM(ELSE);
X    if (strEQ(d,"exit")) {
X        saw_line_op = TRUE;
X        XTERM(EXIT);
X    }
X    if (strEQ(d,"exp")) {
X        yylval = OEXP;
X        XTERM(FUN1);
X    }
X    if (strEQ(d,"elsif"))
X        *d = toupper(*d);
X    else if (strEQ(d,"eq"))
X        *d = toupper(*d);
X    else if (strEQ(d,"eval"))
X        *d = toupper(*d);
X    else if (strEQ(d,"eof"))
X        *d = toupper(*d);
X    else if (strEQ(d,"each"))
X        *d = toupper(*d);
X    else if (strEQ(d,"exec"))
X        *d = toupper(*d);
X    ID(d);
X    case 'f': case 'F':
X    SNARFWORD;
X    if (strEQ(d,"FS")) {
X        saw_FS++;
X        if (saw_FS == 1 && in_begin) {
X        for (d = s; *d && isspace(*d); d++) ;
X        if (*d == '=') {
X            for (d++; *d && isspace(*d); d++) ;
X            if (*d == '"' && d[2] == '"')
X            const_FS = d[1];
X        }
X        }
X        ID(tokenbuf);
X    }
X    if (strEQ(d,"for"))
X        XTERM(FOR);
X    else if (strEQ(d,"function"))
X        XTERM(FUNCTION);
X    if (strEQ(d,"FILENAME"))
X        d = "ARGV";
X    if (strEQ(d,"foreach"))
X        *d = toupper(*d);
X    else if (strEQ(d,"format"))
X        *d = toupper(*d);
X    else if (strEQ(d,"fork"))
X        *d = toupper(*d);
X    else if (strEQ(d,"fh"))
X        *d = toupper(*d);
X    ID(d);
X    case 'g': case 'G':
X    SNARFWORD;
X    if (strEQ(d,"getline"))
X        XTERM(GETLINE);
X    if (strEQ(d,"gsub"))
X        XTERM(GSUB);
X    if (strEQ(d,"ge"))
X        *d = toupper(*d);
X    else if (strEQ(d,"gt"))
X        *d = toupper(*d);
X    else if (strEQ(d,"goto"))
X        *d = toupper(*d);
X    else if (strEQ(d,"gmtime"))
X        *d = toupper(*d);
X    ID(d);
X    case 'h': case 'H':
X    SNARFWORD;
X    if (strEQ(d,"hex"))
X        *d = toupper(*d);
X    ID(d);
X    case 'i': case 'I':
X    SNARFWORD;
X    if (strEQ(d,"if"))
X        XTERM(IF);
X    if (strEQ(d,"in"))
X        XTERM(IN);
X    if (strEQ(d,"index")) {
X        set_array_base = TRUE;
X        XTERM(INDEX);
X    }
X    if (strEQ(d,"int")) {
X        yylval = OINT;
X        XTERM(FUN1);
X    }
X    ID(d);
X    case 'j': case 'J':
X    SNARFWORD;
X    if (strEQ(d,"join"))
X        *d = toupper(*d);
X    ID(d);
X    case 'k': case 'K':
X    SNARFWORD;
X    if (strEQ(d,"keys"))
X        *d = toupper(*d);
X    else if (strEQ(d,"kill"))
X        *d = toupper(*d);
X    ID(d);
X    case 'l': case 'L':
X    SNARFWORD;
X    if (strEQ(d,"length")) {
X        yylval = OLENGTH;
X        XTERM(FUN1);
X    }
X    if (strEQ(d,"log")) {
X        yylval = OLOG;
X        XTERM(FUN1);
X    }
X    if (strEQ(d,"last"))
X        *d = toupper(*d);
X    else if (strEQ(d,"local"))
X        *d = toupper(*d);
X    else if (strEQ(d,"lt"))
X        *d = toupper(*d);
X    else if (strEQ(d,"le"))
X        *d = toupper(*d);
X    else if (strEQ(d,"locatime"))
X        *d = toupper(*d);
X    else if (strEQ(d,"link"))
X        *d = toupper(*d);
X    ID(d);
X    case 'm': case 'M':
X    SNARFWORD;
X    if (strEQ(d,"match")) {
X        set_array_base = TRUE;
X        XTERM(MATCH);
X    }
X    if (strEQ(d,"m"))
X        *d = toupper(*d);
X    ID(d);
X    case 'n': case 'N':
X    SNARFWORD;
X    if (strEQ(d,"NF"))
X        do_split = split_to_array = set_array_base = TRUE;
X    if (strEQ(d,"next")) {
X        saw_line_op = TRUE;
X        XTERM(NEXT);
X    }
X    if (strEQ(d,"ne"))
X        *d = toupper(*d);
X    ID(d);
X    case 'o': case 'O':
X    SNARFWORD;
X    if (strEQ(d,"ORS")) {
X        saw_ORS = TRUE;
X        d = "\\";
X    }
X    if (strEQ(d,"OFS")) {
X        saw_OFS = TRUE;
X        d = ",";
X    }
X    if (strEQ(d,"OFMT")) {
X        d = "#";
X    }
X    if (strEQ(d,"open"))
X        *d = toupper(*d);
X    else if (strEQ(d,"ord"))
X        *d = toupper(*d);
X    else if (strEQ(d,"oct"))
X        *d = toupper(*d);
X    ID(d);
X    case 'p': case 'P':
X    SNARFWORD;
X    if (strEQ(d,"print")) {
X        XTERM(PRINT);
X    }
X    if (strEQ(d,"printf")) {
X        XTERM(PRINTF);
X    }
X    if (strEQ(d,"push"))
X        *d = toupper(*d);
X    else if (strEQ(d,"pop"))
X        *d = toupper(*d);
X    ID(d);
X    case 'q': case 'Q':
X    SNARFWORD;
X    ID(d);
X    case 'r': case 'R':
X    SNARFWORD;
X    if (strEQ(d,"RS")) {
X        d = "/";
X        saw_RS = TRUE;
X    }
X    if (strEQ(d,"rand")) {
X        yylval = ORAND;
X        XTERM(FUN1);
X    }
X    if (strEQ(d,"return"))
X        XTERM(RET);
X    if (strEQ(d,"reset"))
X        *d = toupper(*d);
X    else if (strEQ(d,"redo"))
X        *d = toupper(*d);
X    else if (strEQ(d,"rename"))
X        *d = toupper(*d);
X    ID(d);
X    case 's': case 'S':
X    SNARFWORD;
X    if (strEQ(d,"split")) {
X        set_array_base = TRUE;
X        XOP(SPLIT);
X    }
X    if (strEQ(d,"substr")) {
X        set_array_base = TRUE;
X        XTERM(SUBSTR);
X    }
X    if (strEQ(d,"sub"))
X        XTERM(SUB);
X    if (strEQ(d,"sprintf"))
X        XTERM(SPRINTF);
X    if (strEQ(d,"sqrt")) {
X        yylval = OSQRT;
X        XTERM(FUN1);
X    }
X    if (strEQ(d,"SUBSEP")) {
X        d = ";";
X    }
X    if (strEQ(d,"sin")) {
X        yylval = OSIN;
X        XTERM(FUN1);
X    }
X    if (strEQ(d,"srand")) {
X        yylval = OSRAND;
X        XTERM(FUN1);
X    }
X    if (strEQ(d,"system")) {
X        yylval = OSYSTEM;
X        XTERM(FUN1);
X    }
X    if (strEQ(d,"s"))
X        *d = toupper(*d);
X    else if (strEQ(d,"shift"))
X        *d = toupper(*d);
X    else if (strEQ(d,"select"))
X        *d = toupper(*d);
X    else if (strEQ(d,"seek"))
X        *d = toupper(*d);
X    else if (strEQ(d,"stat"))
X        *d = toupper(*d);
X    else if (strEQ(d,"study"))
X        *d = toupper(*d);
X    else if (strEQ(d,"sleep"))
X        *d = toupper(*d);
X    else if (strEQ(d,"symlink"))
X        *d = toupper(*d);
X    else if (strEQ(d,"sort"))
X        *d = toupper(*d);
X    ID(d);
X    case 't': case 'T':
X    SNARFWORD;
X    if (strEQ(d,"tr"))
X        *d = toupper(*d);
X    else if (strEQ(d,"tell"))
X        *d = toupper(*d);
X    else if (strEQ(d,"time"))
X        *d = toupper(*d);
X    else if (strEQ(d,"times"))
X        *d = toupper(*d);
X    ID(d);
X    case 'u': case 'U':
X    SNARFWORD;
X    if (strEQ(d,"until"))
X        *d = toupper(*d);
X    else if (strEQ(d,"unless"))
X        *d = toupper(*d);
X    else if (strEQ(d,"umask"))
X        *d = toupper(*d);
X    else if (strEQ(d,"unshift"))
X        *d = toupper(*d);
X    else if (strEQ(d,"unlink"))
X        *d = toupper(*d);
X    else if (strEQ(d,"utime"))
X        *d = toupper(*d);
X    ID(d);
X    case 'v': case 'V':
X    SNARFWORD;
X    if (strEQ(d,"values"))
X        *d = toupper(*d);
X    ID(d);
X    case 'w': case 'W':
X    SNARFWORD;
X    if (strEQ(d,"while"))
X        XTERM(WHILE);
X    if (strEQ(d,"write"))
X        *d = toupper(*d);
X    else if (strEQ(d,"wait"))
X        *d = toupper(*d);
X    ID(d);
X    case 'x': case 'X':
X    SNARFWORD;
X    if (strEQ(d,"x"))
X        *d = toupper(*d);
X    ID(d);
X    case 'y': case 'Y':
X    SNARFWORD;
X    if (strEQ(d,"y"))
X        *d = toupper(*d);
X    ID(d);
X    case 'z': case 'Z':
X    SNARFWORD;
X    ID(d);
X    }
X}
X
Xchar *
Xscanpat(s)
Xregister char *s;
X{
X    register char *d;
X
X    switch (*s++) {
X    case '/':
X    break;
X    default:
X    fatal("Search pattern not found:\n%s",str_get(linestr));
X    }
X
X    d = tokenbuf;
X    for (; *s; s++,d++) {
X    if (*s == '\\') {
X        if (s[1] == '/')
X        *d++ = *s++;
X        else if (s[1] == '\\')
X        *d++ = *s++;
X    }
X    else if (*s == '[') {
X        *d++ = *s++;
X        do {
X        if (*s == '\\' && s[1])
X            *d++ = *s++;
X        if (*s == '/' || (*s == '-' && s[1] == ']'))
X            *d++ = '\\';
X        *d++ = *s++;
X        } while (*s && *s != ']');
X    }
X    else if (*s == '/')
X        break;
X    *d = *s;
X    }
X    *d = '\0';
X
X    if (!*s)
X    fatal("Search pattern not terminated:\n%s",str_get(linestr));
X    s++;
X    yylval = string(tokenbuf,0);
X    return s;
X}
X
Xyyerror(s)
Xchar *s;
X{
X    fprintf(stderr,"%s in file %s at line %d\n",
X      s,filename,line);
X}
X
Xchar *
Xscannum(s)
Xregister char *s;
X{
X    register char *d;
X
X    switch (*s) {
X    case '1': case '2': case '3': case '4': case '5':
X    case '6': case '7': case '8': case '9': case '0' : case '.':
X    d = tokenbuf;
X    while (isdigit(*s)) {
X        *d++ = *s++;
X    }
X    if (*s == '.' && index("0123456789eE",s[1])) {
X        *d++ = *s++;
X        while (isdigit(*s)) {
X        *d++ = *s++;
X        }
X    }
X    if (index("eE",*s) && index("+-0123456789",s[1])) {
X        *d++ = *s++;
X        if (*s == '+' || *s == '-')
X        *d++ = *s++;
X        while (isdigit(*s))
X        *d++ = *s++;
X    }
X    *d = '\0';
X    yylval = string(tokenbuf,0);
X    break;
X    }
X    return s;
X}
X
Xstring(ptr,len)
Xchar *ptr;
X{
X    int retval = mop;
X
X    ops[mop++].ival = OSTRING + (1<<8);
X    if (!len)
X    len = strlen(ptr);
X    ops[mop].cval = safemalloc(len+1);
X    strncpy(ops[mop].cval,ptr,len);
X    ops[mop++].cval[len] = '\0';
X    if (mop >= OPSMAX)
X    fatal("Recompile a2p with larger OPSMAX\n");
X    return retval;
X}
X
Xoper0(type)
Xint type;
X{
X    int retval = mop;
X
X    if (type > 255)
X    fatal("type > 255 (%d)\n",type);
X    ops[mop++].ival = type;
X    if (mop >= OPSMAX)
X    fatal("Recompile a2p with larger OPSMAX\n");
X    return retval;
X}
X
Xoper1(type,arg1)
Xint type;
Xint arg1;
X{
X    int retval = mop;
X
X    if (type > 255)
X    fatal("type > 255 (%d)\n",type);
X    ops[mop++].ival = type + (1<<8);
X    ops[mop++].ival = arg1;
X    if (mop >= OPSMAX)
X    fatal("Recompile a2p with larger OPSMAX\n");
X    return retval;
X}
X
Xoper2(type,arg1,arg2)
Xint type;
Xint arg1;
Xint arg2;
X{
X    int retval = mop;
X
X    if (type > 255)
X    fatal("type > 255 (%d)\n",type);
X    ops[mop++].ival = type + (2<<8);
X    ops[mop++].ival = arg1;
X    ops[mop++].ival = arg2;
X    if (mop >= OPSMAX)
X    fatal("Recompile a2p with larger OPSMAX\n");
X    return retval;
X}
X
Xoper3(type,arg1,arg2,arg3)
Xint type;
Xint arg1;
Xint arg2;
Xint arg3;
X{
X    int retval = mop;
X
X    if (type > 255)
X    fatal("type > 255 (%d)\n",type);
X    ops[mop++].ival = type + (3<<8);
X    ops[mop++].ival = arg1;
X    ops[mop++].ival = arg2;
X    ops[mop++].ival = arg3;
X    if (mop >= OPSMAX)
X    fatal("Recompile a2p with larger OPSMAX\n");
X    return retval;
X}
X
Xoper4(type,arg1,arg2,arg3,arg4)
Xint type;
Xint arg1;
Xint arg2;
Xint arg3;
Xint arg4;
X{
X    int retval = mop;
X
X    if (type > 255)
X    fatal("type > 255 (%d)\n",type);
X    ops[mop++].ival = type + (4<<8);
X    ops[mop++].ival = arg1;
X    ops[mop++].ival = arg2;
X    ops[mop++].ival = arg3;
X    ops[mop++].ival = arg4;
X    if (mop >= OPSMAX)
X    fatal("Recompile a2p with larger OPSMAX\n");
X    return retval;
X}
X
Xoper5(type,arg1,arg2,arg3,arg4,arg5)
Xint type;
Xint arg1;
Xint arg2;
Xint arg3;
Xint arg4;
Xint arg5;
X{
X    int retval = mop;
X
X    if (type > 255)
X    fatal("type > 255 (%d)\n",type);
X    ops[mop++].ival = type + (5<<8);
X    ops[mop++].ival = arg1;
X    ops[mop++].ival = arg2;
X    ops[mop++].ival = arg3;
X    ops[mop++].ival = arg4;
X    ops[mop++].ival = arg5;
X    if (mop >= OPSMAX)
X    fatal("Recompile a2p with larger OPSMAX\n");
X    return retval;
X}
X
Xint depth = 0;
X
Xdump(branch)
Xint branch;
X{
X    register int type;
X    register int len;
X    register int i;
X
X    type = ops[branch].ival;
X    len = type >> 8;
X    type &= 255;
X    for (i=depth; i; i--)
X    printf(" ");
X    if (type == OSTRING) {
X    printf("%-5d\"%s\"\n",branch,ops[branch+1].cval);
X    }
X    else {
X    printf("(%-5d%s %d\n",branch,opname[type],len);
X    depth++;
X    for (i=1; i<=len; i++)
X        dump(ops[branch+i].ival);
X    depth--;
X    for (i=depth; i; i--)
X        printf(" ");
X    printf(")\n");
X    }
X}
X
Xbl(arg,maybe)
Xint arg;
Xint maybe;
X{
X    if (!arg)
X    return 0;
X    else if ((ops[arg].ival & 255) != OBLOCK)
X    return oper2(OBLOCK,arg,maybe);
X    else if ((ops[arg].ival >> 8) < 2)
X    return oper2(OBLOCK,ops[arg+1].ival,maybe);
X    else
X    return arg;
X}
X
Xfixup(str)
XSTR *str;
X{
X    register char *s;
X    register char *t;
X
X    for (s = str->str_ptr; *s; s++) {
X    if (*s == ';' && s[1] == ' ' && s[2] == '\n') {
X        strcpy(s+1,s+2);
X        s++;
X    }
X    else if (*s == '\n') {
X        for (t = s+1; isspace(*t & 127); t++) ;
X        t--;
X        while (isspace(*t & 127) && *t != '\n') t--;
X        if (*t == '\n' && t-s > 1) {
X        if (s[-1] == '{')
X            s--;
X        strcpy(s+1,t);
X        }
X        s++;
X    }
X    }
X}
X
Xputlines(str)
XSTR *str;
X{
X    register char *d, *s, *t, *e;
X    register int pos, newpos;
X
X    d = tokenbuf;
X    pos = 0;
X    for (s = str->str_ptr; *s; s++) {
X    *d++ = *s;
X    pos++;
X    if (*s == '\n') {
X        *d = '\0';
X        d = tokenbuf;
X        pos = 0;
X        putone();
X    }
X    else if (*s == '\t')
X        pos += 7;
X    if (pos > 78) {        /* split a long line? */
X        *d-- = '\0';
X        newpos = 0;
X        for (t = tokenbuf; isspace(*t & 127); t++) {
X        if (*t == '\t')
X            newpos += 8;
X        else
X            newpos += 1;
X        }
X        e = d;
X        while (d > tokenbuf && (*d != ' ' || d[-1] != ';'))
X        d--;
X        if (d < t+10) {
X        d = e;
X        while (d > tokenbuf &&
X          (*d != ' ' || d[-1] != '|' || d[-2] != '|') )
X            d--;
X        }
X        if (d < t+10) {
X        d = e;
X        while (d > tokenbuf &&
X          (*d != ' ' || d[-1] != '&' || d[-2] != '&') )
X            d--;
X        }
X        if (d < t+10) {
X        d = e;
X        while (d > tokenbuf && (*d != ' ' || d[-1] != ','))
X            d--;
X        }
X        if (d < t+10) {
X        d = e;
X        while (d > tokenbuf && *d != ' ')
X            d--;
X        }
X        if (d > t+3) {
X        *d = '\0';
X        putone();
X        putchar('\n');
X        if (d[-1] != ';' && !(newpos % 4)) {
X            *t++ = ' ';
X            *t++ = ' ';
X            newpos += 2;
X        }
X        strcpy(t,d+1);
X        newpos += strlen(t);
X        d = t + strlen(t);
X        pos = newpos;
X        }
X        else
X        d = e + 1;
X    }
X    }
X}
X
Xputone()
X{
X    register char *t;
X
X    for (t = tokenbuf; *t; t++) {
X    *t &= 127;
X    if (*t == 127) {
X        *t = ' ';
X        strcpy(t+strlen(t)-1, "\t#???\n");
X        checkers++;
X    }
X    }
X    t = tokenbuf;
X    if (*t == '#') {
X    if (strnEQ(t,"#!/bin/awk",10) || strnEQ(t,"#! /bin/awk",11))
X        return;
X    if (strnEQ(t,"#!/usr/bin/awk",14) || strnEQ(t,"#! /usr/bin/awk",15))
X        return;
X    }
X    fputs(tokenbuf,stdout);
X}
X
Xnumary(arg)
Xint arg;
X{
X    STR *key;
X    int dummy;
X
X    key = walk(0,0,arg,&dummy,P_MIN);
X    str_cat(key,"[]");
X    hstore(symtab,key->str_ptr,str_make("1"));
X    str_free(key);
X    set_array_base = TRUE;
X    return arg;
X}
X
Xrememberargs(arg)
Xint arg;
X{
X    int type;
X    STR *str;
X
X    if (!arg)
X    return arg;
X    type = ops[arg].ival & 255;
X    if (type == OCOMMA) {
X    rememberargs(ops[arg+1].ival);
X    rememberargs(ops[arg+3].ival);
X    }
X    else if (type == OVAR) {
X    str = str_new(0);
X    hstore(curarghash,ops[ops[arg+1].ival+1].cval,str);
X    }
X    else
X    fatal("panic: unknown argument type %d, line %d\n",type,line);
X    return arg;
X}
X
Xaryrefarg(arg)
Xint arg;
X{
X    int type = ops[arg].ival & 255;
X    STR *str;
X
X    if (type != OSTRING)
X    fatal("panic: aryrefarg %d, line %d\n",type,line);
X    str = hfetch(curarghash,ops[arg+1].cval);
X    if (str)
X    str_set(str,"*");
X    return arg;
X}
X
Xfixfargs(name,arg,prevargs)
Xint name;
Xint arg;
Xint prevargs;
X{
X    int type;
X    STR *str;
X    int numargs;
X
X    if (!arg)
X    return prevargs;
X    type = ops[arg].ival & 255;
X    if (type == OCOMMA) {
X    numargs = fixfargs(name,ops[arg+1].ival,prevargs);
X    numargs = fixfargs(name,ops[arg+3].ival,numargs);
X    }
X    else if (type == OVAR) {
X    str = hfetch(curarghash,ops[ops[arg+1].ival+1].cval);
X    if (strEQ(str_get(str),"*")) {
X        char tmpbuf[128];
X
X        str_set(str,"");        /* in case another routine has this */
X        ops[arg].ival &= ~255;
X        ops[arg].ival |= OSTAR;
X        sprintf(tmpbuf,"%s:%d",ops[name+1].cval,prevargs);
X        fprintf(stderr,"Adding %s\n",tmpbuf);
X        str = str_new(0);
X        str_set(str,"*");
X        hstore(curarghash,tmpbuf,str);
X    }
X    numargs = prevargs + 1;
X    }
X    else
X    fatal("panic: unknown argument type %d, arg %d, line %d\n",
X      type,numargs+1,line);
X    return numargs;
X}
X
Xfixrargs(name,arg,prevargs)
Xchar *name;
Xint arg;
Xint prevargs;
X{
X    int type;
X    STR *str;
X    int numargs;
X
X    if (!arg)
X    return prevargs;
X    type = ops[arg].ival & 255;
X    if (type == OCOMMA) {
X    numargs = fixrargs(name,ops[arg+1].ival,prevargs);
X    numargs = fixrargs(name,ops[arg+3].ival,numargs);
X    }
X    else {
X    char tmpbuf[128];
X
X    sprintf(tmpbuf,"%s:%d",name,prevargs);
X    str = hfetch(curarghash,tmpbuf);
X    fprintf(stderr,"Looking for %s\n",tmpbuf);
X    if (str && strEQ(str->str_ptr,"*")) {
X        if (type == OVAR || type == OSTAR) {
X        ops[arg].ival &= ~255;
X        ops[arg].ival |= OSTAR;
X        }
X        else
X        fatal("Can't pass expression by reference as arg %d of %s\n",
X            prevargs+1, name);
X    }
X    numargs = prevargs + 1;
X    }
X    return numargs;
X}
X
!STUFFY!FUNK!
echo Extracting dolist.c
sed >dolist.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: dolist.c,v 3.0 89/10/18 15:11:02 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:    dolist.c,v $
X * Revision 3.0  89/10/18  15:11:02  lwall
X * 3.0 baseline
X *
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X
X
Xint
Xdo_match(str,arg,gimme,arglast)
XSTR *str;
Xregister ARG *arg;
Xint gimme;
Xint *arglast;
X{
X    register STR **st = stack->ary_array;
X    register SPAT *spat = arg[2].arg_ptr.arg_spat;
X    register char *t;
X    register int sp = arglast[0] + 1;
X    STR *srchstr = st[sp];
X    register char *s = str_get(st[sp]);
X    char *strend = s + st[sp]->str_cur;
X    STR *tmpstr;
X
X    if (!spat) {
X    if (gimme == G_ARRAY)
X        return --sp;
X    str_set(str,Yes);
X    STABSET(str);
X    st[sp] = str;
X    return sp;
X    }
X    if (!s)
X    fatal("panic: do_match");
X    if (spat->spat_flags & SPAT_USED) {
X#ifdef DEBUGGING
X    if (debug & 8)
X        deb("2.SPAT USED\n");
X#endif
X    if (gimme == G_ARRAY)
X        return --sp;
X    str_set(str,No);
X    STABSET(str);
X    st[sp] = str;
X    return sp;
X    }
X    --sp;
X    if (spat->spat_runtime) {
X    nointrp = "|)";
X    sp = eval(spat->spat_runtime,G_SCALAR,sp);
X    st = stack->ary_array;
X    t = str_get(tmpstr = st[sp--]);
X    nointrp = "";
X#ifdef DEBUGGING
X    if (debug & 8)
X        deb("2.SPAT /%s/\n",t);
X#endif
X    if (spat->spat_regexp)
X        regfree(spat->spat_regexp);
X    spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
X        spat->spat_flags & SPAT_FOLD,1);
X    if (!*spat->spat_regexp->precomp && lastspat)
X        spat = lastspat;
X    if (spat->spat_flags & SPAT_KEEP) {
X        arg_free(spat->spat_runtime);    /* it won't change, so */
X        spat->spat_runtime = Nullarg;    /* no point compiling again */
X    }
X    if (!spat->spat_regexp->nparens)
X        gimme = G_SCALAR;            /* accidental array context? */
X    if (regexec(spat->spat_regexp, s, strend, s, 0,
X      srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
X      gimme == G_ARRAY)) {
X        if (spat->spat_regexp->subbase)
X        curspat = spat;
X        lastspat = spat;
X        goto gotcha;
X    }
X    else {
X        if (gimme == G_ARRAY)
X        return sp;
X        str_sset(str,&str_no);
X        STABSET(str);
X        st[++sp] = str;
X        return sp;
X    }
X    }
X    else {
X#ifdef DEBUGGING
X    if (debug & 8) {
X        char ch;
X
X        if (spat->spat_flags & SPAT_ONCE)
X        ch = '?';
X        else
X        ch = '/';
X        deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
X    }
X#endif
X    if (!*spat->spat_regexp->precomp && lastspat)
X        spat = lastspat;
X    t = s;
X    if (hint) {
X        if (hint < s || hint > strend)
X        fatal("panic: hint in do_match");
X        s = hint;
X        hint = Nullch;
X        if (spat->spat_regexp->regback >= 0) {
X        s -= spat->spat_regexp->regback;
X        if (s < t)
X            s = t;
X        }
X        else
X        s = t;
X    }
X    else if (spat->spat_short) {
X        if (spat->spat_flags & SPAT_SCANFIRST) {
X        if (srchstr->str_pok & SP_STUDIED) {
X            if (screamfirst[spat->spat_short->str_rare] < 0)
X            goto nope;
X            else if (!(s = screaminstr(srchstr,spat->spat_short)))
X            goto nope;
X            else if (spat->spat_flags & SPAT_ALL)
X            goto yup;
X        }
X#ifndef lint
X        else if (!(s = fbminstr((unsigned char*)s,
X          (unsigned char*)strend, spat->spat_short)))
X            goto nope;
X#endif
X        else if (spat->spat_flags & SPAT_ALL)
X            goto yup;
X        if (s && spat->spat_regexp->regback >= 0) {
X            ++spat->spat_short->str_u.str_useful;
X            s -= spat->spat_regexp->regback;
X            if (s < t)
X            s = t;
X        }
X        else
X            s = t;
X        }
X        else if (!multiline && (*spat->spat_short->str_ptr != *s ||
X          bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
X        goto nope;
X        if (--spat->spat_short->str_u.str_useful < 0) {
X        str_free(spat->spat_short);
X        spat->spat_short = Nullstr;    /* opt is being useless */
X        }
X    }
X    if (!spat->spat_regexp->nparens)
X        gimme = G_SCALAR;            /* accidental array context? */
X    if (regexec(spat->spat_regexp, s, strend, t, 0,
X      srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
X      gimme == G_ARRAY)) {
X        if (spat->spat_regexp->subbase)
X        curspat = spat;
X        lastspat = spat;
X        if (spat->spat_flags & SPAT_ONCE)
X        spat->spat_flags |= SPAT_USED;
X        goto gotcha;
X    }
X    else {
X        if (gimme == G_ARRAY)
X        return sp;
X        str_sset(str,&str_no);
X        STABSET(str);
X        st[++sp] = str;
X        return sp;
X    }
X    }
X    /*NOTREACHED*/
X
X  gotcha:
X    if (gimme == G_ARRAY) {
X    int iters, i, len;
X
X    iters = spat->spat_regexp->nparens;
X    if (sp + iters >= stack->ary_max) {
X        astore(stack,sp + iters, Nullstr);
X        st = stack->ary_array;        /* possibly realloced */
X    }
X
X    for (i = 1; i <= iters; i++) {
X        st[++sp] = str_static(&str_no);
X        if (s = spat->spat_regexp->startp[i]) {
X        len = spat->spat_regexp->endp[i] - s;
X        if (len > 0)
X            str_nset(st[sp],s,len);
X        }
X    }
X    return sp;
X    }
X    else {
X    str_sset(str,&str_yes);
X    STABSET(str);
X    st[++sp] = str;
X    return sp;
X    }
X
Xyup:
X    ++spat->spat_short->str_u.str_useful;
X    lastspat = spat;
X    if (spat->spat_flags & SPAT_ONCE)
X    spat->spat_flags |= SPAT_USED;
X    if (sawampersand) {
X    char *tmps;
X
X    tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t);
X    tmps = spat->spat_regexp->startp[0] = tmps + (s - t);
X    spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur;
X    curspat = spat;
X    }
X    str_sset(str,&str_yes);
X    STABSET(str);
X    st[++sp] = str;
X    return sp;
X
Xnope:
X    ++spat->spat_short->str_u.str_useful;
X    if (gimme == G_ARRAY)
X    return sp;
X    str_sset(str,&str_no);
X    STABSET(str);
X    st[++sp] = str;
X    return sp;
X}
X
Xint
Xdo_split(str,spat,limit,gimme,arglast)
XSTR *str;
Xregister SPAT *spat;
Xregister int limit;
Xint gimme;
Xint *arglast;
X{
X    register ARRAY *ary = stack;
X    STR **st = ary->ary_array;
X    register int sp = arglast[0] + 1;
X    register char *s = str_get(st[sp]);
X    char *strend = s + st[sp--]->str_cur;
X    register STR *dstr;
X    register char *m;
X    int iters = 0;
X    int i;
X    char *orig;
X    int origlimit = limit;
X    int realarray = 0;
X
X    if (!spat || !s)
X    fatal("panic: do_split");
X    else if (spat->spat_runtime) {
X    nointrp = "|)";
X    sp = eval(spat->spat_runtime,G_SCALAR,sp);
X    st = stack->ary_array;
X    m = str_get(dstr = st[sp--]);
X    nointrp = "";
X    if (!dstr->str_cur || (*m == ' ' && dstr->str_cur == 1)) {
X        str_set(dstr,"\\s+");
X        m = dstr->str_ptr;
X        spat->spat_flags |= SPAT_SKIPWHITE;
X    }
X    if (spat->spat_regexp)
X        regfree(spat->spat_regexp);
X    spat->spat_regexp = regcomp(m,m+dstr->str_cur,
X        spat->spat_flags & SPAT_FOLD,1);
X    if (spat->spat_flags & SPAT_KEEP ||
X        (spat->spat_runtime->arg_type == O_ITEM &&
X          (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) {
X        arg_free(spat->spat_runtime);    /* it won't change, so */
X        spat->spat_runtime = Nullarg;    /* no point compiling again */
X    }
X    }
X#ifdef DEBUGGING
X    if (debug & 8) {
X    deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
X    }
X#endif
X    ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab);
X    if (ary && ((ary->ary_flags & ARF_REAL) || gimme != G_ARRAY)) {
X    ary->ary_flags |= ARF_REAL;
X    realarray = 1;
X    ary->ary_fill = -1;
X    sp = -1;    /* temporarily switch stacks */
X    }
X    else
X    ary = stack;
X    orig = s;
X    if (spat->spat_flags & SPAT_SKIPWHITE) {
X    while (isspace(*s))
X        s++;
X    }
X    if (!limit)
X    limit = 10001;
X    if (spat->spat_short) {
X    i = spat->spat_short->str_cur;
X    if (i == 1) {
X        i = *spat->spat_short->str_ptr;
X        while (--limit) {
X        for (m = s; m < strend && *m != i; m++) ;
X        if (m >= strend)
X            break;
X        if (realarray)
X            dstr = Str_new(30,m-s);
X        else
X            dstr = str_static(&str_undef);
X        str_nset(dstr,s,m-s);
X        (void)astore(ary, ++sp, dstr);
X        s = m + 1;
X        }
X    }
X    else {
X#ifndef lint
X        while (s < strend && --limit &&
X          (m=fbminstr((unsigned char*)s, (unsigned char*)strend,
X            spat->spat_short)) )
X#endif
X        {
X        if (realarray)
X            dstr = Str_new(31,m-s);
X        else
X            dstr = str_static(&str_undef);
X        str_nset(dstr,s,m-s);
X        (void)astore(ary, ++sp, dstr);
X        s = m + i;
X        }
X    }
X    }
X    else {
X    while (s < strend && --limit &&
X        regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) {
X        if (spat->spat_regexp->subbase
X          && spat->spat_regexp->subbase != orig) {
X        m = s;
X        s = orig;
X        orig = spat->spat_regexp->subbase;
X        s = orig + (m - s);
X        strend = s + (strend - m);
X        }
X        m = spat->spat_regexp->startp[0];
X        if (realarray)
X        dstr = Str_new(32,m-s);
X        else
X        dstr = str_static(&str_undef);
X        str_nset(dstr,s,m-s);
X        (void)astore(ary, ++sp, dstr);
X        if (spat->spat_regexp->nparens) {
X        for (i = 1; i <= spat->spat_regexp->nparens; i++) {
X            s = spat->spat_regexp->startp[i];
X            m = spat->spat_regexp->endp[i];
X            if (realarray)
X            dstr = Str_new(33,m-s);
X            else
X            dstr = str_static(&str_undef);
X            str_nset(dstr,s,m-s);
X            (void)astore(ary, ++sp, dstr);
X        }
X        }
X        s = spat->spat_regexp->endp[0];
X    }
X    }
X    if (realarray)
X    iters = sp + 1;
X    else
X    iters = sp - arglast[0];
X    if (iters > 9999)
X    fatal("Split loop");
X    if (s < strend || origlimit) {    /* keep field after final delim? */
X    if (realarray)
X        dstr = Str_new(34,strend-s);
X    else
X        dstr = str_static(&str_undef);
X    str_nset(dstr,s,strend-s);
X    (void)astore(ary, ++sp, dstr);
X    iters++;
X    }
X    else {
X#ifndef I286
X    while (iters > 0 && ary->ary_array[sp]->str_cur == 0)
X        iters--,sp--;
X#else
X    char *zaps;
X    int   zapb;
X
X    if (iters > 0) {
X        zaps = str_get(afetch(ary,sp,FALSE));
X        zapb = (int) *zaps;
X    }
X
X    while (iters > 0 && (!zapb)) {
X        iters--,sp--;
X        if (iters > 0) {
X        zaps = str_get(afetch(ary,iters-1,FALSE));
X        zapb = (int) *zaps;
X        }
X    }
X#endif
X    }
X    if (realarray) {
X    ary->ary_fill = sp;
X    if (gimme == G_ARRAY) {
X        sp++;
X        astore(stack, arglast[0] + 1 + sp, Nullstr);
X        Copy(ary->ary_array, stack->ary_array + arglast[0] + 1, sp, STR*);
X        return arglast[0] + sp;
X    }
X    }
X    else {
X    if (gimme == G_ARRAY)
X        return sp;
X    }
X    sp = arglast[0] + 1;
X    str_numset(str,(double)iters);
X    STABSET(str);
X    st[sp] = str;
X    return sp;
X}
X
Xint
Xdo_unpack(str,gimme,arglast)
XSTR *str;
Xint gimme;
Xint *arglast;
X{
X    STR **st = stack->ary_array;
X    register int sp = arglast[0] + 1;
X    register char *pat = str_get(st[sp++]);
X    register char *s = str_get(st[sp]);
X    char *strend = s + st[sp--]->str_cur;
X    register char *patend = pat + st[sp]->str_cur;
X    int datumtype;
X    register int len;
X
X    /* These must not be in registers: */
X    char achar;
X    short ashort;
X    int aint;
X    long along;
X    unsigned char auchar;
X    unsigned short aushort;
X    unsigned int auint;
X    unsigned long aulong;
X    char *aptr;
X
X    if (gimme != G_ARRAY) {
X    str_sset(str,&str_undef);
X    STABSET(str);
X    st[sp] = str;
X    return sp;
X    }
X    sp--;
X    while (pat < patend) {
X    datumtype = *pat++;
X    if (isdigit(*pat)) {
X        len = atoi(pat);
X        while (isdigit(*pat))
X        pat++;
X    }
X    else
X        len = 1;
X    switch(datumtype) {
X    default:
X        break;
X    case 'x':
X        s += len;
X        break;
X    case 'A':
X    case 'a':
X        if (s + len > strend)
X        len = strend - s;
X        str = Str_new(35,len);
X        str_nset(str,s,len);
X        s += len;
X        if (datumtype == 'A') {
X        aptr = s;    /* borrow register */
X        s = str->str_ptr + len - 1;
X        while (s >= str->str_ptr && (!*s || isspace(*s)))
X            s--;
X        *++s = '\0';
X        str->str_cur = s - str->str_ptr;
X        s = aptr;    /* unborrow register */
X        }
X        (void)astore(stack, ++sp, str_2static(str));
X        break;
X    case 'c':
X        while (len-- > 0) {
X        if (s + sizeof(char) > strend)
X            achar = 0;
X        else {
X            bcopy(s,(char*)&achar,sizeof(char));
X            s += sizeof(char);
X        }
X        str = Str_new(36,0);
X        aint = achar;
X        if (aint >= 128)    /* fake up signed chars */
X            aint -= 256;
X        str_numset(str,(double)aint);
X        (void)astore(stack, ++sp, str_2static(str));
X        }
X        break;
X    case 'C':
X        while (len-- > 0) {
X        if (s + sizeof(unsigned char) > strend)
X            auchar = 0;
X        else {
X            bcopy(s,(char*)&auchar,sizeof(unsigned char));
X            s += sizeof(unsigned char);
X        }
X        str = Str_new(37,0);
X        auint = auchar;        /* some can't cast uchar to double */
X        str_numset(str,(double)auint);
X        (void)astore(stack, ++sp, str_2static(str));
X        }
X        break;
X    case 's':
X        while (len-- > 0) {
X        if (s + sizeof(short) > strend)
X            ashort = 0;
X        else {
X            bcopy(s,(char*)&ashort,sizeof(short));
X            s += sizeof(short);
X        }
X        str = Str_new(38,0);
X        str_numset(str,(double)ashort);
X        (void)astore(stack, ++sp, str_2static(str));
X        }
X        break;
X    case 'n':
X    case 'S':
X        while (len-- > 0) {
X        if (s + sizeof(unsigned short) > strend)
X            aushort = 0;
X        else {
X            bcopy(s,(char*)&aushort,sizeof(unsigned short));
X            s += sizeof(unsigned short);
X        }
X        str = Str_new(39,0);
X#ifdef NTOHS
X        if (datumtype == 'n')
X            aushort = ntohs(aushort);
X#endif
X        str_numset(str,(double)aushort);
X        (void)astore(stack, ++sp, str_2static(str));
X        }
X        break;
X    case 'i':
X        while (len-- > 0) {
X        if (s + sizeof(int) > strend)
X            aint = 0;
X        else {
X            bcopy(s,(char*)&aint,sizeof(int));
X            s += sizeof(int);
X        }
X        str = Str_new(40,0);
X        str_numset(str,(double)aint);
X        (void)astore(stack, ++sp, str_2static(str));
X        }
X        break;
X    case 'I':
X        while (len-- > 0) {
X        if (s + sizeof(unsigned int) > strend)
X            auint = 0;
X        else {
X            bcopy(s,(char*)&auint,sizeof(unsigned int));
X            s += sizeof(unsigned int);
X        }
X        str = Str_new(41,0);
X        str_numset(str,(double)auint);
X        (void)astore(stack, ++sp, str_2static(str));
X        }
X        break;
X    case 'l':
X        while (len-- > 0) {
X        if (s + sizeof(long) > strend)
X            along = 0;
X        else {
X            bcopy(s,(char*)&along,sizeof(long));
X            s += sizeof(long);
X        }
X        str = Str_new(42,0);
X        str_numset(str,(double)along);
X        (void)astore(stack, ++sp, str_2static(str));
X        }
X        break;
X    case 'N':
X    case 'L':
X        while (len-- > 0) {
X        if (s + sizeof(unsigned long) > strend)
X            aulong = 0;
X        else {
X            bcopy(s,(char*)&aulong,sizeof(unsigned long));
X            s += sizeof(unsigned long);
X        }
X        str = Str_new(43,0);
X#ifdef NTOHL
X        if (datumtype == 'N')
X            aulong = ntohl(aulong);
X#endif
X        str_numset(str,(double)aulong);
X        (void)astore(stack, ++sp, str_2static(str));
X        }
X        break;
X    case 'p':
X        while (len-- > 0) {
X        if (s + sizeof(char*) > strend)
X            aptr = 0;
X        else {
X            bcopy(s,(char*)&aptr,sizeof(char*));
X            s += sizeof(char*);
X        }
X        str = Str_new(44,0);
X        if (aptr)
X            str_set(str,aptr);
X        (void)astore(stack, ++sp, str_2static(str));
X        }
X        break;
X    }
X    }
X    return sp;
X}
X
Xint
Xdo_slice(stab,numarray,lval,gimme,arglast)
Xregister STAB *stab;
Xint numarray;
Xint lval;
Xint gimme;
Xint *arglast;
X{
X    register STR **st = stack->ary_array;
X    register int sp = arglast[1];
X    register int max = arglast[2];
X    register char *tmps;
X    register int len;
X    register int magic = 0;
X
X    if (lval && !numarray) {
X    if (stab == envstab)
X        magic = 'E';
X    else if (stab == sigstab)
X        magic = 'S';
X#ifdef SOME_DBM
X    else if (stab_hash(stab)->tbl_dbm)
X        magic = 'D';
X#endif /* SOME_DBM */
X    }
X
X    if (gimme == G_ARRAY) {
X    if (numarray) {
X        while (sp < max) {
X        if (st[++sp]) {
X            st[sp-1] = afetch(stab_array(stab),(int)str_gnum(st[sp]),
X            lval);
X        }
X        else
X            st[sp-1] = Nullstr;
X        }
X    }
X    else {
X        while (sp < max) {
X        if (st[++sp]) {
X            tmps = str_get(st[sp]);
X            len = st[sp]->str_cur;
X            st[sp-1] = hfetch(stab_hash(stab),tmps,len, lval);
X            if (magic)
X            str_magic(st[sp-1],stab,magic,tmps,len);
X        }
X        else
X            st[sp-1] = Nullstr;
X        }
X    }
X    sp--;
X    }
X    else {
X    if (numarray) {
X        if (st[max])
X        st[sp] = afetch(stab_array(stab),(int)str_gnum(st[max]), lval);
X        else
X        st[sp] = Nullstr;
X    }
X    else {
X        if (st[max]) {
X        tmps = str_get(st[max]);
X        len = st[max]->str_cur;
X        st[sp] = hfetch(stab_hash(stab),tmps,len, lval);
X        if (magic)
X            str_magic(st[sp],stab,magic,tmps,len);
X        }
X        else
X        st[sp] = Nullstr;
X    }
X    }
X    return sp;
X}
X
Xint
Xdo_grep(arg,str,gimme,arglast)
Xregister ARG *arg;
XSTR *str;
Xint gimme;
Xint *arglast;
X{
X    STR **st = stack->ary_array;
X    register STR **dst = &st[arglast[1]];
X    register STR **src = dst + 1;
X    register int sp = arglast[2];
X    register int i = sp - arglast[1];
X    int oldsave = savestack->ary_fill;
X
X    savesptr(&stab_val(defstab));
X    if ((arg[1].arg_type & A_MASK) != A_EXPR)
X    dehoist(arg,1);
X    arg = arg[1].arg_ptr.arg_arg;
X    while (i-- > 0) {
X    stab_val(defstab) = *src;
X    (void)eval(arg,G_SCALAR,sp);
X    if (str_true(st[sp+1]))
X        *dst++ = *src;
X    src++;
X    }
X    restorelist(oldsave);
X    if (gimme != G_ARRAY) {
X    str_sset(str,&str_undef);
X    STABSET(str);
X    st[arglast[0]+1] = str;
X    return arglast[0]+1;
X    }
X    return arglast[0] + (dst - &st[arglast[1]]);
X}
X
Xint
Xdo_reverse(str,gimme,arglast)
XSTR *str;
Xint gimme;
Xint *arglast;
X{
X    STR **st = stack->ary_array;
X    register STR **up = &st[arglast[1]];
X    register STR **down = &st[arglast[2]];
X    register int i = arglast[2] - arglast[1];
X
X    if (gimme != G_ARRAY) {
X    str_sset(str,&str_undef);
X    STABSET(str);
X    st[arglast[0]+1] = str;
X    return arglast[0]+1;
X    }
X    while (i-- > 0) {
X    *up++ = *down;
X    *down-- = *up;
X    }
X    return arglast[2] - 1;
X}
X
Xstatic CMD *sortcmd;
Xstatic STAB *firststab = Nullstab;
Xstatic STAB *secondstab = Nullstab;
X
Xint
Xdo_sort(str,stab,gimme,arglast)
XSTR *str;
XSTAB *stab;
Xint gimme;
Xint *arglast;
X{
X    STR **st = stack->ary_array;
X    int sp = arglast[1];
X    register STR **up;
X    register int max = arglast[2] - sp;
X    register int i;
X    int sortcmp();
X    int sortsub();
X    STR *oldfirst;
X    STR *oldsecond;
X    ARRAY *oldstack;
X    static ARRAY *sortstack = Null(ARRAY*);
X
X    if (gimme != G_ARRAY) {
X    str_sset(str,&str_undef);
X    STABSET(str);
X    st[sp] = str;
X    return sp;
X    }
X    up = &st[sp];
X    for (i = 0; i < max; i++) {
X    if ((*up = up[1]) && !(*up)->str_pok)
X        (void)str_2ptr(*up);
X    up++;
X    }
X    sp--;
X    if (max > 1) {
X    if (stab_sub(stab) && (sortcmd = stab_sub(stab)->cmd)) {
X        int oldtmps_base = tmps_base;
X
X        if (!sortstack) {
X        sortstack = anew(Nullstab);
X        sortstack->ary_flags = 0;
X        }
X        oldstack = stack;
X        stack = sortstack;
X        tmps_base = tmps_max;
X        if (!firststab) {
X        firststab = stabent("a",TRUE);
X        secondstab = stabent("b",TRUE);
X        }
X        oldfirst = stab_val(firststab);
X        oldsecond = stab_val(secondstab);
X#ifndef lint
X        qsort((char*)(st+sp+1),max,sizeof(STR*),sortsub);
X#else
X        qsort(Nullch,max,sizeof(STR*),sortsub);
X#endif
X        stab_val(firststab) = oldfirst;
X        stab_val(secondstab) = oldsecond;
X        tmps_base = oldtmps_base;
X        stack = oldstack;
X    }
X#ifndef lint
X    else
X        qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp);
X#endif
X    }
X    up = &st[arglast[1]];
X    while (max > 0 && !*up)
X    max--,up--;
X    return sp+max;
X}
X
Xint
Xsortsub(str1,str2)
XSTR **str1;
XSTR **str2;
X{
X    if (!*str1)
X    return -1;
X    if (!*str2)
X    return 1;
X    stab_val(firststab) = *str1;
X    stab_val(secondstab) = *str2;
X    cmd_exec(sortcmd,G_SCALAR,-1);
X    return (int)str_gnum(*stack->ary_array);
X}
X
Xsortcmp(strp1,strp2)
XSTR **strp1;
XSTR **strp2;
X{
X    register STR *str1 = *strp1;
X    register STR *str2 = *strp2;
X    int retval;
X
X    if (!str1)
X    return -1;
X    if (!str2)
X    return 1;
X
X    if (str1->str_cur < str2->str_cur) {
X    if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
X        return retval;
X    else
X        return -1;
X    }
X    else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
X    return retval;
X    else if (str1->str_cur == str2->str_cur)
X    return 0;
X    else
X    return 1;
X}
X
Xint
Xdo_range(gimme,arglast)
Xint gimme;
Xint *arglast;
X{
X    STR **st = stack->ary_array;
X    register int sp = arglast[0];
X    register int i = (int)str_gnum(st[sp+1]);
X    register ARRAY *ary = stack;
X    register STR *str;
X    int max = (int)str_gnum(st[sp+2]);
X
X    if (gimme != G_ARRAY)
X    fatal("panic: do_range");
X
X    while (i <= max) {
X    (void)astore(ary, ++sp, str = str_static(&str_no));
X    str_numset(str,(double)i++);
X    }
X    return sp;
X}
X
Xint
Xdo_tms(str,gimme,arglast)
XSTR *str;
Xint gimme;
Xint *arglast;
X{
X    STR **st = stack->ary_array;
X    register int sp = arglast[0];
X
X    if (gimme != G_ARRAY) {
X    str_sset(str,&str_undef);
X    STABSET(str);
X    st[++sp] = str;
X    return sp;
X    }
X    (void)times(×buf);
X
X#ifndef HZ
X#define HZ 60
X#endif
X
X#ifndef lint
X    (void)astore(stack,++sp,
X      str_2static(str_nmake(((double)timesbuf.tms_utime)/HZ)));
X    (void)astore(stack,++sp,
X      str_2static(str_nmake(((double)timesbuf.tms_stime)/HZ)));
X    (void)astore(stack,++sp,
X      str_2static(str_nmake(((double)timesbuf.tms_cutime)/HZ)));
X    (void)astore(stack,++sp,
X      str_2static(str_nmake(((double)timesbuf.tms_cstime)/HZ)));
X#else
X    (void)astore(stack,++sp,
X      str_2static(str_nmake(0.0)));
X#endif
X    return sp;
X}
X
Xint
Xdo_time(str,tmbuf,gimme,arglast)
XSTR *str;
Xstruct tm *tmbuf;
Xint gimme;
Xint *arglast;
X{
X    register ARRAY *ary = stack;
X    STR **st = ary->ary_array;
X    register int sp = arglast[0];
X
X    if (!tmbuf || gimme != G_ARRAY) {
X    str_sset(str,&str_undef);
X    STABSET(str);
X    st[++sp] = str;
X    return sp;
X    }
X    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_sec)));
X    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_min)));
X    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_hour)));
X    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mday)));
X    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mon)));
X    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_year)));
X    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_wday)));
X    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_yday)));
X    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_isdst)));
X    return sp;
X}
X
Xint
Xdo_kv(str,hash,kv,gimme,arglast)
XSTR *str;
XHASH *hash;
Xint kv;
Xint gimme;
Xint *arglast;
X{
X    register ARRAY *ary = stack;
X    STR **st = ary->ary_array;
X    register int sp = arglast[0];
X    int i;
X    register HENT *entry;
X    char *tmps;
X    STR *tmpstr;
X    int dokeys = (kv == O_KEYS || kv == O_HASH);
X    int dovalues = (kv == O_VALUES || kv == O_HASH);
X
X    if (gimme != G_ARRAY) {
X    str_sset(str,&str_undef);
X    STABSET(str);
X    st[++sp] = str;
X    return sp;
X    }
X    (void)hiterinit(hash);
X    while (entry = hiternext(hash)) {
X    if (dokeys) {
X        tmps = hiterkey(entry,&i);
X        (void)astore(ary,++sp,str_2static(str_make(tmps,i)));
X    }
X    if (dovalues) {
X        tmpstr = Str_new(45,0);
X#ifdef DEBUGGING
X        if (debug & 8192) {
X        sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
X            hash->tbl_max+1,entry->hent_hash & hash->tbl_max);
X        str_set(tmpstr,buf);
X        }
X        else
X#endif
X        str_sset(tmpstr,hiterval(hash,entry));
X        (void)astore(ary,++sp,str_2static(tmpstr));
X    }
X    }
X    return sp;
X}
X
Xint
Xdo_each(str,hash,gimme,arglast)
XSTR *str;
XHASH *hash;
Xint gimme;
Xint *arglast;
X{
X    STR **st = stack->ary_array;
X    register int sp = arglast[0];
X    static STR *mystrk = Nullstr;
X    HENT *entry = hiternext(hash);
X    int i;
X    char *tmps;
X
X    if (mystrk) {
X    str_free(mystrk);
X    mystrk = Nullstr;
X    }
X
X    if (entry) {
X    if (gimme == G_ARRAY) {
X        tmps = hiterkey(entry, &i);
X        st[++sp] = mystrk = str_make(tmps,i);
X    }
X    st[++sp] = str;
X    str_sset(str,hiterval(hash,entry));
X    STABSET(str);
X    return sp;
X    }
X    else
X    return sp;
X}
!STUFFY!FUNK!
echo ""
echo "End of kit 16 (of 24)"
cat /dev/null >kit16isdone
run=''
config=''
for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24; do
    if test -f kit${iskit}isdone; then
    run="$run $iskit"
    else
    todo="$todo $iskit"
    fi
done
case $todo in
    '')
    echo "You have run all your kits.  Please read README and then type Configure."
    chmod 755 Configure
    ;;
    *)  echo "You have run$run."
    echo "You still need to run$todo."
    ;;
esac
: Someone might mail this, so...
exit