From 9e6b2b00f0190751b970ece3db7033405cb08ca5 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Fri, 1 May 1998 19:21:02 +0000 Subject: [PATCH] [asperl] add AS patch#20 (exposes more global constants) p4raw-id: //depot/asperl@908 --- ObjXSub.h | 6 +++++ byterun.h | 4 ++-- embed.h | 3 +++ embedvar.h | 8 +++---- global.sym | 3 +++ globals.c | 10 ++++++++ interp.sym | 1 + ipsock.h | 5 ++++ ipstdio.h | 1 + objpp.h | 4 ++++ perlio.h | 1 + perlsock.h | 1 + proto.h | 24 +++++++++++++++----- util.c | 12 ++++++++++ win32/GenCAPI.pl | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++++--- win32/runperl.c | 25 ++++++++++++++++---- 16 files changed, 158 insertions(+), 19 deletions(-) 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 <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 <