This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
perl 3.0 patch #39 patch #38, continued
[perl5.git] / consarg.c
diff --git a/consarg.c b/consarg.c
index 4252ad5..ac7a8ca 100644 (file)
--- a/consarg.c
+++ b/consarg.c
@@ -1,4 +1,4 @@
-/* $Header: consarg.c,v 3.0.1.3 90/02/28 16:47:54 lwall Locked $
+/* $Header: consarg.c,v 3.0.1.7 90/10/15 15:55:28 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,20 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       consarg.c,v $
+ * Revision 3.0.1.7  90/10/15  15:55:28  lwall
+ * patch29: defined @foo was behaving inconsistently
+ * patch29: -5 % 5 was wrong
+ * patch29: package behavior is now more consistent
+ * 
+ * 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
@@ -54,6 +68,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;
        }
@@ -82,6 +97,9 @@ register ARG *pat;
     register SPAT *spat;
     register ARG *newarg;
 
+    if (!pat)
+       return Nullarg;
+
     if ((pat->arg_type == O_MATCH ||
         pat->arg_type == O_SUBST ||
         pat->arg_type == O_TRANS ||
@@ -146,17 +164,17 @@ ARG *arg3;
 {
     register ARG *arg;
     register ARG *chld;
-    register int doarg;
+    register unsigned doarg;
+    register int i;
     extern ARG *arg4;  /* should be normal arguments, really */
     extern ARG *arg5;
 
     arg = op_new(newlen);
     arg->arg_type = type;
-    doarg = opargs[type];
     if (chld = arg1) {
        if (chld->arg_type == O_ITEM &&
-           (hoistable[chld[1].arg_type] || chld[1].arg_type == A_LVAL ||
-            (chld[1].arg_type == A_LEXPR &&
+           (hoistable[ i = (chld[1].arg_type&A_MASK)] || i == A_LVAL ||
+            (i == A_LEXPR &&
              (chld[1].arg_ptr.arg_arg->arg_type == O_LIST ||
               chld[1].arg_ptr.arg_arg->arg_type == O_ARRAY ||
               chld[1].arg_ptr.arg_arg->arg_type == O_HASH ))))
@@ -171,15 +189,10 @@ ARG *arg3;
            arg[1].arg_type = A_EXPR;
            arg[1].arg_ptr.arg_arg = chld;
        }
-       if (!(doarg & 1))
-           arg[1].arg_type |= A_DONT;
-       if (doarg & 2)
-           arg[1].arg_flags |= AF_ARYOK;
     }
-    doarg >>= 2;
     if (chld = arg2) {
        if (chld->arg_type == O_ITEM && 
-           (hoistable[chld[1].arg_type] || 
+           (hoistable[chld[1].arg_type&A_MASK] || 
             (type == O_ASSIGN && 
              ((chld[1].arg_type == A_READ && !(arg[1].arg_type & A_DONT))
                ||
@@ -196,14 +209,9 @@ ARG *arg3;
            arg[2].arg_type = A_EXPR;
            arg[2].arg_ptr.arg_arg = chld;
        }
-       if (!(doarg & 1))
-           arg[2].arg_type |= A_DONT;
-       if (doarg & 2)
-           arg[2].arg_flags |= AF_ARYOK;
     }
-    doarg >>= 2;
     if (chld = arg3) {
-       if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) {
+       if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
            arg[3].arg_type = chld[1].arg_type;
            arg[3].arg_ptr = chld[1].arg_ptr;
            arg[3].arg_len = chld[1].arg_len;
@@ -213,13 +221,9 @@ ARG *arg3;
            arg[3].arg_type = A_EXPR;
            arg[3].arg_ptr.arg_arg = chld;
        }
-       if (!(doarg & 1))
-           arg[3].arg_type |= A_DONT;
-       if (doarg & 2)
-           arg[3].arg_flags |= AF_ARYOK;
     }
     if (newlen >= 4 && (chld = arg4)) {
-       if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) {
+       if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
            arg[4].arg_type = chld[1].arg_type;
            arg[4].arg_ptr = chld[1].arg_ptr;
            arg[4].arg_len = chld[1].arg_len;
@@ -231,7 +235,7 @@ ARG *arg3;
        }
     }
     if (newlen >= 5 && (chld = arg5)) {
-       if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) {
+       if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
            arg[5].arg_type = chld[1].arg_type;
            arg[5].arg_ptr = chld[1].arg_ptr;
            arg[5].arg_len = chld[1].arg_len;
@@ -242,6 +246,14 @@ ARG *arg3;
            arg[5].arg_ptr.arg_arg = chld;
        }
     }
+    doarg = opargs[type];
+    for (i = 1; i <= newlen; ++i) {
+       if (!(doarg & 1))
+           arg[i].arg_type |= A_DONT;
+       if (doarg & 2)
+           arg[i].arg_flags |= AF_ARYOK;
+       doarg >>= 2;
+    }
 #ifdef DEBUGGING
     if (debug & 16) {
        fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]);
@@ -302,7 +314,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 */
@@ -335,7 +346,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;
@@ -345,7 +356,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
@@ -401,22 +412,31 @@ register ARG *arg;
            value = str_gnum(s1);
            str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0);
            break;
+       case O_NCMP:
+           value = str_gnum(s1);
+           value -= str_gnum(s2);
+           if (value > 0.0)
+               value = 1.0;
+           else if (value < 0.0)
+               value = -1.0;
+           str_numset(str,value);
+           break;
        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:
@@ -452,7 +472,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:
@@ -490,6 +510,9 @@ register ARG *arg;
        case O_SNE:
            str_numset(str,(double)(!str_eq(s1,s2)));
            break;
+       case O_SCMP:
+           str_numset(str,(double)(str_cmp(s1,s2)));
+           break;
        case O_CRYPT:
 #ifdef CRYPT
            tmps = str_get(s1);
@@ -905,7 +928,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);
@@ -923,19 +955,6 @@ ARG *arg;
 }
 
 ARG *
-fixeval(arg)
-ARG *arg;
-{
-    Renew(arg, 3, ARG);
-    if (arg->arg_len == 0)
-       arg[1].arg_type = A_NULL;
-    arg->arg_len = 2;
-    arg[2].arg_ptr.arg_hash = curstash;
-    arg[2].arg_type = A_NULL;
-    return arg;
-}
-
-ARG *
 rcatmaybe(arg)
 ARG *arg;
 {
Unnamed repository; edit this file 'description' to name the repository.