home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / perl / os2perl / stab.c < prev    next >
C/C++ Source or Header  |  1991-06-11  |  23KB  |  986 lines
  1. /* $RCSfile: stab.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:55:53 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    stab.c,v $
  9.  * Revision 4.0.1.2  91/06/07  11:55:53  lwall
  10.  * patch4: new copyright notice
  11.  * patch4: added $^P variable to control calling of perldb routines
  12.  * patch4: added $^F variable to specify maximum system fd, default 2
  13.  * patch4: $` was busted inside s///
  14.  * patch4: default top-of-form format is now FILEHANDLE_TOP
  15.  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  16.  * patch4: $^D |= 1024 now does syntax tree dump at run-time
  17.  *
  18.  * Revision 4.0.1.1  91/04/12  09:10:24  lwall
  19.  * patch1: Configure now differentiates getgroups() type from getgid() type
  20.  * patch1: you may now use "die" and "caller" in a signal handler
  21.  *
  22.  * Revision 4.0  91/03/20  01:39:41  lwall
  23.  * 4.0 baseline.
  24.  *
  25.  */
  26.  
  27. #include "EXTERN.h"
  28. #include "perl.h"
  29.  
  30. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  31. #include <signal.h>
  32. #endif
  33.  
  34. static char *sig_name[] = {
  35.     SIG_NAME,0
  36. };
  37.  
  38. #ifdef VOIDSIG
  39. #define handlertype void
  40. #else
  41. #define handlertype int
  42. #endif
  43.  
  44. static handlertype sighandler();
  45.  
  46. static int origalen = 0;
  47.  
  48. STR *
  49. stab_str(str)
  50. STR *str;
  51. {
  52.     STAB *stab = str->str_u.str_stab;
  53.     register int paren;
  54.     register char *s;
  55.     register int i;
  56.  
  57.     if (str->str_rare)
  58.     return stab_val(stab);
  59.  
  60.     switch (*stab->str_magic->str_ptr) {
  61.     case '\004':        /* ^D */
  62. #ifdef DEBUGGING
  63.     str_numset(stab_val(stab),(double)(debug & 32767));
  64. #endif
  65.     break;
  66.     case '\006':        /* ^F */
  67.     str_numset(stab_val(stab),(double)maxsysfd);
  68.     break;
  69.     case '\t':            /* ^I */
  70.     if (inplace)
  71.         str_set(stab_val(stab), inplace);
  72.     else
  73.         str_sset(stab_val(stab),&str_undef);
  74.     break;
  75.     case '\020':        /* ^P */
  76.     str_numset(stab_val(stab),(double)perldb);
  77.     break;
  78.     case '\024':        /* ^T */
  79.     str_numset(stab_val(stab),(double)basetime);
  80.     break;
  81.     case '\027':        /* ^W */
  82.     str_numset(stab_val(stab),(double)dowarn);
  83.     break;
  84.     case '1': case '2': case '3': case '4':
  85.     case '5': case '6': case '7': case '8': case '9': case '&':
  86.     if (curspat) {
  87.         paren = atoi(stab_name(stab));
  88.       getparen:
  89.         if (curspat->spat_regexp &&
  90.           paren <= curspat->spat_regexp->nparens &&
  91.           (s = curspat->spat_regexp->startp[paren]) ) {
  92.         i = curspat->spat_regexp->endp[paren] - s;
  93.         if (i >= 0)
  94.             str_nset(stab_val(stab),s,i);
  95.         else
  96.             str_sset(stab_val(stab),&str_undef);
  97.         }
  98.         else
  99.         str_sset(stab_val(stab),&str_undef);
  100.     }
  101.     break;
  102.     case '+':
  103.     if (curspat) {
  104.         paren = curspat->spat_regexp->lastparen;
  105.         goto getparen;
  106.     }
  107.     break;
  108.     case '`':
  109.     if (curspat) {
  110.         if (curspat->spat_regexp &&
  111.           (s = curspat->spat_regexp->subbeg) ) {
  112.         i = curspat->spat_regexp->startp[0] - s;
  113.         if (i >= 0)
  114.             str_nset(stab_val(stab),s,i);
  115.         else
  116.             str_nset(stab_val(stab),"",0);
  117.         }
  118.         else
  119.         str_nset(stab_val(stab),"",0);
  120.     }
  121.     break;
  122.     case '\'':
  123.     if (curspat) {
  124.         if (curspat->spat_regexp &&
  125.           (s = curspat->spat_regexp->endp[0]) ) {
  126.         str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
  127.         }
  128.         else
  129.         str_nset(stab_val(stab),"",0);
  130.     }
  131.     break;
  132.     case '.':
  133. #ifndef lint
  134.     if (last_in_stab) {
  135.         str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
  136.     }
  137. #endif
  138.     break;
  139.     case '?':
  140.     str_numset(stab_val(stab),(double)statusvalue);
  141.     break;
  142.     case '^':
  143.     s = stab_io(curoutstab)->top_name;
  144.     if (s)
  145.         str_set(stab_val(stab),s);
  146.     else {
  147.         str_set(stab_val(stab),stab_name(curoutstab));
  148.         str_cat(stab_val(stab),"_TOP");
  149.     }
  150.     break;
  151.     case '~':
  152.     s = stab_io(curoutstab)->fmt_name;
  153.     if (!s)
  154.         s = stab_name(curoutstab);
  155.     str_set(stab_val(stab),s);
  156.     break;
  157. #ifndef lint
  158.     case '=':
  159.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
  160.     break;
  161.     case '-':
  162.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
  163.     break;
  164.     case '%':
  165.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
  166.     break;
  167. #endif
  168.     case '/':
  169.     break;
  170.     case '[':
  171.     str_numset(stab_val(stab),(double)arybase);
  172.     break;
  173.     case '|':
  174.     if (!stab_io(curoutstab))
  175.         stab_io(curoutstab) = stio_new();
  176.     str_numset(stab_val(stab),
  177.        (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
  178.     break;
  179.     case ',':
  180.     str_nset(stab_val(stab),ofs,ofslen);
  181.     break;
  182.     case '\\':
  183.     str_nset(stab_val(stab),ors,orslen);
  184.     break;
  185.     case '#':
  186.     str_set(stab_val(stab),ofmt);
  187.     break;
  188.     case '!':
  189.     str_numset(stab_val(stab), (double)errno);
  190.     str_set(stab_val(stab), errno ? strerror(errno) : "");
  191.     stab_val(stab)->str_nok = 1;    /* what a wonderful hack! */
  192.     break;
  193.     case '<':
  194.     str_numset(stab_val(stab),(double)uid);
  195.     break;
  196.     case '>':
  197.     str_numset(stab_val(stab),(double)euid);
  198.     break;
  199.     case '(':
  200.     s = buf;
  201.     (void)sprintf(s,"%d",(int)gid);
  202.     goto add_groups;
  203.     case ')':
  204.     s = buf;
  205.     (void)sprintf(s,"%d",(int)egid);
  206.       add_groups:
  207.     while (*s) s++;
  208. #ifdef HAS_GETGROUPS
  209. #ifndef NGROUPS
  210. #define NGROUPS 32
  211. #endif
  212.     {
  213.         GROUPSTYPE gary[NGROUPS];
  214.  
  215.         i = getgroups(NGROUPS,gary);
  216.         while (--i >= 0) {
  217.         (void)sprintf(s," %ld", (long)gary[i]);
  218.         while (*s) s++;
  219.         }
  220.     }
  221. #endif
  222.     str_set(stab_val(stab),buf);
  223.     break;
  224.     case '*':
  225.     break;
  226.     case '0':
  227.     break;
  228.     default:
  229.     {
  230.         struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
  231.  
  232.         if (uf && uf->uf_val)
  233.         (*uf->uf_val)(uf->uf_index, stab_val(stab));
  234.     }
  235.     break;
  236.     }
  237.     return stab_val(stab);
  238. }
  239.  
  240. STRLEN
  241. stab_len(str)
  242. STR *str;
  243. {
  244.     STAB *stab = str->str_u.str_stab;
  245.     int paren;
  246.     int i;
  247.     char *s;
  248.  
  249.     if (str->str_rare)
  250.     return stab_val(stab)->str_cur;
  251.  
  252.     switch (*stab->str_magic->str_ptr) {
  253.     case '1': case '2': case '3': case '4':
  254.     case '5': case '6': case '7': case '8': case '9': case '&':
  255.     if (curspat) {
  256.         paren = atoi(stab_name(stab));
  257.       getparen:
  258.         if (curspat->spat_regexp &&
  259.           paren <= curspat->spat_regexp->nparens &&
  260.           (s = curspat->spat_regexp->startp[paren]) ) {
  261.         i = curspat->spat_regexp->endp[paren] - s;
  262.         if (i >= 0)
  263.             return i;
  264.         else
  265.             return 0;
  266.         }
  267.         else
  268.         return 0;
  269.     }
  270.     break;
  271.     case '+':
  272.     if (curspat) {
  273.         paren = curspat->spat_regexp->lastparen;
  274.         goto getparen;
  275.     }
  276.     break;
  277.     case '`':
  278.     if (curspat) {
  279.         if (curspat->spat_regexp &&
  280.           (s = curspat->spat_regexp->subbeg) ) {
  281.         i = curspat->spat_regexp->startp[0] - s;
  282.         if (i >= 0)
  283.             return i;
  284.         else
  285.             return 0;
  286.         }
  287.         else
  288.         return 0;
  289.     }
  290.     break;
  291.     case '\'':
  292.     if (curspat) {
  293.         if (curspat->spat_regexp &&
  294.           (s = curspat->spat_regexp->endp[0]) ) {
  295.         return (STRLEN) (curspat->spat_regexp->subend - s);
  296.         }
  297.         else
  298.         return 0;
  299.     }
  300.     break;
  301.     case ',':
  302.     return (STRLEN)ofslen;
  303.     case '\\':
  304.     return (STRLEN)orslen;
  305.     default:
  306.     return stab_str(str)->str_cur;
  307.     }
  308. }
  309.  
  310. stabset(mstr,str)
  311. register STR *mstr;
  312. STR *str;
  313. {
  314.     STAB *stab = mstr->str_u.str_stab;
  315.     register char *s;
  316.     int i;
  317.  
  318.     switch (mstr->str_rare) {
  319.     case 'E':
  320.     setenv(mstr->str_ptr,str_get(str));
  321.                 /* And you'll never guess what the dog had */
  322.                 /*   in its mouth... */
  323. #ifdef TAINT
  324.     if (strEQ(mstr->str_ptr,"PATH")) {
  325.         char *strend = str->str_ptr + str->str_cur;
  326.  
  327.         s = str->str_ptr;
  328.         while (s < strend) {
  329.         s = cpytill(tokenbuf,s,strend,':',&i);
  330.         s++;
  331.         if (*tokenbuf != '/'
  332.           || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
  333.             str->str_tainted = 2;
  334.         }
  335.     }
  336. #endif
  337.     break;
  338.     case 'S':
  339.     s = str_get(str);
  340.     i = whichsig(mstr->str_ptr);    /* ...no, a brick */
  341.     if (strEQ(s,"IGNORE"))
  342. #ifndef lint
  343.         (void)signal(i,SIG_IGN);
  344. #else
  345.         ;
  346. #endif
  347.     else if (strEQ(s,"DEFAULT") || !*s)
  348.         (void)signal(i,SIG_DFL);
  349.     else {
  350.         (void)signal(i,sighandler);
  351.         if (!index(s,'\'')) {
  352.         sprintf(tokenbuf, "main'%s",s);
  353.         str_set(str,tokenbuf);
  354.         }
  355.     }
  356.     break;
  357. #ifdef SOME_DBM
  358.     case 'D':
  359.     hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
  360.     break;
  361. #endif
  362.     case 'L':
  363.     {
  364.         CMD *cmd;
  365.  
  366.         i = str_true(str);
  367.         str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE);
  368.         cmd = str->str_magic->str_u.str_cmd;
  369.         cmd->c_flags &= ~CF_OPTIMIZE;
  370.         cmd->c_flags |= i? CFT_D1 : CFT_D0;
  371.     }
  372.     break;
  373.     case '#':
  374.     afill(stab_array(stab), (int)str_gnum(str) - arybase);
  375.     break;
  376.     case 'X':    /* merely a copy of a * string */
  377.     break;
  378.     case '*':
  379.     s = str_get(str);
  380.     if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
  381.         if (!*s) {
  382.         STBP *stbp;
  383.  
  384.         (void)savenostab(stab);    /* schedule a free of this stab */
  385.         if (stab->str_len)
  386.             Safefree(stab->str_ptr);
  387.         Newz(601,stbp, 1, STBP);
  388.         stab->str_ptr = stbp;
  389.         stab->str_len = stab->str_cur = sizeof(STBP);
  390.         stab->str_pok = 1;
  391.         strcpy(stab_magic(stab),"StB");
  392.         stab_val(stab) = Str_new(70,0);
  393.         stab_line(stab) = curcmd->c_line;
  394.         stab_stash(stab) = curcmd->c_stash;
  395.         }
  396.         else {
  397.         stab = stabent(s,TRUE);
  398.         if (!stab_xarray(stab))
  399.             aadd(stab);
  400.         if (!stab_xhash(stab))
  401.             hadd(stab);
  402.         if (!stab_io(stab))
  403.             stab_io(stab) = stio_new();
  404.         }
  405.         str_sset(str,stab);
  406.     }
  407.     break;
  408.     case 's': {
  409.         struct lstring *lstr = (struct lstring*)str;
  410.         char *tmps;
  411.  
  412.         mstr->str_rare = 0;
  413.         str->str_magic = Nullstr;
  414.         tmps = str_get(str);
  415.         str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
  416.           tmps,str->str_cur);
  417.     }
  418.     break;
  419.  
  420.     case 'v':
  421.     do_vecset(mstr,str);
  422.     break;
  423.  
  424.     case 0:
  425.     switch (*stab->str_magic->str_ptr) {
  426.     case '\004':    /* ^D */
  427. #ifdef DEBUGGING
  428.         debug = (int)(str_gnum(str)) | 32768;
  429.         if (debug & 1024)
  430.         dump_all();
  431. #endif
  432.         break;
  433.     case '\006':    /* ^F */
  434.         maxsysfd = (int)str_gnum(str);
  435.         break;
  436.     case '\t':    /* ^I */
  437.         if (inplace)
  438.         Safefree(inplace);
  439.         if (str->str_pok || str->str_nok)
  440.         inplace = savestr(str_get(str));
  441.         else
  442.         inplace = Nullch;
  443.         break;
  444.     case '\020':    /* ^P */
  445.         perldb = (int)str_gnum(str);
  446.         break;
  447.     case '\024':    /* ^T */
  448.         basetime = (long)str_gnum(str);
  449.         break;
  450.     case '\027':    /* ^W */
  451.         dowarn = (bool)str_gnum(str);
  452.         break;
  453.     case '.':
  454.         if (localizing)
  455.         savesptr((STR**)&last_in_stab);
  456.         break;
  457.     case '^':
  458.         Safefree(stab_io(curoutstab)->top_name);
  459.         stab_io(curoutstab)->top_name = s = savestr(str_get(str));
  460.         stab_io(curoutstab)->top_stab = stabent(s,TRUE);
  461.         break;
  462.     case '~':
  463.         Safefree(stab_io(curoutstab)->fmt_name);
  464.         stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
  465.         stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
  466.         break;
  467.     case '=':
  468.         stab_io(curoutstab)->page_len = (long)str_gnum(str);
  469.         break;
  470.     case '-':
  471.         stab_io(curoutstab)->lines_left = (long)str_gnum(str);
  472.         if (stab_io(curoutstab)->lines_left < 0L)
  473.         stab_io(curoutstab)->lines_left = 0L;
  474.         break;
  475.     case '%':
  476.         stab_io(curoutstab)->page = (long)str_gnum(str);
  477.         break;
  478.     case '|':
  479.         if (!stab_io(curoutstab))
  480.         stab_io(curoutstab) = stio_new();
  481.         stab_io(curoutstab)->flags &= ~IOF_FLUSH;
  482.         if (str_gnum(str) != 0.0) {
  483.         stab_io(curoutstab)->flags |= IOF_FLUSH;
  484.         }
  485.         break;
  486.     case '*':
  487.         i = (int)str_gnum(str);
  488.         multiline = (i != 0);
  489.         break;
  490.     case '/':
  491.         if (str->str_pok) {
  492.         rs = str_get(str);
  493.         rslen = str->str_cur;
  494.         if (!rslen) {
  495.             rs = "\n\n";
  496.             rslen = 2;
  497.         }
  498.         rschar = rs[rslen - 1];
  499.         }
  500.         else {
  501.         rschar = 0777;    /* fake a non-existent char */
  502.         rslen = 1;
  503.         }
  504.         break;
  505.     case '\\':
  506.         if (ors)
  507.         Safefree(ors);
  508.         ors = savestr(str_get(str));
  509.         orslen = str->str_cur;
  510.         break;
  511.     case ',':
  512.         if (ofs)
  513.         Safefree(ofs);
  514.         ofs = savestr(str_get(str));
  515.         ofslen = str->str_cur;
  516.         break;
  517.     case '#':
  518.         if (ofmt)
  519.         Safefree(ofmt);
  520.         ofmt = savestr(str_get(str));
  521.         break;
  522.     case '[':
  523.         arybase = (int)str_gnum(str);
  524.         break;
  525.     case '?':
  526.         statusvalue = U_S(str_gnum(str));
  527.         break;
  528.     case '!':
  529.         errno = (int)str_gnum(str);        /* will anyone ever use this? */
  530.         break;
  531.     case '<':
  532.         uid = (int)str_gnum(str);
  533. #if defined(HAS_SETREUID) || !defined(HAS_SETRUID)
  534.         if (delaymagic) {
  535.         delaymagic |= DM_REUID;
  536.         break;                /* don't do magic till later */
  537.         }
  538. #endif /* HAS_SETREUID or not HASSETRUID */
  539. #ifdef HAS_SETRUID
  540.         if (setruid((UIDTYPE)uid) < 0)
  541.         uid = (int)getuid();
  542. #else
  543. #ifdef HAS_SETREUID
  544.         if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
  545.         uid = (int)getuid();
  546. #else
  547.         if (uid == euid)        /* special case $< = $> */
  548.         setuid(uid);
  549.         else
  550.         fatal("setruid() not implemented");
  551. #endif
  552. #endif
  553.         break;
  554.     case '>':
  555.         euid = (int)str_gnum(str);
  556. #if defined(HAS_SETREUID) || !defined(HAS_SETEUID)
  557.         if (delaymagic) {
  558.         delaymagic |= DM_REUID;
  559.         break;                /* don't do magic till later */
  560.         }
  561. #endif /* HAS_SETREUID or not HAS_SETEUID */
  562. #ifdef HAS_SETEUID
  563.         if (seteuid((UIDTYPE)euid) < 0)
  564.         euid = (int)geteuid();
  565. #else
  566. #ifdef HAS_SETREUID
  567.         if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
  568.         euid = (int)geteuid();
  569. #else
  570.         if (euid == uid)        /* special case $> = $< */
  571.         setuid(euid);
  572.         else
  573.         fatal("seteuid() not implemented");
  574. #endif
  575. #endif
  576.         break;
  577.     case '(':
  578.         gid = (int)str_gnum(str);
  579. #if defined(HAS_SETREGID) || !defined(HAS_SETRGID)
  580.         if (delaymagic) {
  581.         delaymagic |= DM_REGID;
  582.         break;                /* don't do magic till later */
  583.         }
  584. #endif /* HAS_SETREGID or not HAS_SETRGID */
  585. #ifdef HAS_SETRGID
  586.         (void)setrgid((GIDTYPE)gid);
  587. #else
  588. #ifdef HAS_SETREGID
  589.         (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
  590. #else
  591.         fatal("setrgid() not implemented");
  592. #endif
  593. #endif
  594.         break;
  595.     case ')':
  596.         egid = (int)str_gnum(str);
  597. #if defined(HAS_SETREGID) || !defined(HAS_SETEGID)
  598.         if (delaymagic) {
  599.         delaymagic |= DM_REGID;
  600.         break;                /* don't do magic till later */
  601.         }
  602. #endif /* HAS_SETREGID or not HAS_SETEGID */
  603. #ifdef HAS_SETEGID
  604.         (void)setegid((GIDTYPE)egid);
  605. #else
  606. #ifdef HAS_SETREGID
  607.         (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
  608. #else
  609.         fatal("setegid() not implemented");
  610. #endif
  611. #endif
  612.         break;
  613.     case ':':
  614.         chopset = str_get(str);
  615.         break;
  616.     case '0':
  617.         if (!origalen) {
  618.         s = origargv[0];
  619.         s += strlen(s);
  620.         /* See if all the arguments are contiguous in memory */
  621.         for (i = 1; i < origargc; i++) {
  622.             if (origargv[i] == s + 1)
  623.             s += strlen(++s);    /* this one is ok too */
  624.         }
  625.         if (origenviron[0] == s + 1) {    /* can grab env area too? */
  626.             setenv("NoNeSuCh", Nullch);    /* force copy of environment */
  627.             for (i = 0; origenviron[i]; i++)
  628.             if (origenviron[i] == s + 1)
  629.                 s += strlen(++s);
  630.         }
  631.         origalen = s - origargv[0];
  632.         }
  633.         s = str_get(str);
  634.         i = str->str_cur;
  635.         if (i >= origalen) {
  636.         i = origalen;
  637.         str->str_cur = i;
  638.         str->str_ptr[i] = '\0';
  639.         bcopy(s, origargv[0], i);
  640.         }
  641.         else {
  642.         bcopy(s, origargv[0], i);
  643.         s = origargv[0]+i;
  644.         *s++ = '\0';
  645.         while (++i < origalen)
  646.             *s++ = ' ';
  647.         }
  648.         break;
  649.     default:
  650.         {
  651.         struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
  652.  
  653.         if (uf && uf->uf_set)
  654.             (*uf->uf_set)(uf->uf_index, str);
  655.         }
  656.         break;
  657.     }
  658.     break;
  659.     }
  660. }
  661.  
  662. whichsig(sig)
  663. char *sig;
  664. {
  665.     register char **sigv;
  666.  
  667.     for (sigv = sig_name+1; *sigv; sigv++)
  668.     if (strEQ(sig,*sigv))
  669.         return sigv - sig_name;
  670. #ifdef SIGCLD
  671.     if (strEQ(sig,"CHLD"))
  672.     return SIGCLD;
  673. #endif
  674. #ifdef SIGCHLD
  675.     if (strEQ(sig,"CLD"))
  676.     return SIGCHLD;
  677. #endif
  678.     return 0;
  679. }
  680.  
  681. static handlertype
  682. sighandler(sig)
  683. int sig;
  684. {
  685.     STAB *stab;
  686.     STR *str;
  687.     int oldsave = savestack->ary_fill;
  688.     int oldtmps_base = tmps_base;
  689.     register CSV *csv;
  690.     SUBR *sub;
  691.  
  692. #ifdef OS2        /* or anybody else who requires SIG_ACK */
  693.     signal(sig, SIG_ACK);
  694. #endif
  695.     stab = stabent(
  696.     str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
  697.       TRUE)), TRUE);
  698.     sub = stab_sub(stab);
  699.     if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
  700.     if (sig_name[sig][1] == 'H')
  701.         stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
  702.           TRUE);
  703.     else
  704.         stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
  705.           TRUE);
  706.     sub = stab_sub(stab);    /* gag */
  707.     }
  708.     if (!sub) {
  709.     if (dowarn)
  710.         warn("SIG%s handler \"%s\" not defined.\n",
  711.         sig_name[sig], stab_name(stab) );
  712.     return;
  713.     }
  714.     saveaptr(&stack);
  715.     str = Str_new(15, sizeof(CSV));
  716.     str->str_state = SS_SCSV;
  717.     (void)apush(savestack,str);
  718.     csv = (CSV*)str->str_ptr;
  719.     csv->sub = sub;
  720.     csv->stab = stab;
  721.     csv->curcsv = curcsv;
  722.     csv->curcmd = curcmd;
  723.     csv->depth = sub->depth;
  724.     csv->wantarray = G_SCALAR;
  725.     csv->hasargs = TRUE;
  726.     csv->savearray = stab_xarray(defstab);
  727.     csv->argarray = stab_xarray(defstab) = stack = anew(defstab);
  728.     stack->ary_flags = 0;
  729.     curcsv = csv;
  730.     str = str_mortal(&str_undef);
  731.     str_set(str,sig_name[sig]);
  732.     (void)apush(stab_xarray(defstab),str);
  733.     sub->depth++;
  734.     if (sub->depth >= 2) {    /* save temporaries on recursion? */
  735.     if (sub->depth == 100 && dowarn)
  736.         warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
  737.     savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
  738.     }
  739.  
  740.     tmps_base = tmps_max;        /* protect our mortal string */
  741.     (void)cmd_exec(sub->cmd,G_SCALAR,0);        /* so do it already */
  742.     tmps_base = oldtmps_base;
  743.  
  744.     restorelist(oldsave);        /* put everything back */
  745. }
  746.  
  747. STAB *
  748. aadd(stab)
  749. register STAB *stab;
  750. {
  751.     if (!stab_xarray(stab))
  752.     stab_xarray(stab) = anew(stab);
  753.     return stab;
  754. }
  755.  
  756. STAB *
  757. hadd(stab)
  758. register STAB *stab;
  759. {
  760.     if (!stab_xhash(stab))
  761.     stab_xhash(stab) = hnew(COEFFSIZE);
  762.     return stab;
  763. }
  764.  
  765. STAB *
  766. fstab(name)
  767. char *name;
  768. {
  769.     char tmpbuf[1200];
  770.     STAB *stab;
  771.  
  772.     sprintf(tmpbuf,"'_<%s", name);
  773.     stab = stabent(tmpbuf, TRUE);
  774.     str_set(stab_val(stab), name);
  775.     if (perldb)
  776.     (void)hadd(aadd(stab));
  777.     return stab;
  778. }
  779.  
  780. STAB *
  781. stabent(name,add)
  782. register char *name;
  783. int add;
  784. {
  785.     register STAB *stab;
  786.     register STBP *stbp;
  787.     int len;
  788.     register char *namend;
  789.     HASH *stash;
  790.     char *sawquote = Nullch;
  791.     char *prevquote = Nullch;
  792.     bool global = FALSE;
  793.  
  794.     if (isascii(*name) && isupper(*name)) {
  795.     if (*name > 'I') {
  796.         if (*name == 'S' && (
  797.           strEQ(name, "SIG") ||
  798.           strEQ(name, "STDIN") ||
  799.           strEQ(name, "STDOUT") ||
  800.           strEQ(name, "STDERR") ))
  801.         global = TRUE;
  802.     }
  803.     else if (*name > 'E') {
  804.         if (*name == 'I' && strEQ(name, "INC"))
  805.         global = TRUE;
  806.     }
  807.     else if (*name > 'A') {
  808.         if (*name == 'E' && strEQ(name, "ENV"))
  809.         global = TRUE;
  810.     }
  811.     else if (*name == 'A' && (
  812.       strEQ(name, "ARGV") ||
  813.       strEQ(name, "ARGVOUT") ))
  814.         global = TRUE;
  815.     }
  816.     for (namend = name; *namend; namend++) {
  817.     if (*namend == '\'' && namend[1])
  818.         prevquote = sawquote, sawquote = namend;
  819.     }
  820.     if (sawquote == name && name[1]) {
  821.     stash = defstash;
  822.     sawquote = Nullch;
  823.     name++;
  824.     }
  825.     else if (!isalpha(*name) || global)
  826.     stash = defstash;
  827.     else if (curcmd == &compiling)
  828.     stash = curstash;
  829.     else
  830.     stash = curcmd->c_stash;
  831.     if (sawquote) {
  832.     char tmpbuf[256];
  833.     char *s, *d;
  834.  
  835.     *sawquote = '\0';
  836.     if (s = prevquote) {
  837.         strncpy(tmpbuf,name,s-name+1);
  838.         d = tmpbuf+(s-name+1);
  839.         *d++ = '_';
  840.         strcpy(d,s+1);
  841.     }
  842.     else {
  843.         *tmpbuf = '_';
  844.         strcpy(tmpbuf+1,name);
  845.     }
  846.     stab = stabent(tmpbuf,TRUE);
  847.     if (!(stash = stab_xhash(stab)))
  848.         stash = stab_xhash(stab) = hnew(0);
  849.     if (!stash->tbl_name)
  850.         stash->tbl_name = savestr(name);
  851.     name = sawquote+1;
  852.     *sawquote = '\'';
  853.     }
  854.     len = namend - name;
  855.     stab = (STAB*)hfetch(stash,name,len,add);
  856.     if (stab == (STAB*)&str_undef)
  857.     return Nullstab;
  858.     if (stab->str_pok) {
  859.     stab->str_pok |= SP_MULTI;
  860.     return stab;
  861.     }
  862.     else {
  863.     if (stab->str_len)
  864.         Safefree(stab->str_ptr);
  865.     Newz(602,stbp, 1, STBP);
  866.     stab->str_ptr = stbp;
  867.     stab->str_len = stab->str_cur = sizeof(STBP);
  868.     stab->str_pok = 1;
  869.     strcpy(stab_magic(stab),"StB");
  870.     stab_val(stab) = Str_new(72,0);
  871.     stab_line(stab) = curcmd->c_line;
  872.     str_magic(stab,stab,'*',name,len);
  873.     stab_stash(stab) = stash;
  874.     if (isdigit(*name) && *name != '0') {
  875.         stab_flags(stab) = SF_VMAGIC;
  876.         str_magic(stab_val(stab), stab, 0, Nullch, 0);
  877.     }
  878.     return stab;
  879.     }
  880. }
  881.  
  882. stab_fullname(str,stab)
  883. STR *str;
  884. STAB *stab;
  885. {
  886.     HASH *tb = stab_stash(stab);
  887.  
  888.     if (!tb)
  889.     return;
  890.     str_set(str,tb->tbl_name);
  891.     str_ncat(str,"'", 1);
  892.     str_scat(str,stab->str_magic);
  893. }
  894.  
  895. STIO *
  896. stio_new()
  897. {
  898.     STIO *stio;
  899.  
  900.     Newz(603,stio,1,STIO);
  901.     stio->page_len = 60;
  902.     return stio;
  903. }
  904.  
  905. stab_check(min,max)
  906. int min;
  907. register int max;
  908. {
  909.     register HENT *entry;
  910.     register int i;
  911.     register STAB *stab;
  912.  
  913.     for (i = min; i <= max; i++) {
  914.     for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
  915.         stab = (STAB*)entry->hent_val;
  916.         if (stab->str_pok & SP_MULTI)
  917.         continue;
  918.         curcmd->c_line = stab_line(stab);
  919.         warn("Possible typo: \"%s\"", stab_name(stab));
  920.     }
  921.     }
  922. }
  923.  
  924. static int gensym = 0;
  925.  
  926. STAB *
  927. genstab()
  928. {
  929.     (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
  930.     return stabent(tokenbuf,TRUE);
  931. }
  932.  
  933. /* hopefully this is only called on local symbol table entries */
  934.  
  935. void
  936. stab_clear(stab)
  937. register STAB *stab;
  938. {
  939.     STIO *stio;
  940.     SUBR *sub;
  941.  
  942.     afree(stab_xarray(stab));
  943.     stab_xarray(stab) = Null(ARRAY*);
  944.     (void)hfree(stab_xhash(stab), FALSE);
  945.     stab_xhash(stab) = Null(HASH*);
  946.     str_free(stab_val(stab));
  947.     stab_val(stab) = Nullstr;
  948.     if (stio = stab_io(stab)) {
  949.     do_close(stab,FALSE);
  950.     Safefree(stio->top_name);
  951.     Safefree(stio->fmt_name);
  952.     }
  953.     if (sub = stab_sub(stab)) {
  954.     afree(sub->tosave);
  955.     cmd_free(sub->cmd);
  956.     }
  957.     Safefree(stab->str_ptr);
  958.     stab->str_ptr = Null(STBP*);
  959.     stab->str_len = 0;
  960.     stab->str_cur = 0;
  961. }
  962.  
  963. #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
  964. #define MICROPORT
  965. #endif
  966.  
  967. #ifdef    MICROPORT    /* Microport 2.4 hack */
  968. ARRAY *stab_array(stab)
  969. register STAB *stab;
  970. {
  971.     if (((STBP*)(stab->str_ptr))->stbp_array)
  972.     return ((STBP*)(stab->str_ptr))->stbp_array;
  973.     else
  974.     return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
  975. }
  976.  
  977. HASH *stab_hash(stab)
  978. register STAB *stab;
  979. {
  980.     if (((STBP*)(stab->str_ptr))->stbp_hash)
  981.     return ((STBP*)(stab->str_ptr))->stbp_hash;
  982.     else
  983.     return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
  984. }
  985. #endif            /* Microport 2.4 hack */
  986.