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