#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>
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
- SV *error = GvSV(errgv);
- (void)SvUPGRADE(error, SVt_PV);
- if (SvPOK(error) && SvCUR(error))
- sv_catpv(error, "\t...caught");
- tmps = SvPV(error, 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";
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
- SV *error = GvSV(errgv);
- (void)SvUPGRADE(error, SVt_PV);
- if (SvPOK(error) && SvCUR(error))
- sv_catpv(error, "\t...propagated");
- tmps = SvPV(error, 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";
}
+
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)
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;
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) {
dPOPPOPssrl;
HV* stash;
GV *gv;
- BINOP myop;
SV *sv;
+#ifdef ORIGINAL_TIE
+ BINOP myop;
bool oldcatch = CATCH_GET;
+#endif
hv = (HV*)POPs;
DIE("No dbm on this machine");
}
+#ifdef ORIGINAL_TIE
Zero(&myop, 1, BINOP);
myop.op_last = (OP *) &myop;
myop.op_next = Nullop;
op->op_private |= OPpENTERSUB_DB;
PUTBACK;
pp_pushmark(ARGS);
-
+#else
+ ENTER;
+ PUSHMARK(sp);
+#endif
EXTEND(sp, 5);
PUSHs(sv);
PUSHs(left);
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;
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);
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)));
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;
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
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;
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();