home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / perl / Source / Xc / Evalargs
Encoding:
Text File  |  1991-02-09  |  11.0 KB  |  441 lines
  1. /* This file is included by eval.c.  It's separate from eval.c to keep
  2.  * kit sizes from getting too big.
  3.  */
  4.  
  5. /* $Header: evalargs.xc,v 3.0.1.9 91/01/11 18:00:18 lwall Locked $
  6.  *
  7.  * $Log:    evalargs.xc,v $
  8.  * Revision 3.0.1.9  91/01/11  18:00:18  lwall
  9.  * patch42: <> input to individual array elements was suboptimal
  10.  * 
  11.  * Revision 3.0.1.8  90/11/10  01:35:49  lwall
  12.  * patch38: array slurps are now faster and take less memory
  13.  * 
  14.  * Revision 3.0.1.7  90/10/15  16:48:11  lwall
  15.  * patch29: non-existent array values no longer cause core dumps
  16.  * patch29: added caller
  17.  * 
  18.  * Revision 3.0.1.6  90/08/09  03:37:15  lwall
  19.  * patch19: passing *name to subroutine now forces filehandle and array creation
  20.  * patch19: `command` in array context now returns array of lines
  21.  * patch19: <handle> input is a little more efficient
  22.  * 
  23.  * Revision 3.0.1.5  90/03/27  15:54:42  lwall
  24.  * patch16: MSDOS support
  25.  * 
  26.  * Revision 3.0.1.4  90/02/28  17:38:37  lwall
  27.  * patch9: $#foo -= 2 didn't work
  28.  * 
  29.  * Revision 3.0.1.3  89/11/17  15:25:07  lwall
  30.  * patch5: constant numeric subscripts disappeared in ?:
  31.  * 
  32.  * Revision 3.0.1.2  89/11/11  04:33:05  lwall
  33.  * patch2: Configure now locates csh
  34.  * 
  35.  * Revision 3.0.1.1  89/10/26  23:12:55  lwall
  36.  * patch1: glob didn't free a temporary string
  37.  * 
  38.  * Revision 3.0  89/10/18  15:17:16  lwall
  39.  * 3.0 baseline
  40.  * 
  41.  */
  42.  
  43.     for (anum = 1; anum <= maxarg; anum++) {
  44.     argflags = arg[anum].arg_flags;
  45.     argtype = arg[anum].arg_type;
  46.     argptr = arg[anum].arg_ptr;
  47.       re_eval:
  48.     switch (argtype) {
  49.     default:
  50.         st[++sp] = &str_undef;
  51. #ifdef DEBUGGING
  52.         tmps = "NULL";
  53. #endif
  54.         break;
  55.     case A_EXPR:
  56. #ifdef DEBUGGING
  57.         if (debug & 8) {
  58.         tmps = "EXPR";
  59.         deb("%d.EXPR =>\n",anum);
  60.         }
  61. #endif
  62.         sp = eval(argptr.arg_arg,
  63.         (argflags & AF_ARYOK) ? G_ARRAY : G_SCALAR, sp);
  64.         if (sp + (maxarg - anum) > stack->ary_max)
  65.         astore(stack, sp + (maxarg - anum), Nullstr);
  66.         st = stack->ary_array;    /* possibly reallocated */
  67.         break;
  68.     case A_CMD:
  69. #ifdef DEBUGGING
  70.         if (debug & 8) {
  71.         tmps = "CMD";
  72.         deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd);
  73.         }
  74. #endif
  75.         sp = cmd_exec(argptr.arg_cmd, gimme, sp);
  76.         if (sp + (maxarg - anum) > stack->ary_max)
  77.         astore(stack, sp + (maxarg - anum), Nullstr);
  78.         st = stack->ary_array;    /* possibly reallocated */
  79.         break;
  80.     case A_LARYSTAB:
  81.         ++sp;
  82.         switch (optype) {
  83.         case O_ITEM2: argtype = 2; break;
  84.         case O_ITEM3: argtype = 3; break;
  85.         default:      argtype = anum; break;
  86.         }
  87.         str = afetch(stab_array(argptr.arg_stab),
  88.         arg[argtype].arg_len - arybase, TRUE);
  89. #ifdef DEBUGGING
  90.         if (debug & 8) {
  91.         (void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
  92.             arg[argtype].arg_len);
  93.         tmps = buf;
  94.         }
  95. #endif
  96.         goto do_crement;
  97.     case A_ARYSTAB:
  98.         switch (optype) {
  99.         case O_ITEM2: argtype = 2; break;
  100.         case O_ITEM3: argtype = 3; break;
  101.         default:      argtype = anum; break;
  102.         }
  103.         st[++sp] = afetch(stab_array(argptr.arg_stab),
  104.         arg[argtype].arg_len - arybase, FALSE);
  105. #ifdef DEBUGGING
  106.         if (debug & 8) {
  107.         (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
  108.             arg[argtype].arg_len);
  109.         tmps = buf;
  110.         }
  111. #endif
  112.         break;
  113.     case A_STAR:
  114.         stab = argptr.arg_stab;
  115.         st[++sp] = (STR*)stab;
  116.         if (!stab_xarray(stab))
  117.         aadd(stab);
  118.         if (!stab_xhash(stab))
  119.         hadd(stab);
  120.         if (!stab_io(stab))
  121.         stab_io(stab) = stio_new();
  122. #ifdef DEBUGGING
  123.         if (debug & 8) {
  124.         (void)sprintf(buf,"STAR *%s",stab_name(argptr.arg_stab));
  125.         tmps = buf;
  126.         }
  127. #endif
  128.         break;
  129.     case A_LSTAR:
  130.         str = st[++sp] = (STR*)argptr.arg_stab;
  131. #ifdef DEBUGGING
  132.         if (debug & 8) {
  133.         (void)sprintf(buf,"LSTAR *%s",stab_name(argptr.arg_stab));
  134.         tmps = buf;
  135.         }
  136. #endif
  137.         break;
  138.     case A_STAB:
  139.         st[++sp] = STAB_STR(argptr.arg_stab);
  140. #ifdef DEBUGGING
  141.         if (debug & 8) {
  142.         (void)sprintf(buf,"STAB $%s",stab_name(argptr.arg_stab));
  143.         tmps = buf;
  144.         }
  145. #endif
  146.         break;
  147.     case A_LEXPR:
  148. #ifdef DEBUGGING
  149.         if (debug & 8) {
  150.         tmps = "LEXPR";
  151.         deb("%d.LEXPR =>\n",anum);
  152.         }
  153. #endif
  154.         if (argflags & AF_ARYOK) {
  155.         sp = eval(argptr.arg_arg, G_ARRAY, sp);
  156.         if (sp + (maxarg - anum) > stack->ary_max)
  157.             astore(stack, sp + (maxarg - anum), Nullstr);
  158.         st = stack->ary_array;    /* possibly reallocated */
  159.         }
  160.         else {
  161.         sp = eval(argptr.arg_arg, G_SCALAR, sp);
  162.         st = stack->ary_array;    /* possibly reallocated */
  163.         str = st[sp];
  164.         goto do_crement;
  165.         }
  166.         break;
  167.     case A_LVAL:
  168. #ifdef DEBUGGING
  169.         if (debug & 8) {
  170.         (void)sprintf(buf,"LVAL $%s",stab_name(argptr.arg_stab));
  171.         tmps = buf;
  172.         }
  173. #endif
  174.         ++sp;
  175.         str = STAB_STR(argptr.arg_stab);
  176.         if (!str)
  177.         fatal("panic: A_LVAL");
  178.       do_crement:
  179.         assigning = TRUE;
  180.         if (argflags & AF_PRE) {
  181.         if (argflags & AF_UP)
  182.             str_inc(str);
  183.         else
  184.             str_dec(str);
  185.         STABSET(str);
  186.         st[sp] = str;
  187.         str = arg->arg_ptr.arg_str;
  188.         }
  189.         else if (argflags & AF_POST) {
  190.         st[sp] = str_static(str);
  191.         if (argflags & AF_UP)
  192.             str_inc(str);
  193.         else
  194.             str_dec(str);
  195.         STABSET(str);
  196.         str = arg->arg_ptr.arg_str;
  197.         }
  198.         else
  199.         st[sp] = str;
  200.         break;
  201.     case A_LARYLEN:
  202.         ++sp;
  203.         stab = argptr.arg_stab;
  204.         str = stab_array(argptr.arg_stab)->ary_magic;
  205.         if (optype != O_SASSIGN || argflags & (AF_PRE|AF_POST))
  206.         str_numset(str,(double)(stab_array(stab)->ary_fill+arybase));
  207. #ifdef DEBUGGING
  208.         tmps = "LARYLEN";
  209. #endif
  210.         if (!str)
  211.         fatal("panic: A_LEXPR");
  212.         goto do_crement;
  213.     case A_ARYLEN:
  214.         stab = argptr.arg_stab;
  215.         st[++sp] = stab_array(stab)->ary_magic;
  216.         str_numset(st[sp],(double)(stab_array(stab)->ary_fill+arybase));
  217. #ifdef DEBUGGING
  218.         tmps = "ARYLEN";
  219. #endif
  220.         break;
  221.     case A_SINGLE:
  222.         st[++sp] = argptr.arg_str;
  223. #ifdef DEBUGGING
  224.         tmps = "SINGLE";
  225. #endif
  226.         break;
  227.     case A_DOUBLE:
  228.         (void) interp(str,argptr.arg_str,sp);
  229.         st = stack->ary_array;
  230.         st[++sp] = str;
  231. #ifdef DEBUGGING
  232.         tmps = "DOUBLE";
  233. #endif
  234.         break;
  235.     case A_BACKTICK:
  236.         tmps = savestr(str_get(interp(str,argptr.arg_str,sp)));
  237.         st = stack->ary_array;
  238. #ifdef TAINT
  239.         taintproper("Insecure dependency in ``");
  240. #endif
  241.         str_set(str,"");
  242.         tmps2 = tmps;
  243.         tmps3 = index(tmps, '\n');
  244.         do {
  245.         if (tmps3)
  246.             *tmps3 = 0;
  247.  
  248.         fp = mypopen(tmps2,"r");
  249.         if (fp) {
  250.             if (gimme == G_SCALAR) {
  251.             while (str_gets(str,fp,str->str_cur) != Nullch)
  252.                 ;
  253.             }
  254.             else {
  255.             for (;;) {
  256.                 if (++sp > stack->ary_max) {
  257.                 astore(stack, sp, Nullstr);
  258.                 st = stack->ary_array;
  259.                 }
  260.             str = st[sp] = Str_new(56,80);
  261.             if (str_gets(str,fp,0) == Nullch) {
  262.                 sp--;
  263.                 break;
  264.                 }
  265.                 if (str->str_len - str->str_cur > 20) {
  266.                 str->str_len = str->str_cur+1;
  267.                 Renew(str->str_ptr, str->str_len, char);
  268.                 }
  269.                 str_2static(str);
  270.             }
  271.             }
  272.             statusvalue = mypclose(fp);
  273.         }
  274.         else
  275.             statusvalue = -1;
  276.  
  277.         if (tmps3) {
  278.             *tmps3 = '\n';
  279.             tmps2 = tmps3 + 1;
  280.             tmps3 = index(tmps2, '\n');
  281.         }
  282.  
  283.         } while (tmps3);
  284.  
  285.         Safefree(tmps);
  286.         if (gimme == G_SCALAR)
  287.         st[++sp] = str;
  288. #ifdef DEBUGGING
  289.         tmps = "BACK";
  290. #endif
  291.         break;
  292.     case A_WANTARRAY:
  293.         {
  294.         if (curcsv->wantarray == G_ARRAY)
  295.             st[++sp] = &str_yes;
  296.         else
  297.             st[++sp] = &str_no;
  298.         }
  299. #ifdef DEBUGGING
  300.         tmps = "WANTARRAY";
  301. #endif
  302.         break;
  303.     case A_INDREAD:
  304.         last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE);
  305.         old_record_separator = record_separator;
  306.         goto do_read;
  307.     case A_GLOB:
  308.         argflags |= AF_POST;    /* enable newline chopping */
  309.         last_in_stab = argptr.arg_stab;
  310.         old_record_separator = record_separator;
  311.         record_separator = 0;
  312.         goto do_read;
  313.     case A_READ:
  314.         last_in_stab = argptr.arg_stab;
  315.         old_record_separator = record_separator;
  316.       do_read:
  317.         if (anum > 1)        /* assign to scalar */
  318.         gimme = G_SCALAR;    /* force context to scalar */
  319.         if (gimme == G_ARRAY)
  320.         str = Str_new(57,0);
  321.         ++sp;
  322.         fp = Nullfp;
  323.         if (stab_io(last_in_stab)) {
  324.         fp = stab_io(last_in_stab)->ifp;
  325.         if (!fp) {
  326.             if (stab_io(last_in_stab)->flags & IOF_ARGV) {
  327.             if (stab_io(last_in_stab)->flags & IOF_START) {
  328.                 stab_io(last_in_stab)->flags &= ~IOF_START;
  329.                 stab_io(last_in_stab)->lines = 0;
  330.                 if (alen(stab_array(last_in_stab)) < 0) {
  331.                 tmpstr = str_make("-",1); /* assume stdin */
  332.                 (void)apush(stab_array(last_in_stab), tmpstr);
  333.                 }
  334.             }
  335.             fp = nextargv(last_in_stab);
  336.             if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */
  337.                 (void)do_close(last_in_stab,FALSE); /* now it does*/
  338.                 stab_io(last_in_stab)->flags |= IOF_START;
  339.             }
  340.             }
  341.             else if (argtype == A_GLOB) {
  342.             (void) interp(str,stab_val(last_in_stab),sp);
  343.             st = stack->ary_array;
  344.             tmpstr = Str_new(55,0);
  345.  
  346.             str_set(tmpstr, "glob ");
  347.             str_scat(tmpstr,str);
  348.             str_cat(tmpstr," |");
  349.  
  350.             (void)do_open(last_in_stab,tmpstr->str_ptr,
  351.               tmpstr->str_cur);
  352.             fp = stab_io(last_in_stab)->ifp;
  353.             str_free(tmpstr);
  354.             }
  355.         }
  356.         }
  357.         if (!fp && dowarn)
  358.         warn("Read on closed filehandle <%s>",stab_name(last_in_stab));
  359.         when = str->str_len;    /* remember if already alloced */
  360.         if (!when)
  361.         Str_Grow(str,80);    /* try short-buffering it */
  362.       keepgoing:
  363.         if (!fp)
  364.         st[sp] = &str_undef;
  365.         else if (!str_gets(str,fp, optype == O_RCAT ? str->str_cur : 0)) {
  366.         clearerr(fp);
  367.         if (stab_io(last_in_stab)->flags & IOF_ARGV) {
  368.             fp = nextargv(last_in_stab);
  369.             if (fp)
  370.             goto keepgoing;
  371.             (void)do_close(last_in_stab,FALSE);
  372.             stab_io(last_in_stab)->flags |= IOF_START;
  373.         }
  374.         else if (argflags & AF_POST) {
  375.             (void)do_close(last_in_stab,FALSE);
  376.         }
  377.         st[sp] = &str_undef;
  378.         record_separator = old_record_separator;
  379.         if (gimme == G_ARRAY) {
  380.             --sp;
  381.             str_2static(str);
  382.             goto array_return;
  383.         }
  384.         break;
  385.         }
  386.         else {
  387.         stab_io(last_in_stab)->lines++;
  388.         st[sp] = str;
  389. #ifdef TAINT
  390.         str->str_tainted = 1; /* Anything from the outside world...*/
  391. #endif
  392.         if (argflags & AF_POST) {
  393.             if (str->str_cur > 0)
  394.             str->str_cur--;
  395.             if (str->str_ptr[str->str_cur] == record_separator)
  396.             str->str_ptr[str->str_cur] = '\0';
  397.             else
  398.             str->str_cur++;
  399.             for (tmps = str->str_ptr; *tmps; tmps++)
  400.             if (!isalpha(*tmps) && !isdigit(*tmps) &&
  401.                 index("$&*(){}[]'\";\\|?<>~`",*tmps))
  402.                 break;
  403.             if (*tmps && stat(str->str_ptr,&statbuf) < 0)
  404.             goto keepgoing;        /* unmatched wildcard? */
  405.         }
  406.         if (gimme == G_ARRAY) {
  407.             if (str->str_len - str->str_cur > 20) {
  408.             str->str_len = str->str_cur+1;
  409.             Renew(str->str_ptr, str->str_len, char);
  410.             }
  411.             str_2static(str);
  412.             if (++sp > stack->ary_max) {
  413.             astore(stack, sp, Nullstr);
  414.             st = stack->ary_array;
  415.             }
  416.             str = Str_new(58,80);
  417.             goto keepgoing;
  418.         }
  419.         else if (!when && str->str_len - str->str_cur > 80) {
  420.             /* try to reclaim a bit of scalar space on 1st alloc */
  421.             if (str->str_cur < 60)
  422.             str->str_len = 80;
  423.             else
  424.             str->str_len = str->str_cur+40;    /* allow some slop */
  425.             Renew(str->str_ptr, str->str_len, char);
  426.         }
  427.         }
  428.         record_separator = old_record_separator;
  429. #ifdef DEBUGGING
  430.         tmps = "READ";
  431. #endif
  432.         break;
  433.     }
  434. #ifdef DEBUGGING
  435.     if (debug & 8)
  436.         deb("%d.%s = '%s'\n",anum,tmps,str_peek(st[sp]));
  437. #endif
  438.     if (anum < 8)
  439.         arglast[anum] = sp;
  440.     }
  441.