stab.c

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