1 files changed, 82 insertions, 52 deletions

diff --git a/mg.c b/mg.c
index 1d0014315d..12e2748dc9 100644
--- a/mg.c
+++ b/mg.c
@@ -30,6 +30,21 @@
  * Use the "DESTRUCTOR" scope cleanup to reinstate magic.
  */
 
+#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
 struct magic_state {
     SV* mgs_sv;
     U32 mgs_flags;
@@ -37,22 +52,27 @@ 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
 
-static void
+#endif
+
+STATIC void
 save_magic(MGS *mgs, SV *sv)
 {
     assert(SvMAGICAL(sv));
 
     mgs->mgs_sv = sv;
     mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv);
-    SAVEDESTRUCTOR(restore_magic, mgs);
+    SAVEDESTRUCTOR(RESTOREMAGIC, mgs);
 
     SvMAGICAL_off(sv);
     SvREADONLY_off(sv);
     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 }
 
-static void
+STATIC void
 restore_magic(void *p)
 {
     MGS* mgs = (MGS*)p;
@@ -76,11 +96,11 @@ mg_magical(SV *sv)
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
 	MGVTBL* vtbl = mg->mg_virtual;
 	if (vtbl) {
-	    if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
+	    if ((vtbl->svt_get != NULL) && !(mg->mg_flags & MGf_GSKIP))
 		SvGMAGICAL_on(sv);
 	    if (vtbl->svt_set)
 		SvSMAGICAL_on(sv);
-	    if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
+	    if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || (vtbl->svt_clear != NULL))
 		SvRMAGICAL_on(sv);
 	}
     }
@@ -100,8 +120,8 @@ mg_get(SV *sv)
     mgp = &SvMAGIC(sv);
     while ((mg = *mgp) != 0) {
 	MGVTBL* vtbl = mg->mg_virtual;
-	if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
-	    (*vtbl->svt_get)(sv, mg);
+	if (!(mg->mg_flags & MGf_GSKIP) && vtbl && (vtbl->svt_get != NULL)) {
+	    (VTBL->svt_get)(sv, mg);
 	    /* Ignore this magic if it's been deleted */
 	    if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) &&
 		  (mg->mg_flags & MGf_GSKIP))
@@ -137,8 +157,8 @@ mg_set(SV *sv)
 	    mg->mg_flags &= ~MGf_GSKIP;	/* setting requires another read */
 	    mgs.mgs_flags = 0;
 	}
-	if (vtbl && vtbl->svt_set)
-	    (*vtbl->svt_set)(sv, mg);
+	if (vtbl && (vtbl->svt_set != NULL))
+	    (VTBL->svt_set)(sv, mg);
     }
 
     LEAVE;
@@ -154,13 +174,13 @@ mg_len(SV *sv)
 
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
 	MGVTBL* vtbl = mg->mg_virtual;
-	if (vtbl && vtbl->svt_len) {
+	if (vtbl && (vtbl->svt_len != NULL)) {
 	    MGS mgs;
 
 	    ENTER;
 	    save_magic(&mgs, sv);
 	    /* omit MGf_GSKIP -- not changed here */
-	    len = (*vtbl->svt_len)(sv, mg);
+	    len = (VTBL->svt_len)(sv, mg);
 	    LEAVE;
 	    return len;
 	}
@@ -183,8 +203,8 @@ mg_clear(SV *sv)
 	MGVTBL* vtbl = mg->mg_virtual;
 	/* omit GSKIP -- never set here */
 	
-	if (vtbl && vtbl->svt_clear)
-	    (*vtbl->svt_clear)(sv, mg);
+	if (vtbl && (vtbl->svt_clear != NULL))
+	    (VTBL->svt_clear)(sv, mg);
     }
 
     LEAVE;
@@ -224,12 +244,12 @@ mg_free(SV *sv)
     for (mg = SvMAGIC(sv); mg; mg = moremagic) {
 	MGVTBL* vtbl = mg->mg_virtual;
 	moremagic = mg->mg_moremagic;
-	if (vtbl && vtbl->svt_free)
-	    (*vtbl->svt_free)(sv, mg);
+	if (vtbl && (vtbl->svt_free != NULL))
+	    (VTBL->svt_free)(sv, mg);
 	if (mg->mg_ptr && mg->mg_type != 'g')
-	    if (mg->mg_len >= 0)
+	    if (mg->mg_length >= 0)
 		Safefree(mg->mg_ptr);
-	    else if (mg->mg_len == HEf_SVKEY)
+	    else if (mg->mg_length == HEf_SVKEY)
 		SvREFCNT_dec((SV*)mg->mg_ptr);
 	if (mg->mg_flags & MGf_REFCOUNTED)
 	    SvREFCNT_dec(mg->mg_obj);
@@ -354,7 +374,17 @@ magic_get(SV *sv, MAGIC *mg)
 	    DWORD dwErr = GetLastError();
 	    sv_setnv(sv, (double)dwErr);
 	    if (dwErr)
+	    {
+#ifdef PERL_OBJECT
+		char *sMsg;
+		DWORD dwLen;
+		PerlProc_GetSysMsg(sMsg, dwLen, dwErr);
+		sv_setpvn(sv, sMsg, dwLen);
+		PerlProc_FreeBuf(sMsg);
+#else
 		win32_str_os_error(sv, dwErr);
+#endif
+	    }
 	    else
 		sv_setpv(sv, "");
 	    SetLastError(dwErr);
@@ -922,7 +952,7 @@ magic_setnkeys(SV *sv, MAGIC *mg)
     return 0;
 }
 
-static int
+STATIC int
 magic_methpack(SV *sv, MAGIC *mg, char *meth)
 {
     dSP;
@@ -933,13 +963,13 @@ magic_methpack(SV *sv, MAGIC *mg, char *meth)
     EXTEND(sp, 2);
     PUSHs(mg->mg_obj);
     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)
+	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_len)));
+	PUSHs(sv_2mortal(newSViv(mg->mg_length)));
     PUTBACK;
 
     if (perl_call_method(meth, G_SCALAR))
@@ -968,13 +998,13 @@ magic_setpack(SV *sv, MAGIC *mg)
     EXTEND(sp, 3);
     PUSHs(mg->mg_obj);
     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)
+	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_len)));
+	PUSHs(sv_2mortal(newSViv(mg->mg_length)));
     PUSHs(sv);
     PUTBACK;
 
@@ -1074,9 +1104,9 @@ magic_getpos(SV *sv, MAGIC *mg)
     
     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
 	mg = mg_find(lsv, 'g');
-	if (mg && mg->mg_len >= 0) {
+	if (mg && mg->mg_length >= 0) {
 	    dTHR;
-	    sv_setiv(sv, mg->mg_len + curcop->cop_arybase);
+	    sv_setiv(sv, mg->mg_length + curcop->cop_arybase);
 	    return 0;
 	}
     }
@@ -1102,7 +1132,7 @@ magic_setpos(SV *sv, MAGIC *mg)
 	mg = mg_find(lsv, 'g');
     }
     else if (!SvOK(sv)) {
-	mg->mg_len = -1;
+	mg->mg_length = -1;
 	return 0;
     }
     len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
@@ -1115,7 +1145,7 @@ magic_setpos(SV *sv, MAGIC *mg)
     }
     else if (pos > len)
 	pos = len;
-    mg->mg_len = pos;
+    mg->mg_length = pos;
     mg->mg_flags &= ~MGf_MINMATCH;
 
     return 0;
@@ -1167,8 +1197,8 @@ int
 magic_gettaint(SV *sv, MAGIC *mg)
 {
     dTHR;
-    TAINT_IF((mg->mg_len & 1) ||
-	     (mg->mg_len & 2) && mg->mg_obj == sv);	/* kludge */
+    TAINT_IF((mg->mg_length & 1) ||
+	     (mg->mg_length & 2) && mg->mg_obj == sv);	/* kludge */
     return 0;
 }
 
@@ -1178,14 +1208,14 @@ magic_settaint(SV *sv, MAGIC *mg)
     dTHR;
     if (localizing) {
 	if (localizing == 1)
-	    mg->mg_len <<= 1;
+	    mg->mg_length <<= 1;
 	else
-	    mg->mg_len >>= 1;
+	    mg->mg_length >>= 1;
     }
     else if (tainted)
-	mg->mg_len |= 1;
+	mg->mg_length |= 1;
     else
-	mg->mg_len &= ~1;
+	mg->mg_length &= ~1;
     return 0;
 }
 
@@ -1285,7 +1315,7 @@ vivify_defelem(SV *sv)
 int
 magic_setmglob(SV *sv, MAGIC *mg)
 {
-    mg->mg_len = -1;
+    mg->mg_length = -1;
     SvSCREAM_off(sv);
     return 0;
 }
@@ -1335,7 +1365,7 @@ magic_setcollxfrm(SV *sv, MAGIC *mg)
     if (mg->mg_ptr) {
 	Safefree(mg->mg_ptr);
 	mg->mg_ptr = NULL;
-	mg->mg_len = -1;
+	mg->mg_length = -1;
     }
     return 0;
 }
@@ -1515,15 +1545,15 @@ magic_set(SV *sv, MAGIC *mg)
       (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1);
 #else
 	if (uid == euid)		/* special case $< = $> */
-	    (void)setuid(uid);
+	    (void)PerlProc_setuid(uid);
 	else {
-	    uid = (I32)getuid();
+	    uid = (I32)PerlProc_getuid();
 	    croak("setruid() not implemented");
 	}
 #endif
 #endif
 #endif
-	uid = (I32)getuid();
+	uid = (I32)PerlProc_getuid();
 	tainting |= (uid && (euid != uid || egid != gid));
 	break;
     case '>':
@@ -1542,15 +1572,15 @@ magic_set(SV *sv, MAGIC *mg)
 	(void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
 #else
 	if (euid == uid)		/* special case $> = $< */
-	    setuid(euid);
+	    PerlProc_setuid(euid);
 	else {
-	    euid = (I32)geteuid();
+	    euid = (I32)PerlProc_geteuid();
 	    croak("seteuid() not implemented");
 	}
 #endif
 #endif
 #endif
-	euid = (I32)geteuid();
+	euid = (I32)PerlProc_geteuid();
 	tainting |= (uid && (euid != uid || egid != gid));
 	break;
     case '(':
@@ -1569,15 +1599,15 @@ magic_set(SV *sv, MAGIC *mg)
       (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1);
 #else
 	if (gid == egid)			/* special case $( = $) */
-	    (void)setgid(gid);
+	    (void)PerlProc_setgid(gid);
 	else {
-	    gid = (I32)getgid();
+	    gid = (I32)PerlProc_getgid();
 	    croak("setrgid() not implemented");
 	}
 #endif
 #endif
 #endif
-	gid = (I32)getgid();
+	gid = (I32)PerlProc_getgid();
 	tainting |= (uid && (euid != uid || egid != gid));
 	break;
     case ')':
@@ -1619,15 +1649,15 @@ magic_set(SV *sv, MAGIC *mg)
 	(void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1);
 #else
 	if (egid == gid)			/* special case $) = $( */
-	    (void)setgid(egid);
+	    (void)PerlProc_setgid(egid);
 	else {
-	    egid = (I32)getegid();
+	    egid = (I32)PerlProc_getegid();
 	    croak("setegid() not implemented");
 	}
 #endif
 #endif
 #endif
-	egid = (I32)getegid();
+	egid = (I32)PerlProc_getegid();
 	tainting |= (uid && (euid != uid || egid != gid));
 	break;
     case ':':
@@ -1731,7 +1761,7 @@ whichsig(char *sig)
 
 static SV* sig_sv;
 
-static void
+STATIC void
 unwind_handler_stack(void *p)
 {
     dTHR;
@@ -1785,7 +1815,7 @@ sighandler(int sig)
     if (flags & 1) {
 	savestack_ix += 5;		/* Protect save in progress. */
 	o_save_i = savestack_ix;
-	SAVEDESTRUCTOR(unwind_handler_stack, (void*)&flags);
+	SAVEDESTRUCTOR(UNWINDHANDLER, (void*)&flags);
     }
     if (flags & 4) 
 	markstack_ptr++;		/* Protect mark. */