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

/* $Header: stab.c,v 3.0.1.2 89/11/17 15:35:37 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.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
};

extern int errno;
extern int sys_nerr;
extern char *sys_errlist[];

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