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