1 /* $RCSfile: stab.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:10:24 $
3 * Copyright (c) 1989, Larry Wall
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.
9 * Revision 4.0.1.1 91/04/12 09:10:24 lwall
10 * patch1: Configure now differentiates getgroups() type from getgid() type
11 * patch1: you may now use "die" and "caller" in a signal handler
13 * Revision 4.0 91/03/20 01:39:41 lwall
21 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
25 static char *sig_name[] = {
30 #define handlertype void
32 #define handlertype int
35 static handlertype sighandler();
37 static int origalen = 0;
43 STAB *stab = str->str_u.str_stab;
49 return stab_val(stab);
51 switch (*stab->str_magic->str_ptr) {
54 str_numset(stab_val(stab),(double)(debug & 32767));
59 str_set(stab_val(stab), inplace);
61 str_sset(stab_val(stab),&str_undef);
64 str_numset(stab_val(stab),(double)basetime);
67 str_numset(stab_val(stab),(double)dowarn);
69 case '1': case '2': case '3': case '4':
70 case '5': case '6': case '7': case '8': case '9': case '&':
72 paren = atoi(stab_name(stab));
74 if (curspat->spat_regexp &&
75 paren <= curspat->spat_regexp->nparens &&
76 (s = curspat->spat_regexp->startp[paren]) ) {
77 i = curspat->spat_regexp->endp[paren] - s;
79 str_nset(stab_val(stab),s,i);
81 str_sset(stab_val(stab),&str_undef);
84 str_sset(stab_val(stab),&str_undef);
89 paren = curspat->spat_regexp->lastparen;
95 if (curspat->spat_regexp &&
96 (s = curspat->spat_regexp->subbase) ) {
97 i = curspat->spat_regexp->startp[0] - s;
99 str_nset(stab_val(stab),s,i);
101 str_nset(stab_val(stab),"",0);
104 str_nset(stab_val(stab),"",0);
109 if (curspat->spat_regexp &&
110 (s = curspat->spat_regexp->endp[0]) ) {
111 str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
114 str_nset(stab_val(stab),"",0);
120 str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
125 str_numset(stab_val(stab),(double)statusvalue);
128 s = stab_io(curoutstab)->top_name;
129 str_set(stab_val(stab),s);
132 s = stab_io(curoutstab)->fmt_name;
133 str_set(stab_val(stab),s);
137 str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
140 str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
143 str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
149 str_numset(stab_val(stab),(double)arybase);
152 if (!stab_io(curoutstab))
153 stab_io(curoutstab) = stio_new();
154 str_numset(stab_val(stab),
155 (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
158 str_nset(stab_val(stab),ofs,ofslen);
161 str_nset(stab_val(stab),ors,orslen);
164 str_set(stab_val(stab),ofmt);
167 str_numset(stab_val(stab), (double)errno);
168 str_set(stab_val(stab), errno ? strerror(errno) : "");
169 stab_val(stab)->str_nok = 1; /* what a wonderful hack! */
172 str_numset(stab_val(stab),(double)uid);
175 str_numset(stab_val(stab),(double)euid);
179 (void)sprintf(s,"%d",(int)gid);
183 (void)sprintf(s,"%d",(int)egid);
191 GROUPSTYPE gary[NGROUPS];
193 i = getgroups(NGROUPS,gary);
195 (void)sprintf(s," %ld", (long)gary[i]);
200 str_set(stab_val(stab),buf);
208 struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
210 if (uf && uf->uf_val)
211 (*uf->uf_val)(uf->uf_index, stab_val(stab));
215 return stab_val(stab);
222 STAB *stab = mstr->str_u.str_stab;
226 switch (mstr->str_rare) {
228 setenv(mstr->str_ptr,str_get(str));
229 /* And you'll never guess what the dog had */
230 /* in its mouth... */
232 if (strEQ(mstr->str_ptr,"PATH")) {
233 char *strend = str->str_ptr + str->str_cur;
237 s = cpytill(tokenbuf,s,strend,':',&i);
240 || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
241 str->str_tainted = 2;
248 i = whichsig(mstr->str_ptr); /* ...no, a brick */
249 if (strEQ(s,"IGNORE"))
251 (void)signal(i,SIG_IGN);
255 else if (strEQ(s,"DEFAULT") || !*s)
256 (void)signal(i,SIG_DFL);
258 (void)signal(i,sighandler);
259 if (!index(s,'\'')) {
260 sprintf(tokenbuf, "main'%s",s);
261 str_set(str,tokenbuf);
267 hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
275 str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE);
276 cmd = str->str_magic->str_u.str_cmd;
277 cmd->c_flags &= ~CF_OPTIMIZE;
278 cmd->c_flags |= i? CFT_D1 : CFT_D0;
282 afill(stab_array(stab), (int)str_gnum(str) - arybase);
284 case 'X': /* merely a copy of a * string */
288 if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
292 (void)savenostab(stab); /* schedule a free of this stab */
294 Safefree(stab->str_ptr);
295 Newz(601,stbp, 1, STBP);
296 stab->str_ptr = stbp;
297 stab->str_len = stab->str_cur = sizeof(STBP);
299 strcpy(stab_magic(stab),"StB");
300 stab_val(stab) = Str_new(70,0);
301 stab_line(stab) = curcmd->c_line;
302 stab_stash(stab) = curcmd->c_stash;
305 stab = stabent(s,TRUE);
306 if (!stab_xarray(stab))
308 if (!stab_xhash(stab))
311 stab_io(stab) = stio_new();
317 struct lstring *lstr = (struct lstring*)str;
321 str->str_magic = Nullstr;
323 str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
333 switch (*stab->str_magic->str_ptr) {
334 case '\004': /* ^D */
336 debug = (int)(str_gnum(str)) | 32768;
342 if (str->str_pok || str->str_nok)
343 inplace = savestr(str_get(str));
347 case '\024': /* ^T */
348 basetime = (long)str_gnum(str);
350 case '\027': /* ^W */
351 dowarn = (bool)str_gnum(str);
355 savesptr((STR**)&last_in_stab);
358 Safefree(stab_io(curoutstab)->top_name);
359 stab_io(curoutstab)->top_name = s = savestr(str_get(str));
360 stab_io(curoutstab)->top_stab = stabent(s,TRUE);
363 Safefree(stab_io(curoutstab)->fmt_name);
364 stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
365 stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
368 stab_io(curoutstab)->page_len = (long)str_gnum(str);
371 stab_io(curoutstab)->lines_left = (long)str_gnum(str);
372 if (stab_io(curoutstab)->lines_left < 0L)
373 stab_io(curoutstab)->lines_left = 0L;
376 stab_io(curoutstab)->page = (long)str_gnum(str);
379 if (!stab_io(curoutstab))
380 stab_io(curoutstab) = stio_new();
381 stab_io(curoutstab)->flags &= ~IOF_FLUSH;
382 if (str_gnum(str) != 0.0) {
383 stab_io(curoutstab)->flags |= IOF_FLUSH;
387 i = (int)str_gnum(str);
388 multiline = (i != 0);
393 rslen = str->str_cur;
398 rschar = rs[rslen - 1];
401 rschar = 0777; /* fake a non-existent char */
408 ors = savestr(str_get(str));
409 orslen = str->str_cur;
414 ofs = savestr(str_get(str));
415 ofslen = str->str_cur;
420 ofmt = savestr(str_get(str));
423 arybase = (int)str_gnum(str);
426 statusvalue = U_S(str_gnum(str));
429 errno = (int)str_gnum(str); /* will anyone ever use this? */
432 uid = (int)str_gnum(str);
435 delaymagic |= DM_REUID;
436 break; /* don't do magic till later */
438 #endif /* HAS_SETREUID */
440 if (setruid((UIDTYPE)uid) < 0)
444 if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
447 if (uid == euid) /* special case $< = $> */
450 fatal("setruid() not implemented");
455 euid = (int)str_gnum(str);
458 delaymagic |= DM_REUID;
459 break; /* don't do magic till later */
461 #endif /* HAS_SETREUID */
463 if (seteuid((UIDTYPE)euid) < 0)
464 euid = (int)geteuid();
467 if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
468 euid = (int)geteuid();
470 if (euid == uid) /* special case $> = $< */
473 fatal("seteuid() not implemented");
478 gid = (int)str_gnum(str);
481 delaymagic |= DM_REGID;
482 break; /* don't do magic till later */
484 #endif /* HAS_SETREGID */
486 (void)setrgid((GIDTYPE)gid);
489 (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
491 fatal("setrgid() not implemented");
496 egid = (int)str_gnum(str);
499 delaymagic |= DM_REGID;
500 break; /* don't do magic till later */
502 #endif /* HAS_SETREGID */
504 (void)setegid((GIDTYPE)egid);
507 (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
509 fatal("setegid() not implemented");
514 chopset = str_get(str);
520 /* See if all the arguments are contiguous in memory */
521 for (i = 1; i < origargc; i++) {
522 if (origargv[i] == s + 1)
523 s += strlen(++s); /* this one is ok too */
525 if (origenviron[0] == s + 1) { /* can grab env area too? */
526 setenv("NoNeSuCh", Nullch); /* force copy of environment */
527 for (i = 0; origenviron[i]; i++)
528 if (origenviron[i] == s + 1)
531 origalen = s - origargv[0];
538 str->str_ptr[i] = '\0';
539 bcopy(s, origargv[0], i);
542 bcopy(s, origargv[0], i);
545 while (++i < origalen)
551 struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
553 if (uf && uf->uf_set)
554 (*uf->uf_set)(uf->uf_index, str);
565 register char **sigv;
567 for (sigv = sig_name+1; *sigv; sigv++)
568 if (strEQ(sig,*sigv))
569 return sigv - sig_name;
571 if (strEQ(sig,"CHLD"))
575 if (strEQ(sig,"CLD"))
587 int oldsave = savestack->ary_fill;
588 int oldtmps_base = tmps_base;
592 #ifdef OS2 /* or anybody else who requires SIG_ACK */
593 signal(sig, SIG_ACK);
596 str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
598 sub = stab_sub(stab);
599 if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
600 if (sig_name[sig][1] == 'H')
601 stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
604 stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
606 sub = stab_sub(stab); /* gag */
610 warn("SIG%s handler \"%s\" not defined.\n",
611 sig_name[sig], stab_name(stab) );
615 str = Str_new(15, sizeof(CSV));
616 str->str_state = SS_SCSV;
617 (void)apush(savestack,str);
618 csv = (CSV*)str->str_ptr;
621 csv->curcsv = curcsv;
622 csv->curcmd = curcmd;
623 csv->depth = sub->depth;
624 csv->wantarray = G_SCALAR;
626 csv->savearray = stab_xarray(defstab);
627 csv->argarray = stab_xarray(defstab) = stack = anew(defstab);
628 stack->ary_flags = 0;
630 str = str_mortal(&str_undef);
631 str_set(str,sig_name[sig]);
632 (void)apush(stab_xarray(defstab),str);
634 if (sub->depth >= 2) { /* save temporaries on recursion? */
635 if (sub->depth == 100 && dowarn)
636 warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
637 savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
640 tmps_base = tmps_max; /* protect our mortal string */
641 (void)cmd_exec(sub->cmd,G_SCALAR,0); /* so do it already */
642 tmps_base = oldtmps_base;
644 restorelist(oldsave); /* put everything back */
651 if (!stab_xarray(stab))
652 stab_xarray(stab) = anew(stab);
660 if (!stab_xhash(stab))
661 stab_xhash(stab) = hnew(COEFFSIZE);
672 sprintf(tmpbuf,"'_<%s", name);
673 stab = stabent(tmpbuf, TRUE);
674 str_set(stab_val(stab), name);
676 (void)hadd(aadd(stab));
688 register char *namend;
690 char *sawquote = Nullch;
691 char *prevquote = Nullch;
694 if (isascii(*name) && isupper(*name)) {
696 if (*name == 'S' && (
697 strEQ(name, "SIG") ||
698 strEQ(name, "STDIN") ||
699 strEQ(name, "STDOUT") ||
700 strEQ(name, "STDERR") ))
703 else if (*name > 'E') {
704 if (*name == 'I' && strEQ(name, "INC"))
707 else if (*name > 'A') {
708 if (*name == 'E' && strEQ(name, "ENV"))
711 else if (*name == 'A' && (
712 strEQ(name, "ARGV") ||
713 strEQ(name, "ARGVOUT") ))
716 for (namend = name; *namend; namend++) {
717 if (*namend == '\'' && namend[1])
718 prevquote = sawquote, sawquote = namend;
720 if (sawquote == name && name[1]) {
725 else if (!isalpha(*name) || global)
727 else if (curcmd == &compiling)
730 stash = curcmd->c_stash;
737 strncpy(tmpbuf,name,s-name+1);
738 d = tmpbuf+(s-name+1);
744 strcpy(tmpbuf+1,name);
746 stab = stabent(tmpbuf,TRUE);
747 if (!(stash = stab_xhash(stab)))
748 stash = stab_xhash(stab) = hnew(0);
749 if (!stash->tbl_name)
750 stash->tbl_name = savestr(name);
755 stab = (STAB*)hfetch(stash,name,len,add);
756 if (stab == (STAB*)&str_undef)
759 stab->str_pok |= SP_MULTI;
764 Safefree(stab->str_ptr);
765 Newz(602,stbp, 1, STBP);
766 stab->str_ptr = stbp;
767 stab->str_len = stab->str_cur = sizeof(STBP);
769 strcpy(stab_magic(stab),"StB");
770 stab_val(stab) = Str_new(72,0);
771 stab_line(stab) = curcmd->c_line;
772 str_magic(stab,stab,'*',name,len);
773 stab_stash(stab) = stash;
774 if (isdigit(*name) && *name != '0') {
775 stab_flags(stab) = SF_VMAGIC;
776 str_magic(stab_val(stab), stab, 0, Nullch, 0);
782 stab_fullname(str,stab)
786 HASH *tb = stab_stash(stab);
790 str_set(str,tb->tbl_name);
791 str_ncat(str,"'", 1);
792 str_scat(str,stab->str_magic);
800 Newz(603,stio,1,STIO);
809 register HENT *entry;
813 for (i = min; i <= max; i++) {
814 for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
815 stab = (STAB*)entry->hent_val;
816 if (stab->str_pok & SP_MULTI)
818 curcmd->c_line = stab_line(stab);
819 warn("Possible typo: \"%s\"", stab_name(stab));
824 static int gensym = 0;
829 (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
830 return stabent(tokenbuf,TRUE);
833 /* hopefully this is only called on local symbol table entries */
842 afree(stab_xarray(stab));
843 stab_xarray(stab) = Null(ARRAY*);
844 (void)hfree(stab_xhash(stab), FALSE);
845 stab_xhash(stab) = Null(HASH*);
846 str_free(stab_val(stab));
847 stab_val(stab) = Nullstr;
848 if (stio = stab_io(stab)) {
849 do_close(stab,FALSE);
850 Safefree(stio->top_name);
851 Safefree(stio->fmt_name);
853 if (sub = stab_sub(stab)) {
857 Safefree(stab->str_ptr);
858 stab->str_ptr = Null(STBP*);
863 #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
867 #ifdef MICROPORT /* Microport 2.4 hack */
868 ARRAY *stab_array(stab)
871 if (((STBP*)(stab->str_ptr))->stbp_array)
872 return ((STBP*)(stab->str_ptr))->stbp_array;
874 return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
877 HASH *stab_hash(stab)
880 if (((STBP*)(stab->str_ptr))->stbp_hash)
881 return ((STBP*)(stab->str_ptr))->stbp_hash;
883 return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
885 #endif /* Microport 2.4 hack */