[asperl] integrate win32 branch contents

p4raw-id: //depot/asperl@493

1 files changed, 47 insertions, 2 deletions

diff --git a/pp.c b/pp.c
index aaeca3fc2e..c98ac83cb3 100644
--- a/pp.c
+++ b/pp.c
@@ -362,9 +362,54 @@ PP(pp_prototype)
     SV *ret;
 
     ret = &sv_undef;
+    if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
+	char *s = SvPVX(TOPs);
+	if (strnEQ(s, "CORE::", 6)) {
+	    int code;
+	    
+	    code = keyword(s + 6, SvCUR(TOPs) - 6);
+	    if (code < 0) {	/* Overridable. */
+#define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
+		int i = 0, n = 0, seen_question = 0;
+		I32 oa;
+		char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
+
+		while (i < MAXO) {	/* The slow way. */
+		    if (strEQ(s + 6, op_name[i]) || strEQ(s + 6, op_desc[i]))
+			goto found;
+		    i++;
+		}
+		goto nonesuch;		/* Should not happen... */
+	      found:
+		oa = opargs[i] >> OASHIFT;
+		while (oa) {
+		    if (oa & OA_OPTIONAL) {
+			seen_question = 1;
+			str[n++] = ';';
+		    } else if (seen_question) 
+			goto set;	/* XXXX system, exec */
+		    if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF 
+			&& (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
+			str[n++] = '\\';
+		    }
+		    /* What to do with R ((un)tie, tied, (sys)read, recv)? */
+		    str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
+		    oa = oa >> 4;
+		}
+		str[n++] = '\0';
+		ret = sv_2mortal(newSVpv(str, n - 1));
+	    } else if (code)		/* Non-Overridable */
+		goto set;
+	    else {			/* None such */
+	      nonesuch:
+		croak("Cannot find an opnumber for \"%s\"", s+6);
+	    }
+	}
+    }
     cv = sv_2cv(TOPs, &stash, &gv, FALSE);
     if (cv && SvPOK(cv))
 	ret = sv_2mortal(newSVpv(SvPVX(cv), SvCUR(cv)));
+  set:
     SETs(ret);
     RETURN;
 }
@@ -1868,7 +1913,7 @@ PP(pp_vec)
 	}
     }
 
-    sv_setiv(TARG, (IV)retnum);
+    sv_setuv(TARG, (UV)retnum);
     PUSHs(TARG);
     RETURN;
 }
@@ -4394,7 +4439,7 @@ PP(pp_threadsv)
     if (op->op_private & OPpLVAL_INTRO)
 	PUSHs(*save_threadsv(op->op_targ));
     else
-	PUSHs(*av_fetch(thr->threadsv, op->op_targ, FALSE));
+	PUSHs(THREADSV(op->op_targ));
     RETURN;
 #else
     DIE("tried to access per-thread data in non-threaded perl");