perl 3.0 beta kit [15/23]
Larry Wall
lwall at jato.Jpl.Nasa.Gov
Mon Sep 4 05:00:11 AEST 1989
#! /bin/sh
# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 23 through sh. When all 23 kits have been run, read README.
echo "This is perl 3.0 kit 15 (of 23). If kit 15 is complete, the line"
echo '"'"End of kit 15 (of 23)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir eg/scan eg x2p 2>/dev/null
echo Extracting x2p/a2py.c
sed >x2p/a2py.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: a2py.c,v 2.0.1.4 88/10/31 16:52:13 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 2.0.1.4 88/10/31 16:52:13 lwall
X * patch15: deleted some duplicate $ characters
X *
X * Revision 2.0.1.3 88/09/07 17:15:57 lwall
X * patch14: walk() needed to be declared outside of main()
X *
X * Revision 2.0.1.2 88/08/03 22:50:05 root
X * patch11: in a2p, numbers couldn't start with '.'
X *
X * Revision 2.0.1.1 88/07/11 23:25:33 root
X * patch2: changes to support translation of 1985 awk
X * patch2: now fixes any perl reserved words it finds
X * patch2: now checks for overflow of ops storage area
X *
X * Revision 2.0 88/06/05 00:15:41 root
X * Baseline version 2.0.
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("#!/usr/bin/perl\neval \"exec /usr/bin/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 util.c
sed >util.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: util.c,v 2.0.1.6 88/11/19 00:31: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: util.c,v $
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X#include "errno.h"
X
X#ifdef VARARGS
X# include <varargs.h>
X#endif
X
X#define FLUSH
X
Xstatic char nomem[] = "Out of memory!\n";
X
X/* paranoid version of malloc */
X
X#ifdef DEBUGGING
Xstatic int an = 0;
X#endif
X
X/* NOTE: Do not call the next three routines directly. Use the macros
X * in handy.h, so that we can easily redefine everything to do tracking of
X * allocated hunks back to the original New to track down any memory leaks.
X */
X
Xchar *
Xsafemalloc(size)
XMEM_SIZE size;
X{
X char *ptr;
X char *malloc();
X
X ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
X#ifdef DEBUGGING
X# ifndef I286
X if (debug & 128)
X fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",ptr,an++,size);
X# else
X if (debug & 128)
X fprintf(stderr,"0x%lx: (%05d) malloc %d bytes\n",ptr,an++,size);
X# endif
X#endif
X if (ptr != Nullch)
X return ptr;
X else {
X fputs(nomem,stdout) FLUSH;
X exit(1);
X }
X /*NOTREACHED*/
X#ifdef lint
X return ptr;
X#endif
X}
X
X/* paranoid version of realloc */
X
Xchar *
Xsaferealloc(where,size)
Xchar *where;
XMEM_SIZE size;
X{
X char *ptr;
X char *realloc();
X
X if (!where)
X fatal("Null realloc");
X ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */
X#ifdef DEBUGGING
X# ifndef I286
X if (debug & 128) {
X fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
X fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",ptr,an++,size);
X }
X# else
X if (debug & 128) {
X fprintf(stderr,"0x%lx: (%05d) rfree\n",where,an++);
X fprintf(stderr,"0x%lx: (%05d) realloc %d bytes\n",ptr,an++,size);
X }
X# endif
X#endif
X if (ptr != Nullch)
X return ptr;
X else {
X fputs(nomem,stdout) FLUSH;
X exit(1);
X }
X /*NOTREACHED*/
X#ifdef lint
X return ptr;
X#endif
X}
X
X/* safe version of free */
X
Xsafefree(where)
Xchar *where;
X{
X#ifdef DEBUGGING
X# ifndef I286
X if (debug & 128)
X fprintf(stderr,"0x%x: (%05d) free\n",where,an++);
X# else
X if (debug & 128)
X fprintf(stderr,"0x%lx: (%05d) free\n",where,an++);
X# endif
X#endif
X if (where) {
X free(where);
X }
X}
X
X/* copy a string up to some (non-backslashed) delimiter, if any */
X
Xchar *
Xcpytill(to,from,fromend,delim,retlen)
Xregister char *to, *from;
Xregister char *fromend;
Xregister int delim;
Xint *retlen;
X{
X char *origto = to;
X
X for (; from < fromend; from++,to++) {
X if (*from == '\\') {
X if (from[1] == delim)
X from++;
X else if (from[1] == '\\')
X *to++ = *from++;
X }
X else if (*from == delim)
X break;
X *to = *from;
X }
X *to = '\0';
X *retlen = to - origto;
X return from;
X}
X
X/* return ptr to little string in big string, NULL if not found */
X/* This routine was donated by Corey Satten. */
X
Xchar *
Xinstr(big, little)
Xregister char *big;
Xregister char *little;
X{
X register char *s, *x;
X register int first = *little++;
X
X if (!first)
X return big;
X while (*big) {
X if (*big++ != first)
X continue;
X for (x=big,s=little; *s; /**/ ) {
X if (!*x)
X return Nullch;
X if (*s++ != *x++) {
X s--;
X break;
X }
X }
X if (!*s)
X return big-1;
X }
X return Nullch;
X}
X
X/* same as instr but allow embedded nulls */
X
Xchar *
Xninstr(big, bigend, little, lend)
Xregister char *big;
Xregister char *bigend;
Xchar *little;
Xchar *lend;
X{
X register char *s, *x;
X register int first = *little;
X register char *littleend = lend;
X
X if (!first && little > littleend)
X return big;
X bigend -= littleend - little++;
X while (big <= bigend) {
X if (*big++ != first)
X continue;
X for (x=big,s=little; s < littleend; /**/ ) {
X if (*s++ != *x++) {
X s--;
X break;
X }
X }
X if (s >= littleend)
X return big-1;
X }
X return Nullch;
X}
X
X/* reverse of the above--find last substring */
X
Xchar *
Xrninstr(big, bigend, little, lend)
Xregister char *big;
Xchar *bigend;
Xchar *little;
Xchar *lend;
X{
X register char *bigbeg;
X register char *s, *x;
X register int first = *little;
X register char *littleend = lend;
X
X if (!first && little > littleend)
X return bigend;
X bigbeg = big;
X big = bigend - (littleend - little++);
X while (big >= bigbeg) {
X if (*big-- != first)
X continue;
X for (x=big+2,s=little; s < littleend; /**/ ) {
X if (*s++ != *x++) {
X s--;
X break;
X }
X }
X if (s >= littleend)
X return big+1;
X }
X return Nullch;
X}
X
Xunsigned char fold[] = {
X 0, 1, 2, 3, 4, 5, 6, 7,
X 8, 9, 10, 11, 12, 13, 14, 15,
X 16, 17, 18, 19, 20, 21, 22, 23,
X 24, 25, 26, 27, 28, 29, 30, 31,
X 32, 33, 34, 35, 36, 37, 38, 39,
X 40, 41, 42, 43, 44, 45, 46, 47,
X 48, 49, 50, 51, 52, 53, 54, 55,
X 56, 57, 58, 59, 60, 61, 62, 63,
X 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g',
X 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',
X 'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
X 'x', 'y', 'z', 91, 92, 93, 94, 95,
X 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G',
X 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
X 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
X 'X', 'Y', 'Z', 123, 124, 125, 126, 127,
X 128, 129, 130, 131, 132, 133, 134, 135,
X 136, 137, 138, 139, 140, 141, 142, 143,
X 144, 145, 146, 147, 148, 149, 150, 151,
X 152, 153, 154, 155, 156, 157, 158, 159,
X 160, 161, 162, 163, 164, 165, 166, 167,
X 168, 169, 170, 171, 172, 173, 174, 175,
X 176, 177, 178, 179, 180, 181, 182, 183,
X 184, 185, 186, 187, 188, 189, 190, 191,
X 192, 193, 194, 195, 196, 197, 198, 199,
X 200, 201, 202, 203, 204, 205, 206, 207,
X 208, 209, 210, 211, 212, 213, 214, 215,
X 216, 217, 218, 219, 220, 221, 222, 223,
X 224, 225, 226, 227, 228, 229, 230, 231,
X 232, 233, 234, 235, 236, 237, 238, 239,
X 240, 241, 242, 243, 244, 245, 246, 247,
X 248, 249, 250, 251, 252, 253, 254, 255
X};
X
Xstatic unsigned char freq[] = {
X 1, 2, 84, 151, 154, 155, 156, 157,
X 165, 246, 250, 3, 158, 7, 18, 29,
X 40, 51, 62, 73, 85, 96, 107, 118,
X 129, 140, 147, 148, 149, 150, 152, 153,
X 255, 182, 224, 205, 174, 176, 180, 217,
X 233, 232, 236, 187, 235, 228, 234, 226,
X 222, 219, 211, 195, 188, 193, 185, 184,
X 191, 183, 201, 229, 181, 220, 194, 162,
X 163, 208, 186, 202, 200, 218, 198, 179,
X 178, 214, 166, 170, 207, 199, 209, 206,
X 204, 160, 212, 216, 215, 192, 175, 173,
X 243, 172, 161, 190, 203, 189, 164, 230,
X 167, 248, 227, 244, 242, 255, 241, 231,
X 240, 253, 169, 210, 245, 237, 249, 247,
X 239, 168, 252, 251, 254, 238, 223, 221,
X 213, 225, 177, 197, 171, 196, 159, 4,
X 5, 6, 8, 9, 10, 11, 12, 13,
X 14, 15, 16, 17, 19, 20, 21, 22,
X 23, 24, 25, 26, 27, 28, 30, 31,
X 32, 33, 34, 35, 36, 37, 38, 39,
X 41, 42, 43, 44, 45, 46, 47, 48,
X 49, 50, 52, 53, 54, 55, 56, 57,
X 58, 59, 60, 61, 63, 64, 65, 66,
X 67, 68, 69, 70, 71, 72, 74, 75,
X 76, 77, 78, 79, 80, 81, 82, 83,
X 86, 87, 88, 89, 90, 91, 92, 93,
X 94, 95, 97, 98, 99, 100, 101, 102,
X 103, 104, 105, 106, 108, 109, 110, 111,
X 112, 113, 114, 115, 116, 117, 119, 120,
X 121, 122, 123, 124, 125, 126, 127, 128,
X 130, 131, 132, 133, 134, 135, 136, 137,
X 138, 139, 141, 142, 143, 144, 145, 146
X};
X
Xvoid
Xfbmcompile(str, iflag)
XSTR *str;
Xint iflag;
X{
X register unsigned char *s;
X register unsigned char *table;
X register int i;
X register int len = str->str_cur;
X int rarest = 0;
X int frequency = 256;
X
X str_grow(str,len+258);
X#ifndef lint
X table = (unsigned char*)(str->str_ptr + len + 1);
X#else
X table = Null(unsigned char*);
X#endif
X s = table - 2;
X for (i = 0; i < 256; i++) {
X table[i] = len;
X }
X i = 0;
X#ifndef lint
X while (s >= (unsigned char*)(str->str_ptr))
X#endif
X {
X if (table[*s] == len) {
X#ifndef pdp11
X if (iflag)
X table[*s] = table[fold[*s]] = i;
X#else
X if (iflag) {
X int j;
X j = fold[*s];
X table[j] = i;
X table[*s] = i;
X }
X#endif /* pdp11 */
X else
X table[*s] = i;
X }
X s--,i++;
X }
X str->str_pok |= SP_FBM; /* deep magic */
X
X#ifndef lint
X s = (unsigned char*)(str->str_ptr); /* deeper magic */
X#else
X s = Null(unsigned char*);
X#endif
X if (iflag) {
X register int tmp, foldtmp;
X str->str_pok |= SP_CASEFOLD;
X for (i = 0; i < len; i++) {
X tmp=freq[s[i]];
X foldtmp=freq[fold[s[i]]];
X if (tmp < frequency && foldtmp < frequency) {
X rarest = i;
X /* choose most frequent among the two */
X frequency = (tmp > foldtmp) ? tmp : foldtmp;
X }
X }
X }
X else {
X for (i = 0; i < len; i++) {
X if (freq[s[i]] < frequency) {
X rarest = i;
X frequency = freq[s[i]];
X }
X }
X }
X str->str_rare = s[rarest];
X str->str_state = rarest;
X#ifdef DEBUGGING
X if (debug & 512)
X fprintf(stderr,"rarest char %c at %d\n",str->str_rare, str->str_state);
X#endif
X}
X
Xchar *
Xfbminstr(big, bigend, littlestr)
Xunsigned char *big;
Xregister unsigned char *bigend;
XSTR *littlestr;
X{
X register unsigned char *s;
X register int tmp;
X register int littlelen;
X register unsigned char *little;
X register unsigned char *table;
X register unsigned char *olds;
X register unsigned char *oldlittle;
X
X#ifndef lint
X if (!(littlestr->str_pok & SP_FBM))
X return instr((char*)big,littlestr->str_ptr);
X#endif
X
X littlelen = littlestr->str_cur;
X#ifndef lint
X if (littlestr->str_pok & SP_TAIL && !multiline) { /* tail anchored? */
X little = (unsigned char*)littlestr->str_ptr;
X if (littlestr->str_pok & SP_CASEFOLD) { /* oops, fake it */
X big = bigend - littlelen; /* just start near end */
X if (bigend[-1] == '\n' && little[littlelen-1] != '\n')
X big--;
X }
X else {
X s = bigend - littlelen;
X if (*s == *little && bcmp(s,little,littlelen)==0)
X return (char*)s; /* how sweet it is */
X else if (bigend[-1] == '\n' && little[littlelen-1] != '\n') {
X s--;
X if (*s == *little && bcmp(s,little,littlelen)==0)
X return (char*)s;
X }
X return Nullch;
X }
X }
X table = (unsigned char*)(littlestr->str_ptr + littlelen + 1);
X#else
X table = Null(unsigned char*);
X#endif
X s = big + --littlelen;
X oldlittle = little = table - 2;
X if (littlestr->str_pok & SP_CASEFOLD) { /* case insensitive? */
X while (s < bigend) {
X top1:
X if (tmp = table[*s]) {
X s += tmp;
X }
X else {
X tmp = littlelen; /* less expensive than calling strncmp() */
X olds = s;
X while (tmp--) {
X if (*--s == *--little || fold[*s] == *little)
X continue;
X s = olds + 1; /* here we pay the price for failure */
X little = oldlittle;
X if (s < bigend) /* fake up continue to outer loop */
X goto top1;
X return Nullch;
X }
X#ifndef lint
X return (char *)s;
X#endif
X }
X }
X }
X else {
X while (s < bigend) {
X top2:
X if (tmp = table[*s]) {
X s += tmp;
X }
X else {
X tmp = littlelen; /* less expensive than calling strncmp() */
X olds = s;
X while (tmp--) {
X if (*--s == *--little)
X continue;
X s = olds + 1; /* here we pay the price for failure */
X little = oldlittle;
X if (s < bigend) /* fake up continue to outer loop */
X goto top2;
X return Nullch;
X }
X#ifndef lint
X return (char *)s;
X#endif
X }
X }
X }
X return Nullch;
X}
X
Xchar *
Xscreaminstr(bigstr, littlestr)
XSTR *bigstr;
XSTR *littlestr;
X{
X register unsigned char *s, *x;
X register unsigned char *big;
X register int pos;
X register int previous;
X register int first;
X register unsigned char *little;
X register unsigned char *bigend;
X register unsigned char *littleend;
X
X if ((pos = screamfirst[littlestr->str_rare]) < 0)
X return Nullch;
X#ifndef lint
X little = (unsigned char *)(littlestr->str_ptr);
X#else
X little = Null(unsigned char *);
X#endif
X littleend = little + littlestr->str_cur;
X first = *little++;
X previous = littlestr->str_state;
X#ifndef lint
X big = (unsigned char *)(bigstr->str_ptr);
X#else
X big = Null(unsigned char*);
X#endif
X bigend = big + bigstr->str_cur;
X big -= previous;
X while (pos < previous) {
X#ifndef lint
X if (!(pos += screamnext[pos]))
X#endif
X return Nullch;
X }
X if (littlestr->str_pok & SP_CASEFOLD) { /* case insignificant? */
X do {
X if (big[pos] != first && big[pos] != fold[first])
X continue;
X for (x=big+pos+1,s=little; s < littleend; /**/ ) {
X if (x >= bigend)
X return Nullch;
X if (*s++ != *x++ && fold[*(s-1)] != *(x-1)) {
X s--;
X break;
X }
X }
X if (s == littleend)
X#ifndef lint
X return (char *)(big+pos);
X#else
X return Nullch;
X#endif
X } while (
X#ifndef lint
X pos += screamnext[pos] /* does this goof up anywhere? */
X#else
X pos += screamnext[0]
X#endif
X );
X }
X else {
X do {
X if (big[pos] != first)
X continue;
X for (x=big+pos+1,s=little; s < littleend; /**/ ) {
X if (x >= bigend)
X return Nullch;
X if (*s++ != *x++) {
X s--;
X break;
X }
X }
X if (s == littleend)
X#ifndef lint
X return (char *)(big+pos);
X#else
X return Nullch;
X#endif
X } while (
X#ifndef lint
X pos += screamnext[pos]
X#else
X pos += screamnext[0]
X#endif
X );
X }
X return Nullch;
X}
X
X/* copy a string to a safe spot */
X
Xchar *
Xsavestr(str)
Xchar *str;
X{
X register char *newaddr;
X
X New(902,newaddr,strlen(str)+1,char);
X (void)strcpy(newaddr,str);
X return newaddr;
X}
X
X/* same thing but with a known length */
X
Xchar *
Xnsavestr(str, len)
Xchar *str;
Xregister int len;
X{
X register char *newaddr;
X
X New(903,newaddr,len+1,char);
X (void)bcopy(str,newaddr,len); /* might not be null terminated */
X newaddr[len] = '\0'; /* is now */
X return newaddr;
X}
X
X/* grow a static string to at least a certain length */
X
Xvoid
Xgrowstr(strptr,curlen,newlen)
Xchar **strptr;
Xint *curlen;
Xint newlen;
X{
X if (newlen > *curlen) { /* need more room? */
X if (*curlen)
X Renew(*strptr,newlen,char);
X else
X New(905,*strptr,newlen,char);
X *curlen = newlen;
X }
X}
X
Xextern int errno;
X
X#ifndef VARARGS
X/*VARARGS1*/
Xmess(pat,a1,a2,a3,a4)
Xchar *pat;
Xlong a1, a2, a3, a4;
X{
X char *s;
X
X s = buf;
X (void)sprintf(s,pat,a1,a2,a3,a4);
X s += strlen(s);
X if (s[-1] != '\n') {
X if (line) {
X (void)sprintf(s," at %s line %ld",
X in_eval?filename:origfilename, (long)line);
X s += strlen(s);
X }
X if (last_in_stab &&
X stab_io(last_in_stab) &&
X stab_io(last_in_stab)->lines ) {
X (void)sprintf(s,", <%s> line %ld",
X last_in_stab == argvstab ? "" : stab_name(last_in_stab),
X (long)stab_io(last_in_stab)->lines);
X s += strlen(s);
X }
X (void)strcpy(s,".\n");
X }
X}
X
X/*VARARGS1*/
Xfatal(pat,a1,a2,a3,a4)
Xchar *pat;
Xlong a1, a2, a3, a4;
X{
X extern FILE *e_fp;
X extern char *e_tmpname;
X
X mess(pat,a1,a2,a3,a4);
X if (in_eval) {
X str_set(stab_val(stabent("@",TRUE)),buf);
X longjmp(eval_env,1);
X }
X fputs(buf,stderr);
X (void)fflush(stderr);
X if (e_fp)
X (void)UNLINK(e_tmpname);
X statusvalue >>= 8;
X exit(errno?errno:(statusvalue?statusvalue:255));
X}
X
X/*VARARGS1*/
Xwarn(pat,a1,a2,a3,a4)
Xchar *pat;
Xlong a1, a2, a3, a4;
X{
X mess(pat,a1,a2,a3,a4);
X fputs(buf,stderr);
X (void)fflush(stderr);
X}
X#else
X/*VARARGS0*/
Xmess(args)
Xva_list args;
X{
X char *pat;
X char *s;
X#ifdef CHARSPRINTF
X char *vsprintf();
X#else
X int vsprintf();
X#endif
X
X s = buf;
X#ifdef lint
X pat = Nullch;
X#else
X pat = va_arg(args, char *);
X#endif
X (void) vsprintf(s,pat,args);
X
X s += strlen(s);
X if (s[-1] != '\n') {
X if (line) {
X (void)sprintf(s," at %s line %ld",
X in_eval?filename:origfilename, (long)line);
X s += strlen(s);
X }
X if (last_in_stab &&
X stab_io(last_in_stab) &&
X stab_io(last_in_stab)->lines ) {
X (void)sprintf(s,", <%s> line %ld",
X last_in_stab == argvstab ? "" : last_in_stab->str_magic->str_ptr,
X (long)stab_io(last_in_stab)->lines);
X s += strlen(s);
X }
X (void)strcpy(s,".\n");
X }
X}
X
X/*VARARGS0*/
Xfatal(va_alist)
Xva_dcl
X{
X va_list args;
X extern FILE *e_fp;
X extern char *e_tmpname;
X
X#ifndef lint
X va_start(args);
X#else
X args = 0;
X#endif
X mess(args);
X va_end(args);
X if (in_eval) {
X str_set(stab_val(stabent("@",TRUE)),buf);
X longjmp(eval_env,1);
X }
X fputs(buf,stderr);
X (void)fflush(stderr);
X if (e_fp)
X (void)UNLINK(e_tmpname);
X statusvalue >>= 8;
X exit((int)(errno?errno:(statusvalue?statusvalue:255)));
X}
X
X/*VARARGS0*/
Xwarn(va_alist)
Xva_dcl
X{
X va_list args;
X
X#ifndef lint
X va_start(args);
X#else
X args = 0;
X#endif
X mess(args);
X va_end(args);
X
X fputs(buf,stderr);
X (void)fflush(stderr);
X}
X#endif
X
Xstatic bool firstsetenv = TRUE;
Xextern char **environ;
X
Xvoid
Xsetenv(nam,val)
Xchar *nam, *val;
X{
X register int i=envix(nam); /* where does it go? */
X
X if (!val) {
X while (environ[i]) {
X environ[i] = environ[i+1];
X i++;
X }
X return;
X }
X if (!environ[i]) { /* does not exist yet */
X if (firstsetenv) { /* need we copy environment? */
X int j;
X char **tmpenv;
X
X New(901,tmpenv, i+2, char*);
X firstsetenv = FALSE;
X for (j=0; j<i; j++) /* copy environment */
X tmpenv[j] = environ[j];
X environ = tmpenv; /* tell exec where it is now */
X }
X else
X Renew(environ, i+2, char*); /* just expand it a bit */
X environ[i+1] = Nullch; /* make sure it's null terminated */
X }
X New(904, environ[i], strlen(nam) + strlen(val) + 2, char);
X /* this may or may not be in */
X /* the old environ structure */
X (void)sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
X}
X
Xint
Xenvix(nam)
Xchar *nam;
X{
X register int i, len = strlen(nam);
X
X for (i = 0; environ[i]; i++) {
X if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
X break; /* strnEQ must come first to avoid */
X } /* potential SEGV's */
X return i;
X}
X
X#ifdef EUNICE
Xunlnk(f) /* unlink all versions of a file */
Xchar *f;
X{
X int i;
X
X for (i = 0; unlink(f) >= 0; i++) ;
X return i ? 0 : -1;
X}
X#endif
X
X#ifndef BCOPY
X#ifndef MEMCPY
Xchar *
Xbcopy(from,to,len)
Xregister char *from;
Xregister char *to;
Xregister int len;
X{
X char *retval = to;
X
X while (len--)
X *to++ = *from++;
X return retval;
X}
X
Xchar *
Xbzero(loc,len)
Xregister char *loc;
Xregister int len;
X{
X char *retval = loc;
X
X while (len--)
X *loc++ = 0;
X return retval;
X}
X#endif
X#endif
X
X#ifdef VARARGS
X#ifndef VPRINTF
X
X#ifdef CHARSPRINTF
Xchar *
X#else
Xint
X#endif
Xvsprintf(dest, pat, args)
Xchar *dest, *pat, *args;
X{
X FILE fakebuf;
X
X fakebuf._ptr = dest;
X fakebuf._cnt = 32767;
X fakebuf._flag = _IOWRT|_IOSTRG;
X _doprnt(pat, args, &fakebuf); /* what a kludge */
X (void)putc('\0', &fakebuf);
X return(dest);
X}
X
X#ifdef DEBUGGING
Xint
Xvfprintf(fd, pat, args)
XFILE *fd;
Xchar *pat, *args;
X{
X _doprnt(pat, args, fd);
X return 0; /* wrong, but perl doesn't use the return value */
X}
X#endif
X#endif /* VPRINTF */
X#endif /* VARARGS */
X
X#ifdef MYSWAP
X#if BYTEORDER != 04321
Xshort
Xmy_swap(s)
Xshort s;
X{
X#if (BYTEORDER & 1) == 0
X short result;
X
X result = ((s & 255) << 8) + ((s >> 8) & 255);
X return result;
X#else
X return s;
X#endif
X}
X
Xlong
Xhtonl(l)
Xregister long l;
X{
X union {
X long result;
X char c[4];
X } u;
X
X#if BYTEORDER == 01234
X u.c[0] = (l >> 24) & 255;
X u.c[1] = (l >> 16) & 255;
X u.c[2] = (l >> 8) & 255;
X u.c[3] = l & 255;
X return u.result;
X#else
X#if ((BYTEORDER - 01111) & 0444) || !(BYTEORDER & 7)
X fatal("Unknown BYTEORDER\n");
X#else
X register int o;
X register int s;
X
X for (o = BYTEORDER - 01111, s = 0; s < 32; o >>= 3, s += 8) {
X u.c[o & 7] = (l >> s) & 255;
X }
X return u.result;
X#endif
X#endif
X}
X
Xlong
Xntohl(l)
Xregister long l;
X{
X union {
X long l;
X char c[4];
X } u;
X
X#if BYTEORDER == 01234
X u.c[0] = (l >> 24) & 255;
X u.c[1] = (l >> 16) & 255;
X u.c[2] = (l >> 8) & 255;
X u.c[3] = l & 255;
X return u.l;
X#else
X#if ((BYTEORDER - 01111) & 0444) || !(BYTEORDER & 7)
X fatal("Unknown BYTEORDER\n");
X#else
X register int o;
X register int s;
X
X u.l = l;
X l = 0;
X for (o = BYTEORDER - 01111, s = 0; s < 32; o >>= 3, s += 8) {
X l |= (u.c[o & 7] & 255) << s;
X }
X return l;
X#endif
X#endif
X}
X
X#endif /* BYTEORDER != 04321 */
X#endif /* HTONS */
X
XFILE *
Xmypopen(cmd,mode)
Xchar *cmd;
Xchar *mode;
X{
X int p[2];
X register int this, that;
X register int pid;
X STR *str;
X int doexec = strNE(cmd,"-");
X
X if (pipe(p) < 0)
X return Nullfp;
X this = (*mode == 'w');
X while ((pid = (doexec?vfork():fork())) < 0) {
X if (errno != EAGAIN) {
X close(p[this]);
X if (!doexec)
X fatal("Can't fork");
X return Nullfp;
X }
X sleep(5);
X }
X if (pid == 0) {
X this = !this; /* swap this and that */
X that = !this;
X close(p[that]);
X if (p[this] != (*mode == 'r')) {
X dup2(p[this], *mode == 'r');
X close(p[this]);
X }
X if (doexec) {
X do_exec(cmd); /* may or may not use the shell */
X _exit(1);
X }
X if (tmpstab = stabent("$",allstabs))
X str_numset(STAB_STR(tmpstab),(double)getpid());
X return Nullfp;
X }
X that = !this;
X close(p[that]);
X str = afetch(pidstatary,p[this],TRUE);
X str_numset(str,(double)pid);
X str->str_cur = 0;
X forkprocess = pid;
X return fdopen(p[this], mode);
X}
X
Xint
Xmypclose(ptr)
XFILE *ptr;
X{
X register int result;
X#ifdef VOIDSIG
X void (*hstat)(), (*istat)(), (*qstat)();
X#else
X int (*hstat)(), (*istat)(), (*qstat)();
X#endif
X int status;
X STR *str;
X register int pid;
X
X str = afetch(pidstatary,fileno(ptr),TRUE);
X fclose(ptr);
X pid = (int)str_gnum(str);
X if (!pid)
X return -1;
X hstat = signal(SIGHUP, SIG_IGN);
X istat = signal(SIGINT, SIG_IGN);
X qstat = signal(SIGQUIT, SIG_IGN);
X#ifdef WAIT4
X if (wait4(pid,&status,0,Null(struct rusage *)) < 0)
X status = -1;
X#else
X if (pid < 0) /* already exited? */
X status = str->str_cur;
X else {
X while ((result = wait(&status)) != pid && result >= 0)
X pidgone(result,status);
X if (result < 0)
X status = -1;
X }
X#endif
X signal(SIGHUP, hstat);
X signal(SIGINT, istat);
X signal(SIGQUIT, qstat);
X str_numset(str,0.0);
X return(status);
X}
X
Xpidgone(pid,status)
Xint pid;
Xint status;
X{
X#ifdef WAIT4
X return;
X#else
X register int count;
X register STR *str;
X
X for (count = pidstatary->ary_fill; count >= 0; --count) {
X if ((str = afetch(pidstatary,count,FALSE)) &&
X ((int)str->str_u.str_nval) == pid) {
X str_numset(str, -str->str_u.str_nval);
X str->str_cur = status;
X return;
X }
X }
X#endif
X}
!STUFFY!FUNK!
echo Extracting eg/scan/scan_passwd
sed >eg/scan/scan_passwd <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: scan_passwd,v 2.0 88/06/05 00:17:49 root Exp $
X
X# This scans passwd file for security holes.
X
Xopen(Pass,'/etc/passwd') || die "Can't open passwd file: $!\n";
X# $dotriv = (`date` =~ /^Mon/);
X$dotriv = 1;
X
Xwhile (<Pass>) {
X ($login,$pass,$uid,$gid,$gcos,$home,$shell) = split(/:/);
X if ($shell eq '') {
X print "Short: $_";
X }
X next if /^[+]/;
X if ($pass eq '') {
X if (index(":sync:lpq:+:", ":$login:") < 0) {
X print "No pass: $login\t$gcos\n";
X }
X }
X elsif ($dotriv && crypt($login,substr($pass,0,2)) eq $pass) {
X print "Trivial: $login\t$gcos\n";
X }
X if ($uid == 0) {
X if ($login !~ /^.?root$/ && $pass ne '*') {
X print "Extra root: $_";
X }
X }
X}
!STUFFY!FUNK!
echo ""
echo "End of kit 15 (of 23)"
cat /dev/null >kit15isdone
run=''
config=''
for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23; do
if test -f kit${iskit}isdone; then
run="$run $iskit"
else
todo="$todo $iskit"
fi
done
case $todo in
'')
echo "You have run all your kits. Please read README and then type Configure."
chmod 755 Configure
;;
*) echo "You have run$run."
echo "You still need to run$todo."
;;
esac
: Someone might mail this, so...
exit
More information about the Alt.sources
mailing list