1 /* $Header: stab.c,v 3.0.1.7 90/08/09 05:17:48 lwall Locked $
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 3.0.1.7 90/08/09 05:17:48 lwall
10 * patch19: fixed double include of <signal.h>
11 * patch19: $' broke on embedded nulls
12 * patch19: $< and $> better supported on machines without setreuid
13 * patch19: Added support for linked-in C subroutines
14 * patch19: %ENV wasn't forced to be global like it should
15 * patch19: $| didn't work before the filehandle was opened
16 * patch19: $! now returns "" in string context if errno == 0
18 * Revision 3.0.1.6 90/03/27 16:22:11 lwall
19 * patch16: support for machines that can't cast negative floats to unsigned ints
21 * Revision 3.0.1.5 90/03/12 17:00:11 lwall
22 * patch13: undef $/ didn't work as advertised
24 * Revision 3.0.1.4 90/02/28 18:19:14 lwall
25 * patch9: $0 is now always the command name
26 * patch9: you may now undef $/ to have no input record separator
27 * patch9: local($.) didn't work
28 * patch9: sometimes perl thought ordinary data was a symbol table entry
29 * patch9: stab_array() and stab_hash() weren't defined on MICROPORT
31 * Revision 3.0.1.3 89/12/21 20:18:40 lwall
32 * patch7: ANSI strerror() is now supported
33 * patch7: errno may now be a macro with an lvalue
34 * patch7: in stab.c, sighandler() may now return either void or int
36 * Revision 3.0.1.2 89/11/17 15:35:37 lwall
37 * patch5: sighandler() needed to be static
39 * Revision 3.0.1.1 89/11/11 04:55:07 lwall
40 * patch2: sys_errlist[sys_nerr] is illegal
42 * Revision 3.0 89/10/18 15:23:23 lwall
54 static char *sig_name[] = {
59 #define handlertype void
61 #define handlertype int
68 STAB *stab = str->str_u.str_stab;
74 return stab_val(stab);
76 switch (*stab->str_magic->str_ptr) {
77 case '1': case '2': case '3': case '4':
78 case '5': case '6': case '7': case '8': case '9': case '&':
80 paren = atoi(stab_name(stab));
82 if (curspat->spat_regexp &&
83 paren <= curspat->spat_regexp->nparens &&
84 (s = curspat->spat_regexp->startp[paren]) ) {
85 i = curspat->spat_regexp->endp[paren] - s;
87 str_nset(stab_val(stab),s,i);
89 str_sset(stab_val(stab),&str_undef);
92 str_sset(stab_val(stab),&str_undef);
97 paren = curspat->spat_regexp->lastparen;
103 if (curspat->spat_regexp &&
104 (s = curspat->spat_regexp->subbase) ) {
105 i = curspat->spat_regexp->startp[0] - s;
107 str_nset(stab_val(stab),s,i);
109 str_nset(stab_val(stab),"",0);
112 str_nset(stab_val(stab),"",0);
117 if (curspat->spat_regexp &&
118 (s = curspat->spat_regexp->endp[0]) ) {
119 str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
122 str_nset(stab_val(stab),"",0);
128 str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
133 str_numset(stab_val(stab),(double)statusvalue);
136 s = stab_io(curoutstab)->top_name;
137 str_set(stab_val(stab),s);
140 s = stab_io(curoutstab)->fmt_name;
141 str_set(stab_val(stab),s);
145 str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
148 str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
151 str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
155 if (record_separator != 12345) {
156 *tokenbuf = record_separator;
158 str_nset(stab_val(stab),tokenbuf,rslen);
162 str_numset(stab_val(stab),(double)arybase);
165 if (!stab_io(curoutstab))
166 stab_io(curoutstab) = stio_new();
167 str_numset(stab_val(stab),
168 (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
171 str_nset(stab_val(stab),ofs,ofslen);
174 str_nset(stab_val(stab),ors,orslen);
177 str_set(stab_val(stab),ofmt);
180 str_numset(stab_val(stab), (double)errno);
181 str_set(stab_val(stab), errno ? strerror(errno) : "");
182 stab_val(stab)->str_nok = 1; /* what a wonderful hack! */
185 str_numset(stab_val(stab),(double)uid);
188 str_numset(stab_val(stab),(double)euid);
192 (void)sprintf(s,"%d",(int)gid);
196 (void)sprintf(s,"%d",(int)egid);
204 GIDTYPE gary[NGROUPS];
206 i = getgroups(NGROUPS,gary);
208 (void)sprintf(s," %ld", (long)gary[i]);
213 str_set(stab_val(stab),buf);
217 struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
219 if (uf && uf->uf_val)
220 uf->uf_val(uf->uf_index, stab_val(stab));
224 return stab_val(stab);
231 STAB *stab = mstr->str_u.str_stab;
234 static handlertype sighandler();
236 switch (mstr->str_rare) {
238 setenv(mstr->str_ptr,str_get(str));
239 /* And you'll never guess what the dog had */
240 break; /* in its mouth... */
243 i = whichsig(mstr->str_ptr); /* ...no, a brick */
244 if (strEQ(s,"IGNORE"))
246 (void)signal(i,SIG_IGN);
250 else if (strEQ(s,"DEFAULT") || !*s)
251 (void)signal(i,SIG_DFL);
253 (void)signal(i,sighandler);
257 hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
261 afill(stab_array(stab), (int)str_gnum(str) - arybase);
263 case 'X': /* merely a copy of a * string */
267 if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
271 (void)savenostab(stab); /* schedule a free of this stab */
273 Safefree(stab->str_ptr);
274 Newz(601,stbp, 1, STBP);
275 stab->str_ptr = stbp;
276 stab->str_len = stab->str_cur = sizeof(STBP);
278 strcpy(stab_magic(stab),"StB");
279 stab_val(stab) = Str_new(70,0);
280 stab_line(stab) = curcmd->c_line;
283 stab = stabent(s,TRUE);
284 if (!stab_xarray(stab))
286 if (!stab_xhash(stab))
289 stab_io(stab) = stio_new();
295 struct lstring *lstr = (struct lstring*)str;
298 str->str_magic = Nullstr;
299 str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
300 str->str_ptr,str->str_cur);
309 switch (*stab->str_magic->str_ptr) {
312 savesptr((STR**)&last_in_stab);
315 Safefree(stab_io(curoutstab)->top_name);
316 stab_io(curoutstab)->top_name = s = savestr(str_get(str));
317 stab_io(curoutstab)->top_stab = stabent(s,TRUE);
320 Safefree(stab_io(curoutstab)->fmt_name);
321 stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
322 stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
325 stab_io(curoutstab)->page_len = (long)str_gnum(str);
328 stab_io(curoutstab)->lines_left = (long)str_gnum(str);
329 if (stab_io(curoutstab)->lines_left < 0L)
330 stab_io(curoutstab)->lines_left = 0L;
333 stab_io(curoutstab)->page = (long)str_gnum(str);
336 if (!stab_io(curoutstab))
337 stab_io(curoutstab) = stio_new();
338 stab_io(curoutstab)->flags &= ~IOF_FLUSH;
339 if (str_gnum(str) != 0.0) {
340 stab_io(curoutstab)->flags |= IOF_FLUSH;
344 i = (int)str_gnum(str);
345 multiline = (i != 0);
349 record_separator = *str_get(str);
350 rslen = str->str_cur;
353 record_separator = 12345; /* fake a non-existent char */
360 ors = savestr(str_get(str));
361 orslen = str->str_cur;
366 ofs = savestr(str_get(str));
367 ofslen = str->str_cur;
372 ofmt = savestr(str_get(str));
375 arybase = (int)str_gnum(str);
378 statusvalue = U_S(str_gnum(str));
381 errno = (int)str_gnum(str); /* will anyone ever use this? */
384 uid = (int)str_gnum(str);
387 delaymagic |= DM_REUID;
388 break; /* don't do magic till later */
390 #endif /* SETREUID */
392 if (setruid((UIDTYPE)uid) < 0)
396 if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
399 if (uid == euid) /* special case $< = $> */
402 fatal("setruid() not implemented");
407 euid = (int)str_gnum(str);
410 delaymagic |= DM_REUID;
411 break; /* don't do magic till later */
413 #endif /* SETREUID */
415 if (seteuid((UIDTYPE)euid) < 0)
416 euid = (int)geteuid();
419 if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
420 euid = (int)geteuid();
422 if (euid == uid) /* special case $> = $< */
425 fatal("seteuid() not implemented");
430 gid = (int)str_gnum(str);
433 delaymagic |= DM_REGID;
434 break; /* don't do magic till later */
436 #endif /* SETREGID */
438 (void)setrgid((GIDTYPE)gid);
441 (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
443 fatal("setrgid() not implemented");
448 egid = (int)str_gnum(str);
451 delaymagic |= DM_REGID;
452 break; /* don't do magic till later */
454 #endif /* SETREGID */
456 (void)setegid((GIDTYPE)egid);
459 (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
461 fatal("setegid() not implemented");
466 chopset = str_get(str);
470 struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
472 if (uf && uf->uf_set)
473 uf->uf_set(uf->uf_index, str);
484 register char **sigv;
486 for (sigv = sig_name+1; *sigv; sigv++)
487 if (strEQ(sig,*sigv))
488 return sigv - sig_name;
490 if (strEQ(sig,"CHLD"))
494 if (strEQ(sig,"CLD"))
507 char *oldfile = filename;
508 int oldsave = savestack->ary_fill;
509 ARRAY *oldstack = stack;
512 #ifdef OS2 /* or anybody else who requires SIG_ACK */
513 signal(sig, SIG_ACK);
516 str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
518 sub = stab_sub(stab);
519 if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
520 if (sig_name[sig][1] == 'H')
521 stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
524 stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
526 sub = stab_sub(stab); /* gag */
530 warn("SIG%s handler \"%s\" not defined.\n",
531 sig_name[sig], stab_name(stab) );
534 savearray = stab_xarray(defstab);
535 stab_xarray(defstab) = stack = anew(defstab);
536 stack->ary_flags = 0;
538 str_set(str,sig_name[sig]);
539 (void)apush(stab_xarray(defstab),str);
541 if (sub->depth >= 2) { /* save temporaries on recursion? */
542 if (sub->depth == 100 && dowarn)
543 warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
544 savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
546 filename = sub->filename;
548 (void)cmd_exec(sub->cmd,G_SCALAR,1); /* so do it already */
550 sub->depth--; /* assuming no longjumps out of here */
551 str_free(stack->ary_array[0]); /* free the one real string */
552 afree(stab_xarray(defstab)); /* put back old $_[] */
553 stab_xarray(defstab) = savearray;
556 if (savestack->ary_fill > oldsave)
557 restorelist(oldsave);
564 if (!stab_xarray(stab))
565 stab_xarray(stab) = anew(stab);
573 if (!stab_xhash(stab))
574 stab_xhash(stab) = hnew(COEFFSIZE);
586 register char *namend;
588 char *sawquote = Nullch;
589 char *prevquote = Nullch;
592 if (isascii(*name) && isupper(*name)) {
594 if (*name == 'S' && (
595 strEQ(name, "SIG") ||
596 strEQ(name, "STDIN") ||
597 strEQ(name, "STDOUT") ||
598 strEQ(name, "STDERR") ))
601 else if (*name > 'E') {
602 if (*name == 'I' && strEQ(name, "INC"))
605 else if (*name > 'A') {
606 if (*name == 'E' && strEQ(name, "ENV"))
609 else if (*name == 'A' && (
610 strEQ(name, "ARGV") ||
611 strEQ(name, "ARGVOUT") ))
614 for (namend = name; *namend; namend++) {
615 if (*namend == '\'' && namend[1])
616 prevquote = sawquote, sawquote = namend;
618 if (sawquote == name && name[1]) {
623 else if (!isalpha(*name) || global)
633 strncpy(tmpbuf,name,s-name+1);
634 d = tmpbuf+(s-name+1);
640 strcpy(tmpbuf+1,name);
642 stab = stabent(tmpbuf,TRUE);
643 if (!(stash = stab_xhash(stab)))
644 stash = stab_xhash(stab) = hnew(0);
649 stab = (STAB*)hfetch(stash,name,len,add);
653 stab->str_pok |= SP_MULTI;
658 Safefree(stab->str_ptr);
659 Newz(602,stbp, 1, STBP);
660 stab->str_ptr = stbp;
661 stab->str_len = stab->str_cur = sizeof(STBP);
663 strcpy(stab_magic(stab),"StB");
664 stab_val(stab) = Str_new(72,0);
665 stab_line(stab) = curcmd->c_line;
666 str_magic(stab,stab,'*',name,len);
676 Newz(603,stio,1,STIO);
685 register HENT *entry;
689 for (i = min; i <= max; i++) {
690 for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
691 stab = (STAB*)entry->hent_val;
692 if (stab->str_pok & SP_MULTI)
694 curcmd->c_line = stab_line(stab);
695 warn("Possible typo: \"%s\"", stab_name(stab));
700 static int gensym = 0;
705 (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
706 return stabent(tokenbuf,TRUE);
709 /* hopefully this is only called on local symbol table entries */
718 afree(stab_xarray(stab));
719 (void)hfree(stab_xhash(stab));
720 str_free(stab_val(stab));
721 if (stio = stab_io(stab)) {
722 do_close(stab,FALSE);
723 Safefree(stio->top_name);
724 Safefree(stio->fmt_name);
726 if (sub = stab_sub(stab)) {
730 Safefree(stab->str_ptr);
731 stab->str_ptr = Null(STBP*);
736 #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
740 #ifdef MICROPORT /* Microport 2.4 hack */
741 ARRAY *stab_array(stab)
744 if (((STBP*)(stab->str_ptr))->stbp_array)
745 return ((STBP*)(stab->str_ptr))->stbp_array;
747 return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
750 HASH *stab_hash(stab)
753 if (((STBP*)(stab->str_ptr))->stbp_hash)
754 return ((STBP*)(stab->str_ptr))->stbp_hash;
756 return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
758 #endif /* Microport 2.4 hack */