Usenet 1994 October

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

/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume20 / perl3.0 / part20 < prev next >

Wrap

Text File | 1989-11-01 | 50KB | 1,793 lines

Subject: v20i103: Perl, a language with features of C/sed/awk/shell/etc, Part20/24 Newsgroups: comp.sources.unix Sender: sources Approved: rsalz@uunet.UU.NET Submitted-by: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov> Posting-number: Volume 20, Issue 103 Archive-name: perl3.0/part20 #! /bin/sh # Make a new directory for the perl sources, cd to it, and run kits 1 # thru 24 through sh. When all 24 kits have been run, read README. echo "This is perl 3.0 kit 20 (of 24). If kit 20 is complete, the line" echo '"'"End of kit 20 (of 24)"'" will echo at the end.' echo "" export PATH || (echo "You didn't use sh, you clunch." ; kill $$) mkdir x2p 2>/dev/null echo Extracting Changes sed >Changes <<'!STUFFY!FUNK!' -e 's/X//' XChanges to perl X--------------- X XApart from little bug fixes, here are the new features: X XPerl can now handle binary data correctly and has functions to pack and Xunpack binary structures into arrays or lists. You can now do arbitrary Xioctl functions. X XYou can do i/o with sockets and select. X XYou can now write packages with their own namespace. X XYou can now pass things to subroutines by reference. X XThe debugger now has hooks in the perl parser so it doesn't get confused. XThe debugger won't interfere with stdin and stdout. New debugger commands: X n Single step around subroutine call. X l min+incr List incr+1 lines starting at min. X l List incr+1 more lines. X l subname List subroutine. X b subname Set breakpoint at first line of subroutine. X S List subroutine names. X D Delete all breakpoints. X A List line actions. X < command Define command before prompt. X > command Define command after prompt. X ! number Redo command (default previous command). X ! -number Redo numberth to last command. X h -number Display last number commands (default all). X p expr Same as \"print DBout expr\". X XThe rules are more consistent about where parens are needed and Xwhere they are not. In particular, unary operators and list operators now Xbehave like functions if they're called like functions. X XThere are some new quoting mechanisms: X $foo = q/"'"'"'"'"'"'"/; X $foo = qq/"'"''$bar"''/; X $foo = q(hi there); X $foo = <<'EOF' x 10; X Why, it's the old here-is mechanism! X EOF X XYou can now work with array slices (note the initial @): X @foo[1,2,3]; X @foo{'Sun','Mon','Tue','Wed','Thu','Fri','Sat'} = (1,2,3,4,5,6,7); X @foo{split} = (1,1,1,1,1,1,1); X XThere's now a range operator that works in array contexts: X for (1..15) { ... X @foo[3..5] = ('time','for','all'); X @foo{'Sun','Mon','Tue','Wed','Thu','Fri','Sat'} = 1..7; X XYou can now reference associative arrays as a whole: X %abc = %def; X %foo = ('Sun',1,'Mon',2,'Tue',3,'Wed',4,'Thu',5,'Fri',6,'Sat',7); X XAssociative arrays can now be bound to a dbm or ndbm file. Perl automatically Xcaches references to the dbm file for you. X XAn array or associative array can now be assigned to as part of a list, if Xit's the last thing in the list: X ($a,$b,@rest) = split; X XAn array or associative array may now appear in a local() list. X local(%assoc); X local(@foo) = @_; X XArray values may now be interpolated into strings: X `echo @ARGV`; X print "first three = @list[0..2]\n"; X print "@ENV{keys(ENV)}"; X ($" is used as the delimiter between array elements) X XArray sizes may be interpolated into strings: X print "The last element is $#foo.\n"; X XArray values may now be returned from subroutines, evals, and do blocks. X XLists of values in formats may now be arbitrary expressions, separated Xby commas. X XSubroutine names are now distinguished by prefixing with &. You can call Xsubroutines without using do, and without passing any argument list at all: X $foo = &min($a,$b,$c); X $num = &myrand; X XYou can use the new -u switch to cause perl to dump core so that you can Xrun undump and produce a binary executable image. Alternately you can Xuse the "dump" operator after initializing any variables and such. X XPerl now optimizes splits that are assigned directly to an array, or Xto a list with fewer elements than the split would produce, or that Xsplit on a constant string. X XPerl now optimizes on end matches such as /foo$/; X XPerl now recognizes {n,m} in patterns to match preceding item at least n times Xand no more than m times. Also recognizes {n,} and {n} to match n or more Xtimes, or exactly n times. If { occurs in other than this context it is Xstill treated as a normal character. X XPerl now optimizes "next" to avoid unnecessary longjmps and subroutine calls. X XPerl now optimizes appended input: $_ .= <>; X XSubstitutions are faster if the substituted text is constant, especially Xwhen substituting at the beginning of a string. This plus the previous Xoptimization let you run down a file comparing multiple lines more Xefficiently. (Basically the equivalents of sed's N and D are faster.) X XSimilarly, combinations of shifts and pushes on the same array are much Xfaster now--it doesn't copy all the pointers every time you shift (just Xevery n times, where n is approximately the length of the array plus 10, Xmore if you pre-extend the array), so you can use an array as a shift Xregister much more efficiently: X push(@ary,shift(@ary)); Xor X shift(@ary); push(@ary,<>); X XThe shift operator used inside subroutines now defaults to shifting Xthe @_ array. You can still shift ARGV explicitly, of course. X XThe @_ array which is passed to subroutines is a local array, but the Xelements of it are passed by reference now. This means that if you Xexplicitly modify $_[0], you are actually modifying the first argument Xto the routine. Assignment to another location (such as the usual Xlocal($foo) = @_ trick) causes a copy of the value, so this will not Xaffect most scripts. However, if you've modified @_ values in the Xsubroutine you could be in for a surprise. I don't believe most people Xwill find this a problem, and the long term efficiency gain is worth Xa little confusion. X XPerl now detects sequences of references to the same variable and builds Xswitch statements internally wherever reasonable. X XThe substr function can take offsets from the end of the string. X XThe substr function can be assigned to in order to change the interior of a Xstring in place. X XThe split function can return as part of the returned array any substrings Xmatched as part of the delimiter: X split(/([-,])/, '1-10,20') Xreturns X (1,'-',10,',',20) X XIf you specify a maximum number of fields to split, the truncation of Xtrailing null fields is disabled. X XYou can now chop lists. X XPerl now uses /bin/csh to do filename globbing, if available. This means Xthat filenames with spaces or other strangenesses work right. X XPerl can now report multiple syntax errors with a single invocation. X XPerl syntax errors now give two tokens of context where reasonable. X XPerl will now report the possibility of a runaway multi-line string if Xsuch a string ends on a line with a syntax error. X XThe assumed assignment in a while now works in the while modifier as Xwell as the while statement. X XPerl can now warn you if you use numeric == on non-numeric string values. X XNew functions: X mkdir and rmdir X getppid X getpgrp and setpgrp X getpriority and setpriority X chroot X ioctl and fcntl X flock X readlink X lstat X rindex - find last occurrence of substring X pack and unpack - turn structures into arrays and vice versa X read - just what you think X warn - like die, only not fatal X dbmopen and dbmclose - bind a dbm file to an associative array X dump - do core dump so you can undump X reverse - turns an array value end for end X defined - does an object exist? X undef - make an object not exist X vec - treat string as a vector of small integers X fileno - return the file descriptor for a handle X wantarray - was subroutine called in array context? X opendir X readdir X telldir X seekdir X rewinddir X closedir X syscall X socket X bind X connect X listen X accept X shutdown X socketpair X getsockname X getpeername X getsockopt X setsockopt X getpwnam X getpwuid X getpwent X setpwent X endpwent X getgrnam X getgrgid X getgrent X setgrent X endgrent X gethostbyname X gethostbyaddr X gethostent X sethostent X endhostent X getnetbyname X getnetbyaddr X getnetent X setnetent X endnetent X getprotobyname X getprotobynumber X getprotoent X setprotoent X endprotoent X getservbyname X getservbyport X getservent X setservent X endservent X XChanges to s2p X-------------- X XIn patterns, s2p now translates \{n,m\} correctly to {n,m}. X XIn patterns, s2p no longer removes backslashes in front of |. X XIn patterns, s2p now removes backslashes in front of [a-zA-Z0-9]. X XS2p now makes use of the location of perl as determined by Configure. X X XChanges to a2p X-------------- X XA2p can now accurately translate the "in" operator by using perl's new X"defined" operator. X XA2p can now accurately translate the passing of arrays by reference. X !STUFFY!FUNK! echo Extracting MANIFEST sed >MANIFEST <<'!STUFFY!FUNK!' -e 's/X//' XChanges Differences between 2.0 level 18 and 3.0 level 0 XConfigure Run this first XCopying The GNU General Public License XEXTERN.h Included before foreign .h files XINTERN.h Included before domestic .h files XMANIFEST This list of files XMakefile.SH Precursor to Makefile XPACKINGLIST Which files came from which kits XREADME The Instructions XWishlist Some things that may or may not happen Xarg.h Public declarations for the above Xarray.c Numerically subscripted arrays Xarray.h Public declarations for the above Xclient A client to test sockets Xcmd.c Command interpreter Xcmd.h Public declarations for the above Xconfig.H Sample config.h Xconfig.h.SH Produces config.h Xcons.c Routines to construct cmd nodes of a parse tree Xconsarg.c Routines to construct arg nodes of a parse tree Xdoarg.c Scalar expression evaluation Xdoio.c I/O operations Xdolist.c Array expression evaluation Xdump.c Debugging output Xeg/ADB An adb wrapper to put in your crash dir Xeg/README Intro to example perl scripts Xeg/changes A program to list recently changed files Xeg/down A program to do things to subdirectories Xeg/dus A program to do du -s on non-mounted dirs Xeg/findcp A find wrapper that implements a -cp switch Xeg/findtar A find wrapper that pumps out a tar file Xeg/g/gcp A program to do a global rcp Xeg/g/gcp.man Manual page for gcp Xeg/g/ged A program to do a global edit Xeg/g/ghosts A sample /etc/ghosts file Xeg/g/gsh A program to do a global rsh Xeg/g/gsh.man Manual page for gsh Xeg/muck A program to find missing make dependencies Xeg/muck.man Manual page for muck Xeg/myrup A program to find lightly loaded machines Xeg/nih Script to insert #! workaround Xeg/rename A program to rename files Xeg/rmfrom A program to feed doomed filenames to Xeg/scan/scan_df Scan for filesystem anomalies Xeg/scan/scan_last Scan for login anomalies Xeg/scan/scan_messages Scan for console message anomalies Xeg/scan/scan_passwd Scan for passwd file anomalies Xeg/scan/scan_ps Scan for process anomalies Xeg/scan/scan_sudo Scan for sudo anomalies Xeg/scan/scan_suid Scan for setuid anomalies Xeg/scan/scanner An anomaly reporter Xeg/shmkill A program to remove unused shared memory Xeg/van/empty A program to empty the trashcan Xeg/van/unvanish A program to undo what vanish does Xeg/van/vanexp A program to expire vanished files Xeg/van/vanish A program to put files in a trashcan Xeg/who A sample who program Xeval.c The expression evaluator Xevalargs.xc The arg evaluator of eval.c Xform.c Format processing Xform.h Public declarations for the above Xgettest A little script to test the get* routines Xhandy.h Handy definitions Xhash.c Associative arrays Xhash.h Public declarations for the above Xioctl.pl Sample ioctl.pl Xlib/abbrev.pl An abbreviation table builder Xlib/look.pl A "look" equivalent Xlib/complete.pl A command completion subroutine Xlib/dumpvar.pl A variable dumper Xlib/getopt.pl Perl library supporting option parsing Xlib/getopts.pl Perl library supporting option parsing Xlib/importenv.pl Perl routine to get environment into variables Xlib/perldb.pl Perl debugging routines Xlib/stat.pl Perl library supporting stat function Xlib/termcap.pl Perl library supporting termcap usage Xlib/validate.pl Perl library supporting wholesale file mode validation Xmakedepend.SH Precursor to makedepend Xmakedir.SH Precursor to makedir Xmakelib.SH A thing to turn C .h file into perl .h files Xmalloc.c A version of malloc you might not want Xpatchlevel.h The current patch level of perl Xperl.h Global declarations Xperl.man.1 The manual page(s), first fourth Xperl.man.2 The manual page(s), second fourth Xperl.man.3 The manual page(s), third fourth Xperl.man.4 The manual page(s), fourth fourth Xperl.y Yacc grammar for perl Xperlsh A poor man's perl shell Xperly.c main() Xregcomp.c Regular expression compiler Xregcomp.h Private declarations for above Xregexp.h Public declarations for the above Xregexec.c Regular expression evaluator Xserver A server to test sockets Xspat.h Search pattern declarations Xstab.c Symbol table stuff Xstab.h Public declarations for the above Xstr.c String handling package Xstr.h Public declarations for the above Xt/README Instructions for regression tests Xt/TEST The regression tester Xt/base.cond See if conditionals work Xt/base.if See if if works Xt/base.lex See if lexical items work Xt/base.pat See if pattern matching works Xt/base.term See if various terms work Xt/cmd.elsif See if else-if works Xt/cmd.for See if for loops work Xt/cmd.mod See if statement modifiers work Xt/cmd.subval See if subroutine values work Xt/cmd.switch See if switch optimizations work Xt/cmd.while See if while loops work Xt/comp.cmdopt See if command optimization works Xt/comp.cpp See if C preprocessor works Xt/comp.decl See if declarations work Xt/comp.multiline See if multiline strings work Xt/comp.package See if packages work Xt/comp.script See if script invokation works Xt/comp.term See if more terms work Xt/io.argv See if ARGV stuff works Xt/io.dup See if >& works right Xt/io.fs See if directory manipulations work Xt/io.inplace See if inplace editing works Xt/io.pipe See if secure pipes work Xt/io.print See if print commands work Xt/io.tell See if file seeking works Xt/op.append See if . works Xt/op.array See if array operations work Xt/op.auto See if autoincrement et all work Xt/op.chop See if chop works Xt/op.cond See if conditional expressions work Xt/op.dbm See if dbm binding works Xt/op.delete See if delete works Xt/op.do See if subroutines work Xt/op.each See if associative iterators work Xt/op.eval See if eval operator works Xt/op.exec See if exec and system work Xt/op.exp See if math functions work Xt/op.flip See if range operator works Xt/op.fork See if fork works Xt/op.glob See if <*> works Xt/op.goto See if goto works Xt/op.index See if index works Xt/op.int See if int works Xt/op.join See if join works Xt/op.list See if array lists work Xt/op.local See if local works Xt/op.magic See if magic variables work Xt/op.mkdir See if mkdir works Xt/op.oct See if oct and hex work Xt/op.ord See if ord works Xt/op.pack See if pack and unpack work Xt/op.pat See if esoteric patterns work Xt/op.push See if push and pop work Xt/op.range See if .. works Xt/op.read See if read() works Xt/op.regexp See if regular expressions work Xt/op.repeat See if x operator works Xt/op.sleep See if sleep works Xt/op.sort See if sort works Xt/op.split See if split works Xt/op.sprintf See if sprintf works Xt/op.stat See if stat works Xt/op.study See if study works Xt/op.subst See if substitutions work Xt/op.substr See if substr works Xt/op.time See if time functions work Xt/op.undef See if undef works Xt/op.unshift See if unshift works Xt/op.vec See if vectors work Xt/op.write See if write works Xt/re_tests Input file for op.regexp Xtoke.c The tokener Xutil.c Utility routines Xutil.h Public declarations for the above Xx2p/EXTERN.h Same as above Xx2p/INTERN.h Same as above Xx2p/Makefile.SH Precursor to Makefile Xx2p/a2p.h Global declarations Xx2p/a2p.man Manual page for awk to perl translator Xx2p/a2p.y A yacc grammer for awk Xx2p/a2py.c Awk compiler, sort of Xx2p/handy.h Handy definitions Xx2p/hash.c Associative arrays again Xx2p/hash.h Public declarations for the above Xx2p/s2p.SH Sed to perl translator Xx2p/s2p.man Manual page for sed to perl translator Xx2p/str.c String handling package Xx2p/str.h Public declarations for the above Xx2p/util.c Utility routines Xx2p/util.h Public declarations for the above Xx2p/walk.c Parse tree walker !STUFFY!FUNK! echo Extracting dump.c sed >dump.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: dump.c,v 3.0 89/10/18 15:11:16 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: dump.c,v $ X * Revision 3.0 89/10/18 15:11:16 lwall X * 3.0 baseline X * X */ X X#include "EXTERN.h" X#include "perl.h" X X#ifdef DEBUGGING Xstatic int dumplvl = 0; X Xdump_all() X{ X register int i; X register STAB *stab; X register HENT *entry; X X dump_cmd(main_root,Nullcmd); X for (i = 0; i <= 127; i++) { X for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) { X stab = (STAB*)entry->hent_val; X if (stab_sub(stab)) { X dump("\nSUB %s = ", stab_name(stab)); X dump_cmd(stab_sub(stab)->cmd,Nullcmd); X } X } X } X} 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 dump("C_ADDR = 0x%lx\n",cmd); X dump("C_NEXT = 0x%lx\n",cmd->c_next); X if (cmd->c_line) X dump("C_LINE = %d (0x%lx)\n",cmd->c_line,cmd); 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 (void)strcat(buf,"FIRSTNEG,"); X if (cmd->c_flags & CF_NESURE) X (void)strcat(buf,"NESURE,"); X if (cmd->c_flags & CF_EQSURE) X (void)strcat(buf,"EQSURE,"); X if (cmd->c_flags & CF_COND) X (void)strcat(buf,"COND,"); X if (cmd->c_flags & CF_LOOP) X (void)strcat(buf,"LOOP,"); X if (cmd->c_flags & CF_INVERT) X (void)strcat(buf,"INVERT,"); X if (cmd->c_flags & CF_ONCE) X (void)strcat(buf,"ONCE,"); X if (cmd->c_flags & CF_FLIP) X (void)strcat(buf,"FLIP,"); X if (cmd->c_flags & CF_TERM) X (void)strcat(buf,"TERM,"); X if (*buf) X buf[strlen(buf)-1] = '\0'; X dump("C_FLAGS = (%s)\n",buf); X if (cmd->c_short) { X dump("C_SHORT = \"%s\"\n",str_peek(cmd->c_short)); X dump("C_SLEN = \"%d\"\n",cmd->c_slen); 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_NEXT: X case C_WHILE: X case C_BLOCK: X case C_ELSE: 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 } X else X dump("CC_TRUE = NULL\n"); X if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt) { X dump("CC_ENDELSE = 0x%lx\n",cmd->ucmd.ccmd.cc_alt); X } X else if (cmd->c_type == C_NEXT && cmd->ucmd.ccmd.cc_alt) { X dump("CC_NEXT = 0x%lx\n",cmd->ucmd.ccmd.cc_alt); X } 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_stab(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 case C_CSWITCH: X case C_NSWITCH: X { X int max, i; X X max = cmd->ucmd.scmd.sc_max; X dump("SC_MIN = (%d)\n",cmd->ucmd.scmd.sc_offset + 1); X dump("SC_MAX = (%d)\n", max + cmd->ucmd.scmd.sc_offset - 1); X dump("SC_NEXT[LT] = 0x%lx\n", cmd->ucmd.scmd.sc_next[0]); X for (i = 1; i < max; i++) X dump("SC_NEXT[%d] = 0x%lx\n", i + cmd->ucmd.scmd.sc_offset, X cmd->ucmd.scmd.sc_next[i]); X dump("SC_NEXT[GT] = 0x%lx\n", cmd->ucmd.scmd.sc_next[max]); X } 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 0x%lx {\n",cmd); 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 if (arg->arg_flags) { X dump_flags(buf,arg->arg_flags); X dump("OP_FLAGS = (%s)\n",buf); X } X for (i = 1; i <= arg->arg_len; i++) { X dump("[%d]ARG_TYPE = %s%s\n",i,argname[arg[i].arg_type & A_MASK], X arg[i].arg_type & A_DONT ? " (unevaluated)" : ""); X if (arg[i].arg_len) X dump("[%d]ARG_LEN = %d\n",i,arg[i].arg_len); X if (arg[i].arg_flags) { X dump_flags(buf,arg[i].arg_flags); X dump("[%d]ARG_FLAGS = (%s)\n",i,buf); X } X switch (arg[i].arg_type & A_MASK) { 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_WORD: X case A_STAB: X case A_LVAL: X case A_READ: X case A_GLOB: X case A_ARYLEN: X case A_ARYSTAB: X case A_LARYSTAB: 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 } X } X dumplvl--; X dump("}\n"); X} X Xdump_flags(b,flags) Xchar *b; Xunsigned flags; X{ X *b = '\0'; X if (flags & AF_ARYOK) X (void)strcat(b,"ARYOK,"); X if (flags & AF_POST) X (void)strcat(b,"POST,"); X if (flags & AF_PRE) X (void)strcat(b,"PRE,"); X if (flags & AF_UP) X (void)strcat(b,"UP,"); X if (flags & AF_COMMON) X (void)strcat(b,"COMMON,"); X if (flags & AF_UNUSED) X (void)strcat(b,"UNUSED,"); X if (flags & AF_LISTISH) X (void)strcat(b,"LISTISH,"); X if (flags & AF_LOCAL) X (void)strcat(b,"LOCAL,"); X if (*b) X b[strlen(b)-1] = '\0'; X} X Xdump_stab(stab) Xregister STAB *stab; X{ X if (!stab) { X fprintf(stderr,"{}\n"); X return; X } X dumplvl++; X fprintf(stderr,"{\n"); X dump("STAB_NAME = %s\n",stab_name(stab)); X dumplvl--; X dump("}\n"); X} X Xdump_spat(spat) Xregister SPAT *spat; X{ X char ch; X X if (!spat) { X fprintf(stderr,"{}\n"); X return; 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_ONCE) X ch = '?'; X else X ch = '/'; X dump("SPAT_PRE %c%s%c\n",ch,spat->spat_regexp->precomp,ch); X } X if (spat->spat_repl) { X dump("SPAT_REPL = "); X dump_arg(spat->spat_repl); X } X if (spat->spat_short) { X dump("SPAT_SHORT = \"%s\"\n",str_peek(spat->spat_short)); X } X dumplvl--; X dump("}\n"); X} X X/* VARARGS1 */ Xdump(arg1,arg2,arg3,arg4,arg5) Xchar *arg1; Xlong arg2, arg3, arg4, arg5; X{ X int i; X X for (i = dumplvl*4; i; i--) X (void)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,0)) { X write(fd,s,linestr->str_cur); X } X (void)close(fd); X for (s=cmd; *s; s++) X if (*s < ' ') X *s += 96; X rsfp = mypopen(cmd,"r"); X s = str_gets(linestr,rsfp,0); X return s; X } X } X return str_get(linestr); X} X#endif !STUFFY!FUNK! echo Extracting form.c sed >form.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: form.c,v 3.0 89/10/18 15:17:26 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: form.c,v $ X * Revision 3.0 89/10/18 15:17:26 lwall X * 3.0 baseline X * X */ X X#include "EXTERN.h" X#include "perl.h" X X/* Forms stuff */ X Xvoid Xform_parseargs(fcmd) Xregister FCMD *fcmd; X{ X register int i; X register ARG *arg; X register int items; X STR *str; X ARG *parselist(); X line_t oldline = line; X int oldsave = savestack->ary_fill; X X str = fcmd->f_unparsed; X line = fcmd->f_line; X fcmd->f_unparsed = Nullstr; X (void)savehptr(&curstash); X curstash = str->str_u.str_hash; X arg = parselist(str); X restorelist(oldsave); X X items = arg->arg_len - 1; /* ignore $$ on end */ X for (i = 1; i <= items; i++) { X if (!fcmd || fcmd->f_type == F_NULL) X fatal("Too many field values"); X dehoist(arg,i); X fcmd->f_expr = make_op(O_ITEM,1, X arg[i].arg_ptr.arg_arg,Nullarg,Nullarg); X if (fcmd->f_flags & FC_CHOP) { X if ((fcmd->f_expr[1].arg_type & A_MASK) == A_STAB) X fcmd->f_expr[1].arg_type = A_LVAL; X else if ((fcmd->f_expr[1].arg_type & A_MASK) == A_EXPR) X fcmd->f_expr[1].arg_type = A_LEXPR; X else X fatal("^ field requires scalar lvalue"); X } X fcmd = fcmd->f_next; X } X if (fcmd && fcmd->f_type) X fatal("Not enough field values"); X line = oldline; X Safefree(arg); X str_free(str); X} X Xint newsize; X X#define CHKLEN(allow) \ Xnewsize = (d - orec->o_str) + (allow); \ Xif (newsize >= 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,sp) Xregister struct outrec *orec; Xregister FCMD *fcmd; Xint sp; 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 FCMD *nextfcmd; X FCMD *linebeg = fcmd; 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 = nextfcmd) { X nextfcmd = fcmd->f_next; X CHKLEN(fcmd->f_presize); X if (s = fcmd->f_pre) { X while (*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 if (d == orec->o_str || d[-1] == '\n') { X orec->o_lines--; /* don't print blank line */ X linebeg = fcmd->f_next; X break; X } X else if (fcmd->f_flags & FC_REPEAT) X nextfcmd = linebeg; X } X else X linebeg = fcmd->f_next; X } X *d++ = *s++; X } X } X if (fcmd->f_unparsed) X form_parseargs(fcmd); X switch (fcmd->f_type) { X case F_NULL: X orec->o_lines++; X break; X case F_LEFT: X (void)eval(fcmd->f_expr,G_SCALAR,sp); X str = stack->ary_array[sp+1]; X s = str_get(str); X size = fcmd->f_size; X CHKLEN(size); X chophere = Nullch; X while (size && *s && *s != '\n') { X if (*s == '\t') X *s = ' '; X size--; X if (*s && index(chopset,(*d++ = *s++))) X chophere = s; X if (*s == '\n' && (fcmd->f_flags & FC_CHOP)) X *s = ' '; X } X if (size) X chophere = s; X else if (chophere && chophere < s && *s && index(chopset,*s)) 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 while (*chophere && index(chopset,*chophere)) 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 (void)eval(fcmd->f_expr,G_SCALAR,sp); X str = stack->ary_array[sp+1]; X t = s = str_get(str); X size = fcmd->f_size; X CHKLEN(size); X chophere = Nullch; X while (size && *s && *s != '\n') { X if (*s == '\t') X *s = ' '; X size--; X if (*s && index(chopset,*s++)) X chophere = s; X if (*s == '\n' && (fcmd->f_flags & FC_CHOP)) X *s = ' '; X } X if (size) X chophere = s; X else if (chophere && chophere < s && *s && index(chopset,*s)) X chophere = s; X if (fcmd->f_flags & FC_CHOP) { X if (!chophere) X chophere = s; X size += (s - chophere); X s = chophere; X while (*chophere && index(chopset,*chophere)) X chophere++; X } X tmpchar = *s; X *s = '\0'; X while (size) { X size--; X *d++ = ' '; X } X size = s - t; X (void)bcopy(t,d,size); X d += size; X *s = tmpchar; X if (fcmd->f_flags & FC_CHOP) X str_chop(str,chophere); X break; X case F_CENTER: { X int halfsize; X X (void)eval(fcmd->f_expr,G_SCALAR,sp); X str = stack->ary_array[sp+1]; X t = s = str_get(str); X size = fcmd->f_size; X CHKLEN(size); X chophere = Nullch; X while (size && *s && *s != '\n') { X if (*s == '\t') X *s = ' '; X size--; X if (*s && index(chopset,*s++)) X chophere = s; X if (*s == '\n' && (fcmd->f_flags & FC_CHOP)) X *s = ' '; X } X if (size) X chophere = s; X else if (chophere && chophere < s && *s && index(chopset,*s)) X chophere = s; X if (fcmd->f_flags & FC_CHOP) { X if (!chophere) X chophere = s; X size += (s - chophere); X s = chophere; X while (*chophere && index(chopset,*chophere)) X 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 (void)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 if (fcmd->f_flags & FC_CHOP) X str_chop(str,chophere); X break; X } X case F_LINES: X (void)eval(fcmd->f_expr,G_SCALAR,sp); X str = stack->ary_array[sp+1]; X s = str_get(str); X size = str_len(str); X CHKLEN(size); X orec->o_lines += countlines(s); X (void)bcopy(s,d,size); X d += size; X linebeg = fcmd->f_next; 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,sp) Xstruct outrec *orec; Xregister STIO *stio; Xint sp; X{ X FILE *ofp = stio->ofp; X X#ifdef DEBUGGING X if (debug & 256) X fprintf(stderr,"left=%ld, todo=%ld\n", X (long)stio->lines_left, (long)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 || !stab_form(topstab)) { X stio->lines_left = 100000000; X goto forget_top; X } X stio->top_stab = topstab; X } X if (stio->lines_left >= 0 && stio->page > 0) X (void)putc('\f',ofp); X stio->lines_left = stio->page_len; X stio->page++; X format(&toprec,stab_form(stio->top_stab),sp); 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 x2p/a2p.man sed >x2p/a2p.man <<'!STUFFY!FUNK!' -e 's/X//' X.rn '' }` X''' $Header: a2p.man,v 3.0 89/10/18 15:34:22 lwall Locked $ X''' X''' $Log: a2p.man,v $ X''' Revision 3.0 89/10/18 15:34:22 lwall X''' 3.0 baseline X''' X''' Revision 2.0.1.1 88/07/11 23:16:25 root X''' patch2: changes related to 1985 awk X''' X''' Revision 2.0 88/06/05 00:15:36 root X''' Baseline version 2.0. 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 \(*W-|\(bv\*(Tr X.ie n \{\ X.ds -- \(*W- X.if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch X.if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\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 can be used 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 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. XYou might want to run at least once with the \-w switch to perl, which Xwill warn you if you use == where you should have used eq. 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 using the keys() function, but Xiteration over a numeric array is NOT. XYou might need to modify any loop that is iterating over the array in question. 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 XFor aesthetic reasons you may wish to change the array base $[ from 1 back Xto perl's 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 passed Xthrough unmodified. 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.PP XScripts that refer to the special variables RSTART and RLENGTH can often Xbe simplified by referring to the variables $`, $& and $', as long as they Xare within the scope of the pattern match that sets them. X.PP XThe produced perl script may have subroutines defined to deal with awk's Xsemantics regarding getline and print. XSince a2p usually picks correctness over efficiency. Xit is almost always possible to rewrite such code to be more efficient by Xdiscarding the semantic sugar. X.PP XFor efficiency, you may wish to remove the keyword from any return statement Xthat is the last statement executed in a subroutine. XA2p catches the most common case, but doesn't analyze embedded blocks for Xsubtler cases. X.PP XARGV[0] translates to $ARGV0, but ARGV[n] translates to $ARGV[$n]. XA loop that tries to iterate over ARGV[0] won't find it. X.SH ENVIRONMENT XA2p uses no environment variables. X.SH AUTHOR XLarry Wall <lwall@jpl-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.h sed >x2p/a2p.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: a2p.h,v 3.0 89/10/18 15:34:14 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: a2p.h,v $ X * Revision 3.0 89/10/18 15:34:14 lwall X * 3.0 baseline X * X */ X X#define VOIDUSED 1 X#include "../config.h" X X#ifndef BCOPY X# define bcopy(s1,s2,l) memcpy(s2,s1,l); X# define bzero(s,l) memset(s,0,l); X#endif 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 OSUBTRACT 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#define ODO 70 X#define OPOW 71 X#define OSUB 72 X#define OGSUB 73 X#define OMATCH 74 X#define OUSERFUN 75 X#define OUSERDEF 76 X#define OCLOSE 77 X#define OATAN2 78 X#define OSIN 79 X#define OCOS 80 X#define ORAND 81 X#define OSRAND 82 X#define ODELETE 83 X#define OSYSTEM 84 X#define OCOND 85 X#define ORETURN 86 X#define ODEFINED 87 X#define OSTAR 88 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 "SUBTRACT", 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 "DO", X "POW", X "SUB", X "GSUB", X "MATCH", X "USERFUN", X "USERDEF", X "CLOSE", X "ATAN2", X "SIN", X "COS", X "RAND", X "SRAND", X "DELETE", X "SYSTEM", X "COND", X "RETURN", X "DEFINED", X "STAR", X "89" X}; X#else Xextern char *opname[]; X#endif X XEXT int mop INIT(1); X X#define OPSMAX 50000 Xunion { X int ival; X char *cval; X} ops[OPSMAX]; /* hope they have 200k to spare */ X X#define DEBUGGING X X#include <stdio.h> X#include <ctype.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 1 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); XEXT bool saw_altinput 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; XEXT HASH *curarghash; X X#define P_MIN 0 X#define P_LISTOP 5 X#define P_COMMA 10 X#define P_ASSIGN 15 X#define P_COND 20 X#define P_DOTDOT 25 X#define P_OROR 30 X#define P_ANDAND 35 X#define P_OR 40 X#define P_AND 45 X#define P_EQ 50 X#define P_REL 55 X#define P_UNI 60 X#define P_FILETEST 65 X#define P_SHIFT 70 X#define P_ADD 75 X#define P_MUL 80 X#define P_MATCH 85 X#define P_UNARY 90 X#define P_POW 95 X#define P_AUTO 100 X#define P_MAX 999 !STUFFY!FUNK! echo Extracting stab.h sed >stab.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: stab.h,v 3.0 89/10/18 15:23:30 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: stab.h,v $ X * Revision 3.0 89/10/18 15:23:30 lwall X * 3.0 baseline X * X */ X Xstruct stabptrs { X char stbp_magic[4]; X STR *stbp_val; /* scalar value */ X struct stio *stbp_io; /* filehandle value */ X FCMD *stbp_form; /* format value */ X ARRAY *stbp_array; /* array value */ X HASH *stbp_hash; /* associative array value */ X SUBR *stbp_sub; /* subroutine value */ X int stbp_lastexpr; /* used by nothing_in_common() */ X line_t stbp_line; /* line first declared at (for -w) */ X char stbp_flags; X}; X X#define stab_magic(stab) (((STBP*)(stab->str_ptr))->stbp_magic) X#define stab_val(stab) (((STBP*)(stab->str_ptr))->stbp_val) X#define stab_io(stab) (((STBP*)(stab->str_ptr))->stbp_io) X#define stab_form(stab) (((STBP*)(stab->str_ptr))->stbp_form) X#define stab_xarray(stab) (((STBP*)(stab->str_ptr))->stbp_array) X#define stab_array(stab) (((STBP*)(stab->str_ptr))->stbp_array ? \ X ((STBP*)(stab->str_ptr))->stbp_array : \ X ((STBP*)(aadd(stab)->str_ptr))->stbp_array) X#define stab_xhash(stab) (((STBP*)(stab->str_ptr))->stbp_hash) X#define stab_hash(stab) (((STBP*)(stab->str_ptr))->stbp_hash ? \ X ((STBP*)(stab->str_ptr))->stbp_hash : \ X ((STBP*)(hadd(stab)->str_ptr))->stbp_hash) X#define stab_sub(stab) (((STBP*)(stab->str_ptr))->stbp_sub) X#define stab_lastexpr(stab) (((STBP*)(stab->str_ptr))->stbp_lastexpr) X#define stab_line(stab) (((STBP*)(stab->str_ptr))->stbp_line) X#define stab_flags(stab) (((STBP*)(stab->str_ptr))->stbp_flags) X#define stab_name(stab) (stab->str_magic->str_ptr) X X#define SF_VMAGIC 1 /* call routine to dereference STR val */ X#define SF_MULTI 2 /* seen more than once */ X Xstruct stio { X FILE *ifp; /* ifp and ofp are normally the same */ X FILE *ofp; /* but sockets need separate streams */ X#if defined(I_DIRENT) || defined(I_SYSDIR) X DIR *dirp; /* for opendir, readdir, etc */ X#endif X long lines; /* $. */ X long page; /* $% */ X long page_len; /* $= */ X long lines_left; /* $- */ X char *top_name; /* $^ */ X STAB *top_stab; /* $^ */ X char *fmt_name; /* $~ */ X STAB *fmt_stab; /* $~ */ X short subprocess; /* -| or |- */ X char type; X char flags; X}; X X#define IOF_ARGV 1 /* this fp iterates over ARGV */ X#define IOF_START 2 /* check for null ARGV and substitute '-' */ X#define IOF_FLUSH 4 /* this fp wants a flush after write op */ X Xstruct sub { X CMD *cmd; X char *filename; X long depth; /* >= 2 indicates recursive call */ X ARRAY *tosave; X}; X X#define Nullstab Null(STAB*) X X#define STAB_STR(s) (tmpstab = (s), stab_flags(tmpstab) & SF_VMAGIC ? stab_str(stab_val(tmpstab)->str_magic) : stab_val(tmpstab)) X#define STAB_GET(s) (tmpstab = (s), str_get(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab))) X#define STAB_GNUM(s) (tmpstab = (s), str_gnum(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab))) X XEXT STAB *tmpstab; X XEXT STAB *stab_index[128]; X XEXT unsigned short statusvalue; X XEXT int delaymagic INIT(0); X#define DM_DELAY 1 X#define DM_REUID 2 X#define DM_REGID 4 X XSTAB *aadd(); XSTAB *hadd(); !STUFFY!FUNK! echo "" echo "End of kit 20 (of 24)" cat /dev/null >kit20isdone run='' config='' for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24; do if test -f kit${iskit}isdone; then run="$run $iskit" else todo="$todo $iskit" fi done case $todo in '') echo "You have run all your kits. Please read README and then type Configure." chmod 755 Configure ;; *) echo "You have run$run." echo "You still need to run$todo." ;; esac : Someone might mail this, so... exit