[p5sagit/p5-mst-13.2.git] / stab.c

/* $Header: stab.c,v 3.0.1.6 90/03/27 16:22:11 lwall Locked $
 *
 *    Copyright (c) 1989, Larry Wall
 *
 *    You may distribute under the terms of the GNU General Public License
 *    as specified in the README file that comes with the perl 3.0 kit.
 *
 * $Log:	stab.c,v $
 * Revision 3.0.1.6  90/03/27  16:22:11  lwall
 * patch16: support for machines that can't cast negative floats to unsigned ints
 * 
 * Revision 3.0.1.5  90/03/12  17:00:11  lwall
 * patch13: undef $/ didn't work as advertised
 * 
 * Revision 3.0.1.4  90/02/28  18:19:14  lwall
 * patch9: $0 is now always the command name
 * patch9: you may now undef $/ to have no input record separator
 * patch9: local($.) didn't work
 * patch9: sometimes perl thought ordinary data was a symbol table entry
 * patch9: stab_array() and stab_hash() weren't defined on MICROPORT
 * 
 * Revision 3.0.1.3  89/12/21  20:18:40  lwall
 * patch7: ANSI strerror() is now supported
 * patch7: errno may now be a macro with an lvalue
 * patch7: in stab.c, sighandler() may now return either void or int
 * 
 * Revision 3.0.1.2  89/11/17  15:35:37  lwall
 * patch5: sighandler() needed to be static
 * 
 * Revision 3.0.1.1  89/11/11  04:55:07  lwall
 * patch2: sys_errlist[sys_nerr] is illegal
 * 
 * Revision 3.0  89/10/18  15:23:23  lwall
 * 3.0 baseline
 * 
 */

#include "EXTERN.h"
#include "perl.h"

#include <signal.h>

static char *sig_name[] = {
    SIG_NAME,0
};

#ifdef VOIDSIG
#define handlertype void
#else
#define handlertype int
#endif

STR *
stab_str(str)
STR *str;
{
    STAB *stab = str->str_u.str_stab;
    register int paren;
    register char *s;
    register int i;

    if (str->str_rare)
	return stab_val(stab);

    switch (*stab->str_magic->str_ptr) {
    case '1': case '2': case '3': case '4':
    case '5': case '6': case '7': case '8': case '9': case '&':
	if (curspat) {
	    paren = atoi(stab_name(stab));
	  getparen:
	    if (curspat->spat_regexp &&
	      paren <= curspat->spat_regexp->nparens &&
	      (s = curspat->spat_regexp->startp[paren]) ) {
		i = curspat->spat_regexp->endp[paren] - s;
		if (i >= 0)
		    str_nset(stab_val(stab),s,i);
		else
		    str_sset(stab_val(stab),&str_undef);
	    }
	    else
		str_sset(stab_val(stab),&str_undef);
	}
	break;
    case '+':
	if (curspat) {
	    paren = curspat->spat_regexp->lastparen;
	    goto getparen;
	}
	break;
    case '`':
	if (curspat) {
	    if (curspat->spat_regexp &&
	      (s = curspat->spat_regexp->subbase) ) {
		i = curspat->spat_regexp->startp[0] - s;
		if (i >= 0)
		    str_nset(stab_val(stab),s,i);
		else
		    str_nset(stab_val(stab),"",0);
	    }
	    else
		str_nset(stab_val(stab),"",0);
	}
	break;
    case '\'':
	if (curspat) {
	    if (curspat->spat_regexp &&
	      (s = curspat->spat_regexp->endp[0]) ) {
		str_set(stab_val(stab),s);
	    }
	    else
		str_nset(stab_val(stab),"",0);
	}
	break;
    case '.':
#ifndef lint
	if (last_in_stab) {
	    str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
	}
#endif
	break;
    case '?':
	str_numset(stab_val(stab),(double)statusvalue);
	break;
    case '^':
	s = stab_io(curoutstab)->top_name;
	str_set(stab_val(stab),s);
	break;
    case '~':
	s = stab_io(curoutstab)->fmt_name;
	str_set(stab_val(stab),s);
	break;
#ifndef lint
    case '=':
	str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
	break;
    case '-':
	str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
	break;
    case '%':
	str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
	break;
#endif
    case '/':
	if (record_separator != 12345) {
	    *tokenbuf = record_separator;
	    tokenbuf[1] = '\0';
	    str_nset(stab_val(stab),tokenbuf,rslen);
	}
	break;
    case '[':
	str_numset(stab_val(stab),(double)arybase);
	break;
    case '|':
	str_numset(stab_val(stab),
	   (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
	break;
    case ',':
	str_nset(stab_val(stab),ofs,ofslen);
	break;
    case '\\':
	str_nset(stab_val(stab),ors,orslen);
	break;
    case '#':
	str_set(stab_val(stab),ofmt);
	break;
    case '!':
	str_numset(stab_val(stab), (double)errno);
	str_set(stab_val(stab), strerror(errno));
	stab_val(stab)->str_nok = 1;	/* what a wonderful hack! */
	break;
    case '<':
	str_numset(stab_val(stab),(double)uid);
	break;
    case '>':
	str_numset(stab_val(stab),(double)euid);
	break;
    case '(':
	s = buf;
	(void)sprintf(s,"%d",(int)gid);
	goto add_groups;
    case ')':
	s = buf;
	(void)sprintf(s,"%d",(int)egid);
      add_groups:
	while (*s) s++;
#ifdef GETGROUPS
#ifndef NGROUPS
#define NGROUPS 32
#endif
	{
	    GIDTYPE gary[NGROUPS];

	    i = getgroups(NGROUPS,gary);
	    while (--i >= 0) {
		(void)sprintf(s," %ld", (long)gary[i]);
		while (*s) s++;
	    }
	}
#endif
	str_set(stab_val(stab),buf);
	break;
    }
    return stab_val(stab);
}

stabset(mstr,str)
register STR *mstr;
STR *str;
{
    STAB *stab = mstr->str_u.str_stab;
    char *s;
    int i;
    static handlertype sighandler();

    switch (mstr->str_rare) {
    case 'E':
	setenv(mstr->str_ptr,str_get(str));
				/* And you'll never guess what the dog had */
	break;			/*   in its mouth... */
    case 'S':
	s = str_get(str);
	i = whichsig(mstr->str_ptr);	/* ...no, a brick */
	if (strEQ(s,"IGNORE"))
#ifndef lint
	    (void)signal(i,SIG_IGN);
#else
	    ;
#endif
	else if (strEQ(s,"DEFAULT") || !*s)
	    (void)signal(i,SIG_DFL);
	else
	    (void)signal(i,sighandler);
	break;
#ifdef SOME_DBM
    case 'D':
	hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
	break;
#endif
    case '#':
	afill(stab_array(stab), (int)str_gnum(str) - arybase);
	break;
    case 'X':	/* merely a copy of a * string */
	break;
    case '*':
	s = str_get(str);
	if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
	    if (!*s) {
		STBP *stbp;

		(void)savenostab(stab);	/* schedule a free of this stab */
		if (stab->str_len)
		    Safefree(stab->str_ptr);
		Newz(601,stbp, 1, STBP);
		stab->str_ptr = stbp;
		stab->str_len = stab->str_cur = sizeof(STBP);
		stab->str_pok = 1;
		strcpy(stab_magic(stab),"StB");
		stab_val(stab) = Str_new(70,0);
		stab_line(stab) = line;
	    }
	    else
		stab = stabent(s,TRUE);
	    str_sset(str,stab);
	}
	break;
    case 's': {
	    struct lstring *lstr = (struct lstring*)str;

	    mstr->str_rare = 0;
	    str->str_magic = Nullstr;
	    str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
	      str->str_ptr,str->str_cur);
	}
	break;

    case 'v':
	do_vecset(mstr,str);
	break;

    case 0:
	switch (*stab->str_magic->str_ptr) {
	case '.':
	    if (localizing)
		savesptr((STR**)&last_in_stab);
	    break;
	case '^':
	    Safefree(stab_io(curoutstab)->top_name);
	    stab_io(curoutstab)->top_name = s = savestr(str_get(str));
	    stab_io(curoutstab)->top_stab = stabent(s,TRUE);
	    break;
	case '~':
	    Safefree(stab_io(curoutstab)->fmt_name);
	    stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
	    stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
	    break;
	case '=':
	    stab_io(curoutstab)->page_len = (long)str_gnum(str);
	    break;
	case '-':
	    stab_io(curoutstab)->lines_left = (long)str_gnum(str);
	    if (stab_io(curoutstab)->lines_left < 0L)
		stab_io(curoutstab)->lines_left = 0L;
	    break;
	case '%':
	    stab_io(curoutstab)->page = (long)str_gnum(str);
	    break;
	case '|':
	    stab_io(curoutstab)->flags &= ~IOF_FLUSH;
	    if (str_gnum(str) != 0.0) {
		stab_io(curoutstab)->flags |= IOF_FLUSH;
	    }
	    break;
	case '*':
	    i = (int)str_gnum(str);
	    multiline = (i != 0);
	    break;
	case '/':
	    if (str->str_pok) {
		record_separator = *str_get(str);
		rslen = str->str_cur;
	    }
	    else {
		record_separator = 12345;	/* fake a non-existent char */
		rslen = 1;
	    }
	    break;
	case '\\':
	    if (ors)
		Safefree(ors);
	    ors = savestr(str_get(str));
	    orslen = str->str_cur;
	    break;
	case ',':
	    if (ofs)
		Safefree(ofs);
	    ofs = savestr(str_get(str));
	    ofslen = str->str_cur;
	    break;
	case '#':
	    if (ofmt)
		Safefree(ofmt);
	    ofmt = savestr(str_get(str));
	    break;
	case '[':
	    arybase = (int)str_gnum(str);
	    break;
	case '?':
	    statusvalue = U_S(str_gnum(str));
	    break;
	case '!':
	    errno = (int)str_gnum(str);		/* will anyone ever use this? */
	    break;
	case '<':
	    uid = (int)str_gnum(str);
#ifdef SETREUID
	    if (delaymagic) {
		delaymagic |= DM_REUID;
		break;				/* don't do magic till later */
	    }
#endif /* SETREUID */
#ifdef SETRUID
	    if (setruid((UIDTYPE)uid) < 0)
		uid = (int)getuid();
#else
#ifdef SETREUID
	    if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
		uid = (int)getuid();
#else
	    fatal("setruid() not implemented");
#endif
#endif
	    break;
	case '>':
	    euid = (int)str_gnum(str);
#ifdef SETREUID
	    if (delaymagic) {
		delaymagic |= DM_REUID;
		break;				/* don't do magic till later */
	    }
#endif /* SETREUID */
#ifdef SETEUID
	    if (seteuid((UIDTYPE)euid) < 0)
		euid = (int)geteuid();
#else
#ifdef SETREUID
	    if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
		euid = (int)geteuid();
#else
	    fatal("seteuid() not implemented");
#endif
#endif
	    break;
	case '(':
	    gid = (int)str_gnum(str);
#ifdef SETREGID
	    if (delaymagic) {
		delaymagic |= DM_REGID;
		break;				/* don't do magic till later */
	    }
#endif /* SETREGID */
#ifdef SETRGID
	    (void)setrgid((GIDTYPE)gid);
#else
#ifdef SETREGID
	    (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
#else
	    fatal("setrgid() not implemented");
#endif
#endif
	    break;
	case ')':
	    egid = (int)str_gnum(str);
#ifdef SETREGID
	    if (delaymagic) {
		delaymagic |= DM_REGID;
		break;				/* don't do magic till later */
	    }
#endif /* SETREGID */
#ifdef SETEGID
	    (void)setegid((GIDTYPE)egid);
#else
#ifdef SETREGID
	    (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
#else
	    fatal("setegid() not implemented");
#endif
#endif
	    break;
	case ':':
	    chopset = str_get(str);
	    break;
	}
	break;
    }
}

whichsig(sig)
char *sig;
{
    register char **sigv;

    for (sigv = sig_name+1; *sigv; sigv++)
	if (strEQ(sig,*sigv))
	    return sigv - sig_name;
#ifdef SIGCLD
    if (strEQ(sig,"CHLD"))
	return SIGCLD;
#endif
#ifdef SIGCHLD
    if (strEQ(sig,"CLD"))
	return SIGCHLD;
#endif
    return 0;
}

static handlertype
sighandler(sig)
int sig;
{
    STAB *stab;
    ARRAY *savearray;
    STR *str;
    char *oldfile = filename;
    int oldsave = savestack->ary_fill;
    ARRAY *oldstack = stack;
    SUBR *sub;

    stab = stabent(
	str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
	  TRUE)), TRUE);
    sub = stab_sub(stab);
    if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
	if (sig_name[sig][1] == 'H')
	    stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
	      TRUE);
	else
	    stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
	      TRUE);
	sub = stab_sub(stab);	/* gag */
    }
    if (!sub) {
	if (dowarn)
	    warn("SIG%s handler \"%s\" not defined.\n",
		sig_name[sig], stab_name(stab) );
	return;
    }
    savearray = stab_xarray(defstab);
    stab_xarray(defstab) = stack = anew(defstab);
    stack->ary_flags = 0;
    str = Str_new(71,0);
    str_set(str,sig_name[sig]);
    (void)apush(stab_xarray(defstab),str);
    sub->depth++;
    if (sub->depth >= 2) {	/* save temporaries on recursion? */
	if (sub->depth == 100 && dowarn)
	    warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
	savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
    }
    filename = sub->filename;

    (void)cmd_exec(sub->cmd,G_SCALAR,1);		/* so do it already */

    sub->depth--;	/* assuming no longjumps out of here */
    str_free(stack->ary_array[0]);	/* free the one real string */
    afree(stab_xarray(defstab));  /* put back old $_[] */
    stab_xarray(defstab) = savearray;
    stack = oldstack;
    filename = oldfile;
    if (savestack->ary_fill > oldsave)
	restorelist(oldsave);
}

STAB *
aadd(stab)
register STAB *stab;
{
    if (!stab_xarray(stab))
	stab_xarray(stab) = anew(stab);
    return stab;
}

STAB *
hadd(stab)
register STAB *stab;
{
    if (!stab_xhash(stab))
	stab_xhash(stab) = hnew(COEFFSIZE);
    return stab;
}

STAB *
stabent(name,add)
register char *name;
int add;
{
    register STAB *stab;
    register STBP *stbp;
    int len;
    register char *namend;
    HASH *stash;
    char *sawquote = Nullch;
    char *prevquote = Nullch;
    bool global = FALSE;

    if (isascii(*name) && isupper(*name)) {
	if (*name > 'I') {
	    if (*name == 'S' && (
	      strEQ(name, "SIG") ||
	      strEQ(name, "STDIN") ||
	      strEQ(name, "STDOUT") ||
	      strEQ(name, "STDERR") ))
		global = TRUE;
	}
	else if (*name > 'E') {
	    if (*name == 'I' && strEQ(name, "INC"))
		global = TRUE;
	}
	else if (*name >= 'A') {
	    if (*name == 'E' && strEQ(name, "ENV"))
		global = TRUE;
	}
	else if (*name == 'A' && (
	  strEQ(name, "ARGV") ||
	  strEQ(name, "ARGVOUT") ))
	    global = TRUE;
    }
    for (namend = name; *namend; namend++) {
	if (*namend == '\'' && namend[1])
	    prevquote = sawquote, sawquote = namend;
    }
    if (sawquote == name && name[1]) {
	stash = defstash;
	sawquote = Nullch;
	name++;
    }
    else if (!isalpha(*name) || global)
	stash = defstash;
    else
	stash = curstash;
    if (sawquote) {
	char tmpbuf[256];
	char *s, *d;

	*sawquote = '\0';
	if (s = prevquote) {
	    strncpy(tmpbuf,name,s-name+1);
	    d = tmpbuf+(s-name+1);
	    *d++ = '_';
	    strcpy(d,s+1);
	}
	else {
	    *tmpbuf = '_';
	    strcpy(tmpbuf+1,name);
	}
	stab = stabent(tmpbuf,TRUE);
	if (!(stash = stab_xhash(stab)))
	    stash = stab_xhash(stab) = hnew(0);
	name = sawquote+1;
	*sawquote = '\'';
    }
    len = namend - name;
    stab = (STAB*)hfetch(stash,name,len,add);
    if (!stab)
	return Nullstab;
    if (stab->str_pok) {
	stab->str_pok |= SP_MULTI;
	return stab;
    }
    else {
	if (stab->str_len)
	    Safefree(stab->str_ptr);
	Newz(602,stbp, 1, STBP);
	stab->str_ptr = stbp;
	stab->str_len = stab->str_cur = sizeof(STBP);
	stab->str_pok = 1;
	strcpy(stab_magic(stab),"StB");
	stab_val(stab) = Str_new(72,0);
	stab_line(stab) = line;
	str_magic(stab,stab,'*',name,len);
	return stab;
    }
}

STIO *
stio_new()
{
    STIO *stio;

    Newz(603,stio,1,STIO);
    stio->page_len = 60;
    return stio;
}

stab_check(min,max)
int min;
register int max;
{
    register HENT *entry;
    register int i;
    register STAB *stab;

    for (i = min; i <= max; i++) {
	for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
	    stab = (STAB*)entry->hent_val;
	    if (stab->str_pok & SP_MULTI)
		continue;
	    line = stab_line(stab);
	    warn("Possible typo: \"%s\"", stab_name(stab));
	}
    }
}

static int gensym = 0;

STAB *
genstab()
{
    (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
    return stabent(tokenbuf,TRUE);
}

/* hopefully this is only called on local symbol table entries */

void
stab_clear(stab)
register STAB *stab;
{
    STIO *stio;
    SUBR *sub;

    afree(stab_xarray(stab));
    (void)hfree(stab_xhash(stab));
    str_free(stab_val(stab));
    if (stio = stab_io(stab)) {
	do_close(stab,FALSE);
	Safefree(stio->top_name);
	Safefree(stio->fmt_name);
    }
    if (sub = stab_sub(stab)) {
	afree(sub->tosave);
	cmd_free(sub->cmd);
    }
    Safefree(stab->str_ptr);
    stab->str_ptr = Null(STBP*);
    stab->str_len = 0;
    stab->str_cur = 0;
}

#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
#define MICROPORT
#endif

#ifdef	MICROPORT	/* Microport 2.4 hack */
ARRAY *stab_array(stab)
register STAB *stab;
{
    if (((STBP*)(stab->str_ptr))->stbp_array) 
	return ((STBP*)(stab->str_ptr))->stbp_array;
    else
	return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
}

HASH *stab_hash(stab)
register STAB *stab;
{
    if (((STBP*)(stab->str_ptr))->stbp_hash)
	return ((STBP*)(stab->str_ptr))->stbp_hash;
    else
	return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
}
#endif			/* Microport 2.4 hack */
Commit	Line	Data
0f85fab0	1	/* $Header: stab.c,v 3.0.1.6 90/03/27 16:22:11 lwall Locked $
a687059c	2	*
	3	* Copyright (c) 1989, Larry Wall
	4	*
	5	* You may distribute under the terms of the GNU General Public License
	6	* as specified in the README file that comes with the perl 3.0 kit.
8d063cd8	7	*
8d063cd8	8	* $Log: stab.c,v $
0f85fab0	9	* Revision 3.0.1.6 90/03/27 16:22:11 lwall
	10	* patch16: support for machines that can't cast negative floats to unsigned ints
	11	*
79a0689e	12	* Revision 3.0.1.5 90/03/12 17:00:11 lwall
	13	* patch13: undef $/ didn't work as advertised
	14	*
9f68db38	15	* Revision 3.0.1.4 90/02/28 18:19:14 lwall
	16	* patch9: $0 is now always the command name
	17	* patch9: you may now undef $/ to have no input record separator
	18	* patch9: local($.) didn't work
	19	* patch9: sometimes perl thought ordinary data was a symbol table entry
	20	* patch9: stab_array() and stab_hash() weren't defined on MICROPORT
	21	*
663a0e37	22	* Revision 3.0.1.3 89/12/21 20:18:40 lwall
	23	* patch7: ANSI strerror() is now supported
	24	* patch7: errno may now be a macro with an lvalue
	25	* patch7: in stab.c, sighandler() may now return either void or int
	26	*
ffed7fef	27	* Revision 3.0.1.2 89/11/17 15:35:37 lwall
	28	* patch5: sighandler() needed to be static
	29	*
ae986130	30	* Revision 3.0.1.1 89/11/11 04:55:07 lwall
	31	* patch2: sys_errlist[sys_nerr] is illegal
	32	*
a687059c	33	* Revision 3.0 89/10/18 15:23:23 lwall
a687059c	34	* 3.0 baseline
8d063cd8	35	*
	36	*/
	37
8d063cd8	38	#include "EXTERN.h"
8d063cd8	39	#include "perl.h"
8d063cd8	40
378cc40b	41	#include <signal.h>
378cc40b	42
8d063cd8	43	static char *sig_name[] = {
a687059c	44	SIG_NAME,0
a687059c	45	};
8d063cd8	46
663a0e37	47	#ifdef VOIDSIG
	48	#define handlertype void
	49	#else
	50	#define handlertype int
	51	#endif
2e1b3b7e	52
8d063cd8	53	STR *
a687059c	54	stab_str(str)
a687059c	55	STR *str;
8d063cd8	56	{
a687059c	57	STAB *stab = str->str_u.str_stab;
8d063cd8	58	register int paren;
8d063cd8	59	register char *s;
378cc40b	60	register int i;
8d063cd8	61
a687059c	62	if (str->str_rare)
	63	return stab_val(stab);
	64
	65	switch (*stab->str_magic->str_ptr) {
9f68db38	66	case '1': case '2': case '3': case '4':
8d063cd8	67	case '5': case '6': case '7': case '8': case '9': case '&':
8d063cd8	68	if (curspat) {
a687059c	69	paren = atoi(stab_name(stab));
378cc40b	70	getparen:
	71	if (curspat->spat_regexp &&
	72	paren <= curspat->spat_regexp->nparens &&
	73	(s = curspat->spat_regexp->startp[paren]) ) {
	74	i = curspat->spat_regexp->endp[paren] - s;
	75	if (i >= 0)
a687059c	76	str_nset(stab_val(stab),s,i);
378cc40b	77	else
a687059c	78	str_sset(stab_val(stab),&str_undef);
8d063cd8	79	}
378cc40b	80	else
a687059c	81	str_sset(stab_val(stab),&str_undef);
8d063cd8	82	}
	83	break;
	84	case '+':
	85	if (curspat) {
378cc40b	86	paren = curspat->spat_regexp->lastparen;
378cc40b	87	goto getparen;
8d063cd8	88	}
8d063cd8	89	break;
a687059c	90	case '`':
	91	if (curspat) {
	92	if (curspat->spat_regexp &&
	93	(s = curspat->spat_regexp->subbase) ) {
	94	i = curspat->spat_regexp->startp[0] - s;
	95	if (i >= 0)
	96	str_nset(stab_val(stab),s,i);
	97	else
	98	str_nset(stab_val(stab),"",0);
	99	}
	100	else
	101	str_nset(stab_val(stab),"",0);
	102	}
	103	break;
	104	case '\'':
	105	if (curspat) {
	106	if (curspat->spat_regexp &&
	107	(s = curspat->spat_regexp->endp[0]) ) {
	108	str_set(stab_val(stab),s);
	109	}
	110	else
	111	str_nset(stab_val(stab),"",0);
	112	}
	113	break;
8d063cd8	114	case '.':
a687059c	115	#ifndef lint
8d063cd8	116	if (last_in_stab) {
a687059c	117	str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
8d063cd8	118	}
a687059c	119	#endif
8d063cd8	120	break;
8d063cd8	121	case '?':
a687059c	122	str_numset(stab_val(stab),(double)statusvalue);
8d063cd8	123	break;
8d063cd8	124	case '^':
a687059c	125	s = stab_io(curoutstab)->top_name;
a687059c	126	str_set(stab_val(stab),s);
8d063cd8	127	break;
8d063cd8	128	case '~':
a687059c	129	s = stab_io(curoutstab)->fmt_name;
a687059c	130	str_set(stab_val(stab),s);
8d063cd8	131	break;
a687059c	132	#ifndef lint
8d063cd8	133	case '=':
a687059c	134	str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
8d063cd8	135	break;
8d063cd8	136	case '-':
a687059c	137	str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
8d063cd8	138	break;
8d063cd8	139	case '%':
a687059c	140	str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
8d063cd8	141	break;
a687059c	142	#endif
8d063cd8	143	case '/':
9f68db38	144	if (record_separator != 12345) {
	145	*tokenbuf = record_separator;
	146	tokenbuf[1] = '\0';
	147	str_nset(stab_val(stab),tokenbuf,rslen);
	148	}
8d063cd8	149	break;
8d063cd8	150	case '[':
a687059c	151	str_numset(stab_val(stab),(double)arybase);
8d063cd8	152	break;
8d063cd8	153	case '\|':
a687059c	154	str_numset(stab_val(stab),
a687059c	155	(double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
8d063cd8	156	break;
8d063cd8	157	case ',':
a687059c	158	str_nset(stab_val(stab),ofs,ofslen);
8d063cd8	159	break;
8d063cd8	160	case '\\':
a687059c	161	str_nset(stab_val(stab),ors,orslen);
8d063cd8	162	break;
8d063cd8	163	case '#':
a687059c	164	str_set(stab_val(stab),ofmt);
8d063cd8	165	break;
8d063cd8	166	case '!':
a687059c	167	str_numset(stab_val(stab), (double)errno);
663a0e37	168	str_set(stab_val(stab), strerror(errno));
a687059c	169	stab_val(stab)->str_nok = 1; /* what a wonderful hack! */
378cc40b	170	break;
378cc40b	171	case '<':
a687059c	172	str_numset(stab_val(stab),(double)uid);
378cc40b	173	break;
378cc40b	174	case '>':
a687059c	175	str_numset(stab_val(stab),(double)euid);
378cc40b	176	break;
378cc40b	177	case '(':
a687059c	178	s = buf;
a687059c	179	(void)sprintf(s,"%d",(int)gid);
378cc40b	180	goto add_groups;
378cc40b	181	case ')':
a687059c	182	s = buf;
a687059c	183	(void)sprintf(s,"%d",(int)egid);
378cc40b	184	add_groups:
	185	while (*s) s++;
	186	#ifdef GETGROUPS
	187	#ifndef NGROUPS
	188	#define NGROUPS 32
	189	#endif
	190	{
	191	GIDTYPE gary[NGROUPS];
	192
	193	i = getgroups(NGROUPS,gary);
	194	while (--i >= 0) {
a687059c	195	(void)sprintf(s," %ld", (long)gary[i]);
378cc40b	196	while (*s) s++;
	197	}
	198	}
	199	#endif
a687059c	200	str_set(stab_val(stab),buf);
8d063cd8	201	break;
8d063cd8	202	}
a687059c	203	return stab_val(stab);
8d063cd8	204	}
8d063cd8	205
a687059c	206	stabset(mstr,str)
a687059c	207	register STR *mstr;
8d063cd8	208	STR *str;
8d063cd8	209	{
a687059c	210	STAB *stab = mstr->str_u.str_stab;
8d063cd8	211	char *s;
8d063cd8	212	int i;
663a0e37	213	static handlertype sighandler();
8d063cd8	214
a687059c	215	switch (mstr->str_rare) {
	216	case 'E':
	217	setenv(mstr->str_ptr,str_get(str));
	218	/* And you'll never guess what the dog had */
	219	break; /* in its mouth... */
	220	case 'S':
	221	s = str_get(str);
	222	i = whichsig(mstr->str_ptr); /* ...no, a brick */
	223	if (strEQ(s,"IGNORE"))
	224	#ifndef lint
	225	(void)signal(i,SIG_IGN);
	226	#else
	227	;
	228	#endif
	229	else if (strEQ(s,"DEFAULT") \|\| !*s)
	230	(void)signal(i,SIG_DFL);
	231	else
	232	(void)signal(i,sighandler);
	233	break;
	234	#ifdef SOME_DBM
	235	case 'D':
	236	hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
	237	break;
	238	#endif
	239	case '#':
	240	afill(stab_array(stab), (int)str_gnum(str) - arybase);
	241	break;
	242	case 'X': /* merely a copy of a * string */
	243	break;
	244	case '*':
	245	s = str_get(str);
9f68db38	246	if (strNE(s,"StB") \|\| str->str_cur != sizeof(STBP)) {
a687059c	247	if (!*s) {
	248	STBP *stbp;
	249
	250	(void)savenostab(stab); /* schedule a free of this stab */
	251	if (stab->str_len)
	252	Safefree(stab->str_ptr);
	253	Newz(601,stbp, 1, STBP);
	254	stab->str_ptr = stbp;
	255	stab->str_len = stab->str_cur = sizeof(STBP);
	256	stab->str_pok = 1;
9f68db38	257	strcpy(stab_magic(stab),"StB");
a687059c	258	stab_val(stab) = Str_new(70,0);
	259	stab_line(stab) = line;
	260	}
	261	else
	262	stab = stabent(s,TRUE);
	263	str_sset(str,stab);
	264	}
	265	break;
	266	case 's': {
	267	struct lstring lstr = (struct lstring)str;
	268
	269	mstr->str_rare = 0;
	270	str->str_magic = Nullstr;
	271	str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
	272	str->str_ptr,str->str_cur);
	273	}
	274	break;
	275
	276	case 'v':
	277	do_vecset(mstr,str);
	278	break;
	279
	280	case 0:
	281	switch (*stab->str_magic->str_ptr) {
9f68db38	282	case '.':
	283	if (localizing)
	284	savesptr((STR**)&last_in_stab);
	285	break;
8d063cd8	286	case '^':
a687059c	287	Safefree(stab_io(curoutstab)->top_name);
	288	stab_io(curoutstab)->top_name = s = savestr(str_get(str));
	289	stab_io(curoutstab)->top_stab = stabent(s,TRUE);
8d063cd8	290	break;
8d063cd8	291	case '~':
a687059c	292	Safefree(stab_io(curoutstab)->fmt_name);
	293	stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
	294	stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
8d063cd8	295	break;
8d063cd8	296	case '=':
a687059c	297	stab_io(curoutstab)->page_len = (long)str_gnum(str);
8d063cd8	298	break;
8d063cd8	299	case '-':
a687059c	300	stab_io(curoutstab)->lines_left = (long)str_gnum(str);
	301	if (stab_io(curoutstab)->lines_left < 0L)
	302	stab_io(curoutstab)->lines_left = 0L;
8d063cd8	303	break;
8d063cd8	304	case '%':
a687059c	305	stab_io(curoutstab)->page = (long)str_gnum(str);
8d063cd8	306	break;
8d063cd8	307	case '\|':
a687059c	308	stab_io(curoutstab)->flags &= ~IOF_FLUSH;
8d063cd8	309	if (str_gnum(str) != 0.0) {
a687059c	310	stab_io(curoutstab)->flags \|= IOF_FLUSH;
8d063cd8	311	}
	312	break;
	313	case '*':
a687059c	314	i = (int)str_gnum(str);
a687059c	315	multiline = (i != 0);
8d063cd8	316	break;
8d063cd8	317	case '/':
79a0689e	318	if (str->str_pok) {
9f68db38	319	record_separator = *str_get(str);
	320	rslen = str->str_cur;
	321	}
	322	else {
	323	record_separator = 12345; /* fake a non-existent char */
	324	rslen = 1;
	325	}
8d063cd8	326	break;
	327	case '\\':
	328	if (ors)
a687059c	329	Safefree(ors);
8d063cd8	330	ors = savestr(str_get(str));
a687059c	331	orslen = str->str_cur;
8d063cd8	332	break;
	333	case ',':
	334	if (ofs)
a687059c	335	Safefree(ofs);
8d063cd8	336	ofs = savestr(str_get(str));
a687059c	337	ofslen = str->str_cur;
8d063cd8	338	break;
	339	case '#':
	340	if (ofmt)
a687059c	341	Safefree(ofmt);
8d063cd8	342	ofmt = savestr(str_get(str));
	343	break;
	344	case '[':
	345	arybase = (int)str_gnum(str);
	346	break;
378cc40b	347	case '?':
0f85fab0	348	statusvalue = U_S(str_gnum(str));
378cc40b	349	break;
8d063cd8	350	case '!':
	351	errno = (int)str_gnum(str); /* will anyone ever use this? */
	352	break;
378cc40b	353	case '<':
378cc40b	354	uid = (int)str_gnum(str);
a687059c	355	#ifdef SETREUID
	356	if (delaymagic) {
	357	delaymagic \|= DM_REUID;
	358	break; /* don't do magic till later */
	359	}
	360	#endif /* SETREUID */
	361	#ifdef SETRUID
	362	if (setruid((UIDTYPE)uid) < 0)
	363	uid = (int)getuid();
	364	#else
	365	#ifdef SETREUID
	366	if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
378cc40b	367	uid = (int)getuid();
	368	#else
	369	fatal("setruid() not implemented");
	370	#endif
a687059c	371	#endif
378cc40b	372	break;
378cc40b	373	case '>':
378cc40b	374	euid = (int)str_gnum(str);
a687059c	375	#ifdef SETREUID
	376	if (delaymagic) {
	377	delaymagic \|= DM_REUID;
	378	break; /* don't do magic till later */
	379	}
	380	#endif /* SETREUID */
	381	#ifdef SETEUID
	382	if (seteuid((UIDTYPE)euid) < 0)
	383	euid = (int)geteuid();
	384	#else
	385	#ifdef SETREUID
	386	if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
378cc40b	387	euid = (int)geteuid();
	388	#else
	389	fatal("seteuid() not implemented");
	390	#endif
a687059c	391	#endif
378cc40b	392	break;
378cc40b	393	case '(':
a687059c	394	gid = (int)str_gnum(str);
	395	#ifdef SETREGID
	396	if (delaymagic) {
	397	delaymagic \|= DM_REGID;
	398	break; /* don't do magic till later */
	399	}
	400	#endif /* SETREGID */
378cc40b	401	#ifdef SETRGID
a687059c	402	(void)setrgid((GIDTYPE)gid);
	403	#else
	404	#ifdef SETREGID
	405	(void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
378cc40b	406	#else
	407	fatal("setrgid() not implemented");
	408	#endif
a687059c	409	#endif
378cc40b	410	break;
378cc40b	411	case ')':
a687059c	412	egid = (int)str_gnum(str);
	413	#ifdef SETREGID
	414	if (delaymagic) {
	415	delaymagic \|= DM_REGID;
	416	break; /* don't do magic till later */
	417	}
	418	#endif /* SETREGID */
378cc40b	419	#ifdef SETEGID
a687059c	420	(void)setegid((GIDTYPE)egid);
	421	#else
	422	#ifdef SETREGID
	423	(void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
378cc40b	424	#else
	425	fatal("setegid() not implemented");
	426	#endif
a687059c	427	#endif
	428	break;
	429	case ':':
	430	chopset = str_get(str);
378cc40b	431	break;
8d063cd8	432	}
a687059c	433	break;
378cc40b	434	}
8d063cd8	435	}
8d063cd8	436
378cc40b	437	whichsig(sig)
378cc40b	438	char *sig;
8d063cd8	439	{
	440	register char **sigv;
	441
	442	for (sigv = sig_name+1; *sigv; sigv++)
378cc40b	443	if (strEQ(sig,*sigv))
8d063cd8	444	return sigv - sig_name;
a687059c	445	#ifdef SIGCLD
	446	if (strEQ(sig,"CHLD"))
	447	return SIGCLD;
	448	#endif
	449	#ifdef SIGCHLD
	450	if (strEQ(sig,"CLD"))
	451	return SIGCHLD;
	452	#endif
8d063cd8	453	return 0;
	454	}
	455
663a0e37	456	static handlertype
8d063cd8	457	sighandler(sig)
	458	int sig;
	459	{
	460	STAB *stab;
	461	ARRAY *savearray;
	462	STR *str;
378cc40b	463	char *oldfile = filename;
378cc40b	464	int oldsave = savestack->ary_fill;
a687059c	465	ARRAY *oldstack = stack;
378cc40b	466	SUBR *sub;
8d063cd8	467
a687059c	468	stab = stabent(
	469	str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
	470	TRUE)), TRUE);
	471	sub = stab_sub(stab);
	472	if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
	473	if (sig_name[sig][1] == 'H')
	474	stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
	475	TRUE);
	476	else
	477	stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
	478	TRUE);
	479	sub = stab_sub(stab); /* gag */
	480	}
378cc40b	481	if (!sub) {
	482	if (dowarn)
	483	warn("SIG%s handler \"%s\" not defined.\n",
a687059c	484	sig_name[sig], stab_name(stab) );
378cc40b	485	return;
378cc40b	486	}
a687059c	487	savearray = stab_xarray(defstab);
	488	stab_xarray(defstab) = stack = anew(defstab);
	489	stack->ary_flags = 0;
	490	str = Str_new(71,0);
8d063cd8	491	str_set(str,sig_name[sig]);
a687059c	492	(void)apush(stab_xarray(defstab),str);
378cc40b	493	sub->depth++;
	494	if (sub->depth >= 2) { /* save temporaries on recursion? */
	495	if (sub->depth == 100 && dowarn)
a687059c	496	warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
378cc40b	497	savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
	498	}
	499	filename = sub->filename;
	500
a687059c	501	(void)cmd_exec(sub->cmd,G_SCALAR,1); /* so do it already */
378cc40b	502
378cc40b	503	sub->depth--; /* assuming no longjumps out of here */
a687059c	504	str_free(stack->ary_array[0]); /* free the one real string */
	505	afree(stab_xarray(defstab)); /* put back old $_[] */
	506	stab_xarray(defstab) = savearray;
	507	stack = oldstack;
378cc40b	508	filename = oldfile;
	509	if (savestack->ary_fill > oldsave)
	510	restorelist(oldsave);
8d063cd8	511	}
8d063cd8	512
8d063cd8	513	STAB *
	514	aadd(stab)
	515	register STAB *stab;
	516	{
a687059c	517	if (!stab_xarray(stab))
a687059c	518	stab_xarray(stab) = anew(stab);
8d063cd8	519	return stab;
	520	}
	521
	522	STAB *
	523	hadd(stab)
	524	register STAB *stab;
	525	{
a687059c	526	if (!stab_xhash(stab))
a687059c	527	stab_xhash(stab) = hnew(COEFFSIZE);
8d063cd8	528	return stab;
8d063cd8	529	}
378cc40b	530
	531	STAB *
	532	stabent(name,add)
	533	register char *name;
	534	int add;
	535	{
	536	register STAB *stab;
a687059c	537	register STBP *stbp;
	538	int len;
	539	register char *namend;
	540	HASH *stash;
	541	char *sawquote = Nullch;
	542	char *prevquote = Nullch;
	543	bool global = FALSE;
378cc40b	544
a687059c	545	if (isascii(name) && isupper(name)) {
	546	if (*name > 'I') {
	547	if (*name == 'S' && (
	548	strEQ(name, "SIG") \|\|
	549	strEQ(name, "STDIN") \|\|
	550	strEQ(name, "STDOUT") \|\|
	551	strEQ(name, "STDERR") ))
	552	global = TRUE;
378cc40b	553	}
a687059c	554	else if (*name > 'E') {
	555	if (*name == 'I' && strEQ(name, "INC"))
	556	global = TRUE;
	557	}
	558	else if (*name >= 'A') {
	559	if (*name == 'E' && strEQ(name, "ENV"))
	560	global = TRUE;
	561	}
	562	else if (*name == 'A' && (
	563	strEQ(name, "ARGV") \|\|
	564	strEQ(name, "ARGVOUT") ))
	565	global = TRUE;
	566	}
	567	for (namend = name; *namend; namend++) {
	568	if (*namend == '\'' && namend[1])
	569	prevquote = sawquote, sawquote = namend;
	570	}
	571	if (sawquote == name && name[1]) {
	572	stash = defstash;
	573	sawquote = Nullch;
	574	name++;
	575	}
	576	else if (!isalpha(*name) \|\| global)
	577	stash = defstash;
	578	else
	579	stash = curstash;
	580	if (sawquote) {
	581	char tmpbuf[256];
	582	char s, d;
	583
	584	*sawquote = '\0';
	585	if (s = prevquote) {
	586	strncpy(tmpbuf,name,s-name+1);
	587	d = tmpbuf+(s-name+1);
	588	*d++ = '_';
	589	strcpy(d,s+1);
	590	}
	591	else {
	592	*tmpbuf = '_';
	593	strcpy(tmpbuf+1,name);
	594	}
	595	stab = stabent(tmpbuf,TRUE);
	596	if (!(stash = stab_xhash(stab)))
	597	stash = stab_xhash(stab) = hnew(0);
	598	name = sawquote+1;
	599	*sawquote = '\'';
378cc40b	600	}
a687059c	601	len = namend - name;
	602	stab = (STAB*)hfetch(stash,name,len,add);
	603	if (!stab)
	604	return Nullstab;
	605	if (stab->str_pok) {
	606	stab->str_pok \|= SP_MULTI;
	607	return stab;
	608	}
	609	else {
	610	if (stab->str_len)
	611	Safefree(stab->str_ptr);
	612	Newz(602,stbp, 1, STBP);
	613	stab->str_ptr = stbp;
	614	stab->str_len = stab->str_cur = sizeof(STBP);
	615	stab->str_pok = 1;
9f68db38	616	strcpy(stab_magic(stab),"StB");
a687059c	617	stab_val(stab) = Str_new(72,0);
	618	stab_line(stab) = line;
	619	str_magic(stab,stab,'*',name,len);
378cc40b	620	return stab;
378cc40b	621	}
378cc40b	622	}
	623
	624	STIO *
	625	stio_new()
	626	{
a687059c	627	STIO *stio;
378cc40b	628
a687059c	629	Newz(603,stio,1,STIO);
378cc40b	630	stio->page_len = 60;
	631	return stio;
	632	}
	633
	634	stab_check(min,max)
	635	int min;
	636	register int max;
	637	{
a687059c	638	register HENT *entry;
378cc40b	639	register int i;
	640	register STAB *stab;
	641
	642	for (i = min; i <= max; i++) {
a687059c	643	for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
	644	stab = (STAB*)entry->hent_val;
	645	if (stab->str_pok & SP_MULTI)
378cc40b	646	continue;
a687059c	647	line = stab_line(stab);
a687059c	648	warn("Possible typo: \"%s\"", stab_name(stab));
378cc40b	649	}
	650	}
	651	}
a687059c	652
	653	static int gensym = 0;
	654
	655	STAB *
	656	genstab()
	657	{
	658	(void)sprintf(tokenbuf,"_GEN_%d",gensym++);
	659	return stabent(tokenbuf,TRUE);
	660	}
	661
	662	/* hopefully this is only called on local symbol table entries */
	663
	664	void
	665	stab_clear(stab)
	666	register STAB *stab;
	667	{
	668	STIO *stio;
	669	SUBR *sub;
	670
	671	afree(stab_xarray(stab));
	672	(void)hfree(stab_xhash(stab));
	673	str_free(stab_val(stab));
	674	if (stio = stab_io(stab)) {
	675	do_close(stab,FALSE);
	676	Safefree(stio->top_name);
	677	Safefree(stio->fmt_name);
	678	}
	679	if (sub = stab_sub(stab)) {
	680	afree(sub->tosave);
	681	cmd_free(sub->cmd);
	682	}
	683	Safefree(stab->str_ptr);
	684	stab->str_ptr = Null(STBP*);
	685	stab->str_len = 0;
	686	stab->str_cur = 0;
	687	}
	688
9f68db38	689	#if defined(CRIPPLED_CC) && (defined(iAPX286) \|\| defined(M_I286) \|\| defined(I80286))
	690	#define MICROPORT
	691	#endif
	692
	693	#ifdef MICROPORT /* Microport 2.4 hack */
	694	ARRAY *stab_array(stab)
	695	register STAB *stab;
	696	{
	697	if (((STBP*)(stab->str_ptr))->stbp_array)
	698	return ((STBP*)(stab->str_ptr))->stbp_array;
	699	else
	700	return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
	701	}
	702
	703	HASH *stab_hash(stab)
	704	register STAB *stab;
	705	{
	706	if (((STBP*)(stab->str_ptr))->stbp_hash)
	707	return ((STBP*)(stab->str_ptr))->stbp_hash;
	708	else
	709	return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
	710	}
	711	#endif /* Microport 2.4 hack */