1 /* $Header: stab.c,v 3.0 89/10/18 15:23:23 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 89/10/18 15:23:23 lwall
19 /* This oughta be generated by Configure. */
21 static char *sig_name[] = {
27 extern char *sys_errlist[];
33 STAB *stab = str->str_u.str_stab;
39 return stab_val(stab);
41 switch (*stab->str_magic->str_ptr) {
42 case '0': case '1': case '2': case '3': case '4':
43 case '5': case '6': case '7': case '8': case '9': case '&':
45 paren = atoi(stab_name(stab));
47 if (curspat->spat_regexp &&
48 paren <= curspat->spat_regexp->nparens &&
49 (s = curspat->spat_regexp->startp[paren]) ) {
50 i = curspat->spat_regexp->endp[paren] - s;
52 str_nset(stab_val(stab),s,i);
54 str_sset(stab_val(stab),&str_undef);
57 str_sset(stab_val(stab),&str_undef);
62 paren = curspat->spat_regexp->lastparen;
68 if (curspat->spat_regexp &&
69 (s = curspat->spat_regexp->subbase) ) {
70 i = curspat->spat_regexp->startp[0] - s;
72 str_nset(stab_val(stab),s,i);
74 str_nset(stab_val(stab),"",0);
77 str_nset(stab_val(stab),"",0);
82 if (curspat->spat_regexp &&
83 (s = curspat->spat_regexp->endp[0]) ) {
84 str_set(stab_val(stab),s);
87 str_nset(stab_val(stab),"",0);
93 str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
98 str_numset(stab_val(stab),(double)statusvalue);
101 s = stab_io(curoutstab)->top_name;
102 str_set(stab_val(stab),s);
105 s = stab_io(curoutstab)->fmt_name;
106 str_set(stab_val(stab),s);
110 str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
113 str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
116 str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
120 *tokenbuf = record_separator;
122 str_nset(stab_val(stab),tokenbuf,rslen);
125 str_numset(stab_val(stab),(double)arybase);
128 str_numset(stab_val(stab),
129 (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
132 str_nset(stab_val(stab),ofs,ofslen);
135 str_nset(stab_val(stab),ors,orslen);
138 str_set(stab_val(stab),ofmt);
141 str_numset(stab_val(stab), (double)errno);
142 str_set(stab_val(stab),
143 errno < 0 || errno > sys_nerr ? "(unknown)" : sys_errlist[errno]);
144 stab_val(stab)->str_nok = 1; /* what a wonderful hack! */
147 str_numset(stab_val(stab),(double)uid);
150 str_numset(stab_val(stab),(double)euid);
154 (void)sprintf(s,"%d",(int)gid);
158 (void)sprintf(s,"%d",(int)egid);
166 GIDTYPE gary[NGROUPS];
168 i = getgroups(NGROUPS,gary);
170 (void)sprintf(s," %ld", (long)gary[i]);
175 str_set(stab_val(stab),buf);
178 return stab_val(stab);
185 STAB *stab = mstr->str_u.str_stab;
190 switch (mstr->str_rare) {
192 setenv(mstr->str_ptr,str_get(str));
193 /* And you'll never guess what the dog had */
194 break; /* in its mouth... */
197 i = whichsig(mstr->str_ptr); /* ...no, a brick */
198 if (strEQ(s,"IGNORE"))
200 (void)signal(i,SIG_IGN);
204 else if (strEQ(s,"DEFAULT") || !*s)
205 (void)signal(i,SIG_DFL);
207 (void)signal(i,sighandler);
211 hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
215 afill(stab_array(stab), (int)str_gnum(str) - arybase);
217 case 'X': /* merely a copy of a * string */
221 if (strnNE(s,"Stab",4) || str->str_cur != sizeof(STBP)) {
225 (void)savenostab(stab); /* schedule a free of this stab */
227 Safefree(stab->str_ptr);
228 Newz(601,stbp, 1, STBP);
229 stab->str_ptr = stbp;
230 stab->str_len = stab->str_cur = sizeof(STBP);
232 strncpy(stab_magic(stab),"Stab",4);
233 stab_val(stab) = Str_new(70,0);
234 stab_line(stab) = line;
237 stab = stabent(s,TRUE);
242 struct lstring *lstr = (struct lstring*)str;
245 str->str_magic = Nullstr;
246 str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
247 str->str_ptr,str->str_cur);
256 switch (*stab->str_magic->str_ptr) {
258 Safefree(stab_io(curoutstab)->top_name);
259 stab_io(curoutstab)->top_name = s = savestr(str_get(str));
260 stab_io(curoutstab)->top_stab = stabent(s,TRUE);
263 Safefree(stab_io(curoutstab)->fmt_name);
264 stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
265 stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
268 stab_io(curoutstab)->page_len = (long)str_gnum(str);
271 stab_io(curoutstab)->lines_left = (long)str_gnum(str);
272 if (stab_io(curoutstab)->lines_left < 0L)
273 stab_io(curoutstab)->lines_left = 0L;
276 stab_io(curoutstab)->page = (long)str_gnum(str);
279 stab_io(curoutstab)->flags &= ~IOF_FLUSH;
280 if (str_gnum(str) != 0.0) {
281 stab_io(curoutstab)->flags |= IOF_FLUSH;
285 i = (int)str_gnum(str);
286 multiline = (i != 0);
289 record_separator = *str_get(str);
290 rslen = str->str_cur;
295 ors = savestr(str_get(str));
296 orslen = str->str_cur;
301 ofs = savestr(str_get(str));
302 ofslen = str->str_cur;
307 ofmt = savestr(str_get(str));
310 arybase = (int)str_gnum(str);
313 statusvalue = (unsigned short)str_gnum(str);
316 errno = (int)str_gnum(str); /* will anyone ever use this? */
319 uid = (int)str_gnum(str);
322 delaymagic |= DM_REUID;
323 break; /* don't do magic till later */
325 #endif /* SETREUID */
327 if (setruid((UIDTYPE)uid) < 0)
331 if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
334 fatal("setruid() not implemented");
339 euid = (int)str_gnum(str);
342 delaymagic |= DM_REUID;
343 break; /* don't do magic till later */
345 #endif /* SETREUID */
347 if (seteuid((UIDTYPE)euid) < 0)
348 euid = (int)geteuid();
351 if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
352 euid = (int)geteuid();
354 fatal("seteuid() not implemented");
359 gid = (int)str_gnum(str);
362 delaymagic |= DM_REGID;
363 break; /* don't do magic till later */
365 #endif /* SETREGID */
367 (void)setrgid((GIDTYPE)gid);
370 (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
372 fatal("setrgid() not implemented");
377 egid = (int)str_gnum(str);
380 delaymagic |= DM_REGID;
381 break; /* don't do magic till later */
383 #endif /* SETREGID */
385 (void)setegid((GIDTYPE)egid);
388 (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
390 fatal("setegid() not implemented");
395 chopset = str_get(str);
405 register char **sigv;
407 for (sigv = sig_name+1; *sigv; sigv++)
408 if (strEQ(sig,*sigv))
409 return sigv - sig_name;
411 if (strEQ(sig,"CHLD"))
415 if (strEQ(sig,"CLD"))
427 char *oldfile = filename;
428 int oldsave = savestack->ary_fill;
429 ARRAY *oldstack = stack;
433 str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
435 sub = stab_sub(stab);
436 if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
437 if (sig_name[sig][1] == 'H')
438 stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
441 stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
443 sub = stab_sub(stab); /* gag */
447 warn("SIG%s handler \"%s\" not defined.\n",
448 sig_name[sig], stab_name(stab) );
451 savearray = stab_xarray(defstab);
452 stab_xarray(defstab) = stack = anew(defstab);
453 stack->ary_flags = 0;
455 str_set(str,sig_name[sig]);
456 (void)apush(stab_xarray(defstab),str);
458 if (sub->depth >= 2) { /* save temporaries on recursion? */
459 if (sub->depth == 100 && dowarn)
460 warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
461 savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
463 filename = sub->filename;
465 (void)cmd_exec(sub->cmd,G_SCALAR,1); /* so do it already */
467 sub->depth--; /* assuming no longjumps out of here */
468 str_free(stack->ary_array[0]); /* free the one real string */
469 afree(stab_xarray(defstab)); /* put back old $_[] */
470 stab_xarray(defstab) = savearray;
473 if (savestack->ary_fill > oldsave)
474 restorelist(oldsave);
481 if (!stab_xarray(stab))
482 stab_xarray(stab) = anew(stab);
490 if (!stab_xhash(stab))
491 stab_xhash(stab) = hnew(COEFFSIZE);
503 register char *namend;
505 char *sawquote = Nullch;
506 char *prevquote = Nullch;
509 if (isascii(*name) && isupper(*name)) {
511 if (*name == 'S' && (
512 strEQ(name, "SIG") ||
513 strEQ(name, "STDIN") ||
514 strEQ(name, "STDOUT") ||
515 strEQ(name, "STDERR") ))
518 else if (*name > 'E') {
519 if (*name == 'I' && strEQ(name, "INC"))
522 else if (*name >= 'A') {
523 if (*name == 'E' && strEQ(name, "ENV"))
526 else if (*name == 'A' && (
527 strEQ(name, "ARGV") ||
528 strEQ(name, "ARGVOUT") ))
531 for (namend = name; *namend; namend++) {
532 if (*namend == '\'' && namend[1])
533 prevquote = sawquote, sawquote = namend;
535 if (sawquote == name && name[1]) {
540 else if (!isalpha(*name) || global)
550 strncpy(tmpbuf,name,s-name+1);
551 d = tmpbuf+(s-name+1);
557 strcpy(tmpbuf+1,name);
559 stab = stabent(tmpbuf,TRUE);
560 if (!(stash = stab_xhash(stab)))
561 stash = stab_xhash(stab) = hnew(0);
566 stab = (STAB*)hfetch(stash,name,len,add);
570 stab->str_pok |= SP_MULTI;
575 Safefree(stab->str_ptr);
576 Newz(602,stbp, 1, STBP);
577 stab->str_ptr = stbp;
578 stab->str_len = stab->str_cur = sizeof(STBP);
580 strncpy(stab_magic(stab),"Stab",4);
581 stab_val(stab) = Str_new(72,0);
582 stab_line(stab) = line;
583 str_magic(stab,stab,'*',name,len);
593 Newz(603,stio,1,STIO);
602 register HENT *entry;
606 for (i = min; i <= max; i++) {
607 for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
608 stab = (STAB*)entry->hent_val;
609 if (stab->str_pok & SP_MULTI)
611 line = stab_line(stab);
612 warn("Possible typo: \"%s\"", stab_name(stab));
617 static int gensym = 0;
622 (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
623 return stabent(tokenbuf,TRUE);
626 /* hopefully this is only called on local symbol table entries */
635 afree(stab_xarray(stab));
636 (void)hfree(stab_xhash(stab));
637 str_free(stab_val(stab));
638 if (stio = stab_io(stab)) {
639 do_close(stab,FALSE);
640 Safefree(stio->top_name);
641 Safefree(stio->fmt_name);
643 if (sub = stab_sub(stab)) {
647 Safefree(stab->str_ptr);
648 stab->str_ptr = Null(STBP*);