pp_hex can be implemented trivially by pp_oct, making pp_hex a mathom.
authorNicholas Clark <nick@ccl4.org>
Tue, 7 Feb 2006 14:11:42 +0000 (14:11 +0000)
committerNicholas Clark <nick@ccl4.org>
Tue, 7 Feb 2006 14:11:42 +0000 (14:11 +0000)
p4raw-id: //depot/perl@27119

mathoms.c
opcode.h
opcode.pl
pp.c

index 261abe3..f1f20b2 100644 (file)
--- a/mathoms.c
+++ b/mathoms.c
@@ -1044,6 +1044,11 @@ PP(pp_rindex)
     return pp_index();
 }
 
+PP(pp_hex)
+{
+    return pp_oct();
+}
+
 U8 *
 Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
 {
index 5b73eb6..4541421 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -892,7 +892,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
        MEMBER_TO_FPTR(Perl_pp_log),
        MEMBER_TO_FPTR(Perl_pp_sqrt),
        MEMBER_TO_FPTR(Perl_pp_int),
-       MEMBER_TO_FPTR(Perl_pp_hex),
+       MEMBER_TO_FPTR(Perl_pp_oct),    /* Perl_pp_hex */
        MEMBER_TO_FPTR(Perl_pp_oct),
        MEMBER_TO_FPTR(Perl_pp_abs),
        MEMBER_TO_FPTR(Perl_pp_length),
index c548f7b..b1c50b9 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -80,6 +80,7 @@ my @raw_alias = (
                 Perl_pp_sle => [qw(slt sgt sge)],
                 Perl_pp_print => ['say'],
                 Perl_pp_index => ['rindex'],
+                Perl_pp_oct => ['hex'],
                );
 
 while (my ($func, $names) = splice @raw_alias, 0, 2) {
diff --git a/pp.c b/pp.c
index 01dac5c..7789120 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -2821,37 +2821,6 @@ PP(pp_abs)
     RETURN;
 }
 
-
-PP(pp_hex)
-{
-    dVAR; dSP; dTARGET;
-    const char *tmps;
-    I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
-    STRLEN len;
-    NV result_nv;
-    UV result_uv;
-    SV* const sv = POPs;
-
-    tmps = (SvPV_const(sv, len));
-    if (DO_UTF8(sv)) {
-        /* If Unicode, try to downgrade
-         * If not possible, croak. */
-        SV* const tsv = sv_2mortal(newSVsv(sv));
-       
-        SvUTF8_on(tsv);
-        sv_utf8_downgrade(tsv, FALSE);
-        tmps = SvPV_const(tsv, len);
-    }
-    result_uv = grok_hex (tmps, &len, &flags, &result_nv);
-    if (flags & PERL_SCAN_GREATER_THAN_UV_MAX) {
-        XPUSHn(result_nv);
-    }
-    else {
-        XPUSHu(result_uv);
-    }
-    RETURN;
-}
-
 PP(pp_oct)
 {
     dVAR; dSP; dTARGET;
@@ -2872,12 +2841,17 @@ PP(pp_oct)
         sv_utf8_downgrade(tsv, FALSE);
         tmps = SvPV_const(tsv, len);
     }
+    if (PL_op->op_type == OP_HEX)
+       goto hex;
+
     while (*tmps && len && isSPACE(*tmps))
         tmps++, len--;
     if (*tmps == '0')
         tmps++, len--;
-    if (*tmps == 'x')
+    if (*tmps == 'x') {
+    hex:
         result_uv = grok_hex (tmps, &len, &flags, &result_nv);
+    }
     else if (*tmps == 'b')
         result_uv = grok_bin (tmps, &len, &flags, &result_nv);
     else