rsalz@bbn.com (Rich Salz) (02/01/88)
Submitted-by: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov> Posting-number: Volume 13, Issue 2 Archive-name: perl/part02 #! /bin/sh # Make a new directory for the perl sources, cd to it, and run kits 1 # thru 10 through sh. When all 10 kits have been run, read README. echo "This is perl 1.0 kit 2 (of 10). If kit 2 is complete, the line" echo '"'"End of kit 2 (of 10)"'" will echo at the end.' echo "" export PATH || (echo "You didn't use sh, you clunch." ; kill $$) echo Extracting perly.c sed >perly.c <<'!STUFFY!FUNK!' -e 's/X//' Xchar rcsid[] = "$Header: perly.c,v 1.0 87/12/18 15:53:31 root Exp $"; X/* X * $Log: perly.c,v $ X * Revision 1.0 87/12/18 15:53:31 root X * Initial revision X * X */ X Xbool preprocess = FALSE; Xbool assume_n = FALSE; Xbool assume_p = FALSE; Xbool doswitches = FALSE; Xchar *filename; Xchar *e_tmpname = "/tmp/perl-eXXXXXX"; XFILE *e_fp = Nullfp; XARG *l(); X Xmain(argc,argv,env) Xregister int argc; Xregister char **argv; Xregister char **env; X{ X register STR *str; X register char *s; X char *index(); X X linestr = str_new(80); X str = str_make("-I/usr/lib/perl "); /* 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 'e': X if (!e_fp) { X mktemp(e_tmpname); X e_fp = fopen(e_tmpname,"w"); X } X if (argv[1]) X fputs(argv[1],e_fp); X putc('\n', e_fp); X argc--,argv++; X break; X case 'i': X inplace = savestr(argv[0]+2); X argvoutstab = stabent("ARGVOUT",TRUE); X break; X case 'I': X str_cat(str,argv[0]); X str_cat(str," "); X if (!argv[0][2]) { X str_cat(str,argv[1]); X argc--,argv++; X str_cat(str," "); X } X break; X case 'n': X assume_n = TRUE; X strcpy(argv[0], argv[0]+1); X goto reswitch; X case 'p': X assume_p = TRUE; X strcpy(argv[0], argv[0]+1); X goto reswitch; X case 'P': X preprocess = TRUE; X strcpy(argv[0], argv[0]+1); X goto reswitch; X case 's': X doswitches = TRUE; X strcpy(argv[0], argv[0]+1); X goto reswitch; X case 'v': X version(); X exit(0); 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 if (e_fp) { X fclose(e_fp); X argc++,argv--; X argv[0] = e_tmpname; X } X X str_set(&str_no,No); X str_set(&str_yes,Yes); X init_eval(); 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 (preprocess) { X sprintf(buf, "\ X/bin/sed -e '/^[^#]/b' \ X -e '/^#[ ]*include[ ]/b' \ X -e '/^#[ ]*define[ ]/b' \ X -e '/^#[ ]*if[ ]/b' \ X -e '/^#[ ]*ifdef[ ]/b' \ X -e '/^#[ ]*else/b' \ X -e '/^#[ ]*endif/b' \ X -e 's/^#.*//' \ X %s | /lib/cpp -C %s-", X argv[0], str_get(str)); X rsfp = popen(buf,"r"); X } X else if (!*argv[0]) X rsfp = stdin; X else X rsfp = fopen(argv[0],"r"); X if (rsfp == Nullfp) X fatal("Perl script \"%s\" doesn't seem to exist.\n",filename); X str_free(str); /* free -I directories */ X X defstab = stabent("_",TRUE); X X /* init tokener */ X X bufptr = str_get(linestr); X X /* now parse the report spec */ X X if (yyparse()) X fatal("Execution aborted due to compilation errors.\n"); X X if (e_fp) { X e_fp = Nullfp; X UNLINK(e_tmpname); X } X argc--,argv++; /* skip name of script */ X if (doswitches) { X for (; argc > 0 && **argv == '-'; argc--,argv++) { X if (argv[0][1] == '-') { X argc--,argv++; X break; X } X str_numset(stabent(argv[0]+1,TRUE)->stab_val,(double)1.0); X } X } X if (argvstab = stabent("ARGV",FALSE)) { X for (; argc > 0; argc--,argv++) { X apush(argvstab->stab_array,str_make(argv[0])); X } X } X if (envstab = stabent("ENV",FALSE)) { X for (; *env; env++) { X if (!(s = index(*env,'='))) X continue; X *s++ = '\0'; X str = str_make(s); X str->str_link.str_magic = envstab; X hstore(envstab->stab_hash,*env,str); X *--s = '='; X } X } X sigstab = stabent("SIG",FALSE); X X magicalize("!#?^~=-%0123456789.+&*(),\\/[|"); X X (tmpstab = stabent("0",FALSE)) && str_set(STAB_STR(tmpstab),filename); X (tmpstab = stabent("$",FALSE)) && X str_numset(STAB_STR(tmpstab),(double)getpid()); X X tmpstab = stabent("stdin",TRUE); X tmpstab->stab_io = stio_new(); X tmpstab->stab_io->fp = stdin; X X tmpstab = stabent("stdout",TRUE); X tmpstab->stab_io = stio_new(); X tmpstab->stab_io->fp = stdout; X defoutstab = tmpstab; X curoutstab = tmpstab; X X tmpstab = stabent("stderr",TRUE); X tmpstab->stab_io = stio_new(); X tmpstab->stab_io->fp = stderr; X X setjmp(top_env); /* sets goto_targ on longjump */ X X#ifdef DEBUGGING X if (debug & 1024) X dump_cmd(main_root,Nullcmd); X if (debug) X fprintf(stderr,"\nEXECUTING...\n\n"); X#endif X X /* do it */ X X (void) cmd_exec(main_root); X X if (goto_targ) X fatal("Can't find label \"%s\"--aborting.\n",goto_targ); X exit(0); X} X Xmagicalize(list) Xregister char *list; X{ X register STAB *stab; X char sym[2]; X X sym[1] = '\0'; X while (*sym = *list++) { X if (stab = stabent(sym,FALSE)) { X stab->stab_flags = SF_VMAGIC; X stab->stab_val->str_link.str_magic = stab; X } X } X} X X#define RETURN(retval) return (bufptr = s,retval) X#define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,retval) X#define TERM(retval) return (expectterm = FALSE,bufptr = s,retval) X#define LOOPX(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,LOOPEX) X#define UNI(f) return (yylval.ival = f,expectterm = TRUE,bufptr = s,UNIOP) X#define FUN0(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC0) X#define FUN1(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC1) X#define FUN2(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC2) X#define FUN3(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC3) X#define SFUN(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,STABFUN) X Xyylex() X{ X register char *s = bufptr; X register char *d; X register int tmp; X static bool in_format = FALSE; X static bool firstline = TRUE; 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 0: X s = str_get(linestr); X *s = '\0'; X if (firstline && (assume_n || assume_p)) { X firstline = FALSE; X str_set(linestr,"while (<>) {"); X s = str_get(linestr); X goto retry; X } X if (!rsfp) X RETURN(0); X if (in_format) { X yylval.formval = load_format(); /* leaves . in buffer */ X in_format = FALSE; X s = str_get(linestr); X TERM(FORMLIST); X } X line++; X if ((s = str_gets(linestr, rsfp)) == Nullch) { X if (preprocess) X pclose(rsfp); X else if (rsfp != stdin) X fclose(rsfp); X rsfp = Nullfp; X if (assume_n || assume_p) { X str_set(linestr,assume_p ? "}continue{print;" : ""); X str_cat(linestr,"}"); X s = str_get(linestr); X goto retry; X } X s = str_get(linestr); X RETURN(0); X } X#ifdef DEBUG X else if (firstline) { X char *showinput(); X s = showinput(); X } X#endif X firstline = FALSE; X goto retry; X case ' ': case '\t': X s++; X goto retry; X case '\n': X case '#': X if (preprocess && s == str_get(linestr) && X s[1] == ' ' && isdigit(s[2])) { X line = atoi(s+2)-1; X for (s += 2; isdigit(*s); s++) ; X while (*s && isspace(*s)) s++; X if (filename) X safefree(filename); X s[strlen(s)-1] = '\0'; /* wipe out newline */ X filename = savestr(s); X s = str_get(linestr); X } X *s = '\0'; X if (lex_newlines) X RETURN('\n'); X goto retry; X case '+': X case '-': X if (s[1] == *s) { X s++; X if (*s++ == '+') X RETURN(INC); X else X RETURN(DEC); X } X /* FALL THROUGH */ X case '*': X case '%': X case '^': X case '~': X case '(': X case ',': X case ':': X case ';': X case '{': X case '[': X tmp = *s++; X OPERATOR(tmp); X case ')': X case ']': X case '}': X tmp = *s++; X TERM(tmp); X case '&': X s++; X tmp = *s++; X if (tmp == '&') X OPERATOR(ANDAND); X s--; X OPERATOR('&'); X case '|': X s++; X tmp = *s++; X if (tmp == '|') X OPERATOR(OROR); X s--; X OPERATOR('|'); X case '=': X s++; X tmp = *s++; X if (tmp == '=') X OPERATOR(EQ); X if (tmp == '~') X OPERATOR(MATCH); X s--; X OPERATOR('='); X case '!': X s++; X tmp = *s++; X if (tmp == '=') X OPERATOR(NE); X if (tmp == '~') X OPERATOR(NMATCH); X s--; X OPERATOR('!'); X case '<': X if (expectterm) { X s = scanstr(s); X TERM(RSTRING); X } X s++; X tmp = *s++; X if (tmp == '<') X OPERATOR(LS); X if (tmp == '=') X OPERATOR(LE); X s--; X OPERATOR('<'); X case '>': X s++; X tmp = *s++; X if (tmp == '>') X OPERATOR(RS); X if (tmp == '=') X OPERATOR(GE); X s--; X OPERATOR('>'); X X#define SNARFWORD \ X d = tokenbuf; \ X while (isalpha(*s) || isdigit(*s) || *s == '_') \ X *d++ = *s++; \ X *d = '\0'; \ X d = tokenbuf; X X case '$': X if (s[1] == '#' && (isalpha(s[2]) || s[2] == '_')) { X s++; X s = scanreg(s,tokenbuf); X yylval.stabval = aadd(stabent(tokenbuf,TRUE)); X TERM(ARYLEN); X } X s = scanreg(s,tokenbuf); X yylval.stabval = stabent(tokenbuf,TRUE); X TERM(REG); X X case '@': X s = scanreg(s,tokenbuf); X yylval.stabval = aadd(stabent(tokenbuf,TRUE)); X TERM(ARY); X X case '/': /* may either be division or pattern */ X case '?': /* may either be conditional or pattern */ X if (expectterm) { X s = scanpat(s); X TERM(PATTERN); X } X tmp = *s++; X OPERATOR(tmp); X X case '.': X if (!expectterm || !isdigit(s[1])) { X s++; X tmp = *s++; X if (tmp == '.') X OPERATOR(DOTDOT); X s--; X OPERATOR('.'); X } X /* FALL THROUGH */ X case '0': case '1': case '2': case '3': case '4': X case '5': case '6': case '7': case '8': case '9': X case '\'': case '"': case '`': X s = scanstr(s); X TERM(RSTRING); X X case '_': X SNARFWORD; X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'a': case 'A': X SNARFWORD; X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'b': case 'B': X SNARFWORD; X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'c': case 'C': X SNARFWORD; X if (strEQ(d,"continue")) X OPERATOR(CONTINUE); X if (strEQ(d,"chdir")) X UNI(O_CHDIR); X if (strEQ(d,"close")) X OPERATOR(CLOSE); X if (strEQ(d,"crypt")) X FUN2(O_CRYPT); X if (strEQ(d,"chop")) X OPERATOR(CHOP); X if (strEQ(d,"chmod")) { X yylval.ival = O_CHMOD; X OPERATOR(PRINT); X } X if (strEQ(d,"chown")) { X yylval.ival = O_CHOWN; X OPERATOR(PRINT); X } X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'd': case 'D': X SNARFWORD; X if (strEQ(d,"do")) X OPERATOR(DO); X if (strEQ(d,"die")) X UNI(O_DIE); X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'e': case 'E': X SNARFWORD; X if (strEQ(d,"else")) X OPERATOR(ELSE); X if (strEQ(d,"elsif")) X OPERATOR(ELSIF); X if (strEQ(d,"eq") || strEQ(d,"EQ")) X OPERATOR(SEQ); X if (strEQ(d,"exit")) X UNI(O_EXIT); X if (strEQ(d,"eof")) X TERM(FEOF); X if (strEQ(d,"exp")) X FUN1(O_EXP); X if (strEQ(d,"each")) X SFUN(O_EACH); X if (strEQ(d,"exec")) { X yylval.ival = O_EXEC; X OPERATOR(PRINT); X } X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'f': case 'F': X SNARFWORD; X if (strEQ(d,"for")) X OPERATOR(FOR); X if (strEQ(d,"format")) { X in_format = TRUE; X OPERATOR(FORMAT); X } X if (strEQ(d,"fork")) X FUN0(O_FORK); X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'g': case 'G': X SNARFWORD; X if (strEQ(d,"gt") || strEQ(d,"GT")) X OPERATOR(SGT); X if (strEQ(d,"ge") || strEQ(d,"GE")) X OPERATOR(SGE); X if (strEQ(d,"goto")) X LOOPX(O_GOTO); X if (strEQ(d,"gmtime")) X FUN1(O_GMTIME); X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'h': case 'H': X SNARFWORD; X if (strEQ(d,"hex")) X FUN1(O_HEX); X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'i': case 'I': X SNARFWORD; X if (strEQ(d,"if")) X OPERATOR(IF); X if (strEQ(d,"index")) X FUN2(O_INDEX); X if (strEQ(d,"int")) X FUN1(O_INT); X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'j': case 'J': X SNARFWORD; X if (strEQ(d,"join")) X OPERATOR(JOIN); X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'k': case 'K': X SNARFWORD; X if (strEQ(d,"keys")) X SFUN(O_KEYS); X if (strEQ(d,"kill")) { X yylval.ival = O_KILL; X OPERATOR(PRINT); X } X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'l': case 'L': X SNARFWORD; X if (strEQ(d,"last")) X LOOPX(O_LAST); X if (strEQ(d,"length")) X FUN1(O_LENGTH); X if (strEQ(d,"lt") || strEQ(d,"LT")) X OPERATOR(SLT); X if (strEQ(d,"le") || strEQ(d,"LE")) X OPERATOR(SLE); X if (strEQ(d,"localtime")) X FUN1(O_LOCALTIME); X if (strEQ(d,"log")) X FUN1(O_LOG); X if (strEQ(d,"link")) X FUN2(O_LINK); X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'm': case 'M': X SNARFWORD; X if (strEQ(d,"m")) { X s = scanpat(s-1); X TERM(PATTERN); X } X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'n': case 'N': X SNARFWORD; X if (strEQ(d,"next")) X LOOPX(O_NEXT); X if (strEQ(d,"ne") || strEQ(d,"NE")) X OPERATOR(SNE); X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'o': case 'O': X SNARFWORD; X if (strEQ(d,"open")) X OPERATOR(OPEN); X if (strEQ(d,"ord")) X FUN1(O_ORD); X if (strEQ(d,"oct")) X FUN1(O_OCT); X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'p': case 'P': X SNARFWORD; X if (strEQ(d,"print")) { X yylval.ival = O_PRINT; X OPERATOR(PRINT); X } X if (strEQ(d,"printf")) { X yylval.ival = O_PRTF; X OPERATOR(PRINT); X } X if (strEQ(d,"push")) { X yylval.ival = O_PUSH; X OPERATOR(PUSH); X } X if (strEQ(d,"pop")) X OPERATOR(POP); X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'q': case 'Q': X SNARFWORD; X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'r': case 'R': X SNARFWORD; X if (strEQ(d,"reset")) X UNI(O_RESET); X if (strEQ(d,"redo")) X LOOPX(O_REDO); X if (strEQ(d,"rename")) X FUN2(O_RENAME); X yylval.cval = savestr(d); X OPERATOR(WORD); X case 's': case 'S': X SNARFWORD; X if (strEQ(d,"s")) { X s = scansubst(s); X TERM(SUBST); X } X if (strEQ(d,"shift")) X TERM(SHIFT); X if (strEQ(d,"split")) X TERM(SPLIT); X if (strEQ(d,"substr")) X FUN3(O_SUBSTR); X if (strEQ(d,"sprintf")) X OPERATOR(SPRINTF); X if (strEQ(d,"sub")) X OPERATOR(SUB); X if (strEQ(d,"select")) X OPERATOR(SELECT); X if (strEQ(d,"seek")) X OPERATOR(SEEK); X if (strEQ(d,"stat")) X OPERATOR(STAT); X if (strEQ(d,"sqrt")) X FUN1(O_SQRT); X if (strEQ(d,"sleep")) X UNI(O_SLEEP); X if (strEQ(d,"system")) { X yylval.ival = O_SYSTEM; X OPERATOR(PRINT); X } X yylval.cval = savestr(d); X OPERATOR(WORD); X case 't': case 'T': X SNARFWORD; X if (strEQ(d,"tr")) { X s = scantrans(s); X TERM(TRANS); X } X if (strEQ(d,"tell")) X TERM(TELL); X if (strEQ(d,"time")) X FUN0(O_TIME); X if (strEQ(d,"times")) X FUN0(O_TMS); X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'u': case 'U': X SNARFWORD; X if (strEQ(d,"using")) X OPERATOR(USING); X if (strEQ(d,"until")) X OPERATOR(UNTIL); X if (strEQ(d,"unless")) X OPERATOR(UNLESS); X if (strEQ(d,"umask")) X FUN1(O_UMASK); X if (strEQ(d,"unshift")) { X yylval.ival = O_UNSHIFT; X OPERATOR(PUSH); X } X if (strEQ(d,"unlink")) { X yylval.ival = O_UNLINK; X OPERATOR(PRINT); X } X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'v': case 'V': X SNARFWORD; X if (strEQ(d,"values")) X SFUN(O_VALUES); X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'w': case 'W': X SNARFWORD; X if (strEQ(d,"write")) X TERM(WRITE); X if (strEQ(d,"while")) X OPERATOR(WHILE); X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'x': case 'X': X SNARFWORD; X if (!expectterm && strEQ(d,"x")) X OPERATOR('x'); X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'y': case 'Y': X SNARFWORD; X if (strEQ(d,"y")) { X s = scantrans(s); X TERM(TRANS); X } X yylval.cval = savestr(d); X OPERATOR(WORD); X case 'z': case 'Z': X SNARFWORD; X yylval.cval = savestr(d); X OPERATOR(WORD); X } X} X XSTAB * Xstabent(name,add) Xregister char *name; Xint add; X{ X register STAB *stab; X X for (stab = stab_index[*name]; stab; stab = stab->stab_next) { X if (strEQ(name,stab->stab_name)) X return stab; X } X X /* no entry--should we add one? */ X X if (add) { X stab = (STAB *) safemalloc(sizeof(STAB)); X bzero((char*)stab, sizeof(STAB)); X stab->stab_name = savestr(name); X stab->stab_val = str_new(0); X stab->stab_next = stab_index[*name]; X stab_index[*name] = stab; X return stab; X } X return Nullstab; X} X XSTIO * Xstio_new() X{ X STIO *stio = (STIO *) safemalloc(sizeof(STIO)); X X bzero((char*)stio, sizeof(STIO)); X stio->page_len = 60; X return stio; X} X Xchar * Xscanreg(s,dest) Xregister char *s; Xchar *dest; X{ X register char *d; X X s++; X d = dest; X while (isalpha(*s) || isdigit(*s) || *s == '_') X *d++ = *s++; X *d = '\0'; X d = dest; X if (!*d) { X *d = *s++; X if (*d == '{') { X d = dest; X while (*s && *s != '}') X *d++ = *s++; X *d = '\0'; X d = dest; X if (*s) X s++; X } X else X d[1] = '\0'; X } X if (*d == '^' && !isspace(*s)) X *d = *s++ & 31; X return s; X} X XSTR * Xscanconst(string) Xchar *string; X{ X register STR *retstr; X register char *t; X register char *d; X X if (index(string,'|')) { X return Nullstr; X } X retstr = str_make(string); X t = str_get(retstr); X for (d=t; *d; ) { X switch (*d) { X case '.': case '[': case '$': case '(': case ')': case '|': X *d = '\0'; X break; X case '\\': X if (index("wWbB0123456789",d[1])) { X *d = '\0'; X break; X } X strcpy(d,d+1); X switch(*d) { X case 'n': X *d = '\n'; X break; X case 't': X *d = '\t'; X break; X case 'f': X *d = '\f'; X break; X case 'r': X *d = '\r'; X break; X } X /* FALL THROUGH */ X default: X if (d[1] == '*' || d[1] == '+' || d[1] == '?') { X *d = '\0'; X break; X } X d++; X } X } X if (!*t) { X str_free(retstr); X return Nullstr; X } X retstr->str_cur = strlen(retstr->str_ptr); /* XXX cheating here */ X return retstr; X} X Xchar * Xscanpat(s) Xregister char *s; X{ X register SPAT *spat = (SPAT *) safemalloc(sizeof (SPAT)); X register char *d; X X bzero((char *)spat, sizeof(SPAT)); X spat->spat_next = spat_root; /* link into spat list */ X spat_root = spat; X init_compex(&spat->spat_compex); X X switch (*s++) { X case 'm': X s++; X break; X case '/': X break; X case '?': X spat->spat_flags |= SPAT_USE_ONCE; X break; X default: X fatal("Search pattern not found:\n%s",str_get(linestr)); X } X s = cpytill(tokenbuf,s,s[-1]); X if (!*s) X fatal("Search pattern not terminated:\n%s",str_get(linestr)); X s++; X if (*tokenbuf == '^') { X spat->spat_first = scanconst(tokenbuf+1); X if (spat->spat_first) { X spat->spat_flen = strlen(spat->spat_first->str_ptr); X if (spat->spat_flen == strlen(tokenbuf+1)) X spat->spat_flags |= SPAT_SCANALL; X } X } X else { X spat->spat_flags |= SPAT_SCANFIRST; X spat->spat_first = scanconst(tokenbuf); X if (spat->spat_first) { X spat->spat_flen = strlen(spat->spat_first->str_ptr); X if (spat->spat_flen == strlen(tokenbuf)) X spat->spat_flags |= SPAT_SCANALL; X } X } X if (d = compile(&spat->spat_compex,tokenbuf,TRUE,FALSE)) X fatal(d); X yylval.arg = make_match(O_MATCH,stab_to_arg(A_STAB,defstab),spat); X return s; X} X Xchar * Xscansubst(s) Xregister char *s; X{ X register SPAT *spat = (SPAT *) safemalloc(sizeof (SPAT)); X register char *d; X X bzero((char *)spat, sizeof(SPAT)); X spat->spat_next = spat_root; /* link into spat list */ X spat_root = spat; X init_compex(&spat->spat_compex); X X s = cpytill(tokenbuf,s+1,*s); X if (!*s) X fatal("Substitution pattern not terminated:\n%s",str_get(linestr)); X for (d=tokenbuf; *d; d++) { X if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') { X register ARG *arg; X X spat->spat_runtime = arg = op_new(1); X arg->arg_type = O_ITEM; X arg[1].arg_type = A_DOUBLE; X arg[1].arg_ptr.arg_str = str_make(tokenbuf); X goto get_repl; /* skip compiling for now */ X } X } X if (*tokenbuf == '^') { X spat->spat_first = scanconst(tokenbuf+1); X if (spat->spat_first) X spat->spat_flen = strlen(spat->spat_first->str_ptr); X } X else { X spat->spat_flags |= SPAT_SCANFIRST; X spat->spat_first = scanconst(tokenbuf); X if (spat->spat_first) X spat->spat_flen = strlen(spat->spat_first->str_ptr); X } X if (d = compile(&spat->spat_compex,tokenbuf,TRUE,FALSE)) X fatal(d); Xget_repl: X s = scanstr(s); X if (!*s) X fatal("Substitution replacement not terminated:\n%s",str_get(linestr)); X spat->spat_repl = yylval.arg; X if (*s == 'g') { X s++; X spat->spat_flags &= ~SPAT_USE_ONCE; X } X else X spat->spat_flags |= SPAT_USE_ONCE; X yylval.arg = make_match(O_SUBST,stab_to_arg(A_STAB,defstab),spat); X return s; X} X XARG * Xmake_split(stab,arg) Xregister STAB *stab; Xregister ARG *arg; X{ X if (arg->arg_type != O_MATCH) { X register SPAT *spat = (SPAT *) safemalloc(sizeof (SPAT)); X register char *d; X X bzero((char *)spat, sizeof(SPAT)); X spat->spat_next = spat_root; /* link into spat list */ X spat_root = spat; X init_compex(&spat->spat_compex); X X spat->spat_runtime = arg; X arg = make_match(O_MATCH,stab_to_arg(A_STAB,defstab),spat); X } X arg->arg_type = O_SPLIT; X arg[2].arg_ptr.arg_spat->spat_repl = stab_to_arg(A_STAB,aadd(stab)); X return arg; X} X Xchar * Xexpand_charset(s) Xregister char *s; X{ X char t[512]; X register char *d = t; X register int i; X X while (*s) { X if (s[1] == '-' && s[2]) { X for (i = s[0]; i <= s[2]; i++) X *d++ = i; X s += 3; X } X else X *d++ = *s++; X } X *d = '\0'; X return savestr(t); X} X Xchar * Xscantrans(s) Xregister char *s; X{ X ARG *arg = X l(make_op(O_TRANS,2,stab_to_arg(A_STAB,defstab),Nullarg,Nullarg,0)); X register char *t; X register char *r; X register char *tbl = safemalloc(256); X register int i; X X arg[2].arg_type = A_NULL; X arg[2].arg_ptr.arg_cval = tbl; X for (i=0; i<256; i++) X tbl[i] = 0; X s = scanstr(s); X if (!*s) X fatal("Translation pattern not terminated:\n%s",str_get(linestr)); X t = expand_charset(str_get(yylval.arg[1].arg_ptr.arg_str)); X free_arg(yylval.arg); X s = scanstr(s-1); X if (!*s) X fatal("Translation replacement not terminated:\n%s",str_get(linestr)); X r = expand_charset(str_get(yylval.arg[1].arg_ptr.arg_str)); X free_arg(yylval.arg); X yylval.arg = arg; X if (!*r) { X safefree(r); X r = t; X } X for (i = 0; t[i]; i++) { X if (!r[i]) X r[i] = r[i-1]; X tbl[t[i] & 0377] = r[i]; X } X if (r != t) X safefree(r); X safefree(t); X return s; X} X XCMD * Xblock_head(tail) Xregister CMD *tail; X{ X if (tail == Nullcmd) { X return tail; X } X return tail->c_head; 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 * Xmake_acmd(type,stab,cond,arg) Xint type; XSTAB *stab; XARG *cond; XARG *arg; X{ X register CMD *cmd = (CMD *) safemalloc(sizeof (CMD)); X X bzero((char *)cmd, sizeof(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); X cmd->c_flags |= CF_COND; X } X return cmd; X} X XCMD * Xmake_ccmd(type,arg,cblock) Xint type; Xregister ARG *arg; Xstruct compcmd cblock; X{ X register CMD *cmd = (CMD *) safemalloc(sizeof (CMD)); X X bzero((char *)cmd, sizeof(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); X cmd->c_flags |= CF_COND; X } X return cmd; X} X Xvoid Xopt_arg(cmd,fliporflop) Xregister CMD *cmd; Xint fliporflop; X{ X register ARG *arg; X int opt = CFT_EVAL; X int sure = 0; X ARG *arg2; X char *tmps; /* for True macro */ 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 /* Turn "if (!expr)" into "unless (expr)" */ X X while (arg->arg_type == O_NOT && arg[1].arg_type == A_EXPR) { 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 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_EXPR) { X arg = arg[flp].arg_ptr.arg_arg; X flp = 1; X } 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_SINGLE) { X opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE); X cmd->c_first = arg[flp].arg_ptr.arg_str; X goto literal; X } X else if (arg[flp].arg_type == A_STAB || arg[flp].arg_type == 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_SPAT && X arg[2].arg_ptr.arg_spat->spat_first ) { X cmd->c_stab = arg[1].arg_ptr.arg_stab; X cmd->c_first = arg[2].arg_ptr.arg_spat->spat_first; X cmd->c_flen = arg[2].arg_ptr.arg_spat->spat_flen; X if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANALL && 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 arg[2].arg_ptr.arg_spat->spat_first = Nullstr; X arg[2].arg_ptr.arg_spat->spat_flen = 0; /* only one chk */ 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 arg[2].arg_type = A_SINGLE; /* don't do twice */ X arg[2].arg_ptr.arg_str = &str_yes; 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_first = arg[2].arg_ptr.arg_str; X cmd->c_flen = 30000; 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_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 (!(arg2[1].arg_ptr.arg_stab->stab_io->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 arg[3].arg_ptr.arg_cmd = (CMD*)safemalloc(sizeof(CMD)); X bcopy((char *)cmd, (char *)arg[3].arg_ptr.arg_cmd, sizeof(CMD)); X arg[4].arg_ptr.arg_cmd = (CMD*)safemalloc(sizeof(CMD)); X bcopy((char *)cmd, (char *)arg[4].arg_ptr.arg_cmd, sizeof(CMD)); X opt_arg(arg[4].arg_ptr.arg_cmd,2); 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 XARG * Xmod_match(type,left,pat) Xregister ARG *left; Xregister ARG *pat; X{ X X register SPAT *spat; X register ARG *newarg; X X if ((pat->arg_type == O_MATCH || X pat->arg_type == O_SUBST || X pat->arg_type == O_TRANS || X pat->arg_type == O_SPLIT X ) && X pat[1].arg_ptr.arg_stab == defstab ) { X switch (pat->arg_type) { X case O_MATCH: X newarg = make_op(type == O_MATCH ? O_MATCH : O_NMATCH, X pat->arg_len, X left,Nullarg,Nullarg,0); X break; X case O_SUBST: X newarg = l(make_op(type == O_MATCH ? O_SUBST : O_NSUBST, X pat->arg_len, X left,Nullarg,Nullarg,0)); X break; X case O_TRANS: X newarg = l(make_op(type == O_MATCH ? O_TRANS : O_NTRANS, X pat->arg_len, X left,Nullarg,Nullarg,0)); X break; X case O_SPLIT: X newarg = make_op(type == O_MATCH ? O_SPLIT : O_SPLIT, X pat->arg_len, X left,Nullarg,Nullarg,0); X break; X } X if (pat->arg_len >= 2) { X newarg[2].arg_type = pat[2].arg_type; X newarg[2].arg_ptr = pat[2].arg_ptr; X newarg[2].arg_flags = pat[2].arg_flags; X if (pat->arg_len >= 3) { X newarg[3].arg_type = pat[3].arg_type; X newarg[3].arg_ptr = pat[3].arg_ptr; X newarg[3].arg_flags = pat[3].arg_flags; X } X } X safefree((char*)pat); X } X else { X spat = (SPAT *) safemalloc(sizeof (SPAT)); X bzero((char *)spat, sizeof(SPAT)); X spat->spat_next = spat_root; /* link into spat list */ X spat_root = spat; X init_compex(&spat->spat_compex); X X spat->spat_runtime = pat; X newarg = make_op(type,2,left,Nullarg,Nullarg,0); X newarg[2].arg_type = A_SPAT; X newarg[2].arg_ptr.arg_spat = spat; X newarg[2].arg_flags = AF_SPECIAL; X } X X return newarg; 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); X cmd->c_flags |= CF_COND; X return cmd; X} X XCMD * Xaddloop(cmd, arg) Xregister CMD *cmd; Xregister ARG *arg; X{ X cmd->c_expr = arg; X opt_arg(cmd,1); X cmd->c_flags |= CF_COND|CF_LOOP; 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 cmd->c_flags ^= CF_INVERT; X return cmd; X} X Xyyerror(s) Xchar *s; X{ X char tmpbuf[128]; X char *tname = tmpbuf; X X if (yychar > 256) { X tname = tokename[yychar-256]; X if (strEQ(tname,"word")) X strcpy(tname,tokenbuf); X else if (strEQ(tname,"register")) X sprintf(tname,"$%s",tokenbuf); X else if (strEQ(tname,"array_length")) X sprintf(tname,"$#%s",tokenbuf); X } X else if (!yychar) X strcpy(tname,"EOF"); X else if (yychar < 32) X sprintf(tname,"^%c",yychar+64); X else if (yychar == 127) X strcpy(tname,"^?"); X else X sprintf(tname,"%c",yychar); X printf("%s in file %s at line %d, next token \"%s\"\n", X s,filename,line,tname); X} X Xchar * Xscanstr(s) Xregister char *s; X{ X register char term; X register char *d; X register ARG *arg; X register bool makesingle = FALSE; X char *leave = "\\$nrtfb0123456789"; /* which backslash sequences to keep */ X X arg = op_new(1); X yylval.arg = arg; X arg->arg_type = O_ITEM; X X switch (*s) { X default: /* a substitution replacement */ X arg[1].arg_type = A_DOUBLE; X makesingle = TRUE; /* maybe disable runtime scanning */ X term = *s; X if (term == '\'') X leave = Nullch; X goto snarf_it; X case '0': X { X long i; X int shift; X X arg[1].arg_type = A_SINGLE; X if (s[1] == 'x') { X shift = 4; X s += 2; X } X else if (s[1] == '.') X goto decimal; X else X shift = 3; X i = 0; X for (;;) { X switch (*s) { X default: X goto out; X case '8': case '9': X if (shift != 4) X fatal("Illegal octal digit at line %d",line); X /* FALL THROUGH */ X case '0': case '1': case '2': case '3': case '4': X case '5': case '6': case '7': X i <<= shift; X i += *s++ & 15; X break; X case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': X case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': X if (shift != 4) X goto out; X i <<= 4; X i += (*s++ & 7) + 9; X break; X } X } X out: X sprintf(tokenbuf,"%d",i); X arg[1].arg_ptr.arg_str = str_make(tokenbuf); X } X break; X case '1': case '2': case '3': case '4': case '5': X case '6': case '7': case '8': case '9': case '.': X decimal: X arg[1].arg_type = A_SINGLE; X d = tokenbuf; X while (isdigit(*s) || *s == '_') X *d++ = *s++; X if (*s == '.' && index("0123456789eE",s[1])) X *d++ = *s++; X while (isdigit(*s) || *s == '_') X *d++ = *s++; 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 *d = '\0'; X arg[1].arg_ptr.arg_str = str_make(tokenbuf); X break; X case '\'': X arg[1].arg_type = A_SINGLE; X term = *s; X leave = Nullch; X goto snarf_it; X X case '<': X arg[1].arg_type = A_READ; X s = cpytill(tokenbuf,s+1,'>'); X if (!*tokenbuf) X strcpy(tokenbuf,"ARGV"); X if (*s) X s++; X if (rsfp == stdin && strEQ(tokenbuf,"stdin")) X fatal("Can't get both program and data from <stdin>\n"); X arg[1].arg_ptr.arg_stab = stabent(tokenbuf,TRUE); X arg[1].arg_ptr.arg_stab->stab_io = stio_new(); X if (strEQ(tokenbuf,"ARGV")) { X aadd(arg[1].arg_ptr.arg_stab); X arg[1].arg_ptr.arg_stab->stab_io->flags |= IOF_ARGV|IOF_START; X } X break; X case '"': X arg[1].arg_type = A_DOUBLE; X makesingle = TRUE; /* maybe disable runtime scanning */ X term = *s; X goto snarf_it; X case '`': X arg[1].arg_type = A_BACKTICK; X term = *s; X snarf_it: X { X STR *tmpstr; X int sqstart = line; X char *tmps; X X tmpstr = str_new(strlen(s)); X s = str_append_till(tmpstr,s+1,term,leave); X while (!*s) { /* multiple line string? */ X s = str_gets(linestr, rsfp); X if (!*s) X fatal("EOF in string at line %d\n",sqstart); X line++; X s = str_append_till(tmpstr,s,term,leave); X } X s++; X if (term == '\'') { X arg[1].arg_ptr.arg_str = tmpstr; X break; X } X tmps = s; X s = d = tmpstr->str_ptr; /* assuming shrinkage only */ X while (*s) { X if (*s == '$' && s[1]) { X makesingle = FALSE; /* force interpretation */ X if (!isalpha(s[1])) { /* an internal register? */ X int len; X X len = scanreg(s,tokenbuf) - s; X stabent(tokenbuf,TRUE); /* make sure it's created */ X while (len--) X *d++ = *s++; X continue; X } X } X else if (*s == '\\' && s[1]) { X s++; X switch (*s) { X default: X defchar: X if (!leave || index(leave,*s)) X *d++ = '\\'; X *d++ = *s++; X continue; X case '0': case '1': case '2': case '3': X case '4': case '5': case '6': case '7': X *d = *s++ - '0'; X if (index("01234567",*s)) { X *d <<= 3; X *d += *s++ - '0'; X } X else if (!index('`"',term)) { /* oops, a subpattern */ X s--; X goto defchar; X } X if (index("01234567",*s)) { X *d <<= 3; X *d += *s++ - '0'; X } X d++; X continue; X case 'b': X *d++ = '\b'; X break; X case 'n': X *d++ = '\n'; X break; X case 'r': X *d++ = '\r'; X break; X case 'f': X *d++ = '\f'; X break; X case 't': X *d++ = '\t'; X break; X } X s++; X continue; X } X *d++ = *s++; X } X *d = '\0'; X if (arg[1].arg_type == A_DOUBLE) { X if (makesingle) X arg[1].arg_type = A_SINGLE; /* now we can optimize on it */ X else X leave = "\\"; X for (d = s = tmpstr->str_ptr; *s; *d++ = *s++) { X if (*s == '\\' && (!leave || index(leave,s[1]))) X s++; X } X *d = '\0'; X } X tmpstr->str_cur = d - tmpstr->str_ptr; /* XXX cheat */ X arg[1].arg_ptr.arg_str = tmpstr; X s = tmps; X break; X } X } X return s; X} X XARG * Xmake_op(type,newlen,arg1,arg2,arg3,dolist) Xint type; Xint newlen; XARG *arg1; XARG *arg2; XARG *arg3; Xint dolist; X{ X register ARG *arg; X register ARG *chld; X register int doarg; X X arg = op_new(newlen); X arg->arg_type = type; X doarg = opargs[type]; X if (chld = arg1) { X if (!(doarg & 1)) X arg[1].arg_flags |= AF_SPECIAL; X if (doarg & 16) X arg[1].arg_flags |= AF_NUMERIC; X if (chld->arg_type == O_ITEM && X (hoistable[chld[1].arg_type] || chld[1].arg_type == A_LVAL) ) { X arg[1].arg_type = chld[1].arg_type; X arg[1].arg_ptr = chld[1].arg_ptr; X arg[1].arg_flags |= chld[1].arg_flags; X free_arg(chld); X } X else { X arg[1].arg_type = A_EXPR; X arg[1].arg_ptr.arg_arg = chld; X if (dolist & 1) { X if (chld->arg_type == O_LIST) { X if (newlen == 1) { /* we can hoist entire list */ X chld->arg_type = type; X free_arg(arg); X arg = chld; X } X else { X arg[1].arg_flags |= AF_SPECIAL; X } X } X else if (chld->arg_type == O_ARRAY && chld->arg_len == 1) X arg[1].arg_flags |= AF_SPECIAL; X } X } X } X if (chld = arg2) { X if (!(doarg & 2)) X arg[2].arg_flags |= AF_SPECIAL; X if (doarg & 32) X arg[2].arg_flags |= AF_NUMERIC; X if (chld->arg_type == O_ITEM && X (hoistable[chld[1].arg_type] || X (type == O_ASSIGN && X (chld[1].arg_type == A_READ || X chld[1].arg_type == A_DOUBLE || X chld[1].arg_type == A_BACKTICK ) ) ) ) { X arg[2].arg_type = chld[1].arg_type; X arg[2].arg_ptr = chld[1].arg_ptr; X free_arg(chld); X } X else { X arg[2].arg_type = A_EXPR; X arg[2].arg_ptr.arg_arg = chld; X if ((dolist & 2) && X (chld->arg_type == O_LIST || X (chld->arg_type == O_ARRAY && chld->arg_len == 1) )) X arg[2].arg_flags |= AF_SPECIAL; X } X } X if (chld = arg3) { X if (!(doarg & 4)) X arg[3].arg_flags |= AF_SPECIAL; X if (doarg & 64) X arg[3].arg_flags |= AF_NUMERIC; X if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) { X arg[3].arg_type = chld[1].arg_type; X arg[3].arg_ptr = chld[1].arg_ptr; X free_arg(chld); X } X else { X arg[3].arg_type = A_EXPR; X arg[3].arg_ptr.arg_arg = chld; X if ((dolist & 4) && X (chld->arg_type == O_LIST || X (chld->arg_type == O_ARRAY && chld->arg_len == 1) )) X arg[3].arg_flags |= AF_SPECIAL; X } X } X#ifdef DEBUGGING X if (debug & 16) { X fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]); X if (arg1) X fprintf(stderr,",%s=%lx", X argname[arg[1].arg_type],arg[1].arg_ptr.arg_arg); X if (arg2) X fprintf(stderr,",%s=%lx", X argname[arg[2].arg_type],arg[2].arg_ptr.arg_arg); X if (arg3) X fprintf(stderr,",%s=%lx", X argname[arg[3].arg_type],arg[3].arg_ptr.arg_arg); X fprintf(stderr,")\n"); X } X#endif X evalstatic(arg); /* see if we can consolidate anything */ X return arg; X} X X/* turn 123 into 123 == $. */ X XARG * Xflipflip(arg) Xregister ARG *arg; X{ X if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_SINGLE) { X arg = (ARG*)saferealloc((char*)arg,3*sizeof(ARG)); X arg->arg_type = O_EQ; X arg->arg_len = 2; X arg[2].arg_type = A_STAB; X arg[2].arg_flags = 0; X arg[2].arg_ptr.arg_stab = stabent(".",TRUE); X } X return arg; X} X Xvoid Xevalstatic(arg) Xregister ARG *arg; X{ X register STR *str; X register STR *s1; X register STR *s2; X double value; /* must not be register */ X register char *tmps; X int i; X double exp(), log(), sqrt(), modf(); X char *crypt(); X X if (!arg || !arg->arg_len) X return; X X if (arg[1].arg_type == A_SINGLE && X (arg->arg_len == 1 || arg[2].arg_type == A_SINGLE) ) { X str = str_new(0); X s1 = arg[1].arg_ptr.arg_str; X if (arg->arg_len > 1) X s2 = arg[2].arg_ptr.arg_str; X else X s2 = Nullstr; X switch (arg->arg_type) { X default: X str_free(str); X str = Nullstr; /* can't be evaluated yet */ X break; X case O_CONCAT: X str_sset(str,s1); X str_scat(str,s2); X break; X case O_REPEAT: X i = (int)str_gnum(s2); X while (i--) X str_scat(str,s1); X break; X case O_MULTIPLY: X value = str_gnum(s1); X str_numset(str,value * str_gnum(s2)); X break; X case O_DIVIDE: X value = str_gnum(s1); X str_numset(str,value / str_gnum(s2)); X break; X case O_MODULO: X value = str_gnum(s1); X str_numset(str,(double)(((long)value) % ((long)str_gnum(s2)))); X break; X case O_ADD: X value = str_gnum(s1); X str_numset(str,value + str_gnum(s2)); X break; X case O_SUBTRACT: X value = str_gnum(s1); X str_numset(str,value - str_gnum(s2)); X break; X case O_LEFT_SHIFT: X value = str_gnum(s1); X str_numset(str,(double)(((long)value) << ((long)str_gnum(s2)))); X break; X case O_RIGHT_SHIFT: X value = str_gnum(s1); X str_numset(str,(double)(((long)value) >> ((long)str_gnum(s2)))); X break; X case O_LT: X value = str_gnum(s1); X str_numset(str,(double)(value < str_gnum(s2))); X break; X case O_GT: X value = str_gnum(s1); X str_numset(str,(double)(value > str_gnum(s2))); X break; X case O_LE: X value = str_gnum(s1); X str_numset(str,(double)(value <= str_gnum(s2))); X break; X case O_GE: X value = str_gnum(s1); X str_numset(str,(double)(value >= str_gnum(s2))); X break; X case O_EQ: X value = str_gnum(s1); X str_numset(str,(double)(value == str_gnum(s2))); X break; X case O_NE: X value = str_gnum(s1); X str_numset(str,(double)(value != str_gnum(s2))); X break; X case O_BIT_AND: X value = str_gnum(s1); X str_numset(str,(double)(((long)value) & ((long)str_gnum(s2)))); X break; X case O_XOR: X value = str_gnum(s1); X str_numset(str,(double)(((long)value) ^ ((long)str_gnum(s2)))); X break; X case O_BIT_OR: X value = str_gnum(s1); X str_numset(str,(double)(((long)value) | ((long)str_gnum(s2)))); X break; X case O_AND: X if (str_true(s1)) X str = str_make(str_get(s2)); X else X str = str_make(str_get(s1)); X break; X case O_OR: X if (str_true(s1)) X str = str_make(str_get(s1)); X else X str = str_make(str_get(s2)); X break; X case O_COND_EXPR: X if (arg[3].arg_type != A_SINGLE) { X str_free(str); X str = Nullstr; X } X else { X str = str_make(str_get(str_true(s1) ? s2 : arg[3].arg_ptr.arg_str)); X str_free(arg[3].arg_ptr.arg_str); X } X break; X case O_NEGATE: X str_numset(str,(double)(-str_gnum(s1))); X break; X case O_NOT: X str_numset(str,(double)(!str_true(s1))); X break; X case O_COMPLEMENT: X str_numset(str,(double)(~(long)str_gnum(s1))); X break; X case O_LENGTH: X str_numset(str, (double)str_len(s1)); X break; X case O_SUBSTR: X if (arg[3].arg_type != A_SINGLE || stabent("[",FALSE)) { X str_free(str); /* making the fallacious assumption */ X str = Nullstr; /* that any $[ occurs before substr()*/ X } X else { X char *beg; X int len = (int)str_gnum(s2); X int tmp; X X for (beg = str_get(s1); *beg && len > 0; beg++,len--) ; X len = (int)str_gnum(arg[3].arg_ptr.arg_str); X str_free(arg[3].arg_ptr.arg_str); X if (len > (tmp = strlen(beg))) X len = tmp; X str_nset(str,beg,len); X } X break; X case O_SLT: X tmps = str_get(s1); X str_numset(str,(double)(strLT(tmps,str_get(s2)))); X break; X case O_SGT: X tmps = str_get(s1); X str_numset(str,(double)(strGT(tmps,str_get(s2)))); X break; X case O_SLE: X tmps = str_get(s1); X str_numset(str,(double)(strLE(tmps,str_get(s2)))); X break; X case O_SGE: X tmps = str_get(s1); X str_numset(str,(double)(strGE(tmps,str_get(s2)))); X break; X case O_SEQ: X tmps = str_get(s1); X str_numset(str,(double)(strEQ(tmps,str_get(s2)))); X break; X case O_SNE: X tmps = str_get(s1); X str_numset(str,(double)(strNE(tmps,str_get(s2)))); X break; X case O_CRYPT: X tmps = str_get(s1); X str_set(str,crypt(tmps,str_get(s2))); X break; X case O_EXP: X str_numset(str,exp(str_gnum(s1))); X break; X case O_LOG: X str_numset(str,log(str_gnum(s1))); X break; X case O_SQRT: X str_numset(str,sqrt(str_gnum(s1))); X break; X case O_INT: X modf(str_gnum(s1),&value); X str_numset(str,value); X break; X case O_ORD: X str_numset(str,(double)(*str_get(s1))); X break; X } X if (str) { X arg->arg_type = O_ITEM; /* note arg1 type is already SINGLE */ X str_free(s1); X str_free(s2); X arg[1].arg_ptr.arg_str = str; X } X } X} X XARG * Xl(arg) Xregister ARG *arg; X{ X register int i; X register ARG *arg1; X X arg->arg_flags |= AF_COMMON; /* XXX should cross-match */ X X /* see if it's an array reference */ X X if (arg[1].arg_type == A_EXPR) { X arg1 = arg[1].arg_ptr.arg_arg; X X if (arg1->arg_type == O_LIST && arg->arg_type != O_ITEM) { X /* assign to list */ X arg[1].arg_flags |= AF_SPECIAL; X arg[2].arg_flags |= AF_SPECIAL; X for (i = arg1->arg_len; i >= 1; i--) { X switch (arg1[i].arg_type) { X case A_STAB: case A_LVAL: X arg1[i].arg_type = A_LVAL; X break; X case A_EXPR: case A_LEXPR: X arg1[i].arg_type = A_LEXPR; X if (arg1[i].arg_ptr.arg_arg->arg_type == O_ARRAY) X arg1[i].arg_ptr.arg_arg->arg_type = O_LARRAY; X else if (arg1[i].arg_ptr.arg_arg->arg_type == O_HASH) X arg1[i].arg_ptr.arg_arg->arg_type = O_LHASH; X if (arg1[i].arg_ptr.arg_arg->arg_type == O_LARRAY) X break; X if (arg1[i].arg_ptr.arg_arg->arg_type == O_LHASH) X break; X /* FALL THROUGH */ X default: X sprintf(tokenbuf, X "Illegal item (%s) as lvalue",argname[arg1[i].arg_type]); X yyerror(tokenbuf); X } X } X } X else if (arg1->arg_type == O_ARRAY) { X if (arg1->arg_len == 1 && arg->arg_type != O_ITEM) { X /* assign to array */ X arg[1].arg_flags |= AF_SPECIAL; X arg[2].arg_flags |= AF_SPECIAL; X } X else X arg1->arg_type = O_LARRAY; /* assign to array elem */ X } X else if (arg1->arg_type == O_HASH) X arg1->arg_type = O_LHASH; X else { X sprintf(tokenbuf, X "Illegal expression (%s) as lvalue",opname[arg1->arg_type]); X yyerror(tokenbuf); X } X arg[1].arg_type = A_LEXPR; X#ifdef DEBUGGING X if (debug & 16) X fprintf(stderr,"lval LEXPR\n"); X#endif X return arg; X } X X /* not an array reference, should be a register name */ X X if (arg[1].arg_type != A_STAB && arg[1].arg_type != A_LVAL) { X sprintf(tokenbuf, X "Illegal item (%s) as lvalue",argname[arg[1].arg_type]); X yyerror(tokenbuf); X } X arg[1].arg_type = A_LVAL; X#ifdef DEBUGGING X if (debug & 16) X fprintf(stderr,"lval LVAL\n"); X#endif X return arg; X} X XARG * Xaddflags(i,flags,arg) Xregister ARG *arg; X{ X arg[i].arg_flags |= flags; X return arg; X} X XARG * Xhide_ary(arg) XARG *arg; X{ X if (arg->arg_type == O_ARRAY) X return make_op(O_ITEM,1,arg,Nullarg,Nullarg,0); X return arg; X} X XARG * Xmake_list(arg) Xregister ARG *arg; X{ X register int i; X register ARG *node; X register ARG *nxtnode; X register int j; X STR *tmpstr; X X if (!arg) { X arg = op_new(0); X arg->arg_type = O_LIST; X } X if (arg->arg_type != O_COMMA) { X arg->arg_flags |= AF_LISTISH; /* see listish() below */ X return arg; X } X for (i = 2, node = arg; ; i++) { X if (node->arg_len < 2) X break; X if (node[2].arg_type != A_EXPR) X break; X node = node[2].arg_ptr.arg_arg; X if (node->arg_type != O_COMMA) X break; X } X if (i > 2) { X node = arg; X arg = op_new(i); X tmpstr = arg->arg_ptr.arg_str; X *arg = *node; /* copy everything except the STR */ X arg->arg_ptr.arg_str = tmpstr; X for (j = 1; ; ) { X arg[j++] = node[1]; X if (j >= i) { X arg[j] = node[2]; X free_arg(node); X break; X } X nxtnode = node[2].arg_ptr.arg_arg; X free_arg(node); X node = nxtnode; X } X } X arg->arg_type = O_LIST; X arg->arg_len = i; X return arg; X} X X/* turn a single item into a list */ X XARG * Xlistish(arg) XARG *arg; X{ X if (arg->arg_flags & AF_LISTISH) X arg = make_op(O_LIST,1,arg,Nullarg,Nullarg,0); X return arg; X} X XARG * Xstab_to_arg(atype,stab) Xint atype; Xregister STAB *stab; X{ X register ARG *arg; X X arg = op_new(1); X arg->arg_type = O_ITEM; X arg[1].arg_type = atype; X arg[1].arg_ptr.arg_stab = stab; X return arg; X} X XARG * Xcval_to_arg(cval) Xregister char *cval; X{ X register ARG *arg; X X arg = op_new(1); X arg->arg_type = O_ITEM; X arg[1].arg_type = A_SINGLE; X arg[1].arg_ptr.arg_str = str_make(cval); X safefree(cval); X return arg; X} X XARG * Xop_new(numargs) Xint numargs; X{ X register ARG *arg; X X arg = (ARG*)safemalloc((numargs + 1) * sizeof (ARG)); X bzero((char *)arg, (numargs + 1) * sizeof (ARG)); X arg->arg_ptr.arg_str = str_new(0); X arg->arg_len = numargs; X return arg; X} X Xvoid Xfree_arg(arg) XARG *arg; X{ X str_free(arg->arg_ptr.arg_str); X safefree((char*)arg); X} X XARG * Xmake_match(type,expr,spat) Xint type; XARG *expr; XSPAT *spat; X{ X register ARG *arg; X X arg = make_op(type,2,expr,Nullarg,Nullarg,0); X X arg[2].arg_type = A_SPAT; X arg[2].arg_ptr.arg_spat = spat; X#ifdef DEBUGGING X if (debug & 16) X fprintf(stderr,"make_match SPAT=%lx\n",spat); X#endif X X if (type == O_SUBST || type == O_NSUBST) { X if (arg[1].arg_type != A_STAB) X yyerror("Illegal lvalue"); X arg[1].arg_type = A_LVAL; X } X return arg; X} X XARG * Xcmd_to_arg(cmd) XCMD *cmd; X{ X register ARG *arg; X X arg = op_new(1); X arg->arg_type = O_ITEM; X arg[1].arg_type = A_CMD; X arg[1].arg_ptr.arg_cmd = cmd; X return arg; X} X XCMD * Xwopt(cmd) Xregister CMD *cmd; X{ X register CMD *tail; X register ARG *arg = cmd->c_expr; X char *tmps; /* used by True macro */ 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 (arg[1].arg_ptr.arg_stab->stab_io->flags & IOF_ARGV) { X cmd->c_expr = l(make_op(O_ASSIGN, 2, /* fake up "$_ =" */ X stab_to_arg(A_LVAL,defstab), arg, Nullarg,1 )); X } X else { X free_arg(arg); X cmd->c_expr = Nullarg; X } X } X X /* First find the end of the true list */ X X if (cmd->ucmd.ccmd.cc_true == Nullcmd) X return cmd; X for (tail = cmd->ucmd.ccmd.cc_true; tail->c_next; tail = tail->c_next) ; 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 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 = (CMD *) safemalloc(sizeof (CMD)); X tail = tail->c_next; X if (!cmd->ucmd.ccmd.cc_alt) X cmd->ucmd.ccmd.cc_alt = tail; /* every loop has a continue now */ X X bcopy((char *)cmd, (char *)tail, sizeof(CMD)); 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 XFCMD * Xload_format() X{ X FCMD froot; X FCMD *flinebeg; X register FCMD *fprev = &froot; X register FCMD *fcmd; X register char *s; X register char *t; X register char tmpchar; X bool noblank; X X while ((s = str_gets(linestr,rsfp)) != Nullch) { X line++; X if (strEQ(s,".\n")) { X bufptr = s; X return froot.f_next; X } X if (*s == '#') X continue; X flinebeg = Nullfcmd; X noblank = FALSE; X while (*s) { X fcmd = (FCMD *)safemalloc(sizeof (FCMD)); X bzero((char*)fcmd, sizeof (FCMD)); X fprev->f_next = fcmd; X fprev = fcmd; X for (t=s; *t && *t != '@' && *t != '^'; t++) { X if (*t == '~') { X noblank = TRUE; X *t = ' '; X } X } X tmpchar = *t; X *t = '\0'; X fcmd->f_pre = savestr(s); X fcmd->f_presize = strlen(s); X *t = tmpchar; X s = t; X if (!*s) { X if (noblank) X fcmd->f_flags |= FC_NOBLANK; X break; X } X if (!flinebeg) X flinebeg = fcmd; /* start values here */ X if (*s++ == '^') X fcmd->f_flags |= FC_CHOP; /* for doing text filling */ X switch (*s) { X case '*': X fcmd->f_type = F_LINES; X *s = '\0'; X break; X case '<': X fcmd->f_type = F_LEFT; X while (*s == '<') X s++; X break; X case '>': X fcmd->f_type = F_RIGHT; X while (*s == '>') X s++; X break; X case '|': X fcmd->f_type = F_CENTER; X while (*s == '|') X s++; X break; X default: X fcmd->f_type = F_LEFT; X break; X } X if (fcmd->f_flags & FC_CHOP && *s == '.') { X fcmd->f_flags |= FC_MORE; X while (*s == '.') X s++; X } X fcmd->f_size = s-t; X } X if (flinebeg) { X again: X if ((bufptr = str_gets(linestr ,rsfp)) == Nullch) X goto badform; X line++; X if (strEQ(bufptr,".\n")) { X yyerror("Missing values line"); X return froot.f_next; X } X if (*bufptr == '#') X goto again; X lex_newlines = TRUE; X while (flinebeg || *bufptr) { X switch(yylex()) { X default: X yyerror("Bad value in format"); X *bufptr = '\0'; X break; X case '\n': X if (flinebeg) X yyerror("Missing value in format"); X *bufptr = '\0'; X break; X case REG: X yylval.arg = stab_to_arg(A_LVAL,yylval.stabval); X /* FALL THROUGH */ X case RSTRING: X if (!flinebeg) X yyerror("Extra value in format"); X else { X flinebeg->f_expr = yylval.arg; X do { X flinebeg = flinebeg->f_next; X } while (flinebeg && flinebeg->f_size == 0); X } X break; X case ',': case ';': X continue; X } X } X lex_newlines = FALSE; X } X } X badform: X bufptr = str_get(linestr); X yyerror("Format not terminated"); X return froot.f_next; X} !STUFFY!FUNK! echo "" echo "End of kit 2 (of 10)" cat /dev/null >kit2isdone config=true for iskit in 1 2 3 4 5 6 7 8 9 10; do if test -f kit${iskit}isdone; then echo "You have run kit ${iskit}." else echo "You still need to run kit ${iskit}." config=false fi done case $config in true) echo "You have run all your kits. Please read README and then type Configure." chmod 755 Configure ;; esac : Someone might mail this, so... exit -- For comp.sources.unix stuff, mail to sources@uunet.uu.net.