Add ceil & floor to builtin

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 }
 };
 

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
-

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__

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);

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>

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 = $@;

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:
  */

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

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();