stab.c

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