[asperl] integrate latest win32 branch
[p5sagit/p5-mst-13.2.git] / mg.c
diff --git a/mg.c b/mg.c
index 12e2748..a487674 100644 (file)
--- a/mg.c
+++ b/mg.c
  */
 
 #ifdef PERL_OBJECT
-static void UnwindHandler(void *pPerl, void *ptr)
-{
-       ((CPerlObj*)pPerl)->unwind_handler_stack(ptr);
-}
 
-static void RestoreMagic(void *pPerl, void *ptr)
-{
-       ((CPerlObj*)pPerl)->restore_magic(ptr);
-}
-#define UNWINDHANDLER   UnwindHandler
-#define RESTOREMAGIC    RestoreMagic
 #define VTBL            this->*vtbl
 
 #else
@@ -52,8 +42,6 @@ struct magic_state {
 typedef struct magic_state MGS;
 
 static void restore_magic _((void *p));
-#define UNWINDHANDLER   unwind_handler_stack
-#define RESTOREMAGIC   restore_magic
 #define VTBL                   *vtbl
 
 #endif
@@ -65,7 +53,7 @@ save_magic(MGS *mgs, SV *sv)
 
     mgs->mgs_sv = sv;
     mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv);
-    SAVEDESTRUCTOR(RESTOREMAGIC, mgs);
+    SAVEDESTRUCTOR(restore_magic, mgs);
 
     SvMAGICAL_off(sv);
     SvREADONLY_off(sv);
@@ -166,7 +154,7 @@ mg_set(SV *sv)
 }
 
 U32
-mg_len(SV *sv)
+mg_length(SV *sv)
 {
     MAGIC* mg;
     char *junk;
@@ -190,6 +178,37 @@ mg_len(SV *sv)
     return len;
 }
 
+I32
+mg_size(SV *sv)
+{
+    MAGIC* mg;
+    I32 len;
+    
+    for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+       MGVTBL* vtbl = mg->mg_virtual;
+       if (vtbl && (vtbl->svt_len != NULL)) {
+           MGS mgs;
+           ENTER;
+           /* omit MGf_GSKIP -- not changed here */
+           len = (VTBL->svt_len)(sv, mg);
+           LEAVE;
+           return len;
+       }
+    }
+
+    switch(SvTYPE(sv)) {
+       case SVt_PVAV:
+           len = AvFILLp((AV *) sv); /* Fallback to non-tied array */
+           return len;
+       case SVt_PVHV:
+           /* FIXME */
+       default:
+           croak("Size magic not implemented");
+           break;
+    }
+    return 0;
+}
+
 int
 mg_clear(SV *sv)
 {
@@ -247,9 +266,9 @@ mg_free(SV *sv)
        if (vtbl && (vtbl->svt_free != NULL))
            (VTBL->svt_free)(sv, mg);
        if (mg->mg_ptr && mg->mg_type != 'g')
-           if (mg->mg_length >= 0)
+           if (mg->mg_len >= 0)
                Safefree(mg->mg_ptr);
-           else if (mg->mg_length == HEf_SVKEY)
+           else if (mg->mg_len == HEf_SVKEY)
                SvREFCNT_dec((SV*)mg->mg_ptr);
        if (mg->mg_flags & MGf_REFCOUNTED)
            SvREFCNT_dec(mg->mg_obj);
@@ -895,8 +914,9 @@ magic_setisa(SV *sv, MAGIC *mg)
 
     stash = GvSTASH(mg->mg_obj);
     svp = AvARRAY((AV*)sv);
-    
-    for (fill = AvFILL((AV*)sv); fill >= 0; fill--, svp++) {
+                
+    /* NOTE: No support for tied ISA */
+    for (fill = AvFILLp((AV*)sv); fill >= 0; fill--, svp++) {
        HV *basestash = gv_stashsv(*svp, FALSE);
 
        if (!basestash) {
@@ -950,30 +970,46 @@ magic_setnkeys(SV *sv, MAGIC *mg)
        LvTARG(sv) = Nullsv;    /* Don't allow a ref to reassign this. */
     }
     return 0;
-}
+}          
 
 STATIC int
-magic_methpack(SV *sv, MAGIC *mg, char *meth)
+magic_methcall(MAGIC *mg, char *meth, I32 flags, int n, SV *val)
 {
     dSP;
 
-    ENTER;
-    SAVETMPS;
     PUSHMARK(sp);
-    EXTEND(sp, 2);
+    EXTEND(sp, n);
     PUSHs(mg->mg_obj);
-    if (mg->mg_ptr) {
-       if (mg->mg_length >= 0)
-           PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_length)));
-       else if (mg->mg_length == HEf_SVKEY)
-           PUSHs((SV*)mg->mg_ptr);
+    if (n > 1) { 
+       if (mg->mg_ptr) {
+           if (mg->mg_len >= 0)
+               PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
+           else if (mg->mg_len == HEf_SVKEY)
+               PUSHs((SV*)mg->mg_ptr);
+       }
+       else if (mg->mg_type == 'p') {
+           PUSHs(sv_2mortal(newSViv(mg->mg_len)));
+       }
+    }
+    if (n > 2) {
+       PUSHs(val);
     }
-    else if (mg->mg_type == 'p')
-       PUSHs(sv_2mortal(newSViv(mg->mg_length)));
     PUTBACK;
 
-    if (perl_call_method(meth, G_SCALAR))
+    return perl_call_method(meth, flags);
+}
+
+STATIC int
+magic_methpack(SV *sv, MAGIC *mg, char *meth)
+{
+    dSP;
+
+    ENTER;
+    SAVETMPS;
+
+    if (magic_methcall(mg, meth, G_SCALAR, 2, NULL)) {
        sv_setsv(sv, *stack_sp--);
+    }
 
     FREETMPS;
     LEAVE;
@@ -991,25 +1027,10 @@ magic_getpack(SV *sv, MAGIC *mg)
 
 int
 magic_setpack(SV *sv, MAGIC *mg)
-{
-    dSP;
-
-    PUSHMARK(sp);
-    EXTEND(sp, 3);
-    PUSHs(mg->mg_obj);
-    if (mg->mg_ptr) {
-       if (mg->mg_length >= 0)
-           PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_length)));
-       else if (mg->mg_length == HEf_SVKEY)
-           PUSHs((SV*)mg->mg_ptr);
-    }
-    else if (mg->mg_type == 'p')
-       PUSHs(sv_2mortal(newSViv(mg->mg_length)));
-    PUSHs(sv);
-    PUTBACK;
-
-    perl_call_method("STORE", G_SCALAR|G_DISCARD);
-
+{   
+    ENTER;
+    magic_methcall(mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
+    LEAVE;
     return 0;
 }
 
@@ -1019,6 +1040,24 @@ magic_clearpack(SV *sv, MAGIC *mg)
     return magic_methpack(sv,mg,"DELETE");
 }
 
+
+U32
+magic_sizepack(SV *sv, MAGIC *mg)
+{         
+    dTHR;
+    U32 retval = 0;
+
+    ENTER;
+    SAVETMPS;
+    if (magic_methcall(mg, "FETCHSIZE", G_SCALAR, 2, NULL)) {
+       sv = *stack_sp--;
+       retval = (U32) SvIV(sv)-1;
+    }
+    FREETMPS;
+    LEAVE;
+    return retval;
+}
+
 int magic_wipepack(SV *sv, MAGIC *mg)
 {
     dSP;
@@ -1026,9 +1065,9 @@ int magic_wipepack(SV *sv, MAGIC *mg)
     PUSHMARK(sp);
     XPUSHs(mg->mg_obj);
     PUTBACK;
-
+    ENTER;
     perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
-
+    LEAVE;
     return 0;
 }
 
@@ -1104,9 +1143,9 @@ magic_getpos(SV *sv, MAGIC *mg)
     
     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
        mg = mg_find(lsv, 'g');
-       if (mg && mg->mg_length >= 0) {
+       if (mg && mg->mg_len >= 0) {
            dTHR;
-           sv_setiv(sv, mg->mg_length + curcop->cop_arybase);
+           sv_setiv(sv, mg->mg_len + curcop->cop_arybase);
            return 0;
        }
     }
@@ -1132,7 +1171,7 @@ magic_setpos(SV *sv, MAGIC *mg)
        mg = mg_find(lsv, 'g');
     }
     else if (!SvOK(sv)) {
-       mg->mg_length = -1;
+       mg->mg_len = -1;
        return 0;
     }
     len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
@@ -1145,7 +1184,7 @@ magic_setpos(SV *sv, MAGIC *mg)
     }
     else if (pos > len)
        pos = len;
-    mg->mg_length = pos;
+    mg->mg_len = pos;
     mg->mg_flags &= ~MGf_MINMATCH;
 
     return 0;
@@ -1197,8 +1236,8 @@ int
 magic_gettaint(SV *sv, MAGIC *mg)
 {
     dTHR;
-    TAINT_IF((mg->mg_length & 1) ||
-            (mg->mg_length & 2) && mg->mg_obj == sv);  /* kludge */
+    TAINT_IF((mg->mg_len & 1) ||
+            (mg->mg_len & 2) && mg->mg_obj == sv);     /* kludge */
     return 0;
 }
 
@@ -1208,14 +1247,14 @@ magic_settaint(SV *sv, MAGIC *mg)
     dTHR;
     if (localizing) {
        if (localizing == 1)
-           mg->mg_length <<= 1;
+           mg->mg_len <<= 1;
        else
-           mg->mg_length >>= 1;
+           mg->mg_len >>= 1;
     }
     else if (tainted)
-       mg->mg_length |= 1;
+       mg->mg_len |= 1;
     else
-       mg->mg_length &= ~1;
+       mg->mg_len &= ~1;
     return 0;
 }
 
@@ -1238,7 +1277,7 @@ magic_getdefelem(SV *sv, MAGIC *mg)
                targ = HeVAL(he);
        }
        else {
-           AV* av = (AV*)LvTARG(sv);
+           AV* av = (AV*)LvTARG(sv); 
            if ((I32)LvTARGOFF(sv) <= AvFILL(av))
                targ = AvARRAY(av)[LvTARGOFF(sv)];
        }
@@ -1315,7 +1354,7 @@ vivify_defelem(SV *sv)
 int
 magic_setmglob(SV *sv, MAGIC *mg)
 {
-    mg->mg_length = -1;
+    mg->mg_len = -1;
     SvSCREAM_off(sv);
     return 0;
 }
@@ -1365,7 +1404,7 @@ magic_setcollxfrm(SV *sv, MAGIC *mg)
     if (mg->mg_ptr) {
        Safefree(mg->mg_ptr);
        mg->mg_ptr = NULL;
-       mg->mg_length = -1;
+       mg->mg_len = -1;
     }
     return 0;
 }
@@ -1815,7 +1854,7 @@ sighandler(int sig)
     if (flags & 1) {
        savestack_ix += 5;              /* Protect save in progress. */
        o_save_i = savestack_ix;
-       SAVEDESTRUCTOR(UNWINDHANDLER, (void*)&flags);
+       SAVEDESTRUCTOR(unwind_handler_stack, (void*)&flags);
     }
     if (flags & 4) 
        markstack_ptr++;                /* Protect mark. */
@@ -1842,7 +1881,7 @@ sighandler(int sig)
 
     oldstack = curstack;
     if (curstack != signalstack)
-       AvFILL(signalstack) = 0;
+       AvFILLp(signalstack) = 0;
     SWITCHSTACK(curstack, signalstack);
 
     if(psig_name[sig]) {