stab.c

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