stab.c

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