From @uunet.uu.net:root@jpl-devvax.jpl.nasa.gov Sun Jun 5 04:26:20 1988 Received: from BBN.COM by pineapple.bbn.com id AA14493; Sun, 5 Jun 88 04:25:27 EDT Received: from uunet.uu.net by BBN.COM id aa22001; 5 Jun 88 4:25 EDT Received: from elroy.jpl.nasa.gov by uunet.UU.NET (5.54/1.14) id AA17223; Sun, 5 Jun 88 04:21:36 EDT Received: from devvax.Jpl.Nasa.Gov (jpl-devvax.jpl.nasa.gov) by elroy.Jpl.Nasa.Gov (4.0/SMI-3.2+DXR) id AA12971; Sun, 5 Jun 88 01:13:08 PDT Received: by devvax.Jpl.Nasa.Gov (5.51/4.7) id AA08266; Sun, 5 Jun 88 01:11:51 PDT Date: Sun, 5 Jun 88 01:11:51 PDT From: The Superuser Message-Id: <8806050811.AA08266@devvax.Jpl.Nasa.Gov> Apparently-To: rsalz@uunet.uu.net Status: R #! /bin/sh # Make a new directory for the perl sources, cd to it, and run kits 1 # thru 15 through sh. When all 15 kits have been run, read README. echo "This is perl 2.0 kit 12 (of 15). If kit 12 is complete, the line" echo '"'"End of kit 12 (of 15)"'" will echo at the end.' echo "" export PATH || (echo "You didn't use sh, you clunch." ; kill $$) mkdir t x2p 2>/dev/null echo Extracting arg.h sed >arg.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: arg.h,v 2.0 88/06/05 00:08:14 root Exp $ X * X * $Log: arg.h,v $ X * Revision 2.0 88/06/05 00:08:14 root X * Baseline version 2.0. 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 O_EVAL 105 X#define O_FTEREAD 106 X#define O_FTEWRITE 107 X#define O_FTEEXEC 108 X#define O_FTEOWNED 109 X#define O_FTRREAD 110 X#define O_FTRWRITE 111 X#define O_FTREXEC 112 X#define O_FTROWNED 113 X#define O_FTIS 114 X#define O_FTZERO 115 X#define O_FTSIZE 116 X#define O_FTFILE 117 X#define O_FTDIR 118 X#define O_FTLINK 119 X#define O_SYMLINK 120 X#define O_FTPIPE 121 X#define O_FTSOCK 122 X#define O_FTBLK 123 X#define O_FTCHR 124 X#define O_FTSUID 125 X#define O_FTSGID 126 X#define O_FTSVTX 127 X#define O_FTTTY 128 X#define O_DOFILE 129 X#define O_FTTEXT 130 X#define O_FTBINARY 131 X#define O_UTIME 132 X#define O_WAIT 133 X#define O_SORT 134 X#define O_DELETE 135 X#define O_STUDY 136 X#define MAXO 137 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 "EVAL", X "FTEREAD", X "FTEWRITE", X "FTEEXEC", X "FTEOWNED", X "FTRREAD", X "FTRWRITE", X "FTREXEC", X "FTROWNED", X "FTIS", X "FTZERO", X "FTSIZE", X "FTFILE", X "FTDIR", X "FTLINK", X "SYMLINK", X "FTPIPE", X "FTSOCK", X "FTBLK", X "FTCHR", X "FTSUID", X "FTSGID", X "FTSVTX", X "FTTTY", X "DOFILE", X "FTTEXT", X "FTBINARY", X "UTIME", X "WAIT", X "SORT", X "DELETE", X "STUDY", X "135" 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#define A_LARYLEN 13 X#define A_GLOB 14 X#define A_WORD 15 X#define A_INDREAD 16 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 "LARYLEN", X "GLOB", X "WORD", X "INDREAD", X "17" 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, 1, 0, 0, 0, 0}; X#endif X Xunion 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}; X Xstruct arg { X union argptr arg_ptr; X short arg_len; X unsigned char arg_type; X unsigned 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#define AF_LOCAL 128 /* list of local variables */ 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(); XSTR *do_push(); XFILE *nextargv(); XSTR *do_fttext(); !STUFFY!FUNK! echo Extracting x2p/a2p.y sed >x2p/a2p.y <<'!STUFFY!FUNK!' -e 's/X//' X%{ X/* $Header: a2p.y,v 2.0 88/06/05 00:15:38 root Exp $ X * X * $Log: a2p.y,v $ X * Revision 2.0 88/06/05 00:15:38 root X * Baseline version 2.0. 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 '{' maybe states '}' junk X { $$ = oper3(OJUNK,$3,$4,$6); in_begin = FALSE; } X | /* NULL */ X { $$ = Nullop; } X ; X Xend : END '{' maybe states '}' X { $$ = oper2(OJUNK,$3,$4); } 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 '{' maybe states '}' X { $$ = oper2(OHUNK,$1,oper2(OJUNK,$3,$4)); } X | '{' maybe states '}' X { $$ = oper2(OHUNK,Nullop,oper2(OJUNK,$2,$3)); } 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,oper1(OREGEX,$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 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 Xmaybe : maybe nlstuff X { $$ = oper2(OJUNK,$1,$2); } X | /* NULL */ X { $$ = Nullop; } X ; X Xnlstuff : NEWLINE X { $$ = oper0(ONEWLINE); } X | COMMENT X { $$ = oper1(OCOMMENT,$1); } X ; X Xseparator X : ';' maybe X { $$ = oper2(OJUNK,oper0(OSEMICOLON),$2); } X | SEMINEW maybe X { $$ = oper2(OJUNK,oper0(OSNEWLINE),$2); } X | NEWLINE maybe X { $$ = oper2(OJUNK,oper0(OSNEWLINE),$2); } X | COMMENT maybe X { $$ = oper2(OJUNK,oper1(OSCOMMENT,$1),$2); } X ; X Xstates : states statement X { $$ = oper2(OSTATES,$1,$2); } X | /* NULL */ X { $$ = Nullop; } X ; X Xstatement X : simple separator maybe X { $$ = oper2(OJUNK,oper2(OSTATE,$1,$2),$3); } X | ';' maybe X { $$ = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSEMICOLON),$2)); } X | SEMINEW maybe X { $$ = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSNEWLINE),$2)); } X | compound X ; X Xsimpnull: simple X | /* NULL */ X { $$ = Nullop; } 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 ; 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 '(' simpnull ';' cond ';' simpnull ')' maybe statement X { $$ = oper4(OFOR,$3,$5,$7,bl($10,$9)); } X | FOR '(' simpnull ';' ';' simpnull ')' 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 | '{' maybe states '}' maybe X { $$ = oper3(OBLOCK,oper2(OJUNK,$2,$3),Nullop,$5); } X ; X X%% X#include "a2py.c" !STUFFY!FUNK! echo Extracting x2p/a2p.man sed >x2p/a2p.man <<'!STUFFY!FUNK!' -e 's/X//' X.rn '' }` X''' $Header: a2p.man,v 2.0 88/06/05 00:15:36 root Exp $ X''' X''' $Log: a2p.man,v $ 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 Xsets debugging flags. X.TP 5 X.B \-F Xtells a2p that this awk script is always invoked with this -F switch. X.TP 5 X.B \-n 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 \- 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 \-, 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 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 dump.c sed >dump.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: dump.c,v 2.0 88/06/05 00:08:44 root Exp $ X * X * $Log: dump.c,v $ X * Revision 2.0 88/06/05 00:08:44 root X * Baseline version 2.0. X * X */ X X#include "EXTERN.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_line) X dump("C_LINE = %d\n",cmd->c_line); 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_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_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_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 } 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 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\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 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) { 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 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_flags(b,flags) Xchar *b; Xunsigned flags; X{ X *b = '\0'; X if (flags & AF_SPECIAL) X strcat(b,"SPECIAL,"); X if (flags & AF_POST) X strcat(b,"POST,"); X if (flags & AF_PRE) X strcat(b,"PRE,"); X if (flags & AF_UP) X strcat(b,"UP,"); X if (flags & AF_COMMON) X strcat(b,"COMMON,"); X if (flags & AF_NUMERIC) X strcat(b,"NUMERIC,"); X if (flags & AF_LISTISH) X strcat(b,"LISTISH,"); X if (flags & AF_LOCAL) X 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->stab_name); 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 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 perl.h sed >perl.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: perl.h,v 2.0 88/06/05 00:09:21 root Exp $ X * X * $Log: perl.h,v $ X * Revision 2.0 88/06/05 00:09:21 root X * Baseline version 2.0. X * X */ X X#ifndef lint X#define DEBUGGING X#endif X X#define VOIDUSED 1 X#include "config.h" X X#ifdef MEMCPY Xextern char *memcpy(), *memset(); X#define bcopy(s1,s2,l) memcpy(s2,s1,l); X#define bzero(s,l) memset(s,0,l); X#endif X X#include X#include X#include X#include /* if this needs types.h we're still wrong */ X X#ifndef _TYPES_ /* If types.h defines this it's easy. */ X#ifndef major /* Does everyone's types.h define this? */ X#include X#endif X#endif X X#include X X#ifdef TMINSYS X#include X#else X#include X#endif X X#include X Xtypedef struct arg ARG; Xtypedef struct cmd CMD; Xtypedef struct formcmd FCMD; Xtypedef struct scanpat SPAT; Xtypedef struct stab STAB; Xtypedef struct stio STIO; Xtypedef struct sub SUBR; Xtypedef struct string STR; Xtypedef struct atbl ARRAY; Xtypedef struct htbl HASH; Xtypedef struct regexp REGEXP; X X#include "handy.h" X#include "regexp.h" X#include "str.h" X#include "util.h" X#include "form.h" X#include "stab.h" X#include "spat.h" X#include "arg.h" X#include "cmd.h" X#include "array.h" X#include "hash.h" X X#ifdef CHARSPRINTF X char *sprintf(); X#else X int sprintf(); X#endif 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#ifdef DEBUGGING X#define str_peek(str) (Str = (str), (Str->str_pok ? Str->str_ptr : (Str->str_nok ? (sprintf(buf,"num(%g)",Str->str_nval),(char*)buf) : "" ))) X#endif X 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 XCMD *add_label(); XCMD *block_head(); XCMD *append_line(); XCMD *make_acmd(); XCMD *make_ccmd(); XCMD *invert(); XCMD *addcond(); XCMD *addloop(); XCMD *wopt(); XCMD *over(); X XSPAT *stab2spat(); X XSTAB *stabent(); XSTAB *genstab(); X XARG *stab2arg(); XARG *op_new(); XARG *make_op(); XARG *make_lval(); XARG *make_match(); XARG *make_split(); XARG *flipflip(); XARG *listish(); XARG *localize(); XARG *l(); XARG *mod_match(); XARG *make_list(); XARG *cmd_to_arg(); XARG *addflags(); XARG *hide_ary(); XARG *cval_to_arg(); X XSTR *arg_to_str(); XSTR *str_new(); XSTR *stab_str(); XSTR *eval(); /* this evaluates expressions */ XSTR *do_eval(); /* this evaluates eval operator */ XSTR *do_each(); XSTR *do_subr(); XSTR *do_match(); X XSUBR *make_sub(); X XFCMD *load_format(); X Xchar *scanpat(); Xchar *scansubst(); Xchar *scantrans(); Xchar *scanstr(); Xchar *scanreg(); Xchar *reg_get(); Xchar *str_append_till(); Xchar *str_gets(); X Xbool do_open(); Xbool do_close(); Xbool do_print(); Xbool do_aprint(); Xbool do_exec(); Xbool do_aexec(); X Xint do_subst(); Xint cando(); Xint ingroup(); X Xvoid str_grow(); Xvoid str_replace(); Xvoid str_inc(); Xvoid str_dec(); Xvoid str_free(); Xvoid freearg(); Xvoid savelist(); Xvoid restorelist(); Xvoid ajoin(); Xvoid do_join(); Xvoid do_assign(); Xvoid do_sprintf(); X XEXT line_t line INIT(0); XEXT int arybase INIT(0); X Xstruct outrec { X line_t o_lines; X char *o_str; X int o_len; X}; X XEXT struct outrec outrec; XEXT struct outrec toprec; X XEXT STAB *last_in_stab INIT(Nullstab); XEXT STAB *defstab INIT(Nullstab); XEXT STAB *argvstab INIT(Nullstab); XEXT STAB *envstab INIT(Nullstab); XEXT STAB *sigstab INIT(Nullstab); XEXT STAB *defoutstab INIT(Nullstab); XEXT STAB *curoutstab INIT(Nullstab); XEXT STAB *argvoutstab INIT(Nullstab); XEXT STAB *incstab INIT(Nullstab); X XEXT STR *freestrroot INIT(Nullstr); XEXT STR *lastretstr INIT(Nullstr); X XEXT char *filename; XEXT char *origfilename; XEXT FILE *rsfp; XEXT char buf[1024]; XEXT char *bufptr INIT(buf); X XEXT STR *linestr INIT(Nullstr); X XEXT char record_separator INIT('\n'); XEXT char *ofs INIT(Nullch); XEXT char *ors INIT(Nullch); XEXT char *ofmt INIT(Nullch); XEXT char *inplace INIT(Nullch); X XEXT bool preprocess INIT(FALSE); XEXT bool minus_n INIT(FALSE); XEXT bool minus_p INIT(FALSE); XEXT bool minus_a INIT(FALSE); XEXT bool doswitches INIT(FALSE); XEXT bool dowarn INIT(FALSE); XEXT bool allstabs INIT(FALSE); /* init all customary symbols in symbol table?*/ XEXT bool sawampersand INIT(FALSE); /* must save all match strings */ XEXT bool sawstudy INIT(FALSE); /* do fbminstr on all strings */ X X#define TMPPATH "/tmp/perl-eXXXXXX" XEXT char *e_tmpname; XEXT FILE *e_fp INIT(Nullfp); X XEXT char tokenbuf[256]; XEXT int expectterm INIT(TRUE); XEXT int lex_newlines INIT(FALSE); XEXT int in_eval INIT(FALSE); XEXT int multiline INIT(0); XEXT int forkprocess; X XFILE *popen(); X/* char *str_get(); */ XSTR *interp(); Xvoid free_arg(); XSTIO *stio_new(); X XEXT struct stat statbuf; XEXT struct tms timesbuf; XEXT int uid; XEXT int euid; XUIDTYPE getuid(); XUIDTYPE geteuid(); XGIDTYPE getgid(); XGIDTYPE getegid(); XEXT int unsafe; X X#ifdef DEBUGGING XEXT int debug INIT(0); XEXT int dlevel INIT(0); XEXT char debname[128]; XEXT char debdelim[128]; X#define YYDEBUG 1 Xextern int yydebug; X#endif X XEXT line_t cmdline INIT(NOLINE); X XEXT STR str_no; XEXT STR str_yes; X X/* runtime control stuff */ X XEXT struct loop { X char *loop_label; X jmp_buf loop_env; X} loop_stack[64]; X XEXT int loop_ptr INIT(-1); X XEXT jmp_buf top_env; XEXT jmp_buf eval_env; X XEXT char *goto_targ INIT(Nullch); /* cmd_exec gets strange when set */ X XEXT ARRAY *savestack; /* to save non-local values on */ X XEXT ARRAY *tosave; /* strings to save on recursive subroutine */ X Xdouble atof(); Xunsigned sleep(); Xlong time(), times(); Xstruct tm *gmtime(), *localtime(); Xchar *mktemp(); Xchar *index(), *rindex(); Xchar *strcpy(), *strcat(); X X#ifdef EUNICE X#define UNLINK unlnk Xint unlnk(); X#else X#define UNLINK unlink X#endif !STUFFY!FUNK! echo Extracting form.c sed >form.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: form.c,v 2.0 88/06/05 00:08:57 root Exp $ X * X * $Log: form.c,v $ X * Revision 2.0 88/06/05 00:08:57 root X * Baseline version 2.0. X * X */ X X#include "EXTERN.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(STR***),-1); 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(STR***),-1)); 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(STR***),-1)); 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(STR***),-1); 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=%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 || !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 hash.c sed >hash.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: hash.c,v 2.0 88/06/05 00:09:06 root Exp $ X * X * $Log: hash.c,v $ X * Revision 2.0 88/06/05 00:09:06 root X * Baseline version 2.0. X * X */ X X#include "EXTERN.h" X#include "perl.h" X XSTR * Xhfetch(tb,key) Xregister HASH *tb; Xchar *key; X{ X register char *s; X register int i; X register int hash; X register HENT *entry; X X if (!tb) X return Nullstr; X for (s=key, i=0, hash = 0; X /* while */ *s && i < COEFFSIZE; X s++, i++, hash *= 5) { X hash += *s * coeff[i]; X } X entry = tb->tbl_array[hash & tb->tbl_max]; X for (; entry; entry = entry->hent_next) { X if (entry->hent_hash != hash) /* strings can't be equal */ X continue; X if (strNE(entry->hent_key,key)) /* is this it? */ X continue; X return entry->hent_val; X } X return Nullstr; X} X Xbool Xhstore(tb,key,val) Xregister HASH *tb; Xchar *key; XSTR *val; X{ X register char *s; X register int i; X register int hash; X register HENT *entry; X register HENT **oentry; X X if (!tb) X return FALSE; X for (s=key, i=0, hash = 0; X /* while */ *s && i < COEFFSIZE; X s++, i++, hash *= 5) { X hash += *s * coeff[i]; X } X X oentry = &(tb->tbl_array[hash & tb->tbl_max]); X i = 1; X X for (entry = *oentry; entry; i=0, entry = entry->hent_next) { X if (entry->hent_hash != hash) /* strings can't be equal */ X continue; X if (strNE(entry->hent_key,key)) /* is this it? */ X continue; X safefree((char*)entry->hent_val); X entry->hent_val = val; X return TRUE; X } X entry = (HENT*) safemalloc(sizeof(HENT)); X X entry->hent_key = savestr(key); X entry->hent_val = val; X entry->hent_hash = hash; X entry->hent_next = *oentry; X *oentry = entry; X X if (i) { /* initial entry? */ X tb->tbl_fill++; X if ((tb->tbl_fill * 100 / (tb->tbl_max + 1)) > FILLPCT) X hsplit(tb); X } X X return FALSE; X} X XSTR * Xhdelete(tb,key) Xregister HASH *tb; Xchar *key; X{ X register char *s; X register int i; X register int hash; X register HENT *entry; X register HENT **oentry; X STR *str; X X if (!tb) X return Nullstr; X for (s=key, i=0, hash = 0; X /* while */ *s && i < COEFFSIZE; X s++, i++, hash *= 5) { X hash += *s * coeff[i]; X } X X oentry = &(tb->tbl_array[hash & tb->tbl_max]); X entry = *oentry; X i = 1; X for (; entry; i=0, oentry = &entry->hent_next, entry = *oentry) { X if (entry->hent_hash != hash) /* strings can't be equal */ X continue; X if (strNE(entry->hent_key,key)) /* is this it? */ X continue; X *oentry = entry->hent_next; X str = str_static(entry->hent_val); X hentfree(entry); X if (i) X tb->tbl_fill--; X return str; X } X return Nullstr; X} X Xhsplit(tb) XHASH *tb; X{ X int oldsize = tb->tbl_max + 1; X register int newsize = oldsize * 2; X register int i; X register HENT **a; X register HENT **b; X register HENT *entry; X register HENT **oentry; X X a = (HENT**) saferealloc((char*)tb->tbl_array, newsize * sizeof(HENT*)); X bzero((char*)&a[oldsize], oldsize * sizeof(HENT*)); /* zero second half */ X tb->tbl_max = --newsize; X tb->tbl_array = a; X X for (i=0; ihent_hash & newsize) != i) { X *oentry = entry->hent_next; X entry->hent_next = *b; X if (!*b) X tb->tbl_fill++; X *b = entry; X continue; X } X else X oentry = &entry->hent_next; X } X if (!*a) /* everything moved */ X tb->tbl_fill--; X } X} X XHASH * Xhnew() X{ X register HASH *tb = (HASH*)safemalloc(sizeof(HASH)); X X tb->tbl_array = (HENT**) safemalloc(8 * sizeof(HENT*)); X tb->tbl_fill = 0; X tb->tbl_max = 7; X hiterinit(tb); /* so each() will start off right */ X bzero((char*)tb->tbl_array, 8 * sizeof(HENT*)); X return tb; X} X Xvoid Xhentfree(hent) Xregister HENT *hent; X{ X if (!hent) X return; X str_free(hent->hent_val); X safefree(hent->hent_key); X safefree((char*)hent); X} X Xvoid Xhclear(tb) Xregister HASH *tb; X{ X register HENT *hent; X register HENT *ohent = Null(HENT*); X X if (!tb) X return; X hiterinit(tb); X while (hent = hiternext(tb)) { /* concise but not very efficient */ X hentfree(ohent); X ohent = hent; X } X hentfree(ohent); X tb->tbl_fill = 0; X bzero((char*)tb->tbl_array, (tb->tbl_max + 1) * sizeof(HENT*)); X} X X#ifdef NOTUSED Xvoid Xhfree(tb) XHASH *tb; X{ X if (!tb) X return X hiterinit(tb); X while (hent = hiternext(tb)) { X hentfree(ohent); X ohent = hent; X } X hentfree(ohent); X safefree((char*)tb->tbl_array); X safefree((char*)tb); X} X#endif X X#ifdef NOTUSED Xhshow(tb) Xregister HASH *tb; X{ X fprintf(stderr,"%5d %4d (%2d%%)\n", X tb->tbl_max+1, X tb->tbl_fill, X tb->tbl_fill * 100 / (tb->tbl_max+1)); X} X#endif X Xhiterinit(tb) Xregister HASH *tb; X{ X tb->tbl_riter = -1; X tb->tbl_eiter = Null(HENT*); X return tb->tbl_fill; X} X XHENT * Xhiternext(tb) Xregister HASH *tb; X{ X register HENT *entry; X X entry = tb->tbl_eiter; X do { X if (entry) X entry = entry->hent_next; X if (!entry) { X tb->tbl_riter++; X if (tb->tbl_riter > tb->tbl_max) { X tb->tbl_riter = -1; X break; X } X entry = tb->tbl_array[tb->tbl_riter]; X } X } while (!entry); X X tb->tbl_eiter = entry; X return entry; X} X Xchar * Xhiterkey(entry) Xregister HENT *entry; X{ X return entry->hent_key; X} X XSTR * Xhiterval(entry) Xregister HENT *entry; X{ X return entry->hent_val; X} !STUFFY!FUNK! echo Extracting t/io.fs sed >t/io.fs <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: io.fs,v 2.0 88/06/05 00:12:59 root Exp $ X Xprint "1..22\n"; X X$wd = `pwd`; Xchop($wd); X X`rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`; Xchdir './tmp'; X`/bin/rm -rf a b c x`; X Xumask(022); X Xif (umask(0) == 022) {print "ok 1\n";} else {print "not ok 1\n";} Xopen(fh,'>x') || die "Can't create x"; Xclose(fh); Xopen(fh,'>a') || die "Can't create a"; Xclose(fh); X Xif (link('a','b')) {print "ok 2\n";} else {print "not ok 2\n";} X Xif (link('b','c')) {print "ok 3\n";} else {print "not ok 3\n";} X X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, X $blksize,$blocks) = stat('c'); X Xif ($nlink == 3) {print "ok 4\n";} else {print "not ok 4\n";} Xif (($mode & 0777) == 0666) {print "ok 5\n";} else {print "not ok 5\n";} X Xif ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";} X X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, X $blksize,$blocks) = stat('c'); Xif (($mode & 0777) == 0777) {print "ok 7\n";} else {print "not ok 7\n";} X Xif ((chmod 0700,'c','x') == 2) {print "ok 8\n";} else {print "not ok 8\n";} X X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, X $blksize,$blocks) = stat('c'); Xif (($mode & 0777) == 0700) {print "ok 9\n";} else {print "not ok 9\n";} X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, X $blksize,$blocks) = stat('x'); Xif (($mode & 0777) == 0700) {print "ok 10\n";} else {print "not ok 10\n";} X Xif ((unlink 'b','x') == 2) {print "ok 11\n";} else {print "not ok 11\n";} X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, X $blksize,$blocks) = stat('b'); Xif ($ino == 0) {print "ok 12\n";} else {print "not ok 12\n";} X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, X $blksize,$blocks) = stat('x'); Xif ($ino == 0) {print "ok 13\n";} else {print "not ok 13\n";} X Xif (rename('a','b')) {print "ok 14\n";} else {print "not ok 14\n";} X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, X $blksize,$blocks) = stat('a'); Xif ($ino == 0) {print "ok 15\n";} else {print "not ok 15\n";} X$foo = (utime 0,1,'b'); Xif ($foo == 1) {print "ok 16\n";} else {print "not ok 16 $foo\n";} X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, X $blksize,$blocks) = stat('b'); Xif ($ino) {print "ok 17\n";} else {print "not ok 17\n";} Xif ($atime == 0 && $mtime == 1) {print "ok 18\n";} else {print "not ok 18 $atime $mtime\n";} X Xif ((unlink 'b') == 1) {print "ok 19\n";} else {print "not ok 19\n";} X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, X $blksize,$blocks) = stat('b'); Xif ($ino == 0) {print "ok 20\n";} else {print "not ok 20\n";} Xunlink 'c'; X Xchdir $wd || die "Can't cd back to $wd"; X Xunlink 'c'; Xif (`ls -l perl 2>/dev/null` =~ /^l.*->/) { # we have symbolic links X if (symlink("TEST","c")) {print "ok 21\n";} else {print "not ok 21\n";} X $foo = `grep perl c`; X if ($foo) {print "ok 22\n";} else {print "not ok 22\n";} X} Xelse { X print "ok 21\nok 22\n"; X} !STUFFY!FUNK! echo Extracting patchlevel.h sed >patchlevel.h <<'!STUFFY!FUNK!' -e 's/X//' X#define PATCHLEVEL 0 !STUFFY!FUNK! echo "" echo "End of kit 12 (of 15)" cat /dev/null >kit12isdone run='' config='' for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15; 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