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 6feeb9b..a7db58b 100644 (file)
--- a/consarg.c
+++ b/consarg.c
@@ -1,4 +1,4 @@
-/* $Header: consarg.c,v 3.0.1.2 89/11/17 15:11:34 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,19 @@
  *    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
  * 
@@ -50,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;
        }
@@ -298,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 */
@@ -312,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);
@@ -328,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;
@@ -338,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
@@ -397,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:
@@ -445,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:
@@ -648,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 */
@@ -897,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);
@@ -922,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;