1 /* $RCSfile: stab.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:55:53 $
3 * Copyright (c) 1991, Larry Wall
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
9 * Revision 4.0.1.2 91/06/07 11:55:53 lwall
10 * patch4: new copyright notice
11 * patch4: added $^P variable to control calling of perldb routines
12 * patch4: added $^F variable to specify maximum system fd, default 2
13 * patch4: $` was busted inside s///
14 * patch4: default top-of-form format is now FILEHANDLE_TOP
15 * patch4: length($`), length($&), length($') now optimized to avoid string copy
16 * patch4: $^D |= 1024 now does syntax tree dump at run-time
18 * Revision 4.0.1.1 91/04/12 09:10:24 lwall
19 * patch1: Configure now differentiates getgroups() type from getgid() type
20 * patch1: you may now use "die" and "caller" in a signal handler
22 * Revision 4.0 91/03/20 01:39:41 lwall
30 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
34 static char *sig_name[] = {
39 #define handlertype void
41 #define handlertype int
44 static handlertype sighandler();
46 static int origalen = 0;
52 STAB *stab = str->str_u.str_stab;
58 return stab_val(stab);
60 switch (*stab->str_magic->str_ptr) {
63 str_numset(stab_val(stab),(double)(debug & 32767));
67 str_numset(stab_val(stab),(double)maxsysfd);
71 str_set(stab_val(stab), inplace);
73 str_sset(stab_val(stab),&str_undef);
76 str_numset(stab_val(stab),(double)perldb);
79 str_numset(stab_val(stab),(double)basetime);
82 str_numset(stab_val(stab),(double)dowarn);
84 case '1': case '2': case '3': case '4':
85 case '5': case '6': case '7': case '8': case '9': case '&':
87 paren = atoi(stab_name(stab));
89 if (curspat->spat_regexp &&
90 paren <= curspat->spat_regexp->nparens &&
91 (s = curspat->spat_regexp->startp[paren]) ) {
92 i = curspat->spat_regexp->endp[paren] - s;
94 str_nset(stab_val(stab),s,i);
96 str_sset(stab_val(stab),&str_undef);
99 str_sset(stab_val(stab),&str_undef);
104 paren = curspat->spat_regexp->lastparen;
110 if (curspat->spat_regexp &&
111 (s = curspat->spat_regexp->subbeg) ) {
112 i = curspat->spat_regexp->startp[0] - s;
114 str_nset(stab_val(stab),s,i);
116 str_nset(stab_val(stab),"",0);
119 str_nset(stab_val(stab),"",0);
124 if (curspat->spat_regexp &&
125 (s = curspat->spat_regexp->endp[0]) ) {
126 str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
129 str_nset(stab_val(stab),"",0);
135 str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
140 str_numset(stab_val(stab),(double)statusvalue);
143 s = stab_io(curoutstab)->top_name;
145 str_set(stab_val(stab),s);
147 str_set(stab_val(stab),stab_name(curoutstab));
148 str_cat(stab_val(stab),"_TOP");
152 s = stab_io(curoutstab)->fmt_name;
154 s = stab_name(curoutstab);
155 str_set(stab_val(stab),s);
159 str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
162 str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
165 str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
171 str_numset(stab_val(stab),(double)arybase);
174 if (!stab_io(curoutstab))
175 stab_io(curoutstab) = stio_new();
176 str_numset(stab_val(stab),
177 (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
180 str_nset(stab_val(stab),ofs,ofslen);
183 str_nset(stab_val(stab),ors,orslen);
186 str_set(stab_val(stab),ofmt);
189 str_numset(stab_val(stab), (double)errno);
190 str_set(stab_val(stab), errno ? strerror(errno) : "");
191 stab_val(stab)->str_nok = 1; /* what a wonderful hack! */
194 str_numset(stab_val(stab),(double)uid);
197 str_numset(stab_val(stab),(double)euid);
201 (void)sprintf(s,"%d",(int)gid);
205 (void)sprintf(s,"%d",(int)egid);
213 GROUPSTYPE gary[NGROUPS];
215 i = getgroups(NGROUPS,gary);
217 (void)sprintf(s," %ld", (long)gary[i]);
222 str_set(stab_val(stab),buf);
230 struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
232 if (uf && uf->uf_val)
233 (*uf->uf_val)(uf->uf_index, stab_val(stab));
237 return stab_val(stab);
244 STAB *stab = str->str_u.str_stab;
250 return stab_val(stab)->str_cur;
252 switch (*stab->str_magic->str_ptr) {
253 case '1': case '2': case '3': case '4':
254 case '5': case '6': case '7': case '8': case '9': case '&':
256 paren = atoi(stab_name(stab));
258 if (curspat->spat_regexp &&
259 paren <= curspat->spat_regexp->nparens &&
260 (s = curspat->spat_regexp->startp[paren]) ) {
261 i = curspat->spat_regexp->endp[paren] - s;
273 paren = curspat->spat_regexp->lastparen;
279 if (curspat->spat_regexp &&
280 (s = curspat->spat_regexp->subbeg) ) {
281 i = curspat->spat_regexp->startp[0] - s;
293 if (curspat->spat_regexp &&
294 (s = curspat->spat_regexp->endp[0]) ) {
295 return (STRLEN) (curspat->spat_regexp->subend - s);
302 return (STRLEN)ofslen;
304 return (STRLEN)orslen;
306 return stab_str(str)->str_cur;
314 STAB *stab = mstr->str_u.str_stab;
318 switch (mstr->str_rare) {
320 setenv(mstr->str_ptr,str_get(str));
321 /* And you'll never guess what the dog had */
322 /* in its mouth... */
324 if (strEQ(mstr->str_ptr,"PATH")) {
325 char *strend = str->str_ptr + str->str_cur;
329 s = cpytill(tokenbuf,s,strend,':',&i);
332 || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
333 str->str_tainted = 2;
340 i = whichsig(mstr->str_ptr); /* ...no, a brick */
341 if (strEQ(s,"IGNORE"))
343 (void)signal(i,SIG_IGN);
347 else if (strEQ(s,"DEFAULT") || !*s)
348 (void)signal(i,SIG_DFL);
350 (void)signal(i,sighandler);
351 if (!index(s,'\'')) {
352 sprintf(tokenbuf, "main'%s",s);
353 str_set(str,tokenbuf);
359 hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
367 str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE);
368 cmd = str->str_magic->str_u.str_cmd;
369 cmd->c_flags &= ~CF_OPTIMIZE;
370 cmd->c_flags |= i? CFT_D1 : CFT_D0;
374 afill(stab_array(stab), (int)str_gnum(str) - arybase);
376 case 'X': /* merely a copy of a * string */
380 if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
384 (void)savenostab(stab); /* schedule a free of this stab */
386 Safefree(stab->str_ptr);
387 Newz(601,stbp, 1, STBP);
388 stab->str_ptr = stbp;
389 stab->str_len = stab->str_cur = sizeof(STBP);
391 strcpy(stab_magic(stab),"StB");
392 stab_val(stab) = Str_new(70,0);
393 stab_line(stab) = curcmd->c_line;
394 stab_stash(stab) = curcmd->c_stash;
397 stab = stabent(s,TRUE);
398 if (!stab_xarray(stab))
400 if (!stab_xhash(stab))
403 stab_io(stab) = stio_new();
409 struct lstring *lstr = (struct lstring*)str;
413 str->str_magic = Nullstr;
415 str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
425 switch (*stab->str_magic->str_ptr) {
426 case '\004': /* ^D */
428 debug = (int)(str_gnum(str)) | 32768;
433 case '\006': /* ^F */
434 maxsysfd = (int)str_gnum(str);
439 if (str->str_pok || str->str_nok)
440 inplace = savestr(str_get(str));
444 case '\020': /* ^P */
445 perldb = (int)str_gnum(str);
447 case '\024': /* ^T */
448 basetime = (long)str_gnum(str);
450 case '\027': /* ^W */
451 dowarn = (bool)str_gnum(str);
455 savesptr((STR**)&last_in_stab);
458 Safefree(stab_io(curoutstab)->top_name);
459 stab_io(curoutstab)->top_name = s = savestr(str_get(str));
460 stab_io(curoutstab)->top_stab = stabent(s,TRUE);
463 Safefree(stab_io(curoutstab)->fmt_name);
464 stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
465 stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
468 stab_io(curoutstab)->page_len = (long)str_gnum(str);
471 stab_io(curoutstab)->lines_left = (long)str_gnum(str);
472 if (stab_io(curoutstab)->lines_left < 0L)
473 stab_io(curoutstab)->lines_left = 0L;
476 stab_io(curoutstab)->page = (long)str_gnum(str);
479 if (!stab_io(curoutstab))
480 stab_io(curoutstab) = stio_new();
481 stab_io(curoutstab)->flags &= ~IOF_FLUSH;
482 if (str_gnum(str) != 0.0) {
483 stab_io(curoutstab)->flags |= IOF_FLUSH;
487 i = (int)str_gnum(str);
488 multiline = (i != 0);
493 rslen = str->str_cur;
498 rschar = rs[rslen - 1];
501 rschar = 0777; /* fake a non-existent char */
508 ors = savestr(str_get(str));
509 orslen = str->str_cur;
514 ofs = savestr(str_get(str));
515 ofslen = str->str_cur;
520 ofmt = savestr(str_get(str));
523 arybase = (int)str_gnum(str);
526 statusvalue = U_S(str_gnum(str));
529 errno = (int)str_gnum(str); /* will anyone ever use this? */
532 uid = (int)str_gnum(str);
533 #if defined(HAS_SETREUID) || !defined(HAS_SETRUID)
535 delaymagic |= DM_REUID;
536 break; /* don't do magic till later */
538 #endif /* HAS_SETREUID or not HASSETRUID */
540 if (setruid((UIDTYPE)uid) < 0)
544 if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
547 if (uid == euid) /* special case $< = $> */
550 fatal("setruid() not implemented");
555 euid = (int)str_gnum(str);
556 #if defined(HAS_SETREUID) || !defined(HAS_SETEUID)
558 delaymagic |= DM_REUID;
559 break; /* don't do magic till later */
561 #endif /* HAS_SETREUID or not HAS_SETEUID */
563 if (seteuid((UIDTYPE)euid) < 0)
564 euid = (int)geteuid();
567 if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
568 euid = (int)geteuid();
570 if (euid == uid) /* special case $> = $< */
573 fatal("seteuid() not implemented");
578 gid = (int)str_gnum(str);
579 #if defined(HAS_SETREGID) || !defined(HAS_SETRGID)
581 delaymagic |= DM_REGID;
582 break; /* don't do magic till later */
584 #endif /* HAS_SETREGID or not HAS_SETRGID */
586 (void)setrgid((GIDTYPE)gid);
589 (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
591 fatal("setrgid() not implemented");
596 egid = (int)str_gnum(str);
597 #if defined(HAS_SETREGID) || !defined(HAS_SETEGID)
599 delaymagic |= DM_REGID;
600 break; /* don't do magic till later */
602 #endif /* HAS_SETREGID or not HAS_SETEGID */
604 (void)setegid((GIDTYPE)egid);
607 (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
609 fatal("setegid() not implemented");
614 chopset = str_get(str);
620 /* See if all the arguments are contiguous in memory */
621 for (i = 1; i < origargc; i++) {
622 if (origargv[i] == s + 1)
623 s += strlen(++s); /* this one is ok too */
625 if (origenviron[0] == s + 1) { /* can grab env area too? */
626 setenv("NoNeSuCh", Nullch); /* force copy of environment */
627 for (i = 0; origenviron[i]; i++)
628 if (origenviron[i] == s + 1)
631 origalen = s - origargv[0];
638 str->str_ptr[i] = '\0';
639 bcopy(s, origargv[0], i);
642 bcopy(s, origargv[0], i);
645 while (++i < origalen)
651 struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
653 if (uf && uf->uf_set)
654 (*uf->uf_set)(uf->uf_index, str);
665 register char **sigv;
667 for (sigv = sig_name+1; *sigv; sigv++)
668 if (strEQ(sig,*sigv))
669 return sigv - sig_name;
671 if (strEQ(sig,"CHLD"))
675 if (strEQ(sig,"CLD"))
687 int oldsave = savestack->ary_fill;
688 int oldtmps_base = tmps_base;
692 #ifdef OS2 /* or anybody else who requires SIG_ACK */
693 signal(sig, SIG_ACK);
696 str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
698 sub = stab_sub(stab);
699 if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
700 if (sig_name[sig][1] == 'H')
701 stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
704 stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
706 sub = stab_sub(stab); /* gag */
710 warn("SIG%s handler \"%s\" not defined.\n",
711 sig_name[sig], stab_name(stab) );
715 str = Str_new(15, sizeof(CSV));
716 str->str_state = SS_SCSV;
717 (void)apush(savestack,str);
718 csv = (CSV*)str->str_ptr;
721 csv->curcsv = curcsv;
722 csv->curcmd = curcmd;
723 csv->depth = sub->depth;
724 csv->wantarray = G_SCALAR;
726 csv->savearray = stab_xarray(defstab);
727 csv->argarray = stab_xarray(defstab) = stack = anew(defstab);
728 stack->ary_flags = 0;
730 str = str_mortal(&str_undef);
731 str_set(str,sig_name[sig]);
732 (void)apush(stab_xarray(defstab),str);
734 if (sub->depth >= 2) { /* save temporaries on recursion? */
735 if (sub->depth == 100 && dowarn)
736 warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
737 savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
740 tmps_base = tmps_max; /* protect our mortal string */
741 (void)cmd_exec(sub->cmd,G_SCALAR,0); /* so do it already */
742 tmps_base = oldtmps_base;
744 restorelist(oldsave); /* put everything back */
751 if (!stab_xarray(stab))
752 stab_xarray(stab) = anew(stab);
760 if (!stab_xhash(stab))
761 stab_xhash(stab) = hnew(COEFFSIZE);
772 sprintf(tmpbuf,"'_<%s", name);
773 stab = stabent(tmpbuf, TRUE);
774 str_set(stab_val(stab), name);
776 (void)hadd(aadd(stab));
788 register char *namend;
790 char *sawquote = Nullch;
791 char *prevquote = Nullch;
794 if (isascii(*name) && isupper(*name)) {
796 if (*name == 'S' && (
797 strEQ(name, "SIG") ||
798 strEQ(name, "STDIN") ||
799 strEQ(name, "STDOUT") ||
800 strEQ(name, "STDERR") ))
803 else if (*name > 'E') {
804 if (*name == 'I' && strEQ(name, "INC"))
807 else if (*name > 'A') {
808 if (*name == 'E' && strEQ(name, "ENV"))
811 else if (*name == 'A' && (
812 strEQ(name, "ARGV") ||
813 strEQ(name, "ARGVOUT") ))
816 for (namend = name; *namend; namend++) {
817 if (*namend == '\'' && namend[1])
818 prevquote = sawquote, sawquote = namend;
820 if (sawquote == name && name[1]) {
825 else if (!isalpha(*name) || global)
827 else if (curcmd == &compiling)
830 stash = curcmd->c_stash;
837 strncpy(tmpbuf,name,s-name+1);
838 d = tmpbuf+(s-name+1);
844 strcpy(tmpbuf+1,name);
846 stab = stabent(tmpbuf,TRUE);
847 if (!(stash = stab_xhash(stab)))
848 stash = stab_xhash(stab) = hnew(0);
849 if (!stash->tbl_name)
850 stash->tbl_name = savestr(name);
855 stab = (STAB*)hfetch(stash,name,len,add);
856 if (stab == (STAB*)&str_undef)
859 stab->str_pok |= SP_MULTI;
864 Safefree(stab->str_ptr);
865 Newz(602,stbp, 1, STBP);
866 stab->str_ptr = stbp;
867 stab->str_len = stab->str_cur = sizeof(STBP);
869 strcpy(stab_magic(stab),"StB");
870 stab_val(stab) = Str_new(72,0);
871 stab_line(stab) = curcmd->c_line;
872 str_magic(stab,stab,'*',name,len);
873 stab_stash(stab) = stash;
874 if (isdigit(*name) && *name != '0') {
875 stab_flags(stab) = SF_VMAGIC;
876 str_magic(stab_val(stab), stab, 0, Nullch, 0);
882 stab_fullname(str,stab)
886 HASH *tb = stab_stash(stab);
890 str_set(str,tb->tbl_name);
891 str_ncat(str,"'", 1);
892 str_scat(str,stab->str_magic);
900 Newz(603,stio,1,STIO);
909 register HENT *entry;
913 for (i = min; i <= max; i++) {
914 for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
915 stab = (STAB*)entry->hent_val;
916 if (stab->str_pok & SP_MULTI)
918 curcmd->c_line = stab_line(stab);
919 warn("Possible typo: \"%s\"", stab_name(stab));
924 static int gensym = 0;
929 (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
930 return stabent(tokenbuf,TRUE);
933 /* hopefully this is only called on local symbol table entries */
942 afree(stab_xarray(stab));
943 stab_xarray(stab) = Null(ARRAY*);
944 (void)hfree(stab_xhash(stab), FALSE);
945 stab_xhash(stab) = Null(HASH*);
946 str_free(stab_val(stab));
947 stab_val(stab) = Nullstr;
948 if (stio = stab_io(stab)) {
949 do_close(stab,FALSE);
950 Safefree(stio->top_name);
951 Safefree(stio->fmt_name);
953 if (sub = stab_sub(stab)) {
957 Safefree(stab->str_ptr);
958 stab->str_ptr = Null(STBP*);
963 #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
967 #ifdef MICROPORT /* Microport 2.4 hack */
968 ARRAY *stab_array(stab)
971 if (((STBP*)(stab->str_ptr))->stbp_array)
972 return ((STBP*)(stab->str_ptr))->stbp_array;
974 return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
977 HASH *stab_hash(stab)
980 if (((STBP*)(stab->str_ptr))->stbp_hash)
981 return ((STBP*)(stab->str_ptr))->stbp_hash;
983 return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
985 #endif /* Microport 2.4 hack */