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