perlglossary: Add defn for "code point"

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index 78e5760..5445da9 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -77,7 +77,7 @@ Perl_cxinc(pTHX)
     dVAR;
     const IV old_max = cxstack_max;
     cxstack_max = GROW(cxstack_max);
-    Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);     /* XXX should fix CXINC macro */
+    Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);
     /* Without any kind of initialising deep enough recursion
      * will end up reading uninitialised PERL_CONTEXTs. */
     PoisonNew(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
@@ -285,7 +285,7 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty)
     SSPUSHINT(SvFAKE(gv));
     SSPUSHPTR(GvGP(gv));
     SSPUSHPTR(SvREFCNT_inc(gv));
-    SSPUSHINT(SAVEt_GP);
+    SSPUSHUV(SAVEt_GP);
 
     /* Don't let the localized GV coerce into non-glob, otherwise we would
      * not be able to restore GP upon leave from context if that happened */
@@ -373,10 +373,9 @@ Perl_save_bool(pTHX_ bool *boolp)
 
     PERL_ARGS_ASSERT_SAVE_BOOL;
 
-    SSCHECK(3);
-    SSPUSHBOOL(*boolp);
+    SSCHECK(2);
     SSPUSHPTR(boolp);
-    SSPUSHUV(SAVEt_BOOL);
+    SSPUSHUV(SAVEt_BOOL | (*boolp << 8));
 }
 
 void
@@ -393,10 +392,16 @@ void
 Perl_save_int(pTHX_ int *intp)
 {
     dVAR;
+    const UV shifted = (UV)*intp << SAVE_TIGHT_SHIFT;
 
     PERL_ARGS_ASSERT_SAVE_INT;
 
-    save_pushi32ptr(*intp, intp, SAVEt_INT);
+    if ((int)(shifted >> SAVE_TIGHT_SHIFT) == *intp) {
+       SSCHECK(2);
+       SSPUSHPTR(intp);
+       SSPUSHUV(SAVEt_INT_SMALL | shifted);
+    } else
+       save_pushi32ptr(*intp, intp, SAVEt_INT);
 }
 
 void
@@ -406,7 +411,9 @@ Perl_save_I8(pTHX_ I8 *bytep)
 
     PERL_ARGS_ASSERT_SAVE_I8;
 
-    save_pushi32ptr(*bytep, bytep, SAVEt_I8);
+    SSCHECK(2);
+    SSPUSHPTR(bytep);
+    SSPUSHUV(SAVEt_I8 | ((UV)*bytep << 8));
 }
 
 void
@@ -416,17 +423,25 @@ Perl_save_I16(pTHX_ I16 *intp)
 
     PERL_ARGS_ASSERT_SAVE_I16;
 
-    save_pushi32ptr(*intp, intp, SAVEt_I16);
+    SSCHECK(2);
+    SSPUSHPTR(intp);
+    SSPUSHUV(SAVEt_I16 | ((UV)*intp << 8));
 }
 
 void
 Perl_save_I32(pTHX_ I32 *intp)
 {
     dVAR;
+    const UV shifted = (UV)*intp << SAVE_TIGHT_SHIFT;
 
     PERL_ARGS_ASSERT_SAVE_I32;
 
-    save_pushi32ptr(*intp, intp, SAVEt_I32);
+    if ((I32)(shifted >> SAVE_TIGHT_SHIFT) == *intp) {
+       SSCHECK(2);
+       SSPUSHPTR(intp);
+       SSPUSHUV(SAVEt_I32_SMALL | shifted);
+    } else
+       save_pushi32ptr(*intp, intp, SAVEt_I32);
 }
 
 /* Cannot use save_sptr() to store a char* since the SV** cast will
@@ -507,13 +522,18 @@ void
 Perl_save_clearsv(pTHX_ SV **svp)
 {
     dVAR;
+    const UV offset = svp - PL_curpad;
+    const UV offset_shifted = offset << SAVE_TIGHT_SHIFT;
 
     PERL_ARGS_ASSERT_SAVE_CLEARSV;
 
     ASSERT_CURPAD_ACTIVE("save_clearsv");
-    SSCHECK(2);
-    SSPUSHLONG((long)(svp-PL_curpad));
-    SSPUSHUV(SAVEt_CLEARSV);
+    if ((offset_shifted >> SAVE_TIGHT_SHIFT) != offset)
+       Perl_croak(aTHX_ "panic: pad offset %"UVuf" out of range (%p-%p)",
+                  offset, svp, PL_curpad);
+
+    SSCHECK(1);
+    SSPUSHUV(offset_shifted | SAVEt_CLEARSV);
     SvPADSTALE_off(*svp); /* mark lexical as active */
 }
 
@@ -675,13 +695,17 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad)
     dVAR;
     register const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
                                - (char*)PL_savestack);
-    register const I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
+    const UV elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
+    const UV elems_shifted = elems << SAVE_TIGHT_SHIFT;
 
-    SSGROW(elems + 2);
+    if ((elems_shifted >> SAVE_TIGHT_SHIFT) != elems)
+       Perl_croak(aTHX_ "panic: save_alloc elems %"UVuf" out of range (%ld-%ld)",
+                  elems, size, pad);
+
+    SSGROW(elems + 1);
 
     PL_savestack_ix += elems;
-    SSPUSHINT(elems);
-    SSPUSHUV(SAVEt_ALLOC);
+    SSPUSHUV(SAVEt_ALLOC | elems_shifted);
     return start;
 }
 
@@ -784,13 +808,21 @@ Perl_leave_scope(pTHX_ I32 base)
                PL_localizing = 0;
            }
            break;
+       case SAVEt_INT_SMALL:
+           ptr = SSPOPPTR;
+           *(int*)ptr = (int)(uv >> SAVE_TIGHT_SHIFT);
+           break;
        case SAVEt_INT:                         /* int reference */
            ptr = SSPOPPTR;
            *(int*)ptr = (int)SSPOPINT;
            break;
        case SAVEt_BOOL:                        /* bool reference */
            ptr = SSPOPPTR;
-           *(bool*)ptr = cBOOL(SSPOPBOOL);
+           *(bool*)ptr = cBOOL(uv >> 8);
+           break;
+       case SAVEt_I32_SMALL:
+           ptr = SSPOPPTR;
+           *(I32*)ptr = (I32)(uv >> SAVE_TIGHT_SHIFT);
            break;
        case SAVEt_I32:                         /* I32 reference */
            ptr = SSPOPPTR;
@@ -850,7 +882,7 @@ Perl_leave_scope(pTHX_ I32 base)
            Safefree(ptr);
            break;
        case SAVEt_CLEARSV:
-           ptr = (void*)&PL_curpad[SSPOPLONG];
+           ptr = (void*)&PL_curpad[uv >> SAVE_TIGHT_SHIFT];
            sv = *(SV**)ptr;
 
            DEBUG_Xv(PerlIO_printf(Perl_debug_log,
@@ -926,9 +958,9 @@ Perl_leave_scope(pTHX_ I32 base)
            (*SSPOPDXPTR)(aTHX_ ptr);
            break;
        case SAVEt_REGCONTEXT:
+           /* regexp must have croaked */
        case SAVEt_ALLOC:
-           i = SSPOPINT;
-           PL_savestack_ix -= i;       /* regexp must have croaked */
+           PL_savestack_ix -= uv >> SAVE_TIGHT_SHIFT;
            break;
        case SAVEt_STACK_POS:           /* Position on Perl stack */
            i = SSPOPINT;
@@ -1076,11 +1108,11 @@ Perl_leave_scope(pTHX_ I32 base)
 
        case SAVEt_I16:                         /* I16 reference */
            ptr = SSPOPPTR;
-           *(I16*)ptr = (I16)SSPOPINT;
+           *(I16*)ptr = (I16)(uv >> 8);
            break;
        case SAVEt_I8:                          /* I8 reference */
            ptr = SSPOPPTR;
-           *(I8*)ptr = (I8)SSPOPINT;
+           *(I8*)ptr = (I8)(uv >> 8);
            break;
        case SAVEt_DESTRUCTOR:
            ptr = SSPOPPTR;