From: Gurusamy Sarathy <gsar@cpan.org>
Date: Fri, 1 May 1998 19:21:02 +0000 (+0000)
Subject: [asperl] add AS patch#20 (exposes more global constants)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9e6b2b00f0190751b970ece3db7033405cb08ca5;p=p5sagit%2Fp5-mst-13.2.git
[asperl] add AS patch#20 (exposes more global constants)
p4raw-id: //depot/asperl@908
---
diff --git a/ObjXSub.h b/ObjXSub.h
index 08446c8..9880e8c 100644
--- a/ObjXSub.h
+++ b/ObjXSub.h
@@ -53,6 +53,8 @@
#define bufend pPerl->Perl_bufend
#undef bufptr
#define bufptr pPerl->Perl_bufptr
+#undef byterun
+#define byterun pPerl->Perl_byterun
#undef cddir
#define cddir pPerl->Perl_cddir
#undef chopset
@@ -912,6 +914,10 @@
#define get_op_descs pPerl->Perl_get_op_descs
#undef get_op_names
#define get_op_names pPerl->Perl_get_op_names
+#undef get_no_modify
+#define get_no_modify pPerl->Perl_get_no_modify
+#undef get_opargs
+#define get_opargs pPerl->Perl_get_opargs
#undef gp_free
#define gp_free pPerl->Perl_gp_free
#undef gp_ref
diff --git a/byterun.h b/byterun.h
index 85342b8..9abbc22 100644
--- a/byterun.h
+++ b/byterun.h
@@ -16,8 +16,8 @@ struct bytestream {
void (*freadpv)(U32, void*);
};
void byterun _((struct bytestream));
-#else
-void byterun _((PerlIO *));
+/* #else
+void byterun _((PerlIO *)); */
#endif /* INDIRECT_BGET_MACROS */
void *bset_obj_store _((void *, I32));
diff --git a/embed.h b/embed.h
index fd3d549..7318270 100644
--- a/embed.h
+++ b/embed.h
@@ -205,8 +205,11 @@
#define freq Perl_freq
#define ge_amg Perl_ge_amg
#define gen_constant_list Perl_gen_constant_list
+#define get_no_modify Perl_get_no_modify
#define get_op_descs Perl_get_op_descs
#define get_op_names Perl_get_op_names
+#define get_opargs Perl_get_opargs
+#define get_specialsv_list Perl_get_specialsv_list
#define gp_free Perl_gp_free
#define gp_ref Perl_gp_ref
#define gt_amg Perl_gt_amg
diff --git a/embedvar.h b/embedvar.h
index 0ba1579..7a7c80f 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -211,10 +211,10 @@
#define sawampersand (curinterp->Isawampersand)
#define sawstudy (curinterp->Isawstudy)
#define sawvec (curinterp->Isawvec)
-#define seen_zerolen (curinterp->Iseen_zerolen)
#define screamfirst (curinterp->Iscreamfirst)
#define screamnext (curinterp->Iscreamnext)
#define secondgv (curinterp->Isecondgv)
+#define seen_zerolen (curinterp->Iseen_zerolen)
#define siggv (curinterp->Isiggv)
#define sortcop (curinterp->Isortcop)
#define sortcxix (curinterp->Isortcxix)
@@ -775,7 +775,7 @@
#define do_undump (Perl_Vars.Gdo_undump)
#define egid (Perl_Vars.Gegid)
#define error_count (Perl_Vars.Gerror_count)
-#define error_no (Perl_Vars.Gerror_no)
+#define error_no (Perl_Vars.Gerror_no)
#define euid (Perl_Vars.Geuid)
#define eval_cond (Perl_Vars.Geval_cond)
#define eval_mutex (Perl_Vars.Geval_mutex)
@@ -895,7 +895,7 @@
#define Gdo_undump do_undump
#define Gegid egid
#define Gerror_count error_count
-#define Gerror_no error_no
+#define Gerror_no error_no
#define Geuid euid
#define Geval_cond eval_cond
#define Geval_mutex eval_mutex
@@ -1015,7 +1015,7 @@
#define do_undump Perl_do_undump
#define egid Perl_egid
#define error_count Perl_error_count
-#define error_no Perl_error_no
+#define error_no Perl_error_no
#define euid Perl_euid
#define eval_cond Perl_eval_cond
#define eval_mutex Perl_eval_mutex
diff --git a/global.sym b/global.sym
index 28080ce..854b230 100644
--- a/global.sym
+++ b/global.sym
@@ -35,6 +35,9 @@ freq
ge_amg
get_op_descs
get_op_names
+get_no_modify
+get_opargs
+get_specialsv_list
gt_amg
inc_amg
init_thread_intern
diff --git a/globals.c b/globals.c
index e3ca27e..320b8df 100644
--- a/globals.c
+++ b/globals.c
@@ -1464,4 +1464,14 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
}
#endif /* WIN32 */
+#ifndef DEBUGGING
+/* create a matching set of virtual entries for the non debugging version */
+void CPerlObj::deb_place_holder _((const char* pat,...)) {};
+void CPerlObj::deb_growlevel_place_holder _((void)) {};
+void CPerlObj::debprofdump_place_holder _((void)) {};
+I32 CPerlObj::debop_place_holder _((OP* o)) { return 0; };
+I32 CPerlObj::debstack_place_holder _((void)) { return 0; };
+I32 CPerlObj::debstackptrs_place_holder _((void)) { return 0; };
+#endif
+
#endif /* PERL_OBJECT */
diff --git a/interp.sym b/interp.sym
index b715d1c..62e603a 100644
--- a/interp.sym
+++ b/interp.sym
@@ -85,6 +85,7 @@ mainstack
maxscream
maxsysfd
mess_sv
+mh
minus_F
minus_a
minus_c
diff --git a/ipsock.h b/ipsock.h
index 152eb2d..1875d56 100644
--- a/ipsock.h
+++ b/ipsock.h
@@ -41,6 +41,7 @@ public:
virtual unsigned long InetAddr(const char* cp, int &err) = 0;
virtual char* InetNtoa(struct in_addr in, int &err) = 0;
virtual int Listen(SOCKET s, int backlog, int &err) = 0;
+ virtual int Recv(SOCKET s, char* buf, int len, int flags, int &err) = 0;
virtual int Recvfrom(SOCKET s, char* buf, int len, int flags, struct sockaddr* from, int* fromlen, int &err) = 0;
virtual int Select(int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout, int &err) = 0;
virtual int Send(SOCKET s, const char* buf, int len, int flags, int &err) = 0;
@@ -53,6 +54,10 @@ public:
virtual int Shutdown(SOCKET s, int how, int &err) = 0;
virtual SOCKET Socket(int af, int type, int protocol, int &err) = 0;
virtual int Socketpair(int domain, int type, int protocol, int* fds, int &err) = 0;
+#ifdef WIN32
+ virtual int Closesocket(SOCKET s, int& err) = 0;
+ virtual int Ioctlsocket(SOCKET s, long cmd, u_long *argp, int& err) = 0;
+#endif
};
#endif /* __Inc__IPerlSock___ */
diff --git a/ipstdio.h b/ipstdio.h
index 1ed0e61..d639aca 100644
--- a/ipstdio.h
+++ b/ipstdio.h
@@ -28,6 +28,7 @@ public:
virtual int GetBufsiz(PerlIO *, int &err) = 0;
virtual int GetCnt(PerlIO *, int &err) = 0;
virtual char* GetPtr(PerlIO *, int &err) = 0;
+ virtual char* Gets(PerlIO*, char*, int, int& err) = 0;
virtual int Putc(PerlIO*, int, int &err) = 0;
virtual int Puts(PerlIO*, const char *, int &err) = 0;
virtual int Flush(PerlIO*, int &err) = 0;
diff --git a/objpp.h b/objpp.h
index 5d662de..77b6c0d 100644
--- a/objpp.h
+++ b/objpp.h
@@ -375,6 +375,10 @@
#define get_op_descs CPerlObj::Perl_get_op_descs
#undef get_op_names
#define get_op_names CPerlObj::Perl_get_op_names
+#undef get_no_modify
+#define get_no_modify CPerlObj::Perl_get_no_modify
+#undef get_opargs
+#define get_opargs CPerlObj::Perl_get_opargs
#undef getlogin
#define getlogin CPerlObj::getlogin
#undef gp_free
diff --git a/perlio.h b/perlio.h
index 9df9575..8d453a5 100644
--- a/perlio.h
+++ b/perlio.h
@@ -45,6 +45,7 @@ extern void PerlIO_init _((void));
#define PerlIO_putc(f,c) piStdIO->Putc((f),(c), ErrorNo())
#define PerlIO_puts(f,s) piStdIO->Puts((f),(s), ErrorNo())
#define PerlIO_flush(f) piStdIO->Flush((f), ErrorNo())
+#define PerlIO_gets(s, n, fp) piStdIO->Gets((fp), s, n, ErrorNo())
#define PerlIO_ungetc(f,c) piStdIO->Ungetc((f),(c), ErrorNo())
#define PerlIO_fileno(f) piStdIO->Fileno((f), ErrorNo())
#define PerlIO_fdopen(f, s) piStdIO->Fdopen((f),(s), ErrorNo())
diff --git a/perlsock.h b/perlsock.h
index 08c04f3..70350be 100644
--- a/perlsock.h
+++ b/perlsock.h
@@ -35,6 +35,7 @@
#define PerlSock_inet_addr(c) piSock->InetAddr(c, ErrorNo())
#define PerlSock_inet_ntoa(i) piSock->InetNtoa(i, ErrorNo())
#define PerlSock_listen(s, b) piSock->Listen(s, b, ErrorNo())
+#define PerlSock_recv(s, b, l, f) piSock->Recv(s, b, l, f, ErrorNo())
#define PerlSock_recvfrom(s, b, l, f, from, fromlen) piSock->Recvfrom(s, b, l, f, from, fromlen, ErrorNo())
#define PerlSock_select(n, r, w, e, t) piSock->Select(n, (char*)r, (char*)w, (char*)e, t, ErrorNo())
#define PerlSock_send(s, b, l, f) piSock->Send(s, b, l, f, ErrorNo())
diff --git a/proto.h b/proto.h
index 159eeee..3ed352a 100644
--- a/proto.h
+++ b/proto.h
@@ -87,6 +87,8 @@ VIRTUAL void filter_del _((filter_t funcp));
VIRTUAL I32 filter_read _((int idx, SV* buffer, int maxlen));
VIRTUAL char ** get_op_descs _((void));
VIRTUAL char ** get_op_names _((void));
+VIRTUAL char * get_no_modify _((void));
+VIRTUAL U32 * get_opargs _((void));
VIRTUAL I32 cxinc _((void));
#ifdef DEBUGGING
VIRTUAL void deb _((const char* pat,...)) __attribute__((format(printf,1,2)));
@@ -95,6 +97,16 @@ VIRTUAL void debprofdump _((void));
VIRTUAL I32 debop _((OP* o));
VIRTUAL I32 debstack _((void));
VIRTUAL I32 debstackptrs _((void));
+#else
+#ifdef PERL_OBJECT
+/* create a matching set of virtual entries for the non debugging version */
+VIRTUAL void deb_place_holder _((const char* pat,...));
+VIRTUAL void deb_growlevel_place_holder _((void));
+VIRTUAL void debprofdump_place_holder _((void));
+VIRTUAL I32 debop_place_holder _((OP* o));
+VIRTUAL I32 debstack_place_holder _((void));
+VIRTUAL I32 debstackptrs_place_holder _((void));
+#endif
#endif
VIRTUAL char* delimcpy _((char* to, char* toend, char* from, char* fromend,
int delim, I32* retlen));
@@ -839,16 +851,16 @@ void debprof _((OP *o));
#endif
void *bset_obj_store _((void *obj, I32 ix));
-#ifdef INDIRECT_BGET_MACROS
-void byterun _((struct bytestream bs));
-#else
-void byterun _((PerlIO *fp));
-#endif /* INDIRECT_BGET_MACROS */
-
OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
#define PPDEF(s) OP* CPerlObj::s _((ARGSproto));
public:
+#ifdef INDIRECT_BGET_MACROS
+VIRTUAL void byterun _((struct bytestream bs));
+#else
+VIRTUAL void byterun _((PerlIO *fp));
+#endif /* INDIRECT_BGET_MACROS */
+
PPDEF(pp_aassign)
PPDEF(pp_abs)
PPDEF(pp_accept)
diff --git a/util.c b/util.c
index b62be9a..587225c 100644
--- a/util.c
+++ b/util.c
@@ -2669,3 +2669,15 @@ get_op_descs(void)
{
return op_desc;
}
+
+char *
+get_no_modify(void)
+{
+ return (char*)no_modify;
+}
+
+U32 *
+get_opargs(void)
+{
+ return opargs;
+}
diff --git a/win32/GenCAPI.pl b/win32/GenCAPI.pl
index 468a9a3..4988ab7 100644
--- a/win32/GenCAPI.pl
+++ b/win32/GenCAPI.pl
@@ -50,6 +50,12 @@ debprofdump
debop
debstack
debstackptrs
+deb_place_holder
+deb_growlevel_place_holder
+debprofdump_place_holder
+debop_place_holder
+debstack_place_holder
+debstackptrs_place_holder
fprintf
find_threadsv
magic_mutexfree
@@ -279,6 +285,10 @@ ENDCODE
next;
}
+ if($name eq "byterun" and $args eq "struct bytestream bs") {
+ next;
+ }
+
# foo(void);
if ($args eq "void") {
print OUTFILE <<ENDCODE;
@@ -501,6 +511,28 @@ print OUTFILE <<EOCODE;
extern "C" {
+
+
+char ** _Perl_op_desc(void)
+{
+ return pPerl->Perl_get_op_descs();
+}
+
+char ** _Perl_op_name(void)
+{
+ return pPerl->Perl_get_op_names();
+}
+
+char * _Perl_no_modify(void)
+{
+ return pPerl->Perl_get_no_modify();
+}
+
+U32 * _Perl_opargs(void)
+{
+ return pPerl->Perl_get_opargs();
+}
+
void xs_handler(CV* cv, CPerlObj* p)
{
void(*func)(CV*);
@@ -716,6 +748,16 @@ int _win32_setvbuf(FILE *pf, char *buf, int type, size_t size)
return pPerl->piStdIO->SetVBuf((PerlIO*)pf, buf, type, size, ErrorNo());
}
+char* _win32_fgets(char *s, int n, FILE *pf)
+{
+ return pPerl->piStdIO->Gets((PerlIO*)pf, s, n, ErrorNo());
+}
+
+char* _win32_gets(char *s)
+{
+ return _win32_fgets(s, 80, (FILE*)pPerl->piStdIO->Stdin());
+}
+
int _win32_fgetc(FILE *pf)
{
return pPerl->piStdIO->Getc((PerlIO*)pf, ErrorNo());
@@ -960,7 +1002,7 @@ int _win32_sendto (SOCKET s, const char * buf, int len, int flags,
int _win32_recv (SOCKET s, char * buf, int len, int flags)
{
- return 0;
+ return pPerl->piSock->Recv(s, buf, len, flags, ErrorNo());
}
int _win32_recvfrom (SOCKET s, char * buf, int len, int flags,
@@ -976,12 +1018,12 @@ int _win32_shutdown (SOCKET s, int how)
int _win32_closesocket (SOCKET s)
{
- return 0;
+ return pPerl->piSock->Closesocket(s, ErrorNo());
}
int _win32_ioctlsocket (SOCKET s, long cmd, u_long *argp)
{
- return 0;
+ return pPerl->piSock->Ioctlsocket(s, cmd, argp, ErrorNo());
}
int _win32_setsockopt (SOCKET s, int level, int optname,
@@ -1115,6 +1157,23 @@ EOCODE
print HDRFILE <<EOCODE;
+#undef Perl_op_desc
+char ** _Perl_op_desc ();
+#define Perl_op_desc (_Perl_op_desc())
+
+#undef Perl_op_name
+char ** _Perl_op_name ();
+#define Perl_op_name (_Perl_op_name())
+
+#undef Perl_no_modify
+char ** _Perl_no_modify ();
+#define Perl_no_modify (_Perl_no_modify())
+
+#undef Perl_opargs
+char ** _Perl_opargs ();
+#define Perl_opargs (_Perl_opargs())
+
+
#undef win32_errno
#undef win32_stdin
#undef win32_stdout
@@ -1166,6 +1225,8 @@ print HDRFILE <<EOCODE;
#undef win32_setbuf
#undef win32_setvbuf
#undef win32_fgetc
+#undef win32_fgets
+#undef win32_gets
#undef win32_putc
#undef win32_puts
#undef win32_getchar
@@ -1279,6 +1340,8 @@ print HDRFILE <<EOCODE;
#define win32_setbuf _win32_setbuf
#define win32_setvbuf _win32_setvbuf
#define win32_fgetc _win32_fgetc
+#define win32_fgets _win32_fgets
+#define win32_gets _win32_gets
#define win32_putc _win32_putc
#define win32_puts _win32_puts
#define win32_getchar _win32_getchar
diff --git a/win32/runperl.c b/win32/runperl.c
index cfa195d..9f8c26a 100644
--- a/win32/runperl.c
+++ b/win32/runperl.c
@@ -243,14 +243,14 @@ public:
char *r = win32_inet_ntoa(in);
PROCESS_AND_RETURN;
};
- virtual int IoctlSocket(SOCKET s, long cmd, u_long *argp, int& err)
+ virtual int Listen(SOCKET s, int backlog, int &err)
{
- int r = win32_ioctlsocket(s, cmd, argp);
+ int r = win32_listen(s, backlog);
PROCESS_AND_RETURN;
};
- virtual int Listen(SOCKET s, int backlog, int &err)
+ virtual int Recv(SOCKET s, char* buffer, int len, int flags, int &err)
{
- int r = win32_listen(s, backlog);
+ int r = win32_recv(s, buffer, len, flags);
PROCESS_AND_RETURN;
};
virtual int Recvfrom(SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen, int &err)
@@ -309,6 +309,16 @@ public:
croak("socketpair not implemented!\n");
return 0;
};
+ virtual int Closesocket(SOCKET s, int& err)
+ {
+ int r = win32_closesocket(s);
+ PROCESS_AND_RETURN;
+ };
+ virtual int Ioctlsocket(SOCKET s, long cmd, u_long *argp, int& err)
+ {
+ int r = win32_ioctlsocket(s, cmd, argp);
+ PROCESS_AND_RETURN;
+ };
};
@@ -724,6 +734,13 @@ public:
FILE *f = (FILE*)pf;
return FILE_ptr(f);
};
+ virtual char* Gets(PerlIO* pf, char* s, int n, int& err)
+ {
+ char* ret = win32_fgets(s, n, (FILE*)pf);
+ if(errno)
+ err = errno;
+ return ret;
+ };
virtual int Putc(PerlIO* pf, int c, int &err)
{
CALLFUNCERR(win32_fputc(c, (FILE*)pf))