rsalz@bbn.com (Rich Salz) (07/13/88)
Submitted-by: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Posting-number: Volume 15, Issue 100
Archive-name: perl2/part11
#! /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 11 (of 15). If kit 11 is complete, the line"
echo '"'"End of kit 11 (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/str.c
sed >x2p/str.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: str.c,v 2.0 88/06/05 00:16:02 root Exp $
X *
X * $Log: str.c,v $
X * Revision 2.0 88/06/05 00:16:02 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
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 STDCHAR *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) {
X if ((*bp++ = *ptr++) == newline)
X if (bp <= str->str_ptr || bp[-2] != '\\')
X goto thats_all_folks;
X else {
X line++;
X bp -= 2;
X }
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 2.0 88/06/05 00:09:16 root Exp $
X *
X * $Log: malloc.c,v $
X * Revision 2.0 88/06/05 00:09:16 root
X * Baseline version 2.0.
X *
X */
X
X#ifndef lint
Xstatic char sccsid[] = "@(#)malloc.c 4.3 (Berkeley) 9/16/83";
X#endif
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 "EXTERN.h"
X#include "perl.h"
X
X/* I don't much care whether these are defined in sys/types.h--LAW */
X
X#define u_char unsigned char
X#define u_int unsigned int
X#define u_short unsigned short
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 OLDMAGIC 0x7f /* same after a free() */
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 fprintf(stderr,"%s free() ignored\n",
X op->ov_magic == OLDMAGIC ? "Duplicate" : "Bad");
X return; /* sanity */
X }
X op->ov_magic = OLDMAGIC;
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 * ``reall_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 reall_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 ``reall_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, reall_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 MANIFEST
sed >MANIFEST <<'!STUFFY!FUNK!' -e 's/X//'
XAfter all the perl kits are run you should have the following files:
X
XFilename Kit Description
X-------- --- -----------
XChanges 13 Differences between 1.0 level 29 and 2.0 level 0
XConfigure 6 Run this first
XEXTERN.h 6 Included before foreign .h files
XINTERN.h 15 Included before domestic .h files
XMANIFEST 11 This list of files
XMakefile.SH 13 Precursor to Makefile
XREADME 1 The Instructions
XWishlist 4 Some things that may or may not happen
Xarg.c 1 Expression evaluation
Xarg.h 12 Public declarations for the above
Xarray.c 13 Numerically subscripted arrays
Xarray.h 15 Public declarations for the above
Xcmd.c 10 Command interpreter
Xcmd.h 13 Public declarations for the above
Xconfig.H 13 Sample config.h
Xconfig.h.SH 11 Produces config.h.
Xdump.c 12 Debugging output
Xeg/ADB 15 An adb wrapper to put in your crash dir
Xeg/README 1 Intro to example perl scripts
Xeg/changes 15 A program to list recently changed files
Xeg/dus 15 A program to do du -s on non-mounted dirs
Xeg/findcp 14 A find wrapper that implements a -cp switch
Xeg/findtar 15 A find wrapper that pumps out a tar file
Xeg/g/gcp 14 A program to do a global rcp
Xeg/g/gcp.man 14 Manual page for gcp
Xeg/g/ged 1 A program to do a global edit
Xeg/g/ghosts 15 A sample /etc/ghosts file
Xeg/g/gsh 10 A program to do a global rsh
Xeg/g/gsh.man 14 Manual page for gsh
Xeg/myrup 15 A program to find lightly loaded machines
Xeg/nih 15 Script to insert #! workaround
Xeg/rmfrom 15 A program to feed doomed filenames to
Xeg/scan/scan_df 14 Scan for filesystem anomalies
Xeg/scan/scan_last 14 Scan for login anomalies
Xeg/scan/scan_messages 13 Scan for console message anomalies
Xeg/scan/scan_passwd 15 Scan for passwd file anomalies
Xeg/scan/scan_ps 15 Scan for process anomalies
Xeg/scan/scan_sudo 14 Scan for sudo anomalies
Xeg/scan/scan_suid 8 Scan for setuid anomalies
Xeg/scan/scanner 14 An anomaly reporter
Xeg/shmkill 15 A program to remove unused shared memory
Xeg/van/empty 15 A program to empty the trashcan
Xeg/van/unvanish 14 A program to undo what vanish does
Xeg/van/vanexp 15 A program to expire vanished files
Xeg/van/vanish 14 A program to put files in a trashcan
Xeval.c 8 The expression evaluator
Xform.c 12 Format processing
Xform.h 15 Public declarations for the above
Xhandy.h 15 Handy definitions
Xhash.c 12 Associative arrays
Xhash.h 14 Public declarations for the above
Xlib/getopt.pl 14 Perl library supporting option parsing
Xlib/importenv.pl 15 Perl routine to get environment into variables.
Xlib/stat.pl 15 Perl library supporting stat function
Xmakedepend.SH 5 Precursor to makedepend
Xmakedir.SH 14 Precursor to makedir
Xmalloc.c 11 A version of malloc you might not want
Xpatchlevel.h 12 The current patch level of perl
Xperl.h 12 Global declarations
Xperl.man.1 5 The manual page(s), first half
Xperl.man.2 3 The manual page(s), second half
Xperl.y 10 Yacc grammar for perl
Xperldb 11 Perl symbolic debugger
Xperldb.man 13 Manual page for perl debugger
Xperlsh 15 A poor man's perl shell.
Xperly.c 4 The perl compiler
Xregexp.c 2 String matching
Xregexp.h 14 Public declarations for the above
Xspat.h 14 Search pattern declarations
Xstab.c 6 Symbol table stuff
Xstab.h 3 Public declarations for the above
Xstr.c 7 String handling package
Xstr.h 14 Public declarations for the above
Xt/README 1 Instructions for regression tests
Xt/TEST 14 The regression tester
Xt/base.cond 15 See if conditionals work
Xt/base.if 15 See if if works
Xt/base.lex 15 See if lexical items work
Xt/base.pat 15 See if pattern matching works
Xt/base.term 15 See if various terms work
Xt/cmd.elsif 15 See if else-if works
Xt/cmd.for 15 See if for loops work
Xt/cmd.mod 15 See if statement modifiers work
Xt/cmd.subval 14 See if subroutine values work
Xt/cmd.while 14 See if while loops work
Xt/comp.cmdopt 13 See if command optimization works
Xt/comp.cpp 15 See if C preprocessor works
Xt/comp.decl 15 See if declarations work
Xt/comp.multiline 15 See if multiline strings work
Xt/comp.script 14 See if script invokation works
Xt/comp.term 15 See if more terms work
Xt/io.argv 15 See if ARGV stuff works
Xt/io.dup 15 See if >& works right
Xt/io.fs 12 See if directory manipulations work
Xt/io.inplace 15 See if inplace editing works
Xt/io.pipe 15 See if secure pipes work
Xt/io.print 15 See if print commands work
Xt/io.tell 13 See if file seeking works
Xt/op.append 15 See if . works
Xt/op.auto 14 See if autoincrement et all work
Xt/op.chop 15 See if chop works
Xt/op.cond 5 See if conditional expressions work
Xt/op.delete 15 See if delete works
Xt/op.do 14 See if subroutines work
Xt/op.each 14 See if associative iterators work
Xt/op.eval 14 See if eval operator works
Xt/op.exec 15 See if exec and system work
Xt/op.exp 15 See if math functions work
Xt/op.flip 15 See if range operator works
Xt/op.fork 15 See if fork works
Xt/op.goto 15 See if goto works
Xt/op.int 15 See if int works
Xt/op.join 15 See if join works
Xt/op.list 14 See if array lists work
Xt/op.magic 15 See if magic variables work
Xt/op.oct 15 See if oct and hex work
Xt/op.ord 15 See if ord works
Xt/op.pat 14 See if esoteric patterns work
Xt/op.push 15 See if push and pop work
Xt/op.regexp 15 See if regular expressions work
Xt/op.repeat 15 See if x operator works
Xt/op.sleep 15 See if sleep works
Xt/op.split 7 See if split works
Xt/op.sprintf 15 See if sprintf works
Xt/op.stat 11 See if stat works
Xt/op.study 14 See if study works
Xt/op.subst 14 See if substitutions work
Xt/op.time 14 See if time functions work
Xt/op.unshift 15 See if unshift works
Xt/re_tests 13 Input file for op.regexp
Xtoke.c 9 The tokener
Xutil.c 8 Utility routines
Xutil.h 15 Public declarations for the above
Xversion.c 15 Prints version of perl
Xx2p/EXTERN.h 15 Same as above
Xx2p/INTERN.h 15 Same as above
Xx2p/Makefile.SH 4 Precursor to Makefile
Xx2p/a2p.h 13 Global declarations
Xx2p/a2p.man 12 Manual page for awk to perl translator
Xx2p/a2p.y 12 A yacc grammer for awk
Xx2p/a2py.c 9 Awk compiler, sort of
Xx2p/handy.h 15 Handy definitions
Xx2p/hash.c 13 Associative arrays again
Xx2p/hash.h 14 Public declarations for the above
Xx2p/s2p 10 Sed to perl translator
Xx2p/s2p.man 9 Manual page for sed to perl translator
Xx2p/str.c 11 String handling package
Xx2p/str.h 15 Public declarations for the above
Xx2p/util.c 13 Utility routines
Xx2p/util.h 15 Public declarations for the above
Xx2p/walk.c 7 Parse tree walker
!STUFFY!FUNK!
echo Extracting config.h.SH
sed >config.h.SH <<'!STUFFY!FUNK!' -e 's/X//'
Xcase $CONFIG in
X'')
X if test ! -f config.sh; then
X ln ../config.sh . || \
X ln ../../config.sh . || \
X ln ../../../config.sh . || \
X (echo "Can't find config.sh."; exit 1)
X echo "Using config.sh from above..."
X fi
X . ./config.sh
X ;;
Xesac
Xecho "Extracting config.h (with variable substitutions)"
Xcat <<!GROK!THIS! >config.h
X/* config.h
X * This file was produced by running the config.h.SH script, which
X * gets its values from config.sh, which is generally produced by
X * running Configure.
X *
X * Feel free to modify any of this as the need arises. Note, however,
X * that running config.h.SH again will wipe out any changes you've made.
X * For a more permanent change edit config.sh and rerun config.h.SH.
X */
X
X
X/* EUNICE:
X * This symbol, if defined, indicates that the program is being compiled
X * under the EUNICE package under VMS. The program will need to handle
X * things like files that don't go away the first time you unlink them,
X * due to version numbering. It will also need to compensate for lack
X * of a respectable link() command.
X */
X/* VMS:
X * This symbol, if defined, indicates that the program is running under
X * VMS. It is currently only set in conjunction with the EUNICE symbol.
X */
X#$d_eunice EUNICE /**/
X#$d_eunice VMS /**/
X
X/* CPPSTDIN:
X * This symbol contains the first part of the string which will invoke
X * the C preprocessor on the standard input and produce to standard
X * output. Typical value of "cc -E" or "/lib/cpp".
X */
X/* CPPMINUS:
X * This symbol contains the second part of the string which will invoke
X * the C preprocessor on the standard input and produce to standard
X * output. This symbol will have the value "-" if CPPSTDIN needs a minus
X * to specify standard input, otherwise the value is "".
X */
X#define CPPSTDIN "$cppstdin"
X#define CPPMINUS "$cppminus"
X
X/* BCOPY:
X * This symbol, if defined, indicates that the bcopy routine is available
X * to copy blocks of memory. Otherwise you should probably use memcpy().
X */
X#$d_bcopy BCOPY /**/
X
X/* CHARSPRINTF:
X * This symbol is defined if this system declares "char *sprintf()" in
X * stdio.h. The trend seems to be to declare it as "int sprintf()". It
X * is up to the package author to declare sprintf correctly based on the
X * symbol.
X */
X#$d_charsprf CHARSPRINTF /**/
X
X/* CRYPT:
X * This symbol, if defined, indicates that the crypt routine is available
X * to encrypt passwords and the like.
X */
X#$d_crypt CRYPT /**/
X
X/* FCHMOD:
X * This symbol, if defined, indicates that the fchmod routine is available
X * to change mode of opened files. If unavailable, use chmod().
X */
X#$d_fchmod FCHMOD /**/
X
X/* FCHOWN:
X * This symbol, if defined, indicates that the fchown routine is available
X * to change ownership of opened files. If unavailable, use chown().
X */
X#$d_fchown FCHOWN /**/
X
X/* GETGROUPS:
X * This symbol, if defined, indicates that the getgroups() routine is
X * available to get the list of process groups. If unavailable, multiple
X * groups are probably not supported.
X */
X#$d_getgrps GETGROUPS /**/
X
X/* index:
X * This preprocessor symbol is defined, along with rindex, if the system
X * uses the strchr and strrchr routines instead.
X */
X/* rindex:
X * This preprocessor symbol is defined, along with index, if the system
X * uses the strchr and strrchr routines instead.
X */
X#$d_index index strchr /* cultural */
X#$d_index rindex strrchr /* differences? */
X
X/* KILLPG:
X * This symbol, if defined, indicates that the killpg routine is available
X * to kill process groups. If unavailable, you probably should use kill
X * with a negative process number.
X */
X#$d_killpg KILLPG /**/
X
X/* MEMCPY:
X * This symbol, if defined, indicates that the memcpy routine is available
X * to copy blocks of memory. Otherwise you should probably use bcopy().
X * If neither is defined, roll your own.
X */
X#$d_memcpy MEMCPY /**/
X
X/* RENAME:
X * This symbol, if defined, indicates that the rename routine is available
X * to rename files. Otherwise you should do the unlink(), link(), unlink()
X * trick.
X */
X#$d_rename RENAME /**/
X
X/* SETEGID:
X * This symbol, if defined, indicates that the setegid routine is available
X * to change the effective gid of the current program.
X */
X#$d_setegid SETEGID /**/
X
X/* SETEUID:
X * This symbol, if defined, indicates that the seteuid routine is available
X * to change the effective uid of the current program.
X */
X#$d_seteuid SETEUID /**/
X
X/* SETRGID:
X * This symbol, if defined, indicates that the setrgid routine is available
X * to change the real gid of the current program.
X */
X#$d_setrgid SETRGID /**/
X
X/* SETRUID:
X * This symbol, if defined, indicates that the setruid routine is available
X * to change the real uid of the current program.
X */
X#$d_setruid SETRUID /**/
X
X/* STATBLOCKS:
X * This symbol is defined if this system has a stat structure declaring
X * st_blksize and st_blocks.
X */
X#$d_statblks STATBLOCKS /**/
X
X/* STDSTDIO:
X * This symbol is defined if this system has a FILE structure declaring
X * _ptr and _cnt in stdio.h.
X */
X#$d_stdstdio STDSTDIO /**/
X
X/* STRCSPN:
X * This symbol, if defined, indicates that the strcspn routine is available
X * to scan strings.
X */
X#$d_strcspn STRCSPN /**/
X
X/* STRUCTCOPY:
X * This symbol, if defined, indicates that this C compiler knows how
X * to copy structures. If undefined, you'll need to use a block copy
X * routine of some sort instead.
X */
X#$d_strctcpy STRUCTCOPY /**/
X
X/* SYMLINK:
X * This symbol, if defined, indicates that the symlink routine is available
X * to create symbolic links.
X */
X#$d_symlink SYMLINK /**/
X
X/* TMINSYS:
X * This symbol is defined if this system declares "struct tm" in
X * in <sys/time.h> rather than <time.h>. We can't just say
X * -I/usr/include/sys because some systems have both time files, and
X * the -I trick gets the wrong one.
X */
X#$d_tminsys TMINSYS /**/
X
X/* vfork:
X * This symbol, if defined, remaps the vfork routine to fork if the
X * vfork() routine isn't supported here.
X */
X#$d_vfork vfork fork /**/
X
X/* VOIDSIG:
X * This symbol is defined if this system declares "void (*signal())()" in
X * signal.h. The old way was to declare it as "int (*signal())()". It
X * is up to the package author to declare things correctly based on the
X * symbol.
X */
X#$d_voidsig VOIDSIG /**/
X
X/* GIDTYPE:
X * This symbol has a value like gid_t, int, ushort, or whatever type is
X * used to declare group ids in the kernel.
X */
X#define GIDTYPE $gidtype /**/
X
X/* STDCHAR:
X * This symbol is defined to be the type of char used in stdio.h.
X * It has the values "unsigned char" or "char".
X */
X#define STDCHAR $stdchar /**/
X
X/* UIDTYPE:
X * This symbol has a value like uid_t, int, ushort, or whatever type is
X * used to declare user ids in the kernel.
X */
X#define UIDTYPE $uidtype /**/
X
X/* VOIDFLAGS:
X * This symbol indicates how much support of the void type is given by this
X * compiler. What various bits mean:
X *
X * 1 = supports declaration of void
X * 2 = supports arrays of pointers to functions returning void
X * 4 = supports comparisons between pointers to void functions and
X * addresses of void functions
X *
X * The package designer should define VOIDUSED to indicate the requirements
X * of the package. This can be done either by #defining VOIDUSED before
X * including config.h, or by defining defvoidused in Myinit.U. If the
X * level of void support necessary is not present, defines void to int.
X */
X#ifndef VOIDUSED
X#define VOIDUSED $defvoidused
X#endif
X#define VOIDFLAGS $voidflags
X#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
X#$define void int /* is void to be avoided? */
X#$define M_VOID /* Xenix strikes again */
X#endif
X
X/* PRIVLIB:
X * This symbol contains the name of the private library for this package.
X * The library is private in the sense that it needn't be in anyone's
X * execution path, but it should be accessible by the world.
X */
X#define PRIVLIB "$privlib" /**/
X
X!GROK!THIS!
!STUFFY!FUNK!
echo Extracting perldb
sed >perldb <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: perldb,v 2.0 88/06/05 00:09:45 root Exp $
X#
X# $Log: perldb,v $
X# Revision 2.0 88/06/05 00:09:45 root
X# Baseline version 2.0.
X#
X#
X
X$tmp = "/tmp/pdb$$"; # default temporary file, -o overrides.
X
X# parse any switches
X
Xwhile ($ARGV[0] =~ /^-/) {
X $_ = shift;
X /^-o$/ && ($tmp = shift,next);
X die "Unrecognized switch: $_";
X}
X
X$filename = shift;
Xdie "Usage: perldb [-o output] scriptname arguments" unless $filename;
X
Xopen(script,$filename) || die "Can't find $filename";
X
Xopen(tmp, ">$tmp") || die "Can't make temp script";
X
X$perl = '/usr/bin/perl';
X$init = 1;
X$state = 'statement';
X
X# now translate script to contain DB calls at the appropriate places
X
Xwhile (<script>) {
X chop;
X if ($. == 1) {
X if (/^#! *([^ \t]*) (-[^ \t]*)/) {
X $perl = $1;
X $switch = $2;
X }
X elsif (/^#! *([^ \t]*)/) {
X $perl = $1;
X }
X }
X s/ *$//;
X push(@script,$_); # remember line for DBinit
X $line = $_;
X next if /^$/; # blank lines are uninteresting
X next if /^[ \t]*#/; # likewise comment lines
X if ($init) {
X print tmp "do DBinit($.);"; $init = '';
X }
X if ($inform) { # skip formats
X if (/^\.$/) {
X $inform = '';
X $state = 'statement';
X }
X next;
X }
X if (/^[ \t]*format /) {
X $inform++;
X next;
X }
X if ($state eq 'statement' &&
X !/^[ \t]*}|^[ \t]*else|^[ \t]*continue|^[ \t]*elsif/) {
X if (s/^([ \t]*[A-Za-z_0-9]+:)//) {
X $label = $1;
X }
X else {
X $label = '';
X }
X $line = $label . "do DB($.); " . $_; # all that work for this line
X }
X else {
X $script[$#script - 1] .= ' '; # mark line as having continuation
X }
X do parse(); # set $state to correct eol value
X}
Xcontinue {
X print tmp $line,"\n";
X}
X
X# now put out our debugging subroutines. First the one that's called all over.
X
Xprint tmp '
Xsub DB {
X push(@DB,$. ,$@, $!, $[, $,, $/, $\ );
X $[ = 0; $, = ""; $/ = "\n"; $\ = "";
X $DBline=pop(@_);
X if ($DBsingle || $DBstop[$DBline] || $DBtrace) {
X print "$DBline:\t",$DBline[$DBline],"\n";
X for ($DBi = $DBline; $DBline[$DBi++] =~ / $/; ) {
X print "$DBi:\t",$DBline[$DBi],"\n";
X }
X }
X if ($DBaction[$DBline]) {
X eval $DBaction[$DBline]; print $@;
X }
X if ($DBstop[$DBline] || $DBsingle) {
X for (;;) {
X print "perldb> ";
X $DBcmd = <stdin>;
X last if $DBcmd =~ /^$/;
X if ($DBcmd =~ /^q$/) {
X exit 0;
X }
X if ($DBcmd =~ /^h$/) {
X print "
Xs Single step.
Xc Continue.
X<CR> Repeat last s or c.
Xl min-max List lines.
Xl line List line.
Xl List the whole program.
XL List breakpoints.
Xt Toggle trace mode.
Xb line Set breakpoint.
Xd line Delete breakpoint.
Xd Delete breakpoint at this line.
Xa line command Set an action for this line.
Xq Quit.
Xcommand Execute as a perl statement.
X
X";
X next;
X }
X if ($DBcmd =~ /^t$/) {
X $DBtrace = !$DBtrace;
X print "Trace = $DBtrace\n";
X next;
X }
X if ($DBcmd =~ /^l (.*)[-,](.*)/) {
X for ($DBi = $1; $DBi <= $2; $DBi++) {
X print "$DBi:\t", $DBline[$DBi], "\n";
X }
X next;
X }
X if ($DBcmd =~ /^l (.*)/) {
X print "$1:\t", $DBline[$1], "\n";
X next;
X }
X if ($DBcmd =~ /^l$/) {
X for ($DBi = 1; $DBi <= $DBmax ; $DBi++) {
X print "$DBi:\t", $DBline[$DBi], "\n";
X }
X next;
X }
X if ($DBcmd =~ /^L$/) {
X for ($DBi = 1; $DBi <= $DBmax ; $DBi++) {
X print "$DBi:\t", $DBline[$DBi], "\n" if $DBstop[$DBi];
X }
X next;
X }
X if ($DBcmd =~ /^b (.*)/) {
X $DBi = $1;
X if ($DBline[$DBi-1] =~ / $/) {
X print "Line $DBi not breakable.\n";
X }
X else {
X $DBstop[$DBi] = 1;
X }
X next;
X }
X if ($DBcmd =~ /^d (.*)/) {
X $DBstop[$1] = 0;
X next;
X }
X if ($DBcmd =~ /^d$/) {
X $DBstop[$DBline] = 0;
X next;
X }
X if ($DBcmd =~ /^a ([0-9]+)[ \t]+(.*)/) {
X $DBi = $1;
X $DBaction = $2;
X $DBaction .= ";" unless $DBaction =~ /[;}]$/;
X $DBaction[$DBi] = $DBaction;
X next;
X }
X if ($DBcmd =~ /^s$/) {
X $DBsingle = 1;
X last;
X }
X if ($DBcmd =~ /^c$/) {
X $DBsingle = 0;
X last;
X }
X chop($DBcmd);
X $DBcmd .= ";" unless $DBcmd =~ /[;}]$/;
X eval $DBcmd;
X print $@,"\n";
X }
X }
X $\ = pop(@DB);
X $/ = pop(@DB);
X $, = pop(@DB);
X $[ = pop(@DB);
X $! = pop(@DB);
X $@ = pop(@DB);
X $. = pop(@DB);
X}
X
Xsub DBinit {
X $DBstop[$_[0]] = 1;
X';
Xprint tmp " \$0 = '$script';\n";
Xprint tmp " \$DBmax = $.;\n";
Xprint tmp " unlink '/tmp/pdb$$';\n"; # expected to fail on -o.
Xfor ($i = 1; $#script >= 0; $i++) {
X $_ = shift(@script);
X s/'/\\'/g;
X print tmp " \$DBline[$i] = '$_';\n";
X}
Xprint tmp '}
X';
X
Xclose tmp;
X
X# prepare to run the new script
X
Xunshift(@ARGV,$tmp);
Xunshift(@ARGV,$switch) if $switch;
Xunshift(@ARGV,$perl);
Xexec @ARGV;
X
X# This routine tokenizes one perl line good enough to tell what state we are
X# in by the end of the line, so we can tell if the next line should contain
X# a call to DB or not.
X
Xsub parse {
X until ($_ eq '') {
X $ord = ord($_);
X if ($quoting) {
X if ($quote == $ord) {
X $quoting--;
X }
X s/^.// if /^[\\]/;
X s/^.//;
X last if $_ eq "\n";
X $state = 'term' unless $quoting;
X next;
X }
X if ($ord > 64) {
X do quote(ord($1),1), next if s/^m\b(.)//;
X do quote(ord($1),2), next if s/^s\b(.)//;
X do quote(ord($1),2), next if s/^y\b(.)//;
X do quote(ord($1),2), next if s/^tr\b(.)//;
X do quote($ord,1), next if s/^`//;
X next if s/^[A-Za-z_][A-Za-z_0-9]*://;
X $state = 'term', next if s/^eof\b//;
X $state = 'term', next if s/^shift\b//;
X $state = 'term', next if s/^split\b//;
X $state = 'term', next if s/^tell\b//;
X $state = 'term', next if s/^write\b//;
X $state = 'operator', next if s/^[A-Za-z_][A-Za-z_0-9]*//;
X $state = 'operator', next if s/^[~^|]+//;
X $state = 'statement', next if s/^{//;
X $state = 'statement', next if s/^}[ \t]*$//;
X $state = 'statement', next if s/^}[ \t]*#/#/;
X $state = 'term', next if s/^}//;
X $state = 'operator', next if s/^\[//;
X $state = 'term', next if s/^]//;
X die "Illegal character $_";
X }
X elsif ($ord < 33) {
X next if s/[ \t\n\f]+//;
X die "Illegal character $_";
X }
X else {
X $state = 'statement', next if s/^;//;
X $state = 'term', next if s/^\.[0-9eE]+//;
X $state = 'term', next if s/^[0-9][0-9xaAbBcCddeEfF.]*//;
X $state = 'term', next if s/^\$[A-Za-z_][A-Za-z_0-9]*//;
X $state = 'term', next if s/^\$.//;
X $state = 'term', next if s/^@[A-Za-z_][A-Za-z_0-9]*//;
X $state = 'term', next if s/^@.//;
X $state = 'term', next if s/^<[A-Za-z_0-9]*>//;
X next if s/^\+\+//;
X next if s/^--//;
X $state = 'operator', next if s/^[-(!%&*=+:,.<>]//;
X $state = 'term', next if s/^\)+//;
X do quote($ord,1), next if s/^'//;
X do quote($ord,1), next if s/^"//;
X if (s|^[/?]||) {
X if ($state =~ /stat|oper/) {
X $state = 'term';
X do quote($ord,1), next;
X }
X $state = 'operator', next;
X }
X next if s/^#.*//;
X }
X }
X}
X
Xsub quote {
X ($quote,$quoting) = @_;
X $state = 'quote';
X}
!STUFFY!FUNK!
echo Extracting t/op.stat
sed >t/op.stat <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.stat,v 2.0 88/06/05 00:14:43 root Exp $
X
Xprint "1..56\n";
X
Xopen(foo, ">Op.stat.tmp");
X
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat(foo);
Xif ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";}
Xif ($mtime && $mtime == $ctime) {print "ok 2\n";} else {print "not ok 2\n";}
X
Xprint foo "Now is the time for all good men to come to.\n";
Xclose(foo);
X
X$base = time;
Xwhile (time == $base) {}
X
X`rm -f Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
X
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('Op.stat.tmp');
X
Xif ($nlink == 2) {print "ok 3\n";} else {print "not ok 3\n";}
Xif ($mtime && $mtime != $ctime) {print "ok 4\n";} else {print "not ok 4\n";}
Xprint "#4 :$mtime: != :$ctime:\n";
X
X`cp /dev/null Op.stat.tmp`;
X
Xif (-z 'Op.stat.tmp') {print "ok 5\n";} else {print "not ok 5\n";}
Xif (! -s 'Op.stat.tmp') {print "ok 6\n";} else {print "not ok 6\n";}
X
X`echo hi >Op.stat.tmp`;
Xif (! -z 'Op.stat.tmp') {print "ok 7\n";} else {print "not ok 7\n";}
Xif (-s 'Op.stat.tmp') {print "ok 8\n";} else {print "not ok 8\n";}
X
Xchmod 0,'Op.stat.tmp';
X$olduid = $>; # can't test -r if uid == 0
Xeval '$> = 1;'; # so switch uid (may not be implemented)
Xif (!$> || ! -r 'Op.stat.tmp') {print "ok 9\n";} else {print "not ok 9\n";}
Xif (!$> || ! -w 'Op.stat.tmp') {print "ok 10\n";} else {print "not ok 10\n";}
Xeval '$> = $olduid;'; # switch uid back (may not be implemented)
Xif (! -x 'Op.stat.tmp') {print "ok 11\n";} else {print "not ok 11\n";}
X
Xforeach ((12,13,14,15,16,17)) {
X print "ok $_\n"; #deleted tests
X}
X
Xchmod 0700,'Op.stat.tmp';
Xif (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";}
Xif (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";}
Xif (-x 'Op.stat.tmp') {print "ok 20\n";} else {print "not ok 20\n";}
X
Xif (-f 'Op.stat.tmp') {print "ok 21\n";} else {print "not ok 21\n";}
Xif (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";}
X
Xif (-d '.') {print "ok 23\n";} else {print "not ok 23\n";}
Xif (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";}
X
Xif (`ls -l perl` =~ /^l.*->/) {
X if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";}
X}
Xelse {
X print "ok 25\n";
X}
X
Xif (-o 'Op.stat.tmp') {print "ok 26\n";} else {print "not ok 26\n";}
X
Xif (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";}
X`rm -f Op.stat.tmp Op.stat.tmp2`;
Xif (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";}
X
Xif (-c '/dev/tty') {print "ok 29\n";} else {print "not ok 29\n";}
Xif (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
X
Xif (! -e '/dev/printer' || -S '/dev/printer')
X {print "ok 31\n";}
Xelse
X {print "not ok 31\n";}
Xif (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";}
X
Xif (! -e '/dev/mt0' || -b '/dev/mt0')
X {print "ok 33\n";}
Xelse
X {print "not ok 33\n";}
Xif (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
X
X$cnt = $uid = 0;
X
Xwhile (</usr/bin/*>) {
X $cnt++;
X $uid++ if -u;
X last if $uid && $uid < $cnt;
X}
X
X# I suppose this is going to fail somewhere...
Xif ($uid > 0 && $uid < $cnt) {print "ok 35\n";} else {print "not ok 35\n";}
X
Xunless (open(tty,"/dev/tty")) {
X print stderr "Can't open /dev/tty--run t/TEST outside of make.\n";
X}
Xif (-t tty) {print "ok 36\n";} else {print "not ok 36\n";}
Xif (-c tty) {print "ok 37\n";} else {print "not ok 37\n";}
Xclose(tty);
Xif (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";}
Xopen(null,"/dev/null");
Xif (! -t null) {print "ok 39\n";} else {print "not ok 39\n";}
Xclose(null);
Xif (-t) {print "ok 40\n";} else {print "not ok 40\n";}
X
X# These aren't strictly "stat" calls, but so what?
X
Xif (-T 'op.stat') {print "ok 41\n";} else {print "not ok 41\n";}
Xif (! -B 'op.stat') {print "ok 42\n";} else {print "not ok 42\n";}
X
Xif (-B './perl') {print "ok 43\n";} else {print "not ok 43\n";}
Xif (! -T './perl') {print "ok 44\n";} else {print "not ok 44\n";}
X
Xopen(foo,'op.stat');
Xif (-T foo) {print "ok 45\n";} else {print "not ok 45\n";}
Xif (! -B foo) {print "ok 46\n";} else {print "not ok 46\n";}
X$_ = <foo>;
Xif (/perl/) {print "ok 47\n";} else {print "not ok 47\n";}
Xif (-T foo) {print "ok 48\n";} else {print "not ok 48\n";}
Xif (! -B foo) {print "ok 49\n";} else {print "not ok 49\n";}
Xclose(foo);
X
Xopen(foo,'op.stat');
X$_ = <foo>;
Xif (/perl/) {print "ok 50\n";} else {print "not ok 50\n";}
Xif (-T foo) {print "ok 51\n";} else {print "not ok 51\n";}
Xif (! -B foo) {print "ok 52\n";} else {print "not ok 52\n";}
Xseek(foo,0,0);
Xif (-T foo) {print "ok 53\n";} else {print "not ok 53\n";}
Xif (! -B foo) {print "ok 54\n";} else {print "not ok 54\n";}
Xclose(foo);
X
Xif (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";}
Xif (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";}
!STUFFY!FUNK!
echo ""
echo "End of kit 11 (of 15)"
cat /dev/null >kit11isdone
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.