From: Malcolm Beattie Date: Fri, 24 Oct 1997 14:36:09 +0000 (+0000) Subject: Patches for VMS [Dan Sugalski] X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5b411029755fe810157205c2903f1053046aff30;p=p5sagit%2Fp5-mst-13.2.git Patches for VMS [Dan Sugalski] p4raw-id: //depot/perl@173 --- diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index a09eafe..0e53a49 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -58,76 +58,6 @@ #if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) # define HAS_TZNAME /* shows up in VMS 7.0 or Dec C 5.6 */ # include -#else - /* The default VMS emulation of Unix signals isn't very POSIXish */ - typedef int sigset_t; -# define sigpending(a) (not_here("sigpending"),0) - - /* sigset_t is atomic under VMS, so these routines are easy */ - int sigemptyset(sigset_t *set) { - if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; } - *set = 0; return 0; - } - int sigfillset(sigset_t *set) { - int i; - if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; } - for (i = 0; i < NSIG; i++) *set |= (1 << i); - return 0; - } - int sigaddset(sigset_t *set, int sig) { - if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; } - if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; } - *set |= (1 << (sig - 1)); - return 0; - } - int sigdelset(sigset_t *set, int sig) { - if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; } - if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; } - *set &= ~(1 << (sig - 1)); - return 0; - } - int sigismember(sigset_t *set, int sig) { - if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; } - if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; } - *set & (1 << (sig - 1)); - } - /* The tools for sigprocmask() are there, just not the routine itself */ -# ifndef SIG_UNBLOCK -# define SIG_UNBLOCK 1 -# endif -# ifndef SIG_BLOCK -# define SIG_BLOCK 2 -# endif -# ifndef SIG_SETMASK -# define SIG_SETMASK 3 -# endif - int sigprocmask(int how, sigset_t *set, sigset_t *oset) { - if (!set || !oset) { - set_errno(EFAULT); set_vaxc_errno(SS$_ACCVIO); - return -1; - } - switch (how) { - case SIG_SETMASK: - *oset = sigsetmask(*set); - break; - case SIG_BLOCK: - *oset = sigblock(*set); - break; - case SIG_UNBLOCK: - *oset = sigblock(0); - sigsetmask(*oset & ~*set); - break; - default: - set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG); - return -1; - } - return 0; - } -# define sigaction sigvec -# define sa_flags sv_onstack -# define sa_handler sv_handler -# define sa_mask sv_mask -# define sigsuspend(set) sigpause(*set) # endif /* __VMS_VER >= 70000000 or Dec C 5.6 */ /* The POSIX notion of ttyname() is better served by getname() under VMS */ diff --git a/vms/descrip.mms b/vms/descrip.mms index 7681f21..47e192e 100644 --- a/vms/descrip.mms +++ b/vms/descrip.mms @@ -28,6 +28,12 @@ #: SOCKETSHR socket support. #: /Macro="DECC_SOCKETS=1" to include UCX (or #: compatible) socket support +#: /Macro="OLDTHREADED=1" to compile with the old +#: pthreads API (VMS version 6.2 and previous) +#: /Macro="THREADED=1" to compile with full POSIX +#: threads. (VMS 7.0 and above) +#: /Macro="FAKETHREADED=1" to compile with the +#: fake threads package # # tidy -- purge files generated by executing this file # clean -- remove all intermediate (e.g. object files, C files generated @@ -202,8 +208,33 @@ SOCKOBJ = SOCKPM = .endif +THREADH = +THREAD = + +.ifdef THREADED +THREADDEF = ,USE_THREADS,MULTIPLICITY +THREADH = thread.h +THREAD = THREAD +.endif + +.ifdef OLDTHREADED +THREADDEF = ,USE_THREADS,MULTIPLICITY,OLD_PTHREADS_API +THREADH = thread.h +THREAD = THREAD +LIBS2 = sys$share:cma$lib_shr/share,cma$rtl/share +.ifdef __AXP__ +LIBS2 = $(LIBS2),sys$share:cma$open_lib_shr/share,cma$open_rtl/share +.endif +.endif + +.ifdef FAKETHREADED +THREADDEF = ,USE_THREADS,MULTIPLICITY,FAKE_THREADS +THREADH = thread.h fakethr.h +THREAD = THREAD +.endif + # C preprocessor manifest "DEBUGGING" ==> perl -D, not the VMS debugger -CFLAGS = /Define=(DEBUGGING$(SOCKDEF)$(XTRADEF))$(XTRACCFLAGS)$(DBGCCFLAGS) +CFLAGS = /Define=(DEBUGGING$(SOCKDEF)$(XTRADEF)$(THREADDEF))$(XTRACCFLAGS)$(DBGCCFLAGS) LINKFLAGS = $(DBGLINKFLAGS) MAKE = $(MMS) @@ -246,7 +277,7 @@ h1 = EXTERN.h, INTERN.h, XSUB.h, av.h, config.h, cop.h, cv.h h2 = embed.h, form.h, gv.h, handy.h, hv.h, keywords.h, mg.h, op.h h3 = opcode.h, patchlevel.h, perl.h, perly.h, pp.h, proto.h, regcomp.h h4 = regexp.h, scope.h, sv.h, vmsish.h, util.h, perlio.h, perlsdio.h -h = $(h1), $(h2), $(h3), $(h4) $(SOCKHLIS) +h = $(h1), $(h2), $(h3), $(h4) $(SOCKHLIS) $(THREADH) c1 = av.c, scope.c, op.c, doop.c, doio.c, dump.c, hv.c, mg.c, universal.c, perlio.c c2 = perl.c, perly.c, pp.c, pp_hot.c, pp_ctl.c, pp_sys.c, regcomp.c, regexec.c @@ -311,7 +342,7 @@ all : base extras x2p archcorefiles preplibrary perlpods .endif base : miniperl perl @ $(NOOP) -extras : Fcntl IO Opcode $(POSIX) libmods utils podxform +extras : Fcntl IO Opcode attrs $(POSIX) $(THREAD) libmods utils podxform @ $(NOOP) libmods : $(LIBPREREQ) @ $(NOOP) @@ -466,6 +497,25 @@ Fcntl : [.lib]Fcntl.pm [.lib.auto.Fcntl]Fcntl$(E) [.ext.Fcntl]Descrip.MMS : [.ext.Fcntl]Makefile.PL $(LIBPREREQ) $(DBG)perlshr$(E) $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Fcntl]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" +attrs : [.lib]attrs.pm [.lib.auto.attrs]attrs$(E) + @ $(NOOP) + +[.lib]attrs.pm : [.ext.attrs]Descrip.MMS + @ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto] + @ Set Default [.ext.attrs] + $(MMS) + @ Set Default [--] + +[.lib.auto.attrs]attrs$(E) : [.ext.attrs]Descrip.MMS + @ Set Default [.ext.attrs] + $(MMS) + @ Set Default [--] + +# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C +# ${@} necessary to distract different versions of MM[SK]/make +[.ext.attrs]Descrip.MMS : [.ext.Fcntl]Makefile.PL $(LIBPREREQ) $(DBG)perlshr$(E) + $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.attrs]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" + POSIX : [.lib]POSIX.pm [.lib.auto.POSIX]POSIX$(E) @ $(NOOP) @@ -485,6 +535,25 @@ POSIX : [.lib]POSIX.pm [.lib.auto.POSIX]POSIX$(E) [.ext.POSIX]Descrip.MMS : [.ext.POSIX]Makefile.PL $(LIBPREREQ) $(DBG)perlshr$(E) $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.POSIX]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" +THREAD : [.lib]THREAD.pm [.lib.auto.THREAD]THREAD$(E) + @ $(NOOP) + +[.lib]THREAD.pm : [.ext.THREAD]Descrip.MMS + @ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto] + @ Set Default [.ext.THREAD] + $(MMS) + @ Set Default [--] + +[.lib.auto.THREAD]THREAD$(E) : [.ext.THREAD]Descrip.MMS + @ Set Default [.ext.THREAD] + $(MMS) + @ Set Default [--] + +# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C +# ${@} necessary to distract different versions of MM[SK]/make +[.ext.THREAD]Descrip.MMS : [.ext.THREAD]Makefile.PL $(LIBPREREQ) $(DBG)perlshr$(E) + $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.THREAD]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" + IO : [.lib]IO.pm [.lib.IO]File.pm [.lib.IO]Handle.pm [.lib.IO]Pipe.pm [.lib.IO]Seekable.pm [.lib.IO]Socket.pm [.lib.auto.IO]IO$(E) @ $(NOOP) @@ -1783,6 +1852,14 @@ realclean : clean Set Default [.ext.Opcode] - $(MMS) realclean Set Default [--] + Set Default [.ext.attrs] + - $(MMS) realclean + Set Default [--] +.ifdef THREAD + Set Default [.ext.Thread] + - $(MMS) realclean + Set Default [--] +.endif .ifdef DECC Set Default [.ext.POSIX] - $(MMS) realclean diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl index e451e18..5767c5f 100644 --- a/vms/gen_shrfls.pl +++ b/vms/gen_shrfls.pl @@ -150,6 +150,7 @@ sub scan_var { $line =~ s/\[.*//; $line =~ s/=.*//; $line =~ s/\W*;?\s*$//; + $line =~ s/\(void//; print "\tfiltered to \\$line\\\n" if $debug > 1; if ($line =~ /(\w+)$/) { print "\tvar name is \\$1\\" . ($const ? ' (const)' : '') . "\n" if $debug > 1; diff --git a/vms/vms.c b/vms/vms.c index d4f3f30..84330e2 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -3179,6 +3179,79 @@ void my_endpwent() /*}}}*/ #if __VMS_VER < 70000000 || __DECC_VER < 50200000 +/* Signal handling routines, pulled into the core from POSIX.xs. + * + * We need these for threads, so they've been rolled into the core, + * rather than left in POSIX.xs. + * + * (DRS, Oct 23, 1997) + */ + +/* sigset_t is atomic under VMS, so these routines are easy */ +int my_sigemptyset(sigset_t *set) { + if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; } + *set = 0; return 0; +} +int my_sigfillset(sigset_t *set) { + int i; + if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; } + for (i = 0; i < NSIG; i++) *set |= (1 << i); + return 0; +} +int my_sigaddset(sigset_t *set, int sig) { + if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; } + if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; } + *set |= (1 << (sig - 1)); + return 0; +} +int my_sigdelset(sigset_t *set, int sig) { + if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; } + if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; } + *set &= ~(1 << (sig - 1)); + return 0; +} +int my_sigismember(sigset_t *set, int sig) { + if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; } + if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; } + *set & (1 << (sig - 1)); +} +int my_sigprocmask(int how, sigset_t *set, sigset_t *oset) { + sigset_t tempmask; + + /* If set and oset are both null, then things are badky wrong. Bail */ + if ((oset == NULL) && (set == NULL)) { + set_errno(EFAULT); set_vaxc_errno(SS$_ACCVIO); + return -1; + } + + /* If set's null, then we're just handling a fetch. */ + if (set == NULL) { + tempmask = sigblock(0); + } else { + switch (how) { + case SIG_SETMASK: + tempmask = sigsetmask(*set); + break; + case SIG_BLOCK: + tempmask = sigblock(*set); + break; + case SIG_UNBLOCK: + tempmask = sigblock(0); + sigsetmask(*oset & ~tempmask); + break; + default: + set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG); + return -1; + } + } + + /* Did they pass us an oset? If so, stick our holding mask into it */ + if (oset) + *oset = tempmask; + + return 0; +} + /* Used for UTC calculation in my_gmtime(), my_localtime(), my_time(), * my_utime(), and flex_stat(), all of which operate on UTC unless * VMSISH_TIMES is true. diff --git a/vms/vmsish.h b/vms/vmsish.h index 2da1639..410031c 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -115,6 +115,12 @@ # define my_gmtime Perl_my_gmtime # define my_localtime Perl_my_localtime # define my_time Perl_my_time +# define my_sigemptyset Perl_my_sigemptyset +# define my_sigfillset Perl_my_sigfillset +# define my_sigaddset Perl_my_sigaddset +# define my_sigdelset Perl_my_sigdelset +# define my_sigismember Perl_my_sigismember +# define my_sigprocmask Perl_my_sigprocmask #endif # define cando_by_name Perl_cando_by_name # define flex_fstat Perl_flex_fstat @@ -336,6 +342,29 @@ struct utimbuf { #define gmtime(t) my_gmtime(t) #define localtime(t) my_localtime(t) #define time(t) my_time(t) +#define sigemptyset(t) my_sigemptyset(t) +#define sigfillset(t) my_sigfillset(t) +#define sigaddset(t, u) my_sigaddset(t, u) +#define sigdelset(t, u) my_sigdelset(t, u) +#define sigismember(t, u) my_sigismember(t, u) +#define sigprocmask(t, u, v) my_sigprocmask(t, u, v) +typedef int sigset_t; +/* The tools for sigprocmask() are there, just not the routine itself */ +# ifndef SIG_UNBLOCK +# define SIG_UNBLOCK 1 +# endif +# ifndef SIG_BLOCK +# define SIG_BLOCK 2 +# endif +# ifndef SIG_SETMASK +# define SIG_SETMASK 3 +# endif +# define sigaction sigvec +# define sa_flags sv_onstack +# define sa_handler sv_handler +# define sa_mask sv_mask +# define sigsuspend(set) sigpause(*set) +# define sigpending(a) (not_here("sigpending"),0) #endif /* VMS doesn't use a real sys_nerr, but we need this when scanning for error @@ -541,6 +570,16 @@ struct tm * my_gmtime _((const time_t *)); struct tm * my_localtime _((const time_t *)); time_t my_time _((time_t *)); #endif /* We're assuming these three come as a package */ +/* We're just gonna assume that if we've got an antique here that we */ +/* need the signal functions */ +#if __VMS_VER < 70000000 || __DECC_VER < 50200000 +int my_sigemptyset _((sigset_t *)); +int my_sigfillset _((sigset_t *)); +int my_sigaddset _((sigset_t *, int)); +int my_sigdelset _((sigset_t *, int)); +int my_sigismember _((sigset_t *, int)); +int my_sigprocmask _((int, sigset_t *, sigset_t *)); +#endif I32 cando_by_name _((I32, I32, char *)); int flex_fstat _((int, struct mystat *)); int flex_stat _((char *, struct mystat *));