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

/* $Header: stab.c,v 3.0.1.8 90/08/13 22:30:17 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.8  90/08/13  22:30:17  lwall
 * patch28: the NSIG hack didn't work right on Xenix
 * 
 * Revision 3.0.1.7  90/08/09  05:17:48  lwall
 * patch19: fixed double include of <signal.h>
 * patch19: $' broke on embedded nulls
 * patch19: $< and $> better supported on machines without setreuid
 * patch19: Added support for linked-in C subroutines
 * patch19: %ENV wasn't forced to be global like it should
 * patch19: $| didn't work before the filehandle was opened
 * patch19: $! now returns "" in string context if errno == 0
 * 
 * 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"

#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
#include <signal.h>
#endif

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_nset(stab_val(stab),s, curspat->spat_regexp->subend - 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 '|':
	if (!stab_io(curoutstab))
	    stab_io(curoutstab) = stio_new();
	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 ? 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;
    default:
	{
	    struct ufuncs *uf = (struct ufuncs *)str->str_ptr;

	    if (uf && uf->uf_val)
		uf->uf_val(uf->uf_index, stab_val(stab));
	}
	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) = curcmd->c_line;
	    }
	    else {
		stab = stabent(s,TRUE);
		if (!stab_xarray(stab))
		    aadd(stab);
		if (!stab_xhash(stab))
		    hadd(stab);
		if (!stab_io(stab))
		    stab_io(stab) = stio_new();
	    }
	    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 '|':
	    if (!stab_io(curoutstab))
		stab_io(curoutstab) = stio_new();
	    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
	    if (uid == euid)		/* special case $< = $> */
		setuid(uid);
	    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
	    if (euid == uid)		/* special case $> = $< */
		setuid(euid);
	    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;
	default:
	    {
		struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;

		if (uf && uf->uf_set)
		    uf->uf_set(uf->uf_index, 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;

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