stab.c

   1 /* $Header: stab.c,v 4.0 91/03/20 01:39:41 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 4.0  91/03/20  01:39:41  lwall
  10  * 4.0 baseline.
  11  *
  12  */
  13
  14 #include "EXTERN.h"
  15 #include "perl.h"
  16
  17 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  18 #include <signal.h>
  19 #endif
  20
  21 static char *sig_name[] = {
  22     SIG_NAME,0
  23 };
  24
  25 #ifdef VOIDSIG
  26 #define handlertype void
  27 #else
  28 #define handlertype int
  29 #endif
  30
  31 static handlertype sighandler();
  32
  33 static int origalen = 0;
  34
  35 STR *
  36 stab_str(str)
  37 STR *str;
  38 {
  39     STAB *stab = str->str_u.str_stab;
  40     register int paren;
  41     register char *s;
  42     register int i;
  43
  44     if (str->str_rare)
  45         return stab_val(stab);
  46
  47     switch (*stab->str_magic->str_ptr) {
  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;
  59     case '\024':                /* ^T */
  60         str_numset(stab_val(stab),(double)basetime);
  61         break;
  62     case '\027':                /* ^W */
  63         str_numset(stab_val(stab),(double)dowarn);
  64         break;
  65     case '1': case '2': case '3': case '4':
  66     case '5': case '6': case '7': case '8': case '9': case '&':
  67         if (curspat) {
  68             paren = atoi(stab_name(stab));
  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)
  75                     str_nset(stab_val(stab),s,i);
  76                 else
  77                     str_sset(stab_val(stab),&str_undef);
  78             }
  79             else
  80                 str_sset(stab_val(stab),&str_undef);
  81         }
  82         break;
  83     case '+':
  84         if (curspat) {
  85             paren = curspat->spat_regexp->lastparen;
  86             goto getparen;
  87         }
  88         break;
  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]) ) {
 107                 str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
 108             }
 109             else
 110                 str_nset(stab_val(stab),"",0);
 111         }
 112         break;
 113     case '.':
 114 #ifndef lint
 115         if (last_in_stab) {
 116             str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
 117         }
 118 #endif
 119         break;
 120     case '?':
 121         str_numset(stab_val(stab),(double)statusvalue);
 122         break;
 123     case '^':
 124         s = stab_io(curoutstab)->top_name;
 125         str_set(stab_val(stab),s);
 126         break;
 127     case '~':
 128         s = stab_io(curoutstab)->fmt_name;
 129         str_set(stab_val(stab),s);
 130         break;
 131 #ifndef lint
 132     case '=':
 133         str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
 134         break;
 135     case '-':
 136         str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
 137         break;
 138     case '%':
 139         str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
 140         break;
 141 #endif
 142     case '/':
 143         break;
 144     case '[':
 145         str_numset(stab_val(stab),(double)arybase);
 146         break;
 147     case '|':
 148         if (!stab_io(curoutstab))
 149             stab_io(curoutstab) = stio_new();
 150         str_numset(stab_val(stab),
 151            (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
 152         break;
 153     case ',':
 154         str_nset(stab_val(stab),ofs,ofslen);
 155         break;
 156     case '\\':
 157         str_nset(stab_val(stab),ors,orslen);
 158         break;
 159     case '#':
 160         str_set(stab_val(stab),ofmt);
 161         break;
 162     case '!':
 163         str_numset(stab_val(stab), (double)errno);
 164         str_set(stab_val(stab), errno ? strerror(errno) : "");
 165         stab_val(stab)->str_nok = 1;    /* what a wonderful hack! */
 166         break;
 167     case '<':
 168         str_numset(stab_val(stab),(double)uid);
 169         break;
 170     case '>':
 171         str_numset(stab_val(stab),(double)euid);
 172         break;
 173     case '(':
 174         s = buf;
 175         (void)sprintf(s,"%d",(int)gid);
 176         goto add_groups;
 177     case ')':
 178         s = buf;
 179         (void)sprintf(s,"%d",(int)egid);
 180       add_groups:
 181         while (*s) s++;
 182 #ifdef HAS_GETGROUPS
 183 #ifndef NGROUPS
 184 #define NGROUPS 32
 185 #endif
 186         {
 187             GIDTYPE gary[NGROUPS];
 188
 189             i = getgroups(NGROUPS,gary);
 190             while (--i >= 0) {
 191                 (void)sprintf(s," %ld", (long)gary[i]);
 192                 while (*s) s++;
 193             }
 194         }
 195 #endif
 196         str_set(stab_val(stab),buf);
 197         break;
 198     case '*':
 199         break;
 200     case '0':
 201         break;
 202     default:
 203         {
 204             struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
 205
 206             if (uf && uf->uf_val)
 207                 (*uf->uf_val)(uf->uf_index, stab_val(stab));
 208         }
 209         break;
 210     }
 211     return stab_val(stab);
 212 }
 213
 214 stabset(mstr,str)
 215 register STR *mstr;
 216 STR *str;
 217 {
 218     STAB *stab = mstr->str_u.str_stab;
 219     register char *s;
 220     int i;
 221
 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 */
 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;
 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);
 253         else {
 254             (void)signal(i,sighandler);
 255             if (!index(s,'\'')) {
 256                 sprintf(tokenbuf, "main'%s",s);
 257                 str_set(str,tokenbuf);
 258             }
 259         }
 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
 266     case 'L':
 267         {
 268             CMD *cmd;
 269
 270             i = str_true(str);
 271             str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE);
 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;
 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);
 284         if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
 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;
 295                 strcpy(stab_magic(stab),"StB");
 296                 stab_val(stab) = Str_new(70,0);
 297                 stab_line(stab) = curcmd->c_line;
 298                 stab_stash(stab) = curcmd->c_stash;
 299             }
 300             else {
 301                 stab = stabent(s,TRUE);
 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             }
 309             str_sset(str,stab);
 310         }
 311         break;
 312     case 's': {
 313             struct lstring *lstr = (struct lstring*)str;
 314             char *tmps;
 315
 316             mstr->str_rare = 0;
 317             str->str_magic = Nullstr;
 318             tmps = str_get(str);
 319             str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
 320               tmps,str->str_cur);
 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) {
 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;
 343         case '\024':    /* ^T */
 344             basetime = (long)str_gnum(str);
 345             break;
 346         case '\027':    /* ^W */
 347             dowarn = (bool)str_gnum(str);
 348             break;
 349         case '.':
 350             if (localizing)
 351                 savesptr((STR**)&last_in_stab);
 352             break;
 353         case '^':
 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);
 357             break;
 358         case '~':
 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);
 362             break;
 363         case '=':
 364             stab_io(curoutstab)->page_len = (long)str_gnum(str);
 365             break;
 366         case '-':
 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;
 370             break;
 371         case '%':
 372             stab_io(curoutstab)->page = (long)str_gnum(str);
 373             break;
 374         case '|':
 375             if (!stab_io(curoutstab))
 376                 stab_io(curoutstab) = stio_new();
 377             stab_io(curoutstab)->flags &= ~IOF_FLUSH;
 378             if (str_gnum(str) != 0.0) {
 379                 stab_io(curoutstab)->flags |= IOF_FLUSH;
 380             }
 381             break;
 382         case '*':
 383             i = (int)str_gnum(str);
 384             multiline = (i != 0);
 385             break;
 386         case '/':
 387             if (str->str_pok) {
 388                 rs = str_get(str);
 389                 rslen = str->str_cur;
 390                 if (!rslen) {
 391                     rs = "\n\n";
 392                     rslen = 2;
 393                 }
 394                 rschar = rs[rslen - 1];
 395             }
 396             else {
 397                 rschar = 0777;  /* fake a non-existent char */
 398                 rslen = 1;
 399             }
 400             break;
 401         case '\\':
 402             if (ors)
 403                 Safefree(ors);
 404             ors = savestr(str_get(str));
 405             orslen = str->str_cur;
 406             break;
 407         case ',':
 408             if (ofs)
 409                 Safefree(ofs);
 410             ofs = savestr(str_get(str));
 411             ofslen = str->str_cur;
 412             break;
 413         case '#':
 414             if (ofmt)
 415                 Safefree(ofmt);
 416             ofmt = savestr(str_get(str));
 417             break;
 418         case '[':
 419             arybase = (int)str_gnum(str);
 420             break;
 421         case '?':
 422             statusvalue = U_S(str_gnum(str));
 423             break;
 424         case '!':
 425             errno = (int)str_gnum(str);         /* will anyone ever use this? */
 426             break;
 427         case '<':
 428             uid = (int)str_gnum(str);
 429 #ifdef HAS_SETREUID
 430             if (delaymagic) {
 431                 delaymagic |= DM_REUID;
 432                 break;                          /* don't do magic till later */
 433             }
 434 #endif /* HAS_SETREUID */
 435 #ifdef HAS_SETRUID
 436             if (setruid((UIDTYPE)uid) < 0)
 437                 uid = (int)getuid();
 438 #else
 439 #ifdef HAS_SETREUID
 440             if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
 441                 uid = (int)getuid();
 442 #else
 443             if (uid == euid)            /* special case $< = $> */
 444                 setuid(uid);
 445             else
 446                 fatal("setruid() not implemented");
 447 #endif
 448 #endif
 449             break;
 450         case '>':
 451             euid = (int)str_gnum(str);
 452 #ifdef HAS_SETREUID
 453             if (delaymagic) {
 454                 delaymagic |= DM_REUID;
 455                 break;                          /* don't do magic till later */
 456             }
 457 #endif /* HAS_SETREUID */
 458 #ifdef HAS_SETEUID
 459             if (seteuid((UIDTYPE)euid) < 0)
 460                 euid = (int)geteuid();
 461 #else
 462 #ifdef HAS_SETREUID
 463             if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
 464                 euid = (int)geteuid();
 465 #else
 466             if (euid == uid)            /* special case $> = $< */
 467                 setuid(euid);
 468             else
 469                 fatal("seteuid() not implemented");
 470 #endif
 471 #endif
 472             break;
 473         case '(':
 474             gid = (int)str_gnum(str);
 475 #ifdef HAS_SETREGID
 476             if (delaymagic) {
 477                 delaymagic |= DM_REGID;
 478                 break;                          /* don't do magic till later */
 479             }
 480 #endif /* HAS_SETREGID */
 481 #ifdef HAS_SETRGID
 482             (void)setrgid((GIDTYPE)gid);
 483 #else
 484 #ifdef HAS_SETREGID
 485             (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
 486 #else
 487             fatal("setrgid() not implemented");
 488 #endif
 489 #endif
 490             break;
 491         case ')':
 492             egid = (int)str_gnum(str);
 493 #ifdef HAS_SETREGID
 494             if (delaymagic) {
 495                 delaymagic |= DM_REGID;
 496                 break;                          /* don't do magic till later */
 497             }
 498 #endif /* HAS_SETREGID */
 499 #ifdef HAS_SETEGID
 500             (void)setegid((GIDTYPE)egid);
 501 #else
 502 #ifdef HAS_SETREGID
 503             (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
 504 #else
 505             fatal("setegid() not implemented");
 506 #endif
 507 #endif
 508             break;
 509         case ':':
 510             chopset = str_get(str);
 511             break;
 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;
 545         default:
 546             {
 547                 struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
 548
 549                 if (uf && uf->uf_set)
 550                     (*uf->uf_set)(uf->uf_index, str);
 551             }
 552             break;
 553         }
 554         break;
 555     }
 556 }
 557
 558 whichsig(sig)
 559 char *sig;
 560 {
 561     register char **sigv;
 562
 563     for (sigv = sig_name+1; *sigv; sigv++)
 564         if (strEQ(sig,*sigv))
 565             return sigv - sig_name;
 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
 574     return 0;
 575 }
 576
 577 static handlertype
 578 sighandler(sig)
 579 int sig;
 580 {
 581     STAB *stab;
 582     ARRAY *savearray;
 583     STR *str;
 584     CMD *oldcurcmd = curcmd;
 585     int oldsave = savestack->ary_fill;
 586     ARRAY *oldstack = stack;
 587     CSV *oldcurcsv = curcsv;
 588     SUBR *sub;
 589
 590 #ifdef OS2              /* or anybody else who requires SIG_ACK */
 591     signal(sig, SIG_ACK);
 592 #endif
 593     curcsv = Nullcsv;
 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     }
 607     if (!sub) {
 608         if (dowarn)
 609             warn("SIG%s handler \"%s\" not defined.\n",
 610                 sig_name[sig], stab_name(stab) );
 611         return;
 612     }
 613     savearray = stab_xarray(defstab);
 614     stab_xarray(defstab) = stack = anew(defstab);
 615     stack->ary_flags = 0;
 616     str = Str_new(71,0);
 617     str_set(str,sig_name[sig]);
 618     (void)apush(stab_xarray(defstab),str);
 619     sub->depth++;
 620     if (sub->depth >= 2) {      /* save temporaries on recursion? */
 621         if (sub->depth == 100 && dowarn)
 622             warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
 623         savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
 624     }
 625
 626     (void)cmd_exec(sub->cmd,G_SCALAR,1);                /* so do it already */
 627
 628     sub->depth--;       /* assuming no longjumps out of here */
 629     str_free(stack->ary_array[0]);      /* free the one real string */
 630     stack->ary_array[0] = Nullstr;
 631     afree(stab_xarray(defstab));  /* put back old $_[] */
 632     stab_xarray(defstab) = savearray;
 633     stack = oldstack;
 634     if (savestack->ary_fill > oldsave)
 635         restorelist(oldsave);
 636     curcmd = oldcurcmd;
 637     curcsv = oldcurcsv;
 638 }
 639
 640 STAB *
 641 aadd(stab)
 642 register STAB *stab;
 643 {
 644     if (!stab_xarray(stab))
 645         stab_xarray(stab) = anew(stab);
 646     return stab;
 647 }
 648
 649 STAB *
 650 hadd(stab)
 651 register STAB *stab;
 652 {
 653     if (!stab_xhash(stab))
 654         stab_xhash(stab) = hnew(COEFFSIZE);
 655     return stab;
 656 }
 657
 658 STAB *
 659 fstab(name)
 660 char *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
 673 STAB *
 674 stabent(name,add)
 675 register char *name;
 676 int add;
 677 {
 678     register STAB *stab;
 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;
 686
 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;
 695         }
 696         else if (*name > 'E') {
 697             if (*name == 'I' && strEQ(name, "INC"))
 698                 global = TRUE;
 699         }
 700         else if (*name > 'A') {
 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;
 720     else if (curcmd == &compiling)
 721         stash = curstash;
 722     else
 723         stash = curcmd->c_stash;
 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);
 742         if (!stash->tbl_name)
 743             stash->tbl_name = savestr(name);
 744         name = sawquote+1;
 745         *sawquote = '\'';
 746     }
 747     len = namend - name;
 748     stab = (STAB*)hfetch(stash,name,len,add);
 749     if (stab == (STAB*)&str_undef)
 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;
 762         strcpy(stab_magic(stab),"StB");
 763         stab_val(stab) = Str_new(72,0);
 764         stab_line(stab) = curcmd->c_line;
 765         str_magic(stab,stab,'*',name,len);
 766         stab_stash(stab) = stash;
 767         if (isdigit(*name) && *name != '0') {
 768             stab_flags(stab) = SF_VMAGIC;
 769             str_magic(stab_val(stab), stab, 0, Nullch, 0);
 770         }
 771         return stab;
 772     }
 773 }
 774
 775 stab_fullname(str,stab)
 776 STR *str;
 777 STAB *stab;
 778 {
 779     HASH *tb = stab_stash(stab);
 780
 781     if (!tb)
 782         return;
 783     str_set(str,tb->tbl_name);
 784     str_ncat(str,"'", 1);
 785     str_scat(str,stab->str_magic);
 786 }
 787
 788 STIO *
 789 stio_new()
 790 {
 791     STIO *stio;
 792
 793     Newz(603,stio,1,STIO);
 794     stio->page_len = 60;
 795     return stio;
 796 }
 797
 798 stab_check(min,max)
 799 int min;
 800 register int max;
 801 {
 802     register HENT *entry;
 803     register int i;
 804     register STAB *stab;
 805
 806     for (i = min; i <= max; i++) {
 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)
 810                 continue;
 811             curcmd->c_line = stab_line(stab);
 812             warn("Possible typo: \"%s\"", stab_name(stab));
 813         }
 814     }
 815 }
 816
 817 static int gensym = 0;
 818
 819 STAB *
 820 genstab()
 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
 828 void
 829 stab_clear(stab)
 830 register STAB *stab;
 831 {
 832     STIO *stio;
 833     SUBR *sub;
 834
 835     afree(stab_xarray(stab));
 836     stab_xarray(stab) = Null(ARRAY*);
 837     (void)hfree(stab_xhash(stab), FALSE);
 838     stab_xhash(stab) = Null(HASH*);
 839     str_free(stab_val(stab));
 840     stab_val(stab) = Nullstr;
 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
 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 */
 861 ARRAY *stab_array(stab)
 862 register 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
 870 HASH *stab_hash(stab)
 871 register 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 */