Re: Unicode/EBCDIC

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

diff --git a/pp_ctl.c b/pp_ctl.c
index 5490221..8466d45 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -47,7 +47,7 @@ static I32 sv_cmp_locale_static(pTHXo_ SV *a, SV *b);
 
 PP(pp_wantarray)
 {
-    djSP;
+    dSP;
     I32 cxix;
     EXTEND(SP, 1);
 
@@ -80,7 +80,7 @@ PP(pp_regcreset)
 
 PP(pp_regcomp)
 {
-    djSP;
+    dSP;
     register PMOP *pm = (PMOP*)cLOGOP->op_other;
     register char *t;
     SV *tmpstr;
@@ -119,12 +119,12 @@ PP(pp_regcomp)
            else {
                pm->op_pmdynflags &= ~PMdf_DYN_UTF8;
                if (pm->op_pmdynflags & PMdf_UTF8)
-                   t = bytes_to_utf8(t, &len);
+                   t = (char*)bytes_to_utf8((U8*)t, &len);
            }
            pm->op_pmregexp = CALLREGCOMP(aTHX_ t, t + len, pm);
            if (!DO_UTF8(tmpstr) && (pm->op_pmdynflags & PMdf_UTF8))
                Safefree(t);
-           PL_reginterp_cnt = 0;               /* XXXX Be extra paranoid - needed
+           PL_reginterp_cnt = 0;       /* XXXX Be extra paranoid - needed
                                           inside tie/overload accessors.  */
        }
     }
@@ -156,7 +156,7 @@ PP(pp_regcomp)
 
 PP(pp_substcont)
 {
-    djSP;
+    dSP;
     register PMOP *pm = (PMOP*) cLOGOP->op_other;
     register PERL_CONTEXT *cx = &cxstack[cxstack_ix];
     register SV *dstr = cx->sb_dstr;
@@ -226,7 +226,7 @@ PP(pp_substcont)
        MAGIC *mg;
        I32 i;
        if (SvTYPE(sv) < SVt_PVMG)
-           SvUPGRADE(sv, SVt_PVMG);
+           (void)SvUPGRADE(sv, SVt_PVMG);
        if (!(mg = mg_find(sv, 'g'))) {
            sv_magic(sv, Nullsv, 'g', Nullch, 0);
            mg = mg_find(sv, 'g');
@@ -304,7 +304,7 @@ Perl_rxres_free(pTHX_ void **rsp)
 
 PP(pp_formline)
 {
-    djSP; dMARK; dORIGMARK;
+    dSP; dMARK; dORIGMARK;
     register SV *tmpForm = *++MARK;
     register U16 *fpc;
     register char *t;
@@ -750,7 +750,7 @@ PP(pp_formline)
 
 PP(pp_grepstart)
 {
-    djSP;
+    dSP;
     SV *src;
 
     if (PL_stack_base + *PL_markstack_ptr == SP) {
@@ -787,7 +787,7 @@ PP(pp_mapstart)
 
 PP(pp_mapwhile)
 {
-    djSP;
+    dSP;
     I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */
     I32 count;
     I32 shift;
@@ -875,7 +875,7 @@ PP(pp_mapwhile)
 
 PP(pp_sort)
 {
-    djSP; dMARK; dORIGMARK;
+    dSP; dMARK; dORIGMARK;
     register SV **up;
     SV **myorigmark = ORIGMARK;
     register I32 max;
@@ -1060,7 +1060,7 @@ PP(pp_range)
 
 PP(pp_flip)
 {
-    djSP;
+    dSP;
 
     if (GIMME == G_ARRAY) {
        RETURNOP(((LOGOP*)cUNOP->op_first)->op_other);
@@ -1099,7 +1099,7 @@ PP(pp_flip)
 
 PP(pp_flop)
 {
-    djSP;
+    dSP;
 
     if (GIMME == G_ARRAY) {
        dPOPPOPssrl;
@@ -1534,7 +1534,7 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
 
 PP(pp_xor)
 {
-    djSP; dPOPTOPssrl;
+    dSP; dPOPTOPssrl;
     if (SvTRUE(left) != SvTRUE(right))
        RETSETYES;
     else
@@ -1543,7 +1543,7 @@ PP(pp_xor)
 
 PP(pp_andassign)
 {
-    djSP;
+    dSP;
     if (!SvTRUE(TOPs))
        RETURN;
     else
@@ -1552,7 +1552,7 @@ PP(pp_andassign)
 
 PP(pp_orassign)
 {
-    djSP;
+    dSP;
     if (SvTRUE(TOPs))
        RETURN;
     else
@@ -1561,7 +1561,7 @@ PP(pp_orassign)
        
 PP(pp_caller)
 {
-    djSP;
+    dSP;
     register I32 cxix = dopoptosub(cxstack_ix);
     register PERL_CONTEXT *cx;
     register PERL_CONTEXT *ccstack = cxstack;
@@ -1704,7 +1704,7 @@ PP(pp_caller)
 
 PP(pp_reset)
 {
-    djSP;
+    dSP;
     char *tmps;
     STRLEN n_a;
 
@@ -1731,7 +1731,7 @@ PP(pp_dbstate)
 
     if (PL_op->op_private || SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace))
     {
-       djSP;
+       dSP;
        register CV *cv;
        register PERL_CONTEXT *cx;
        I32 gimme = G_ARRAY;
@@ -1775,7 +1775,7 @@ PP(pp_scope)
 
 PP(pp_enteriter)
 {
-    djSP; dMARK;
+    dSP; dMARK;
     register PERL_CONTEXT *cx;
     I32 gimme = GIMME_V;
     SV **svp;
@@ -1854,7 +1854,7 @@ PP(pp_enteriter)
 
 PP(pp_enterloop)
 {
-    djSP;
+    dSP;
     register PERL_CONTEXT *cx;
     I32 gimme = GIMME_V;
 
@@ -1870,7 +1870,7 @@ PP(pp_enterloop)
 
 PP(pp_leaveloop)
 {
-    djSP;
+    dSP;
     register PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;
@@ -1910,7 +1910,7 @@ PP(pp_leaveloop)
 
 PP(pp_return)
 {
-    djSP; dMARK;
+    dSP; dMARK;
     I32 cxix;
     register PERL_CONTEXT *cx;
     bool popsub2 = FALSE;
@@ -2021,7 +2021,7 @@ PP(pp_return)
 
 PP(pp_last)
 {
-    djSP;
+    dSP;
     I32 cxix;
     register PERL_CONTEXT *cx;
     I32 pop2 = 0;
@@ -2208,7 +2208,7 @@ PP(pp_dump)
 
 PP(pp_goto)
 {
-    djSP;
+    dSP;
     OP *retop = 0;
     I32 ix;
     register PERL_CONTEXT *cx;
@@ -2585,7 +2585,7 @@ PP(pp_goto)
 
 PP(pp_exit)
 {
-    djSP;
+    dSP;
     I32 anum;
 
     if (MAXARG < 1)
@@ -2606,7 +2606,7 @@ PP(pp_exit)
 #ifdef NOTYET
 PP(pp_nswitch)
 {
-    djSP;
+    dSP;
     NV value = SvNVx(GvSV(cCOP->cop_gv));
     register I32 match = I_32(value);
 
@@ -2625,7 +2625,7 @@ PP(pp_nswitch)
 
 PP(pp_cswitch)
 {
-    djSP;
+    dSP;
     register I32 match;
 
     if (PL_multiline)
@@ -3024,7 +3024,7 @@ S_doopen_pmc(pTHX_ const char *name, const char *mode)
 
 PP(pp_require)
 {
-    djSP;
+    dSP;
     register PERL_CONTEXT *cx;
     SV *sv;
     char *name;
@@ -3110,22 +3110,27 @@ PP(pp_require)
 
     /* prepare to compile file */
 
+#ifdef MACOS_TRADITIONAL
     if (PERL_FILE_IS_ABSOLUTE(name)
-       || (*name == '.' && (name[1] == '/' ||
-                            (name[1] == '.' && name[2] == '/'))))
+       || (*name == ':' && name[1] != ':' && strchr(name+2, ':')))
     {
        tryname = name;
        tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
-#ifdef MACOS_TRADITIONAL
        /* We consider paths of the form :a:b ambiguous and interpret them first
           as global then as local
        */
-       if (!tryrsfp && name[0] == ':' && name[1] != ':' && strchr(name+2, ':'))
+       if (!tryrsfp && *name == ':' && name[1] != ':' && strchr(name+2, ':'))
            goto trylocal;
     }
     else
 trylocal: {
 #else
+    if (PERL_FILE_IS_ABSOLUTE(name)
+       || (*name == '.' && (name[1] == '/' ||
+                            (name[1] == '.' && name[2] == '/'))))
+    {
+       tryname = name;
+       tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
     }
     else {
 #endif
@@ -3161,7 +3166,10 @@ trylocal: {
                    PUSHs(dirsv);
                    PUSHs(sv);
                    PUTBACK;
-                   count = call_sv(loader, G_ARRAY);
+                   if (sv_isobject(loader))
+                       count = call_method("INC", G_ARRAY);
+                   else
+                       count = call_sv(loader, G_ARRAY);
                    SPAGAIN;
 
                    if (count > 0) {
@@ -3372,7 +3380,7 @@ PP(pp_dofile)
 
 PP(pp_entereval)
 {
-    djSP;
+    dSP;
     register PERL_CONTEXT *cx;
     dPOPss;
     I32 gimme = GIMME_V, was = PL_sub_generation;
@@ -3456,7 +3464,7 @@ PP(pp_entereval)
 
 PP(pp_leaveeval)
 {
-    djSP;
+    dSP;
     register SV **mark;
     SV **newsp;
     PMOP *newpm;
@@ -3527,7 +3535,7 @@ PP(pp_leaveeval)
 
 PP(pp_entertry)
 {
-    djSP;
+    dSP;
     register PERL_CONTEXT *cx;
     I32 gimme = GIMME_V;
 
@@ -3547,7 +3555,7 @@ PP(pp_entertry)
 
 PP(pp_leavetry)
 {
-    djSP;
+    dSP;
     register SV **mark;
     SV **newsp;
     PMOP *newpm;
@@ -4393,7 +4401,7 @@ run_user_filter(pTHXo_ int idx, SV *buf_sv, int maxlen)
     }
 
     if (filter_sub && len >= 0) {
-       djSP;
+       dSP;
        int count;
 
        ENTER;