Okay, here's the patch to get MULTIPLICITY working on VMS. It contains
the modifications (previously posted to vmsperl) to get the main build
to work. The addition is some mods to vms/gen_shrfl.pl to grab necessary
global definitions for use in building the extensions.
After thinking about the "whole new approach", I punted and just added
parsing of some more of the .h files that would get the new global defs
for us.
With this patch, a -Dusemultiplicity builds fine and passes all tests.
diff -uBb perlio.c-orig perlio.c
--- perlio.c-orig Tue Nov 6 08:26:42 2001
+++ perlio.c Tue Nov 6 08:46:59 2001
@@ -38,6 +38,11 @@
#define PERL_IN_PERLIO_C
#include "perl.h"
+#ifdef PERL_IMPLICIT_CONTEXT
+#undef dSYS
+#define dSYS dTHX
+#endif
+
#include "XSUB.h"
int
diff -uBb ext/Cwd/Cwd.xs-orig ext/Cwd/Cwd.xs
--- ext/Cwd/Cwd.xs-orig Tue Nov 6 09:05:56 2001
+++ ext/Cwd/Cwd.xs Tue Nov 6 09:05:26 2001
@@ -70,7 +70,8 @@
char *resolved;
{
#ifdef VMS
- return Perl_rmsexpand((char*)path, resolved, NULL, 0);
+ dTHX;
+ return Perl_rmsexpand(aTHX_ (char*)path, resolved, NULL, 0);
#else
struct stat sb;
int n, rootd, serrno;
diff -uBb vms/gen_shrfls.pl-orig vms/gen_shrfls.pl
--- vms/gen_shrfls.pl-orig Tue Nov 6 10:05:50 2001
+++ vms/gen_shrfls.pl Sat Nov 10 00:41:38 2001
@@ -167,9 +167,9 @@
}
if ($use_perlio) {
- $preprocess_list = "${dir}perl.h,${dir}perliol.h";
+ $preprocess_list = "${dir}perl.h+${dir}perlapi.h,${dir}perliol.h";
} else {
- $preprocess_list = "${dir}perl.h";
+ $preprocess_list = "${dir}perl.h+${dir}perlapi.h";
}
$used_expectation_enum = $used_opcode_enum = 0; # avoid warnings
@@ -180,7 +180,7 @@
else {
open(CPP,"$cpp_file") or die "$0: Can't read preprocessed file $cpp_file: $!\n";
}
-%checkh = map { $_,1 } qw( thread bytecode byterun proto perlio );
+%checkh = map { $_,1 } qw( thread bytecode byterun proto perlio perlvars intrpvar
+thrdvar );
$ckfunc = 0;
LINE: while (<CPP>) {
while (/^#.*vmsish\.h/i .. /^#.*perl\.h/i) {
diff -uBb vms/sockadapt.c-orig vms/sockadapt.c
--- vms/sockadapt.c-orig Tue Nov 6 08:17:08 2001
+++ vms/sockadapt.c Tue Nov 6 08:40:07 2001
@@ -34,10 +34,12 @@
#if ((((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >=
70000000)) && defined(DECCRTL_SOCKETS))
#else
void setnetent(int stayopen) {
- croak("Function \"setnetent\" not implemented in this version of perl");
+ dTHX;
+ Perl_croak(aTHX_ "Function \"setnetent\" not implemented in this version of perl");
}
void endnetent() {
- croak("Function \"endnetent\" not implemented in this version of perl");
+ dTHX;
+ Perl_croak(aTHX_ "Function \"endnetent\" not implemented in this version of perl");
}
#endif
@@ -49,29 +51,37 @@
#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
#else
void sethostent(int stayopen) {
- croak("Function \"sethostent\" not implemented in this version of perl");
+ dTHX;
+ Perl_croak(aTHX_ "Function \"sethostent\" not implemented in this version of
+perl");
}
void endhostent() {
- croak("Function \"endhostent\" not implemented in this version of perl");
+ dTHX;
+ Perl_croak(aTHX_ "Function \"endhostent\" not implemented in this version of
+perl");
}
void setprotoent(int stayopen) {
- croak("Function \"setprotoent\" not implemented in this version of perl");
+ dTHX;
+ Perl_croak(aTHX_ "Function \"setprotoent\" not implemented in this version of
+perl");
}
void endprotoent() {
- croak("Function \"endprotoent\" not implemented in this version of perl");
+ dTHX;
+ Perl_croak(aTHX_ "Function \"endprotoent\" not implemented in this version of
+perl");
}
void setservent(int stayopen) {
- croak("Function \"setservent\" not implemented in this version of perl");
+ dTHX;
+ Perl_croak(aTHX_ "Function \"setservent\" not implemented in this version of
+perl");
}
void endservent() {
- croak("Function \"endservent\" not implemented in this version of perl");
+ dTHX;
+ Perl_croak(aTHX_ "Function \"endservent\" not implemented in this version of
+perl");
}
__sockadapt_my_hostent_t gethostent() {
- croak("Function \"gethostent\" not implemented in this version of perl");
+ dTHX;
+ Perl_croak(aTHX_ "Function \"gethostent\" not implemented in this version of
+perl");
return (__sockadapt_my_hostent_t )NULL; /* Avoid MISSINGRETURN warning, not
reached */
}
__sockadapt_my_servent_t getservent() {
- croak("Function \"getservent\" not implemented in this version of perl");
+ dTHX;
+ Perl_croak(aTHX_ "Function \"getservent\" not implemented in this version of
+perl");
return (__sockadapt_my_servent_t )NULL; /* Avoid MISSINGRETURN warning, not
reached */
}
#endif
@@ -80,15 +90,18 @@
/* Work around things missing/broken in SOCKETSHR. */
__sockadapt_my_netent_t getnetbyaddr( __sockadapt_my_addr_t net, int type) {
- croak("Function \"getnetbyaddr\" not implemented in this version of perl");
+ dTHX;
+ Perl_croak(aTHX_ "Function \"getnetbyaddr\" not implemented in this version of
+perl");
return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */
}
__sockadapt_my_netent_t getnetbyname( __sockadapt_my_name_t name) {
- croak("Function \"getnetbyname\" not implemented in this version of perl");
+ dTHX;
+ Perl_croak(aTHX_ "Function \"getnetbyname\" not implemented in this version of
+perl");
return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */
}
__sockadapt_my_netent_t getnetent() {
- croak("Function \"getnetent\" not implemented in this version of perl");
+ dTHX;
+ Perl_croak(aTHX_ "Function \"getnetent\" not implemented in this version of perl");
return (__sockadapt_my_netent_t )NULL; /* Avoid MISSINGRETURN warning, not reached
*/
}
diff -uBb vms/vms.c-orig vms/vms.c
--- vms/vms.c-orig Tue Nov 6 09:05:34 2001
+++ vms/vms.c Tue Nov 6 09:05:27 2001
@@ -5917,7 +5917,7 @@
# endif
dst = -1;
#ifndef RTL_USES_UTC
- if (tz_parse(&when, &dst, 0, &offset)) { /* truelocal determines DST*/
+ if (tz_parse(aTHX_ &when, &dst, 0, &offset)) { /* truelocal determines DST*/
when = whenutc - offset; /* pseudolocal time*/
}
# endif
diff -uBb vms/ext/Stdio/Stdio.xs-orig vms/ext/Stdio/Stdio.xs
--- vms/ext/Stdio/Stdio.xs-orig Tue Nov 6 09:05:44 2001
+++ vms/ext/Stdio/Stdio.xs Tue Nov 6 09:05:26 2001
@@ -174,7 +174,7 @@
}
/* appearances to the contrary, this is an freopen substitute */
name = sv_2mortal(newSVpvn(filespec,strlen(filespec)));
- if (PerlIO_openn(Nullch,acmode,-1,0,0,fp,1,&name) == Nullfp)
XSRETURN_UNDEF;
+ if (PerlIO_openn(aTHX_ Nullch,acmode,-1,0,0,fp,1,&name) == Nullfp)
+XSRETURN_UNDEF;
if (iotype != '-' && ret != -1 && PerlIO_setpos(fp,&pos) == -1)
XSRETURN_UNDEF;
if (ret == -1) { set_errno(saverrno); set_vaxc_errno(savevmserrno); }
XSRETURN_YES;
--
Drexel University \V --Chuck Lane
======]---------->--------*------------<-------[===========
(215) 895-1545 _/ \ Particle Physics
FAX: (215) 895-5934 /\ /~~~~~~~~~~~ [EMAIL PROTECTED]
