rsalz@bbn.com (Rich Salz) (02/02/88)
Submitted-by: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov> Posting-number: Volume 13, Issue 7 Archive-name: perl/part07 #! /bin/sh # Make a new directory for the perl sources, cd to it, and run kits 1 # thru 10 through sh. When all 10 kits have been run, read README. echo "This is perl 1.0 kit 7 (of 10). If kit 7 is complete, the line" echo '"'"End of kit 7 (of 10)"'" will echo at the end.' echo "" export PATH || (echo "You didn't use sh, you clunch." ; kill $$) mkdir t 2>/dev/null mkdir x2p 2>/dev/null echo Extracting x2p/a2py.c sed >x2p/a2py.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: a2py.c,v 1.0 87/12/18 17:50:33 root Exp $ X * X * $Log: a2py.c,v $ X * Revision 1.0 87/12/18 17:50:33 root X * Initial revision X * X */ X X#include "util.h" Xchar *index(); X Xchar *filename; X Xmain(argc,argv,env) Xregister int argc; Xregister char **argv; Xregister char **env; X{ X register STR *str; X register char *s; X int i; X STR *walk(); X STR *tmpstr; X X linestr = str_new(80); X str = str_new(0); /* first used for -I flags */ X for (argc--,argv++; argc; argc--,argv++) { X if (argv[0][0] != '-' || !argv[0][1]) X break; X reswitch: X switch (argv[0][1]) { X#ifdef DEBUGGING X case 'D': X debug = atoi(argv[0]+2); X#ifdef YYDEBUG X yydebug = (debug & 1); X#endif X break; X#endif X case '0': case '1': case '2': case '3': case '4': X case '5': case '6': case '7': case '8': case '9': X maxfld = atoi(argv[0]+1); X absmaxfld = TRUE; X break; X case 'F': X fswitch = argv[0][2]; X break; X case 'n': X namelist = savestr(argv[0]+2); X break; X case '-': X argc--,argv++; X goto switch_end; X case 0: X break; X default: X fatal("Unrecognized switch: %s\n",argv[0]); X } X } X switch_end: X X /* open script */ X X if (argv[0] == Nullch) X argv[0] = "-"; X filename = savestr(argv[0]); X if (strEQ(filename,"-")) X argv[0] = ""; X if (!*argv[0]) X rsfp = stdin; X else X rsfp = fopen(argv[0],"r"); X if (rsfp == Nullfp) X fatal("Awk script \"%s\" doesn't seem to exist.\n",filename); X X /* init tokener */ X X bufptr = str_get(linestr); X symtab = hnew(); X X /* now parse the report spec */ X X if (yyparse()) X fatal("Translation aborted due to syntax errors.\n"); X X#ifdef DEBUGGING X if (debug & 2) { X int type, len; X X for (i=1; i<mop;) { X type = ops[i].ival; X len = type >> 8; X type &= 255; X printf("%d\t%d\t%d\t%-10s",i++,type,len,opname[type]); X if (type == OSTRING) X printf("\t\"%s\"\n",ops[i].cval),i++; X else { X while (len--) { X printf("\t%d",ops[i].ival),i++; X } X putchar('\n'); X } X } X } X if (debug & 8) X dump(root); X#endif X X /* first pass to look for numeric variables */ X X prewalk(0,0,root,&i); X X /* second pass to produce new program */ X X tmpstr = walk(0,0,root,&i); X str = str_make("#!/bin/perl\n\n"); X if (do_opens && opens) { X str_scat(str,opens); X str_free(opens); X str_cat(str,"\n"); X } X str_scat(str,tmpstr); X str_free(tmpstr); X#ifdef DEBUGGING X if (!(debug & 16)) X#endif X fixup(str); X putlines(str); X exit(0); X} X X#define RETURN(retval) return (bufptr = s,retval) X#define XTERM(retval) return (expectterm = TRUE,bufptr = s,retval) X#define XOP(retval) return (expectterm = FALSE,bufptr = s,retval) X#define ID(x) return (yylval=string(x,0),expectterm = FALSE,bufptr = s,VAR) X Xyylex() X{ X register char *s = bufptr; X register char *d; X register int tmp; X X retry: X#ifdef YYDEBUG X if (yydebug) X if (index(s,'\n')) X fprintf(stderr,"Tokener at %s",s); X else X fprintf(stderr,"Tokener at %s\n",s); X#endif X switch (*s) { X default: X fprintf(stderr, X "Unrecognized character %c in file %s line %d--ignoring.\n", X *s++,filename,line); X goto retry; X case '\\': X case 0: X s = str_get(linestr); X *s = '\0'; X if (!rsfp) X RETURN(0); X line++; X if ((s = str_gets(linestr, rsfp)) == Nullch) { X if (rsfp != stdin) X fclose(rsfp); X rsfp = Nullfp; X s = str_get(linestr); X RETURN(0); X } X goto retry; X case ' ': case '\t': X s++; X goto retry; X case '\n': X *s = '\0'; X XTERM(NEWLINE); X case '#': X yylval = string(s,0); X *s = '\0'; X XTERM(COMMENT); X case ';': X tmp = *s++; X if (*s == '\n') { X s++; X XTERM(SEMINEW); X } X XTERM(tmp); X case '(': X case '{': X case '[': X case ')': X case ']': X tmp = *s++; X XOP(tmp); X case 127: X s++; X XTERM('}'); X case '}': X for (d = s + 1; isspace(*d); d++) ; X if (!*d) X s = d - 1; X *s = 127; X XTERM(';'); X case ',': X tmp = *s++; X XTERM(tmp); X case '~': X s++; X XTERM(MATCHOP); X case '+': X case '-': X if (s[1] == *s) { X s++; X if (*s++ == '+') X XTERM(INCR); X else X XTERM(DECR); X } X /* FALL THROUGH */ X case '*': X case '%': X tmp = *s++; X if (*s == '=') { X yylval = string(s-1,2); X s++; X XTERM(ASGNOP); X } X XTERM(tmp); X case '&': X s++; X tmp = *s++; X if (tmp == '&') X XTERM(ANDAND); X s--; X XTERM('&'); X case '|': X s++; X tmp = *s++; X if (tmp == '|') X XTERM(OROR); X s--; X XTERM('|'); X case '=': X s++; X tmp = *s++; X if (tmp == '=') { X yylval = string("==",2); X XTERM(RELOP); X } X s--; X yylval = string("=",1); X XTERM(ASGNOP); X case '!': X s++; X tmp = *s++; X if (tmp == '=') { X yylval = string("!=",2); X XTERM(RELOP); X } X if (tmp == '~') { X yylval = string("!~",2); X XTERM(MATCHOP); X } X s--; X XTERM(NOT); X case '<': X s++; X tmp = *s++; X if (tmp == '=') { X yylval = string("<=",2); X XTERM(RELOP); X } X s--; X yylval = string("<",1); X XTERM(RELOP); X case '>': X s++; X tmp = *s++; X if (tmp == '=') { X yylval = string(">=",2); X XTERM(RELOP); X } X s--; X yylval = string(">",1); X XTERM(RELOP); X X#define SNARFWORD \ X d = tokenbuf; \ X while (isalpha(*s) || isdigit(*s) || *s == '_') \ X *d++ = *s++; \ X *d = '\0'; \ X d = tokenbuf; X X case '$': X s++; X if (*s == '0') { X s++; X do_chop = TRUE; X need_entire = TRUE; X ID("0"); X } X do_split = TRUE; X if (isdigit(*s)) { X for (d = s; isdigit(*s); s++) ; X yylval = string(d,s-d); X tmp = atoi(d); X if (tmp > maxfld) X maxfld = tmp; X XOP(FIELD); X } X split_to_array = set_array_base = TRUE; X XOP(VFIELD); X X case '/': /* may either be division or pattern */ X if (expectterm) { X s = scanpat(s); X XTERM(REGEX); X } X tmp = *s++; X if (*s == '=') { X yylval = string("/=",2); X s++; X XTERM(ASGNOP); X } X XTERM(tmp); X X case '0': case '1': case '2': case '3': case '4': X case '5': case '6': case '7': case '8': case '9': X s = scannum(s); X XOP(NUMBER); X case '"': X s++; X s = cpy2(tokenbuf,s,s[-1]); X if (!*s) X fatal("String not terminated:\n%s",str_get(linestr)); X s++; X yylval = string(tokenbuf,0); X XOP(STRING); X X case 'a': case 'A': X SNARFWORD; X ID(d); X case 'b': case 'B': X SNARFWORD; X if (strEQ(d,"break")) X XTERM(BREAK); X if (strEQ(d,"BEGIN")) X XTERM(BEGIN); X ID(d); X case 'c': case 'C': X SNARFWORD; X if (strEQ(d,"continue")) X XTERM(CONTINUE); X ID(d); X case 'd': case 'D': X SNARFWORD; X ID(d); X case 'e': case 'E': X SNARFWORD; X if (strEQ(d,"END")) X XTERM(END); X if (strEQ(d,"else")) X XTERM(ELSE); X if (strEQ(d,"exit")) { X saw_line_op = TRUE; X XTERM(EXIT); X } X if (strEQ(d,"exp")) { X yylval = OEXP; X XTERM(FUN1); X } X ID(d); X case 'f': case 'F': X SNARFWORD; X if (strEQ(d,"FS")) { X saw_FS++; X if (saw_FS == 1 && in_begin) { X for (d = s; *d && isspace(*d); d++) ; X if (*d == '=') { X for (d++; *d && isspace(*d); d++) ; X if (*d == '"' && d[2] == '"') X const_FS = d[1]; X } X } X ID(tokenbuf); X } X if (strEQ(d,"FILENAME")) X d = "ARGV"; X if (strEQ(d,"for")) X XTERM(FOR); X ID(d); X case 'g': case 'G': X SNARFWORD; X if (strEQ(d,"getline")) X XTERM(GETLINE); X ID(d); X case 'h': case 'H': X SNARFWORD; X ID(d); X case 'i': case 'I': X SNARFWORD; X if (strEQ(d,"if")) X XTERM(IF); X if (strEQ(d,"in")) X XTERM(IN); X if (strEQ(d,"index")) { X set_array_base = TRUE; X XTERM(INDEX); X } X if (strEQ(d,"int")) { X yylval = OINT; X XTERM(FUN1); X } X ID(d); X case 'j': case 'J': X SNARFWORD; X ID(d); X case 'k': case 'K': X SNARFWORD; X ID(d); X case 'l': case 'L': X SNARFWORD; X if (strEQ(d,"length")) { X yylval = OLENGTH; X XTERM(FUN1); X } X if (strEQ(d,"log")) { X yylval = OLOG; X XTERM(FUN1); X } X ID(d); X case 'm': case 'M': X SNARFWORD; X ID(d); X case 'n': case 'N': X SNARFWORD; X if (strEQ(d,"NF")) X do_split = split_to_array = set_array_base = TRUE; X if (strEQ(d,"next")) { X saw_line_op = TRUE; X XTERM(NEXT); X } X ID(d); X case 'o': case 'O': X SNARFWORD; X if (strEQ(d,"ORS")) { X saw_ORS = TRUE; X d = "$\\"; X } X if (strEQ(d,"OFS")) { X saw_OFS = TRUE; X d = "$,"; X } X if (strEQ(d,"OFMT")) { X d = "$#"; X } X ID(d); X case 'p': case 'P': X SNARFWORD; X if (strEQ(d,"print")) { X XTERM(PRINT); X } X if (strEQ(d,"printf")) { X XTERM(PRINTF); X } X ID(d); X case 'q': case 'Q': X SNARFWORD; X ID(d); X case 'r': case 'R': X SNARFWORD; X if (strEQ(d,"RS")) { X d = "$/"; X saw_RS = TRUE; X } X ID(d); X case 's': case 'S': X SNARFWORD; X if (strEQ(d,"split")) { X set_array_base = TRUE; X XOP(SPLIT); X } X if (strEQ(d,"substr")) { X set_array_base = TRUE; X XTERM(SUBSTR); X } X if (strEQ(d,"sprintf")) X XTERM(SPRINTF); X if (strEQ(d,"sqrt")) { X yylval = OSQRT; X XTERM(FUN1); X } X ID(d); X case 't': case 'T': X SNARFWORD; X ID(d); X case 'u': case 'U': X SNARFWORD; X ID(d); X case 'v': case 'V': X SNARFWORD; X ID(d); X case 'w': case 'W': X SNARFWORD; X if (strEQ(d,"while")) X XTERM(WHILE); X ID(d); X case 'x': case 'X': X SNARFWORD; X ID(d); X case 'y': case 'Y': X SNARFWORD; X ID(d); X case 'z': case 'Z': X SNARFWORD; X ID(d); X } X} X Xchar * Xscanpat(s) Xregister char *s; X{ X register char *d; X X switch (*s++) { X case '/': X break; X default: X fatal("Search pattern not found:\n%s",str_get(linestr)); X } X s = cpytill(tokenbuf,s,s[-1]); X if (!*s) X fatal("Search pattern not terminated:\n%s",str_get(linestr)); X s++; X yylval = string(tokenbuf,0); X return s; X} X Xyyerror(s) Xchar *s; X{ X fprintf(stderr,"%s in file %s at line %d\n", X s,filename,line); X} X Xchar * Xscannum(s) Xregister char *s; X{ X register char *d; X X switch (*s) { X case '1': case '2': case '3': case '4': case '5': X case '6': case '7': case '8': case '9': case '0' : case '.': X d = tokenbuf; X while (isdigit(*s) || *s == '_') X *d++ = *s++; X if (*s == '.' && index("0123456789eE",s[1])) X *d++ = *s++; X while (isdigit(*s) || *s == '_') X *d++ = *s++; X if (index("eE",*s) && index("+-0123456789",s[1])) X *d++ = *s++; X if (*s == '+' || *s == '-') X *d++ = *s++; X while (isdigit(*s)) X *d++ = *s++; X *d = '\0'; X yylval = string(tokenbuf,0); X break; X } X return s; X} X Xstring(ptr,len) Xchar *ptr; X{ X int retval = mop; X X ops[mop++].ival = OSTRING + (1<<8); X if (!len) X len = strlen(ptr); X ops[mop].cval = safemalloc(len+1); X strncpy(ops[mop].cval,ptr,len); X ops[mop++].cval[len] = '\0'; X return retval; X} X Xoper0(type) Xint type; X{ X int retval = mop; X X if (type > 255) X fatal("type > 255 (%d)\n",type); X ops[mop++].ival = type; X return retval; X} X Xoper1(type,arg1) Xint type; Xint arg1; X{ X int retval = mop; X X if (type > 255) X fatal("type > 255 (%d)\n",type); X ops[mop++].ival = type + (1<<8); X ops[mop++].ival = arg1; X return retval; X} X Xoper2(type,arg1,arg2) Xint type; Xint arg1; Xint arg2; X{ X int retval = mop; X X if (type > 255) X fatal("type > 255 (%d)\n",type); X ops[mop++].ival = type + (2<<8); X ops[mop++].ival = arg1; X ops[mop++].ival = arg2; X return retval; X} X Xoper3(type,arg1,arg2,arg3) Xint type; Xint arg1; Xint arg2; Xint arg3; X{ X int retval = mop; X X if (type > 255) X fatal("type > 255 (%d)\n",type); X ops[mop++].ival = type + (3<<8); X ops[mop++].ival = arg1; X ops[mop++].ival = arg2; X ops[mop++].ival = arg3; X return retval; X} X Xoper4(type,arg1,arg2,arg3,arg4) Xint type; Xint arg1; Xint arg2; Xint arg3; Xint arg4; X{ X int retval = mop; X X if (type > 255) X fatal("type > 255 (%d)\n",type); X ops[mop++].ival = type + (4<<8); X ops[mop++].ival = arg1; X ops[mop++].ival = arg2; X ops[mop++].ival = arg3; X ops[mop++].ival = arg4; X return retval; X} X Xoper5(type,arg1,arg2,arg3,arg4,arg5) Xint type; Xint arg1; Xint arg2; Xint arg3; Xint arg4; Xint arg5; X{ X int retval = mop; X X if (type > 255) X fatal("type > 255 (%d)\n",type); X ops[mop++].ival = type + (5<<8); X ops[mop++].ival = arg1; X ops[mop++].ival = arg2; X ops[mop++].ival = arg3; X ops[mop++].ival = arg4; X ops[mop++].ival = arg5; X return retval; X} X Xint depth = 0; X Xdump(branch) Xint branch; X{ X register int type; X register int len; X register int i; X X type = ops[branch].ival; X len = type >> 8; X type &= 255; X for (i=depth; i; i--) X printf(" "); X if (type == OSTRING) { X printf("%-5d\"%s\"\n",branch,ops[branch+1].cval); X } X else { X printf("(%-5d%s %d\n",branch,opname[type],len); X depth++; X for (i=1; i<=len; i++) X dump(ops[branch+i].ival); X depth--; X for (i=depth; i; i--) X printf(" "); X printf(")\n"); X } X} X Xbl(arg,maybe) Xint arg; Xint maybe; X{ X if (!arg) X return 0; X else if ((ops[arg].ival & 255) != OBLOCK) X return oper2(OBLOCK,arg,maybe); X else if ((ops[arg].ival >> 8) != 2) X return oper2(OBLOCK,ops[arg+1].ival,maybe); X else X return arg; X} X Xfixup(str) XSTR *str; X{ X register char *s; X register char *t; X X for (s = str->str_ptr; *s; s++) { X if (*s == ';' && s[1] == ' ' && s[2] == '\n') { X strcpy(s+1,s+2); X s++; X } X else if (*s == '\n') { X for (t = s+1; isspace(*t & 127); t++) ; X t--; X while (isspace(*t & 127) && *t != '\n') t--; X if (*t == '\n' && t-s > 1) { X if (s[-1] == '{') X s--; X strcpy(s+1,t); X } X s++; X } X } X} X Xputlines(str) XSTR *str; X{ X register char *d, *s, *t, *e; X register int pos, newpos; X X d = tokenbuf; X pos = 0; X for (s = str->str_ptr; *s; s++) { X *d++ = *s; X pos++; X if (*s == '\n') { X *d = '\0'; X d = tokenbuf; X pos = 0; X putone(); X } X else if (*s == '\t') X pos += 7; X if (pos > 78) { /* split a long line? */ X *d-- = '\0'; X newpos = 0; X for (t = tokenbuf; isspace(*t & 127); t++) { X if (*t == '\t') X newpos += 8; X else X newpos += 1; X } X e = d; X while (d > tokenbuf && (*d != ' ' || d[-1] != ';')) X d--; X if (d < t+10) { X d = e; X while (d > tokenbuf && X (*d != ' ' || d[-1] != '|' || d[-2] != '|') ) X d--; X } X if (d < t+10) { X d = e; X while (d > tokenbuf && X (*d != ' ' || d[-1] != '&' || d[-2] != '&') ) X d--; X } X if (d < t+10) { X d = e; X while (d > tokenbuf && (*d != ' ' || d[-1] != ',')) X d--; X } X if (d < t+10) { X d = e; X while (d > tokenbuf && *d != ' ') X d--; X } X if (d > t+3) { X *d = '\0'; X putone(); X putchar('\n'); X if (d[-1] != ';' && !(newpos % 4)) { X *t++ = ' '; X *t++ = ' '; X newpos += 2; X } X strcpy(t,d+1); X newpos += strlen(t); X d = t + strlen(t); X pos = newpos; X } X else X d = e + 1; X } X } X} X Xputone() X{ X register char *t; X X for (t = tokenbuf; *t; t++) { X *t &= 127; X if (*t == 127) { X *t = ' '; X strcpy(t+strlen(t)-1, "\t#???\n"); X } X } X t = tokenbuf; X if (*t == '#') { X if (strnEQ(t,"#!/bin/awk",10) || strnEQ(t,"#! /bin/awk",11)) X return; X } X fputs(tokenbuf,stdout); X} X Xnumary(arg) Xint arg; X{ X STR *key; X int dummy; X X key = walk(0,0,arg,&dummy); X str_cat(key,"[]"); X hstore(symtab,key->str_ptr,str_make("1")); X str_free(key); X set_array_base = TRUE; X return arg; X} !STUFFY!FUNK! echo Extracting cmd.c sed >cmd.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: cmd.c,v 1.0 87/12/18 13:04:51 root Exp $ X * X * $Log: cmd.c,v $ X * Revision 1.0 87/12/18 13:04:51 root X * Initial revision X * X */ X X#include "handy.h" X#include "EXTERN.h" X#include "search.h" X#include "util.h" X#include "perl.h" X Xstatic STR str_chop; X X/* This is the main command loop. We try to spend as much time in this loop X * as possible, so lots of optimizations do their activities in here. This X * means things get a little sloppy. X */ X XSTR * Xcmd_exec(cmd) Xregister CMD *cmd; X{ X SPAT *oldspat; X#ifdef DEBUGGING X int olddlevel; X int entdlevel; X#endif X register STR *retstr; X register char *tmps; X register int cmdflags; X register bool match; X register char *go_to = goto_targ; X ARG *arg; X FILE *fp; X X retstr = &str_no; X#ifdef DEBUGGING X entdlevel = dlevel; X#endif Xtail_recursion_entry: X#ifdef DEBUGGING X dlevel = entdlevel; X#endif X if (cmd == Nullcmd) X return retstr; X cmdflags = cmd->c_flags; /* hopefully load register */ X if (go_to) { X if (cmd->c_label && strEQ(go_to,cmd->c_label)) X goto_targ = go_to = Nullch; /* here at last */ X else { X switch (cmd->c_type) { X case C_IF: X oldspat = curspat; X#ifdef DEBUGGING X olddlevel = dlevel; X#endif X retstr = &str_yes; X if (cmd->ucmd.ccmd.cc_true) { X#ifdef DEBUGGING X debname[dlevel] = 't'; X debdelim[dlevel++] = '_'; X#endif X retstr = cmd_exec(cmd->ucmd.ccmd.cc_true); X } X if (!goto_targ) { X go_to = Nullch; X } else { X retstr = &str_no; X if (cmd->ucmd.ccmd.cc_alt) { X#ifdef DEBUGGING X debname[dlevel] = 'e'; X debdelim[dlevel++] = '_'; X#endif X retstr = cmd_exec(cmd->ucmd.ccmd.cc_alt); X } X } X if (!goto_targ) X go_to = Nullch; X curspat = oldspat; X#ifdef DEBUGGING X dlevel = olddlevel; X#endif X break; X case C_BLOCK: X case C_WHILE: X if (!(cmdflags & CF_ONCE)) { X cmdflags |= CF_ONCE; X loop_ptr++; X loop_stack[loop_ptr].loop_label = cmd->c_label; X#ifdef DEBUGGING X if (debug & 4) { X deb("(Pushing label #%d %s)\n", X loop_ptr,cmd->c_label); X } X#endif X } X switch (setjmp(loop_stack[loop_ptr].loop_env)) { X case O_LAST: /* not done unless go_to found */ X go_to = Nullch; X retstr = &str_no; X#ifdef DEBUGGING X olddlevel = dlevel; X#endif X curspat = oldspat; X#ifdef DEBUGGING X if (debug & 4) { X deb("(Popping label #%d %s)\n",loop_ptr, X loop_stack[loop_ptr].loop_label); X } X#endif X loop_ptr--; X cmd = cmd->c_next; X goto tail_recursion_entry; X case O_NEXT: /* not done unless go_to found */ X go_to = Nullch; X goto next_iter; X case O_REDO: /* not done unless go_to found */ X go_to = Nullch; X goto doit; X } X oldspat = curspat; X#ifdef DEBUGGING X olddlevel = dlevel; X#endif X if (cmd->ucmd.ccmd.cc_true) { X#ifdef DEBUGGING X debname[dlevel] = 't'; X debdelim[dlevel++] = '_'; X#endif X cmd_exec(cmd->ucmd.ccmd.cc_true); X } X if (!goto_targ) { X go_to = Nullch; X goto next_iter; X } X#ifdef DEBUGGING X dlevel = olddlevel; X#endif X if (cmd->ucmd.ccmd.cc_alt) { X#ifdef DEBUGGING X debname[dlevel] = 'a'; X debdelim[dlevel++] = '_'; X#endif X cmd_exec(cmd->ucmd.ccmd.cc_alt); X } X if (goto_targ) X break; X go_to = Nullch; X goto finish_while; X } X cmd = cmd->c_next; X if (cmd && cmd->c_head == cmd) /* reached end of while loop */ X return retstr; /* targ isn't in this block */ X goto tail_recursion_entry; X } X } X Xuntil_loop: X X#ifdef DEBUGGING X if (debug & 2) { X deb("%s (%lx) r%lx t%lx a%lx n%lx cs%lx\n", X cmdname[cmd->c_type],cmd,cmd->c_expr, X cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt,cmd->c_next,curspat); X } X debname[dlevel] = cmdname[cmd->c_type][0]; X debdelim[dlevel++] = '!'; X#endif X while (tmps_max >= 0) /* clean up after last eval */ X str_free(tmps_list[tmps_max--]); X X /* Here is some common optimization */ X X if (cmdflags & CF_COND) { X switch (cmdflags & CF_OPTIMIZE) { X X case CFT_FALSE: X retstr = cmd->c_first; X match = FALSE; X if (cmdflags & CF_NESURE) X goto maybe; X break; X case CFT_TRUE: X retstr = cmd->c_first; X match = TRUE; X if (cmdflags & CF_EQSURE) X goto flipmaybe; X break; X X case CFT_REG: X retstr = STAB_STR(cmd->c_stab); X match = str_true(retstr); /* => retstr = retstr, c2 should fix */ X if (cmdflags & (match ? CF_EQSURE : CF_NESURE)) X goto flipmaybe; X break; X X case CFT_ANCHOR: /* /^pat/ optimization */ X if (multiline) { X if (*cmd->c_first->str_ptr && !(cmdflags & CF_EQSURE)) X goto scanner; /* just unanchor it */ X else X break; /* must evaluate */ X } X /* FALL THROUGH */ X case CFT_STROP: /* string op optimization */ X retstr = STAB_STR(cmd->c_stab); X if (*cmd->c_first->str_ptr == *str_get(retstr) && X strnEQ(cmd->c_first->str_ptr, str_get(retstr), X cmd->c_flen) ) { X if (cmdflags & CF_EQSURE) { X match = !(cmdflags & CF_FIRSTNEG); X retstr = &str_yes; X goto flipmaybe; X } X } X else if (cmdflags & CF_NESURE) { X match = cmdflags & CF_FIRSTNEG; X retstr = &str_no; X goto flipmaybe; X } X break; /* must evaluate */ X X case CFT_SCAN: /* non-anchored search */ X scanner: X retstr = STAB_STR(cmd->c_stab); X if (instr(str_get(retstr),cmd->c_first->str_ptr)) { X if (cmdflags & CF_EQSURE) { X match = !(cmdflags & CF_FIRSTNEG); X retstr = &str_yes; X goto flipmaybe; X } X } X else if (cmdflags & CF_NESURE) { X match = cmdflags & CF_FIRSTNEG; X retstr = &str_no; X goto flipmaybe; X } X break; /* must evaluate */ X X case CFT_GETS: /* really a while (<file>) */ X last_in_stab = cmd->c_stab; X fp = last_in_stab->stab_io->fp; X retstr = defstab->stab_val; X if (fp && str_gets(retstr, fp)) { X last_in_stab->stab_io->lines++; X match = TRUE; X } X else if (last_in_stab->stab_io->flags & IOF_ARGV) X goto doeval; /* doesn't necessarily count as EOF yet */ X else { X retstr = &str_no; X match = FALSE; X } X goto flipmaybe; X case CFT_EVAL: X break; X case CFT_UNFLIP: X retstr = eval(cmd->c_expr,Null(char***)); X match = str_true(retstr); X if (cmd->c_expr->arg_type == O_FLIP) /* undid itself? */ X cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd); X goto maybe; X case CFT_CHOP: X retstr = cmd->c_stab->stab_val; X match = (retstr->str_cur != 0); X tmps = str_get(retstr); X tmps += retstr->str_cur - match; X str_set(&str_chop,tmps); X *tmps = '\0'; X retstr->str_nok = 0; X retstr->str_cur = tmps - retstr->str_ptr; X retstr = &str_chop; X goto flipmaybe; X } X X /* we have tried to make this normal case as abnormal as possible */ X X doeval: X retstr = eval(cmd->c_expr,Null(char***)); X match = str_true(retstr); X goto maybe; X X /* if flipflop was true, flop it */ X X flipmaybe: X if (match && cmdflags & CF_FLIP) { X if (cmd->c_expr->arg_type == O_FLOP) { /* currently toggled? */ X retstr = eval(cmd->c_expr,Null(char***)); /* let eval undo it */ X cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd); X } X else { X retstr = eval(cmd->c_expr,Null(char***)); /* let eval do it */ X if (cmd->c_expr->arg_type == O_FLOP) /* still toggled? */ X cmdflags = copyopt(cmd,cmd->c_expr[4].arg_ptr.arg_cmd); X } X } X else if (cmdflags & CF_FLIP) { X if (cmd->c_expr->arg_type == O_FLOP) { /* currently toggled? */ X match = TRUE; /* force on */ X } X } X X /* at this point, match says whether our expression was true */ X X maybe: X if (cmdflags & CF_INVERT) X match = !match; X if (!match && cmd->c_type != C_IF) { X cmd = cmd->c_next; X goto tail_recursion_entry; X } X } X X /* now to do the actual command, if any */ X X switch (cmd->c_type) { X case C_NULL: X fatal("panic: cmd_exec\n"); X case C_EXPR: /* evaluated for side effects */ X if (cmd->ucmd.acmd.ac_expr) { /* more to do? */ X retstr = eval(cmd->ucmd.acmd.ac_expr,Null(char***)); X } X break; X case C_IF: X oldspat = curspat; X#ifdef DEBUGGING X olddlevel = dlevel; X#endif X if (match) { X retstr = &str_yes; X if (cmd->ucmd.ccmd.cc_true) { X#ifdef DEBUGGING X debname[dlevel] = 't'; X debdelim[dlevel++] = '_'; X#endif X retstr = cmd_exec(cmd->ucmd.ccmd.cc_true); X } X } X else { X retstr = &str_no; X if (cmd->ucmd.ccmd.cc_alt) { X#ifdef DEBUGGING X debname[dlevel] = 'e'; X debdelim[dlevel++] = '_'; X#endif X retstr = cmd_exec(cmd->ucmd.ccmd.cc_alt); X } X } X curspat = oldspat; X#ifdef DEBUGGING X dlevel = olddlevel; X#endif X break; X case C_BLOCK: X case C_WHILE: X if (!(cmdflags & CF_ONCE)) { /* first time through here? */ X cmdflags |= CF_ONCE; X loop_ptr++; X loop_stack[loop_ptr].loop_label = cmd->c_label; X#ifdef DEBUGGING X if (debug & 4) { X deb("(Pushing label #%d %s)\n", X loop_ptr,cmd->c_label); X } X#endif X } X switch (setjmp(loop_stack[loop_ptr].loop_env)) { X case O_LAST: X retstr = &str_no; X curspat = oldspat; X#ifdef DEBUGGING X if (debug & 4) { X deb("(Popping label #%d %s)\n",loop_ptr, X loop_stack[loop_ptr].loop_label); X } X#endif X loop_ptr--; X cmd = cmd->c_next; X goto tail_recursion_entry; X case O_NEXT: X goto next_iter; X case O_REDO: X goto doit; X } X oldspat = curspat; X#ifdef DEBUGGING X olddlevel = dlevel; X#endif X doit: X if (cmd->ucmd.ccmd.cc_true) { X#ifdef DEBUGGING X debname[dlevel] = 't'; X debdelim[dlevel++] = '_'; X#endif X cmd_exec(cmd->ucmd.ccmd.cc_true); X } X /* actually, this spot is never reached anymore since the above X * cmd_exec() returns through longjmp(). Hooray for structure. X */ X next_iter: X#ifdef DEBUGGING X dlevel = olddlevel; X#endif X if (cmd->ucmd.ccmd.cc_alt) { X#ifdef DEBUGGING X debname[dlevel] = 'a'; X debdelim[dlevel++] = '_'; X#endif X cmd_exec(cmd->ucmd.ccmd.cc_alt); X } X finish_while: X curspat = oldspat; X#ifdef DEBUGGING X dlevel = olddlevel - 1; X#endif X if (cmd->c_type != C_BLOCK) X goto until_loop; /* go back and evaluate conditional again */ X } X if (cmdflags & CF_LOOP) { X cmdflags |= CF_COND; /* now test the condition */ X goto until_loop; X } X cmd = cmd->c_next; X goto tail_recursion_entry; X} X X#ifdef DEBUGGING X/*VARARGS1*/ Xdeb(pat,a1,a2,a3,a4,a5,a6,a7,a8) Xchar *pat; X{ X register int i; X X for (i=0; i<dlevel; i++) X fprintf(stderr,"%c%c ",debname[i],debdelim[i]); X fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8); X} X#endif X Xcopyopt(cmd,which) Xregister CMD *cmd; Xregister CMD *which; X{ X cmd->c_flags &= CF_ONCE|CF_COND|CF_LOOP; X cmd->c_flags |= which->c_flags; X cmd->c_first = which->c_first; X cmd->c_flen = which->c_flen; X cmd->c_stab = which->c_stab; X return cmd->c_flags; X} !STUFFY!FUNK! echo Extracting x2p/str.c sed >x2p/str.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: str.c,v 1.0 87/12/18 13:07:26 root Exp $ X * X * $Log: str.c,v $ X * Revision 1.0 87/12/18 13:07:26 root X * Initial revision X * X */ X X#include "handy.h" X#include "EXTERN.h" X#include "util.h" X#include "a2p.h" 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 Xchar * Xstr_2ptr(str) Xregister STR *str; X{ X register char *s; 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 sprintf(s,"%.20g",str->str_nval); X while (*s) s++; X } 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 str->str_nval = 0.0; 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->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 } 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 char *ptr; /* in the innermost loop into registers */ X register char newline = '\n'; /* (assuming at least 6 registers) */ X int i; X int bpx; 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 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 GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + cnt + 1); X bp = str->str_ptr + bpx; /* reconstitute our pointer */ 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_all_folks; X *bp++ = i; /* now go back to screaming loop */ X } X Xthats_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 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) { X str->str_nval = 1.0; X str->str_nok = 1; X return; X } X for (d = str->str_ptr; *d && *d != '.'; d++) ; X d--; X if (!isdigit(*str->str_ptr) || !isdigit(*d) ) { X str_numset(str,atof(str->str_ptr) + 1.0); /* punt */ X return; X } X while (d >= str->str_ptr) { X if (++*d <= '9') X return; X *(d--) = '0'; 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 *d = '1'; X} X Xvoid Xstr_dec(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) { X str->str_nval = -1.0; X str->str_nok = 1; X return; X } X for (d = str->str_ptr; *d && *d != '.'; d++) ; X d--; X if (!isdigit(*str->str_ptr) || !isdigit(*d) || (*d == '0' && d == str->str_ptr)) { X str_numset(str,atof(str->str_ptr) - 1.0); /* punt */ X return; X } X while (d >= str->str_ptr) { X if (--*d >= '0') X return; X *(d--) = '9'; X } 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 (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 malloc.c sed >malloc.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: malloc.c,v 1.0 87/12/18 13:05:35 root Exp $ X * X * $Log: malloc.c,v $ X * Revision 1.0 87/12/18 13:05:35 root X * Initial revision X * X */ X X#ifndef lint Xstatic char sccsid[] = "@(#)malloc.c 4.3 (Berkeley) 9/16/83"; X#endif X#include <stdio.h> X X#define RCHECK X/* X * malloc.c (Caltech) 2/21/82 X * Chris Kingsley, kingsley@cit-20. X * X * This is a very fast storage allocator. It allocates blocks of a small X * number of different sizes, and keeps free lists of each size. Blocks that X * don't exactly fit are passed up to the next larger size. In this X * implementation, the available sizes are 2^n-4 (or 2^n-12) bytes long. X * This is designed for use in a program that uses vast quantities of memory, X * but bombs when it runs out. X */ X X#include <sys/types.h> X X#define NULL 0 X X/* X * The overhead on a block is at least 4 bytes. When free, this space X * contains a pointer to the next free block, and the bottom two bits must X * be zero. When in use, the first byte is set to MAGIC, and the second X * byte is the size index. The remaining bytes are for alignment. X * If range checking is enabled and the size of the block fits X * in two bytes, then the top two bytes hold the size of the requested block X * plus the range checking words, and the header word MINUS ONE. X */ Xunion overhead { X union overhead *ov_next; /* when free */ X struct { X u_char ovu_magic; /* magic number */ X u_char ovu_index; /* bucket # */ X#ifdef RCHECK X u_short ovu_size; /* actual block size */ X u_int ovu_rmagic; /* range magic number */ X#endif X } ovu; X#define ov_magic ovu.ovu_magic X#define ov_index ovu.ovu_index X#define ov_size ovu.ovu_size X#define ov_rmagic ovu.ovu_rmagic X}; X X#define MAGIC 0xff /* magic # on accounting info */ X#define RMAGIC 0x55555555 /* magic # on range info */ X#ifdef RCHECK X#define RSLOP sizeof (u_int) X#else X#define RSLOP 0 X#endif X X/* X * nextf[i] is the pointer to the next free block of size 2^(i+3). The X * smallest allocatable block is 8 bytes. The overhead information X * precedes the data area returned to the user. X */ X#define NBUCKETS 30 Xstatic union overhead *nextf[NBUCKETS]; Xextern char *sbrk(); X X#ifdef MSTATS X/* X * nmalloc[i] is the difference between the number of mallocs and frees X * for a given block size. X */ Xstatic u_int nmalloc[NBUCKETS]; X#include <stdio.h> X#endif X X#ifdef debug X#define ASSERT(p) if (!(p)) botch("p"); else Xstatic Xbotch(s) X char *s; X{ X X printf("assertion botched: %s\n", s); X abort(); X} X#else X#define ASSERT(p) X#endif X Xchar * Xmalloc(nbytes) X register unsigned nbytes; X{ X register union overhead *p; X register int bucket = 0; X register unsigned shiftr; X X /* X * Convert amount of memory requested into X * closest block size stored in hash buckets X * which satisfies request. Account for X * space used per block for accounting. X */ X nbytes += sizeof (union overhead) + RSLOP; X nbytes = (nbytes + 3) &~ 3; X shiftr = (nbytes - 1) >> 2; X /* apart from this loop, this is O(1) */ X while (shiftr >>= 1) X bucket++; X /* X * If nothing in hash bucket right now, X * request more memory from the system. X */ X if (nextf[bucket] == NULL) X morecore(bucket); X if ((p = (union overhead *)nextf[bucket]) == NULL) X return (NULL); X /* remove from linked list */ X if (*((int*)p) > 0x10000000) X fprintf(stderr,"Corrupt malloc ptr 0x%x at 0x%x\n",*((int*)p),p); X nextf[bucket] = nextf[bucket]->ov_next; X p->ov_magic = MAGIC; X p->ov_index= bucket; X#ifdef MSTATS X nmalloc[bucket]++; X#endif X#ifdef RCHECK X /* X * Record allocated size of block and X * bound space with magic numbers. X */ X if (nbytes <= 0x10000) X p->ov_size = nbytes - 1; X p->ov_rmagic = RMAGIC; X *((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC; X#endif X return ((char *)(p + 1)); X} X X/* X * Allocate more memory to the indicated bucket. X */ Xstatic Xmorecore(bucket) X register bucket; X{ X register union overhead *op; X register int rnu; /* 2^rnu bytes will be requested */ X register int nblks; /* become nblks blocks of the desired size */ X register int siz; X X if (nextf[bucket]) X return; X /* X * Insure memory is allocated X * on a page boundary. Should X * make getpageize call? X */ X op = (union overhead *)sbrk(0); X if ((int)op & 0x3ff) X sbrk(1024 - ((int)op & 0x3ff)); X /* take 2k unless the block is bigger than that */ X rnu = (bucket <= 8) ? 11 : bucket + 3; X nblks = 1 << (rnu - (bucket + 3)); /* how many blocks to get */ X if (rnu < bucket) X rnu = bucket; X op = (union overhead *)sbrk(1 << rnu); X /* no more room! */ X if ((int)op == -1) X return; X /* X * Round up to minimum allocation size boundary X * and deduct from block count to reflect. X */ X if ((int)op & 7) { X op = (union overhead *)(((int)op + 8) &~ 7); X nblks--; X } X /* X * Add new memory allocated to that on X * free list for this hash bucket. X */ X nextf[bucket] = op; X siz = 1 << (bucket + 3); X while (--nblks > 0) { X op->ov_next = (union overhead *)((caddr_t)op + siz); X op = (union overhead *)((caddr_t)op + siz); X } X} X Xfree(cp) X char *cp; X{ X register int size; X register union overhead *op; X X if (cp == NULL) X return; X op = (union overhead *)((caddr_t)cp - sizeof (union overhead)); X#ifdef debug X ASSERT(op->ov_magic == MAGIC); /* make sure it was in use */ X#else X if (op->ov_magic != MAGIC) X return; /* sanity */ X#endif X#ifdef RCHECK X ASSERT(op->ov_rmagic == RMAGIC); X if (op->ov_index <= 13) X ASSERT(*(u_int *)((caddr_t)op + op->ov_size + 1 - RSLOP) == RMAGIC); X#endif X ASSERT(op->ov_index < NBUCKETS); X size = op->ov_index; X op->ov_next = nextf[size]; X nextf[size] = op; X#ifdef MSTATS X nmalloc[size]--; X#endif X} X X/* X * When a program attempts "storage compaction" as mentioned in the X * old malloc man page, it realloc's an already freed block. Usually X * this is the last block it freed; occasionally it might be farther X * back. We have to search all the free lists for the block in order X * to determine its bucket: 1st we make one pass thru the lists X * checking only the first block in each; if that fails we search X * ``realloc_srchlen'' blocks in each list for a match (the variable X * is extern so the caller can modify it). If that fails we just copy X * however many bytes was given to realloc() and hope it's not huge. X */ Xint realloc_srchlen = 4; /* 4 should be plenty, -1 =>'s whole list */ X Xchar * Xrealloc(cp, nbytes) X char *cp; X unsigned nbytes; X{ X register u_int onb; X union overhead *op; X char *res; X register int i; X int was_alloced = 0; X X if (cp == NULL) X return (malloc(nbytes)); X op = (union overhead *)((caddr_t)cp - sizeof (union overhead)); X if (op->ov_magic == MAGIC) { X was_alloced++; X i = op->ov_index; X } else { X /* X * Already free, doing "compaction". X * X * Search for the old block of memory on the X * free list. First, check the most common X * case (last element free'd), then (this failing) X * the last ``realloc_srchlen'' items free'd. X * If all lookups fail, then assume the size of X * the memory block being realloc'd is the X * smallest possible. X */ X if ((i = findbucket(op, 1)) < 0 && X (i = findbucket(op, realloc_srchlen)) < 0) X i = 0; X } X onb = (1 << (i + 3)) - sizeof (*op) - RSLOP; X /* avoid the copy if same size block */ X if (was_alloced && X nbytes <= onb && nbytes > (onb >> 1) - sizeof(*op) - RSLOP) X return(cp); X if ((res = malloc(nbytes)) == NULL) X return (NULL); X if (cp != res) /* common optimization */ X bcopy(cp, res, (nbytes < onb) ? nbytes : onb); X if (was_alloced) X free(cp); X return (res); X} X X/* X * Search ``srchlen'' elements of each free list for a block whose X * header starts at ``freep''. If srchlen is -1 search the whole list. X * Return bucket number, or -1 if not found. X */ Xstatic Xfindbucket(freep, srchlen) X union overhead *freep; X int srchlen; X{ X register union overhead *p; X register int i, j; X X for (i = 0; i < NBUCKETS; i++) { X j = 0; X for (p = nextf[i]; p && j != srchlen; p = p->ov_next) { X if (p == freep) X return (i); X j++; X } X } X return (-1); X} X X#ifdef MSTATS X/* X * mstats - print out statistics about malloc X * X * Prints two lines of numbers, one showing the length of the free list X * for each size category, the second showing the number of mallocs - X * frees for each size category. X */ Xmstats(s) X char *s; X{ X register int i, j; X register union overhead *p; X int totfree = 0, X totused = 0; X X fprintf(stderr, "Memory allocation statistics %s\nfree:\t", s); X for (i = 0; i < NBUCKETS; i++) { X for (j = 0, p = nextf[i]; p; p = p->ov_next, j++) X ; X fprintf(stderr, " %d", j); X totfree += j * (1 << (i + 3)); X } X fprintf(stderr, "\nused:\t"); X for (i = 0; i < NBUCKETS; i++) { X fprintf(stderr, " %d", nmalloc[i]); X totused += nmalloc[i] * (1 << (i + 3)); X } X fprintf(stderr, "\n\tTotal in use: %d, total free: %d\n", X totused, totfree); X} X#endif !STUFFY!FUNK! echo Extracting t/cmd.while sed >t/cmd.while <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: cmd.while,v 1.0 87/12/18 13:12:15 root Exp $ X Xprint "1..10\n"; X Xopen (tmp,'>Cmd.while.tmp') || die "Can't create Cmd.while.tmp."; Xprint tmp "tvi925\n"; Xprint tmp "tvi920\n"; Xprint tmp "vt100\n"; Xprint tmp "Amiga\n"; Xprint tmp "paper\n"; Xclose tmp; X X# test "last" command X Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp."; Xwhile (<fh>) { X last if /vt100/; X} Xif (!eof && /vt100/) {print "ok 1\n";} else {print "not ok 1\n";} X X# test "next" command X X$bad = ''; Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp."; Xwhile (<fh>) { X next if /vt100/; X $bad = 1 if /vt100/; X} Xif (!eof || /vt100/ || $bad) {print "not ok 2\n";} else {print "ok 2\n";} X X# test "redo" command X X$bad = ''; Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp."; Xwhile (<fh>) { X if (s/vt100/VT100/g) { X s/VT100/Vt100/g; X redo; X } X $bad = 1 if /vt100/; X $bad = 1 if /VT100/; X} Xif (!eof || $bad) {print "not ok 3\n";} else {print "ok 3\n";} X X# now do the same with a label and a continue block X X# test "last" command X X$badcont = ''; Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp."; Xline: while (<fh>) { X if (/vt100/) {last line;} X} continue { X $badcont = 1 if /vt100/; X} Xif (!eof && /vt100/) {print "ok 4\n";} else {print "not ok 4\n";} Xif (!$badcont) {print "ok 5\n";} else {print "not ok 5\n";} X X# test "next" command X X$bad = ''; X$badcont = 1; Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp."; Xentry: while (<fh>) { X next entry if /vt100/; X $bad = 1 if /vt100/; X} continue { X $badcont = '' if /vt100/; X} Xif (!eof || /vt100/ || $bad) {print "not ok 6\n";} else {print "ok 6\n";} Xif (!$badcont) {print "ok 7\n";} else {print "not ok 7\n";} X X# test "redo" command X X$bad = ''; X$badcont = ''; Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp."; Xloop: while (<fh>) { X if (s/vt100/VT100/g) { X s/VT100/Vt100/g; X redo loop; X } X $bad = 1 if /vt100/; X $bad = 1 if /VT100/; X} continue { X $badcont = 1 if /vt100/; X} Xif (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";} Xif (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";} X X`/bin/rm -f Cmd.while.tmp`; X X#$x = 0; X#while (1) { X# if ($x > 1) {last;} X# next; X#} continue { X# if ($x++ > 10) {last;} X# next; X#} X# X#if ($x < 10) {print "ok 10\n";} else {print "not ok 10\n";} X X$i = 9; X{ X $i++; X} Xprint "ok $i\n"; !STUFFY!FUNK! echo Extracting t/op.push sed >t/op.push <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.push,v 1.0 87/12/18 13:14:10 root Exp $ X Xprint "1..2\n"; X X@x = (1,2,3); Xpush(@x,@x); Xif (join(x,':') eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";} Xpush(x,4); Xif (join(x,':') eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";} !STUFFY!FUNK! echo "" echo "End of kit 7 (of 10)" cat /dev/null >kit7isdone config=true for iskit in 1 2 3 4 5 6 7 8 9 10; do if test -f kit${iskit}isdone; then echo "You have run kit ${iskit}." else echo "You still need to run kit ${iskit}." config=false fi done case $config in true) echo "You have run all your kits. Please read README and then type Configure." chmod 755 Configure ;; esac : Someone might mail this, so... exit -- For comp.sources.unix stuff, mail to sources@uunet.uu.net.