stab.c

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