[perl #80628] __SUB__

After much alternation, altercation and alteration, __SUB__ is
finally here.

23 files changed, 403 insertions, 274 deletions

diff --git a/MANIFEST b/MANIFEST
index 40dc1752b0..5f902ffaed 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5132,6 +5132,7 @@ t/op/coreamp.t			Test &foo() calls for CORE subs
 t/op/coresubs.t			Generics tests for CORE subs
 t/op/cproto.t			Check builtin prototypes
 t/op/crypt.t			See if crypt works
+t/op/current_sub.t		__SUB__ tests
 t/op/dbm.t			See if dbmopen/dbmclose work
 t/op/defins.t			See if auto-insert of defined() works
 t/op/delete.t			See if delete works
diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index cfdfc5384b..cc787a83c5 100644
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -1547,6 +1547,7 @@ my %feature_keywords = (
     default => 'switch',
     break   => 'switch',
     evalbytes=>'evalbytes',
+    __SUB__ => '__SUB__',
 );
 
 sub keyword {
@@ -4361,6 +4362,8 @@ sub pp_match { matchop(@_, "m", "/") }
 sub pp_pushre { matchop(@_, "m", "/") }
 sub pp_qr { matchop(@_, "qr", "") }
 
+sub pp_runcv { unop(@_, "__SUB__"); }
+
 sub pp_split {
     my $self = shift;
     my($op, $cx) = @_;
diff --git a/dist/B-Deparse/t/core.t b/dist/B-Deparse/t/core.t
index 81d9038b8a..f5952af89c 100644
--- a/dist/B-Deparse/t/core.t
+++ b/dist/B-Deparse/t/core.t
@@ -26,7 +26,7 @@ my @nary = (
           getgrent getlogin getc gmtime hex int lc log lstat length
           lcfirst localtime mkdir ord oct pop quotemeta ref rand
           rmdir reset reverse readlink select setpwent setgrent
-          shift sin sleep sqrt srand stat system tell time times
+          shift sin sleep sqrt srand stat __SUB__ system tell time times
           uc utime umask unlink ucfirst wantarray warn wait write    )],
  # unary
      [qw( abs alarm bless binmode chr cos chop close chdir chomp
diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index 503f46ff91..84f5f6a586 100644
--- a/dist/B-Deparse/t/deparse.t
+++ b/dist/B-Deparse/t/deparse.t
@@ -766,6 +766,7 @@ CORE::given ($x) {
     }
 }
 CORE::evalbytes '';
+() = CORE::__SUB__;
 ####
 # $#- $#+ $#{%} etc.
 my @x;
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 1ef9c95244..d5c869695c 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp
 
 use Exporter (); # use #5
 
-our $VERSION   = "0.87";
+our $VERSION   = "0.88";
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw( set_style set_style_standard add_callback
 		     concise_subref concise_cv concise_main
@@ -660,7 +660,7 @@ if ($] >= 5.009) {
   $priv{$_}{2} = "GREPLEX"
     for ("mapwhile", "mapstart", "grepwhile", "grepstart");
 }
-$priv{$_}{128} = '+1' for qw "caller wantarray";
+$priv{$_}{128} = '+1' for qw "caller wantarray runcv";
 @{$priv{coreargs}}{1,2,64,128} = ('DREF1','DREF2','$MOD','MARK');
 
 our %hints; # used to display each COP's op_hints values
diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index b9d9bbca47..91a7206ec7 100644
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -6,7 +6,7 @@ use strict;
 
 our($VERSION, @ISA, @EXPORT_OK);
 
-$VERSION = "1.21";
+$VERSION = "1.22";
 
 use Carp;
 use Exporter ();
@@ -543,7 +543,7 @@ This tag holds opcodes related to loading modules and getting information
 about calling environment and args.
 
     require dofile 
-    caller
+    caller runcv
 
 =item :still_to_be_decided
 
diff --git a/keywords.c b/keywords.c
index 921d55077e..a37752f34c 100644
--- a/keywords.c
+++ b/keywords.c
@@ -1906,7 +1906,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
           goto unknown;
       }
 
-    case 7: /* 29 tokens of length 7 */
+    case 7: /* 30 tokens of length 7 */
       switch (name[0])
       {
         case 'D':
@@ -1923,14 +1923,35 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
           goto unknown;
 
         case '_':
-          if (name[1] == '_' &&
-              name[2] == 'E' &&
-              name[3] == 'N' &&
-              name[4] == 'D' &&
-              name[5] == '_' &&
-              name[6] == '_')
-          {                                       /* __END__          */
-            return KEY___END__;
+          if (name[1] == '_')
+          {
+            switch (name[2])
+            {
+              case 'E':
+                if (name[3] == 'N' &&
+                    name[4] == 'D' &&
+                    name[5] == '_' &&
+                    name[6] == '_')
+                {                                 /* __END__          */
+                  return KEY___END__;
+                }
+
+                goto unknown;
+
+              case 'S':
+                if (name[3] == 'U' &&
+                    name[4] == 'B' &&
+                    name[5] == '_' &&
+                    name[6] == '_')
+                {                                 /* __SUB__          */
+                  return (all_keywords || FEATURE_IS_ENABLED("__SUB__") ? -KEY___SUB__ : 0);
+                }
+
+                goto unknown;
+
+              default:
+                goto unknown;
+            }
           }
 
           goto unknown;
@@ -3419,5 +3440,5 @@ unknown:
 }
 
 /* Generated from:
- * 370a83cf6eed30dfe61a9dc611013e1014e0c5f537dc4f3872576ba8b9ef7572 regen/keywords.pl
+ * 76ce12941a02bdb120222155311eb8772ba4a4e8965a42ba347a077cac5b426e regen/keywords.pl
  * ex: set ro: */
diff --git a/keywords.h b/keywords.h
index c33f6687c1..142ee0f939 100644
--- a/keywords.h
+++ b/keywords.h
@@ -19,255 +19,256 @@
 #define KEY___PACKAGE__		3
 #define KEY___DATA__		4
 #define KEY___END__		5
-#define KEY_AUTOLOAD		6
-#define KEY_BEGIN		7
-#define KEY_UNITCHECK		8
-#define KEY_CORE		9
-#define KEY_DESTROY		10
-#define KEY_END			11
-#define KEY_INIT		12
-#define KEY_CHECK		13
-#define KEY_abs			14
-#define KEY_accept		15
-#define KEY_alarm		16
-#define KEY_and			17
-#define KEY_atan2		18
-#define KEY_bind		19
-#define KEY_binmode		20
-#define KEY_bless		21
-#define KEY_break		22
-#define KEY_caller		23
-#define KEY_chdir		24
-#define KEY_chmod		25
-#define KEY_chomp		26
-#define KEY_chop		27
-#define KEY_chown		28
-#define KEY_chr			29
-#define KEY_chroot		30
-#define KEY_close		31
-#define KEY_closedir		32
-#define KEY_cmp			33
-#define KEY_connect		34
-#define KEY_continue		35
-#define KEY_cos			36
-#define KEY_crypt		37
-#define KEY_dbmclose		38
-#define KEY_dbmopen		39
-#define KEY_default		40
-#define KEY_defined		41
-#define KEY_delete		42
-#define KEY_die			43
-#define KEY_do			44
-#define KEY_dump		45
-#define KEY_each		46
-#define KEY_else		47
-#define KEY_elsif		48
-#define KEY_endgrent		49
-#define KEY_endhostent		50
-#define KEY_endnetent		51
-#define KEY_endprotoent		52
-#define KEY_endpwent		53
-#define KEY_endservent		54
-#define KEY_eof			55
-#define KEY_eq			56
-#define KEY_eval		57
-#define KEY_evalbytes		58
-#define KEY_exec		59
-#define KEY_exists		60
-#define KEY_exit		61
-#define KEY_exp			62
-#define KEY_fcntl		63
-#define KEY_fileno		64
-#define KEY_flock		65
-#define KEY_for			66
-#define KEY_foreach		67
-#define KEY_fork		68
-#define KEY_format		69
-#define KEY_formline		70
-#define KEY_ge			71
-#define KEY_getc		72
-#define KEY_getgrent		73
-#define KEY_getgrgid		74
-#define KEY_getgrnam		75
-#define KEY_gethostbyaddr	76
-#define KEY_gethostbyname	77
-#define KEY_gethostent		78
-#define KEY_getlogin		79
-#define KEY_getnetbyaddr	80
-#define KEY_getnetbyname	81
-#define KEY_getnetent		82
-#define KEY_getpeername		83
-#define KEY_getpgrp		84
-#define KEY_getppid		85
-#define KEY_getpriority		86
-#define KEY_getprotobyname	87
-#define KEY_getprotobynumber	88
-#define KEY_getprotoent		89
-#define KEY_getpwent		90
-#define KEY_getpwnam		91
-#define KEY_getpwuid		92
-#define KEY_getservbyname	93
-#define KEY_getservbyport	94
-#define KEY_getservent		95
-#define KEY_getsockname		96
-#define KEY_getsockopt		97
-#define KEY_given		98
-#define KEY_glob		99
-#define KEY_gmtime		100
-#define KEY_goto		101
-#define KEY_grep		102
-#define KEY_gt			103
-#define KEY_hex			104
-#define KEY_if			105
-#define KEY_index		106
-#define KEY_int			107
-#define KEY_ioctl		108
-#define KEY_join		109
-#define KEY_keys		110
-#define KEY_kill		111
-#define KEY_last		112
-#define KEY_lc			113
-#define KEY_lcfirst		114
-#define KEY_le			115
-#define KEY_length		116
-#define KEY_link		117
-#define KEY_listen		118
-#define KEY_local		119
-#define KEY_localtime		120
-#define KEY_lock		121
-#define KEY_log			122
-#define KEY_lstat		123
-#define KEY_lt			124
-#define KEY_m			125
-#define KEY_map			126
-#define KEY_mkdir		127
-#define KEY_msgctl		128
-#define KEY_msgget		129
-#define KEY_msgrcv		130
-#define KEY_msgsnd		131
-#define KEY_my			132
-#define KEY_ne			133
-#define KEY_next		134
-#define KEY_no			135
-#define KEY_not			136
-#define KEY_oct			137
-#define KEY_open		138
-#define KEY_opendir		139
-#define KEY_or			140
-#define KEY_ord			141
-#define KEY_our			142
-#define KEY_pack		143
-#define KEY_package		144
-#define KEY_pipe		145
-#define KEY_pop			146
-#define KEY_pos			147
-#define KEY_print		148
-#define KEY_printf		149
-#define KEY_prototype		150
-#define KEY_push		151
-#define KEY_q			152
-#define KEY_qq			153
-#define KEY_qr			154
-#define KEY_quotemeta		155
-#define KEY_qw			156
-#define KEY_qx			157
-#define KEY_rand		158
-#define KEY_read		159
-#define KEY_readdir		160
-#define KEY_readline		161
-#define KEY_readlink		162
-#define KEY_readpipe		163
-#define KEY_recv		164
-#define KEY_redo		165
-#define KEY_ref			166
-#define KEY_rename		167
-#define KEY_require		168
-#define KEY_reset		169
-#define KEY_return		170
-#define KEY_reverse		171
-#define KEY_rewinddir		172
-#define KEY_rindex		173
-#define KEY_rmdir		174
-#define KEY_s			175
-#define KEY_say			176
-#define KEY_scalar		177
-#define KEY_seek		178
-#define KEY_seekdir		179
-#define KEY_select		180
-#define KEY_semctl		181
-#define KEY_semget		182
-#define KEY_semop		183
-#define KEY_send		184
-#define KEY_setgrent		185
-#define KEY_sethostent		186
-#define KEY_setnetent		187
-#define KEY_setpgrp		188
-#define KEY_setpriority		189
-#define KEY_setprotoent		190
-#define KEY_setpwent		191
-#define KEY_setservent		192
-#define KEY_setsockopt		193
-#define KEY_shift		194
-#define KEY_shmctl		195
-#define KEY_shmget		196
-#define KEY_shmread		197
-#define KEY_shmwrite		198
-#define KEY_shutdown		199
-#define KEY_sin			200
-#define KEY_sleep		201
-#define KEY_socket		202
-#define KEY_socketpair		203
-#define KEY_sort		204
-#define KEY_splice		205
-#define KEY_split		206
-#define KEY_sprintf		207
-#define KEY_sqrt		208
-#define KEY_srand		209
-#define KEY_stat		210
-#define KEY_state		211
-#define KEY_study		212
-#define KEY_sub			213
-#define KEY_substr		214
-#define KEY_symlink		215
-#define KEY_syscall		216
-#define KEY_sysopen		217
-#define KEY_sysread		218
-#define KEY_sysseek		219
-#define KEY_system		220
-#define KEY_syswrite		221
-#define KEY_tell		222
-#define KEY_telldir		223
-#define KEY_tie			224
-#define KEY_tied		225
-#define KEY_time		226
-#define KEY_times		227
-#define KEY_tr			228
-#define KEY_truncate		229
-#define KEY_uc			230
-#define KEY_ucfirst		231
-#define KEY_umask		232
-#define KEY_undef		233
-#define KEY_unless		234
-#define KEY_unlink		235
-#define KEY_unpack		236
-#define KEY_unshift		237
-#define KEY_untie		238
-#define KEY_until		239
-#define KEY_use			240
-#define KEY_utime		241
-#define KEY_values		242
-#define KEY_vec			243
-#define KEY_wait		244
-#define KEY_waitpid		245
-#define KEY_wantarray		246
-#define KEY_warn		247
-#define KEY_when		248
-#define KEY_while		249
-#define KEY_write		250
-#define KEY_x			251
-#define KEY_xor			252
-#define KEY_y			253
+#define KEY___SUB__		6
+#define KEY_AUTOLOAD		7
+#define KEY_BEGIN		8
+#define KEY_UNITCHECK		9
+#define KEY_CORE		10
+#define KEY_DESTROY		11
+#define KEY_END			12
+#define KEY_INIT		13
+#define KEY_CHECK		14
+#define KEY_abs			15
+#define KEY_accept		16
+#define KEY_alarm		17
+#define KEY_and			18
+#define KEY_atan2		19
+#define KEY_bind		20
+#define KEY_binmode		21
+#define KEY_bless		22
+#define KEY_break		23
+#define KEY_caller		24
+#define KEY_chdir		25
+#define KEY_chmod		26
+#define KEY_chomp		27
+#define KEY_chop		28
+#define KEY_chown		29
+#define KEY_chr			30
+#define KEY_chroot		31
+#define KEY_close		32
+#define KEY_closedir		33
+#define KEY_cmp			34
+#define KEY_connect		35
+#define KEY_continue		36
+#define KEY_cos			37
+#define KEY_crypt		38
+#define KEY_dbmclose		39
+#define KEY_dbmopen		40
+#define KEY_default		41
+#define KEY_defined		42
+#define KEY_delete		43
+#define KEY_die			44
+#define KEY_do			45
+#define KEY_dump		46
+#define KEY_each		47
+#define KEY_else		48
+#define KEY_elsif		49
+#define KEY_endgrent		50
+#define KEY_endhostent		51
+#define KEY_endnetent		52
+#define KEY_endprotoent		53
+#define KEY_endpwent		54
+#define KEY_endservent		55
+#define KEY_eof			56
+#define KEY_eq			57
+#define KEY_eval		58
+#define KEY_evalbytes		59
+#define KEY_exec		60
+#define KEY_exists		61
+#define KEY_exit		62
+#define KEY_exp			63
+#define KEY_fcntl		64
+#define KEY_fileno		65
+#define KEY_flock		66
+#define KEY_for			67
+#define KEY_foreach		68
+#define KEY_fork		69
+#define KEY_format		70
+#define KEY_formline		71
+#define KEY_ge			72
+#define KEY_getc		73
+#define KEY_getgrent		74
+#define KEY_getgrgid		75
+#define KEY_getgrnam		76
+#define KEY_gethostbyaddr	77
+#define KEY_gethostbyname	78
+#define KEY_gethostent		79
+#define KEY_getlogin		80
+#define KEY_getnetbyaddr	81
+#define KEY_getnetbyname	82
+#define KEY_getnetent		83
+#define KEY_getpeername		84
+#define KEY_getpgrp		85
+#define KEY_getppid		86
+#define KEY_getpriority		87
+#define KEY_getprotobyname	88
+#define KEY_getprotobynumber	89
+#define KEY_getprotoent		90
+#define KEY_getpwent		91
+#define KEY_getpwnam		92
+#define KEY_getpwuid		93
+#define KEY_getservbyname	94
+#define KEY_getservbyport	95
+#define KEY_getservent		96
+#define KEY_getsockname		97
+#define KEY_getsockopt		98
+#define KEY_given		99
+#define KEY_glob		100
+#define KEY_gmtime		101
+#define KEY_goto		102
+#define KEY_grep		103
+#define KEY_gt			104
+#define KEY_hex			105
+#define KEY_if			106
+#define KEY_index		107
+#define KEY_int			108
+#define KEY_ioctl		109
+#define KEY_join		110
+#define KEY_keys		111
+#define KEY_kill		112
+#define KEY_last		113
+#define KEY_lc			114
+#define KEY_lcfirst		115
+#define KEY_le			116
+#define KEY_length		117
+#define KEY_link		118
+#define KEY_listen		119
+#define KEY_local		120
+#define KEY_localtime		121
+#define KEY_lock		122
+#define KEY_log			123
+#define KEY_lstat		124
+#define KEY_lt			125
+#define KEY_m			126
+#define KEY_map			127
+#define KEY_mkdir		128
+#define KEY_msgctl		129
+#define KEY_msgget		130
+#define KEY_msgrcv		131
+#define KEY_msgsnd		132
+#define KEY_my			133
+#define KEY_ne			134
+#define KEY_next		135
+#define KEY_no			136
+#define KEY_not			137
+#define KEY_oct			138
+#define KEY_open		139
+#define KEY_opendir		140
+#define KEY_or			141
+#define KEY_ord			142
+#define KEY_our			143
+#define KEY_pack		144
+#define KEY_package		145
+#define KEY_pipe		146
+#define KEY_pop			147
+#define KEY_pos			148
+#define KEY_print		149
+#define KEY_printf		150
+#define KEY_prototype		151
+#define KEY_push		152
+#define KEY_q			153
+#define KEY_qq			154
+#define KEY_qr			155
+#define KEY_quotemeta		156
+#define KEY_qw			157
+#define KEY_qx			158
+#define KEY_rand		159
+#define KEY_read		160
+#define KEY_readdir		161
+#define KEY_readline		162
+#define KEY_readlink		163
+#define KEY_readpipe		164
+#define KEY_recv		165
+#define KEY_redo		166
+#define KEY_ref			167
+#define KEY_rename		168
+#define KEY_require		169
+#define KEY_reset		170
+#define KEY_return		171
+#define KEY_reverse		172
+#define KEY_rewinddir		173
+#define KEY_rindex		174
+#define KEY_rmdir		175
+#define KEY_s			176
+#define KEY_say			177
+#define KEY_scalar		178
+#define KEY_seek		179
+#define KEY_seekdir		180
+#define KEY_select		181
+#define KEY_semctl		182
+#define KEY_semget		183
+#define KEY_semop		184
+#define KEY_send		185
+#define KEY_setgrent		186
+#define KEY_sethostent		187
+#define KEY_setnetent		188
+#define KEY_setpgrp		189
+#define KEY_setpriority		190
+#define KEY_setprotoent		191
+#define KEY_setpwent		192
+#define KEY_setservent		193
+#define KEY_setsockopt		194
+#define KEY_shift		195
+#define KEY_shmctl		196
+#define KEY_shmget		197
+#define KEY_shmread		198
+#define KEY_shmwrite		199
+#define KEY_shutdown		200
+#define KEY_sin			201
+#define KEY_sleep		202
+#define KEY_socket		203
+#define KEY_socketpair		204
+#define KEY_sort		205
+#define KEY_splice		206
+#define KEY_split		207
+#define KEY_sprintf		208
+#define KEY_sqrt		209
+#define KEY_srand		210
+#define KEY_stat		211
+#define KEY_state		212
+#define KEY_study		213
+#define KEY_sub			214
+#define KEY_substr		215
+#define KEY_symlink		216
+#define KEY_syscall		217
+#define KEY_sysopen		218
+#define KEY_sysread		219
+#define KEY_sysseek		220
+#define KEY_system		221
+#define KEY_syswrite		222
+#define KEY_tell		223
+#define KEY_telldir		224
+#define KEY_tie			225
+#define KEY_tied		226
+#define KEY_time		227
+#define KEY_times		228
+#define KEY_tr			229
+#define KEY_truncate		230
+#define KEY_uc			231
+#define KEY_ucfirst		232
+#define KEY_umask		233
+#define KEY_undef		234
+#define KEY_unless		235
+#define KEY_unlink		236
+#define KEY_unpack		237
+#define KEY_unshift		238
+#define KEY_untie		239
+#define KEY_until		240
+#define KEY_use			241
+#define KEY_utime		242
+#define KEY_values		243
+#define KEY_vec			244
+#define KEY_wait		245
+#define KEY_waitpid		246
+#define KEY_wantarray		247
+#define KEY_warn		248
+#define KEY_when		249
+#define KEY_while		250
+#define KEY_write		251
+#define KEY_x			252
+#define KEY_xor			253
+#define KEY_y			254
 
 /* Generated from:
- * 370a83cf6eed30dfe61a9dc611013e1014e0c5f537dc4f3872576ba8b9ef7572 regen/keywords.pl
+ * 76ce12941a02bdb120222155311eb8772ba4a4e8965a42ba347a077cac5b426e regen/keywords.pl
  * ex: set ro: */
diff --git a/lib/feature.pm b/lib/feature.pm
index ce73e2df96..c48b4e39f8 100644
--- a/lib/feature.pm
+++ b/lib/feature.pm
@@ -1,6 +1,6 @@
 package feature;
 
-our $VERSION = '1.23';
+our $VERSION = '1.24';
 
 # (feature name) => (internal name, used in %^H)
 my %feature = (
@@ -8,6 +8,7 @@ my %feature = (
     state           => 'feature_state',
     switch          => 'feature_switch',
     evalbytes       => 'feature_evalbytes',
+    current_sub     => 'feature___SUB__',
     unicode_eval    => 'feature_unieval',
     unicode_strings => 'feature_unicode',
 );
@@ -23,7 +24,7 @@ our %feature_bundle = (
     "5.10" => [qw(say state switch)],
     "5.11" => [qw(say state switch unicode_strings)],
     "5.15" => [qw(say state switch unicode_strings unicode_eval
-                  evalbytes)],
+                  evalbytes current_sub)],
 );
 
 # Each of these is the same as the previous bundle
@@ -178,6 +179,13 @@ C<evalbytes> fixes that to work the way one would expect:
 
 These two features are available starting with Perl 5.16.
 
+=head2 The 'current_sub' feature
+
+This provides the C<__SUB__> token that returns a reference to the current
+subroutine or C<undef> outside of a subroutine.
+
+This feature is available starting with Perl 5.16.
+
 =head1 FEATURE BUNDLES
 
 It's possible to load a whole slew of features in one go, using
diff --git a/op.c b/op.c
index ea0372df94..1b7a532349 100644
--- a/op.c
+++ b/op.c
@@ -10529,7 +10529,8 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
 	    return op_append_elem(
 	                OP_LINESEQ, argop,
 	                newOP(opnum,
-	                      opnum == OP_WANTARRAY ? OPpOFFBYONE << 8 : 0)
+	                      opnum == OP_WANTARRAY || opnum == OP_RUNCV
+	                        ? OPpOFFBYONE << 8 : 0)
 	           );
 	case OA_BASEOP_OR_UNOP:
 	    if (opnum == OP_ENTEREVAL) {
diff --git a/op.h b/op.h
index f82758e46e..958529e306 100644
--- a/op.h
+++ b/op.h
@@ -299,7 +299,7 @@ Deprecated.  Use C<GIMME_V> instead.
 #define OPpEVAL_BYTES		8
 #define OPpEVAL_COPHH		16	/* Construct %^H from cop hints */
     
-/* Private for OP_CALLER and OP_WANTARRAY */
+/* Private for OP_CALLER, OP_WANTARRAY and OP_RUNCV */
 #define OPpOFFBYONE		128	/* Treat caller(1) as caller(2) */
 
 /* Private for OP_COREARGS */
diff --git a/opcode.h b/opcode.h
index a1b9d2ee89..d747d9ad48 100644
--- a/opcode.h
+++ b/opcode.h
@@ -520,6 +520,7 @@ EXTCONST char* const PL_op_name[] = {
 	"rkeys",
 	"rvalues",
 	"coreargs",
+	"runcv",
 };
 #endif
 
@@ -899,6 +900,7 @@ EXTCONST char* const PL_op_desc[] = {
 	"keys on reference",
 	"values on reference",
 	"CORE:: subroutine",
+	"__SUB__",
 };
 #endif
 
@@ -1292,6 +1294,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
 	Perl_pp_rkeys,
 	Perl_pp_rvalues,	/* implemented by Perl_pp_rkeys */
 	Perl_pp_coreargs,
+	Perl_pp_runcv,
 }
 #endif
 #ifdef PERL_PPADDR_INITED
@@ -1682,6 +1685,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
 	Perl_ck_each,		/* rkeys */
 	Perl_ck_each,		/* rvalues */
 	Perl_ck_null,		/* coreargs */
+	Perl_ck_null,		/* runcv */
 }
 #endif
 #ifdef PERL_CHECK_INITED
@@ -2066,6 +2070,7 @@ EXTCONST U32 PL_opargs[] = {
 	0x00001b08,	/* rkeys */
 	0x00001b08,	/* rvalues */
 	0x00000600,	/* coreargs */
+	0x00000004,	/* runcv */
 };
 #endif
 
diff --git a/opnames.h b/opnames.h
index 26dfbaaac7..5d855ec447 100644
--- a/opnames.h
+++ b/opnames.h
@@ -386,10 +386,11 @@ typedef enum opcode {
 	OP_RKEYS	 = 369,
 	OP_RVALUES	 = 370,
 	OP_COREARGS	 = 371,
+	OP_RUNCV	 = 372,
 	OP_max		
 } opcode;
 
-#define MAXO 372
+#define MAXO 373
 
 /* the OP_IS_* macros are optimized to a simple range check because
     all the member OPs are contiguous in regen/opcodes table.
diff --git a/pod/perldata.pod b/pod/perldata.pod
index 7899e396e0..16ceb41048 100644
--- a/pod/perldata.pod
+++ b/pod/perldata.pod
@@ -398,12 +398,16 @@ X<end> X<data> X<^D> X<^Z>
 
 The special literals __FILE__, __LINE__, and __PACKAGE__
 represent the current filename, line number, and package name at that
-point in your program.  They may be used only as separate tokens; they
+point in your program.  __SUB__ gives a reference to the current
+subroutine.  They may be used only as separate tokens; they
 will not be interpolated into strings.  If there is no current package
 (due to an empty C<package;> directive), __PACKAGE__ is the undefined
 value. (But the empty C<package;> is no longer supported, as of version
-5.10.)
-X<__FILE__> X<__LINE__> X<__PACKAGE__> X<line> X<file> X<package>
+5.10.)  Outside of a subroutine, __SUB__ is the undefined value.  __SUB__
+is only available in 5.16 or higher, and only with a C<use v5.16> or
+C<use feature "current_sub"> declaration.
+X<__FILE__> X<__LINE__> X<__PACKAGE__> X<__SUB__>
+X<line> X<file> X<package>
 
 The two control characters ^D and ^Z, and the tokens __END__ and __DATA__
 may be used to indicate the logical end of the script before the actual
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 86770fd84a..f59ffdc744 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -164,7 +164,10 @@ X<control flow>
 C<caller>, C<continue>, C<die>, C<do>,
 C<dump>, C<eval>, C<evalbytes> C<exit>,
 C<__FILE__>, C<goto>, C<last>, C<__LINE__>, C<next>, C<__PACKAGE__>,
-C<redo>, C<return>, C<sub>, C<wantarray>,
+C<redo>, C<return>, C<sub>, C<__SUB__>, C<wantarray>
+
+C<__SUB__> is only available with a C<use v5.16> (or higher) declaration or
+with the C<"current_sub"> feature (see L<feature>).
 
 =item Keywords related to the switch feature
 
@@ -6908,6 +6911,15 @@ information about attributes.
 =item substr EXPR,OFFSET,LENGTH,REPLACEMENT
 X<substr> X<substring> X<mid> X<left> X<right>
 
+=item __SUB__
+X<__SUB__>
+
+A special token that returns the a reference to the current subroutine, or
+C<undef> outside of a subroutine.
+
+This token is only available under C<use v5.16> or the "current_sub"
+feature.  See L<feature>.
+
 =item substr EXPR,OFFSET,LENGTH
 
 =item substr EXPR,OFFSET
diff --git a/pp.c b/pp.c
index 7011ecfc95..27d6a00b0f 100644
--- a/pp.c
+++ b/pp.c
@@ -5794,6 +5794,25 @@ PP(pp_coreargs)
     RETURN;
 }
 
+PP(pp_runcv)
+{
+    dSP;
+    CV *cv;
+    if (PL_op->op_private & OPpOFFBYONE) {
+	PERL_SI * const oldsi = PL_curstackinfo;
+	I32 const oldcxix = oldsi->si_cxix;
+	if (oldcxix) oldsi->si_cxix--;
+	else PL_curstackinfo = oldsi->si_prev;
+	cv = find_runcv(NULL);
+	PL_curstackinfo = oldsi;
+	oldsi->si_cxix = oldcxix;
+    }
+    else cv = find_runcv(NULL);
+    XPUSHs(CvUNIQUE(cv) ? &PL_sv_undef : sv_2mortal(newRV((SV *)cv)));
+    RETURN;
+}
+
+
 /*
  * Local variables:
  * c-indentation-style: bsd
diff --git a/pp_proto.h b/pp_proto.h
index bc4622b2cc..96bcacbe6b 100644
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -199,6 +199,7 @@ PERL_CALLCONV OP *Perl_pp_rewinddir(pTHX);
 PERL_CALLCONV OP *Perl_pp_right_shift(pTHX);
 PERL_CALLCONV OP *Perl_pp_rkeys(pTHX);
 PERL_CALLCONV OP *Perl_pp_rmdir(pTHX);
+PERL_CALLCONV OP *Perl_pp_runcv(pTHX);
 PERL_CALLCONV OP *Perl_pp_rv2av(pTHX);
 PERL_CALLCONV OP *Perl_pp_rv2cv(pTHX);
 PERL_CALLCONV OP *Perl_pp_rv2gv(pTHX);
diff --git a/regen/keywords.pl b/regen/keywords.pl
index c4cd187273..2cfc5d8641 100755
--- a/regen/keywords.pl
+++ b/regen/keywords.pl
@@ -47,6 +47,8 @@ my %feature_kw = (
 	state	=> 'state',
 
 	evalbytes=>'evalbytes',
+
+	__SUB__ => '__SUB__',
 	);
 
 my %pos = map { ($_ => 1) } @{$by_strength{'+'}};
@@ -115,6 +117,7 @@ __END__
 -__PACKAGE__
 +__DATA__
 +__END__
+-__SUB__
 +AUTOLOAD
 +BEGIN
 +UNITCHECK
diff --git a/regen/opcodes b/regen/opcodes
index f75411e398..c7b42c40a0 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -543,3 +543,5 @@ rvalues		values on reference			ck_each		t%	S
 
 # For CORE:: subs
 coreargs	CORE:: subroutine	ck_null		$	
+
+runcv		__SUB__			ck_null		s0
diff --git a/t/op/coreamp.t b/t/op/coreamp.t
index d3f03eb58a..4285157fe7 100644
--- a/t/op/coreamp.t
+++ b/t/op/coreamp.t
@@ -235,10 +235,13 @@ sub test_proto {
 test_proto '__FILE__';
 test_proto '__LINE__';
 test_proto '__PACKAGE__';
+test_proto '__SUB__';
 
 is file(), 'frob'    , '__FILE__ does check its caller'   ; ++ $tests;
 is line(),  5        , '__LINE__ does check its caller'   ; ++ $tests;
 is pakg(), 'stribble', '__PACKAGE__ does check its caller'; ++ $tests;
+sub __SUB__test { &my__SUB__ }
+is __SUB__test, \&__SUB__test, '&__SUB__';                  ++ $tests;
 
 test_proto 'abs', -5, 5;
 
diff --git a/t/op/cproto.t b/t/op/cproto.t
index ad2249df2c..dabb4bc4a6 100644
--- a/t/op/cproto.t
+++ b/t/op/cproto.t
@@ -7,7 +7,7 @@ BEGIN {
 }
 
 BEGIN { require './test.pl'; }
-plan tests => 246;
+plan tests => 247;
 
 while (<DATA>) {
     chomp;
@@ -32,6 +32,7 @@ __LINE__ ()
 __PACKAGE__ ()
 __DATA__ undef
 __END__ undef
+__SUB__ ()
 CORE unknown
 abs (_)
 accept (**)
diff --git a/t/op/current_sub.t b/t/op/current_sub.t
new file mode 100644
index 0000000000..7a00032c46
--- /dev/null
+++ b/t/op/current_sub.t
@@ -0,0 +1,39 @@
+#!./perl
+
+BEGIN {
+    chdir 't';
+    @INC = qw(../lib);
+    require './test.pl';
+}
+
+plan tests => 11;
+
+is __SUB__, "__SUB__", '__SUB__ is a bareword outside of use feature';
+
+{
+    use v5.15;
+    is __SUB__, undef, '__SUB__ under use v5.16';
+}
+
+use feature 'current_sub';
+
+is __SUB__, undef, '__SUB__ returns undef outside of a subroutine';
+is +()=__SUB__, 1, '__SUB__ returns undef in list context';
+
+sub foo { __SUB__ }
+is foo, \&foo, '__SUB__ inside a named subroutine';
+is foo->(), \&foo, '__SUB__ is callable';
+is ref foo, 'CODE', '__SUB__ is a code reference';
+
+my $subsub = sub { __SUB__ };
+is &$subsub, $subsub, '__SUB__ inside anonymous non-closure';
+
+my @subsubs;
+for my $x(1..3) {
+  push @subsubs, sub { return $x if @_; __SUB__ };
+}
+# Don’t loop here; we need to avoid interactions between the iterator
+# and the closure.
+is $subsubs[0]()(0), 1, '__SUB__ inside closure (1)';
+is $subsubs[1]()(0), 2, '__SUB__ inside closure (2)';
+is $subsubs[2]()(0), 3, '__SUB__ inside closure (3)';
diff --git a/toke.c b/toke.c
index 8690877138..7b5c465daf 100644
--- a/toke.c
+++ b/toke.c
@@ -7119,6 +7119,9 @@ Perl_yylex(pTHX)
 	    goto fake_eof;
 	}
 
+	case KEY___SUB__:
+	    FUN0(OP_RUNCV);
+
 	case KEY_AUTOLOAD:
 	case KEY_DESTROY:
 	case KEY_BEGIN: