perl 3.0 patch #22 patch #19, continued

[p5sagit/p5-mst-13.2.git] / consarg.c

diff --git a/consarg.c b/consarg.c
index b24322e..a7db58b 100644 (file)
--- a/consarg.c
+++ b/consarg.c
@@ -1,4 +1,4 @@
-/* $Header: consarg.c,v 3.0.1.1 89/11/11 04:14:30 lwall Locked $
+/* $Header: consarg.c,v 3.0.1.6 90/08/09 02:38:51 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,22 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       consarg.c,v $
+ * Revision 3.0.1.6  90/08/09  02:38:51  lwall
+ * patch19: fixed problem with % of negative number
+ * 
+ * Revision 3.0.1.5  90/03/27  15:36:45  lwall
+ * patch16: support for machines that can't cast negative floats to unsigned ints
+ * 
+ * Revision 3.0.1.4  90/03/12  16:24:40  lwall
+ * patch13: return (@array) did counter-intuitive things
+ * 
+ * Revision 3.0.1.3  90/02/28  16:47:54  lwall
+ * patch9: the x operator is now up to 10 times faster
+ * patch9: @_ clobbered by ($foo,$bar) = split
+ * 
+ * Revision 3.0.1.2  89/11/17  15:11:34  lwall
+ * patch5: defined $foo{'bar'} should not create element
+ * 
  * Revision 3.0.1.1  89/11/11  04:14:30  lwall
  * patch2: '-' x 26 made warnings about undefined value
  * patch2: eval with no args caused strangeness
@@ -47,6 +63,7 @@ ARG *limarg;
            arg_free(limarg);
        }
        else {
+           arg[3].arg_flags = 0;
            arg[3].arg_type = A_EXPR;
            arg[3].arg_ptr.arg_arg = limarg;
        }
@@ -295,7 +312,6 @@ register ARG *arg;
                arg->arg_len = 1;
                arg[1].arg_type = A_ARYSTAB;    /* $abc[123] is hoistable now */
                arg[1].arg_len = i;
-               arg[1].arg_ptr = arg[1].arg_ptr;        /* get stab pointer */
                str_free(s2);
            }
            /* FALL THROUGH */
@@ -309,9 +325,12 @@ register ARG *arg;
            break;
        case O_REPEAT:
            i = (int)str_gnum(s2);
+           tmps = str_get(s1);
            str_nset(str,"",0);
-           while (i-- > 0)
-               str_scat(str,s1);
+           STR_GROW(str, i * s1->str_cur + 1);
+           repeatcpy(str->str_ptr, tmps, s1->str_cur, i);
+           str->str_cur = i * s1->str_cur;
+           str->str_ptr[str->str_cur] = '\0';
            break;
        case O_MULTIPLY:
            value = str_gnum(s1);
@@ -325,7 +344,7 @@ register ARG *arg;
                str_numset(str,str_gnum(s1) / value);
            break;
        case O_MODULO:
-           tmplong = (long)str_gnum(s2);
+           tmplong = (unsigned long)str_gnum(s2);
            if (tmplong == 0L) {
                yyerror("Illegal modulus of constant zero");
                break;
@@ -335,7 +354,7 @@ register ARG *arg;
            if (tmp2 >= 0)
                str_numset(str,(double)(tmp2 % tmplong));
            else
-               str_numset(str,(double)(tmplong - (-tmp2 % tmplong)));
+               str_numset(str,(double)(tmplong - ((-tmp2 - 1) % tmplong))) - 1;
 #else
            tmp2 = tmp2;
 #endif
@@ -394,19 +413,19 @@ register ARG *arg;
        case O_BIT_AND:
            value = str_gnum(s1);
 #ifndef lint
-           str_numset(str,(double)(((long)value) & ((long)str_gnum(s2))));
+           str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
 #endif
            break;
        case O_XOR:
            value = str_gnum(s1);
 #ifndef lint
-           str_numset(str,(double)(((long)value) ^ ((long)str_gnum(s2))));
+           str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
 #endif
            break;
        case O_BIT_OR:
            value = str_gnum(s1);
 #ifndef lint
-           str_numset(str,(double)(((long)value) | ((long)str_gnum(s2))));
+           str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
 #endif
            break;
        case O_AND:
@@ -442,7 +461,7 @@ register ARG *arg;
            break;
        case O_COMPLEMENT:
 #ifndef lint
-           str_numset(str,(double)(~(long)str_gnum(s1)));
+           str_numset(str,(double)(~U_L(str_gnum(s1))));
 #endif
            break;
        case O_SIN:
@@ -634,7 +653,10 @@ register ARG *arg;
            }
        }
        else if (arg1->arg_type == O_AELEM || arg1->arg_type == O_LAELEM)
-           arg1->arg_type = O_LAELEM;
+           if (arg->arg_type == O_DEFINED)
+               arg1->arg_type = O_AELEM;
+           else
+               arg1->arg_type = O_LAELEM;
        else if (arg1->arg_type == O_ARRAY || arg1->arg_type == O_LARRAY) {
            arg1->arg_type = O_LARRAY;
            if (arg->arg_len > 1) {
@@ -642,10 +664,11 @@ register ARG *arg;
                arg2 = arg[2].arg_ptr.arg_arg;
                if (arg2->arg_type == O_SPLIT) { /* use split's builtin =?*/
                    spat = arg2[2].arg_ptr.arg_spat;
-                   if (spat->spat_repl[1].arg_ptr.arg_stab == defstab &&
+                   if (!(spat->spat_flags & SPAT_ONCE) &&
                      nothing_in_common(arg1,spat->spat_repl)) {
                        spat->spat_repl[1].arg_ptr.arg_stab =
                            arg1[1].arg_ptr.arg_stab;
+                       spat->spat_flags |= SPAT_ONCE;
                        arg_free(arg1); /* recursive */
                        free_arg(arg);  /* non-recursive */
                        return arg2;    /* split has builtin assign */
@@ -662,7 +685,10 @@ register ARG *arg;
                arg[1].arg_flags |= AF_ARYOK;
        }
        else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
-           arg1->arg_type = O_LHELEM;
+           if (arg->arg_type == O_DEFINED)
+               arg1->arg_type = O_HELEM;       /* avoid creating one */
+           else
+               arg1->arg_type = O_LHELEM;
        else if (arg1->arg_type == O_HASH || arg1->arg_type == O_LHASH) {
            arg1->arg_type = O_LHASH;
            if (arg->arg_len > 1) {
@@ -888,7 +914,16 @@ maybelistish(optype, arg)
 int optype;
 ARG *arg;
 {
-    if (optype == O_PRTF ||
+    ARG *tmparg = arg;
+
+    if (optype == O_RETURN && arg->arg_type == O_ITEM &&
+      arg[1].arg_type == A_EXPR && (tmparg = arg[1].arg_ptr.arg_arg) &&
+      ((tmparg->arg_flags & AF_LISTISH) || (tmparg->arg_type == O_ARRAY) )) {
+       tmparg = listish(tmparg);
+       free_arg(arg);
+       arg = tmparg;
+    }
+    else if (optype == O_PRTF ||
       (arg->arg_type == O_ASLICE || arg->arg_type == O_HSLICE ||
        arg->arg_type == O_F_OR_R) )
        arg = listish(arg);
@@ -913,6 +948,7 @@ ARG *arg;
     if (arg->arg_len == 0)
        arg[1].arg_type = A_NULL;
     arg->arg_len = 2;
+    arg[2].arg_flags = 0;
     arg[2].arg_ptr.arg_hash = curstash;
     arg[2].arg_type = A_NULL;
     return arg;