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