projects / unix-history / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
BSD 4_4_Lite2 development
[unix-history] / usr / src / contrib / perl-4.036 / stab.c
CommitLineData
ca2dddd6
C		 1/* $RCSfile: stab.c,v $$Revision: 4.0.1.5 $$Date: 1993/02/05 19:42:47 $
2 *
3 * Copyright (c) 1991, Larry Wall
4 *
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.
7 *
8 * $Log: stab.c,v $
9 * Revision 4.0.1.5 1993/02/05 19:42:47 lwall
10 * patch36: length returned wrong value on certain semi-magical variables
11 *
12 * Revision 4.0.1.4 92/06/08 15:32:19 lwall
13 * patch20: fixed confusion between a *var's real name and its effective name
14 * patch20: the debugger now warns you on lines that can't set a breakpoint
15 * patch20: the debugger made perl forget the last pattern used by //
16 * patch20: paragraph mode now skips extra newlines automatically
17 * patch20: ($<,$>) = ... didn't work on some architectures
18 *
19 * Revision 4.0.1.3 91/11/05 18:35:33 lwall
20 * patch11: length($x) was sometimes wrong for numeric $x
21 * patch11: perl now issues warning if $SIG{'ALARM'} is referenced
22 * patch11: *foo = undef coredumped
23 * patch11: solitary subroutine references no longer trigger typo warnings
24 * patch11: local(*FILEHANDLE) had a memory leak
25 *
26 * Revision 4.0.1.2 91/06/07 11:55:53 lwall
27 * patch4: new copyright notice
28 * patch4: added $^P variable to control calling of perldb routines
29 * patch4: added $^F variable to specify maximum system fd, default 2
30 * patch4: $` was busted inside s///
31 * patch4: default top-of-form format is now FILEHANDLE_TOP
32 * patch4: length($`), length($&), length($') now optimized to avoid string copy
33 * patch4: $^D |= 1024 now does syntax tree dump at run-time
34 *
35 * Revision 4.0.1.1 91/04/12 09:10:24 lwall
36 * patch1: Configure now differentiates getgroups() type from getgid() type
37 * patch1: you may now use "die" and "caller" in a signal handler
38 *
39 * Revision 4.0 91/03/20 01:39:41 lwall
40 * 4.0 baseline.
41 *
42 */
43
44#include "EXTERN.h"
45#include "perl.h"
46
47#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
48#include <signal.h>
49#endif
50
51static char *sig_name[] = {
52 SIG_NAME,0
53};
54
55#ifdef VOIDSIG
56#define handlertype void
57#else
58#define handlertype int
59#endif
60
61static handlertype sighandler();
62
63static int origalen = 0;
64
65STR *
66stab_str(str)
67STR *str;
68{
69 STAB *stab = str->str_u.str_stab;
70 register int paren;
71 register char *s;
72 register int i;
73
74 if (str->str_rare)
75 return stab_val(stab);
76
77 switch (*stab->str_magic->str_ptr) {
78 case '\004': /* ^D */
79#ifdef DEBUGGING
80 str_numset(stab_val(stab),(double)(debug & 32767));
81#endif
82 break;
83 case '\006': /* ^F */
84 str_numset(stab_val(stab),(double)maxsysfd);
85 break;
86 case '\t': /* ^I */
87 if (inplace)
88 str_set(stab_val(stab), inplace);
89 else
90 str_sset(stab_val(stab),&str_undef);
91 break;
92 case '\020': /* ^P */
93 str_numset(stab_val(stab),(double)perldb);
94 break;
95 case '\024': /* ^T */
96 str_numset(stab_val(stab),(double)basetime);
97 break;
98 case '\027': /* ^W */
99 str_numset(stab_val(stab),(double)dowarn);
100 break;
101 case '1': case '2': case '3': case '4':
102 case '5': case '6': case '7': case '8': case '9': case '&':
103 if (curspat) {
104 paren = atoi(stab_ename(stab));
105 getparen:
106 if (curspat->spat_regexp &&
107 paren <= curspat->spat_regexp->nparens &&
108 (s = curspat->spat_regexp->startp[paren]) ) {
109 i = curspat->spat_regexp->endp[paren] - s;
110 if (i >= 0)
111 str_nset(stab_val(stab),s,i);
112 else
113 str_sset(stab_val(stab),&str_undef);
114 }
115 else
116 str_sset(stab_val(stab),&str_undef);
117 }
118 break;
119 case '+':
120 if (curspat) {
121 paren = curspat->spat_regexp->lastparen;
122 goto getparen;
123 }
124 break;
125 case '`':
126 if (curspat) {
127 if (curspat->spat_regexp &&
128 (s = curspat->spat_regexp->subbeg) ) {
129 i = curspat->spat_regexp->startp[0] - s;
130 if (i >= 0)
131 str_nset(stab_val(stab),s,i);
132 else
133 str_nset(stab_val(stab),"",0);
134 }
135 else
136 str_nset(stab_val(stab),"",0);
137 }
138 break;
139 case '\'':
140 if (curspat) {
141 if (curspat->spat_regexp &&
142 (s = curspat->spat_regexp->endp[0]) ) {
143 str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
144 }
145 else
146 str_nset(stab_val(stab),"",0);
147 }
148 break;
149 case '.':
150#ifndef lint
151 if (last_in_stab && stab_io(last_in_stab)) {
152 str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
153 }
154#endif
155 break;
156 case '?':
157 str_numset(stab_val(stab),(double)statusvalue);
158 break;
159 case '^':
160 s = stab_io(curoutstab)->top_name;
161 if (s)
162 str_set(stab_val(stab),s);
163 else {
164 str_set(stab_val(stab),stab_ename(curoutstab));
165 str_cat(stab_val(stab),"_TOP");
166 }
167 break;
168 case '~':
169 s = stab_io(curoutstab)->fmt_name;
170 if (!s)
171 s = stab_ename(curoutstab);
172 str_set(stab_val(stab),s);
173 break;
174#ifndef lint
175 case '=':
176 str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
177 break;
178 case '-':
179 str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
180 break;
181 case '%':
182 str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
183 break;
184#endif
185 case ':':
186 break;
187 case '/':
188 break;
189 case '[':
190 str_numset(stab_val(stab),(double)arybase);
191 break;
192 case '|':
193 if (!stab_io(curoutstab))
194 stab_io(curoutstab) = stio_new();
195 str_numset(stab_val(stab),
196 (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
197 break;
198 case ',':
199 str_nset(stab_val(stab),ofs,ofslen);
200 break;
201 case '\\':
202 str_nset(stab_val(stab),ors,orslen);
203 break;
204 case '#':
205 str_set(stab_val(stab),ofmt);
206 break;
207 case '!':
208 str_numset(stab_val(stab), (double)errno);
209 str_set(stab_val(stab), errno ? strerror(errno) : "");
210 stab_val(stab)->str_nok = 1; /* what a wonderful hack! */
211 break;
212 case '<':
213 str_numset(stab_val(stab),(double)uid);
214 break;
215 case '>':
216 str_numset(stab_val(stab),(double)euid);
217 break;
218 case '(':
219 s = buf;
220 (void)sprintf(s,"%d",(int)gid);
221 goto add_groups;
222 case ')':
223 s = buf;
224 (void)sprintf(s,"%d",(int)egid);
225 add_groups:
226 while (*s) s++;
227#ifdef HAS_GETGROUPS
228#ifndef NGROUPS
229#define NGROUPS 32
230#endif
231 {
232 GROUPSTYPE gary[NGROUPS];
233
234 i = getgroups(NGROUPS,gary);
235 while (--i >= 0) {
236 (void)sprintf(s," %ld", (long)gary[i]);
237 while (*s) s++;
238 }
239 }
240#endif
241 str_set(stab_val(stab),buf);
242 break;
243 case '*':
244 break;
245 case '0':
246 break;
247 default:
248 {
249 struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
250
251 if (uf && uf->uf_val)
252 (*uf->uf_val)(uf->uf_index, stab_val(stab));
253 }
254 break;
255 }
256 return stab_val(stab);
257}
258
259STRLEN
260stab_len(str)
261STR *str;
262{
263 STAB *stab = str->str_u.str_stab;
264 int paren;
265 int i;
266 char *s;
267
268 if (str->str_rare)
269 return str_len(stab_val(stab));
270
271 switch (*stab->str_magic->str_ptr) {
272 case '1': case '2': case '3': case '4':
273 case '5': case '6': case '7': case '8': case '9': case '&':
274 if (curspat) {
275 paren = atoi(stab_ename(stab));
276 getparen:
277 if (curspat->spat_regexp &&
278 paren <= curspat->spat_regexp->nparens &&
279 (s = curspat->spat_regexp->startp[paren]) ) {
280 i = curspat->spat_regexp->endp[paren] - s;
281 if (i >= 0)
282 return i;
283 else
284 return 0;
285 }
286 else
287 return 0;
288 }
289 break;
290 case '+':
291 if (curspat) {
292 paren = curspat->spat_regexp->lastparen;
293 goto getparen;
294 }
295 break;
296 case '`':
297 if (curspat) {
298 if (curspat->spat_regexp &&
299 (s = curspat->spat_regexp->subbeg) ) {
300 i = curspat->spat_regexp->startp[0] - s;
301 if (i >= 0)
302 return i;
303 else
304 return 0;
305 }
306 else
307 return 0;
308 }
309 break;
310 case '\'':
311 if (curspat) {
312 if (curspat->spat_regexp &&
313 (s = curspat->spat_regexp->endp[0]) ) {
314 return (STRLEN) (curspat->spat_regexp->subend - s);
315 }
316 else
317 return 0;
318 }
319 break;
320 case ',':
321 return (STRLEN)ofslen;
322 case '\\':
323 return (STRLEN)orslen;
324 }
325 return str_len(stab_str(str));
326}
327
328void
329stabset(mstr,str)
330register STR *mstr;
331STR *str;
332{
333 STAB *stab;
334 register char *s;
335 int i;
336
337 switch (mstr->str_rare) {
338 case 'E':
339 my_setenv(mstr->str_ptr,str_get(str));
340 /* And you'll never guess what the dog had */
341 /* in its mouth... */
342#ifdef TAINT
343 if (strEQ(mstr->str_ptr,"PATH")) {
344 char *strend = str->str_ptr + str->str_cur;
345
346 s = str->str_ptr;
347 while (s < strend) {
348 s = cpytill(tokenbuf,s,strend,':',&i);
349 s++;
350 if (*tokenbuf != '/'
351 || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
352 str->str_tainted = 2;
353 }
354 }
355#endif
356 break;
357 case 'S':
358 s = str_get(str);
359 i = whichsig(mstr->str_ptr); /* ...no, a brick */
360 if (!i && (dowarn || strEQ(mstr->str_ptr,"ALARM")))
361 warn("No such signal: SIG%s", mstr->str_ptr);
362 if (strEQ(s,"IGNORE"))
363#ifndef lint
364 (void)signal(i,SIG_IGN);
365#else
366 ;
367#endif
368 else if (strEQ(s,"DEFAULT") || !*s)
369 (void)signal(i,SIG_DFL);
370 else {
371 (void)signal(i,sighandler);
372 if (!index(s,'\'')) {
373 sprintf(tokenbuf, "main'%s",s);
374 str_set(str,tokenbuf);
375 }
376 }
377 break;
378#ifdef SOME_DBM
379 case 'D':
380 stab = mstr->str_u.str_stab;
381 hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
382 break;
383#endif
384 case 'L':
385 {
386 CMD *cmd;
387
388 stab = mstr->str_u.str_stab;
389 i = str_true(str);
390 str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE);
391 if (str->str_magic && (cmd = str->str_magic->str_u.str_cmd)) {
392 cmd->c_flags &= ~CF_OPTIMIZE;
393 cmd->c_flags |= i? CFT_D1 : CFT_D0;
394 }
395 else
396 warn("Can't break at that line\n");
397 }
398 break;
399 case '#':
400 stab = mstr->str_u.str_stab;
401 afill(stab_array(stab), (int)str_gnum(str) - arybase);
402 break;
403 case 'X': /* merely a copy of a * string */
404 break;
405 case '*':
406 s = str->str_pok ? str_get(str) : "";
407 if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
408 stab = mstr->str_u.str_stab;
409 if (!*s) {
410 STBP *stbp;
411
412 /*SUPPRESS 701*/
413 (void)savenostab(stab); /* schedule a free of this stab */
414 if (stab->str_len)
415 Safefree(stab->str_ptr);
416 Newz(601,stbp, 1, STBP);
417 stab->str_ptr = stbp;
418 stab->str_len = stab->str_cur = sizeof(STBP);
419 stab->str_pok = 1;
420 strcpy(stab_magic(stab),"StB");
421 stab_val(stab) = Str_new(70,0);
422 stab_line(stab) = curcmd->c_line;
423 stab_estab(stab) = stab;
424 }
425 else {
426 stab = stabent(s,TRUE);
427 if (!stab_xarray(stab))
428 aadd(stab);
429 if (!stab_xhash(stab))
430 hadd(stab);
431 if (!stab_io(stab))
432 stab_io(stab) = stio_new();
433 }
434 str_sset(str, (STR*) stab);
435 }
436 break;
437 case 's': {
438 struct lstring *lstr = (struct lstring*)str;
439 char *tmps;
440
441 mstr->str_rare = 0;
442 str->str_magic = Nullstr;
443 tmps = str_get(str);
444 str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
445 tmps,str->str_cur);
446 }
447 break;
448
449 case 'v':
450 do_vecset(mstr,str);
451 break;
452
453 case 0:
454 /*SUPPRESS 560*/
455 if (!(stab = mstr->str_u.str_stab))
456 break;
457 switch (*stab->str_magic->str_ptr) {
458 case '\004': /* ^D */
459#ifdef DEBUGGING
460 debug = (int)(str_gnum(str)) | 32768;
461 if (debug & 1024)
462 dump_all();
463#endif
464 break;
465 case '\006': /* ^F */
466 maxsysfd = (int)str_gnum(str);
467 break;
468 case '\t': /* ^I */
469 if (inplace)
470 Safefree(inplace);
471 if (str->str_pok || str->str_nok)
472 inplace = savestr(str_get(str));
473 else
474 inplace = Nullch;
475 break;
476 case '\020': /* ^P */
477 i = (int)str_gnum(str);
478 if (i != perldb) {
479 static SPAT *oldlastspat;
480
481 if (perldb)
482 oldlastspat = lastspat;
483 else
484 lastspat = oldlastspat;
485 }
486 perldb = i;
487 break;
488 case '\024': /* ^T */
489 basetime = (time_t)str_gnum(str);
490 break;
491 case '\027': /* ^W */
492 dowarn = (bool)str_gnum(str);
493 break;
494 case '.':
495 if (localizing)
496 savesptr((STR**)&last_in_stab);
497 break;
498 case '^':
499 Safefree(stab_io(curoutstab)->top_name);
500 stab_io(curoutstab)->top_name = s = savestr(str_get(str));
501 stab_io(curoutstab)->top_stab = stabent(s,TRUE);
502 break;
503 case '~':
504 Safefree(stab_io(curoutstab)->fmt_name);
505 stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
506 stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
507 break;
508 case '=':
509 stab_io(curoutstab)->page_len = (long)str_gnum(str);
510 break;
511 case '-':
512 stab_io(curoutstab)->lines_left = (long)str_gnum(str);
513 if (stab_io(curoutstab)->lines_left < 0L)
514 stab_io(curoutstab)->lines_left = 0L;
515 break;
516 case '%':
517 stab_io(curoutstab)->page = (long)str_gnum(str);
518 break;
519 case '|':
520 if (!stab_io(curoutstab))
521 stab_io(curoutstab) = stio_new();
522 stab_io(curoutstab)->flags &= ~IOF_FLUSH;
523 if (str_gnum(str) != 0.0) {
524 stab_io(curoutstab)->flags |= IOF_FLUSH;
525 }
526 break;
527 case '*':
528 i = (int)str_gnum(str);
529 multiline = (i != 0);
530 break;
531 case '/':
532 if (str->str_pok) {
533 rs = str_get(str);
534 rslen = str->str_cur;
535 if (rspara = !rslen) {
536 rs = "\n\n";
537 rslen = 2;
538 }
539 rschar = rs[rslen - 1];
540 }
541 else {
542 rschar = 0777; /* fake a non-existent char */
543 rslen = 1;
544 }
545 break;
546 case '\\':
547 if (ors)
548 Safefree(ors);
549 ors = savestr(str_get(str));
550 orslen = str->str_cur;
551 break;
552 case ',':
553 if (ofs)
554 Safefree(ofs);
555 ofs = savestr(str_get(str));
556 ofslen = str->str_cur;
557 break;
558 case '#':
559 if (ofmt)
560 Safefree(ofmt);
561 ofmt = savestr(str_get(str));
562 break;
563 case '[':
564 arybase = (int)str_gnum(str);
565 break;
566 case '?':
567 statusvalue = U_S(str_gnum(str));
568 break;
569 case '!':
570 errno = (int)str_gnum(str); /* will anyone ever use this? */
571 break;
572 case '<':
573 uid = (int)str_gnum(str);
574 if (delaymagic) {
575 delaymagic |= DM_RUID;
576 break; /* don't do magic till later */
577 }
578#ifdef HAS_SETRUID
579 (void)setruid((UIDTYPE)uid);
580#else
581#ifdef HAS_SETREUID
582 (void)setreuid((UIDTYPE)uid, (UIDTYPE)-1);
583#else
584 if (uid == euid) /* special case $< = $> */
585 (void)setuid(uid);
586 else
587 fatal("setruid() not implemented");
588#endif
589#endif
590 uid = (int)getuid();
591 break;
592 case '>':
593 euid = (int)str_gnum(str);
594 if (delaymagic) {
595 delaymagic |= DM_EUID;
596 break; /* don't do magic till later */
597 }
598#ifdef HAS_SETEUID
599 (void)seteuid((UIDTYPE)euid);
600#else
601#ifdef HAS_SETREUID
602 (void)setreuid((UIDTYPE)-1, (UIDTYPE)euid);
603#else
604 if (euid == uid) /* special case $> = $< */
605 setuid(euid);
606 else
607 fatal("seteuid() not implemented");
608#endif
609#endif
610 euid = (int)geteuid();
611 break;
612 case '(':
613 gid = (int)str_gnum(str);
614 if (delaymagic) {
615 delaymagic |= DM_RGID;
616 break; /* don't do magic till later */
617 }
618#ifdef HAS_SETRGID
619 (void)setrgid((GIDTYPE)gid);
620#else
621#ifdef HAS_SETREGID
622 (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
623#else
624 if (gid == egid) /* special case $( = $) */
625 (void)setgid(gid);
626 else
627 fatal("setrgid() not implemented");
628#endif
629#endif
630 gid = (int)getgid();
631 break;
632 case ')':
633 egid = (int)str_gnum(str);
634 if (delaymagic) {
635 delaymagic |= DM_EGID;
636 break; /* don't do magic till later */
637 }
638#ifdef HAS_SETEGID
639 (void)setegid((GIDTYPE)egid);
640#else
641#ifdef HAS_SETREGID
642 (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
643#else
644 if (egid == gid) /* special case $) = $( */
645 (void)setgid(egid);
646 else
647 fatal("setegid() not implemented");
648#endif
649#endif
650 egid = (int)getegid();
651 break;
652 case ':':
653 chopset = str_get(str);
654 break;
655 case '0':
656 if (!origalen) {
657 s = origargv[0];
658 s += strlen(s);
659 /* See if all the arguments are contiguous in memory */
660 for (i = 1; i < origargc; i++) {
661 if (origargv[i] == s + 1)
662 s += strlen(++s); /* this one is ok too */
663 }
664 if (origenviron[0] == s + 1) { /* can grab env area too? */
665 my_setenv("NoNeSuCh", Nullch);
666 /* force copy of environment */
667 for (i = 0; origenviron[i]; i++)
668 if (origenviron[i] == s + 1)
669 s += strlen(++s);
670 }
671 origalen = s - origargv[0];
672 }
673 s = str_get(str);
674 i = str->str_cur;
675 if (i >= origalen) {
676 i = origalen;
677 str->str_cur = i;
678 str->str_ptr[i] = '\0';
679 Copy(s, origargv[0], i, char);
680 }
681 else {
682 Copy(s, origargv[0], i, char);
683 s = origargv[0]+i;
684 *s++ = '\0';
685 while (++i < origalen)
686 *s++ = ' ';
687 }
688 break;
689 default:
690 {
691 struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
692
693 if (uf && uf->uf_set)
694 (*uf->uf_set)(uf->uf_index, str);
695 }
696 break;
697 }
698 break;
699 }
700}
701
702int
703whichsig(sig)
704char *sig;
705{
706 register char **sigv;
707
708 for (sigv = sig_name+1; *sigv; sigv++)
709 if (strEQ(sig,*sigv))
710 return sigv - sig_name;
711#ifdef SIGCLD
712 if (strEQ(sig,"CHLD"))
713 return SIGCLD;
714#endif
715#ifdef SIGCHLD
716 if (strEQ(sig,"CLD"))
717 return SIGCHLD;
718#endif
719 return 0;
720}
721
722static handlertype
723sighandler(sig)
724int sig;
725{
726 STAB *stab;
727 STR *str;
728 int oldsave = savestack->ary_fill;
729 int oldtmps_base = tmps_base;
730 register CSV *csv;
731 SUBR *sub;
732
733#ifdef OS2 /* or anybody else who requires SIG_ACK */
734 signal(sig, SIG_ACK);
735#endif
736 stab = stabent(
737 str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
738 TRUE)), TRUE);
739 sub = stab_sub(stab);
740 if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
741 if (sig_name[sig][1] == 'H')
742 stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
743 TRUE);
744 else
745 stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
746 TRUE);
747 sub = stab_sub(stab); /* gag */
748 }
749 if (!sub) {
750 if (dowarn)
751 warn("SIG%s handler \"%s\" not defined.\n",
752 sig_name[sig], stab_ename(stab) );
753 return;
754 }
755 /*SUPPRESS 701*/
756 saveaptr(&stack);
757 str = Str_new(15, sizeof(CSV));
758 str->str_state = SS_SCSV;
759 (void)apush(savestack,str);
760 csv = (CSV*)str->str_ptr;
761 csv->sub = sub;
762 csv->stab = stab;
763 csv->curcsv = curcsv;
764 csv->curcmd = curcmd;
765 csv->depth = sub->depth;
766 csv->wantarray = G_SCALAR;
767 csv->hasargs = TRUE;
768 csv->savearray = stab_xarray(defstab);
769 csv->argarray = stab_xarray(defstab) = stack = anew(defstab);
770 stack->ary_flags = 0;
771 curcsv = csv;
772 str = str_mortal(&str_undef);
773 str_set(str,sig_name[sig]);
774 (void)apush(stab_xarray(defstab),str);
775 sub->depth++;
776 if (sub->depth >= 2) { /* save temporaries on recursion? */
777 if (sub->depth == 100 && dowarn)
778 warn("Deep recursion on subroutine \"%s\"",stab_ename(stab));
779 savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
780 }
781
782 tmps_base = tmps_max; /* protect our mortal string */
783 (void)cmd_exec(sub->cmd,G_SCALAR,0); /* so do it already */
784 tmps_base = oldtmps_base;
785
786 restorelist(oldsave); /* put everything back */
787}
788
789STAB *
790aadd(stab)
791register STAB *stab;
792{
793 if (!stab_xarray(stab))
794 stab_xarray(stab) = anew(stab);
795 return stab;
796}
797
798STAB *
799hadd(stab)
800register STAB *stab;
801{
802 if (!stab_xhash(stab))
803 stab_xhash(stab) = hnew(COEFFSIZE);
804 return stab;
805}
806
807STAB *
808fstab(name)
809char *name;
810{
811 char tmpbuf[1200];
812 STAB *stab;
813
814 sprintf(tmpbuf,"'_<%s", name);
815 stab = stabent(tmpbuf, TRUE);
816 str_set(stab_val(stab), name);
817 if (perldb)
818 (void)hadd(aadd(stab));
819 return stab;
820}
821
822STAB *
823stabent(name,add)
824register char *name;
825int add;
826{
827 register STAB *stab;
828 register STBP *stbp;
829 int len;
830 register char *namend;
831 HASH *stash;
832 char *sawquote = Nullch;
833 char *prevquote = Nullch;
834 bool global = FALSE;
835
836 if (isUPPER(*name)) {
837 if (*name > 'I') {
838 if (*name == 'S' && (
839 strEQ(name, "SIG") ||
840 strEQ(name, "STDIN") ||
841 strEQ(name, "STDOUT") ||
842 strEQ(name, "STDERR") ))
843 global = TRUE;
844 }
845 else if (*name > 'E') {
846 if (*name == 'I' && strEQ(name, "INC"))
847 global = TRUE;
848 }
849 else if (*name > 'A') {
850 if (*name == 'E' && strEQ(name, "ENV"))
851 global = TRUE;
852 }
853 else if (*name == 'A' && (
854 strEQ(name, "ARGV") ||
855 strEQ(name, "ARGVOUT") ))
856 global = TRUE;
857 }
858 for (namend = name; *namend; namend++) {
859 if (*namend == '\'' && namend[1])
860 prevquote = sawquote, sawquote = namend;
861 }
862 if (sawquote == name && name[1]) {
863 stash = defstash;
864 sawquote = Nullch;
865 name++;
866 }
867 else if (!isALPHA(*name) || global)
868 stash = defstash;
869 else if ((CMD*)curcmd == &compiling)
870 stash = curstash;
871 else
872 stash = curcmd->c_stash;
873 if (sawquote) {
874 char tmpbuf[256];
875 char *s, *d;
876
877 *sawquote = '\0';
878 /*SUPPRESS 560*/
879 if (s = prevquote) {
880 strncpy(tmpbuf,name,s-name+1);
881 d = tmpbuf+(s-name+1);
882 *d++ = '_';
883 strcpy(d,s+1);
884 }
885 else {
886 *tmpbuf = '_';
887 strcpy(tmpbuf+1,name);
888 }
889 stab = stabent(tmpbuf,TRUE);
890 if (!(stash = stab_xhash(stab)))
891 stash = stab_xhash(stab) = hnew(0);
892 if (!stash->tbl_name)
893 stash->tbl_name = savestr(name);
894 name = sawquote+1;
895 *sawquote = '\'';
896 }
897 len = namend - name;
898 stab = (STAB*)hfetch(stash,name,len,add);
899 if (stab == (STAB*)&str_undef)
900 return Nullstab;
901 if (stab->str_pok) {
902 stab->str_pok |= SP_MULTI;
903 return stab;
904 }
905 else {
906 if (stab->str_len)
907 Safefree(stab->str_ptr);
908 Newz(602,stbp, 1, STBP);
909 stab->str_ptr = stbp;
910 stab->str_len = stab->str_cur = sizeof(STBP);
911 stab->str_pok = 1;
912 strcpy(stab_magic(stab),"StB");
913 stab_val(stab) = Str_new(72,0);
914 stab_line(stab) = curcmd->c_line;
915 stab_estab(stab) = stab;
916 str_magic((STR*)stab, stab, '*', name, len);
917 stab_stash(stab) = stash;
918 if (isDIGIT(*name) && *name != '0') {
919 stab_flags(stab) = SF_VMAGIC;
920 str_magic(stab_val(stab), stab, 0, Nullch, 0);
921 }
922 if (add & 2)
923 stab->str_pok |= SP_MULTI;
924 return stab;
925 }
926}
927
928void
929stab_fullname(str,stab)
930STR *str;
931STAB *stab;
932{
933 HASH *tb = stab_stash(stab);
934
935 if (!tb)
936 return;
937 str_set(str,tb->tbl_name);
938 str_ncat(str,"'", 1);
939 str_scat(str,stab->str_magic);
940}
941
942void
943stab_efullname(str,stab)
944STR *str;
945STAB *stab;
946{
947 HASH *tb = stab_estash(stab);
948
949 if (!tb)
950 return;
951 str_set(str,tb->tbl_name);
952 str_ncat(str,"'", 1);
953 str_scat(str,stab_estab(stab)->str_magic);
954}
955
956STIO *
957stio_new()
958{
959 STIO *stio;
960
961 Newz(603,stio,1,STIO);
962 stio->page_len = 60;
963 return stio;
964}
965
966void
967stab_check(min,max)
968int min;
969register int max;
970{
971 register HENT *entry;
972 register int i;
973 register STAB *stab;
974
975 for (i = min; i <= max; i++) {
976 for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
977 stab = (STAB*)entry->hent_val;
978 if (stab->str_pok & SP_MULTI)
979 continue;
980 curcmd->c_line = stab_line(stab);
981 warn("Possible typo: \"%s\"", stab_name(stab));
982 }
983 }
984}
985
986static int gensym = 0;
987
988STAB *
989genstab()
990{
991 (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
992 return stabent(tokenbuf,TRUE);
993}
994
995/* hopefully this is only called on local symbol table entries */
996
997void
998stab_clear(stab)
999register STAB *stab;
1000{
1001 STIO *stio;
1002 SUBR *sub;
1003
1004 if (!stab || !stab->str_ptr)
1005 return;
1006 afree(stab_xarray(stab));
1007 stab_xarray(stab) = Null(ARRAY*);
1008 (void)hfree(stab_xhash(stab), FALSE);
1009 stab_xhash(stab) = Null(HASH*);
1010 str_free(stab_val(stab));
1011 stab_val(stab) = Nullstr;
1012 /*SUPPRESS 560*/
1013 if (stio = stab_io(stab)) {
1014 do_close(stab,FALSE);
1015 Safefree(stio->top_name);
1016 Safefree(stio->fmt_name);
1017 Safefree(stio);
1018 }
1019 /*SUPPRESS 560*/
1020 if (sub = stab_sub(stab)) {
1021 afree(sub->tosave);
1022 cmd_free(sub->cmd);
1023 }
1024 Safefree(stab->str_ptr);
1025 stab->str_ptr = Null(STBP*);
1026 stab->str_len = 0;
1027 stab->str_cur = 0;
1028}
1029
1030#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
1031#define MICROPORT
1032#endif
1033
1034#ifdef MICROPORT /* Microport 2.4 hack */
1035ARRAY *stab_array(stab)
1036register STAB *stab;
1037{
1038 if (((STBP*)(stab->str_ptr))->stbp_array)
1039 return ((STBP*)(stab->str_ptr))->stbp_array;
1040 else
1041 return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
1042}
1043
1044HASH *stab_hash(stab)
1045register STAB *stab;
1046{
1047 if (((STBP*)(stab->str_ptr))->stbp_hash)
1048 return ((STBP*)(stab->str_ptr))->stbp_hash;
1049 else
1050 return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
1051}
1052#endif /* Microport 2.4 hack */
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.