Create defer syntax and OP_PUSHDEFER opcode

Adds syntax `defer { BLOCK }` to create a deferred block; code that is
deferred until the scope exits. This syntax is guarded by

  use feature 'defer';

Adds a new opcode, `OP_PUSHDEFER`, which is a LOGOP whose `op_other` field
gives the start of an optree to be deferred until scope exit. That op
pointer will be stored on the save stack and invoked as part of scope
unwind.

Included is support for `B::Deparse` to deparse the optree back into
syntax.

MANIFEST

@@ -5852,6 +5852,7 @@ 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/decl-refs.t		See if my \$foo works
+t/op/defer.t			See if defer blocks work
 t/op/defined.t			See if defined() edge cases work
 t/op/defins.t			See if auto-insert of defined() works
 t/op/delete.t			See if delete works

cop.h

@@ -1047,6 +1047,7 @@ struct context {
 #define CXt_FORMAT     10
 #define CXt_EVAL       11 /* eval'', eval{}, try{} */
 #define CXt_SUBST      12
+#define CXt_DEFER      13
 /* SUBST doesn't feature in all switch statements.  */
 
 /* private flags for CXt_SUB and CXt_FORMAT */

embed.fnc

@@ -1460,6 +1460,7 @@ ApdR	|OP*	|newSTATEOP	|I32 flags|NULLOK char* label|NULLOK OP* o
 AdpbM	|CV*	|newSUB		|I32 floor|NULLOK OP* o|NULLOK OP* proto \
 				|NULLOK OP* block
 ApdRx	|OP*	|newTRYCATCHOP	|I32 flags|NN OP* tryblock|NN OP *catchvar|NN OP* catchblock
+ApdRx	|OP*	|newDEFEROP	|I32 flags|NN OP *block
 pd	|CV *	|newXS_len_flags|NULLOK const char *name|STRLEN len \
 				|NN XSUBADDR_t subaddr\
 				|NULLOK const char *const filename \

embed.h

@@ -352,6 +352,7 @@
 #define newCONSTSUB(a,b,c)	Perl_newCONSTSUB(aTHX_ a,b,c)
 #define newCONSTSUB_flags(a,b,c,d,e)	Perl_newCONSTSUB_flags(aTHX_ a,b,c,d,e)
 #define newCVREF(a,b)		Perl_newCVREF(aTHX_ a,b)
+#define newDEFEROP(a,b)		Perl_newDEFEROP(aTHX_ a,b)
 #define newDEFSVOP()		Perl_newDEFSVOP(aTHX)
 #define newFORM(a,b,c)		Perl_newFORM(aTHX_ a,b,c)
 #define newFOROP(a,b,c,d,e)	Perl_newFOROP(aTHX_ a,b,c,d,e)

ext/Opcode/Opcode.pm

@@ -441,6 +441,8 @@ These are a hotchpotch of opcodes still waiting to be considered
     break continue
     smartmatch
 
+    pushdefer
+
     custom -- where should this go
 
 =item :base_math

feature.h

@@ -16,20 +16,21 @@
 #define FEATURE_BITWISE_BIT              0x0002
 #define FEATURE___SUB___BIT              0x0004
 #define FEATURE_MYREF_BIT                0x0008
-#define FEATURE_EVALBYTES_BIT            0x0010
-#define FEATURE_FC_BIT                   0x0020
-#define FEATURE_INDIRECT_BIT             0x0040
-#define FEATURE_ISA_BIT                  0x0080
-#define FEATURE_MULTIDIMENSIONAL_BIT     0x0100
-#define FEATURE_POSTDEREF_QQ_BIT         0x0200
-#define FEATURE_REFALIASING_BIT          0x0400
-#define FEATURE_SAY_BIT                  0x0800
-#define FEATURE_SIGNATURES_BIT           0x1000
-#define FEATURE_STATE_BIT                0x2000
-#define FEATURE_SWITCH_BIT               0x4000
-#define FEATURE_TRY_BIT                  0x8000
-#define FEATURE_UNIEVAL_BIT              0x10000
-#define FEATURE_UNICODE_BIT              0x20000
+#define FEATURE_DEFER_BIT                0x0010
+#define FEATURE_EVALBYTES_BIT            0x0020
+#define FEATURE_FC_BIT                   0x0040
+#define FEATURE_INDIRECT_BIT             0x0080
+#define FEATURE_ISA_BIT                  0x0100
+#define FEATURE_MULTIDIMENSIONAL_BIT     0x0200
+#define FEATURE_POSTDEREF_QQ_BIT         0x0400
+#define FEATURE_REFALIASING_BIT          0x0800
+#define FEATURE_SAY_BIT                  0x1000
+#define FEATURE_SIGNATURES_BIT           0x2000
+#define FEATURE_STATE_BIT                0x4000
+#define FEATURE_SWITCH_BIT               0x8000
+#define FEATURE_TRY_BIT                  0x10000
+#define FEATURE_UNIEVAL_BIT              0x20000
+#define FEATURE_UNICODE_BIT              0x40000
 
 #define FEATURE_BUNDLE_DEFAULT	0
 #define FEATURE_BUNDLE_510	1
@@ -80,6 +81,12 @@
 	 FEATURE_IS_ENABLED_MASK(FEATURE_TRY_BIT) \
     )
 
+#define FEATURE_DEFER_IS_ENABLED \
+    ( \
+	CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
+	 FEATURE_IS_ENABLED_MASK(FEATURE_DEFER_BIT) \
+    )
+
 #define FEATURE_STATE_IS_ENABLED \
     ( \
 	(CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_510 && \
@@ -268,6 +275,14 @@ S_magic_sethint_feature(pTHX_ SV *keysv, const char *keypv, STRLEN keylen,
             }
             return;
 
+        case 'd':
+            if (keylen == sizeof("feature_defer")-1
+                 && memcmp(subf+1, "efer", keylen - sizeof("feature_")) == 0) {
+                mask = FEATURE_DEFER_BIT;
+                break;
+            }
+            return;
+
         case 'e':
             if (keylen == sizeof("feature_evalbytes")-1
                  && memcmp(subf+1, "valbytes", keylen - sizeof("feature_")) == 0) {

gv.c

@@ -545,7 +545,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
         no support for funcs that do not parse like funcs */
     case KEY___DATA__: case KEY___END__: case KEY_and: case KEY_AUTOLOAD:
     case KEY_BEGIN   : case KEY_CHECK  : case KEY_catch : case KEY_cmp:
-    case KEY_default : case KEY_DESTROY:
+    case KEY_default : case KEY_defer  : case KEY_DESTROY:
     case KEY_do      : case KEY_dump   : case KEY_else  : case KEY_elsif  :
     case KEY_END     : case KEY_eq     : case KEY_eval  :
     case KEY_for     : case KEY_foreach: case KEY_format: case KEY_ge     :

keywords.c

@@ -978,7 +978,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
           goto unknown;
       }
 
-    case 5: /* 40 tokens of length 5 */
+    case 5: /* 41 tokens of length 5 */
       switch (name[0])
       {
         case 'B':
@@ -1142,6 +1142,17 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
               goto unknown;
           }
 
+        case 'd':
+          if (name[1] == 'e' &&
+              name[2] == 'f' &&
+              name[3] == 'e' &&
+              name[4] == 'r')
+          {                                       /* defer            */
+            return (all_keywords || FEATURE_DEFER_IS_ENABLED ? KEY_defer : 0);
+          }
+
+          goto unknown;
+
         case 'e':
           if (name[1] == 'l' &&
               name[2] == 's' &&
@@ -3475,5 +3486,5 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
 }
 
 /* Generated from:
- * 3a4f2004642b00b871c01cbdc018f6ca5ead6b4e0b2b184120c60b0b62a229dd regen/keywords.pl
+ * de1ee232f68ea8ae75d09f4f70b58fee8a6e6244dec3ab68baab54f7af9ce306 regen/keywords.pl
  * ex: set ro: */