stab.c

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