Add ceil & floor to builtin

13 files changed, 119 insertions, 9 deletions

diff --git a/builtin.c b/builtin.c
index 5ef3a0bdfd..1e364f34a3 100644
--- a/builtin.c
+++ b/builtin.c
@@ -101,6 +101,14 @@ XS(XS_builtin_func1_scalar)
             Perl_pp_reftype(aTHX);
             break;
 
+        case OP_CEIL:
+            Perl_pp_ceil(aTHX);
+            break;
+
+        case OP_FLOOR:
+            Perl_pp_floor(aTHX);
+            break;
+
         default:
             Perl_die(aTHX_ "panic: unhandled opcode %d for xs_builtin_func1_scalar()", ix);
     }
@@ -182,6 +190,8 @@ static const struct BuiltinFuncDescriptor builtins[] = {
     { "builtin::blessed",  &XS_builtin_func1_scalar, &ck_builtin_func1, OP_BLESSED  },
     { "builtin::refaddr",  &XS_builtin_func1_scalar, &ck_builtin_func1, OP_REFADDR  },
     { "builtin::reftype",  &XS_builtin_func1_scalar, &ck_builtin_func1, OP_REFTYPE  },
+    { "builtin::ceil",     &XS_builtin_func1_scalar, &ck_builtin_func1, OP_CEIL     },
+    { "builtin::floor",    &XS_builtin_func1_scalar, &ck_builtin_func1, OP_FLOOR    },
     { 0 }
 };
 
diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index a2b5621641..377659d2f4 100644
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -6,7 +6,7 @@ use strict;
 
 our($VERSION, @ISA, @EXPORT_OK);
 
-$VERSION = "1.55";
+$VERSION = "1.56";
 
 use Carp;
 use Exporter 'import';
@@ -449,6 +449,8 @@ These are a hotchpotch of opcodes still waiting to be considered
 
     custom -- where should this go
 
+    ceil floor
+
 =item :base_math
 
 These ops are not included in :base_core because of the risk of them being
@@ -616,4 +618,3 @@ Split out from Safe module version 1, named opcode tags and other
 changes added by Tim Bunce.
 
 =cut
-
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 8570bb40d9..b01acda4c4 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -8,6 +8,7 @@
 # but essentially none of his code remains.
 
 package B::Deparse;
+use strict;
 use Carp;
 use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
 	 OPf_WANT OPf_WANT_VOID OPf_WANT_SCALAR OPf_WANT_LIST
@@ -52,8 +53,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
         MDEREF_SHIFT
     );
 
-$VERSION = '1.61';
-use strict;
+our $VERSION = '1.62';
 our $AUTOLOAD;
 use warnings ();
 require feature;
@@ -6638,6 +6638,8 @@ sub pp_unweaken { builtin1(@_, "unweaken"); }
 sub pp_blessed  { builtin1(@_, "blessed"); }
 sub pp_refaddr  { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "refaddr"); }
 sub pp_reftype  { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "reftype"); }
+sub pp_ceil     { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "ceil"); }
+sub pp_floor    { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "floor"); }
 
 1;
 __END__
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index c9c519b2d0..4587d45c41 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -3218,3 +3218,5 @@ builtin::unweaken($x);
 $x = builtin::blessed(undef);
 $x = builtin::refaddr(undef);
 $x = builtin::reftype(undef);
+$x = builtin::ceil($x);
+$x = builtin::floor($x);
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index d1c5829970..9b60b66918 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -149,7 +149,7 @@ $bits{$_}{6} = 'OPpPAD_STATE' for qw(lvavref lvref padav padhv padsv pushmark re
 $bits{$_}{7} = 'OPpPV_IS_UTF8' for qw(dump goto last next redo);
 $bits{$_}{6} = 'OPpREFCOUNTED' for qw(leave leaveeval leavesub leavesublv leavewrite);
 $bits{$_}{2} = 'OPpSLICEWARNING' for qw(aslice hslice padav padhv rv2av rv2hv);
-$bits{$_}{4} = 'OPpTARGET_MY' for qw(abs add atan2 chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int isbool isweak kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid);
+$bits{$_}{4} = 'OPpTARGET_MY' for qw(abs add atan2 ceil chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock floor getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int isbool isweak kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid);
 $bits{$_}{0} = 'OPpTRANS_CAN_FORCE_UTF8' for qw(trans transr);
 $bits{$_}{5} = 'OPpTRANS_COMPLEMENT' for qw(trans transr);
 $bits{$_}{7} = 'OPpTRANS_DELETE' for qw(trans transr);
@@ -275,6 +275,7 @@ $bits{backtick}{0} = $bf[0];
 $bits{blessed}{0} = $bf[0];
 @{$bits{caller}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 $bits{catch}{0} = $bf[0];
+$bits{ceil}{0} = $bf[0];
 @{$bits{chdir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 @{$bits{chmod}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 $bits{chomp}{0} = $bf[0];
@@ -323,6 +324,7 @@ $bits{fc}{0} = $bf[0];
 @{$bits{fileno}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 $bits{flip}{0} = $bf[0];
 @{$bits{flock}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
+$bits{floor}{0} = $bf[0];
 $bits{flop}{0} = $bf[0];
 @{$bits{formline}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 $bits{ftatime}{0} = $bf[0];
@@ -847,7 +849,7 @@ our %ops_using = (
     OPpSORT_DESCEND          => [qw(sort)],
     OPpSPLIT_ASSIGN          => [qw(split)],
     OPpSUBSTR_REPL_FIRST     => [qw(substr)],
-    OPpTARGET_MY             => [qw(abs add atan2 chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int isbool isweak kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid)],
+    OPpTARGET_MY             => [qw(abs add atan2 ceil chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock floor getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int isbool isweak kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid)],
     OPpTRANS_CAN_FORCE_UTF8  => [qw(trans transr)],
     OPpTRUEBOOL              => [qw(blessed grepwhile index length padav padhv pos ref rindex rv2av rv2hv subst)],
     OPpUSEINT                => [qw(bit_and bit_or bit_xor complement left_shift nbit_and nbit_or nbit_xor ncomplement right_shift sbit_and sbit_or sbit_xor)],
diff --git a/lib/builtin.pm b/lib/builtin.pm
index 326d200d36..f38d8a99fe 100644
--- a/lib/builtin.pm
+++ b/lib/builtin.pm
@@ -1,4 +1,4 @@
-package builtin 0.001;
+package builtin 0.002;
 
 use strict;
 use warnings;
@@ -20,6 +20,7 @@ builtin - Perl pragma to import built-in utility functions
         true false isbool
         weaken unweaken isweak
         blessed refaddr reftype
+        ceil floor
     );
 
 =head1 DESCRIPTION
@@ -147,6 +148,20 @@ Returns the basic container type of the referent of a reference, or C<undef>
 for a non-reference. This is returned as a string in all-capitals, such as
 C<ARRAY> for array references, or C<HASH> for hash references.
 
+=head2 ceil
+
+    $num = ceil($num);
+
+Returns the smallest integer value greater than or equal to the given
+numerical argument.
+
+=head2 floor
+
+    $num = floor($num);
+
+Returns the largest integer value less than or equal to the given numerical
+argument.
+
 =head1 SEE ALSO
 
 L<perlop>, L<perlfunc>, L<Scalar::Util>
diff --git a/lib/builtin.t b/lib/builtin.t
index e35e8ab393..75a93cd27f 100644
--- a/lib/builtin.t
+++ b/lib/builtin.t
@@ -93,6 +93,33 @@ package FetchStoreCounter {
     is(blessed(bless [], "0") ? "YES" : "NO", "NO", 'blessed in boolean context handles "0" cornercase');
 }
 
+# ceil, floor
+{
+    use builtin qw( ceil floor );
+
+    cmp_ok(ceil(1.5), '==', 2, 'ceil(1.5) == 2');
+    cmp_ok(floor(1.5), '==', 1, 'floor(1.5) == 1');
+
+    # Invokes magic
+
+    tie my $tied, FetchStoreCounter => (\my $fetchcount, \my $storecount);
+
+    my $_dummy = ceil($tied);
+    is($fetchcount, 1, 'ceil() invokes FETCH magic');
+
+    $tied = ceil(1.1);
+    is($storecount, 1, 'ceil() TARG invokes STORE magic');
+
+    $fetchcount = $storecount = 0;
+    tie $tied, FetchStoreCounter => (\$fetchcount, \$storecount);
+
+    $_dummy = floor($tied);
+    is($fetchcount, 1, 'floor() invokes FETCH magic');
+
+    $tied = floor(1.1);
+    is($storecount, 1, 'floor() TARG invokes STORE magic');
+}
+
 # imports are lexical; should not be visible here
 {
     my $ok = eval 'true()'; my $e = $@;
diff --git a/opcode.h b/opcode.h
index 3a08dfae22..decd14710c 100644
--- a/opcode.h
+++ b/opcode.h
@@ -561,6 +561,8 @@ EXTCONST char* const PL_op_name[] = {
 	"blessed",
 	"refaddr",
 	"reftype",
+	"ceil",
+	"floor",
         "freed",
 };
 #endif
@@ -981,6 +983,8 @@ EXTCONST char* const PL_op_desc[] = {
 	"blessed",
 	"refaddr",
 	"reftype",
+	"ceil",
+	"floor",
         "freed op",
 };
 #endif
@@ -1404,6 +1408,8 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
 	Perl_pp_blessed,
 	Perl_pp_refaddr,
 	Perl_pp_reftype,
+	Perl_pp_ceil,
+	Perl_pp_floor,
 }
 #endif
 ;
@@ -1823,6 +1829,8 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
 	Perl_ck_null,		/* blessed */
 	Perl_ck_null,		/* refaddr */
 	Perl_ck_null,		/* reftype */
+	Perl_ck_null,		/* ceil */
+	Perl_ck_null,		/* floor */
 }
 #endif
 ;
@@ -2243,6 +2251,8 @@ EXTCONST U32 PL_opargs[] = {
 	0x00000106,	/* blessed */
 	0x0000011e,	/* refaddr */
 	0x0000011e,	/* reftype */
+	0x0000011e,	/* ceil */
+	0x0000011e,	/* floor */
 };
 #endif
 
@@ -2922,6 +2932,8 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
       49, /* blessed */
       75, /* refaddr */
       75, /* reftype */
+      75, /* ceil */
+      75, /* floor */
 
 };
 
@@ -2961,7 +2973,7 @@ EXTCONST U16  PL_op_private_bitdefs[] = {
     0x117c, 0x22b8, 0x09b4, 0x40ec, 0x2648, 0x4864, 0x07c1, /* trans, transr */
     0x0fbc, 0x04d8, 0x0067, /* sassign */
     0x0c78, 0x0b74, 0x0a70, 0x31cc, 0x05a8, 0x0067, /* aassign */
-    0x4630, 0x0003, /* chomp, schomp, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, ord, chr, chroot, rmdir, isbool, isweak, refaddr, reftype */
+    0x4630, 0x0003, /* chomp, schomp, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, ord, chr, chroot, rmdir, isbool, isweak, refaddr, reftype, ceil, floor */
     0x05b4, 0x31cc, 0x0003, /* pos */
     0x4630, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract */
     0x1538, 0x0067, /* repeat */
@@ -3433,6 +3445,8 @@ EXTCONST U8 PL_op_private_valid[] = {
     /* BLESSED    */ (OPpARG1_MASK|OPpMAYBE_TRUEBOOL|OPpTRUEBOOL),
     /* REFADDR    */ (OPpARG1_MASK|OPpTARGET_MY),
     /* REFTYPE    */ (OPpARG1_MASK|OPpTARGET_MY),
+    /* CEIL       */ (OPpARG1_MASK|OPpTARGET_MY),
+    /* FLOOR      */ (OPpARG1_MASK|OPpTARGET_MY),
 
 };
 
diff --git a/opnames.h b/opnames.h
index cfad87aaf7..f03ba7f6ba 100644
--- a/opnames.h
+++ b/opnames.h
@@ -426,10 +426,12 @@ typedef enum opcode {
 	OP_BLESSED	 = 409,
 	OP_REFADDR	 = 410,
 	OP_REFTYPE	 = 411,
+	OP_CEIL		 = 412,
+	OP_FLOOR	 = 413,
 	OP_max		
 } opcode;
 
-#define MAXO 412
+#define MAXO 414
 #define OP_FREED MAXO
 
 /* the OP_IS_* macros are optimized to a simple range check because
diff --git a/pp.c b/pp.c
index 643a8758b7..b53fd87968 100644
--- a/pp.c
+++ b/pp.c
@@ -7326,6 +7326,22 @@ PP(pp_reftype)
     RETURN;
 }
 
+PP(pp_ceil)
+{
+    dSP;
+    dTARGET;
+    PUSHn(Perl_ceil(POPn));
+    RETURN;
+}
+
+PP(pp_floor)
+{
+    dSP;
+    dTARGET;
+    PUSHn(Perl_floor(POPn));
+    RETURN;
+}
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */
diff --git a/pp_proto.h b/pp_proto.h
index 815fedc338..ed80604737 100644
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -36,6 +36,7 @@ PERL_CALLCONV OP *Perl_pp_blessed(pTHX);
 PERL_CALLCONV OP *Perl_pp_break(pTHX);
 PERL_CALLCONV OP *Perl_pp_caller(pTHX);
 PERL_CALLCONV OP *Perl_pp_catch(pTHX);
+PERL_CALLCONV OP *Perl_pp_ceil(pTHX);
 PERL_CALLCONV OP *Perl_pp_chdir(pTHX);
 PERL_CALLCONV OP *Perl_pp_chop(pTHX);
 PERL_CALLCONV OP *Perl_pp_chown(pTHX);
@@ -80,6 +81,7 @@ PERL_CALLCONV OP *Perl_pp_fc(pTHX);
 PERL_CALLCONV OP *Perl_pp_fileno(pTHX);
 PERL_CALLCONV OP *Perl_pp_flip(pTHX);
 PERL_CALLCONV OP *Perl_pp_flock(pTHX);
+PERL_CALLCONV OP *Perl_pp_floor(pTHX);
 PERL_CALLCONV OP *Perl_pp_flop(pTHX);
 PERL_CALLCONV OP *Perl_pp_fork(pTHX);
 PERL_CALLCONV OP *Perl_pp_formline(pTHX);
diff --git a/regen/opcodes b/regen/opcodes
index ade3d70acc..45391a2c98 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -591,3 +591,5 @@ unweaken	reference unweaken	ck_null		1
 blessed		blessed			ck_null		fs1
 refaddr		refaddr			ck_null		fsT1
 reftype		reftype			ck_null		fsT1
+ceil		ceil			ck_null		fsT1
+floor		floor			ck_null		fsT1
diff --git a/t/perf/opcount.t b/t/perf/opcount.t
index 372c47f3d6..3351f50f07 100644
--- a/t/perf/opcount.t
+++ b/t/perf/opcount.t
@@ -766,4 +766,19 @@ test_opcount(0, "builtin::reftype is replaced with direct opcode",
                     reftype  => 1,
                 });
 
+my $one_point_five = 1.5;   # Prevent const-folding.
+test_opcount(0, "builtin::ceil is replaced with direct opcode",
+                sub { builtin::ceil($one_point_five); },
+                {
+                    entersub => 0,
+                    ceil     => 1,
+                });
+
+test_opcount(0, "builtin::floor is replaced with direct opcode",
+                sub { builtin::floor($one_point_five); },
+                {
+                    entersub => 0,
+                    floor    => 1,
+                });
+
 done_testing();