stab.c

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