stab.c

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