projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
perl 3.0 patch #37 (combined patch)
[p5sagit/p5-mst-13.2.git] / stab.c
CommitLineData
0a12ae7d 1/* $Header: stab.c,v 3.0.1.9 90/10/16 10:32:05 lwall Locked $
a687059c 2 *
3 * Copyright (c) 1989, Larry Wall
4 *
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.
8d063cd8 7 *
8 * $Log: stab.c,v $
0a12ae7d 9 * Revision 3.0.1.9 90/10/16 10:32:05 lwall
10 * patch29: added -M, -A and -C
11 * patch29: taintperl now checks for world writable PATH components
12 * patch29: *foo now prints as *package'foo
13 * patch29: scripts now run at almost full speed under the debugger
14 * patch29: package behavior is now more consistent
15 *
6eb13c3b 16 * Revision 3.0.1.8 90/08/13 22:30:17 lwall
17 * patch28: the NSIG hack didn't work right on Xenix
18 *
00bf170e 19 * Revision 3.0.1.7 90/08/09 05:17:48 lwall
20 * patch19: fixed double include of <signal.h>
21 * patch19: $' broke on embedded nulls
22 * patch19: $< and $> better supported on machines without setreuid
23 * patch19: Added support for linked-in C subroutines
24 * patch19: %ENV wasn't forced to be global like it should
25 * patch19: $| didn't work before the filehandle was opened
26 * patch19: $! now returns "" in string context if errno == 0
27 *
0f85fab0 28 * Revision 3.0.1.6 90/03/27 16:22:11 lwall
29 * patch16: support for machines that can't cast negative floats to unsigned ints
30 *
79a0689e 31 * Revision 3.0.1.5 90/03/12 17:00:11 lwall
32 * patch13: undef $/ didn't work as advertised
33 *
9f68db38 34 * Revision 3.0.1.4 90/02/28 18:19:14 lwall
35 * patch9: $0 is now always the command name
36 * patch9: you may now undef $/ to have no input record separator
37 * patch9: local($.) didn't work
38 * patch9: sometimes perl thought ordinary data was a symbol table entry
39 * patch9: stab_array() and stab_hash() weren't defined on MICROPORT
40 *
663a0e37 41 * Revision 3.0.1.3 89/12/21 20:18:40 lwall
42 * patch7: ANSI strerror() is now supported
43 * patch7: errno may now be a macro with an lvalue
44 * patch7: in stab.c, sighandler() may now return either void or int
45 *
ffed7fef 46 * Revision 3.0.1.2 89/11/17 15:35:37 lwall
47 * patch5: sighandler() needed to be static
48 *
ae986130 49 * Revision 3.0.1.1 89/11/11 04:55:07 lwall
50 * patch2: sys_errlist[sys_nerr] is illegal
51 *
a687059c 52 * Revision 3.0 89/10/18 15:23:23 lwall
53 * 3.0 baseline
8d063cd8 54 *
55 */
56
8d063cd8 57#include "EXTERN.h"
8d063cd8 58#include "perl.h"
59
6eb13c3b 60#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
378cc40b 61#include <signal.h>
00bf170e 62#endif
378cc40b 63
8d063cd8 64static char *sig_name[] = {
a687059c 65 SIG_NAME,0
66};
8d063cd8 67
663a0e37 68#ifdef VOIDSIG
69#define handlertype void
70#else
71#define handlertype int
72#endif
2e1b3b7e 73
8d063cd8 74STR *
a687059c 75stab_str(str)
76STR *str;
8d063cd8 77{
a687059c 78 STAB *stab = str->str_u.str_stab;
8d063cd8 79 register int paren;
80 register char *s;
378cc40b 81 register int i;
8d063cd8 82
a687059c 83 if (str->str_rare)
84 return stab_val(stab);
85
86 switch (*stab->str_magic->str_ptr) {
0a12ae7d 87 case '\024': /* ^T */
88 str_numset(stab_val(stab),(double)basetime);
89 break;
9f68db38 90 case '1': case '2': case '3': case '4':
8d063cd8 91 case '5': case '6': case '7': case '8': case '9': case '&':
92 if (curspat) {
a687059c 93 paren = atoi(stab_name(stab));
378cc40b 94 getparen:
95 if (curspat->spat_regexp &&
96 paren <= curspat->spat_regexp->nparens &&
97 (s = curspat->spat_regexp->startp[paren]) ) {
98 i = curspat->spat_regexp->endp[paren] - s;
99 if (i >= 0)
a687059c 100 str_nset(stab_val(stab),s,i);
378cc40b 101 else
a687059c 102 str_sset(stab_val(stab),&str_undef);
8d063cd8 103 }
378cc40b 104 else
a687059c 105 str_sset(stab_val(stab),&str_undef);
8d063cd8 106 }
107 break;
108 case '+':
109 if (curspat) {
378cc40b 110 paren = curspat->spat_regexp->lastparen;
111 goto getparen;
8d063cd8 112 }
113 break;
a687059c 114 case '`':
115 if (curspat) {
116 if (curspat->spat_regexp &&
117 (s = curspat->spat_regexp->subbase) ) {
118 i = curspat->spat_regexp->startp[0] - s;
119 if (i >= 0)
120 str_nset(stab_val(stab),s,i);
121 else
122 str_nset(stab_val(stab),"",0);
123 }
124 else
125 str_nset(stab_val(stab),"",0);
126 }
127 break;
128 case '\'':
129 if (curspat) {
130 if (curspat->spat_regexp &&
131 (s = curspat->spat_regexp->endp[0]) ) {
00bf170e 132 str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
a687059c 133 }
134 else
135 str_nset(stab_val(stab),"",0);
136 }
137 break;
8d063cd8 138 case '.':
a687059c 139#ifndef lint
8d063cd8 140 if (last_in_stab) {
a687059c 141 str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
8d063cd8 142 }
a687059c 143#endif
8d063cd8 144 break;
145 case '?':
a687059c 146 str_numset(stab_val(stab),(double)statusvalue);
8d063cd8 147 break;
148 case '^':
a687059c 149 s = stab_io(curoutstab)->top_name;
150 str_set(stab_val(stab),s);
8d063cd8 151 break;
152 case '~':
a687059c 153 s = stab_io(curoutstab)->fmt_name;
154 str_set(stab_val(stab),s);
8d063cd8 155 break;
a687059c 156#ifndef lint
8d063cd8 157 case '=':
a687059c 158 str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
8d063cd8 159 break;
160 case '-':
a687059c 161 str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
8d063cd8 162 break;
163 case '%':
a687059c 164 str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
8d063cd8 165 break;
a687059c 166#endif
8d063cd8 167 case '/':
9f68db38 168 if (record_separator != 12345) {
169 *tokenbuf = record_separator;
170 tokenbuf[1] = '\0';
171 str_nset(stab_val(stab),tokenbuf,rslen);
172 }
8d063cd8 173 break;
174 case '[':
a687059c 175 str_numset(stab_val(stab),(double)arybase);
8d063cd8 176 break;
177 case '|':
00bf170e 178 if (!stab_io(curoutstab))
179 stab_io(curoutstab) = stio_new();
a687059c 180 str_numset(stab_val(stab),
181 (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
8d063cd8 182 break;
183 case ',':
a687059c 184 str_nset(stab_val(stab),ofs,ofslen);
8d063cd8 185 break;
186 case '\\':
a687059c 187 str_nset(stab_val(stab),ors,orslen);
8d063cd8 188 break;
189 case '#':
a687059c 190 str_set(stab_val(stab),ofmt);
8d063cd8 191 break;
192 case '!':
a687059c 193 str_numset(stab_val(stab), (double)errno);
00bf170e 194 str_set(stab_val(stab), errno ? strerror(errno) : "");
a687059c 195 stab_val(stab)->str_nok = 1; /* what a wonderful hack! */
378cc40b 196 break;
197 case '<':
a687059c 198 str_numset(stab_val(stab),(double)uid);
378cc40b 199 break;
200 case '>':
a687059c 201 str_numset(stab_val(stab),(double)euid);
378cc40b 202 break;
203 case '(':
a687059c 204 s = buf;
205 (void)sprintf(s,"%d",(int)gid);
378cc40b 206 goto add_groups;
207 case ')':
a687059c 208 s = buf;
209 (void)sprintf(s,"%d",(int)egid);
378cc40b 210 add_groups:
211 while (*s) s++;
212#ifdef GETGROUPS
213#ifndef NGROUPS
214#define NGROUPS 32
215#endif
216 {
217 GIDTYPE gary[NGROUPS];
218
219 i = getgroups(NGROUPS,gary);
220 while (--i >= 0) {
a687059c 221 (void)sprintf(s," %ld", (long)gary[i]);
378cc40b 222 while (*s) s++;
223 }
224 }
225#endif
a687059c 226 str_set(stab_val(stab),buf);
8d063cd8 227 break;
00bf170e 228 default:
229 {
230 struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
231
232 if (uf && uf->uf_val)
0a12ae7d 233 (*uf->uf_val)(uf->uf_index, stab_val(stab));
00bf170e 234 }
235 break;
8d063cd8 236 }
a687059c 237 return stab_val(stab);
8d063cd8 238}
239
a687059c 240stabset(mstr,str)
241register STR *mstr;
8d063cd8 242STR *str;
243{
a687059c 244 STAB *stab = mstr->str_u.str_stab;
8d063cd8 245 char *s;
246 int i;
663a0e37 247 static handlertype sighandler();
8d063cd8 248
a687059c 249 switch (mstr->str_rare) {
250 case 'E':
251 setenv(mstr->str_ptr,str_get(str));
252 /* And you'll never guess what the dog had */
0a12ae7d 253 /* in its mouth... */
254#ifdef TAINT
255 if (strEQ(mstr->str_ptr,"PATH")) {
256 char *strend = str->str_ptr + str->str_cur;
257
258 s = str->str_ptr;
259 while (s < strend) {
260 s = cpytill(tokenbuf,s,strend,':',&i);
261 s++;
262 if (*tokenbuf != '/'
263 || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
264 str->str_tainted = 2;
265 }
266 }
267#endif
268 break;
a687059c 269 case 'S':
270 s = str_get(str);
271 i = whichsig(mstr->str_ptr); /* ...no, a brick */
272 if (strEQ(s,"IGNORE"))
273#ifndef lint
274 (void)signal(i,SIG_IGN);
275#else
276 ;
277#endif
278 else if (strEQ(s,"DEFAULT") || !*s)
279 (void)signal(i,SIG_DFL);
0a12ae7d 280 else {
a687059c 281 (void)signal(i,sighandler);
0a12ae7d 282 if (!index(s,'\'')) {
283 sprintf(tokenbuf, "main'%s",s);
284 str_set(str,tokenbuf);
285 }
286 }
a687059c 287 break;
288#ifdef SOME_DBM
289 case 'D':
290 hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
291 break;
292#endif
0a12ae7d 293 case 'L':
294 {
295 CMD *cmd;
296
297 i = str_true(str);
298 str = afetch(stab_xarray(stab),atoi(mstr->str_ptr));
299 cmd = str->str_magic->str_u.str_cmd;
300 cmd->c_flags &= ~CF_OPTIMIZE;
301 cmd->c_flags |= i? CFT_D1 : CFT_D0;
302 }
303 break;
a687059c 304 case '#':
305 afill(stab_array(stab), (int)str_gnum(str) - arybase);
306 break;
307 case 'X': /* merely a copy of a * string */
308 break;
309 case '*':
310 s = str_get(str);
9f68db38 311 if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
a687059c 312 if (!*s) {
313 STBP *stbp;
314
315 (void)savenostab(stab); /* schedule a free of this stab */
316 if (stab->str_len)
317 Safefree(stab->str_ptr);
318 Newz(601,stbp, 1, STBP);
319 stab->str_ptr = stbp;
320 stab->str_len = stab->str_cur = sizeof(STBP);
321 stab->str_pok = 1;
9f68db38 322 strcpy(stab_magic(stab),"StB");
a687059c 323 stab_val(stab) = Str_new(70,0);
00bf170e 324 stab_line(stab) = curcmd->c_line;
a687059c 325 }
00bf170e 326 else {
a687059c 327 stab = stabent(s,TRUE);
00bf170e 328 if (!stab_xarray(stab))
329 aadd(stab);
330 if (!stab_xhash(stab))
331 hadd(stab);
332 if (!stab_io(stab))
333 stab_io(stab) = stio_new();
334 }
a687059c 335 str_sset(str,stab);
336 }
337 break;
338 case 's': {
339 struct lstring *lstr = (struct lstring*)str;
340
341 mstr->str_rare = 0;
342 str->str_magic = Nullstr;
343 str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
344 str->str_ptr,str->str_cur);
345 }
346 break;
347
348 case 'v':
349 do_vecset(mstr,str);
350 break;
351
352 case 0:
353 switch (*stab->str_magic->str_ptr) {
0a12ae7d 354 case '\024': /* ^T */
355 basetime = (long)str_gnum(str);
356 break;
9f68db38 357 case '.':
358 if (localizing)
359 savesptr((STR**)&last_in_stab);
360 break;
8d063cd8 361 case '^':
a687059c 362 Safefree(stab_io(curoutstab)->top_name);
363 stab_io(curoutstab)->top_name = s = savestr(str_get(str));
364 stab_io(curoutstab)->top_stab = stabent(s,TRUE);
8d063cd8 365 break;
366 case '~':
a687059c 367 Safefree(stab_io(curoutstab)->fmt_name);
368 stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
369 stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
8d063cd8 370 break;
371 case '=':
a687059c 372 stab_io(curoutstab)->page_len = (long)str_gnum(str);
8d063cd8 373 break;
374 case '-':
a687059c 375 stab_io(curoutstab)->lines_left = (long)str_gnum(str);
376 if (stab_io(curoutstab)->lines_left < 0L)
377 stab_io(curoutstab)->lines_left = 0L;
8d063cd8 378 break;
379 case '%':
a687059c 380 stab_io(curoutstab)->page = (long)str_gnum(str);
8d063cd8 381 break;
382 case '|':
00bf170e 383 if (!stab_io(curoutstab))
384 stab_io(curoutstab) = stio_new();
a687059c 385 stab_io(curoutstab)->flags &= ~IOF_FLUSH;
8d063cd8 386 if (str_gnum(str) != 0.0) {
a687059c 387 stab_io(curoutstab)->flags |= IOF_FLUSH;
8d063cd8 388 }
389 break;
390 case '*':
a687059c 391 i = (int)str_gnum(str);
392 multiline = (i != 0);
8d063cd8 393 break;
394 case '/':
79a0689e 395 if (str->str_pok) {
9f68db38 396 record_separator = *str_get(str);
397 rslen = str->str_cur;
398 }
399 else {
400 record_separator = 12345; /* fake a non-existent char */
401 rslen = 1;
402 }
8d063cd8 403 break;
404 case '\\':
405 if (ors)
a687059c 406 Safefree(ors);
8d063cd8 407 ors = savestr(str_get(str));
a687059c 408 orslen = str->str_cur;
8d063cd8 409 break;
410 case ',':
411 if (ofs)
a687059c 412 Safefree(ofs);
8d063cd8 413 ofs = savestr(str_get(str));
a687059c 414 ofslen = str->str_cur;
8d063cd8 415 break;
416 case '#':
417 if (ofmt)
a687059c 418 Safefree(ofmt);
8d063cd8 419 ofmt = savestr(str_get(str));
420 break;
421 case '[':
422 arybase = (int)str_gnum(str);
423 break;
378cc40b 424 case '?':
0f85fab0 425 statusvalue = U_S(str_gnum(str));
378cc40b 426 break;
8d063cd8 427 case '!':
428 errno = (int)str_gnum(str); /* will anyone ever use this? */
429 break;
378cc40b 430 case '<':
378cc40b 431 uid = (int)str_gnum(str);
a687059c 432#ifdef SETREUID
433 if (delaymagic) {
434 delaymagic |= DM_REUID;
435 break; /* don't do magic till later */
436 }
437#endif /* SETREUID */
438#ifdef SETRUID
439 if (setruid((UIDTYPE)uid) < 0)
440 uid = (int)getuid();
441#else
442#ifdef SETREUID
443 if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
378cc40b 444 uid = (int)getuid();
445#else
00bf170e 446 if (uid == euid) /* special case $< = $> */
447 setuid(uid);
448 else
449 fatal("setruid() not implemented");
378cc40b 450#endif
a687059c 451#endif
378cc40b 452 break;
453 case '>':
378cc40b 454 euid = (int)str_gnum(str);
a687059c 455#ifdef SETREUID
456 if (delaymagic) {
457 delaymagic |= DM_REUID;
458 break; /* don't do magic till later */
459 }
460#endif /* SETREUID */
461#ifdef SETEUID
462 if (seteuid((UIDTYPE)euid) < 0)
463 euid = (int)geteuid();
464#else
465#ifdef SETREUID
466 if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
378cc40b 467 euid = (int)geteuid();
468#else
00bf170e 469 if (euid == uid) /* special case $> = $< */
470 setuid(euid);
471 else
472 fatal("seteuid() not implemented");
378cc40b 473#endif
a687059c 474#endif
378cc40b 475 break;
476 case '(':
a687059c 477 gid = (int)str_gnum(str);
478#ifdef SETREGID
479 if (delaymagic) {
480 delaymagic |= DM_REGID;
481 break; /* don't do magic till later */
482 }
483#endif /* SETREGID */
378cc40b 484#ifdef SETRGID
a687059c 485 (void)setrgid((GIDTYPE)gid);
486#else
487#ifdef SETREGID
488 (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
378cc40b 489#else
490 fatal("setrgid() not implemented");
491#endif
a687059c 492#endif
378cc40b 493 break;
494 case ')':
a687059c 495 egid = (int)str_gnum(str);
496#ifdef SETREGID
497 if (delaymagic) {
498 delaymagic |= DM_REGID;
499 break; /* don't do magic till later */
500 }
501#endif /* SETREGID */
378cc40b 502#ifdef SETEGID
a687059c 503 (void)setegid((GIDTYPE)egid);
504#else
505#ifdef SETREGID
506 (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
378cc40b 507#else
508 fatal("setegid() not implemented");
509#endif
a687059c 510#endif
511 break;
512 case ':':
513 chopset = str_get(str);
378cc40b 514 break;
00bf170e 515 default:
516 {
517 struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
518
519 if (uf && uf->uf_set)
0a12ae7d 520 (*uf->uf_set)(uf->uf_index, str);
00bf170e 521 }
522 break;
8d063cd8 523 }
a687059c 524 break;
378cc40b 525 }
8d063cd8 526}
527
378cc40b 528whichsig(sig)
529char *sig;
8d063cd8 530{
531 register char **sigv;
532
533 for (sigv = sig_name+1; *sigv; sigv++)
378cc40b 534 if (strEQ(sig,*sigv))
8d063cd8 535 return sigv - sig_name;
a687059c 536#ifdef SIGCLD
537 if (strEQ(sig,"CHLD"))
538 return SIGCLD;
539#endif
540#ifdef SIGCHLD
541 if (strEQ(sig,"CLD"))
542 return SIGCHLD;
543#endif
8d063cd8 544 return 0;
545}
546
663a0e37 547static handlertype
8d063cd8 548sighandler(sig)
549int sig;
550{
551 STAB *stab;
552 ARRAY *savearray;
553 STR *str;
0a12ae7d 554 CMD *oldcurcmd = curcmd;
378cc40b 555 int oldsave = savestack->ary_fill;
a687059c 556 ARRAY *oldstack = stack;
0a12ae7d 557 CSV *oldcurcsv = curcsv;
378cc40b 558 SUBR *sub;
8d063cd8 559
00bf170e 560#ifdef OS2 /* or anybody else who requires SIG_ACK */
561 signal(sig, SIG_ACK);
562#endif
0a12ae7d 563 curcsv = Nullcsv;
a687059c 564 stab = stabent(
565 str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
566 TRUE)), TRUE);
567 sub = stab_sub(stab);
568 if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
569 if (sig_name[sig][1] == 'H')
570 stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
571 TRUE);
572 else
573 stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
574 TRUE);
575 sub = stab_sub(stab); /* gag */
576 }
378cc40b 577 if (!sub) {
578 if (dowarn)
579 warn("SIG%s handler \"%s\" not defined.\n",
a687059c 580 sig_name[sig], stab_name(stab) );
378cc40b 581 return;
582 }
a687059c 583 savearray = stab_xarray(defstab);
584 stab_xarray(defstab) = stack = anew(defstab);
585 stack->ary_flags = 0;
586 str = Str_new(71,0);
8d063cd8 587 str_set(str,sig_name[sig]);
a687059c 588 (void)apush(stab_xarray(defstab),str);
378cc40b 589 sub->depth++;
590 if (sub->depth >= 2) { /* save temporaries on recursion? */
591 if (sub->depth == 100 && dowarn)
a687059c 592 warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
378cc40b 593 savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
594 }
378cc40b 595
a687059c 596 (void)cmd_exec(sub->cmd,G_SCALAR,1); /* so do it already */
378cc40b 597
598 sub->depth--; /* assuming no longjumps out of here */
a687059c 599 str_free(stack->ary_array[0]); /* free the one real string */
600 afree(stab_xarray(defstab)); /* put back old $_[] */
601 stab_xarray(defstab) = savearray;
602 stack = oldstack;
378cc40b 603 if (savestack->ary_fill > oldsave)
604 restorelist(oldsave);
0a12ae7d 605 curcmd = oldcurcmd;
606 curcsv = oldcurcsv;
8d063cd8 607}
608
8d063cd8 609STAB *
610aadd(stab)
611register STAB *stab;
612{
a687059c 613 if (!stab_xarray(stab))
614 stab_xarray(stab) = anew(stab);
8d063cd8 615 return stab;
616}
617
618STAB *
619hadd(stab)
620register STAB *stab;
621{
a687059c 622 if (!stab_xhash(stab))
623 stab_xhash(stab) = hnew(COEFFSIZE);
8d063cd8 624 return stab;
625}
378cc40b 626
627STAB *
0a12ae7d 628fstab(name)
629char *name;
630{
631 char tmpbuf[1200];
632 STAB *stab;
633
634 sprintf(tmpbuf,"'_<%s", name);
635 stab = stabent(tmpbuf, TRUE);
636 str_set(stab_val(stab), name);
637 if (perldb)
638 (void)hadd(aadd(stab));
639 return stab;
640}
641
642STAB *
378cc40b 643stabent(name,add)
644register char *name;
645int add;
646{
647 register STAB *stab;
a687059c 648 register STBP *stbp;
649 int len;
650 register char *namend;
651 HASH *stash;
652 char *sawquote = Nullch;
653 char *prevquote = Nullch;
654 bool global = FALSE;
378cc40b 655
a687059c 656 if (isascii(*name) && isupper(*name)) {
657 if (*name > 'I') {
658 if (*name == 'S' && (
659 strEQ(name, "SIG") ||
660 strEQ(name, "STDIN") ||
661 strEQ(name, "STDOUT") ||
662 strEQ(name, "STDERR") ))
663 global = TRUE;
378cc40b 664 }
a687059c 665 else if (*name > 'E') {
666 if (*name == 'I' && strEQ(name, "INC"))
667 global = TRUE;
668 }
00bf170e 669 else if (*name > 'A') {
a687059c 670 if (*name == 'E' && strEQ(name, "ENV"))
671 global = TRUE;
672 }
673 else if (*name == 'A' && (
674 strEQ(name, "ARGV") ||
675 strEQ(name, "ARGVOUT") ))
676 global = TRUE;
677 }
678 for (namend = name; *namend; namend++) {
679 if (*namend == '\'' && namend[1])
680 prevquote = sawquote, sawquote = namend;
681 }
682 if (sawquote == name && name[1]) {
683 stash = defstash;
684 sawquote = Nullch;
685 name++;
686 }
687 else if (!isalpha(*name) || global)
688 stash = defstash;
0a12ae7d 689 else if (curcmd == &compiling)
a687059c 690 stash = curstash;
0a12ae7d 691 else
692 stash = curcmd->c_stash;
a687059c 693 if (sawquote) {
694 char tmpbuf[256];
695 char *s, *d;
696
697 *sawquote = '\0';
698 if (s = prevquote) {
699 strncpy(tmpbuf,name,s-name+1);
700 d = tmpbuf+(s-name+1);
701 *d++ = '_';
702 strcpy(d,s+1);
703 }
704 else {
705 *tmpbuf = '_';
706 strcpy(tmpbuf+1,name);
707 }
708 stab = stabent(tmpbuf,TRUE);
709 if (!(stash = stab_xhash(stab)))
710 stash = stab_xhash(stab) = hnew(0);
0a12ae7d 711 if (!stash->tbl_name)
712 stash->tbl_name = savestr(name);
a687059c 713 name = sawquote+1;
714 *sawquote = '\'';
378cc40b 715 }
a687059c 716 len = namend - name;
717 stab = (STAB*)hfetch(stash,name,len,add);
0a12ae7d 718 if (stab == (STAB*)&str_undef)
a687059c 719 return Nullstab;
720 if (stab->str_pok) {
721 stab->str_pok |= SP_MULTI;
722 return stab;
723 }
724 else {
725 if (stab->str_len)
726 Safefree(stab->str_ptr);
727 Newz(602,stbp, 1, STBP);
728 stab->str_ptr = stbp;
729 stab->str_len = stab->str_cur = sizeof(STBP);
730 stab->str_pok = 1;
9f68db38 731 strcpy(stab_magic(stab),"StB");
a687059c 732 stab_val(stab) = Str_new(72,0);
00bf170e 733 stab_line(stab) = curcmd->c_line;
a687059c 734 str_magic(stab,stab,'*',name,len);
0a12ae7d 735 stab_stash(stab) = stash;
378cc40b 736 return stab;
737 }
378cc40b 738}
739
0a12ae7d 740stab_fullname(str,stab)
741STR *str;
742STAB *stab;
743{
744 str_set(str,stab_stash(stab)->tbl_name);
745 str_ncat(str,"'", 1);
746 str_scat(str,stab->str_magic);
747}
748
378cc40b 749STIO *
750stio_new()
751{
a687059c 752 STIO *stio;
378cc40b 753
a687059c 754 Newz(603,stio,1,STIO);
378cc40b 755 stio->page_len = 60;
756 return stio;
757}
758
759stab_check(min,max)
760int min;
761register int max;
762{
a687059c 763 register HENT *entry;
378cc40b 764 register int i;
765 register STAB *stab;
766
767 for (i = min; i <= max; i++) {
a687059c 768 for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
769 stab = (STAB*)entry->hent_val;
770 if (stab->str_pok & SP_MULTI)
378cc40b 771 continue;
00bf170e 772 curcmd->c_line = stab_line(stab);
a687059c 773 warn("Possible typo: \"%s\"", stab_name(stab));
378cc40b 774 }
775 }
776}
a687059c 777
778static int gensym = 0;
779
780STAB *
781genstab()
782{
783 (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
784 return stabent(tokenbuf,TRUE);
785}
786
787/* hopefully this is only called on local symbol table entries */
788
789void
790stab_clear(stab)
791register STAB *stab;
792{
793 STIO *stio;
794 SUBR *sub;
795
796 afree(stab_xarray(stab));
0a12ae7d 797 (void)hfree(stab_xhash(stab), FALSE);
a687059c 798 str_free(stab_val(stab));
799 if (stio = stab_io(stab)) {
800 do_close(stab,FALSE);
801 Safefree(stio->top_name);
802 Safefree(stio->fmt_name);
803 }
804 if (sub = stab_sub(stab)) {
805 afree(sub->tosave);
806 cmd_free(sub->cmd);
807 }
808 Safefree(stab->str_ptr);
809 stab->str_ptr = Null(STBP*);
810 stab->str_len = 0;
811 stab->str_cur = 0;
812}
813
9f68db38 814#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
815#define MICROPORT
816#endif
817
818#ifdef MICROPORT /* Microport 2.4 hack */
819ARRAY *stab_array(stab)
820register STAB *stab;
821{
822 if (((STBP*)(stab->str_ptr))->stbp_array)
823 return ((STBP*)(stab->str_ptr))->stbp_array;
824 else
825 return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
826}
827
828HASH *stab_hash(stab)
829register STAB *stab;
830{
831 if (((STBP*)(stab->str_ptr))->stbp_hash)
832 return ((STBP*)(stab->str_ptr))->stbp_hash;
833 else
834 return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
835}
836#endif /* Microport 2.4 hack */
Unnamed repository; edit this file to name it for gitweb.