[win32] add archname to *sitearch in config.{b,g,v}c

[p5sagit/p5-mst-13.2.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 34a175a..26886d1 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -38,7 +38,9 @@ extern "C" int syscall(unsigned long,...);
 
 #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
 # include <sys/socket.h>
-# include <netdb.h>
+# ifdef I_NETDB
+#  include <netdb.h>
+# endif
 # ifndef ENOTSOCK
 #  ifdef I_NET_ERRNO
 #   include <net/errno.h>
@@ -284,10 +286,10 @@ PP(pp_warn)
        tmps = SvPV(TOPs, na);
     }
     if (!tmps || !*tmps) {
-       (void)SvUPGRADE(errsv, SVt_PV);
-       if (SvPOK(errsv) && SvCUR(errsv))
-           sv_catpv(errsv, "\t...caught");
-       tmps = SvPV(errsv, na);
+       (void)SvUPGRADE(ERRSV, SVt_PV);
+       if (SvPOK(ERRSV) && SvCUR(ERRSV))
+           sv_catpv(ERRSV, "\t...caught");
+       tmps = SvPV(ERRSV, na);
     }
     if (!tmps || !*tmps)
        tmps = "Warning: something's wrong";
@@ -309,10 +311,10 @@ PP(pp_die)
        tmps = SvPV(TOPs, na);
     }
     if (!tmps || !*tmps) {
-       (void)SvUPGRADE(errsv, SVt_PV);
-       if (SvPOK(errsv) && SvCUR(errsv))
-           sv_catpv(errsv, "\t...propagated");
-       tmps = SvPV(errsv, na);
+       (void)SvUPGRADE(ERRSV, SVt_PV);
+       if (SvPOK(ERRSV) && SvCUR(ERRSV))
+           sv_catpv(ERRSV, "\t...propagated");
+       tmps = SvPV(ERRSV, na);
     }
     if (!tmps || !*tmps)
        tmps = "Died";
@@ -503,18 +505,21 @@ PP(pp_binmode)
 
 }
 
+
 PP(pp_tie)
 {
     djSP;
     SV *varsv;
     HV* stash;
     GV *gv;
-    BINOP myop;
     SV *sv;
     SV **mark = stack_base + ++*markstack_ptr; /* reuse in entersub */
     I32 markoff = mark - stack_base - 1;
     char *methname;
+#ifdef ORIGINAL_TIE
+    BINOP myop;
     bool oldcatch = CATCH_GET;
+#endif
 
     varsv = mark[0];
     if (SvTYPE(varsv) == SVt_PVHV)
@@ -531,6 +536,7 @@ PP(pp_tie)
        DIE("Can't locate object method \"%s\" via package \"%s\"",
                methname, SvPV(mark[1],na));
 
+#ifdef ORIGINAL_TIE
     Zero(&myop, 1, BINOP);
     myop.op_last = (OP *) &myop;
     myop.op_next = Nullop;
@@ -551,6 +557,11 @@ PP(pp_tie)
     SPAGAIN;
 
     CATCH_SET(oldcatch);
+#else
+    ENTER;
+    perl_call_sv((SV*)GvCV(gv), G_SCALAR);
+    SPAGAIN;
+#endif 
     sv = TOPs;
     if (sv_isobject(sv)) {
        if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) {
@@ -625,9 +636,11 @@ PP(pp_dbmopen)
     dPOPPOPssrl;
     HV* stash;
     GV *gv;
-    BINOP myop;
     SV *sv;
+#ifdef ORIGINAL_TIE
+    BINOP myop;
     bool oldcatch = CATCH_GET;
+#endif 
 
     hv = (HV*)POPs;
 
@@ -642,6 +655,7 @@ PP(pp_dbmopen)
            DIE("No dbm on this machine");
     }
 
+#ifdef ORIGINAL_TIE
     Zero(&myop, 1, BINOP);
     myop.op_last = (OP *) &myop;
     myop.op_next = Nullop;
@@ -655,7 +669,10 @@ PP(pp_dbmopen)
        op->op_private |= OPpENTERSUB_DB;
     PUTBACK;
     pp_pushmark(ARGS);
-
+#else
+    ENTER;
+    PUSHMARK(sp);
+#endif 
     EXTEND(sp, 5);
     PUSHs(sv);
     PUSHs(left);
@@ -664,32 +681,49 @@ PP(pp_dbmopen)
     else
        PUSHs(sv_2mortal(newSViv(O_RDWR)));
     PUSHs(right);
+#ifdef ORIGINAL_TIE
     PUSHs((SV*)GvCV(gv));
     PUTBACK;
 
     if (op = pp_entersub(ARGS))
         runops();
+#else
+    PUTBACK;
+    perl_call_sv((SV*)GvCV(gv), G_SCALAR);
+#endif 
     SPAGAIN;
 
     if (!sv_isobject(TOPs)) {
        sp--;
+#ifdef ORIGINAL_TIE
        op = (OP *) &myop;
        PUTBACK;
        pp_pushmark(ARGS);
+#else
+       PUSHMARK(sp);
+#endif 
 
        PUSHs(sv);
        PUSHs(left);
        PUSHs(sv_2mortal(newSViv(O_RDONLY)));
        PUSHs(right);
+#ifdef ORIGINAL_TIE
        PUSHs((SV*)GvCV(gv));
+#endif 
        PUTBACK;
 
+#ifdef ORIGINAL_TIE
        if (op = pp_entersub(ARGS))
            runops();
+#else
+       perl_call_sv((SV*)GvCV(gv), G_SCALAR);
+#endif 
        SPAGAIN;
     }
 
+#ifdef ORIGINAL_TIE
     CATCH_SET(oldcatch);
+#endif 
     if (sv_isobject(TOPs))
        sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
     LEAVE;
@@ -893,7 +927,7 @@ PP(pp_getc)
     if (!gv)
        gv = argvgv;
 
-    if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
        I32 gimme = GIMME_V;
        PUSHMARK(SP);
        XPUSHs(mg->mg_obj);
@@ -924,7 +958,7 @@ static OP *
 doform(CV *cv, GV *gv, OP *retop)
 {
     dTHR;
-    register CONTEXT *cx;
+    register PERL_CONTEXT *cx;
     I32 gimme = GIMME_V;
     AV* padlist = CvPADLIST(cv);
     SV** svp = AvARRAY(padlist);
@@ -992,7 +1026,7 @@ PP(pp_leavewrite)
     PerlIO *fp;
     SV **newsp;
     I32 gimme;
-    register CONTEXT *cx;
+    register PERL_CONTEXT *cx;
 
     DEBUG_f(PerlIO_printf(Perl_debug_log, "left=%ld, todo=%ld\n",
          (long)IoLINES_LEFT(io), (long)FmLINES(formtarget)));
@@ -1111,9 +1145,9 @@ PP(pp_prtf)
     else
        gv = defoutgv;
 
-    if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
        if (MARK == ORIGMARK) {
-           EXTEND(SP, 1);
+           MEXTEND(SP, 1);
            ++MARK;
            Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
            ++SP;
@@ -1221,7 +1255,7 @@ PP(pp_sysread)
 
     gv = (GV*)*++MARK;
     if ((op->op_type == OP_READ || op->op_type == OP_SYSREAD) &&
-       SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
+       SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
     {
        SV *sv;
        
@@ -3063,7 +3097,7 @@ PP(pp_fork)
 
 PP(pp_wait)
 {
-#if !defined(DOSISH) || defined(OS2)
+#if !defined(DOSISH) || defined(OS2) || defined(WIN32)
     djSP; dTARGET;
     int childpid;
     int argflags;
@@ -3079,7 +3113,7 @@ PP(pp_wait)
 
 PP(pp_waitpid)
 {
-#if !defined(DOSISH) || defined(OS2)
+#if !defined(DOSISH) || defined(OS2) || defined(WIN32)
     djSP; dTARGET;
     int childpid;
     int optype;
@@ -3092,7 +3126,7 @@ PP(pp_waitpid)
     SETi(childpid);
     RETURN;
 #else
-    DIE(no_func, "Unsupported function wait");
+    DIE(no_func, "Unsupported function waitpid");
 #endif
 }
 
@@ -3606,7 +3640,7 @@ PP(pp_ghostent)
     register SV *sv;
 #if defined(HAS_GETHOSTENT) && !defined(DONT_DECLARE_STD)
     struct hostent *gethostbyname(const char *);
-    struct hostent *gethostbyaddr(const char *, int, int);
+    struct hostent *gethostbyaddr(const Gethbadd_addr_t, Gethbadd_alen_t, int);
     struct hostent *gethostent(void);
 #endif
     struct hostent *hent;
@@ -3620,9 +3654,9 @@ PP(pp_ghostent)
        int addrtype = POPi;
        SV *addrsv = POPs;
        STRLEN addrlen;
-       char *addr = SvPV(addrsv, addrlen);
+       Gethbadd_addr_t addr = (Gethbadd_addr_t) SvPV(addrsv, addrlen);
 
-       hent = gethostbyaddr(addr, addrlen, addrtype);
+       hent = gethostbyaddr(addr, (Gethbadd_alen_t) addrlen, addrtype);
     }
     else
 #ifdef HAS_GETHOSTENT
@@ -3705,9 +3739,13 @@ PP(pp_gnetent)
     I32 which = op->op_type;
     register char **elem;
     register SV *sv;
-#ifndef DONT_DECLARE_STD
+#ifdef NETDB_H_OMITS_GETNET
     struct netent *getnetbyname(const char *);
-    struct netent *getnetbyaddr(long int, int);
+    /*
+     * long is wrong for getnetbyadddr (e.g. on Alpha). POSIX.1g says
+     * in_addr_t but then such systems don't have broken netdb.h anyway.
+     */
+    struct netent *getnetbyaddr(Getnbadd_net_t, int);
     struct netent *getnetent(void);
 #endif
     struct netent *nent;
@@ -3716,8 +3754,8 @@ PP(pp_gnetent)
        nent = getnetbyname(POPp);
     else if (which == OP_GNBYADDR) {
        int addrtype = POPi;
-       unsigned long addr = U_L(POPn);
-       nent = getnetbyaddr((long)addr, addrtype);
+       Getnbadd_net_t addr = (Getnbadd_net_t) U_L(POPn);
+       nent = getnetbyaddr(addr, addrtype);
     }
     else
        nent = getnetent();