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

/* $Header: stab.c,v 1.0.1.2 88/02/02 11:25:53 root Exp $
 *
 * $Log:	stab.c,v $
 * Revision 1.0.1.2  88/02/02  11:25:53  root
 * patch13: moved extern int out of function for a poor Xenix machine.
 * 
 * Revision 1.0.1.1  88/01/28  10:35:17  root
 * patch8: changed some stabents to support eval operator.
 * 
 * Revision 1.0  87/12/18  13:06:14  root
 * Initial revision
 * 
 */

#include <signal.h>
#include "handy.h"
#include "EXTERN.h"
#include "search.h"
#include "util.h"
#include "perl.h"

static char *sig_name[] = {
    "",
    "HUP",
    "INT",
    "QUIT",
    "ILL",
    "TRAP",
    "IOT",
    "EMT",
    "FPE",
    "KILL",
    "BUS",
    "SEGV",
    "SYS",
    "PIPE",
    "ALRM",
    "TERM",
    "???"
#ifdef SIGTSTP
    ,"STOP",
    "TSTP",
    "CONT",
    "CHLD",
    "TTIN",
    "TTOU",
    "TINT",
    "XCPU",
    "XFSZ"
#ifdef SIGPROF
    ,"VTALARM",
    "PROF"
#ifdef SIGWINCH
    ,"WINCH"
#ifdef SIGLOST
    ,"LOST"
#ifdef SIGUSR1
    ,"USR1"
#endif
#ifdef SIGUSR2
    ,"USR2"
#endif /* SIGUSR2 */
#endif /* SIGLOST */
#endif /* SIGWINCH */
#endif /* SIGPROF */
#endif /* SIGTSTP */
    ,0
    };

extern int errno;

STR *
stab_str(stab)
STAB *stab;
{
    register int paren;
    register char *s;

    switch (*stab->stab_name) {
    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->stab_name);
	    if (curspat->spat_compex.subend[paren] &&
	      (s = getparen(&curspat->spat_compex,paren))) {
		curspat->spat_compex.subend[paren] = Nullch;
		str_set(stab->stab_val,s);
	    }
	}
	break;
    case '+':
	if (curspat) {
	    paren = curspat->spat_compex.lastparen;
	    if (curspat->spat_compex.subend[paren] &&
	      (s = getparen(&curspat->spat_compex,paren))) {
		curspat->spat_compex.subend[paren] = Nullch;
		str_set(stab->stab_val,s);
	    }
	}
	break;
    case '.':
	if (last_in_stab) {
	    str_numset(stab->stab_val,(double)last_in_stab->stab_io->lines);
	}
	break;
    case '?':
	str_numset(stab->stab_val,(double)statusvalue);
	break;
    case '^':
	s = curoutstab->stab_io->top_name;
	str_set(stab->stab_val,s);
	break;
    case '~':
	s = curoutstab->stab_io->fmt_name;
	str_set(stab->stab_val,s);
	break;
    case '=':
	str_numset(stab->stab_val,(double)curoutstab->stab_io->lines);
	break;
    case '-':
	str_numset(stab->stab_val,(double)curoutstab->stab_io->lines_left);
	break;
    case '%':
	str_numset(stab->stab_val,(double)curoutstab->stab_io->page);
	break;
    case '(':
	if (curspat) {
	    str_numset(stab->stab_val,(double)(curspat->spat_compex.subbeg[0] -
		curspat->spat_compex.subbase));
	}
	break;
    case ')':
	if (curspat) {
	    str_numset(stab->stab_val,(double)(curspat->spat_compex.subend[0] -
		curspat->spat_compex.subbeg[0]));
	}
	break;
    case '/':
	*tokenbuf = record_separator;
	tokenbuf[1] = '\0';
	str_set(stab->stab_val,tokenbuf);
	break;
    case '[':
	str_numset(stab->stab_val,(double)arybase);
	break;
    case '|':
	str_numset(stab->stab_val,
	   (double)((curoutstab->stab_io->flags & IOF_FLUSH) != 0) );
	break;
    case ',':
	str_set(stab->stab_val,ofs);
	break;
    case '\\':
	str_set(stab->stab_val,ors);
	break;
    case '#':
	str_set(stab->stab_val,ofmt);
	break;
    case '!':
	str_numset(stab->stab_val,(double)errno);
	break;
    }
    return stab->stab_val;
}

stabset(stab,str)
register STAB *stab;
STR *str;
{
    char *s;
    int i;
    int sighandler();

    if (stab->stab_flags & SF_VMAGIC) {
	switch (stab->stab_name[0]) {
	case '^':
	    safefree(curoutstab->stab_io->top_name);
	    curoutstab->stab_io->top_name = str_get(str);
	    curoutstab->stab_io->top_stab = stabent(str_get(str),TRUE);
	    break;
	case '~':
	    safefree(curoutstab->stab_io->fmt_name);
	    curoutstab->stab_io->fmt_name = str_get(str);
	    curoutstab->stab_io->fmt_stab = stabent(str_get(str),TRUE);
	    break;
	case '=':
	    curoutstab->stab_io->page_len = (long)str_gnum(str);
	    break;
	case '-':
	    curoutstab->stab_io->lines_left = (long)str_gnum(str);
	    break;
	case '%':
	    curoutstab->stab_io->page = (long)str_gnum(str);
	    break;
	case '|':
	    curoutstab->stab_io->flags &= ~IOF_FLUSH;
	    if (str_gnum(str) != 0.0) {
		curoutstab->stab_io->flags |= IOF_FLUSH;
	    }
	    break;
	case '*':
	    multiline = (int)str_gnum(str) != 0;
	    break;
	case '/':
	    record_separator = *str_get(str);
	    break;
	case '\\':
	    if (ors)
		safefree(ors);
	    ors = savestr(str_get(str));
	    break;
	case ',':
	    if (ofs)
		safefree(ofs);
	    ofs = savestr(str_get(str));
	    break;
	case '#':
	    if (ofmt)
		safefree(ofmt);
	    ofmt = savestr(str_get(str));
	    break;
	case '[':
	    arybase = (int)str_gnum(str);
	    break;
	case '!':
	    errno = (int)str_gnum(str);		/* will anyone ever use this? */
	    break;
	case '.':
	case '+':
	case '&':
	case '0':
	case '1':
	case '2':
	case '3':
	case '4':
	case '5':
	case '6':
	case '7':
	case '8':
	case '9':
	case '(':
	case ')':
	    break;		/* "read-only" registers */
	}
    }
    else if (stab == envstab && envname) {
	setenv(envname,str_get(str));
				/* And you'll never guess what the dog had */
	safefree(envname);	/*   in its mouth... */
	envname = Nullch;
    }
    else if (stab == sigstab && signame) {
	s = str_get(str);
	i = whichsig(signame);	/* ...no, a brick */
	if (strEQ(s,"IGNORE"))
	    signal(i,SIG_IGN);
	else if (strEQ(s,"DEFAULT") || !*s)
	    signal(i,SIG_DFL);
	else
	    signal(i,sighandler);
	safefree(signame);
	signame = Nullch;
    }
}

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

    for (sigv = sig_name+1; *sigv; sigv++)
	if (strEQ(signame,*sigv))
	    return sigv - sig_name;
    return 0;
}

sighandler(sig)
int sig;
{
    STAB *stab;
    ARRAY *savearray;
    STR *str;

    stab = stabent(str_get(hfetch(sigstab->stab_hash,sig_name[sig])),TRUE);
    savearray = defstab->stab_array;
    defstab->stab_array = anew();
    str = str_new(0);
    str_set(str,sig_name[sig]);
    apush(defstab->stab_array,str);
    str = cmd_exec(stab->stab_sub);
    afree(defstab->stab_array);  /* put back old $_[] */
    defstab->stab_array = savearray;
}

char *
reg_get(name)
char *name;
{
    return STAB_GET(stabent(name,TRUE));
}

#ifdef NOTUSED
reg_set(name,value)
char *name;
char *value;
{
    str_set(STAB_STR(stabent(name,TRUE)),value);
}
#endif

STAB *
aadd(stab)
register STAB *stab;
{
    if (!stab->stab_array)
	stab->stab_array = anew();
    return stab;
}

STAB *
hadd(stab)
register STAB *stab;
{
    if (!stab->stab_hash)
	stab->stab_hash = hnew();
    return stab;
}
Commit	Line	Data
2e1b3b7e	1	/* $Header: stab.c,v 1.0.1.2 88/02/02 11:25:53 root Exp $
8d063cd8	2	*
8d063cd8	3	* $Log: stab.c,v $
2e1b3b7e	4	* Revision 1.0.1.2 88/02/02 11:25:53 root
	5	* patch13: moved extern int out of function for a poor Xenix machine.
	6	*
a559c259	7	* Revision 1.0.1.1 88/01/28 10:35:17 root
	8	* patch8: changed some stabents to support eval operator.
	9	*
8d063cd8	10	* Revision 1.0 87/12/18 13:06:14 root
	11	* Initial revision
	12	*
	13	*/
	14
	15	#include <signal.h>
	16	#include "handy.h"
	17	#include "EXTERN.h"
	18	#include "search.h"
	19	#include "util.h"
	20	#include "perl.h"
	21
	22	static char *sig_name[] = {
	23	"",
	24	"HUP",
	25	"INT",
	26	"QUIT",
	27	"ILL",
	28	"TRAP",
	29	"IOT",
	30	"EMT",
	31	"FPE",
	32	"KILL",
	33	"BUS",
	34	"SEGV",
	35	"SYS",
	36	"PIPE",
	37	"ALRM",
	38	"TERM",
	39	"???"
	40	#ifdef SIGTSTP
	41	,"STOP",
	42	"TSTP",
	43	"CONT",
	44	"CHLD",
	45	"TTIN",
	46	"TTOU",
	47	"TINT",
	48	"XCPU",
	49	"XFSZ"
	50	#ifdef SIGPROF
	51	,"VTALARM",
	52	"PROF"
	53	#ifdef SIGWINCH
	54	,"WINCH"
	55	#ifdef SIGLOST
	56	,"LOST"
	57	#ifdef SIGUSR1
	58	,"USR1"
	59	#endif
	60	#ifdef SIGUSR2
	61	,"USR2"
	62	#endif /* SIGUSR2 */
	63	#endif /* SIGLOST */
	64	#endif /* SIGWINCH */
	65	#endif /* SIGPROF */
	66	#endif /* SIGTSTP */
	67	,0
	68	};
	69
2e1b3b7e	70	extern int errno;
2e1b3b7e	71
8d063cd8	72	STR *
	73	stab_str(stab)
	74	STAB *stab;
	75	{
	76	register int paren;
	77	register char *s;
8d063cd8	78
	79	switch (*stab->stab_name) {
	80	case '0': case '1': case '2': case '3': case '4':
	81	case '5': case '6': case '7': case '8': case '9': case '&':
	82	if (curspat) {
	83	paren = atoi(stab->stab_name);
	84	if (curspat->spat_compex.subend[paren] &&
	85	(s = getparen(&curspat->spat_compex,paren))) {
	86	curspat->spat_compex.subend[paren] = Nullch;
	87	str_set(stab->stab_val,s);
	88	}
	89	}
	90	break;
	91	case '+':
	92	if (curspat) {
	93	paren = curspat->spat_compex.lastparen;
	94	if (curspat->spat_compex.subend[paren] &&
	95	(s = getparen(&curspat->spat_compex,paren))) {
	96	curspat->spat_compex.subend[paren] = Nullch;
	97	str_set(stab->stab_val,s);
	98	}
	99	}
	100	break;
	101	case '.':
	102	if (last_in_stab) {
	103	str_numset(stab->stab_val,(double)last_in_stab->stab_io->lines);
	104	}
	105	break;
	106	case '?':
	107	str_numset(stab->stab_val,(double)statusvalue);
	108	break;
	109	case '^':
	110	s = curoutstab->stab_io->top_name;
	111	str_set(stab->stab_val,s);
	112	break;
	113	case '~':
	114	s = curoutstab->stab_io->fmt_name;
	115	str_set(stab->stab_val,s);
	116	break;
	117	case '=':
	118	str_numset(stab->stab_val,(double)curoutstab->stab_io->lines);
	119	break;
	120	case '-':
	121	str_numset(stab->stab_val,(double)curoutstab->stab_io->lines_left);
	122	break;
	123	case '%':
	124	str_numset(stab->stab_val,(double)curoutstab->stab_io->page);
	125	break;
	126	case '(':
	127	if (curspat) {
	128	str_numset(stab->stab_val,(double)(curspat->spat_compex.subbeg[0] -
	129	curspat->spat_compex.subbase));
	130	}
	131	break;
	132	case ')':
	133	if (curspat) {
	134	str_numset(stab->stab_val,(double)(curspat->spat_compex.subend[0] -
	135	curspat->spat_compex.subbeg[0]));
	136	}
	137	break;
	138	case '/':
	139	*tokenbuf = record_separator;
	140	tokenbuf[1] = '\0';
	141	str_set(stab->stab_val,tokenbuf);
142	break;
143	case '[':
144	str_numset(stab->stab_val,(double)arybase);
145	break;
146	case '\|':
147	str_numset(stab->stab_val,
148	(double)((curoutstab->stab_io->flags & IOF_FLUSH) != 0) );
149	break;
150	case ',':
151	str_set(stab->stab_val,ofs);
152	break;
153	case '\\':
154	str_set(stab->stab_val,ors);
155	break;
156	case '#':
157	str_set(stab->stab_val,ofmt);
158	break;
159	case '!':
160	str_numset(stab->stab_val,(double)errno);
161	break;
162	}
163	return stab->stab_val;
164	}
165
166	stabset(stab,str)
167	register STAB *stab;
168	STR *str;
169	{
170	char *s;
171	int i;
172	int sighandler();
173
174	if (stab->stab_flags & SF_VMAGIC) {
175	switch (stab->stab_name[0]) {
176	case '^':
177	safefree(curoutstab->stab_io->top_name);
178	curoutstab->stab_io->top_name = str_get(str);
a559c259	179	curoutstab->stab_io->top_stab = stabent(str_get(str),TRUE);
8d063cd8	180	break;
	181	case '~':
	182	safefree(curoutstab->stab_io->fmt_name);
	183	curoutstab->stab_io->fmt_name = str_get(str);
a559c259	184	curoutstab->stab_io->fmt_stab = stabent(str_get(str),TRUE);
8d063cd8	185	break;
	186	case '=':
	187	curoutstab->stab_io->page_len = (long)str_gnum(str);
	188	break;
	189	case '-':
	190	curoutstab->stab_io->lines_left = (long)str_gnum(str);
	191	break;
	192	case '%':
	193	curoutstab->stab_io->page = (long)str_gnum(str);
	194	break;
	195	case '\|':
	196	curoutstab->stab_io->flags &= ~IOF_FLUSH;
	197	if (str_gnum(str) != 0.0) {
	198	curoutstab->stab_io->flags \|= IOF_FLUSH;
	199	}
	200	break;
	201	case '*':
	202	multiline = (int)str_gnum(str) != 0;
	203	break;
	204	case '/':
	205	record_separator = *str_get(str);
	206	break;
	207	case '\\':
	208	if (ors)
	209	safefree(ors);
	210	ors = savestr(str_get(str));
	211	break;
	212	case ',':
	213	if (ofs)
	214	safefree(ofs);
	215	ofs = savestr(str_get(str));
	216	break;
	217	case '#':
	218	if (ofmt)
	219	safefree(ofmt);
	220	ofmt = savestr(str_get(str));
	221	break;
	222	case '[':
	223	arybase = (int)str_gnum(str);
	224	break;
	225	case '!':
	226	errno = (int)str_gnum(str); /* will anyone ever use this? */
	227	break;
	228	case '.':
	229	case '+':
	230	case '&':
	231	case '0':
	232	case '1':
	233	case '2':
	234	case '3':
	235	case '4':
	236	case '5':
	237	case '6':
	238	case '7':
	239	case '8':
	240	case '9':
	241	case '(':
	242	case ')':
	243	break; /* "read-only" registers */
	244	}
	245	}
	246	else if (stab == envstab && envname) {
	247	setenv(envname,str_get(str));
	248	/* And you'll never guess what the dog had */
249	safefree(envname); /* in its mouth... */
250	envname = Nullch;
251	}
252	else if (stab == sigstab && signame) {
253	s = str_get(str);
254	i = whichsig(signame); /* ...no, a brick */
255	if (strEQ(s,"IGNORE"))
256	signal(i,SIG_IGN);
257	else if (strEQ(s,"DEFAULT") \|\| !*s)
258	signal(i,SIG_DFL);
259	else
260	signal(i,sighandler);
261	safefree(signame);
262	signame = Nullch;
263	}
264	}
265
266	whichsig(signame)
267	char *signame;
268	{
269	register char **sigv;
270
271	for (sigv = sig_name+1; *sigv; sigv++)
272	if (strEQ(signame,*sigv))
273	return sigv - sig_name;
274	return 0;
275	}
276
277	sighandler(sig)
278	int sig;
279	{
280	STAB *stab;
281	ARRAY *savearray;
282	STR *str;
283
a559c259	284	stab = stabent(str_get(hfetch(sigstab->stab_hash,sig_name[sig])),TRUE);
8d063cd8	285	savearray = defstab->stab_array;
	286	defstab->stab_array = anew();
	287	str = str_new(0);
	288	str_set(str,sig_name[sig]);
	289	apush(defstab->stab_array,str);
	290	str = cmd_exec(stab->stab_sub);
	291	afree(defstab->stab_array); /* put back old $_[] */
	292	defstab->stab_array = savearray;
	293	}
	294
	295	char *
	296	reg_get(name)
	297	char *name;
	298	{
	299	return STAB_GET(stabent(name,TRUE));
	300	}
	301
	302	#ifdef NOTUSED
	303	reg_set(name,value)
	304	char *name;
	305	char *value;
	306	{
	307	str_set(STAB_STR(stabent(name,TRUE)),value);
	308	}
	309	#endif
	310
	311	STAB *
	312	aadd(stab)
	313	register STAB *stab;
	314	{
	315	if (!stab->stab_array)
	316	stab->stab_array = anew();
	317	return stab;
	318	}
	319
	320	STAB *
	321	hadd(stab)
	322	register STAB *stab;
	323	{
	324	if (!stab->stab_hash)
	325	stab->stab_hash = hnew();
	326	return stab;
	327	}