Usenet 1994 January

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume13 / perl / part08 < prev next >

Wrap

Internet Message Format | 1988-01-30 | 49.1 KB

Subject: v13i008: Perl, a "replacement" for awk and sed, Part08/10 Newsgroups: comp.sources.unix Sender: sources Approved: rsalz@uunet.UU.NET Submitted-by: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov> Posting-number: Volume 13, Issue 8 Archive-name: perl/part08 #! /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 8 (of 10). If kit 8 is complete, the line" echo '"'"End of kit 8 (of 10)"'" will echo at the end.' echo "" export PATH || (echo "You didn't use sh, you clunch." ; kill $$) mkdir x2p 2>/dev/null echo Extracting x2p/a2p.man sed >x2p/a2p.man <<'!STUFFY!FUNK!' -e 's/X//' X.rn '' }` X''' $Header: a2p.man,v 1.0 87/12/18 17:23:56 root Exp $ X''' X''' $Log: a2p.man,v $ X''' Revision 1.0 87/12/18 17:23:56 root X''' Initial revision X''' X''' X.de Sh X.br X.ne 5 X.PP X\fB\\$1\fR X.PP X.. X.de Sp X.if t .sp .5v X.if n .sp X.. X.de Ip X.br X.ie \\n.$>=3 .ne \\$3 X.el .ne 3 X.IP "\\$1" \\$2 X.. X''' X''' Set up \*(-- to give an unbreakable dash; X''' string Tr holds user defined translation string. X''' Bell System Logo is used as a dummy character. X''' X.tr \(bs-|\(bv\*(Tr X.ie n \{\ X.ds -- \(bs- X.if (\n(.H=4u)&(1m=24u) .ds -- \(bs\h'-12u'\(bs\h'-12u'-\" diablo 10 pitch X.if (\n(.H=4u)&(1m=20u) .ds -- \(bs\h'-12u'\(bs\h'-8u'-\" diablo 12 pitch X.ds L" "" X.ds R" "" X.ds L' ' X.ds R' ' X'br\} X.el\{\ X.ds -- \(em\| X.tr \*(Tr X.ds L" `` X.ds R" '' X.ds L' ` X.ds R' ' X'br\} X.TH A2P 1 LOCAL X.SH NAME Xa2p - Awk to Perl translator X.SH SYNOPSIS X.B a2p [options] filename X.SH DESCRIPTION X.I A2p Xtakes an awk script specified on the command line (or from standard input) Xand produces a comparable X.I perl Xscript on the standard output. X.Sh "Options" XOptions include: X.TP 5 X.B \-D<number> Xsets debugging flags. X.TP 5 X.B \-F<character> Xtells a2p that this awk script is always invoked with this -F switch. X.TP 5 X.B \-n<fieldlist> Xspecifies the names of the input fields if input does not have to be split into Xan array. XIf you were translating an awk script that processes the password file, you Xmight say: X.sp X a2p -7 -nlogin.password.uid.gid.gcos.shell.home X.sp XAny delimiter will do to separate the field names. X.TP 5 X.B \-<number> Xcauses a2p to assume that input will always have that many fields. X.Sh "Considerations" XA2p cannot do as good a job translating as a human would, but it usually Xdoes pretty well. XThere are some areas where you may want to examine the perl script produced Xand tweak it some. XHere are some of them, in no particular order. X.PP XThe split operator in perl always strips off all null fields from the end. XAwk does NOT do this, if you've set FS. XIf the perl script splits to an array, the field count may not reflect Xwhat you expect. XOrdinarily this isn't a problem, since nonexistent array elements have a null Xvalue, but if you rely on NF in awk, you could be in for trouble. XEither force the number of fields with \-<number>, or count the number of Xdelimiters another way, e.g. with y/:/:/. XOr add something non-null to the end before you split, and then pop it off Xthe resulting array. X.PP XThere is an awk idiom of putting int() around a string expression to force Xnumeric interpretation, even though the argument is always integer anyway. XThis is generally unneeded in perl, but a2p can't tell if the argument Xis always going to be integer, so it leaves it in. XYou may wish to remove it. X.PP XPerl differentiates numeric comparison from string comparison. XAwk has one operator for both that decides at run time which comparison Xto do. XA2p does not try to do a complete job of awk emulation at this point. XInstead it guesses which one you want. XIt's almost always right, but it can be spoofed. XAll such guesses are marked with the comment \*(L"#???\*(R". XYou should go through and check them. X.PP XPerl does not attempt to emulate the behavior of awk in which nonexistent Xarray elements spring into existence simply by being referenced. XIf somehow you are relying on this mechanism to create null entries for Xa subsequent for...in, they won't be there in perl. X.PP XIf a2p makes a split line that assigns to a list of variables that looks Xlike (Fld1, Fld2, Fld3...) you may want Xto rerun a2p using the \-n option mentioned above. XThis will let you name the fields throughout the script. XIf it splits to an array instead, the script is probably referring to the number Xof fields somewhere. X.PP XThe exit statement in awk doesn't necessarily exit; it goes to the END Xblock if there is one. XAwk scripts that do contortions within the END block to bypass the block under Xsuch circumstances can be simplified by removing the conditional Xin the END block and just exiting directly from the perl script. X.PP XPerl has two kinds of array, numerically-indexed and associative. XAwk arrays are usually translated to associative arrays, but if you happen Xto know that the index is always going to be numeric you could change Xthe {...} to [...]. XIteration over an associative array is done with each(), but Xiteration over a numeric array is NOT. XYou need a for loop, or while loop with a pop() or shift(), so you might Xneed to modify any loop that is iterating over the array in question. X.PP XArrays which have been split into are assumed to be numerically indexed. XThe usual perl idiom for iterating over such arrays is to use pop() or shift() Xand assign the resulting value to a variable inside the conditional of the Xwhile loop. XThis is destructive to the array, however, so a2p can't assume this is Xreasonable. XA2p will write a standard for loop with a scratch variable. XYou may wish to change it to a pop() loop for more efficiency, presuming Xyou don't want to keep the array around. X.PP XAwk starts by assuming OFMT has the value %.6g. XPerl starts by assuming its equivalent, $#, to have the value %.20g. XYou'll want to set $# explicitly if you use the default value of OFMT. X.PP XNear the top of the line loop will be the split operation that is implicit in Xthe awk script. XThere are times when you can move this down past some conditionals that Xtest the entire record so that the split is not done as often. X.PP XThere may occasionally be extra parentheses that you can remove. X.PP XFor aesthetic reasons you may wish to change the array base $[ from 1 back Xto the default of 0, but remember to change all array subscripts AND Xall substr() and index() operations to match. X.PP XCute comments that say "# Here is a workaround because awk is dumb" are not Xtranslated. X.PP XAwk scripts are often embedded in a shell script that pipes stuff into and Xout of awk. XOften the shell script wrapper can be incorporated into the perl script, since Xperl can start up pipes into and out of itself, and can do other things that Xawk can't do by itself. X.SH ENVIRONMENT XA2p uses no environment variables. X.SH AUTHOR XLarry Wall <lwall@devvax.Jpl.Nasa.Gov> X.SH FILES X.SH SEE ALSO Xperl The perl compiler/interpreter X.br Xs2p sed to perl translator X.SH DIAGNOSTICS X.SH BUGS XIt would be possible to emulate awk's behavior in selecting string versus Xnumeric operations at run time by inspection of the operands, but it would Xbe gross and inefficient. XBesides, a2p almost always guesses right. X.PP XStorage for the awk syntax tree is currently static, and can run out. X.rn }` '' !STUFFY!FUNK! echo Extracting x2p/a2p.y sed >x2p/a2p.y <<'!STUFFY!FUNK!' -e 's/X//' X%{ X/* $Header: a2p.y,v 1.0 87/12/18 13:07:05 root Exp $ X * X * $Log: a2p.y,v $ X * Revision 1.0 87/12/18 13:07:05 root X * Initial revision X * X */ X X#include "INTERN.h" X#include "a2p.h" X Xint root; X X%} X%token BEGIN END X%token REGEX X%token SEMINEW NEWLINE COMMENT X%token FUN1 GRGR X%token PRINT PRINTF SPRINTF SPLIT X%token IF ELSE WHILE FOR IN X%token EXIT NEXT BREAK CONTINUE X X%right ASGNOP X%left OROR X%left ANDAND X%left NOT X%left NUMBER VAR SUBSTR INDEX X%left GETLINE X%nonassoc RELOP MATCHOP X%left OR X%left STRING X%left '+' '-' X%left '*' '/' '%' X%right UMINUS X%left INCR DECR X%left FIELD VFIELD X X%% X Xprogram : junk begin hunks end X { root = oper4(OPROG,$1,$2,$3,$4); } X ; X Xbegin : BEGIN '{' states '}' junk X { $$ = oper2(OJUNK,$3,$5); in_begin = FALSE; } X | /* NULL */ X { $$ = Nullop; } X ; X Xend : END '{' states '}' X { $$ = $3; } X | end NEWLINE X { $$ = $1; } X | /* NULL */ X { $$ = Nullop; } X ; X Xhunks : hunks hunk junk X { $$ = oper3(OHUNKS,$1,$2,$3); } X | /* NULL */ X { $$ = Nullop; } X ; X Xhunk : patpat X { $$ = oper1(OHUNK,$1); need_entire = TRUE; } X | patpat '{' states '}' X { $$ = oper2(OHUNK,$1,$3); } X | '{' states '}' X { $$ = oper2(OHUNK,Nullop,$2); } X ; X Xpatpat : pat X { $$ = oper1(OPAT,$1); } X | pat ',' pat X { $$ = oper2(ORANGE,$1,$3); } X ; X Xpat : REGEX X { $$ = oper1(OREGEX,$1); } X | match X | rel X | compound_pat X ; X Xcompound_pat X : '(' compound_pat ')' X { $$ = oper1(OPPAREN,$2); } X | pat ANDAND pat X { $$ = oper2(OPANDAND,$1,$3); } X | pat OROR pat X { $$ = oper2(OPOROR,$1,$3); } X | NOT pat X { $$ = oper1(OPNOT,$2); } X ; X Xcond : expr X | match X | rel X | compound_cond X ; X Xcompound_cond X : '(' compound_cond ')' X { $$ = oper1(OCPAREN,$2); } X | cond ANDAND cond X { $$ = oper2(OCANDAND,$1,$3); } X | cond OROR cond X { $$ = oper2(OCOROR,$1,$3); } X | NOT cond X { $$ = oper1(OCNOT,$2); } X ; X Xrel : expr RELOP expr X { $$ = oper3(ORELOP,$2,$1,$3); } X | '(' rel ')' X { $$ = oper1(ORPAREN,$2); } X ; X Xmatch : expr MATCHOP REGEX X { $$ = oper3(OMATCHOP,$2,$1,$3); } X | '(' match ')' X { $$ = oper1(OMPAREN,$2); } X ; X Xexpr : term X { $$ = $1; } X | expr term X { $$ = oper2(OCONCAT,$1,$2); } X | variable ASGNOP expr X { $$ = oper3(OASSIGN,$2,$1,$3); X if ((ops[$1].ival & 255) == OFLD) X lval_field = TRUE; X if ((ops[$1].ival & 255) == OVFLD) X lval_field = TRUE; X } X ; X Xterm : variable X { $$ = $1; } X | term '+' term X { $$ = oper2(OADD,$1,$3); } X | term '-' term X { $$ = oper2(OSUB,$1,$3); } X | term '*' term X { $$ = oper2(OMULT,$1,$3); } X | term '/' term X { $$ = oper2(ODIV,$1,$3); } X | term '%' term X { $$ = oper2(OMOD,$1,$3); } X | variable INCR X { $$ = oper1(OPOSTINCR,$1); } X | variable DECR X { $$ = oper1(OPOSTDECR,$1); } X | INCR variable X { $$ = oper1(OPREINCR,$2); } X | DECR variable X { $$ = oper1(OPREDECR,$2); } X | '-' term %prec UMINUS X { $$ = oper1(OUMINUS,$2); } X | '+' term %prec UMINUS X { $$ = oper1(OUPLUS,$2); } X | '(' expr ')' X { $$ = oper1(OPAREN,$2); } X | GETLINE X { $$ = oper0(OGETLINE); } X | FUN1 X { $$ = oper0($1); need_entire = do_chop = TRUE; } X | FUN1 '(' ')' X { $$ = oper1($1,Nullop); need_entire = do_chop = TRUE; } X | FUN1 '(' expr ')' X { $$ = oper1($1,$3); } X | SPRINTF print_list X { $$ = oper1(OSPRINTF,$2); } X | SUBSTR '(' expr ',' expr ',' expr ')' X { $$ = oper3(OSUBSTR,$3,$5,$7); } X | SUBSTR '(' expr ',' expr ')' X { $$ = oper2(OSUBSTR,$3,$5); } X | SPLIT '(' expr ',' VAR ',' expr ')' X { $$ = oper3(OSPLIT,$3,numary($5),$7); } X | SPLIT '(' expr ',' VAR ')' X { $$ = oper2(OSPLIT,$3,numary($5)); } X | INDEX '(' expr ',' expr ')' X { $$ = oper2(OINDEX,$3,$5); } X ; X Xvariable: NUMBER X { $$ = oper1(ONUM,$1); } X | STRING X { $$ = oper1(OSTR,$1); } X | VAR X { $$ = oper1(OVAR,$1); } X | VAR '[' expr ']' X { $$ = oper2(OVAR,$1,$3); } X | FIELD X { $$ = oper1(OFLD,$1); } X | VFIELD term X { $$ = oper1(OVFLD,$2); } X ; X Xmaybe : NEWLINE X { $$ = oper0(ONEWLINE); } X | /* NULL */ X { $$ = Nullop; } X | COMMENT X { $$ = oper1(OCOMMENT,$1); } X ; X Xprint_list X : expr X | clist X | /* NULL */ X { $$ = Nullop; } X ; X Xclist : expr ',' expr X { $$ = oper2(OCOMMA,$1,$3); } X | clist ',' expr X { $$ = oper2(OCOMMA,$1,$3); } X | '(' clist ')' /* these parens are invisible */ X { $$ = $2; } X ; X Xjunk : junk hunksep X { $$ = oper2(OJUNK,$1,$2); } X | /* NULL */ X { $$ = Nullop; } X ; X Xhunksep : ';' X { $$ = oper0(OSEMICOLON); } X | SEMINEW X { $$ = oper0(OSEMICOLON); } X | NEWLINE X { $$ = oper0(ONEWLINE); } X | COMMENT X { $$ = oper1(OCOMMENT,$1); } X ; X Xseparator X : ';' X { $$ = oper0(OSEMICOLON); } X | SEMINEW X { $$ = oper0(OSNEWLINE); } X | NEWLINE X { $$ = oper0(OSNEWLINE); } X | COMMENT X { $$ = oper1(OSCOMMENT,$1); } X ; X Xstates : states statement X { $$ = oper2(OSTATES,$1,$2); } X | /* NULL */ X { $$ = Nullop; } X ; X Xstatement X : simple separator X { $$ = oper2(OSTATE,$1,$2); } X | compound X ; X Xsimple X : expr X | PRINT print_list redir expr X { $$ = oper3(OPRINT,$2,$3,$4); X do_opens = TRUE; X saw_ORS = saw_OFS = TRUE; X if (!$2) need_entire = TRUE; X if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } X | PRINT print_list X { $$ = oper1(OPRINT,$2); X if (!$2) need_entire = TRUE; X saw_ORS = saw_OFS = TRUE; X } X | PRINTF print_list redir expr X { $$ = oper3(OPRINTF,$2,$3,$4); X do_opens = TRUE; X if (!$2) need_entire = TRUE; X if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } X | PRINTF print_list X { $$ = oper1(OPRINTF,$2); X if (!$2) need_entire = TRUE; X } X | BREAK X { $$ = oper0(OBREAK); } X | NEXT X { $$ = oper0(ONEXT); } X | EXIT X { $$ = oper0(OEXIT); } X | EXIT expr X { $$ = oper1(OEXIT,$2); } X | CONTINUE X { $$ = oper0(OCONTINUE); } X | /* NULL */ X { $$ = Nullop; } X ; X Xredir : RELOP X { $$ = oper1(OREDIR,string(">",1)); } X | GRGR X { $$ = oper1(OREDIR,string(">>",2)); } X | '|' X { $$ = oper1(OREDIR,string("|",1)); } X ; X Xcompound X : IF '(' cond ')' maybe statement X { $$ = oper2(OIF,$3,bl($6,$5)); } X | IF '(' cond ')' maybe statement ELSE maybe statement X { $$ = oper3(OIF,$3,bl($6,$5),bl($9,$8)); } X | WHILE '(' cond ')' maybe statement X { $$ = oper2(OWHILE,$3,bl($6,$5)); } X | FOR '(' simple ';' cond ';' simple ')' maybe statement X { $$ = oper4(OFOR,$3,$5,$7,bl($10,$9)); } X | FOR '(' simple ';' ';' simple ')' maybe statement X { $$ = oper4(OFOR,$3,string("",0),$6,bl($9,$8)); } X | FOR '(' VAR IN VAR ')' maybe statement X { $$ = oper3(OFORIN,$3,$5,bl($8,$7)); } X | '{' states '}' X { $$ = oper1(OBLOCK,$2); } X ; X X%% X#include "a2py.c" !STUFFY!FUNK! echo Extracting stab.c sed >stab.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: stab.c,v 1.0 87/12/18 13:06:14 root Exp $ X * X * $Log: stab.c,v $ X * Revision 1.0 87/12/18 13:06:14 root X * Initial revision X * X */ X X#include <signal.h> X#include "handy.h" X#include "EXTERN.h" X#include "search.h" X#include "util.h" X#include "perl.h" X Xstatic char *sig_name[] = { X "", X "HUP", X "INT", X "QUIT", X "ILL", X "TRAP", X "IOT", X "EMT", X "FPE", X "KILL", X "BUS", X "SEGV", X "SYS", X "PIPE", X "ALRM", X "TERM", X "???" X#ifdef SIGTSTP X ,"STOP", X "TSTP", X "CONT", X "CHLD", X "TTIN", X "TTOU", X "TINT", X "XCPU", X "XFSZ" X#ifdef SIGPROF X ,"VTALARM", X "PROF" X#ifdef SIGWINCH X ,"WINCH" X#ifdef SIGLOST X ,"LOST" X#ifdef SIGUSR1 X ,"USR1" X#endif X#ifdef SIGUSR2 X ,"USR2" X#endif /* SIGUSR2 */ X#endif /* SIGLOST */ X#endif /* SIGWINCH */ X#endif /* SIGPROF */ X#endif /* SIGTSTP */ X ,0 X }; X XSTR * Xstab_str(stab) XSTAB *stab; X{ X register int paren; X register char *s; X extern int errno; X X switch (*stab->stab_name) { X case '0': case '1': case '2': case '3': case '4': X case '5': case '6': case '7': case '8': case '9': case '&': X if (curspat) { X paren = atoi(stab->stab_name); X if (curspat->spat_compex.subend[paren] && X (s = getparen(&curspat->spat_compex,paren))) { X curspat->spat_compex.subend[paren] = Nullch; X str_set(stab->stab_val,s); X } X } X break; X case '+': X if (curspat) { X paren = curspat->spat_compex.lastparen; X if (curspat->spat_compex.subend[paren] && X (s = getparen(&curspat->spat_compex,paren))) { X curspat->spat_compex.subend[paren] = Nullch; X str_set(stab->stab_val,s); X } X } X break; X case '.': X if (last_in_stab) { X str_numset(stab->stab_val,(double)last_in_stab->stab_io->lines); X } X break; X case '?': X str_numset(stab->stab_val,(double)statusvalue); X break; X case '^': X s = curoutstab->stab_io->top_name; X str_set(stab->stab_val,s); X break; X case '~': X s = curoutstab->stab_io->fmt_name; X str_set(stab->stab_val,s); X break; X case '=': X str_numset(stab->stab_val,(double)curoutstab->stab_io->lines); X break; X case '-': X str_numset(stab->stab_val,(double)curoutstab->stab_io->lines_left); X break; X case '%': X str_numset(stab->stab_val,(double)curoutstab->stab_io->page); X break; X case '(': X if (curspat) { X str_numset(stab->stab_val,(double)(curspat->spat_compex.subbeg[0] - X curspat->spat_compex.subbase)); X } X break; X case ')': X if (curspat) { X str_numset(stab->stab_val,(double)(curspat->spat_compex.subend[0] - X curspat->spat_compex.subbeg[0])); X } X break; X case '/': X *tokenbuf = record_separator; X tokenbuf[1] = '\0'; X str_set(stab->stab_val,tokenbuf); X break; X case '[': X str_numset(stab->stab_val,(double)arybase); X break; X case '|': X str_numset(stab->stab_val, X (double)((curoutstab->stab_io->flags & IOF_FLUSH) != 0) ); X break; X case ',': X str_set(stab->stab_val,ofs); X break; X case '\\': X str_set(stab->stab_val,ors); X break; X case '#': X str_set(stab->stab_val,ofmt); X break; X case '!': X str_numset(stab->stab_val,(double)errno); X break; X } X return stab->stab_val; X} X Xstabset(stab,str) Xregister STAB *stab; XSTR *str; X{ X char *s; X int i; X int sighandler(); X X if (stab->stab_flags & SF_VMAGIC) { X switch (stab->stab_name[0]) { X case '^': X safefree(curoutstab->stab_io->top_name); X curoutstab->stab_io->top_name = str_get(str); X curoutstab->stab_io->top_stab = stabent(str_get(str),FALSE); X break; X case '~': X safefree(curoutstab->stab_io->fmt_name); X curoutstab->stab_io->fmt_name = str_get(str); X curoutstab->stab_io->fmt_stab = stabent(str_get(str),FALSE); X break; X case '=': X curoutstab->stab_io->page_len = (long)str_gnum(str); X break; X case '-': X curoutstab->stab_io->lines_left = (long)str_gnum(str); X break; X case '%': X curoutstab->stab_io->page = (long)str_gnum(str); X break; X case '|': X curoutstab->stab_io->flags &= ~IOF_FLUSH; X if (str_gnum(str) != 0.0) { X curoutstab->stab_io->flags |= IOF_FLUSH; X } X break; X case '*': X multiline = (int)str_gnum(str) != 0; X break; X case '/': X record_separator = *str_get(str); X break; X case '\\': X if (ors) X safefree(ors); X ors = savestr(str_get(str)); X break; X case ',': X if (ofs) X safefree(ofs); X ofs = savestr(str_get(str)); X break; X case '#': X if (ofmt) X safefree(ofmt); X ofmt = savestr(str_get(str)); X break; X case '[': X arybase = (int)str_gnum(str); X break; X case '!': X errno = (int)str_gnum(str); /* will anyone ever use this? */ X break; X case '.': X case '+': X case '&': X case '0': X case '1': X case '2': X case '3': X case '4': X case '5': X case '6': X case '7': X case '8': X case '9': X case '(': X case ')': X break; /* "read-only" registers */ X } X } X else if (stab == envstab && envname) { X setenv(envname,str_get(str)); X /* And you'll never guess what the dog had */ X safefree(envname); /* in its mouth... */ X envname = Nullch; X } X else if (stab == sigstab && signame) { X s = str_get(str); X i = whichsig(signame); /* ...no, a brick */ X if (strEQ(s,"IGNORE")) X signal(i,SIG_IGN); X else if (strEQ(s,"DEFAULT") || !*s) X signal(i,SIG_DFL); X else X signal(i,sighandler); X safefree(signame); X signame = Nullch; X } X} X Xwhichsig(signame) Xchar *signame; X{ X register char **sigv; X X for (sigv = sig_name+1; *sigv; sigv++) X if (strEQ(signame,*sigv)) X return sigv - sig_name; X return 0; X} X Xsighandler(sig) Xint sig; X{ X STAB *stab; X ARRAY *savearray; X STR *str; X X stab = stabent(str_get(hfetch(sigstab->stab_hash,sig_name[sig])),FALSE); X savearray = defstab->stab_array; X defstab->stab_array = anew(); X str = str_new(0); X str_set(str,sig_name[sig]); X apush(defstab->stab_array,str); X str = cmd_exec(stab->stab_sub); X afree(defstab->stab_array); /* put back old $_[] */ X defstab->stab_array = savearray; X} X Xchar * Xreg_get(name) Xchar *name; X{ X return STAB_GET(stabent(name,TRUE)); X} X X#ifdef NOTUSED Xreg_set(name,value) Xchar *name; Xchar *value; X{ X str_set(STAB_STR(stabent(name,TRUE)),value); X} X#endif X XSTAB * Xaadd(stab) Xregister STAB *stab; X{ X if (!stab->stab_array) X stab->stab_array = anew(); X return stab; X} X XSTAB * Xhadd(stab) Xregister STAB *stab; X{ X if (!stab->stab_hash) X stab->stab_hash = hnew(); X return stab; X} !STUFFY!FUNK! echo Extracting MANIFEST sed >MANIFEST <<'!STUFFY!FUNK!' -e 's/X//' XAfter all the perl kits are run you should have the following files: X XFilename Kit Description X-------- --- ----------- XConfigure 6 Run this first XEXTERN.h 10 Included before foreign .h files XINTERN.h 10 Included before domestic .h files XMANIFEST 8 This list of files XMakefile.SH 4 Precursor to Makefile XREADME 1 The Instructions XWishlist 10 Some things that may or may not happen Xarg.c 3 Expression evaluation Xarg.h 8 Public declarations for the above Xarray.c 6 Numerically subscripted arrays Xarray.h 10 Public declarations for the above Xcmd.c 7 Command interpreter Xcmd.h 9 Public declarations for the above Xconfig.H 9 Sample config.h Xconfig.h.SH 9 Produces config.h. Xdump.c 8 Debugging output Xform.c 8 Format processing Xform.h 10 Public declarations for the above Xhandy.h 10 Handy definitions Xhash.c 9 Associative arrays Xhash.h 10 Public declarations for the above Xmakedepend.SH 9 Precursor to makedepend Xmakedir.SH 10 Precursor to makedir Xmalloc.c 7 A version of malloc you might not want Xpatchlevel.h 1 The current patch level of perl Xperl.h 9 Global declarations Xperl.man.1 5 The manual page(s), first half Xperl.man.2 4 The manual page(s), second half Xperl.y 5 Yacc grammar for perl Xperly.c 2 The perl compiler Xsearch.c 6 String matching Xsearch.h 10 Public declarations for the above Xspat.h 10 Search pattern declarations Xstab.c 8 Symbol table stuff Xstab.h 10 Public declarations for the above Xstr.c 4 String handling package Xstr.h 10 Public declarations for the above Xt/README 10 Instructions for regression tests Xt/TEST 10 The regression tester Xt/base.cond 10 See if conditionals work Xt/base.if 10 See if if works Xt/base.lex 10 See if lexical items work Xt/base.pat 10 See if pattern matching works Xt/base.term 10 See if various terms work Xt/cmd.elsif 10 See if else-if works Xt/cmd.for 10 See if for loops work Xt/cmd.mod 10 See if statement modifiers work Xt/cmd.subval 10 See if subroutine values work Xt/cmd.while 7 See if while loops work Xt/comp.cmdopt 9 See if command optimization works Xt/comp.cpp 10 See if C preprocessor works Xt/comp.decl 10 See if declarations work Xt/comp.multiline 10 See if multiline strings work Xt/comp.script 10 See if script invokation works Xt/comp.term 10 See if more terms work Xt/io.argv 10 See if ARGV stuff works Xt/io.fs 5 See if directory manipulations work Xt/io.inplace 10 See if inplace editing works Xt/io.print 10 See if print commands work Xt/io.tell 10 See if file seeking works Xt/op.append 10 See if . works Xt/op.auto 9 See if autoincrement et all work Xt/op.chop 10 See if chop works Xt/op.cond 10 See if conditional expressions work Xt/op.crypt 10 See if crypt works Xt/op.do 10 See if subroutines work Xt/op.each 10 See if associative iterators work Xt/op.exec 10 See if exec and system work Xt/op.exp 10 See if math functions work Xt/op.flip 10 See if range operator works Xt/op.fork 10 See if fork works Xt/op.goto 10 See if goto works Xt/op.int 10 See if int works Xt/op.join 10 See if join works Xt/op.list 10 See if array lists work Xt/op.magic 10 See if magic variables work Xt/op.oct 10 See if oct and hex work Xt/op.ord 10 See if ord works Xt/op.pat 9 See if esoteric patterns work Xt/op.push 7 See if push and pop work Xt/op.repeat 10 See if x operator works Xt/op.sleep 6 See if sleep works Xt/op.split 10 See if split works Xt/op.sprintf 10 See if sprintf work Xt/op.stat 10 See if stat work Xt/op.subst 10 See if substitutions work Xt/op.time 10 See if time functions work Xt/op.unshift 10 See if unshift works Xutil.c 9 Utility routines Xutil.h 10 Public declarations for the above Xversion.c 10 Prints version of perl Xx2p/EXTERN.h 10 Same as above Xx2p/INTERN.h 10 Same as above Xx2p/Makefile.SH 9 Precursor to Makefile Xx2p/a2p.h 8 Global declarations Xx2p/a2p.man 8 Manual page for awk to perl translator Xx2p/a2p.y 8 A yacc grammer for awk Xx2p/a2py.c 7 Awk compiler, sort of Xx2p/handy.h 10 Handy definitions Xx2p/hash.c 9 Associative arrays again Xx2p/hash.h 10 Public declarations for the above Xx2p/s2p 1 Sed to perl translator Xx2p/s2p.man 10 Manual page for sed to perl translator Xx2p/str.c 7 String handling package Xx2p/str.h 10 Public declarations for the above Xx2p/util.c 9 Utility routines Xx2p/util.h 10 Public declarations for the above Xx2p/walk.c 1 Parse tree walker !STUFFY!FUNK! echo Extracting form.c sed >form.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: form.c,v 1.0 87/12/18 13:05:07 root Exp $ X * X * $Log: form.c,v $ X * Revision 1.0 87/12/18 13:05:07 root X * Initial revision X * X */ X X#include "handy.h" X#include "EXTERN.h" X#include "search.h" X#include "util.h" X#include "perl.h" X X/* Forms stuff */ X X#define CHKLEN(allow) \ Xif (d - orec->o_str + (allow) >= curlen) { \ X curlen = d - orec->o_str; \ X GROWSTR(&orec->o_str,&orec->o_len,orec->o_len + (allow)); \ X d = orec->o_str + curlen; /* in case it moves */ \ X curlen = orec->o_len - 2; \ X} X Xformat(orec,fcmd) Xregister struct outrec *orec; Xregister FCMD *fcmd; X{ X register char *d = orec->o_str; X register char *s; X register int curlen = orec->o_len - 2; X register int size; X char tmpchar; X char *t; X CMD mycmd; X STR *str; X char *chophere; X X mycmd.c_type = C_NULL; X orec->o_lines = 0; X for (; fcmd; fcmd = fcmd->f_next) { X CHKLEN(fcmd->f_presize); X for (s=fcmd->f_pre; *s;) { X if (*s == '\n') { X while (d > orec->o_str && (d[-1] == ' ' || d[-1] == '\t')) X d--; X if (fcmd->f_flags & FC_NOBLANK && X (d == orec->o_str || d[-1] == '\n') ) { X orec->o_lines--; /* don't print blank line */ X break; X } X } X *d++ = *s++; X } X switch (fcmd->f_type) { X case F_NULL: X orec->o_lines++; X break; X case F_LEFT: X str = eval(fcmd->f_expr,Null(char***),(double*)0); X s = str_get(str); X size = fcmd->f_size; X CHKLEN(size); X chophere = Nullch; X while (size && *s && *s != '\n') { X size--; X if ((*d++ = *s++) == ' ') X chophere = s; X } X if (size) X chophere = s; X if (fcmd->f_flags & FC_CHOP) { X if (!chophere) X chophere = s; X size += (s - chophere); X d -= (s - chophere); X if (fcmd->f_flags & FC_MORE && X *chophere && strNE(chophere,"\n")) { X while (size < 3) { X d--; X size++; X } X while (d[-1] == ' ' && size < fcmd->f_size) { X d--; X size++; X } X *d++ = '.'; X *d++ = '.'; X *d++ = '.'; X } X s = chophere; X while (*chophere == ' ' || *chophere == '\n') X chophere++; X str_chop(str,chophere); X } X if (fcmd->f_next && fcmd->f_next->f_pre[0] == '\n') X size = 0; /* no spaces before newline */ X while (size) { X size--; X *d++ = ' '; X } X break; X case F_RIGHT: X t = s = str_get(eval(fcmd->f_expr,Null(char***),(double*)0)); X size = fcmd->f_size; X CHKLEN(size); X chophere = Nullch; X while (size && *s && *s != '\n') { X size--; X if (*s++ == ' ') X chophere = s; X } X if (size) X chophere = s; X if (fcmd->f_flags & FC_CHOP) { X if (!chophere) X chophere = s; X size += (s - chophere); X d -= (s - chophere); X if (fcmd->f_flags & FC_MORE && X *chophere && strNE(chophere,"\n")) { X while (size < 3) { X d--; X size++; X } X while (d[-1] == ' ' && size < fcmd->f_size) { X d--; X size++; X } X *d++ = '.'; X *d++ = '.'; X *d++ = '.'; X } X s = chophere; X while (*chophere == ' ' || *chophere == '\n') X chophere++; X str_chop(str,chophere); X } X tmpchar = *s; X *s = '\0'; X while (size) { X size--; X *d++ = ' '; X } X size = s - t; X bcopy(t,d,size); X d += size; X *s = tmpchar; X break; X case F_CENTER: { X int halfsize; X X t = s = str_get(eval(fcmd->f_expr,Null(char***),(double*)0)); X size = fcmd->f_size; X CHKLEN(size); X chophere = Nullch; X while (size && *s && *s != '\n') { X size--; X if (*s++ == ' ') X chophere = s; X } X if (size) X chophere = s; X if (fcmd->f_flags & FC_CHOP) { X if (!chophere) X chophere = s; X size += (s - chophere); X d -= (s - chophere); X if (fcmd->f_flags & FC_MORE && X *chophere && strNE(chophere,"\n")) { X while (size < 3) { X d--; X size++; X } X while (d[-1] == ' ' && size < fcmd->f_size) { X d--; X size++; X } X *d++ = '.'; X *d++ = '.'; X *d++ = '.'; X } X s = chophere; X while (*chophere == ' ' || *chophere == '\n') X chophere++; X str_chop(str,chophere); X } X tmpchar = *s; X *s = '\0'; X halfsize = size / 2; X while (size > halfsize) { X size--; X *d++ = ' '; X } X size = s - t; X bcopy(t,d,size); X d += size; X *s = tmpchar; X if (fcmd->f_next && fcmd->f_next->f_pre[0] == '\n') X size = 0; /* no spaces before newline */ X else X size = halfsize; X while (size) { X size--; X *d++ = ' '; X } X break; X } X case F_LINES: X str = eval(fcmd->f_expr,Null(char***),(double*)0); X s = str_get(str); X size = str_len(str); X CHKLEN(size); X orec->o_lines += countlines(s); X bcopy(s,d,size); X d += size; X break; X } X } X *d++ = '\0'; X} X Xcountlines(s) Xregister char *s; X{ X register int count = 0; X X while (*s) { X if (*s++ == '\n') X count++; X } X return count; X} X Xdo_write(orec,stio) Xstruct outrec *orec; Xregister STIO *stio; X{ X FILE *ofp = stio->fp; X X#ifdef DEBUGGING X if (debug & 256) X fprintf(stderr,"left=%d, todo=%d\n",stio->lines_left, orec->o_lines); X#endif X if (stio->lines_left < orec->o_lines) { X if (!stio->top_stab) { X STAB *topstab; X X if (!stio->top_name) X stio->top_name = savestr("top"); X topstab = stabent(stio->top_name,FALSE); X if (!topstab || !topstab->stab_form) { X stio->lines_left = 100000000; X goto forget_top; X } X stio->top_stab = topstab; X } X if (stio->lines_left >= 0) X putc('\f',ofp); X stio->lines_left = stio->page_len; X stio->page++; X format(&toprec,stio->top_stab->stab_form); X fputs(toprec.o_str,ofp); X stio->lines_left -= toprec.o_lines; X } X forget_top: X fputs(orec->o_str,ofp); X stio->lines_left -= orec->o_lines; X} !STUFFY!FUNK! echo Extracting dump.c sed >dump.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: dump.c,v 1.0 87/12/18 13:05:03 root Exp $ X * X * $Log: dump.c,v $ X * Revision 1.0 87/12/18 13:05:03 root X * Initial revision X * X */ X X#include "handy.h" X#include "EXTERN.h" X#include "search.h" X#include "util.h" X#include "perl.h" X X#ifdef DEBUGGING Xstatic int dumplvl = 0; X Xdump_cmd(cmd,alt) Xregister CMD *cmd; Xregister CMD *alt; X{ X fprintf(stderr,"{\n"); X while (cmd) { X dumplvl++; X dump("C_TYPE = %s\n",cmdname[cmd->c_type]); X if (cmd->c_label) X dump("C_LABEL = \"%s\"\n",cmd->c_label); X dump("C_OPT = CFT_%s\n",cmdopt[cmd->c_flags & CF_OPTIMIZE]); X *buf = '\0'; X if (cmd->c_flags & CF_FIRSTNEG) X strcat(buf,"FIRSTNEG,"); X if (cmd->c_flags & CF_NESURE) X strcat(buf,"NESURE,"); X if (cmd->c_flags & CF_EQSURE) X strcat(buf,"EQSURE,"); X if (cmd->c_flags & CF_COND) X strcat(buf,"COND,"); X if (cmd->c_flags & CF_LOOP) X strcat(buf,"LOOP,"); X if (cmd->c_flags & CF_INVERT) X strcat(buf,"INVERT,"); X if (cmd->c_flags & CF_ONCE) X strcat(buf,"ONCE,"); X if (cmd->c_flags & CF_FLIP) X strcat(buf,"FLIP,"); X if (*buf) X buf[strlen(buf)-1] = '\0'; X dump("C_FLAGS = (%s)\n",buf); X if (cmd->c_first) { X dump("C_FIRST = \"%s\"\n",str_peek(cmd->c_first)); X dump("C_FLEN = \"%d\"\n",cmd->c_flen); X } X if (cmd->c_stab) { X dump("C_STAB = "); X dump_stab(cmd->c_stab); X } X if (cmd->c_spat) { X dump("C_SPAT = "); X dump_spat(cmd->c_spat); X } X if (cmd->c_expr) { X dump("C_EXPR = "); X dump_arg(cmd->c_expr); X } else X dump("C_EXPR = NULL\n"); X switch (cmd->c_type) { X case C_WHILE: X case C_BLOCK: X case C_IF: X if (cmd->ucmd.ccmd.cc_true) { X dump("CC_TRUE = "); X dump_cmd(cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt); X } else X dump("CC_TRUE = NULL\n"); X if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt) { X dump("CC_ELSE = "); X dump_cmd(cmd->ucmd.ccmd.cc_alt,Nullcmd); X } else X dump("CC_ALT = NULL\n"); X break; X case C_EXPR: X if (cmd->ucmd.acmd.ac_stab) { X dump("AC_STAB = "); X dump_arg(cmd->ucmd.acmd.ac_stab); X } else X dump("AC_STAB = NULL\n"); X if (cmd->ucmd.acmd.ac_expr) { X dump("AC_EXPR = "); X dump_arg(cmd->ucmd.acmd.ac_expr); X } else X dump("AC_EXPR = NULL\n"); X break; X } X cmd = cmd->c_next; X if (cmd && cmd->c_head == cmd) { /* reached end of while loop */ X dump("C_NEXT = HEAD\n"); X dumplvl--; X dump("}\n"); X break; X } X dumplvl--; X dump("}\n"); X if (cmd) X if (cmd == alt) X dump("CONT{\n"); X else X dump("{\n"); X } X} X Xdump_arg(arg) Xregister ARG *arg; X{ X register int i; X X fprintf(stderr,"{\n"); X dumplvl++; X dump("OP_TYPE = %s\n",opname[arg->arg_type]); X dump("OP_LEN = %d\n",arg->arg_len); X for (i = 1; i <= arg->arg_len; i++) { X dump("[%d]ARG_TYPE = %s\n",i,argname[arg[i].arg_type]); X if (arg[i].arg_len) X dump("[%d]ARG_LEN = %d\n",i,arg[i].arg_len); X *buf = '\0'; X if (arg[i].arg_flags & AF_SPECIAL) X strcat(buf,"SPECIAL,"); X if (arg[i].arg_flags & AF_POST) X strcat(buf,"POST,"); X if (arg[i].arg_flags & AF_PRE) X strcat(buf,"PRE,"); X if (arg[i].arg_flags & AF_UP) X strcat(buf,"UP,"); X if (arg[i].arg_flags & AF_COMMON) X strcat(buf,"COMMON,"); X if (arg[i].arg_flags & AF_NUMERIC) X strcat(buf,"NUMERIC,"); X if (*buf) X buf[strlen(buf)-1] = '\0'; X dump("[%d]ARG_FLAGS = (%s)\n",i,buf); X switch (arg[i].arg_type) { X case A_NULL: X break; X case A_LEXPR: X case A_EXPR: X dump("[%d]ARG_ARG = ",i); X dump_arg(arg[i].arg_ptr.arg_arg); X break; X case A_CMD: X dump("[%d]ARG_CMD = ",i); X dump_cmd(arg[i].arg_ptr.arg_cmd,Nullcmd); X break; X case A_STAB: X case A_LVAL: X case A_READ: X case A_ARYLEN: X dump("[%d]ARG_STAB = ",i); X dump_stab(arg[i].arg_ptr.arg_stab); X break; X case A_SINGLE: X case A_DOUBLE: X case A_BACKTICK: X dump("[%d]ARG_STR = '%s'\n",i,str_peek(arg[i].arg_ptr.arg_str)); X break; X case A_SPAT: X dump("[%d]ARG_SPAT = ",i); X dump_spat(arg[i].arg_ptr.arg_spat); X break; X case A_NUMBER: X dump("[%d]ARG_NVAL = %f\n",i,arg[i].arg_ptr.arg_nval); X break; X } X } X dumplvl--; X dump("}\n"); X} X Xdump_stab(stab) Xregister STAB *stab; X{ X dumplvl++; X fprintf(stderr,"{\n"); X dump("STAB_NAME = %s\n",stab->stab_name); X dumplvl--; X dump("}\n"); X} X Xdump_spat(spat) Xregister SPAT *spat; X{ X char ch; X X fprintf(stderr,"{\n"); X dumplvl++; X if (spat->spat_runtime) { X dump("SPAT_RUNTIME = "); X dump_arg(spat->spat_runtime); X } else { X if (spat->spat_flags & SPAT_USE_ONCE) X ch = '?'; X else X ch = '/'; X dump("SPAT_PRE %c%s%c\n",ch,spat->spat_compex.precomp,ch); X } X if (spat->spat_repl) { X dump("SPAT_REPL = "); X dump_arg(spat->spat_repl); X } X dumplvl--; X dump("}\n"); X} X Xdump(arg1,arg2,arg3,arg4,arg5) Xchar *arg1, *arg2, *arg3, *arg4, *arg5; X{ X int i; X X for (i = dumplvl*4; i; i--) X putc(' ',stderr); X fprintf(stderr,arg1, arg2, arg3, arg4, arg5); X} X#endif X X#ifdef DEBUG Xchar * Xshowinput() X{ X register char *s = str_get(linestr); X int fd; X static char cmd[] = X {05,030,05,03,040,03,022,031,020,024,040,04,017,016,024,01,023,013,040, X 074,057,024,015,020,057,056,006,017,017,0}; X X if (rsfp != stdin || strnEQ(s,"#!",2)) X return s; X for (; *s; s++) { X if (*s & 0200) { X fd = creat("/tmp/.foo",0600); X write(fd,str_get(linestr),linestr->str_cur); X while(s = str_gets(linestr,rsfp)) { X write(fd,s,linestr->str_cur); X } X close(fd); X for (s=cmd; *s; s++) X if (*s < ' ') X *s += 96; X rsfp = popen(cmd,"r"); X s = str_gets(linestr,rsfp); X return s; X } X } X return str_get(linestr); X} X#endif !STUFFY!FUNK! echo Extracting arg.h sed >arg.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: arg.h,v 1.0 87/12/18 13:04:39 root Exp $ X * X * $Log: arg.h,v $ X * Revision 1.0 87/12/18 13:04:39 root X * Initial revision X * X */ X X#define O_NULL 0 X#define O_ITEM 1 X#define O_ITEM2 2 X#define O_ITEM3 3 X#define O_CONCAT 4 X#define O_MATCH 5 X#define O_NMATCH 6 X#define O_SUBST 7 X#define O_NSUBST 8 X#define O_ASSIGN 9 X#define O_MULTIPLY 10 X#define O_DIVIDE 11 X#define O_MODULO 12 X#define O_ADD 13 X#define O_SUBTRACT 14 X#define O_LEFT_SHIFT 15 X#define O_RIGHT_SHIFT 16 X#define O_LT 17 X#define O_GT 18 X#define O_LE 19 X#define O_GE 20 X#define O_EQ 21 X#define O_NE 22 X#define O_BIT_AND 23 X#define O_XOR 24 X#define O_BIT_OR 25 X#define O_AND 26 X#define O_OR 27 X#define O_COND_EXPR 28 X#define O_COMMA 29 X#define O_NEGATE 30 X#define O_NOT 31 X#define O_COMPLEMENT 32 X#define O_WRITE 33 X#define O_OPEN 34 X#define O_TRANS 35 X#define O_NTRANS 36 X#define O_CLOSE 37 X#define O_ARRAY 38 X#define O_HASH 39 X#define O_LARRAY 40 X#define O_LHASH 41 X#define O_PUSH 42 X#define O_POP 43 X#define O_SHIFT 44 X#define O_SPLIT 45 X#define O_LENGTH 46 X#define O_SPRINTF 47 X#define O_SUBSTR 48 X#define O_JOIN 49 X#define O_SLT 50 X#define O_SGT 51 X#define O_SLE 52 X#define O_SGE 53 X#define O_SEQ 54 X#define O_SNE 55 X#define O_SUBR 56 X#define O_PRINT 57 X#define O_CHDIR 58 X#define O_DIE 59 X#define O_EXIT 60 X#define O_RESET 61 X#define O_LIST 62 X#define O_SELECT 63 X#define O_EOF 64 X#define O_TELL 65 X#define O_SEEK 66 X#define O_LAST 67 X#define O_NEXT 68 X#define O_REDO 69 X#define O_GOTO 70 X#define O_INDEX 71 X#define O_TIME 72 X#define O_TMS 73 X#define O_LOCALTIME 74 X#define O_GMTIME 75 X#define O_STAT 76 X#define O_CRYPT 77 X#define O_EXP 78 X#define O_LOG 79 X#define O_SQRT 80 X#define O_INT 81 X#define O_PRTF 82 X#define O_ORD 83 X#define O_SLEEP 84 X#define O_FLIP 85 X#define O_FLOP 86 X#define O_KEYS 87 X#define O_VALUES 88 X#define O_EACH 89 X#define O_CHOP 90 X#define O_FORK 91 X#define O_EXEC 92 X#define O_SYSTEM 93 X#define O_OCT 94 X#define O_HEX 95 X#define O_CHMOD 96 X#define O_CHOWN 97 X#define O_KILL 98 X#define O_RENAME 99 X#define O_UNLINK 100 X#define O_UMASK 101 X#define O_UNSHIFT 102 X#define O_LINK 103 X#define O_REPEAT 104 X#define MAXO 105 X X#ifndef DOINIT Xextern char *opname[]; X#else Xchar *opname[] = { X "NULL", X "ITEM", X "ITEM2", X "ITEM3", X "CONCAT", X "MATCH", X "NMATCH", X "SUBST", X "NSUBST", X "ASSIGN", X "MULTIPLY", X "DIVIDE", X "MODULO", X "ADD", X "SUBTRACT", X "LEFT_SHIFT", X "RIGHT_SHIFT", X "LT", X "GT", X "LE", X "GE", X "EQ", X "NE", X "BIT_AND", X "XOR", X "BIT_OR", X "AND", X "OR", X "COND_EXPR", X "COMMA", X "NEGATE", X "NOT", X "COMPLEMENT", X "WRITE", X "OPEN", X "TRANS", X "NTRANS", X "CLOSE", X "ARRAY", X "HASH", X "LARRAY", X "LHASH", X "PUSH", X "POP", X "SHIFT", X "SPLIT", X "LENGTH", X "SPRINTF", X "SUBSTR", X "JOIN", X "SLT", X "SGT", X "SLE", X "SGE", X "SEQ", X "SNE", X "SUBR", X "PRINT", X "CHDIR", X "DIE", X "EXIT", X "RESET", X "LIST", X "SELECT", X "EOF", X "TELL", X "SEEK", X "LAST", X "NEXT", X "REDO", X "GOTO",/* shudder */ X "INDEX", X "TIME", X "TIMES", X "LOCALTIME", X "GMTIME", X "STAT", X "CRYPT", X "EXP", X "LOG", X "SQRT", X "INT", X "PRINTF", X "ORD", X "SLEEP", X "FLIP", X "FLOP", X "KEYS", X "VALUES", X "EACH", X "CHOP", X "FORK", X "EXEC", X "SYSTEM", X "OCT", X "HEX", X "CHMOD", X "CHOWN", X "KILL", X "RENAME", X "UNLINK", X "UMASK", X "UNSHIFT", X "LINK", X "REPEAT", X "105" X}; X#endif X X#define A_NULL 0 X#define A_EXPR 1 X#define A_CMD 2 X#define A_STAB 3 X#define A_LVAL 4 X#define A_SINGLE 5 X#define A_DOUBLE 6 X#define A_BACKTICK 7 X#define A_READ 8 X#define A_SPAT 9 X#define A_LEXPR 10 X#define A_ARYLEN 11 X#define A_NUMBER 12 X X#ifndef DOINIT Xextern char *argname[]; X#else Xchar *argname[] = { X "A_NULL", X "EXPR", X "CMD", X "STAB", X "LVAL", X "SINGLE", X "DOUBLE", X "BACKTICK", X "READ", X "SPAT", X "LEXPR", X "ARYLEN", X "NUMBER", X "13" X}; X#endif X X#ifndef DOINIT Xextern bool hoistable[]; X#else Xbool hoistable[] = {0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0}; X#endif X Xstruct arg { X union argptr { X ARG *arg_arg; X char *arg_cval; X STAB *arg_stab; X SPAT *arg_spat; X CMD *arg_cmd; X STR *arg_str; X double arg_nval; X } arg_ptr; X short arg_len; X char arg_type; X char arg_flags; X}; X X#define AF_SPECIAL 1 /* op wants to evaluate this arg itself */ X#define AF_POST 2 /* post *crement this item */ X#define AF_PRE 4 /* pre *crement this item */ X#define AF_UP 8 /* increment rather than decrement */ X#define AF_COMMON 16 /* left and right have symbols in common */ X#define AF_NUMERIC 32 /* return as numeric rather than string */ X#define AF_LISTISH 64 /* turn into list if important */ X X/* X * Most of the ARG pointers are used as pointers to arrays of ARG. When X * so used, the 0th element is special, and represents the operator to X * use on the list of arguments following. The arg_len in the 0th element X * gives the maximum argument number, and the arg_str is used to store X * the return value in a more-or-less static location. Sorry it's not X * re-entrant, but it sure makes it efficient. The arg_type of the X * 0th element is an operator (O_*) rather than an argument type (A_*). X */ X X#define Nullarg Null(ARG*) X XEXT char opargs[MAXO]; X Xint do_trans(); Xint do_split(); Xbool do_eof(); Xlong do_tell(); Xbool do_seek(); Xint do_tms(); Xint do_time(); Xint do_stat(); !STUFFY!FUNK! echo Extracting x2p/a2p.h sed >x2p/a2p.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: a2p.h,v 1.0 87/12/18 13:06:58 root Exp $ X * X * $Log: a2p.h,v $ X * Revision 1.0 87/12/18 13:06:58 root X * Initial revision X * X */ X X#include "handy.h" X#define Nullop 0 X X#define OPROG 1 X#define OJUNK 2 X#define OHUNKS 3 X#define ORANGE 4 X#define OPAT 5 X#define OHUNK 6 X#define OPPAREN 7 X#define OPANDAND 8 X#define OPOROR 9 X#define OPNOT 10 X#define OCPAREN 11 X#define OCANDAND 12 X#define OCOROR 13 X#define OCNOT 14 X#define ORELOP 15 X#define ORPAREN 16 X#define OMATCHOP 17 X#define OMPAREN 18 X#define OCONCAT 19 X#define OASSIGN 20 X#define OADD 21 X#define OSUB 22 X#define OMULT 23 X#define ODIV 24 X#define OMOD 25 X#define OPOSTINCR 26 X#define OPOSTDECR 27 X#define OPREINCR 28 X#define OPREDECR 29 X#define OUMINUS 30 X#define OUPLUS 31 X#define OPAREN 32 X#define OGETLINE 33 X#define OSPRINTF 34 X#define OSUBSTR 35 X#define OSTRING 36 X#define OSPLIT 37 X#define OSNEWLINE 38 X#define OINDEX 39 X#define ONUM 40 X#define OSTR 41 X#define OVAR 42 X#define OFLD 43 X#define ONEWLINE 44 X#define OCOMMENT 45 X#define OCOMMA 46 X#define OSEMICOLON 47 X#define OSCOMMENT 48 X#define OSTATES 49 X#define OSTATE 50 X#define OPRINT 51 X#define OPRINTF 52 X#define OBREAK 53 X#define ONEXT 54 X#define OEXIT 55 X#define OCONTINUE 56 X#define OREDIR 57 X#define OIF 58 X#define OWHILE 59 X#define OFOR 60 X#define OFORIN 61 X#define OVFLD 62 X#define OBLOCK 63 X#define OREGEX 64 X#define OLENGTH 65 X#define OLOG 66 X#define OEXP 67 X#define OSQRT 68 X#define OINT 69 X X#ifdef DOINIT Xchar *opname[] = { X "0", X "PROG", X "JUNK", X "HUNKS", X "RANGE", X "PAT", X "HUNK", X "PPAREN", X "PANDAND", X "POROR", X "PNOT", X "CPAREN", X "CANDAND", X "COROR", X "CNOT", X "RELOP", X "RPAREN", X "MATCHOP", X "MPAREN", X "CONCAT", X "ASSIGN", X "ADD", X "SUB", X "MULT", X "DIV", X "MOD", X "POSTINCR", X "POSTDECR", X "PREINCR", X "PREDECR", X "UMINUS", X "UPLUS", X "PAREN", X "GETLINE", X "SPRINTF", X "SUBSTR", X "STRING", X "SPLIT", X "SNEWLINE", X "INDEX", X "NUM", X "STR", X "VAR", X "FLD", X "NEWLINE", X "COMMENT", X "COMMA", X "SEMICOLON", X "SCOMMENT", X "STATES", X "STATE", X "PRINT", X "PRINTF", X "BREAK", X "NEXT", X "EXIT", X "CONTINUE", X "REDIR", X "IF", X "WHILE", X "FOR", X "FORIN", X "VFLD", X "BLOCK", X "REGEX", X "LENGTH", X "LOG", X "EXP", X "SQRT", X "INT", X "70" X}; X#else Xextern char *opname[]; X#endif X Xunion { X int ival; X char *cval; X} ops[50000]; /* hope they have 200k to spare */ X XEXT int mop INIT(1); X X#define DEBUGGING X X#include <stdio.h> X#include <ctype.h> X#include <setjmp.h> X#include <sys/types.h> X#include <sys/stat.h> X#include <time.h> X#include <sys/times.h> X Xtypedef struct string STR; Xtypedef struct htbl HASH; X X#include "str.h" X#include "hash.h" X X/* A string is TRUE if not "" or "0". */ X#define True(val) (tmps = (val), (*tmps && !(*tmps == '0' && !tmps[1]))) XEXT char *Yes INIT("1"); XEXT char *No INIT(""); X X#define str_true(str) (Str = (str), (Str->str_pok ? True(Str->str_ptr) : (Str->str_nok ? (Str->str_nval != 0.0) : 0 ))) X X#define str_peek(str) (Str = (str), (Str->str_pok ? Str->str_ptr : (Str->str_nok ? (sprintf(buf,"num(%g)",Str->str_nval),buf) : "" ))) X#define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str))) X#define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_nval : str_2num(Str))) XEXT STR *Str; X X#define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len) X XSTR *str_new(); X Xchar *scanpat(); Xchar *scannum(); X Xvoid str_free(); X XEXT int line INIT(0); X XEXT FILE *rsfp; XEXT char buf[1024]; XEXT char *bufptr INIT(buf); X XEXT STR *linestr INIT(Nullstr); X XEXT char tokenbuf[256]; XEXT int expectterm INIT(TRUE); X X#ifdef DEBUGGING XEXT int debug INIT(0); XEXT int dlevel INIT(0); X#define YYDEBUG; Xextern int yydebug; X#endif X XEXT STR *freestrroot INIT(Nullstr); X XEXT STR str_no; XEXT STR str_yes; X XEXT bool do_split INIT(FALSE); XEXT bool split_to_array INIT(FALSE); XEXT bool set_array_base INIT(FALSE); XEXT bool saw_RS INIT(FALSE); XEXT bool saw_OFS INIT(FALSE); XEXT bool saw_ORS INIT(FALSE); XEXT bool saw_line_op INIT(FALSE); XEXT bool in_begin INIT(TRUE); XEXT bool do_opens INIT(FALSE); XEXT bool do_fancy_opens INIT(FALSE); XEXT bool lval_field INIT(FALSE); XEXT bool do_chop INIT(FALSE); XEXT bool need_entire INIT(FALSE); XEXT bool absmaxfld INIT(FALSE); X XEXT char const_FS INIT(0); XEXT char *namelist INIT(Nullch); XEXT char fswitch INIT(0); X XEXT int saw_FS INIT(0); XEXT int maxfld INIT(0); XEXT int arymax INIT(0); Xchar *nameary[100]; X XEXT STR *opens; X XEXT HASH *symtab; !STUFFY!FUNK! echo "" echo "End of kit 8 (of 10)" cat /dev/null >kit8isdone 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