rsalz@uunet.uu.net (Rich Salz) (07/12/88)
Submitted-by: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Posting-number: Volume 15, Issue 96
Archive-name: perl2/part07
#! /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 7 (of 15). If kit 7 is complete, the line"
echo '"'"End of kit 7 (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 x2p/walk.c
sed >x2p/walk.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: walk.c,v 2.0 88/06/05 00:16:12 root Exp $
X *
X * $Log: walk.c,v $
X * Revision 2.0 88/06/05 00:16:12 root
X * Baseline version 2.0.
X *
X */
X
X#include "handy.h"
X#include "EXTERN.h"
X#include "util.h"
X#include "a2p.h"
X
Xbool exitval = FALSE;
Xbool realexit = FALSE;
Xbool saw_getline = FALSE;
Xint maxtmp = 0;
Xchar *lparen;
Xchar *rparen;
X
XSTR *
Xwalk(useval,level,node,numericptr)
Xint useval;
Xint level;
Xregister int node;
Xint *numericptr;
X{
X register int len;
X register STR *str;
X register int type;
X register int i;
X register STR *tmpstr;
X STR *tmp2str;
X char *t;
X char *d, *s;
X int numarg;
X int numeric = FALSE;
X STR *fstr;
X char *index();
X
X if (!node) {
X *numericptr = 0;
X return str_make("");
X }
X type = ops[node].ival;
X len = type >> 8;
X type &= 255;
X switch (type) {
X case OPROG:
X str = walk(0,level,ops[node+1].ival,&numarg);
X opens = str_new(0);
X if (do_split && need_entire && !absmaxfld)
X split_to_array = TRUE;
X if (do_split && split_to_array)
X set_array_base = TRUE;
X if (set_array_base) {
X str_cat(str,"$[ = 1;\t\t\t# set array base to 1\n");
X }
X if (fswitch && !const_FS)
X const_FS = fswitch;
X if (saw_FS > 1 || saw_RS)
X const_FS = 0;
X if (saw_ORS && need_entire)
X do_chop = TRUE;
X if (fswitch) {
X str_cat(str,"$FS = '");
X if (index("*+?.[]()|^$\\",fswitch))
X str_cat(str,"\\");
X sprintf(tokenbuf,"%c",fswitch);
X str_cat(str,tokenbuf);
X str_cat(str,"';\t\t# field separator from -F switch\n");
X }
X else if (saw_FS && !const_FS) {
X str_cat(str,"$FS = ' ';\t\t# set field separator\n");
X }
X if (saw_OFS) {
X str_cat(str,"$, = ' ';\t\t# set output field separator\n");
X }
X if (saw_ORS) {
X str_cat(str,"$\\ = \"\\n\";\t\t# set output record separator\n");
X }
X if (str->str_cur > 20)
X str_cat(str,"\n");
X if (ops[node+2].ival) {
X str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X str_cat(str,"\n\n");
X }
X if (saw_line_op)
X str_cat(str,"line: ");
X str_cat(str,"while (<>) {\n");
X tab(str,++level);
X if (saw_FS && !const_FS)
X do_chop = TRUE;
X if (do_chop) {
X str_cat(str,"chop;\t# strip record separator\n");
X tab(str,level);
X }
X arymax = 0;
X if (namelist) {
X while (isalpha(*namelist)) {
X for (d = tokenbuf,s=namelist;
X isalpha(*s) || isdigit(*s) || *s == '_';
X *d++ = *s++) ;
X *d = '\0';
X while (*s && !isalpha(*s)) s++;
X namelist = s;
X nameary[++arymax] = savestr(tokenbuf);
X }
X }
X if (maxfld < arymax)
X maxfld = arymax;
X if (do_split)
X emit_split(str,level);
X str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg));
X str_free(fstr);
X fixtab(str,--level);
X str_cat(str,"}\n");
X if (ops[node+4].ival) {
X realexit = TRUE;
X str_cat(str,"\n");
X tab(str,level);
X str_scat(str,fstr=walk(0,level,ops[node+4].ival,&numarg));
X str_free(fstr);
X str_cat(str,"\n");
X }
X if (exitval)
X str_cat(str,"exit ExitValue;\n");
X if (saw_getline) {
X str_cat(str,"\nsub Getline {\n $_ = <>;\n");
X tab(str,++level);
X if (do_chop) {
X str_cat(str,"chop;\t# strip record separator\n");
X tab(str,level);
X }
X if (do_split)
X emit_split(str,level);
X fixtab(str,--level);
X str_cat(str,"}\n");
X }
X if (do_fancy_opens) {
X str_cat(str,"\n\
Xsub Pick {\n\
X ($name) = @_;\n\
X $fh = $opened{$name};\n\
X if (!$fh) {\n\
X $nextfh == 0 && open(fh_0,$name);\n\
X $nextfh == 1 && open(fh_1,$name);\n\
X $nextfh == 2 && open(fh_2,$name);\n\
X $nextfh == 3 && open(fh_3,$name);\n\
X $nextfh == 4 && open(fh_4,$name);\n\
X $nextfh == 5 && open(fh_5,$name);\n\
X $nextfh == 6 && open(fh_6,$name);\n\
X $nextfh == 7 && open(fh_7,$name);\n\
X $nextfh == 8 && open(fh_8,$name);\n\
X $nextfh == 9 && open(fh_9,$name);\n\
X $fh = $opened{$name} = 'fh_' . $nextfh++;\n\
X }\n\
X select($fh);\n\
X}\n\
X");
X }
X break;
X case OHUNKS:
X str = walk(0,level,ops[node+1].ival,&numarg);
X str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X if (len == 3) {
X str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg));
X str_free(fstr);
X }
X else {
X }
X break;
X case ORANGE:
X str = walk(1,level,ops[node+1].ival,&numarg);
X str_cat(str," .. ");
X str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X break;
X case OPAT:
X goto def;
X case OREGEX:
X str = str_new(0);
X str_set(str,"/");
X tmpstr=walk(0,level,ops[node+1].ival,&numarg);
X /* translate \nnn to [\nnn] */
X for (s = tmpstr->str_ptr, d = tokenbuf; *s; s++, d++) {
X if (*s == '\\' && isdigit(s[1]) && isdigit(s[2]) && isdigit(s[3])) {
X *d++ = '[';
X *d++ = *s++;
X *d++ = *s++;
X *d++ = *s++;
X *d++ = *s;
X *d = ']';
X }
X else
X *d = *s;
X }
X *d = '\0';
X for (d=tokenbuf; *d; d++)
X *d += 128;
X str_cat(str,tokenbuf);
X str_free(tmpstr);
X str_cat(str,"/");
X break;
X case OHUNK:
X if (len == 1) {
X str = str_new(0);
X str = walk(0,level,oper1(OPRINT,0),&numarg);
X str_cat(str," if ");
X str_scat(str,fstr=walk(0,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X str_cat(str,";");
X }
X else {
X tmpstr = walk(0,level,ops[node+1].ival,&numarg);
X if (*tmpstr->str_ptr) {
X str = str_new(0);
X str_set(str,"if (");
X str_scat(str,tmpstr);
X str_cat(str,") {\n");
X tab(str,++level);
X str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X fixtab(str,--level);
X str_cat(str,"}\n");
X tab(str,level);
X }
X else {
X str = walk(0,level,ops[node+2].ival,&numarg);
X }
X }
X break;
X case OPPAREN:
X str = str_new(0);
X str_set(str,"(");
X str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X str_cat(str,")");
X break;
X case OPANDAND:
X str = walk(1,level,ops[node+1].ival,&numarg);
X str_cat(str," && ");
X str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X break;
X case OPOROR:
X str = walk(1,level,ops[node+1].ival,&numarg);
X str_cat(str," || ");
X str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X break;
X case OPNOT:
X str = str_new(0);
X str_set(str,"!");
X str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X break;
X case OCPAREN:
X str = str_new(0);
X str_set(str,"(");
X str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X numeric |= numarg;
X str_cat(str,")");
X break;
X case OCANDAND:
X str = walk(1,level,ops[node+1].ival,&numarg);
X numeric = 1;
X str_cat(str," && ");
X str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X break;
X case OCOROR:
X str = walk(1,level,ops[node+1].ival,&numarg);
X numeric = 1;
X str_cat(str," || ");
X str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X break;
X case OCNOT:
X str = str_new(0);
X str_set(str,"!");
X str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X numeric = 1;
X break;
X case ORELOP:
X str = walk(1,level,ops[node+2].ival,&numarg);
X numeric |= numarg;
X tmpstr = walk(0,level,ops[node+1].ival,&numarg);
X tmp2str = walk(1,level,ops[node+3].ival,&numarg);
X numeric |= numarg;
X if (!numeric) {
X t = tmpstr->str_ptr;
X if (strEQ(t,"=="))
X str_set(tmpstr,"eq");
X else if (strEQ(t,"!="))
X str_set(tmpstr,"ne");
X else if (strEQ(t,"<"))
X str_set(tmpstr,"lt");
X else if (strEQ(t,"<="))
X str_set(tmpstr,"le");
X else if (strEQ(t,">"))
X str_set(tmpstr,"gt");
X else if (strEQ(t,">="))
X str_set(tmpstr,"ge");
X if (!index(tmpstr->str_ptr,'\'') && !index(tmpstr->str_ptr,'"') &&
X !index(tmp2str->str_ptr,'\'') && !index(tmp2str->str_ptr,'"') )
X numeric |= 2;
X }
X if (numeric & 2) {
X if (numeric & 1) /* numeric is very good guess */
X str_cat(str," ");
X else
X str_cat(str,"\377");
X numeric = 1;
X }
X else
X str_cat(str," ");
X str_scat(str,tmpstr);
X str_free(tmpstr);
X str_cat(str," ");
X str_scat(str,tmp2str);
X str_free(tmp2str);
X numeric = 1;
X break;
X case ORPAREN:
X str = str_new(0);
X str_set(str,"(");
X str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X numeric |= numarg;
X str_cat(str,")");
X break;
X case OMATCHOP:
X str = walk(1,level,ops[node+2].ival,&numarg);
X str_cat(str," ");
X tmpstr = walk(0,level,ops[node+1].ival,&numarg);
X if (strEQ(tmpstr->str_ptr,"~"))
X str_cat(str,"=~");
X else {
X str_scat(str,tmpstr);
X str_free(tmpstr);
X }
X str_cat(str," ");
X str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg));
X str_free(fstr);
X numeric = 1;
X break;
X case OMPAREN:
X str = str_new(0);
X str_set(str,"(");
X str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X numeric |= numarg;
X str_cat(str,")");
X break;
X case OCONCAT:
X str = walk(1,level,ops[node+1].ival,&numarg);
X str_cat(str," . ");
X str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X break;
X case OASSIGN:
X str = walk(0,level,ops[node+2].ival,&numarg);
X str_cat(str," ");
X tmpstr = walk(0,level,ops[node+1].ival,&numarg);
X str_scat(str,tmpstr);
X if (str_len(tmpstr) > 1)
X numeric = 1;
X str_free(tmpstr);
X str_cat(str," ");
X str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg));
X str_free(fstr);
X numeric |= numarg;
X break;
X case OADD:
X str = walk(1,level,ops[node+1].ival,&numarg);
X str_cat(str," + ");
X str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X numeric = 1;
X break;
X case OSUB:
X str = walk(1,level,ops[node+1].ival,&numarg);
X str_cat(str," - ");
X str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X numeric = 1;
X break;
X case OMULT:
X str = walk(1,level,ops[node+1].ival,&numarg);
X str_cat(str," * ");
X str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X numeric = 1;
X break;
X case ODIV:
X str = walk(1,level,ops[node+1].ival,&numarg);
X str_cat(str," / ");
X str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X numeric = 1;
X break;
X case OMOD:
X str = walk(1,level,ops[node+1].ival,&numarg);
X str_cat(str," % ");
X str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X numeric = 1;
X break;
X case OPOSTINCR:
X str = walk(1,level,ops[node+1].ival,&numarg);
X str_cat(str,"++");
X numeric = 1;
X break;
X case OPOSTDECR:
X str = walk(1,level,ops[node+1].ival,&numarg);
X str_cat(str,"--");
X numeric = 1;
X break;
X case OPREINCR:
X str = str_new(0);
X str_set(str,"++");
X str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X numeric = 1;
X break;
X case OPREDECR:
X str = str_new(0);
X str_set(str,"--");
X str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X numeric = 1;
X break;
X case OUMINUS:
X str = str_new(0);
X str_set(str,"-");
X str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X numeric = 1;
X break;
X case OUPLUS:
X numeric = 1;
X goto def;
X case OPAREN:
X str = str_new(0);
X str_set(str,"(");
X str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X str_cat(str,")");
X numeric |= numarg;
X break;
X case OGETLINE:
X str = str_new(0);
X str_set(str,"do Getline()");
X saw_getline = TRUE;
X break;
X case OSPRINTF:
X str = str_new(0);
X str_set(str,"sprintf(");
X str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X str_cat(str,")");
X break;
X case OSUBSTR:
X str = str_new(0);
X str_set(str,"substr(");
X str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X str_cat(str,", ");
X str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X str_cat(str,", ");
X if (len == 3) {
X str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg));
X str_free(fstr);
X }
X else
X str_cat(str,"999999");
X str_cat(str,")");
X break;
X case OSTRING:
X str = str_new(0);
X str_set(str,ops[node+1].cval);
X break;
X case OSPLIT:
X str = str_new(0);
X numeric = 1;
X tmpstr = walk(1,level,ops[node+2].ival,&numarg);
X if (useval)
X str_set(str,"(@");
X else
X str_set(str,"@");
X str_scat(str,tmpstr);
X str_cat(str," = split(");
X if (len == 3) {
X fstr = walk(1,level,ops[node+3].ival,&numarg);
X if (str_len(fstr) == 3 && *fstr->str_ptr == '\'') {
X i = fstr->str_ptr[1] & 127;
X if (index("*+?.[]()|^$\\",i))
X sprintf(tokenbuf,"/\\%c/",i);
X else
X sprintf(tokenbuf,"/%c/",i);
X str_cat(str,tokenbuf);
X }
X else
X str_scat(str,fstr);
X str_free(fstr);
X }
X else if (const_FS) {
X sprintf(tokenbuf,"/[%c\\n]/",const_FS);
X str_cat(str,tokenbuf);
X }
X else if (saw_FS)
X str_cat(str,"$FS");
X else
X str_cat(str,"' '");
X str_cat(str,", ");
X str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X str_cat(str,")");
X if (useval) {
X str_cat(str,")");
X }
X str_free(tmpstr);
X break;
X case OINDEX:
X str = str_new(0);
X str_set(str,"index(");
X str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X str_cat(str,", ");
X str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X str_cat(str,")");
X numeric = 1;
X break;
X case ONUM:
X str = walk(1,level,ops[node+1].ival,&numarg);
X numeric = 1;
X break;
X case OSTR:
X tmpstr = walk(1,level,ops[node+1].ival,&numarg);
X s = "'";
X for (t = tmpstr->str_ptr, d=tokenbuf; *t; d++,t++) {
X if (*t == '\'')
X s = "\"";
X else if (*t == '\\') {
X s = "\"";
X *d++ = *t++ + 128;
X switch (*t) {
X case '\\': case '"': case 'n': case 't':
X break;
X default: /* hide this from perl */
X *d++ = '\\' + 128;
X }
X }
X *d = *t + 128;
X }
X *d = '\0';
X str = str_new(0);
X str_set(str,s);
X str_cat(str,tokenbuf);
X str_free(tmpstr);
X str_cat(str,s);
X break;
X case OVAR:
X str = str_new(0);
X str_set(str,"$");
X str_scat(str,tmpstr=walk(1,level,ops[node+1].ival,&numarg));
X if (len == 1) {
X tmp2str = hfetch(symtab,tmpstr->str_ptr);
X if (tmp2str && atoi(tmp2str->str_ptr))
X numeric = 2;
X if (strEQ(str->str_ptr,"$NR")) {
X numeric = 1;
X str_set(str,"$.");
X }
X else if (strEQ(str->str_ptr,"$NF")) {
X numeric = 1;
X str_set(str,"$#Fld");
X }
X else if (strEQ(str->str_ptr,"$0"))
X str_set(str,"$_");
X }
X else {
X str_cat(tmpstr,"[]");
X tmp2str = hfetch(symtab,tmpstr->str_ptr);
X if (tmp2str && atoi(tmp2str->str_ptr))
X str_cat(str,"[");
X else
X str_cat(str,"{");
X str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X if (tmp2str && atoi(tmp2str->str_ptr))
X strcpy(tokenbuf,"]");
X else
X strcpy(tokenbuf,"}");
X *tokenbuf += 128;
X str_cat(str,tokenbuf);
X }
X str_free(tmpstr);
X break;
X case OFLD:
X str = str_new(0);
X if (split_to_array) {
X str_set(str,"$Fld");
X str_cat(str,"[");
X str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X str_cat(str,"]");
X }
X else {
X i = atoi(walk(1,level,ops[node+1].ival,&numarg)->str_ptr);
X if (i <= arymax)
X sprintf(tokenbuf,"$%s",nameary[i]);
X else
X sprintf(tokenbuf,"$Fld%d",i);
X str_set(str,tokenbuf);
X }
X break;
X case OVFLD:
X str = str_new(0);
X str_set(str,"$Fld[");
X i = ops[node+1].ival;
X if ((ops[i].ival & 255) == OPAREN)
X i = ops[i+1].ival;
X tmpstr=walk(1,level,i,&numarg);
X str_scat(str,tmpstr);
X str_free(tmpstr);
X str_cat(str,"]");
X break;
X case OJUNK:
X goto def;
X case OSNEWLINE:
X str = str_new(2);
X str_set(str,";\n");
X tab(str,level);
X break;
X case ONEWLINE:
X str = str_new(1);
X str_set(str,"\n");
X tab(str,level);
X break;
X case OSCOMMENT:
X str = str_new(0);
X str_set(str,";");
X tmpstr = walk(0,level,ops[node+1].ival,&numarg);
X for (s = tmpstr->str_ptr; *s && *s != '\n'; s++)
X *s += 128;
X str_scat(str,tmpstr);
X str_free(tmpstr);
X tab(str,level);
X break;
X case OCOMMENT:
X str = str_new(0);
X tmpstr = walk(0,level,ops[node+1].ival,&numarg);
X for (s = tmpstr->str_ptr; *s && *s != '\n'; s++)
X *s += 128;
X str_scat(str,tmpstr);
X str_free(tmpstr);
X tab(str,level);
X break;
X case OCOMMA:
X str = walk(1,level,ops[node+1].ival,&numarg);
X str_cat(str,", ");
X str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X break;
X case OSEMICOLON:
X str = str_new(1);
X str_set(str,"; ");
X break;
X case OSTATES:
X str = walk(0,level,ops[node+1].ival,&numarg);
X str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X break;
X case OSTATE:
X str = str_new(0);
X if (len >= 1) {
X str_scat(str,fstr=walk(0,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X if (len >= 2) {
X tmpstr = walk(0,level,ops[node+2].ival,&numarg);
X if (*tmpstr->str_ptr == ';') {
X addsemi(str);
X str_cat(str,tmpstr->str_ptr+1);
X }
X str_free(tmpstr);
X }
X }
X break;
X case OPRINTF:
X case OPRINT:
X lparen = ""; /* set to parens if necessary */
X rparen = "";
X str = str_new(0);
X if (len == 3) { /* output redirection */
X tmpstr = walk(1,level,ops[node+3].ival,&numarg);
X tmp2str = walk(1,level,ops[node+2].ival,&numarg);
X if (!do_fancy_opens) {
X t = tmpstr->str_ptr;
X if (*t == '"' || *t == '\'')
X t = cpytill(tokenbuf,t+1,*t);
X else
X fatal("Internal error: OPRINT");
X d = savestr(t);
X s = savestr(tokenbuf);
X for (t = tokenbuf; *t; t++) {
X *t &= 127;
X if (!isalpha(*t) && !isdigit(*t))
X *t = '_';
X }
X if (!index(tokenbuf,'_'))
X strcpy(t,"_fh");
X str_cat(opens,"open(");
X str_cat(opens,tokenbuf);
X str_cat(opens,", ");
X d[1] = '\0';
X str_cat(opens,d);
X str_scat(opens,tmp2str);
X str_cat(opens,tmpstr->str_ptr+1);
X if (*tmp2str->str_ptr == '|')
X str_cat(opens,") || die 'Cannot pipe to \"");
X else
X str_cat(opens,") || die 'Cannot create file \"");
X if (*d == '"')
X str_cat(opens,"'.\"");
X str_cat(opens,s);
X if (*d == '"')
X str_cat(opens,"\".'");
X str_cat(opens,"\".';\n");
X str_free(tmpstr);
X str_free(tmp2str);
X safefree(s);
X safefree(d);
X }
X else {
X sprintf(tokenbuf,"do Pick('%s' . (%s)) &&\n",
X tmp2str->str_ptr, tmpstr->str_ptr);
X str_cat(str,tokenbuf);
X tab(str,level+1);
X *tokenbuf = '\0';
X str_free(tmpstr);
X str_free(tmp2str);
X lparen = "(";
X rparen = ")";
X }
X }
X else
X strcpy(tokenbuf,"stdout");
X str_cat(str,lparen); /* may be null */
X if (type == OPRINTF)
X str_cat(str,"printf");
X else
X str_cat(str,"print");
X if (len == 3 || do_fancy_opens) {
X if (*tokenbuf)
X str_cat(str," ");
X str_cat(str,tokenbuf);
X }
X tmpstr = walk(1+(type==OPRINT),level,ops[node+1].ival,&numarg);
X if (!*tmpstr->str_ptr && lval_field) {
X t = saw_OFS ? "$," : "' '";
X if (split_to_array) {
X sprintf(tokenbuf,"join(%s,@Fld)",t);
X str_cat(tmpstr,tokenbuf);
X }
X else {
X for (i = 1; i < maxfld; i++) {
X if (i <= arymax)
X sprintf(tokenbuf,"$%s, ",nameary[i]);
X else
X sprintf(tokenbuf,"$Fld%d, ",i);
X str_cat(tmpstr,tokenbuf);
X }
X if (maxfld <= arymax)
X sprintf(tokenbuf,"$%s",nameary[maxfld]);
X else
X sprintf(tokenbuf,"$Fld%d",maxfld);
X str_cat(tmpstr,tokenbuf);
X }
X }
X if (*tmpstr->str_ptr) {
X str_cat(str," ");
X str_scat(str,tmpstr);
X }
X else {
X str_cat(str," $_");
X }
X str_cat(str,rparen); /* may be null */
X str_free(tmpstr);
X break;
X case OLENGTH:
X str = str_make("length(");
X goto maybe0;
X case OLOG:
X str = str_make("log(");
X goto maybe0;
X case OEXP:
X str = str_make("exp(");
X goto maybe0;
X case OSQRT:
X str = str_make("sqrt(");
X goto maybe0;
X case OINT:
X str = str_make("int(");
X maybe0:
X numeric = 1;
X if (len > 0)
X tmpstr = walk(1,level,ops[node+1].ival,&numarg);
X else
X tmpstr = str_new(0);;
X if (!*tmpstr->str_ptr) {
X if (lval_field) {
X t = saw_OFS ? "$," : "' '";
X if (split_to_array) {
X sprintf(tokenbuf,"join(%s,@Fld)",t);
X str_cat(tmpstr,tokenbuf);
X }
X else {
X sprintf(tokenbuf,"join(%s, ",t);
X str_cat(tmpstr,tokenbuf);
X for (i = 1; i < maxfld; i++) {
X if (i <= arymax)
X sprintf(tokenbuf,"$%s,",nameary[i]);
X else
X sprintf(tokenbuf,"$Fld%d,",i);
X str_cat(tmpstr,tokenbuf);
X }
X if (maxfld <= arymax)
X sprintf(tokenbuf,"$%s)",nameary[maxfld]);
X else
X sprintf(tokenbuf,"$Fld%d)",maxfld);
X str_cat(tmpstr,tokenbuf);
X }
X }
X else
X str_cat(tmpstr,"$_");
X }
X if (strEQ(tmpstr->str_ptr,"$_")) {
X if (type == OLENGTH && !do_chop) {
X str = str_make("(length(");
X str_cat(tmpstr,") - 1");
X }
X }
X str_scat(str,tmpstr);
X str_free(tmpstr);
X str_cat(str,")");
X break;
X case OBREAK:
X str = str_new(0);
X str_set(str,"last");
X break;
X case ONEXT:
X str = str_new(0);
X str_set(str,"next line");
X break;
X case OEXIT:
X str = str_new(0);
X if (realexit) {
X str_set(str,"exit");
X if (len == 1) {
X str_cat(str," ");
X exitval = TRUE;
X str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X }
X }
X else {
X if (len == 1) {
X str_set(str,"ExitValue = ");
X exitval = TRUE;
X str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X str_cat(str,"; ");
X }
X str_cat(str,"last line");
X }
X break;
X case OCONTINUE:
X str = str_new(0);
X str_set(str,"next");
X break;
X case OREDIR:
X goto def;
X case OIF:
X str = str_new(0);
X str_set(str,"if (");
X str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X str_cat(str,") ");
X str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X if (len == 3) {
X i = ops[node+3].ival;
X if (i) {
X if ((ops[i].ival & 255) == OBLOCK) {
X i = ops[i+1].ival;
X if (i) {
X if ((ops[i].ival & 255) != OIF)
X i = 0;
X }
X }
X else
X i = 0;
X }
X if (i) {
X str_cat(str,"els");
X str_scat(str,fstr=walk(0,level,i,&numarg));
X str_free(fstr);
X }
X else {
X str_cat(str,"else ");
X str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg));
X str_free(fstr);
X }
X }
X break;
X case OWHILE:
X str = str_new(0);
X str_set(str,"while (");
X str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X str_cat(str,") ");
X str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X break;
X case OFOR:
X str = str_new(0);
X str_set(str,"for (");
X str_scat(str,tmpstr=walk(1,level,ops[node+1].ival,&numarg));
X i = numarg;
X if (i) {
X t = s = tmpstr->str_ptr;
X while (isalpha(*t) || isdigit(*t) || *t == '$' || *t == '_')
X t++;
X i = t - s;
X if (i < 2)
X i = 0;
X }
X str_cat(str,"; ");
X fstr=walk(1,level,ops[node+2].ival,&numarg);
X if (i && (t = index(fstr->str_ptr,0377))) {
X if (strnEQ(fstr->str_ptr,s,i))
X *t = ' ';
X }
X str_scat(str,fstr);
X str_free(fstr);
X str_free(tmpstr);
X str_cat(str,"; ");
X str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg));
X str_free(fstr);
X str_cat(str,") ");
X str_scat(str,fstr=walk(0,level,ops[node+4].ival,&numarg));
X str_free(fstr);
X break;
X case OFORIN:
X tmpstr=walk(0,level,ops[node+2].ival,&numarg);
X str = str_new(0);
X str_sset(str,tmpstr);
X str_cat(str,"[]");
X tmp2str = hfetch(symtab,str->str_ptr);
X if (tmp2str && atoi(tmp2str->str_ptr)) {
X fstr=walk(1,level,ops[node+1].ival,&numarg);
X sprintf(tokenbuf,
X "foreach $%s (@%s) ",
X fstr->str_ptr,
X tmpstr->str_ptr);
X str_set(str,tokenbuf);
X str_free(fstr);
X str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg));
X str_free(fstr);
X }
X else {
X str_set(str,"while (($");
X str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X str_cat(str,",$junkval) = each(");
X str_scat(str,tmpstr);
X str_cat(str,")) ");
X str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg));
X str_free(fstr);
X }
X str_free(tmpstr);
X break;
X case OBLOCK:
X str = str_new(0);
X str_set(str,"{");
X if (len >= 2 && ops[node+2].ival) {
X str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg));
X str_free(fstr);
X }
X fixtab(str,++level);
X str_scat(str,fstr=walk(0,level,ops[node+1].ival,&numarg));
X str_free(fstr);
X addsemi(str);
X fixtab(str,--level);
X str_cat(str,"}\n");
X tab(str,level);
X if (len >= 3) {
X str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg));
X str_free(fstr);
X }
X break;
X default:
X def:
X if (len) {
X if (len > 5)
X fatal("Garbage length in walk");
X str = walk(0,level,ops[node+1].ival,&numarg);
X for (i = 2; i<= len; i++) {
X str_scat(str,fstr=walk(0,level,ops[node+i].ival,&numarg));
X str_free(fstr);
X }
X }
X else {
X str = Nullstr;
X }
X break;
X }
X if (!str)
X str = str_new(0);
X *numericptr = numeric;
X#ifdef DEBUGGING
X if (debug & 4) {
X printf("%3d %5d %15s %d %4d ",level,node,opname[type],len,str->str_cur);
X for (t = str->str_ptr; *t && t - str->str_ptr < 40; t++)
X if (*t == '\n')
X printf("\\n");
X else if (*t == '\t')
X printf("\\t");
X else
X putchar(*t);
X putchar('\n');
X }
X#endif
X return str;
X}
X
Xtab(str,lvl)
Xregister STR *str;
Xregister int lvl;
X{
X while (lvl > 1) {
X str_cat(str,"\t");
X lvl -= 2;
X }
X if (lvl)
X str_cat(str," ");
X}
X
Xfixtab(str,lvl)
Xregister STR *str;
Xregister int lvl;
X{
X register char *s;
X
X /* strip trailing white space */
X
X s = str->str_ptr+str->str_cur - 1;
X while (s >= str->str_ptr && (*s == ' ' || *s == '\t'))
X s--;
X s[1] = '\0';
X str->str_cur = s + 1 - str->str_ptr;
X if (s >= str->str_ptr && *s != '\n')
X str_cat(str,"\n");
X
X tab(str,lvl);
X}
X
Xaddsemi(str)
Xregister STR *str;
X{
X register char *s;
X
X s = str->str_ptr+str->str_cur - 1;
X while (s >= str->str_ptr && (*s == ' ' || *s == '\t' || *s == '\n'))
X s--;
X if (s >= str->str_ptr && *s != ';' && *s != '}')
X str_cat(str,";");
X}
X
Xemit_split(str,level)
Xregister STR *str;
Xint level;
X{
X register int i;
X
X if (split_to_array)
X str_cat(str,"@Fld");
X else {
X str_cat(str,"(");
X for (i = 1; i < maxfld; i++) {
X if (i <= arymax)
X sprintf(tokenbuf,"$%s,",nameary[i]);
X else
X sprintf(tokenbuf,"$Fld%d,",i);
X str_cat(str,tokenbuf);
X }
X if (maxfld <= arymax)
X sprintf(tokenbuf,"$%s)",nameary[maxfld]);
X else
X sprintf(tokenbuf,"$Fld%d)",maxfld);
X str_cat(str,tokenbuf);
X }
X if (const_FS) {
X sprintf(tokenbuf," = split(/[%c\\n]/);\n",const_FS);
X str_cat(str,tokenbuf);
X }
X else if (saw_FS)
X str_cat(str," = split($FS);\n");
X else
X str_cat(str," = split(' ');\n");
X tab(str,level);
X}
X
Xprewalk(numit,level,node,numericptr)
Xint numit;
Xint level;
Xregister int node;
Xint *numericptr;
X{
X register int len;
X register int type;
X register int i;
X char *t;
X char *d, *s;
X int numarg;
X int numeric = FALSE;
X
X if (!node) {
X *numericptr = 0;
X return 0;
X }
X type = ops[node].ival;
X len = type >> 8;
X type &= 255;
X switch (type) {
X case OPROG:
X prewalk(0,level,ops[node+1].ival,&numarg);
X if (ops[node+2].ival) {
X prewalk(0,level,ops[node+2].ival,&numarg);
X }
X ++level;
X prewalk(0,level,ops[node+3].ival,&numarg);
X --level;
X if (ops[node+3].ival) {
X prewalk(0,level,ops[node+4].ival,&numarg);
X }
X break;
X case OHUNKS:
X prewalk(0,level,ops[node+1].ival,&numarg);
X prewalk(0,level,ops[node+2].ival,&numarg);
X if (len == 3) {
X prewalk(0,level,ops[node+3].ival,&numarg);
X }
X break;
X case ORANGE:
X prewalk(1,level,ops[node+1].ival,&numarg);
X prewalk(1,level,ops[node+2].ival,&numarg);
X break;
X case OPAT:
X goto def;
X case OREGEX:
X prewalk(0,level,ops[node+1].ival,&numarg);
X break;
X case OHUNK:
X if (len == 1) {
X prewalk(0,level,ops[node+1].ival,&numarg);
X }
X else {
X i = prewalk(0,level,ops[node+1].ival,&numarg);
X if (i) {
X ++level;
X prewalk(0,level,ops[node+2].ival,&numarg);
X --level;
X }
X else {
X prewalk(0,level,ops[node+2].ival,&numarg);
X }
X }
X break;
X case OPPAREN:
X prewalk(0,level,ops[node+1].ival,&numarg);
X break;
X case OPANDAND:
X prewalk(0,level,ops[node+1].ival,&numarg);
X prewalk(0,level,ops[node+2].ival,&numarg);
X break;
X case OPOROR:
X prewalk(0,level,ops[node+1].ival,&numarg);
X prewalk(0,level,ops[node+2].ival,&numarg);
X break;
X case OPNOT:
X prewalk(0,level,ops[node+1].ival,&numarg);
X break;
X case OCPAREN:
X prewalk(0,level,ops[node+1].ival,&numarg);
X numeric |= numarg;
X break;
X case OCANDAND:
X prewalk(0,level,ops[node+1].ival,&numarg);
X numeric = 1;
X prewalk(0,level,ops[node+2].ival,&numarg);
X break;
X case OCOROR:
X prewalk(0,level,ops[node+1].ival,&numarg);
X numeric = 1;
X prewalk(0,level,ops[node+2].ival,&numarg);
X break;
X case OCNOT:
X prewalk(0,level,ops[node+1].ival,&numarg);
X numeric = 1;
X break;
X case ORELOP:
X prewalk(0,level,ops[node+2].ival,&numarg);
X numeric |= numarg;
X prewalk(0,level,ops[node+1].ival,&numarg);
X prewalk(0,level,ops[node+3].ival,&numarg);
X numeric |= numarg;
X numeric = 1;
X break;
X case ORPAREN:
X prewalk(0,level,ops[node+1].ival,&numarg);
X numeric |= numarg;
X break;
X case OMATCHOP:
X prewalk(0,level,ops[node+2].ival,&numarg);
X prewalk(0,level,ops[node+1].ival,&numarg);
X prewalk(0,level,ops[node+3].ival,&numarg);
X numeric = 1;
X break;
X case OMPAREN:
X prewalk(0,level,ops[node+1].ival,&numarg);
X numeric |= numarg;
X break;
X case OCONCAT:
X prewalk(0,level,ops[node+1].ival,&numarg);
X prewalk(0,level,ops[node+2].ival,&numarg);
X break;
X case OASSIGN:
X prewalk(0,level,ops[node+2].ival,&numarg);
X prewalk(0,level,ops[node+1].ival,&numarg);
X prewalk(0,level,ops[node+3].ival,&numarg);
X if (numarg || strlen(ops[ops[node+1].ival+1].cval) > 1) {
X numericize(ops[node+2].ival);
X if (!numarg)
X numericize(ops[node+3].ival);
X }
X numeric |= numarg;
X break;
X case OADD:
X prewalk(1,level,ops[node+1].ival,&numarg);
X prewalk(1,level,ops[node+2].ival,&numarg);
X numeric = 1;
X break;
X case OSUB:
X prewalk(1,level,ops[node+1].ival,&numarg);
X prewalk(1,level,ops[node+2].ival,&numarg);
X numeric = 1;
X break;
X case OMULT:
X prewalk(1,level,ops[node+1].ival,&numarg);
X prewalk(1,level,ops[node+2].ival,&numarg);
X numeric = 1;
X break;
X case ODIV:
X prewalk(1,level,ops[node+1].ival,&numarg);
X prewalk(1,level,ops[node+2].ival,&numarg);
X numeric = 1;
X break;
X case OMOD:
X prewalk(1,level,ops[node+1].ival,&numarg);
X prewalk(1,level,ops[node+2].ival,&numarg);
X numeric = 1;
X break;
X case OPOSTINCR:
X prewalk(1,level,ops[node+1].ival,&numarg);
X numeric = 1;
X break;
X case OPOSTDECR:
X prewalk(1,level,ops[node+1].ival,&numarg);
X numeric = 1;
X break;
X case OPREINCR:
X prewalk(1,level,ops[node+1].ival,&numarg);
X numeric = 1;
X break;
X case OPREDECR:
X prewalk(1,level,ops[node+1].ival,&numarg);
X numeric = 1;
X break;
X case OUMINUS:
X prewalk(1,level,ops[node+1].ival,&numarg);
X numeric = 1;
X break;
X case OUPLUS:
X prewalk(1,level,ops[node+1].ival,&numarg);
X numeric = 1;
X break;
X case OPAREN:
X prewalk(0,level,ops[node+1].ival,&numarg);
X numeric |= numarg;
X break;
X case OGETLINE:
X break;
X case OSPRINTF:
X prewalk(0,level,ops[node+1].ival,&numarg);
X break;
X case OSUBSTR:
X prewalk(0,level,ops[node+1].ival,&numarg);
X prewalk(1,level,ops[node+2].ival,&numarg);
X if (len == 3) {
X prewalk(1,level,ops[node+3].ival,&numarg);
X }
X break;
X case OSTRING:
X break;
X case OSPLIT:
X numeric = 1;
X prewalk(0,level,ops[node+2].ival,&numarg);
X if (len == 3)
X prewalk(0,level,ops[node+3].ival,&numarg);
X prewalk(0,level,ops[node+1].ival,&numarg);
X break;
X case OINDEX:
X prewalk(0,level,ops[node+1].ival,&numarg);
X prewalk(0,level,ops[node+2].ival,&numarg);
X numeric = 1;
X break;
X case ONUM:
X prewalk(0,level,ops[node+1].ival,&numarg);
X numeric = 1;
X break;
X case OSTR:
X prewalk(0,level,ops[node+1].ival,&numarg);
X break;
X case OVAR:
X prewalk(0,level,ops[node+1].ival,&numarg);
X if (len == 1) {
X if (numit)
X numericize(node);
X }
X else {
X prewalk(0,level,ops[node+2].ival,&numarg);
X }
X break;
X case OFLD:
X prewalk(0,level,ops[node+1].ival,&numarg);
X break;
X case OVFLD:
X i = ops[node+1].ival;
X prewalk(0,level,i,&numarg);
X break;
X case OJUNK:
X goto def;
X case OSNEWLINE:
X break;
X case ONEWLINE:
X break;
X case OSCOMMENT:
X break;
X case OCOMMENT:
X break;
X case OCOMMA:
X prewalk(0,level,ops[node+1].ival,&numarg);
X prewalk(0,level,ops[node+2].ival,&numarg);
X break;
X case OSEMICOLON:
X break;
X case OSTATES:
X prewalk(0,level,ops[node+1].ival,&numarg);
X prewalk(0,level,ops[node+2].ival,&numarg);
X break;
X case OSTATE:
X if (len >= 1) {
X prewalk(0,level,ops[node+1].ival,&numarg);
X if (len >= 2) {
X prewalk(0,level,ops[node+2].ival,&numarg);
X }
X }
X break;
X case OPRINTF:
X case OPRINT:
X if (len == 3) { /* output redirection */
X prewalk(0,level,ops[node+3].ival,&numarg);
X prewalk(0,level,ops[node+2].ival,&numarg);
X }
X prewalk(0+(type==OPRINT),level,ops[node+1].ival,&numarg);
X break;
X case OLENGTH:
X goto maybe0;
X case OLOG:
X goto maybe0;
X case OEXP:
X goto maybe0;
X case OSQRT:
X goto maybe0;
X case OINT:
X maybe0:
X numeric = 1;
X if (len > 0)
X prewalk(type != OLENGTH,level,ops[node+1].ival,&numarg);
X break;
X case OBREAK:
X break;
X case ONEXT:
X break;
X case OEXIT:
X if (len == 1) {
X prewalk(1,level,ops[node+1].ival,&numarg);
X }
X break;
X case OCONTINUE:
X break;
X case OREDIR:
X goto def;
X case OIF:
X prewalk(0,level,ops[node+1].ival,&numarg);
X prewalk(0,level,ops[node+2].ival,&numarg);
X if (len == 3) {
X prewalk(0,level,ops[node+3].ival,&numarg);
X }
X break;
X case OWHILE:
X prewalk(0,level,ops[node+1].ival,&numarg);
X prewalk(0,level,ops[node+2].ival,&numarg);
X break;
X case OFOR:
X prewalk(0,level,ops[node+1].ival,&numarg);
X prewalk(0,level,ops[node+2].ival,&numarg);
X prewalk(0,level,ops[node+3].ival,&numarg);
X prewalk(0,level,ops[node+4].ival,&numarg);
X break;
X case OFORIN:
X prewalk(0,level,ops[node+2].ival,&numarg);
X prewalk(0,level,ops[node+1].ival,&numarg);
X prewalk(0,level,ops[node+3].ival,&numarg);
X break;
X case OBLOCK:
X if (len == 2) {
X prewalk(0,level,ops[node+2].ival,&numarg);
X }
X ++level;
X prewalk(0,level,ops[node+1].ival,&numarg);
X --level;
X break;
X default:
X def:
X if (len) {
X if (len > 5)
X fatal("Garbage length in prewalk");
X prewalk(0,level,ops[node+1].ival,&numarg);
X for (i = 2; i<= len; i++) {
X prewalk(0,level,ops[node+i].ival,&numarg);
X }
X }
X break;
X }
X *numericptr = numeric;
X return 1;
X}
X
Xnumericize(node)
Xregister int node;
X{
X register int len;
X register int type;
X register int i;
X STR *tmpstr;
X STR *tmp2str;
X int numarg;
X
X type = ops[node].ival;
X len = type >> 8;
X type &= 255;
X if (type == OVAR && len == 1) {
X tmpstr=walk(0,0,ops[node+1].ival,&numarg);
X tmp2str = str_make("1");
X hstore(symtab,tmpstr->str_ptr,tmp2str);
X }
X}
!STUFFY!FUNK!
echo Extracting str.c
sed >str.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: str.c,v 2.0 88/06/05 00:11:07 root Exp $
X *
X * $Log: str.c,v $
X * Revision 2.0 88/06/05 00:11:07 root
X * Baseline version 2.0.
X *
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X
Xstr_reset(s)
Xregister char *s;
X{
X register STAB *stab;
X register STR *str;
X register int i;
X register int max;
X register SPAT *spat;
X
X if (!*s) { /* reset ?? searches */
X for (spat = spat_root; spat != Nullspat; spat = spat->spat_next) {
X spat->spat_flags &= ~SPAT_USED;
X }
X return;
X }
X
X /* reset variables */
X
X while (*s) {
X i = *s;
X if (s[1] == '-') {
X s += 2;
X }
X max = *s++;
X for ( ; i <= max; i++) {
X for (stab = stab_index[i]; stab; stab = stab->stab_next) {
X str = stab->stab_val;
X str->str_cur = 0;
X str->str_nok = 0;
X if (str->str_ptr != Nullch)
X str->str_ptr[0] = '\0';
X if (stab->stab_array) {
X aclear(stab->stab_array);
X }
X if (stab->stab_hash) {
X hclear(stab->stab_hash);
X }
X }
X }
X }
X}
X
Xstr_numset(str,num)
Xregister STR *str;
Xdouble num;
X{
X str->str_nval = num;
X str->str_pok = 0; /* invalidate pointer */
X str->str_nok = 1; /* validate number */
X}
X
Xextern int errno;
X
Xchar *
Xstr_2ptr(str)
Xregister STR *str;
X{
X register char *s;
X int olderrno;
X
X if (!str)
X return "";
X GROWSTR(&(str->str_ptr), &(str->str_len), 24);
X s = str->str_ptr;
X if (str->str_nok) {
X olderrno = errno; /* some Xenix systems wipe out errno here */
X#if defined(scs) && defined(ns32000)
X gcvt(str->str_nval,20,s);
X#else
X#ifdef apollo
X if (str->str_nval == 0.0)
X strcpy(s,"0");
X else
X#endif /*apollo*/
X sprintf(s,"%.20g",str->str_nval);
X#endif /*scs*/
X errno = olderrno;
X while (*s) s++;
X }
X else if (dowarn)
X warn("Use of uninitialized variable");
X *s = '\0';
X str->str_cur = s - str->str_ptr;
X str->str_pok = 1;
X#ifdef DEBUGGING
X if (debug & 32)
X fprintf(stderr,"0x%lx ptr(%s)\n",str,str->str_ptr);
X#endif
X return str->str_ptr;
X}
X
Xdouble
Xstr_2num(str)
Xregister STR *str;
X{
X if (!str)
X return 0.0;
X if (str->str_len && str->str_pok)
X str->str_nval = atof(str->str_ptr);
X else {
X if (dowarn)
X fprintf(stderr,"Use of uninitialized variable in %s line %ld.\n",
X filename,(long)line);
X str->str_nval = 0.0;
X }
X str->str_nok = 1;
X#ifdef DEBUGGING
X if (debug & 32)
X fprintf(stderr,"0x%lx num(%g)\n",str,str->str_nval);
X#endif
X return str->str_nval;
X}
X
Xstr_sset(dstr,sstr)
XSTR *dstr;
Xregister STR *sstr;
X{
X if (!sstr)
X str_nset(dstr,No,0);
X else if (sstr->str_nok)
X str_numset(dstr,sstr->str_nval);
X else if (sstr->str_pok)
X str_nset(dstr,sstr->str_ptr,sstr->str_cur);
X else
X str_nset(dstr,"",0);
X}
X
Xstr_nset(str,ptr,len)
Xregister STR *str;
Xregister char *ptr;
Xregister int len;
X{
X GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
X bcopy(ptr,str->str_ptr,len);
X str->str_cur = len;
X *(str->str_ptr+str->str_cur) = '\0';
X str->str_nok = 0; /* invalidate number */
X str->str_pok = 1; /* validate pointer */
X}
X
Xstr_set(str,ptr)
Xregister STR *str;
Xregister char *ptr;
X{
X register int len;
X
X if (!ptr)
X ptr = "";
X len = strlen(ptr);
X GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
X bcopy(ptr,str->str_ptr,len+1);
X str->str_cur = len;
X str->str_nok = 0; /* invalidate number */
X str->str_pok = 1; /* validate pointer */
X}
X
Xstr_chop(str,ptr) /* like set but assuming ptr is in str */
Xregister STR *str;
Xregister char *ptr;
X{
X if (!(str->str_pok))
X str_2ptr(str);
X str->str_cur -= (ptr - str->str_ptr);
X bcopy(ptr,str->str_ptr, str->str_cur + 1);
X str->str_nok = 0; /* invalidate number */
X str->str_pok = 1; /* validate pointer */
X}
X
Xstr_ncat(str,ptr,len)
Xregister STR *str;
Xregister char *ptr;
Xregister int len;
X{
X if (!(str->str_pok))
X str_2ptr(str);
X GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + len + 1);
X bcopy(ptr,str->str_ptr+str->str_cur,len);
X str->str_cur += len;
X *(str->str_ptr+str->str_cur) = '\0';
X str->str_nok = 0; /* invalidate number */
X str->str_pok = 1; /* validate pointer */
X}
X
Xstr_scat(dstr,sstr)
XSTR *dstr;
Xregister STR *sstr;
X{
X if (!sstr)
X return;
X if (!(sstr->str_pok))
X str_2ptr(sstr);
X if (sstr)
X str_ncat(dstr,sstr->str_ptr,sstr->str_cur);
X}
X
Xstr_cat(str,ptr)
Xregister STR *str;
Xregister char *ptr;
X{
X register int len;
X
X if (!ptr)
X return;
X if (!(str->str_pok))
X str_2ptr(str);
X len = strlen(ptr);
X GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + len + 1);
X bcopy(ptr,str->str_ptr+str->str_cur,len+1);
X str->str_cur += len;
X str->str_nok = 0; /* invalidate number */
X str->str_pok = 1; /* validate pointer */
X}
X
Xchar *
Xstr_append_till(str,from,delim,keeplist)
Xregister STR *str;
Xregister char *from;
Xregister int delim;
Xchar *keeplist;
X{
X register char *to;
X register int len;
X
X if (!from)
X return Nullch;
X len = strlen(from);
X GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + len + 1);
X str->str_nok = 0; /* invalidate number */
X str->str_pok = 1; /* validate pointer */
X to = str->str_ptr+str->str_cur;
X for (; *from; from++,to++) {
X if (*from == '\\' && from[1] && delim != '\\') {
X if (!keeplist) {
X if (from[1] == delim || from[1] == '\\')
X from++;
X else
X *to++ = *from++;
X }
X else if (index(keeplist,from[1]))
X *to++ = *from++;
X else
X from++;
X }
X else if (*from == delim)
X break;
X *to = *from;
X }
X *to = '\0';
X str->str_cur = to - str->str_ptr;
X return from;
X}
X
XSTR *
Xstr_new(len)
Xint len;
X{
X register STR *str;
X
X if (freestrroot) {
X str = freestrroot;
X freestrroot = str->str_link.str_next;
X str->str_link.str_magic = Nullstab;
X }
X else {
X str = (STR *) safemalloc(sizeof(STR));
X bzero((char*)str,sizeof(STR));
X }
X if (len)
X GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
X return str;
X}
X
Xvoid
Xstr_grow(str,len)
Xregister STR *str;
Xint len;
X{
X if (len && str)
X GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
X}
X
X/* make str point to what nstr did */
X
Xvoid
Xstr_replace(str,nstr)
Xregister STR *str;
Xregister STR *nstr;
X{
X safefree(str->str_ptr);
X str->str_ptr = nstr->str_ptr;
X str->str_len = nstr->str_len;
X str->str_cur = nstr->str_cur;
X str->str_pok = nstr->str_pok;
X if (str->str_nok = nstr->str_nok)
X str->str_nval = nstr->str_nval;
X safefree((char*)nstr);
X}
X
Xvoid
Xstr_free(str)
Xregister STR *str;
X{
X if (!str)
X return;
X if (str->str_len)
X str->str_ptr[0] = '\0';
X str->str_cur = 0;
X str->str_nok = 0;
X str->str_pok = 0;
X str->str_link.str_next = freestrroot;
X freestrroot = str;
X}
X
Xstr_len(str)
Xregister STR *str;
X{
X if (!str)
X return 0;
X if (!(str->str_pok))
X str_2ptr(str);
X if (str->str_len)
X return str->str_cur;
X else
X return 0;
X}
X
Xchar *
Xstr_gets(str,fp)
Xregister STR *str;
Xregister FILE *fp;
X{
X#ifdef STDSTDIO /* Here is some breathtakingly efficient cheating */
X
X register char *bp; /* we're going to steal some values */
X register int cnt; /* from the stdio struct and put EVERYTHING */
X register STDCHAR *ptr; /* in the innermost loop into registers */
X register char newline = record_separator;/* (assuming >= 6 registers) */
X int i;
X int bpx;
X int obpx;
X register int get_paragraph;
X register char *oldbp;
X
X if (get_paragraph = !newline) { /* yes, that's an assignment */
X newline = '\n';
X oldbp = Nullch; /* remember last \n position (none) */
X }
X cnt = fp->_cnt; /* get count into register */
X str->str_nok = 0; /* invalidate number */
X str->str_pok = 1; /* validate pointer */
X if (str->str_len <= cnt) /* make sure we have the room */
X GROWSTR(&(str->str_ptr), &(str->str_len), cnt+1);
X bp = str->str_ptr; /* move these two too to registers */
X ptr = fp->_ptr;
X for (;;) {
X screamer:
X while (--cnt >= 0) { /* this */ /* eat */
X if ((*bp++ = *ptr++) == newline) /* really */ /* dust */
X goto thats_all_folks; /* screams */ /* sed :-) */
X }
X
X fp->_cnt = cnt; /* deregisterize cnt and ptr */
X fp->_ptr = ptr;
X i = _filbuf(fp); /* get more characters */
X cnt = fp->_cnt;
X ptr = fp->_ptr; /* reregisterize cnt and ptr */
X
X bpx = bp - str->str_ptr; /* prepare for possible relocation */
X if (get_paragraph && oldbp)
X obpx = oldbp - str->str_ptr;
X GROWSTR(&(str->str_ptr), &(str->str_len), bpx + cnt + 2);
X bp = str->str_ptr + bpx; /* reconstitute our pointer */
X if (get_paragraph && oldbp)
X oldbp = str->str_ptr + obpx;
X
X if (i == newline) { /* all done for now? */
X *bp++ = i;
X goto thats_all_folks;
X }
X else if (i == EOF) /* all done for ever? */
X goto thats_really_all_folks;
X *bp++ = i; /* now go back to screaming loop */
X }
X
Xthats_all_folks:
X if (get_paragraph && bp - 1 != oldbp) {
X oldbp = bp; /* remember where this newline was */
X goto screamer; /* and go back to the fray */
X }
Xthats_really_all_folks:
X fp->_cnt = cnt; /* put these back or we're in trouble */
X fp->_ptr = ptr;
X *bp = '\0';
X str->str_cur = bp - str->str_ptr; /* set length */
X
X#else /* !STDSTDIO */ /* The big, slow, and stupid way */
X
X static char buf[4192];
X
X if (fgets(buf, sizeof buf, fp) != Nullch)
X str_set(str, buf);
X else
X str_set(str, No);
X
X#endif /* STDSTDIO */
X
X return str->str_cur ? str->str_ptr : Nullch;
X}
X
X
XSTR *
Xinterp(str,s)
Xregister STR *str;
Xregister char *s;
X{
X register char *t = s;
X char *envsave = envname;
X envname = Nullch;
X
X str_set(str,"");
X while (*s) {
X if (*s == '\\' && s[1] == '\\') {
X str_ncat(str, t, s++ - t);
X t = s++;
X }
X else if (*s == '\\' && s[1] == '$') {
X str_ncat(str, t, s++ - t);
X t = s++;
X }
X else if (*s == '$' && s[1] && s[1] != '|') {
X str_ncat(str,t,s-t);
X s = scanreg(s,tokenbuf);
X str_cat(str,reg_get(tokenbuf));
X t = s;
X }
X else
X s++;
X }
X envname = envsave;
X str_ncat(str,t,s-t);
X return str;
X}
X
Xvoid
Xstr_inc(str)
Xregister STR *str;
X{
X register char *d;
X
X if (!str)
X return;
X if (str->str_nok) {
X str->str_nval += 1.0;
X str->str_pok = 0;
X return;
X }
X if (!str->str_pok || !*str->str_ptr) {
X str->str_nval = 1.0;
X str->str_nok = 1;
X return;
X }
X d = str->str_ptr;
X while (isalpha(*d)) d++;
X while (isdigit(*d)) d++;
X if (*d) {
X str_numset(str,atof(str->str_ptr) + 1.0); /* punt */
X return;
X }
X d--;
X while (d >= str->str_ptr) {
X if (isdigit(*d)) {
X if (++*d <= '9')
X return;
X *(d--) = '0';
X }
X else {
X ++*d;
X if (isalpha(*d))
X return;
X *(d--) -= 'z' - 'a' + 1;
X }
X }
X /* oh,oh, the number grew */
X GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + 2);
X str->str_cur++;
X for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--)
X *d = d[-1];
X if (isdigit(d[1]))
X *d = '1';
X else
X *d = d[1];
X}
X
Xvoid
Xstr_dec(str)
Xregister STR *str;
X{
X if (!str)
X return;
X if (str->str_nok) {
X str->str_nval -= 1.0;
X str->str_pok = 0;
X return;
X }
X if (!str->str_pok) {
X str->str_nval = -1.0;
X str->str_nok = 1;
X return;
X }
X str_numset(str,atof(str->str_ptr) - 1.0);
X}
X
X/* make a string that will exist for the duration of the expression eval */
X
XSTR *
Xstr_static(oldstr)
XSTR *oldstr;
X{
X register STR *str = str_new(0);
X static long tmps_size = -1;
X
X str_sset(str,oldstr);
X if (++tmps_max > tmps_size) {
X tmps_size = tmps_max;
X if (!(tmps_size & 127)) {
X if (tmps_size)
X tmps_list = (STR**)saferealloc((char*)tmps_list,
X (MEM_SIZE)((tmps_size + 128) * sizeof(STR*)) );
X else
X tmps_list = (STR**)safemalloc(128 * sizeof(char*));
X }
X }
X tmps_list[tmps_max] = str;
X return str;
X}
X
XSTR *
Xstr_make(s)
Xchar *s;
X{
X register STR *str = str_new(0);
X
X str_set(str,s);
X return str;
X}
X
XSTR *
Xstr_nmake(n)
Xdouble n;
X{
X register STR *str = str_new(0);
X
X str_numset(str,n);
X return str;
X}
!STUFFY!FUNK!
echo Extracting t/op.split
sed >t/op.split <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.split,v 2.0 88/06/05 00:14:37 root Exp $
X
Xprint "1..7\n";
X
X$FS = ':';
X
X$_ = 'a:b:c';
X
X($a,$b,$c) = split($FS,$_);
X
Xif (join(';',$a,$b,$c) eq 'a;b;c') {print "ok 1\n";} else {print "not ok 1\n";}
X
X@ary = split(/:b:/);
Xif (join("$_",@ary) eq 'aa:b:cc') {print "ok 2\n";} else {print "not ok 2\n";}
X
X$_ = "abc\n";
X@ary = split(//);
Xif (join(".",@ary) eq "a.b.c.\n") {print "ok 3\n";} else {print "not ok 3\n";}
X
X$_ = "a:b:c::::";
X@ary = split(/:/);
Xif (join(".",@ary) eq "a.b.c") {print "ok 4\n";} else {print "not ok 4\n";}
X
X$_ = join(':',split(' '," a b\tc \t d "));
Xif ($_ eq 'a:b:c:d') {print "ok 5\n";} else {print "not ok 5 #$_#\n";}
X
X$_ = join(':',split(/ */,"foo bar bie\tdoll"));
Xif ($_ eq "f:o:o:b:a:r:b:i:e:\t:d:o:l:l")
X {print "ok 6\n";} else {print "not ok 6\n";}
X
X$_ = join(':', 'foo', split(/ /,'a b c'), 'bar');
Xif ($_ eq "foo:a:b::c:bar") {print "ok 7\n";} else {print "not ok 7 $_\n";}
X
!STUFFY!FUNK!
echo ""
echo "End of kit 7 (of 15)"
cat /dev/null >kit7isdone
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
--
Please send comp.sources.unix-related mail to rsalz@uunet.uu.net.