From: Hans Mulder Date: Mon, 1 Mar 1999 16:06:29 +0000 (-0800) Subject: To: perl5-porters@perl.org, vmsperl@perl.org X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a12fb9119e8da180ab3c5a7359cb81660e41b805;p=p5sagit%2Fp5-mst-13.2.git To: perl5-porters@perl.org, vmsperl@perl.org Subject: [PATCH5.005_56]Diffs to get 5.005_56 building on VMS Date: Mon, 01 Mar 1999 16:06:29 -0800 Message-Id: <3.0.6.32.19990301160629.02e09ec0@ous.edu> From: Dan Sugalski To: perl5-porters@perl.org, vmsperl@perl.org Subject: [PATCH 5.005_56]vmsish.pm patch Date: Mon, 01 Mar 1999 20:19:04 -0800 Message-Id: <3.0.6.32.19990301201904.02cff460@ous.edu> plus Configure regen containing a "solution" to the crosscompile/multiarch problem. p4raw-id: //depot/cfgperl@3050 --- diff --git a/Configure b/Configure index 37e4d89..e229ecc 100755 --- a/Configure +++ b/Configure @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Thu Feb 25 22:44:22 EET 1999 [metaconfig 3.0 PL70] +# Generated on Tue Mar 2 10:22:15 EET 1999 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.com) cat >/tmp/c1$$ <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getgrps HAS_GETGROUPS /**/ -/* HAS_GETHOSTNAME: - * This symbol, if defined, indicates that the C program may use the - * gethostname() routine to derive the host name. See also HAS_UNAME - * and PHOSTNAME. - */ -/* HAS_UNAME: - * This symbol, if defined, indicates that the C program may use the - * uname() routine to derive the host name. See also HAS_GETHOSTNAME - * and PHOSTNAME. - */ -/* PHOSTNAME: - * This symbol, if defined, indicates that the C program may use the - * contents of PHOSTNAME as a command to feed to the popen() routine - * to derive the host name. See also HAS_GETHOSTNAME and HAS_UNAME. - * Note that the command uses a fully qualified path, so that it is safe - * even if used by a process with super-user privileges. - */ -#$d_gethname HAS_GETHOSTNAME /**/ -#$d_uname HAS_UNAME /**/ -#$d_phostname PHOSTNAME "$aphostname" /* How to get the host name */ - /* HAS_GETLOGIN: * This symbol, if defined, indicates that the getlogin routine is * available to get the login name. @@ -1071,6 +1050,21 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_syssecrt I_SYS_SECURITY /**/ +/* CROSSCOMPILE: + * This symbol, if defined, signifies that we our + * build process is a cross-compilation. + */ +#$crosscompile CROSSCOMPILE /**/ + +/* MULTIARCH: + * This symbol, if defined, signifies that the build + * process will produce some binary files that are going to be + * used in a cross-platform environment. This is the case for + * example with the NeXT "fat" binaries that contain executables + * for several CPUs. + */ +#$multiarch MULTIARCH /**/ + /* MEM_ALIGNBYTES: * This symbol contains the number of bytes required to align a * double. Usual values are 2, 4 and 8. The default is eight, @@ -1576,6 +1570,31 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_gethent HAS_GETHOSTENT /**/ +/* HAS_GETHOSTNAME: + * This symbol, if defined, indicates that the C program may use the + * gethostname() routine to derive the host name. See also HAS_UNAME + * and PHOSTNAME. + */ +/* HAS_UNAME: + * This symbol, if defined, indicates that the C program may use the + * uname() routine to derive the host name. See also HAS_GETHOSTNAME + * and PHOSTNAME. + */ +/* PHOSTNAME: + * This symbol, if defined, indicates that the C program may use the + * contents of PHOSTNAME as a command to feed to the popen() routine + * to derive the host name. See also HAS_GETHOSTNAME and HAS_UNAME. + * Note that the command uses a fully qualified path, so that it is safe + * even if used by a process with super-user privileges. + */ +#$d_gethname HAS_GETHOSTNAME /**/ +#$d_uname HAS_UNAME /**/ +#$d_phostname PHOSTNAME +#ifdef $d_phostname +#undef $d_phostname +#$d_phostname PHOSTNAME "$aphostname" /* How to get the host name */ +#endif + /* HAS_GETNETBYADDR: * This symbol, if defined, indicates that the getnetbyaddr() routine is * available to look up networks by their IP addresses. @@ -2062,12 +2081,6 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_archlib ARCHLIB "$archlib" /**/ #$d_archlib ARCHLIB_EXP "$archlibexp" /**/ -/* CROSSCOMPILE: - * This symbol, if defined, signifies that we our - * build process is a cross-compilation. - */ -#$crosscompile CROSSCOMPILE /**/ - /* DLSYM_NEEDS_UNDERSCORE: * This symbol, if defined, indicates that we need to prepend an * underscore to the symbol name before calling dlsym(). This only @@ -2326,15 +2339,6 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_off64t HAS_OFF64_T /**/ #$d_dirent64_s HAS_STRUCT_DIRENT64 /**/ -/* MULTIARCH: - * This symbol, if defined, signifies that the build - * process will produce some binary files that are going to be - * used in a cross-platform environment. This is the case for - * example with the NeXT "fat" binaries that contain executables - * for several CPUs. - */ -#$multiarch MULTIARCH /**/ - /* PRIVLIB: * This symbol contains the name of the private library for this package. * The library is private in the sense that it needn't be in anyone's diff --git a/configure.com b/configure.com index 70131e4..7e28293 100644 --- a/configure.com +++ b/configure.com @@ -1727,27 +1727,6 @@ $ ENDIF $ ENDIF $ ENDIF $! -$! Pre-load %ENV? -$ echo "" -$ echo "Because of the way perl fetches the list of logical names -$ echo "for the %ENV hash (we spawn a subprocess that does a -$ echo "SHOW LOGICALS *, which is expensive), we defer fetching it -$ echo "until the first time a program iterates over the %ENV hash. -$ echo "This means things like 'exists($ENV{'SYS$MANAGER'})' will -$ echo "return false unless you've already accessed $ENV{SYS$MANAGER} -$ echo "or done something like a keys %ENV." -$ echo "" -$ echo "If you choose, perl can populate the %ENV hash at startup. -$ echo "This will exact both a memory penalty (to store the keys) and -$ echo "a time penalty (to spawn the subprocess) every time you invoke -$ echo "perl. Depending on your system, this might not be a big deal. -$ echo "" -$ dflt = "n" -$ rp = "Populate %ENV at startup time? [''dflt'] " -$ GOSUB myread -$ if ans.eqs."" then ans="''dflt'" -$ preload_env = f$extract(0, 1, f$edit(ans,"TRIM,COMPRESS,UPCASE")) -$! $! Ask if they want to use perl's memory allocator $ echo "" $ echo "Perl has a built-in memory allocator that's tuned for perl's diff --git a/ext/B/defsubs.h.PL b/ext/B/defsubs.h.PL index 6253bd2..e485ac3 100644 --- a/ext/B/defsubs.h.PL +++ b/ext/B/defsubs.h.PL @@ -1,5 +1,6 @@ #!perl -my ($out) = __FILE__ =~ /(^.*)\.PL/; +my ($out) = __FILE__ =~ /(^.*)[._]PL/i; +if ($^O eq 'VMS') { $out =~ s/(^.*)[._](.*$)/$1.$2/;} open(OUT,">$out") || die "Cannot open $file:$!"; foreach my $const (qw(AVf_REAL HEf_SVKEY diff --git a/vms/ext/vmsish.pm b/vms/ext/vmsish.pm index 851d576..dfb565b 100644 --- a/vms/ext/vmsish.pm +++ b/vms/ext/vmsish.pm @@ -56,9 +56,9 @@ sub bits { my $bits = 0; my $sememe; foreach $sememe (@_) { - $bits |= 0x01000000, next if $sememe eq 'status' || $sememe eq '$?'; - $bits |= 0x02000000, next if $sememe eq 'exit'; - $bits |= 0x04000000, next if $sememe eq 'time'; + $bits |= 0x20000000, next if $sememe eq 'status' || $sememe eq '$?'; + $bits |= 0x40000000, next if $sememe eq 'exit'; + $bits |= 0x80000000, next if $sememe eq 'time'; } $bits; } diff --git a/vms/subconfigure.com b/vms/subconfigure.com index 2ea5667..77dc15c 100644 --- a/vms/subconfigure.com +++ b/vms/subconfigure.com @@ -62,12 +62,12 @@ $ myname = myhostname $ if "''myname'" .eqs. "" THEN myname = f$trnlnm("SYS$NODE") $! $! ##ADD NEW CONSTANTS HERE## -$ perl_multiarch="undef" -$ perl_crosscompile="undef" $ perl_d_madvise="undef" $ perl_d_msync="undef" $ perl_d_mprotect="undef" $ perl_d_munmap="undef" +$ perl_crosscompile="undef" +$ perl_multiarch="undef" $ perl_d_mmap="undef" $ perl_i_sysmman="undef" $ perl_d_telldirproto="define" @@ -82,6 +82,7 @@ $ perl_d_hasmntopt="undef" $ perl_package="''package'" $ perl_baserev = "''baserev'" $ cc_defines="" +$ perl_installusrbinperl="undef" $ perl_CONFIG="true" $ perl_d_fseeko="undef" $ perl_d_ftello="undef" @@ -204,14 +205,14 @@ $ perl_osname="VMS" $ perl_d_archlib="define" $ perl_d_bincompat3="undef" $ perl_cppstdin="''Perl_CC'/noobj/preprocess=sys$output sys$input" -$ perl_cppminus="" +$ perl_cppminus=" " $ perl_d_castneg="define" $ perl_castflags="0" $ perl_d_chsize="undef" $ perl_d_const="define" $ perl_d_crypt="define" $ perl_byteorder="1234" -$ perl_full_csh="" +$ perl_full_csh=" " $ perl_d_csh="undef" $ perl_d_dup2="define" $ perl_d_fchmod="undef" @@ -365,9 +366,9 @@ $ENDIF $ perl_sh="MCR" $ perl_modetype="unsigned int" $ perl_ssizetype="int" -$ perl_o_nonblock="" -$ perl_eagain="" -$ perl_rd_nodata="" +$ perl_o_nonblock=" " +$ perl_eagain=" " +$ perl_rd_nodata=" " $ perl_d_eofnblk="undef" $ perl_d_oldarchlib="define" $ perl_privlibexp="''perl_prefix':[lib]" @@ -400,8 +401,8 @@ $ perl_d_getpgrp2="undef" $ perl_d_sfio="undef" $ perl_usedl="define" $ perl_startperl="""$ perl 'f$env(\""procedure\"")' 'p1' 'p2' 'p3' 'p4' 'p5' 'p6' 'p7' 'p8' !\n$ exit++ + ++$status != 0 and $exit = $status = undef;""" -$ perl_db_hashtype="" -$ perl_db_prefixtype="" +$ perl_db_hashtype=" " +$ perl_db_prefixtype=" " $ perl_useperlio="undef" $ perl_defvoidused="15" $ perl_voidflags="15" @@ -411,13 +412,13 @@ $ IF ("''Use_Threads'".eqs."T").and.("''VMS_VER'".LES."6.2") $ THEN $ perl_libs="SYS$SHARE:CMA$LIB_SHR.EXE/SHARE SYS$SHARE:CMA$RTL.EXE/SHARE SYS$SHARE:CMA$OPEN_LIB_SHR.exe/SHARE SYS$SHARE:CMA$OPEN_RTL.exe/SHARE" $ ELSE -$ perl_libs="" +$ perl_libs=" " $ ENDIF $ IF ("''Using_Dec_C'".eqs."Yes") $ THEN $ perl_libc="(DECCRTL)" $ ELSE -$ perl_libc="" +$ perl_libc=" " $ ENDIF $ perl_PATCHLEVEL="''patchlevel'" $ perl_SUBVERSION="''subversion'" @@ -447,7 +448,9 @@ $ perl_arch = "''perl_arch'-thread" $ perl_archname = "''perl_archname'-thread" $ ELSE $ perl_d_pthread_create_joinable = "undef" -$ perl_pthread_create_joinable = "" +$ perl_pthread_create_joinable = " " +$ perl_d_old_pthread_create_joinable = "undef" +$ perl_old_pthread_create_joinable = " " $ ENDIF $ perl_osvers=f$edit(osvers, "TRIM") $ if (perl_subversion + 0).eq.0 @@ -3065,6 +3068,8 @@ $ WC "d_tmpfile64='" + perl_d_tmpfile64 + "'" $ WC "d_drand48proto='" + perl_d_drand48proto + "'" $ WC "d_pthread_create_joinable='" + perl_d_pthread_create_joinable + "'" $ WC "pthread_create_joinable='" + perl_pthread_create_joinable + "'" +$ WC "d_old_pthread_create_joinable='" + perl_d_old_pthread_create_joinable + "'" +$ WC "old_pthread_create_joinable='" + perl_old_pthread_create_joinable + "'" $ WC "drand01='" + perl_drand01 + "'" $ WC "randseedtype='" + perl_randseedtype + "'" $ WC "seedfunc='" + perl_seedfunc + "'" @@ -3084,8 +3089,9 @@ $ WC "d_mprotect='" + perl_d_mprotect + "'" $ WC "d_munmap='" + perl_d_munmap + "'" $ WC "d_mmap='" + perl_d_mmap + "'" $ WC "i_sysmman='" + perl_i_sysmman + "'" -$ WC "multiarch='" + perl_multiarch + "'" +$ WC "installusrbinperl='" + perl_installusrbinperl + "'" $ WC "crosscompile='" + perl_crosscompile + "'" +$ WC "multiarch='" + perl_multiarch + "'" $! $! ##WRITE NEW CONSTANTS HERE## $! diff --git a/vms/vms.c b/vms/vms.c index 37f9587..8870a0f 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -119,12 +119,13 @@ my_trnlnm(char *lnm, char *eqv, unsigned long int idx) * caller; this pointer will be invalidated at next Perl statement * transition. */ -/*{{{ char *my_getenv(char *lnm)*/ +/*{{{ char *my_getenv(const char *lnm)*/ char * -my_getenv(char *lnm) +my_getenv(const char *lnm) { static char __my_getenv_eqv[LNM$C_NAMLENGTH+1]; - char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2, *eqv; + char uplnm[LNM$C_NAMLENGTH+1], *cp2, *eqv; + const char *cp1; unsigned long int idx = 0; int trnsuccess; SV *tmpsv; diff --git a/vms/vmsish.h b/vms/vmsish.h index 5e78b90..7fce3af 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -569,7 +569,7 @@ void init_os_extras _(()); /* prototype section start marker; `typedef' passes through cpp */ typedef char __VMS_PROTOTYPES__; int my_trnlnm _((char *, char *, unsigned long int)); -char * my_getenv _((char *)); +char * my_getenv _((const char *)); char * my_crypt _((const char *, const char *)); Pid_t my_waitpid _((Pid_t, int *, int)); char * my_gconvert _((double, int, int, char *));