X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2FGenCAPI.pl;h=2e136ed5c6e44dbc91d78068be5dfdf4438d2f5d;hb=808270a4f6ca13fab50ab36aa190d16318036103;hp=d096da302ec5a7985952cded59d5849bcd0a99e1;hpb=e3b8966e2a0e0357b86674327ee528dbb5f122a6;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/GenCAPI.pl b/win32/GenCAPI.pl index d096da3..2e136ed 100644 --- a/win32/GenCAPI.pl +++ b/win32/GenCAPI.pl @@ -50,9 +50,13 @@ debprofdump debop debstack debstackptrs +dump_fds +dump_mstats fprintf find_threadsv magic_mutexfree +my_memcmp +my_memset my_pclose my_popen my_swap @@ -81,10 +85,25 @@ if (!open(OUTFILE, ">PerlCAPI.cpp")) { return 1; } -print OUTFILE "#include \"EXTERN.h\"\n#include \"perl.h\"\n#include \"XSUB.h\"\n\n"; -print OUTFILE "#define DESTRUCTORFUNC (void (*)(void*))\n\n"; -print OUTFILE "#ifdef SetCPerlObj_defined\n" unless ($separateObj == 0); -print OUTFILE "extern \"C\" void SetCPerlObj(CPerlObj* pP)\n{\n\tpPerl = pP;\n}\n"; +print OUTFILE <Perl_$name(pPerl->Perl_mess($arg, &args));\n"; - print OUTFILE "\tva_end(args);\n}\n"; + print OUTFILE <Perl_mess($arg, &args); + New(0, pstr, strlen(pmsg)+1, char); + strcpy(pstr, pmsg); +$return pPerl->Perl_$name(pstr); + va_end(args); +} +ENDCODE print OUTFILE "#endif\n" unless ($separateObj == 0); } elsif($name eq "newSVpvf") { print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0); - print OUTFILE "\n#undef $name\nextern \"C\" $type $funcName ($args)\n{\n"; $args[0] =~ /(\w+)\W*$/; $arg = $1; - print OUTFILE "\tSV *sv;\n\tva_list args;\n\tva_start(args, $arg);\n"; - print OUTFILE "\tsv = pPerl->Perl_newSV(0);\n"; - print OUTFILE "\tpPerl->Perl_sv_vcatpvfn(sv, $arg, strlen($arg), &args, NULL, 0, NULL);\n"; - print OUTFILE "\tva_end(args);\n\treturn sv;\n}\n"; + print OUTFILE <Perl_newSV(0); + pPerl->Perl_sv_vcatpvfn(sv, $arg, strlen($arg), &args, NULL, 0, NULL); + va_end(args); + return sv; +} +ENDCODE print OUTFILE "#endif\n" unless ($separateObj == 0); } elsif($name eq "sv_catpvf") { print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0); - print OUTFILE "\n#undef $name\nextern \"C\" $type $funcName ($args)\n{\n"; $args[0] =~ /(\w+)\W*$/; $arg0 = $1; $args[1] =~ /(\w+)\W*$/; $arg1 = $1; - print OUTFILE "\tva_list args;\n\tva_start(args, $arg1);\n"; - print OUTFILE "\tpPerl->Perl_sv_vcatpvfn($arg0, $arg1, strlen($arg1), &args, NULL, 0, NULL);\n"; - print OUTFILE "\tva_end(args);\n}\n"; + print OUTFILE <Perl_sv_vcatpvfn($arg0, $arg1, strlen($arg1), &args, NULL, 0, NULL); + va_end(args); +} +ENDCODE print OUTFILE "#endif\n" unless ($separateObj == 0); } elsif($name eq "sv_setpvf") { print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0); - print OUTFILE "\n#undef $name\nextern \"C\" $type $funcName ($args)\n{\n"; $args[0] =~ /(\w+)\W*$/; $arg0 = $1; $args[1] =~ /(\w+)\W*$/; $arg1 = $1; - print OUTFILE "\tva_list args;\n\tva_start(args, $arg1);\n"; - print OUTFILE "\tpPerl->Perl_sv_vsetpvfn($arg0, $arg1, strlen($arg1), &args, NULL, 0, NULL);\n"; - print OUTFILE "\tva_end(args);\n}\n"; + print OUTFILE <Perl_sv_vsetpvfn($arg0, $arg1, strlen($arg1), &args, NULL, 0, NULL); + va_end(args); +} +ENDCODE print OUTFILE "#endif\n" unless ($separateObj == 0); } elsif($name eq "fprintf") { print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0); - print OUTFILE "\n#undef $name\nextern \"C\" $type $name ($args)\n{\n"; $args[0] =~ /(\w+)\W*$/; $arg0 = $1; $args[1] =~ /(\w+)\W*$/; $arg1 = $1; - print OUTFILE "\tint nRet;\n\tva_list args;\n\tva_start(args, $arg1);\n"; - print OUTFILE "\tnRet = PerlIO_vprintf($arg0, $arg1, args);\n"; - print OUTFILE "\tva_end(args);\n\treturn nRet;\n}\n"; + print OUTFILE <perl_parse(xsinit, argc, argv, env);\n}\n"; + print OUTFILE <perl_parse(xsinit, argc, argv, env); +} +ENDCODE + print OUTFILE "#endif\n" unless ($separateObj == 0); + next; + } + # handle special case for perl_atexit + if ($name eq "perl_atexit") { + print OUTFILE <perl_atexit(fn, ptr); +} +ENDCODE print OUTFILE "#endif\n" unless ($separateObj == 0); next; } + + if($name eq "byterun" and $args eq "struct bytestream bs") { + next; + } + # foo(void); if ($args eq "void") { - print OUTFILE "\n#undef $name\nextern \"C\" $type $funcName ()\n{\n$return pPerl->$funcName();\n}\n"; + print OUTFILE <$funcName(); +} + +ENDCODE print OUTFILE "#endif\n" unless ($separateObj == 0); next; } # foo(char *s, const int bar); - print OUTFILE "\n#undef $name\nextern \"C\" $type $funcName ($args)\n{\n$return pPerl->$funcName"; + print OUTFILE <$funcName"; $doneone = 0; foreach $arg (@args) { if ($arg =~ /(\w+)\W*$/) { @@ -276,7 +377,6 @@ opsave eval_mutex orslen ofmt -mh modcount generation DBcv @@ -284,7 +384,7 @@ archpat_auto sortcxix lastgotoprobe regdummy -regparse +regcomp_parse regxend regcode regnaughty @@ -295,7 +395,7 @@ regsize regflags regseen seen_zerolen -rx +regcomp_rx extralen colorset colors @@ -371,8 +471,11 @@ readvars %thread, '..\thrdvar.h','T'; readvars %globvar, '..\perlvars.h','G'; open(HDRFILE, ">$hdrfile") or die "$0: Can't open $hdrfile: $!\n"; -print HDRFILE "\nvoid SetCPerlObj(void* pP);"; -print HDRFILE "\nCV* Perl_newXS(char* name, void (*subaddr)(CV* cv), char* filename);\n"; +print HDRFILE <Perl_$name);\n}\n"; + print OUTFILE <Perl_$name); +} + +ENDCODE + print OUTFILE "#endif\n" unless ($separateObj == 0); - print HDRFILE "\n#undef Perl_$name\n$type * _Perl_$name ();"; - print HDRFILE "\n#define Perl_$name (*_Perl_$name())\n\n"; + print HDRFILE <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*); SV* sv; @@ -422,7 +559,6 @@ void xs_handler(CV* cv, CPerlObj* pPerl) { func = (void(*)(CV*))pPerl->Perl_sv_2iv(sv); } - SetCPerlObj(pPerl); func(cv); } } @@ -434,6 +570,11 @@ CV* Perl_newXS(char* name, void (*subaddr)(CV* cv), char* filename) return cv; } + +void Perl_deb(const char pat, ...) +{ +} + #undef piMem #undef piENV #undef piStdIO @@ -617,6 +758,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()); @@ -792,11 +943,247 @@ long _win32_get_osfhandle(int fd) { return pPerl->piStdIO->GetOSfhandle(fd); } + +u_long _win32_htonl (u_long hostlong) +{ + return pPerl->piSock->Htonl(hostlong); +} + +u_short _win32_htons (u_short hostshort) +{ + return pPerl->piSock->Htons(hostshort); +} + +u_long _win32_ntohl (u_long netlong) +{ + return pPerl->piSock->Ntohl(netlong); +} + +u_short _win32_ntohs (u_short netshort) +{ + return pPerl->piSock->Ntohs(netshort); +} + +unsigned long _win32_inet_addr (const char * cp) +{ + return pPerl->piSock->InetAddr(cp, ErrorNo()); +} + +char * _win32_inet_ntoa (struct in_addr in) +{ + return pPerl->piSock->InetNtoa(in, ErrorNo()); +} + +SOCKET _win32_socket (int af, int type, int protocol) +{ + return pPerl->piSock->Socket(af, type, protocol, ErrorNo()); +} + +int _win32_bind (SOCKET s, const struct sockaddr *addr, int namelen) +{ + return pPerl->piSock->Bind(s, addr, namelen, ErrorNo()); +} + +int _win32_listen (SOCKET s, int backlog) +{ + return pPerl->piSock->Listen(s, backlog, ErrorNo()); +} + +SOCKET _win32_accept (SOCKET s, struct sockaddr *addr, int *addrlen) +{ + return pPerl->piSock->Accept(s, addr, addrlen, ErrorNo()); +} + +int _win32_connect (SOCKET s, const struct sockaddr *name, int namelen) +{ + return pPerl->piSock->Connect(s, name, namelen, ErrorNo()); +} + +int _win32_send (SOCKET s, const char * buf, int len, int flags) +{ + return pPerl->piSock->Send(s, buf, len, flags, ErrorNo()); +} + +int _win32_sendto (SOCKET s, const char * buf, int len, int flags, + const struct sockaddr *to, int tolen) +{ + return pPerl->piSock->Sendto(s, buf, len, flags, to, tolen, ErrorNo()); +} + +int _win32_recv (SOCKET s, char * buf, int len, int flags) +{ + return pPerl->piSock->Recv(s, buf, len, flags, ErrorNo()); +} + +int _win32_recvfrom (SOCKET s, char * buf, int len, int flags, + struct sockaddr *from, int * fromlen) +{ + return pPerl->piSock->Recvfrom(s, buf, len, flags, from, fromlen, ErrorNo()); +} + +int _win32_shutdown (SOCKET s, int how) +{ + return pPerl->piSock->Shutdown(s, how, ErrorNo()); +} + +int _win32_closesocket (SOCKET s) +{ + return pPerl->piSock->Closesocket(s, ErrorNo()); +} + +int _win32_ioctlsocket (SOCKET s, long cmd, u_long *argp) +{ + return pPerl->piSock->Ioctlsocket(s, cmd, argp, ErrorNo()); +} + +int _win32_setsockopt (SOCKET s, int level, int optname, + const char * optval, int optlen) +{ + return pPerl->piSock->Setsockopt(s, level, optname, optval, optlen, ErrorNo()); +} + +int _win32_getsockopt (SOCKET s, int level, int optname, char * optval, int *optlen) +{ + return pPerl->piSock->Getsockopt(s, level, optname, optval, optlen, ErrorNo()); +} + +int _win32_getpeername (SOCKET s, struct sockaddr *name, int * namelen) +{ + return pPerl->piSock->Getpeername(s, name, namelen, ErrorNo()); +} + +int _win32_getsockname (SOCKET s, struct sockaddr *name, int * namelen) +{ + return pPerl->piSock->Getsockname(s, name, namelen, ErrorNo()); +} + +int _win32_gethostname (char * name, int namelen) +{ + return pPerl->piSock->Gethostname(name, namelen, ErrorNo()); +} + +struct hostent * _win32_gethostbyname(const char * name) +{ + return pPerl->piSock->Gethostbyname(name, ErrorNo()); +} + +struct hostent * _win32_gethostbyaddr(const char * addr, int len, int type) +{ + return pPerl->piSock->Gethostbyaddr(addr, len, type, ErrorNo()); +} + +struct protoent * _win32_getprotobyname(const char * name) +{ + return pPerl->piSock->Getprotobyname(name, ErrorNo()); +} + +struct protoent * _win32_getprotobynumber(int proto) +{ + return pPerl->piSock->Getprotobynumber(proto, ErrorNo()); +} + +struct servent * _win32_getservbyname(const char * name, const char * proto) +{ + return pPerl->piSock->Getservbyname(name, proto, ErrorNo()); +} + +struct servent * _win32_getservbyport(int port, const char * proto) +{ + return pPerl->piSock->Getservbyport(port, proto, ErrorNo()); +} + +int _win32_select (int nfds, Perl_fd_set *rfds, Perl_fd_set *wfds, Perl_fd_set *xfds, + const struct timeval *timeout) +{ + return pPerl->piSock->Select(nfds, (char*)rfds, (char*)wfds, (char*)xfds, timeout, ErrorNo()); +} + +void _win32_endnetent(void) +{ + pPerl->piSock->Endnetent(ErrorNo()); +} + +void _win32_endhostent(void) +{ + pPerl->piSock->Endhostent(ErrorNo()); +} + +void _win32_endprotoent(void) +{ + pPerl->piSock->Endprotoent(ErrorNo()); +} + +void _win32_endservent(void) +{ + pPerl->piSock->Endservent(ErrorNo()); +} + +struct netent * _win32_getnetent(void) +{ + return pPerl->piSock->Getnetent(ErrorNo()); +} + +struct netent * _win32_getnetbyname(char *name) +{ + return pPerl->piSock->Getnetbyname(name, ErrorNo()); +} + +struct netent * _win32_getnetbyaddr(long net, int type) +{ + return pPerl->piSock->Getnetbyaddr(net, type, ErrorNo()); +} + +struct protoent *_win32_getprotoent(void) +{ + return pPerl->piSock->Getprotoent(ErrorNo()); +} + +struct servent *_win32_getservent(void) +{ + return pPerl->piSock->Getservent(ErrorNo()); +} + +void _win32_sethostent(int stayopen) +{ + pPerl->piSock->Sethostent(stayopen, ErrorNo()); +} + +void _win32_setnetent(int stayopen) +{ + pPerl->piSock->Setnetent(stayopen, ErrorNo()); +} + +void _win32_setprotoent(int stayopen) +{ + pPerl->piSock->Setprotoent(stayopen, ErrorNo()); +} + +void _win32_setservent(int stayopen) +{ + pPerl->piSock->Setservent(stayopen, ErrorNo()); +} } /* extern "C" */ EOCODE print HDRFILE <