From: Perl 5 Porters Date: Tue, 2 Jan 1996 03:34:26 +0000 (+0000) Subject: Updated for VMS. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e518068a77032c4207f9b00e462857e158778ea4;p=p5sagit%2Fp5-mst-13.2.git Updated for VMS. --- diff --git a/vms/Makefile b/vms/Makefile index 5c6deb1..075a6b9 100644 --- a/vms/Makefile +++ b/vms/Makefile @@ -3,7 +3,7 @@ #> conversion process. For more information, see mms2make.pl #> # Makefile. for perl5 on VMS -# Last revised 5-Jun-1995 by Charles Bailey bailey@genetics.upenn.edu +# Last revised 4-Dec-1995 by Charles Bailey bailey@genetics.upenn.edu # # # tidy -- purge files generated by executing this file @@ -35,8 +35,6 @@ ARCHAUTO = [.lib.$(ARCH).auto] # -fno-builtin avoids bug in gcc up to version 2.6.2 which can destroy # data when memcpy() is called on large (>64 kB) blocks of memory # (fixed in gcc 2.6.3) -.first: - @ If f$$TrnLnm("Sys").eqs."" Then Define/NoLog SYS sys$$Library XTRAOBJS = LIBS1 = $(XTRAOBJS) DBGSPECFLAGS = /Show=(Source,Include,Expansion) @@ -45,9 +43,11 @@ DBGSPECFLAGS = /Show=(Source,Include,Expansion) # SYSNAM is enabled. This is fixed in CSC Patch # AXPACRT04_061, but turning # off SYSNAM for the MM[SK] subprocess doesn't hurt anything, so we do it # just in case. +.first: + @ If f$$TrnLnm("Sys").eqs."" Then Define/NoLog SYS sys$$Library XTRACCFLAGS = /Include=[]/Object=$(O) XTRADEF = -LIBS2 = sys$$Share:VAXCRTL.Exe/Shareable +LIBS2 = VAXCRTL/Shareable DBGCCFLAGS = /NoList @@ -70,14 +70,14 @@ SOCKPM = CFLAGS = /Define=(DEBUGGING$(SOCKDEF)$(XTRADEF))$(XTRACCFLAGS)$(DBGCCFLAGS) LINKFLAGS = $(DBGLINKFLAGS) -MAKE = MMK +MAKE = $(MMS) MAKEFILE = [.VMS]Makefile. # this file NOOP = continue # Macros to invoke a copy of miniperl during the build. Targets which # are built using these macros should depend on $(MINIPERL_EXE) MINIPERL_EXE = sys$$Disk:[]miniperl$(E) -MINIPERL = MCR $(MINIPERL_EXE) "-Ilib" +MINIPERL = MCR $(MINIPERL_EXE) "-I[.lib]" XSUBPP = $(MINIPERL) [.lib.extutils]xsubpp # Macro to invoke a preexisting copy of Perl. This is used to regenerate # some header files when rebuilding Perl, but premade versions are provided @@ -146,9 +146,9 @@ CRTLOPTS =,$(CRTL)/Options all : base extras archcorefiles preplibrary @ $(NOOP) -base : miniperl$(E) perl$(E) [.lib.$(ARCH)]Config.pm +base : miniperl$(E) perl$(E) @ $(NOOP) -extras : [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm [.lib.extutils]MM_VMS.pm +extras : [.lib]Config.pm [.lib.$(ARCH)]Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm [.lib.extutils]MM_VMS.pm @ $(NOOP) archcorefiles : $(ac1) $(ac2) $(ac3) $(ac4) $(ac5) $(ac6) $(ac7) $(ac8) $(ac9) $(acs) $(ARCHAUTO)time.stamp @ $(NOOP) @@ -168,11 +168,11 @@ $(DBG)libperl$(OLB) : $(obj) perlmain.c : miniperlmain.c $(MINIPERL_EXE) [.vms]writemain.pl $(MINIPERL) [.VMS]Writemain.pl "$(EXT)" -perl$(E) : perlmain$(O), perlshr$(E), perlshr_attr.opt $(MINIPERL_EXE) +perl$(E) : perlmain$(O), perlshr$(E), $(MINIPERL_EXE) @ $$@[.vms]genopt "PerlShr.Opt/Write" "|" "''f$$Environment("Default")'$(DBG)PerlShr$(E)/Share" Link $(LINKFLAGS)/Exe=$(DBG)$@ perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts - Link $(LINKFLAGS)/Share=$(DBG)$@ $(extobj) []$(DBG)perlshr_bld.opt/Option, perlshr_attr.opt/Option + Link /NoTrace$(LINKFLAGS)/Share=$(DBG)$@ $(extobj) []$(DBG)perlshr_bld.opt/Option, perlshr_attr.opt/Option # The following files are built in one go by gen_shrfls.pl: # perlshr_attr.opt, $(DBG)perlshr_bld.opt - VAX and AXP # perlshr_gbl*.mar, perlshr_gbl*$(O) - VAX only @@ -188,7 +188,7 @@ $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $( Copy [.lib]config.pm $@ [.lib]config.pm : [.vms]config.vms [.vms]genconfig.pl $(MINIPERL_EXE) - $(MINIPERL) [.VMS]GenConfig.Pl cc=$(CC)$(CFLAGS) ldflags=$(LINKFLAGS) + $(MINIPERL) [.VMS]GenConfig.Pl cc=$(CC)$(CFLAGS) ldflags=$(LINKFLAGS) obj_ext=$(O) exe_ext=$(E) lib_ext=$(OLB) $(MINIPERL) ConfigPM. [.ext.dynaloader]dl_vms.c : [.ext.dynaloader]dl_vms.xs $(MINIPERL_EXE) @@ -201,7 +201,7 @@ $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $( Copy/Log/NoConfirm [.ext.dynaloader]dynaloader.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm : [.vms.ext]Filespec.pm - @ Create/Directory [.lib.VMS] + @ If f$$Search("[.lib]VMS.Dir").eqs."" Then Create/Directory [.lib.VMS] Copy/Log/NoConfirm [.vms.ext]Filespec.pm $@ [.lib.ExtUtils]MM_VMS.pm : [.vms.ext]MM_VMS.pm @@ -210,18 +210,21 @@ $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $( preplibrary : $(MINIPERL_EXE) [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm [.lib.ExtUtils]MM_VMS.pm $(SOCKPM) @ Write sys$$Output "Autosplitting Perl library . . ." @ Create/Directory [.lib.auto] - @ $(MINIPERL) "-Ilib" -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]*.pm [.lib.*]*.pm + @ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]*.pm [.lib.*]*.pm -opcode.h : opcode.pl - @ Write sys$$Output "Don't worry if this fails." - - $(INSTPERL) opcode.pl -keywords.h : keywords.pl - @ Write sys$$Output "Don't worry if this fails." - - $(INSTPERL) keywords.pl -embed.h : global.sym interp.sym - @ Write sys$$Output "Don't worry if this fails." - - $(INSTPERL) [.vms]embed_h.pl +# The following three header files are generated automatically +# keywords.h : keywords.pl +# opcode.h : opcode.pl +# embed.h : embed.pl global.sym interp.sym +# The correct versions should be already supplied with the perl kit, +# in case you don't have perl available. +# To force them to run, type +# MMS regen_headers +regen_headers : + $(INSTPERL) keywords.pl + $(INSTPERL) opcode.pl + $(INSTPERL) embed.pl # VMS uses modified perly.[ch] with tags for globaldefs if using DEC compiler perly.c : [.vms]perly_c.vms @@ -233,7 +236,7 @@ perly.h : [.vms]perly_h.vms # commented out if you don't have byacc. # Altered for VMS by Charles Bailey bailey@genetics.upenn.edu # perly.c: -# @ Write Sys$Output 'Expect' 80 shift/reduce and 62 reduce/reduce conflicts +# @ Write Sys$Output "Expect 80 shift/reduce and 62 reduce/reduce conflicts" # \$(BYACC) -d perly.y # Has to be done by hand or by POSIX shell under VMS # sh \$(shellflags) ./perly.fixer y.tab.c perly.c @@ -243,103 +246,103 @@ perly.h : [.vms]perly_h.vms perly$(O) : perly.c, perly.h, $(h) $(CC) $(CFLAGS) perly.c -test : perl$(E) +test : all - @[.VMS]Test.Com # CORE subset for MakeMaker, so we can build Perl without sources # Should move to VMS installperl when we get one $(ARCHCORE)EXTERN.h : EXTERN.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log EXTERN.h $@ $(ARCHCORE)INTERN.h : INTERN.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log INTERN.h $@ $(ARCHCORE)XSUB.h : XSUB.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log XSUB.h $@ $(ARCHCORE)av.h : av.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log av.h $@ $(ARCHCORE)config.h : config.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log config.h $@ $(ARCHCORE)cop.h : cop.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log cop.h $@ $(ARCHCORE)cv.h : cv.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log cv.h $@ $(ARCHCORE)embed.h : embed.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log embed.h $@ $(ARCHCORE)form.h : form.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log form.h $@ $(ARCHCORE)gv.h : gv.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log gv.h $@ $(ARCHCORE)handy.h : handy.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log handy.h $@ $(ARCHCORE)hv.h : hv.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log hv.h $@ $(ARCHCORE)keywords.h : keywords.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log keywords.h $@ $(ARCHCORE)mg.h : mg.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log mg.h $@ $(ARCHCORE)op.h : op.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log op.h $@ $(ARCHCORE)opcode.h : opcode.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log opcode.h $@ $(ARCHCORE)patchlevel.h : patchlevel.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log patchlevel.h $@ $(ARCHCORE)perl.h : perl.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log perl.h $@ $(ARCHCORE)perly.h : perly.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log perly.h $@ $(ARCHCORE)pp.h : pp.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log pp.h $@ $(ARCHCORE)proto.h : proto.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log proto.h $@ $(ARCHCORE)regcomp.h : regcomp.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log regcomp.h $@ $(ARCHCORE)regexp.h : regexp.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log regexp.h $@ $(ARCHCORE)scope.h : scope.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log scope.h $@ $(ARCHCORE)sv.h : sv.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log sv.h $@ $(ARCHCORE)util.h : util.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log util.h $@ $(ARCHCORE)vmsish.h : vmsish.h - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log vmsish.h $@ $(ARCHCORE)$(DBG)libperl$(OLB) : $(DBG)libperl$(OLB) $(DBG)perlshr_xtras.ts - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(DBG)libperl$(OLB) $@ $(ARCHCORE)perlshr_attr.opt : $(DBG)perlshr_xtras.ts - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log perlshr_attr.opt $@ $(ARCHCORE)$(DBG)perlshr_bld.opt : $(DBG)perlshr_xtras.ts - @ Create/Directory $(ARCHCORE) + @ If f$$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(DBG)perlshr_bld.opt $@ $(ARCHAUTO)time.stamp : - @ Create/Directory $(ARCHAUTO) + @ If f$$Search("[.lib.$(ARCH)]auto.dir").eqs."" Then Create/Directory $(ARCHAUTO) @ If f$$Search("$@").eqs."" Then Copy/NoConfirm _NLA0: $(MMS$TARGET) # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE @@ -1006,6 +1009,9 @@ tidy : cleanlis - If f$$Search("[.Lib.Auto...]*.al;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Auto...]*.al - If f$$Search("[.Lib.Auto...]autosplit.ix;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Auto...]autosplit.ix - If f$$Search("[.Lib]DynaLoader.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib]DynaLoader.pm + - If f$$Search("[.Lib]Socket.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib]Socket.pm + - If f$$Search("[.Lib]Config.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib]Config.pm + - If f$$Search("[.Lib.$(ARCH)]Config.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib.$(ARCH)]Config.pm - If f$$Search("[.Lib.VMS]*.*;-1").nes."" Then Purge/NoConfirm/Log [.Lib.VMS]*.* - If f$$Search("[.Lib.ExtUtils]MM_VMS.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib.ExtUtils]MM_VMS.pm - If f$$Search("$(ARCHCORE)*.*").nes."" Then Purge/NoConfirm/Log $(ARCHCORE)*.* @@ -1038,6 +1044,8 @@ realclean : clean - If f$$Search("[.Lib]DynaLoader.pm").nes."" Then Delete/NoConfirm/Log [.Lib]DynaLoader.pm;* - If f$$Search("[.Lib.ExtUtils]MM_VMS.pm").nes."" Then Delete/NoConfirm/Log [.Lib.ExtUtils]MM_VMS.pm;* - If f$$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);* + - If f$$Search("[.Lib]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib]Config.pm;* + - If f$$Search("[.Lib.$(ARCH)]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib.$(ARCH)]Config.pm;* cleansrc : clean - If f$$Search("*.C;-1").nes."" Then Purge/NoConfirm/Log *.C @@ -1050,7 +1058,3 @@ cleansrc : clean - If f$$Search("[.VMS]*.VMS;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.VMS - If f$$Search("[.VMS...]*.pm;-1").nes."" Then Purge/NoConfirm/Log [.VMS...]*.pm - If f$$Search("[.VMS...]*.xs;-1").nes."" Then Purge/NoConfirm/Log [.VMS...]*.xs - - If f$$Search("[.Lib.Auto...]*.al").nes."" Then Delete/NoConfirm/Log [.Lib.Auto...]*.al;* - - If f$$Search("[.Lib.Auto...]autosplit.ts").nes."" Then Delete/NoConfirm/Log [.Lib.Auto...]autosplit.ts;* - - If f$$Search("[.Lib.$(ARCH)]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib.$(ARCH)]Config.pm;* - - If f$$Search("[.Lib]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib]Config.pm;* diff --git a/vms/config.vms b/vms/config.vms index 6381339..cd8a46d 100644 --- a/vms/config.vms +++ b/vms/config.vms @@ -8,10 +8,10 @@ * GenConfig.pl when producing Config.pm. * * config.h for VMS - * Version: 5.1.5 + * Version: 5.2.b1 */ -/* Configuration time: 8-Jun-1995 17:00 +/* Configuration time: 4-Dec-1995 17:00 * Configured by: Charles Bailey bailey@genetics.upenn.edu * Target system: VMS */ @@ -19,18 +19,39 @@ #ifndef _config_h_ #define _config_h_ +/* CAT2: + * This macro catenates 2 tokens together. + */ +/* STRINGIFY: + * This macro surrounds its token with double quotes. + */ +#ifdef __STDC__ +#define CAT2(a,b)a ## b +#define CAT3(a,b,c)a ## b ## c +#define CAT4(a,b,c,d)a ## b ## c ##d +#define CAT5(a,b,c,d,e)a ## b ## c ## d ## e +#define StGiFy(a) # a +#define STRINGIFY(A)StGiFy(a) +#define SCAT2(a,b)StGiFy(a) StGiFy(b) +#define SCAT3(a,b,c)StGiFy(a) StGiFy(b) StGiFy(c) +#define SCAT4(a,b,c,d)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d) +#define SCAT5(a,b,c,d,e)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d) StGiFy(e) +#else +#define CAT2(a,b)a/**/b +#define CAT3(a,b,c)a/**/b/**/c +#define CAT4(a,b,c,d)a/**/b/**/c/**/d +#define CAT5(a,b,c,d,e)a/**/b/**/c/**/d/**/e +#define STRINGIFY(a)"a" +#endif + +/* config-start */ + /* MEM_ALIGNBYTES: * This symbol contains the number of bytes required to align a * double. Usual values are 2, 4 and 8. */ #define MEM_ALIGNBYTES 8 /**/ -/* BYTEORDER: - * This symbol hold the hexadecimal constant defined in byteorder, - * i.e. 0x1234 or 0x4321, etc... - */ -#define BYTEORDER 0x1234 /* large digits for MSB */ - /* ARCHLIB_EXP: * This variable, if defined, holds the name of the directory in * which the user wants to put architecture-dependent public @@ -46,26 +67,6 @@ #define ARCHLIB_EXP "/perl_root/lib/VMS_VAX" /* config-skip */ #endif -/* CAT2: - * This macro catenates 2 tokens together. - */ -/* STRINGIFY: - * This macro surrounds its token with double quotes. - */ -#ifdef __STDC__ -#define CAT2(a,b) a##b /* config-skip */ -#define CAT3(a,b,c) a##b##c /* config-skip */ -#define CAT4(a,b,c,d) a##b##c##d /* config-skip */ -#define CAT5(a,b,c,d,e) a##b##c##d##e /* config-skip */ -#define STRINGIFY(a) #a /* config-skip */ -#else -#define CAT2(a,b) a/**/b /* config-skip */ -#define CAT3(a,b,c) a/**/b/**/c /* config-skip */ -#define CAT4(a,b,c,d) a/**/b/**/c/**/d /* config-skip */ -#define CAT5(a,b,c,d,e) a/**/b/**/c/**/d/**/e /* config-skip */ -#define STRINGIFY(a) "a" /* config-skip */ -#endif - /* CPPSTDIN: * This symbol contains the first part of the string which will invoke * the C preprocessor on the standard input and produce to standard @@ -113,14 +114,6 @@ #define CASTNEGFLOAT /**/ #define CASTFLAGS 0 /**/ -/* CHARSPRINTF: - * This symbol is defined if this system declares "char *sprintf()" in - * stdio.h. The trend seems to be to declare it as "int sprintf()". It - * is up to the package author to declare sprintf correctly based on the - * symbol. - */ -#undef CHARSPRINTF /**/ - /* HAS_CHSIZE: * This symbol, if defined, indicates that the chsize routine is available * to truncate files. You might need a -lx to get this routine. @@ -144,6 +137,12 @@ */ #undef HAS_CRYPT /**/ +/* BYTEORDER: + * This symbol hold the hexadecimal constant defined in byteorder, + * i.e. 0x1234 or 0x4321, etc... + */ +#define BYTEORDER 0x1234 /* large digits for MSB */ + /* CSH: * This symbol, if defined, indicates that the C-shell exists. * If defined, contains the full pathname of csh. @@ -312,6 +311,12 @@ */ #define HAS_OPEN3 /**/ +/* HAS_POLL: + * This symbol, if defined, indicates that the poll routine is + * available to poll active file descriptors. + */ +#undef HAS_POLL /**/ + /* HAS_READDIR: * This symbol, if defined, indicates that the readdir routine is * available to read directory entries. You may have to include @@ -351,13 +356,6 @@ */ #define HAS_RMDIR /**/ -/* HAS_SELECT: - * This symbol, if defined, indicates that the select routine is - * available to select active file descriptors. If the timeout field - * is used, may need to be included. - */ -#undef HAS_SELECT /**/ - /* HAS_SEM: * This symbol, if defined, indicates that the entire sem*(2) library is * supported. @@ -489,7 +487,8 @@ /* VMS: * Regular FILE * are pretty close to meeting these criteria, but socket * I/O uses a summy FILE *, and Perl doesn't distinguish between socket - * and non-socket filehandles. */ + * and non-socket filehandles. + */ #undef USE_STDIO_PTR /**/ #undef USE_STDIO_BASE /**/ @@ -768,12 +767,6 @@ */ #undef I_SYS_IOCTL /**/ -/* HAS_IOCTL: - * This symbol, if defined, indicates that the ioctl() routine is - * available to set I/O characteristics - */ -#undef HAS_IOCTL /**/ - /* I_SYS_NDIR: * This symbol, if defined, indicates to the C program that it should * include . @@ -786,6 +779,17 @@ */ #undef I_SYS_SELECT /**/ +/* I_DBM: + * This symbol, if defined, indicates that exists and should + * be included. + */ +/* I_RPCSVC_DBM: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#undef I_DBM /**/ +#undef I_RPCSVC_DBM /**/ + /* I_SYS_STAT: * This symbol, if defined, indicates to the C program that it should * include . @@ -804,6 +808,12 @@ */ #define I_SYS_TYPES /**/ +/* I_SYS_UN: + * This symbol, if defined, indicates to the C program that it should + * include to get UNIX domain socket definitions. + */ +#undef I_SYS_UN /**/ + /* I_TERMIO: * This symbol, if defined, indicates that the program should include * rather than . There are also differences in @@ -852,21 +862,10 @@ */ #undef I_UTIME /**/ -/* HAS_UTIME: - * This symbol, if defined, indicates that the routine utime() is - * available to update the access and modification times of files. - */ -#define HAS_UTIME /**/ - -/* I_STDARG: - * This symbol, if defined, indicates that exists and should - * be included. - */ /* I_VARARGS: * This symbol, if defined, indicates to the C program that it should * include . */ -#define I_STDARG /**/ #undef I_VARARGS /**/ @@ -876,13 +875,6 @@ */ #undef I_VFORK /**/ -/* INTSIZE: - * This symbol contains the size of an int, so that the C preprocessor - * can make decisions based on it. - */ -#define INTSIZE 4 /**/ - - /* CAN_PROTOTYPE: * If defined, this macro indicates that the C compiler can handle * function prototypes. @@ -914,7 +906,7 @@ * is defined, and 'int *' otherwise. This is only useful if you * have select(), of course. */ -#define Select_fd_set_t fd_set * /**/ +#define Select_fd_set_t int * /**/ /* STDCHAR: * This symbol is defined to be the type of char used in stdio.h. @@ -922,45 +914,12 @@ */ #define STDCHAR char /**/ -/* VOIDFLAGS: - * This symbol indicates how much support of the void type is given by this - * compiler. What various bits mean: - * - * 1 = supports declaration of void - * 2 = supports arrays of pointers to functions returning void - * 4 = supports comparisons between pointers to void functions and - * addresses of void functions - * 8 = suports declaration of generic void pointers - * - * The package designer should define VOIDUSED to indicate the requirements - * of the package. This can be done either by #defining VOIDUSED before - * including config.h, or by defining defvoidused in Myinit.U. If the - * latter approach is taken, only those flags will be tested. If the - * level of void support necessary is not present, defines void to int. - */ -#ifndef VOIDUSED -#define VOIDUSED 15 -#endif -#define VOIDFLAGS 15 -#if (VOIDFLAGS & VOIDUSED) != VOIDUSED -#define void int /* is void to be avoided? */ /* config-skip */ -#define M_VOID /* Xenix strikes again */ /* config-skip */ -#endif - /* UNLINK_ALL_VERSIONS: * This symbol, if defined, indicates that the program should arrange * to remove all versions of a file if unlink() is called. */ #undef UNLINK_ALL_VERSIONS /**/ -/* VMS: - * This symbol, if defined, indicates that the program is running under - * VMS. It's a symbol automagically defined by all VMS C compilers I've seen. - * Just in case, however . . . */ -#ifndef VMS -#define VMS /**/ -#endif - /* LOC_SED: * This symbol holds the complete pathname to the sed program. */ @@ -978,6 +937,19 @@ */ #define HAS_ALARM /**/ +/* HASATTRIBUTE: + * This symbol indicates the C compiler can check for function attributes, + * such as printf formats. This is normally only supported by GNU cc. + */ +#ifdef __GNUC__ +# define HASATTRIBUTE /*config-skip*/ +#else +# undef HASATTRIBUTE /*config-skip*/ +#endif +#ifndef HASATTRIBUTE +#define __attribute__(_arg_) +#endif + /* CASTI32: * This symbol is defined if the C compiler can cast negative * or large floating point numbers to 32-bit ints. @@ -1038,12 +1010,6 @@ */ #undef HAS_GETPPID /**/ -/* HAS_GETGRENT: - * This symbol, if defined, indicates that the getgrent routine is - * available. - */ -#undef HAS_GETGRENT /**/ - /* HAS_HTONL: * This symbol, if defined, indicates that the htonl() routine (and * friends htons() ntohl() ntohs()) are available to do network @@ -1087,13 +1053,6 @@ */ #define HAS_NICE /**/ -/* HAS_PASSWD: - * This symbol, if defined, indicates that the getpwnam(), - * getpwuid(), and getpwent() routines are available to - * get password entries. - */ -#define HAS_PASSWD /**/ - /* HAS_PAUSE: * This symbol, if defined, indicates that the pause routine is * available. @@ -1174,14 +1133,6 @@ */ #define HAS_UMASK /**/ -/* VOIDSIG: - * This symbol is defined if this system declares "void (*signal(...))()" in - * signal.h. The old way was to declare it as "int (*signal(...))()". It - * is up to the package author to declare things correctly based on the - * symbol. - */ -#define VOIDSIG /**/ - /* HAS_WCTOMB: * This symbol, if defined, indicates that the wctomb routine is available * to covert a wide character to a multibyte. @@ -1202,7 +1153,11 @@ * It can be int, ushort, uid_t, etc... It may be necessary to include * to get any typedef'ed information. */ -#define Gid_t unsigned int /* Type for getgid(), etc... */ +#if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 500000) +# define Gid_t gid_t /* config-skip */ +#else +# define Gid_t unsigned int /* config-skip */ +#endif /* I_DLFCN: * This symbol, if defined, indicates that exists and should @@ -1223,12 +1178,23 @@ */ #define I_MATH /**/ +/* I_LOCALE: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#undef I_LOCALE /**/ + /* I_SYS_STAT: * This symbol, if defined, indicates to the C program that it should * include . */ #define I_SYS_STAT /**/ +/* INTSIZE: + * This symbol contains the size of an int, so that the C preprocessor + * can make decisions based on it. + */ +#define INTSIZE 4 /**/ /* Off_t: * This symbol holds the type used to declare offsets in the kernel. @@ -1236,16 +1202,53 @@ * to get any typedef'ed information. */ #define Off_t int /* type */ + +/* Free_t: + * This variable contains the return type of free(). It is usually + * void, but occasionally int. + */ /* Malloc_t: * This symbol is the type of pointer returned by malloc and realloc. */ #define Malloc_t void * /**/ +#define Free_t void /**/ /* MYMALLOC: * This symbol, if defined, indicates that we're using our own malloc. */ #undef MYMALLOC /**/ +/* SIG_NAME: + * This symbol contains a list of signal names in order. This is intended + * to be used as a static array initialization, like this: + * char *sig_name[] = { SIG_NAME }; + * The signals in the list are separated with commas, and each signal + * is surrounded by double quotes. There is no leading SIG in the signal + * name, i.e. SIGQUIT is known as "QUIT". Duplicates are allowed. + * The signal number for sig_name[i] is stored in sig_num[i]. + * The last element is 0 to terminate the list with a NULL. This + * corresponds to the 0 at the end of the sig_num list. + * See SIG_NUM and SIG_MAX. + */ +#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","IOT","EMT","FPE",\ + "KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM",\ + "ABRT","USR1","USR2",0 + +/* SIG_NUM: + * This symbol contains a list of signal number, in the same order as the + * SIG_NAME list. It is suitable for static array initialization, as in: + * int sig_num[] = { SIG_NUM }; + * The signals in the list are separated with commas, and the indices + * within that list and the SIG_NAME list match, so it's easy to compute + * the signal name from a number or vice versa at the price of a small + * dynamic linear lookup. Duplicates are allowed, so you can't assume + * sig_num[i] == i. Instead, the signal number corresponding to + * sig_name[i] is sig_number[i]. + * The last element is 0, corresponding to the 0 at the end of + * the sig_name list. + */ +#define SIG_NUM 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,6,16,17,0 /**/ + /* Mode_t: * This symbol holds the type used to declare file modes * for systems calls. It is usually mode_t, but may be @@ -1264,6 +1267,39 @@ */ #define SSize_t int /* signed count of bytes */ +/* VAL_O_NONBLOCK: + * This symbol is to be used during open() or fcntl(F_SETFL) to turn on + * non-blocking I/O for the file descriptor. Note that there is no way + * back, i.e. you cannot turn it blocking again this way. If you wish to + * alternatively switch between blocking and non-blocking, use the + * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. + */ +/* VAL_EAGAIN: + * This symbol holds the errno error code set by read() when no data was + * present on the non-blocking file descriptor. + */ +/* RD_NODATA: + * This symbol holds the return code from read() when no data is present + * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is + * not defined, then you can't distinguish between no data and EOF by + * issuing a read(). You'll have to find another way to tell for sure! + */ +/* EOF_NONBLOCK: + * This symbol, if defined, indicates to the C program that a read() on + * a non-blocking file descriptor will return 0 on EOF, and not the value + * held in RD_NODATA (-1 usually, in that case!). + */ +#define VAL_O_NONBLOCK +#define VAL_EAGAIN +#define RD_NODATA +#undef EOF_NONBLOCK + +/* OLDARCHLIB_EXP: + * This symbol contains the ~name expanded version of OLDARCHLIB, to be + * used in programs that are not prepared to deal with ~ expansion at + * run-time. + */ +#define OLDARCHLIB_EXP "/perl_root/lib" /**/ /* PRIVLIB_EXP: * This symbol contains the name of the private library for this package. @@ -1273,6 +1309,18 @@ */ #define PRIVLIB_EXP "/perl_root/lib" /**/ +/* SITELIB_EXP: + * This symbol contains the ~name expanded version of SITELIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#undef SITELIB_EXP /**/ + +/* SITEARCH_EXP: + * This symbol contains the ~name expanded version of SITEARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#undef SITEARCH_EXP /**/ + /* SCRIPTDIR: * This symbol holds the name of the directory in which the user wants * to put publicly executable scripts for the package in question. It @@ -1281,17 +1329,6 @@ */ #define SCRIPTDIR "/perl_root/script" /**/ -/* SIG_NAME: - * This symbol contains a list of signal names in order. This is intended - * to be used as a static array initialization, like this: - * char *sig_name[] = { SIG_NAME }; - * The signals in the list are separated with commas, and each signal - * is surrounded by double quotes. There is no leading SIG in the signal - * name, i.e. SIGQUIT is known as "QUIT". - */ -#define SIG_NAME "HUP","INT","QUIT","ILL","TRAP","IOT","EMT","FPE","KILL",\ - "BUS","SEGV","SYS","PIPE","ALRM","TERM" - /* Size_t: * This symbol holds the type used to declare length parameters * for string functions. It is usually size_t, but may be @@ -1361,28 +1398,12 @@ #undef SETUID_SCRIPTS_ARE_SECURE_NOW /**/ #undef DOSUID /**/ -/* Gconvert: - * This preprocessor macro is defined to convert a floating point - * number to a string without a trailing decimal point. This - * emulates the behavior of sprintf("%g"), but is sometimes much more - * efficient. If gconvert() is not available, but gcvt() drops the - * trailing decimal point, then gcvt() is used. If all else fails, - * a macro using sprintf("%g") is used. - */ -#define Gconvert(x,n,t,b) my_gconvert(x,n,t,b) - /* HAS_ISASCII: * This manifest constant lets the C program know that the * isascii is available. */ #define HAS_ISASCII /**/ -/* USE_LINUX_STDIO: - * This symbol is defined if this system has a FILE structure declaring - * _IO_read_base, _IO_read_ptr, and _IO_read_end in stdio.h. - */ -#undef USE_LINUX_STDIO /**/ - /* HAS_LOCALECONV: * This symbol, if defined, indicates that the localeconv routine is * available for numeric and monetary formatting conventions. @@ -1442,12 +1463,54 @@ */ #undef HAS_SYSCONF /**/ +/* Gconvert: + * This preprocessor macro is defined to convert a floating point + * number to a string without a trailing decimal point. This + * emulates the behavior of sprintf("%g"), but is sometimes much more + * efficient. If gconvert() is not available, but gcvt() drops the + * trailing decimal point, then gcvt() is used. If all else fails, + * a macro using sprintf("%g") is used. Arguments for the Gconvert + * macro are: value, number of digits, whether trailing zeros should + * be retained, and the output buffer. + * Possible values are: + * d_Gconvert='gconvert((x),(n),(t),(b))' + * d_Gconvert='gcvt((x),(n),(b))' + * d_Gconvert='sprintf((b),"%.*g",(n),(x))' + * The last two assume trailing zeros should not be kept. + */ +#define Gconvert(x,n,t,b) my_gconvert(x,n,t,b) + /* USE_DYNAMIC_LOADING: * This symbol, if defined, indicates that dynamic loading of * some sort is available. */ #define USE_DYNAMIC_LOADING /**/ +/* VOIDFLAGS: + * This symbol indicates how much support of the void type is given by this + * compiler. What various bits mean: + * + * 1 = supports declaration of void + * 2 = supports arrays of pointers to functions returning void + * 4 = supports comparisons between pointers to void functions and + * addresses of void functions + * 8 = suports declaration of generic void pointers + * + * The package designer should define VOIDUSED to indicate the requirements + * of the package. This can be done either by #defining VOIDUSED before + * including config.h, or by defining defvoidused in Myinit.U. If the + * latter approach is taken, only those flags will be tested. If the + * level of void support necessary is not present, defines void to int. + */ +#ifndef VOIDUSED +#define VOIDUSED 15 +#endif +#define VOIDFLAGS 15 +#if (VOIDFLAGS & VOIDUSED) != VOIDUSED +#define void int /* is void to be avoided? */ /* config-skip */ +#define M_VOID /* Xenix strikes again */ /* config-skip */ +#endif + #ifdef VMS_DO_SOCKETS /* HAS_SOCKET: * This symbol, if defined, indicates that the BSD socket interface is @@ -1488,12 +1551,32 @@ #define Groups_t unsigned int /* Type for 2nd arg to getgroups() */ /* config-skip */ #endif +/* DB_Prefix_t: + * This symbol contains the type of the prefix structure element + * in the header file. In older versions of DB, it was + * int, while in newer ones it is u_int32_t. + */ +/* DB_Hash_t: + * This symbol contains the type of the prefix structure element + * in the header file. In older versions of DB, it was + * int, while in newer ones it is size_t. + */ +#undef DB_Hash_t /**/ +#undef DB_Prefix_t /**/ + /* I_NET_ERRNO: * This symbol, if defined, indicates that exists and * should be included. */ #undef I_NET_ERRNO /**/ /* config-skip */ +/* HAS_SELECT: + * This symbol, if defined, indicates that the select routine is + * available to select active file descriptors. If the timeout field + * is used, may need to be included. + */ +#define HAS_SELECT /**/ /* config-skip */ + #else /* VMS_DO_SOCKETS */ #undef HAS_SOCKET /**/ /* config-skip */ @@ -1501,6 +1584,7 @@ #undef HAS_GETHOSTENT /**/ /* config-skip */ #undef I_NETINET_IN /**/ /* config-skip */ #undef I_NET_ERRNO /**/ /* config-skip */ +#undef HAS_SELECT /**/ /* config-skip */ #endif /* !VMS_DO_SOCKETS */ diff --git a/vms/descrip.mms b/vms/descrip.mms index 00985a6..0925749 100644 --- a/vms/descrip.mms +++ b/vms/descrip.mms @@ -1,5 +1,5 @@ # Descrip.MMS for perl5 on VMS -# Last revised 5-Jun-1995 by Charles Bailey bailey@genetics.upenn.edu +# Last revised 4-Dec-1995 by Charles Bailey bailey@genetics.upenn.edu # #: This file uses MMS syntax, and can be processed using DEC's MMS product, #: or the free MMK clone (available by ftp at ftp.spc.edu). If you want to @@ -81,10 +81,8 @@ DBGSPECFLAGS = XTRADEF = ,GNUC_ATTRIBUTE_CHECK XTRAOBJS = LIBS1 = GNU_CC:[000000]GCCLIB.OLB/Library -LIBS2 = Sys$Share:VAXCRTL.Exe/Shareable +LIBS2 = VAXCRTL/Shareable .else -.first - @ If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS Sys$Library XTRAOBJS = LIBS1 = $(XTRAOBJS) DBGSPECFLAGS = /Show=(Source,Include,Expansion) @@ -97,12 +95,14 @@ DBGSPECFLAGS = /Show=(Source,Include,Expansion) .first @ Set Process/Privilege=(NoSYSNAM) LIBS2 = -XTRACCFLAGS = /Include=[]/Prefix=All/Obj=$(MMS$TARGET_NAME)$(O) +XTRACCFLAGS = /Include=[]/Standard=Relaxed_ANSI/Prefix=All/Obj=$(MMS$TARGET_NAME)$(O) XTRADEF = .else # VAXC +.first + @ If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS Sys$Library XTRACCFLAGS = /Include=[]/Object=$(O) XTRADEF = -LIBS2 = Sys$Share:VAXCRTL.Exe/Shareable +LIBS2 = VAXCRTL/Shareable .endif .endif @@ -111,7 +111,7 @@ LIBS2 = Sys$Share:VAXCRTL.Exe/Shareable #: __DEBUG__: builds images with full VMS debugger support .ifdef __DEBUG__ DBGCCFLAGS = /List/Debug/NoOpt$(DBGSPECFLAGS) -DBGLINKFLAGS = /Debug/Map/Full/Cross +DBGLINKFLAGS = /Trace/Debug/Map/Full/Cross DBG = DBG .else DBGCCFLAGS = /NoList @@ -149,14 +149,14 @@ SOCKPM = CFLAGS = /Define=(DEBUGGING$(SOCKDEF)$(XTRADEF))$(XTRACCFLAGS)$(DBGCCFLAGS) LINKFLAGS = $(DBGLINKFLAGS) -MAKE = MMK +MAKE = $(MMS) MAKEFILE = [.VMS]Descrip.MMS # this file NOOP = continue # Macros to invoke a copy of miniperl during the build. Targets which # are built using these macros should depend on $(MINIPERL_EXE) MINIPERL_EXE = Sys$Disk:[]miniperl$(E) -MINIPERL = MCR $(MINIPERL_EXE) "-Ilib" +MINIPERL = MCR $(MINIPERL_EXE) "-I[.lib]" XSUBPP = $(MINIPERL) [.lib.extutils]xsubpp # Macro to invoke a preexisting copy of Perl. This is used to regenerate # some header files when rebuilding Perl, but premade versions are provided @@ -237,9 +237,9 @@ CRTLOPTS =,$(CRTL)/Options all : base extras archcorefiles preplibrary @ $(NOOP) -base : miniperl$(E) perl$(E) [.lib.$(ARCH)]Config.pm +base : miniperl$(E) perl$(E) @ $(NOOP) -extras : [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm [.lib.extutils]MM_VMS.pm +extras : [.lib]Config.pm [.lib.$(ARCH)]Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm [.lib.extutils]MM_VMS.pm @ $(NOOP) archcorefiles : $(ac1) $(ac2) $(ac3) $(ac4) $(ac5) $(ac6) $(ac7) $(ac8) $(ac9) $(acs) $(ARCHAUTO)time.stamp @ $(NOOP) @@ -259,11 +259,11 @@ $(DBG)libperl$(OLB) : $(obj) perlmain.c : miniperlmain.c $(MINIPERL_EXE) [.vms]writemain.pl $(MINIPERL) [.VMS]Writemain.pl "$(EXT)" -perl$(E) : perlmain$(O), perlshr$(E), perlshr_attr.opt $(MINIPERL_EXE) +perl$(E) : perlmain$(O), perlshr$(E), $(MINIPERL_EXE) @ @[.vms]genopt "PerlShr.Opt/Write" "|" "''F$Environment("Default")'$(DBG)PerlShr$(E)/Share" Link $(LINKFLAGS)/Exe=$(DBG)$(MMS$TARGET) perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts - Link $(LINKFLAGS)/Share=$(DBG)$(MMS$TARGET) $(extobj) []$(DBG)perlshr_bld.opt/Option, perlshr_attr.opt/Option + Link /NoTrace$(LINKFLAGS)/Share=$(DBG)$(MMS$TARGET) $(extobj) []$(DBG)perlshr_bld.opt/Option, perlshr_attr.opt/Option # The following files are built in one go by gen_shrfls.pl: # perlshr_attr.opt, $(DBG)perlshr_bld.opt - VAX and AXP # perlshr_gbl*.mar, perlshr_gbl*$(O) - VAX only @@ -288,7 +288,7 @@ $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $( Copy $(MMS$SOURCE) $(MMS$TARGET) [.lib]config.pm : [.vms]config.vms [.vms]genconfig.pl $(MINIPERL_EXE) - $(MINIPERL) [.VMS]GenConfig.Pl cc=$(CC)$(CFLAGS) ldflags=$(LINKFLAGS) + $(MINIPERL) [.VMS]GenConfig.Pl cc=$(CC)$(CFLAGS) ldflags=$(LINKFLAGS) obj_ext=$(O) exe_ext=$(E) lib_ext=$(OLB) $(MINIPERL) ConfigPM. [.ext.dynaloader]dl_vms.c : [.ext.dynaloader]dl_vms.xs $(MINIPERL_EXE) @@ -301,7 +301,7 @@ $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $( Copy/Log/NoConfirm [.ext.dynaloader]dynaloader.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm : [.vms.ext]Filespec.pm - @ Create/Directory [.lib.VMS] + @ If F$Search("[.lib]VMS.Dir").eqs."" Then Create/Directory [.lib.VMS] Copy/Log/NoConfirm $(MMS$SOURCE) $(MMS$TARGET) [.lib.ExtUtils]MM_VMS.pm : [.vms.ext]MM_VMS.pm @@ -310,7 +310,7 @@ $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $( preplibrary : $(MINIPERL_EXE) [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm [.lib.ExtUtils]MM_VMS.pm $(SOCKPM) @ Write Sys$Output "Autosplitting Perl library . . ." @ Create/Directory [.lib.auto] - @ $(MINIPERL) "-Ilib" -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]*.pm [.lib.*]*.pm + @ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]*.pm [.lib.*]*.pm .ifdef SOCKET $(SOCKOBJ) : $(SOCKC) $(SOCKH) @@ -333,15 +333,18 @@ $(SOCKH) : [.vms]$(SOCKH) Copy/Log/NoConfirm $(MMS$SOURCE) $(MMS$TARGET) .endif -opcode.h : opcode.pl - @ Write Sys$Output "Don't worry if this fails." - - $(INSTPERL) opcode.pl -keywords.h : keywords.pl - @ Write Sys$Output "Don't worry if this fails." - - $(INSTPERL) keywords.pl -embed.h : global.sym interp.sym - @ Write Sys$Output "Don't worry if this fails." - - $(INSTPERL) [.vms]embed_h.pl +# The following three header files are generated automatically +# keywords.h : keywords.pl +# opcode.h : opcode.pl +# embed.h : embed.pl global.sym interp.sym +# The correct versions should be already supplied with the perl kit, +# in case you don't have perl available. +# To force them to run, type +# MMS regen_headers +regen_headers : + $(INSTPERL) keywords.pl + $(INSTPERL) opcode.pl + $(INSTPERL) embed.pl # VMS uses modified perly.[ch] with tags for globaldefs if using DEC compiler perly.c : [.vms]perly_c.vms @@ -353,7 +356,7 @@ perly.h : [.vms]perly_h.vms # commented out if you don't have byacc. # Altered for VMS by Charles Bailey bailey@genetics.upenn.edu # perly.c: -# @ Write Sys$Output 'Expect' 80 shift/reduce and 62 reduce/reduce conflicts +# @ Write Sys$Output "Expect 80 shift/reduce and 62 reduce/reduce conflicts" # \$(BYACC) -d perly.y # Has to be done by hand or by POSIX shell under VMS # sh \$(shellflags) ./perly.fixer y.tab.c perly.c @@ -363,108 +366,108 @@ perly.h : [.vms]perly_h.vms perly$(O) : perly.c, perly.h, $(h) $(CC) $(CFLAGS) $(MMS$SOURCE) -test : perl$(E) +test : all - @[.VMS]Test.Com # CORE subset for MakeMaker, so we can build Perl without sources # Should move to VMS installperl when we get one $(ARCHCORE)EXTERN.h : EXTERN.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)INTERN.h : INTERN.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)XSUB.h : XSUB.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)av.h : av.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)config.h : config.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)cop.h : cop.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)cv.h : cv.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)embed.h : embed.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)form.h : form.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)gv.h : gv.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)handy.h : handy.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)hv.h : hv.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)keywords.h : keywords.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)mg.h : mg.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)op.h : op.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)opcode.h : opcode.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)patchlevel.h : patchlevel.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)perl.h : perl.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)perly.h : perly.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)pp.h : pp.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)proto.h : proto.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)regcomp.h : regcomp.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)regexp.h : regexp.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)scope.h : scope.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)sv.h : sv.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)util.h : util.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)vmsish.h : vmsish.h - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) .ifdef SOCKET $(ARCHCORE)$(SOCKH) : $(SOCKH) - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) .endif $(ARCHCORE)$(DBG)libperl$(OLB) : $(DBG)libperl$(OLB) $(DBG)perlshr_xtras.ts - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(MMS$SOURCE) $(MMS$TARGET) $(ARCHCORE)perlshr_attr.opt : $(DBG)perlshr_xtras.ts - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log perlshr_attr.opt $(MMS$TARGET) $(ARCHCORE)$(DBG)perlshr_bld.opt : $(DBG)perlshr_xtras.ts - @ Create/Directory $(ARCHCORE) + @ If F$Search("[.lib.$(ARCH)]CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) Copy/Log $(DBG)perlshr_bld.opt $(MMS$TARGET) $(ARCHAUTO)time.stamp : - @ Create/Directory $(ARCHAUTO) + @ If F$Search("[.lib.$(ARCH)]auto.dir").eqs."" Then Create/Directory $(ARCHAUTO) @ If F$Search("$(MMS$TARGET)").eqs."" Then Copy/NoConfirm _NLA0: $(MMS$TARGET) # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE @@ -1131,6 +1134,9 @@ tidy : cleanlis - If F$Search("[.Lib.Auto...]*.al;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Auto...]*.al - If F$Search("[.Lib.Auto...]autosplit.ix;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Auto...]autosplit.ix - If F$Search("[.Lib]DynaLoader.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib]DynaLoader.pm + - If F$Search("[.Lib]Socket.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib]Socket.pm + - If F$Search("[.Lib]Config.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib]Config.pm + - If F$Search("[.Lib.$(ARCH)]Config.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib.$(ARCH)]Config.pm - If F$Search("[.Lib.VMS]*.*;-1").nes."" Then Purge/NoConfirm/Log [.Lib.VMS]*.* - If F$Search("[.Lib.ExtUtils]MM_VMS.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib.ExtUtils]MM_VMS.pm - If F$Search("$(ARCHCORE)*.*").nes."" Then Purge/NoConfirm/Log $(ARCHCORE)*.* @@ -1163,6 +1169,8 @@ realclean : clean - If F$Search("[.Lib]DynaLoader.pm").nes."" Then Delete/NoConfirm/Log [.Lib]DynaLoader.pm;* - If F$Search("[.Lib.ExtUtils]MM_VMS.pm").nes."" Then Delete/NoConfirm/Log [.Lib.ExtUtils]MM_VMS.pm;* - If F$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);* + - If F$Search("[.Lib]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib]Config.pm;* + - If F$Search("[.Lib.$(ARCH)]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib.$(ARCH)]Config.pm;* cleansrc : clean - If F$Search("*.C;-1").nes."" Then Purge/NoConfirm/Log *.C @@ -1175,7 +1183,3 @@ cleansrc : clean - If F$Search("[.VMS]*.VMS;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.VMS - If F$Search("[.VMS...]*.pm;-1").nes."" Then Purge/NoConfirm/Log [.VMS...]*.pm - If F$Search("[.VMS...]*.xs;-1").nes."" Then Purge/NoConfirm/Log [.VMS...]*.xs - - If F$Search("[.Lib.Auto...]*.al").nes."" Then Delete/NoConfirm/Log [.Lib.Auto...]*.al;* - - If F$Search("[.Lib.Auto...]autosplit.ts").nes."" Then Delete/NoConfirm/Log [.Lib.Auto...]autosplit.ts;* - - If F$Search("[.Lib.$(ARCH)]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib.$(ARCH)]Config.pm;* - - If F$Search("[.Lib]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib]Config.pm;* diff --git a/vms/ext/Filespec.pm b/vms/ext/Filespec.pm index 35c8365..c690cca 100644 --- a/vms/ext/Filespec.pm +++ b/vms/ext/Filespec.pm @@ -42,8 +42,8 @@ behaves like a normal Perl extension (in fact, you're using Perl substitutes to emulate the necessary VMS system calls). Each of these routines accepts a file specification in either VMS or -Unix syntax, and returns the converted file specification, ir undef if -an error occurs. The conversions are, for the most part, simply +Unix syntax, and returns the converted file specification, or C +if an error occurs. The conversions are, for the most part, simply string manipulations; the routines do not check the details of syntax (e.g. that only legal characters are used). There is one exception: when running under VMS, conversions from VMS syntax use the $PARSE @@ -69,6 +69,10 @@ Converts a directory specification to a path - that is, a string you can prepend to a file name to form a valid file specification. If the input file specification uses VMS syntax, the returned path does, too; likewise for Unix syntax (Unix paths are guaranteed to end with '/'). +Note that this routine will insist that the input be a legal directory +file specification; the file type and version, if specified, must be +F<.DIR;1>. For compatibility with Unix usage, the type and version +may also be omitted. =head2 fileify @@ -76,7 +80,9 @@ Converts a directory specification to the file specification of the directory file - that is, a string you can pass to functions like C or C to manipulate the directory file. If the input directory specification uses VMS syntax, the returned file -specification does, too; likewise for Unix syntax. +specification does, too; likewise for Unix syntax. As with +C, the input file specification must have a type and +version of F<.DIR;1>, or the type and version must be omitted. =head2 vmspath @@ -98,21 +104,22 @@ C becomes part of the Perl core. =head1 REVISION -This document was last revised 08-Mar-1995, for Perl 5.001. +This document was last revised 08-Dec-1995, for Perl 5.002. =cut package VMS::Filespec; -# If you want to use this package on a non-VMS system, uncomment -# the following line, and add AutoLoader to @ISA. -# require AutoLoader; +# If you want to use this package on a non-VMS system, +# uncomment the following line. +# use AutoLoader; require Exporter; @ISA = qw( Exporter ); -@EXPORT = qw( &rmsexpand &vmsify &unixify &pathify - &fileify &vmspath &unixpath &candelete); +@EXPORT = qw( &vmsify &unixify &pathify &fileify + &vmspath &unixpath &candelete); +@EXPORT_OK = qw( &rmsexpand ); 1; diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl index d3a8ab9..286695f 100644 --- a/vms/gen_shrfls.pl +++ b/vms/gen_shrfls.pl @@ -34,7 +34,7 @@ # (i.e. /Define=DEBUGGING,EMBED,MULTIPLICITY)? # # Author: Charles Bailey bailey@genetics.upenn.edu -# Revised: 28-May-1995 +# Revised: 4-Dec-1995 require 5.000; @@ -65,7 +65,7 @@ if ($docc) { $isvaxc = 0; $isgcc = `$cc_cmd _nla0:/Version` =~ /GNU/ or 0; # make debug output nice - $isvaxc = (!$isgcc && $isvax && `$cc_cmd /ansi_alias _nla0:` =~ /IVQUAL/) + $isvaxc = (!$isgcc && $isvax && `$cc_cmd /prefix=all _nla0:` =~ /IVQUAL/) or 0; # again, make debug output nice print "\$isgcc: $isgcc\n" if $debug; print "\$isvaxc: $isvaxc\n" if $debug; @@ -97,7 +97,7 @@ print "\$extnames: \\$extnames\\\n" if $debug; $rtlopt = shift @ARGV; print "\$rtlopt: \\$rtlopt\\\n" if $debug; -# This part gets tricky. VAXC creates creating global symbols for the +# This part gets tricky. VAXC creates global symbols for each of the # constants in an enum if that enum is ever used as the data type of a # global[dr]ef. We have to detect enums which are used in this way, so we # can set up the constants as universal symbols, since anything which diff --git a/vms/genconfig.pl b/vms/genconfig.pl index ca15aa7..9200814 100644 --- a/vms/genconfig.pl +++ b/vms/genconfig.pl @@ -6,12 +6,11 @@ # that went into your perl binary. In addition, values which change from run # to run may be supplied on the command line as key=val pairs. # -# Rev. 08-Mar-1995 Charles Bailey bailey@genetics.upenn.edu +# Rev. 13-Dec-1995 Charles Bailey bailey@genetics.upenn.edu # unshift(@INC,'lib'); # In case someone didn't define Perl_Root # before the build -require 'ctime.pl' || die "Couldn't execute ctime.pl: $!\n"; if (-f "config.vms") { $infile = "config.vms"; $outdir = "[-]"; } elsif (-f "[.vms]config.vms") { $infile = "[.vms]config.vms"; $outdir = "[]"; } @@ -28,7 +27,7 @@ $outdir = ''; open(IN,"$infile") || die "Can't open $infile: $!\n"; open(OUT,">${outdir}Config.sh") || die "Can't open ${outdir}Config.sh: $!\n"; -$time = &ctime(time()); +$time = localtime; print OUT < 1024) { + print OUT "arch='VMS_AXP'\n"; + print OUT "archname='VMS_AXP'\n"; + $archsufx = "AXP"; +} +else { + print OUT "arch='VMS_VAX'\n"; + print OUT "archname='VMS_VAX'\n"; + $archsufx = 'VAX'; +} +$osvers = `Write Sys\$Output F\$GetSyi("VERSION")`; +$osvers =~ s/^V(\S+)\s*\n?$/$1/; +print OUT "osvers='$osvers'\n"; foreach (@ARGV) { ($key,$val) = split('=',$_,2); + if ($key eq 'cc') { # Figure out which C compiler we're using + if (`$val/NoObject/NoList _nla0:/Version` =~ /GNU/) { + print OUT "vms_cc_type='gcc'\n"; + print OUT "d_attribut='define'\n"; + } + elsif ($archsufx eq 'VAX' && + `$val/NoObject/NoList /prefix=all _nla0:` =~ /IVQUAL/) { + print OUT "vms_cc_type='vaxc'\n"; + print OUT "d_attribut='undef'\n"; + } + else { + print OUT "vms_cc_type='decc'\n"; + print OUT "d_attribut='undef'\n"; + # DECC for VAX requires filename in /object qualifier, so we + # have to remove it here. Alas, this means we lose the user's + # object file suffix if it's not .obj. + $val =~ s#/obj(?:ect)?=[^/\s]+##i if $archsufx eq 'VAX';; + } + } print OUT "$key=\'$val\'\n"; - if ($val =~/VMS_DO_SOCKETS/) { $dosock = 1; } + if ($val =~/VMS_DO_SOCKETS/i) { + $dosock = 1; + # Are there any other logicals which TCP/IP stacks use for the host name? + $myname = $ENV{'ARPANET_HOST_NAME'} || $ENV{'INTERNET_HOST_NAME'} || + $ENV{'MULTINET_HOST_NAME'} || $ENV{'UCX$INET_HOST'} || + $ENV{'TCPWARE_DOMAINNAME'} || $ENV{'NEWS_ADDRESS'}; + if (!$myname) { + ($myname) = `hostname` =~ /^(\S+)/; + if ($myname =~ /IVVERB/) { + warn "Can't determine TCP/IP hostname; skipping \$Config{'myhostname'}"; + } + } + print OUT "myhostname='$myname'\n" if $myname; + } } +if (!$dosock) { print OUT "myhostname='$ENV{'SYS$NODE'}'\n"; } while () { # roll through the comment header in Config.VMS - last if /^#define _config_h_/; + last if /config-start/; } while () { @@ -61,13 +126,15 @@ while () { next if /config-skip/; $state = ($blocked || $un) ? 'undef' : 'define'; $token =~ tr/A-Z/a-z/; + $token =~ s/_exp$/exp/; # Config.pm has 'privlibexp' etc. where config.h + # has 'privlib_exp' etc. $val =~ s%/\*.*\*/\s*%%g; $val =~ s/\s*$//; # strip off trailing comment $val =~ s/^"//; $val =~ s/"$//; # remove end quotes $val =~ s/","/ /g; # make signal list look nice if ($val) { print OUT "$token=\'$val\'\n"; } else { $token = "d_$token" unless $token =~ /^i_/; - print OUT "$token=\'$state\'\n"; + print OUT "$token='$state'\n"; } } close IN; @@ -82,29 +149,34 @@ while () { # Add in some of the architecture-dependent stuff which has to be consistent print OUT "d_vms_do_sockets=",$dosock ? "'define'\n" : "'undef'\n"; print OUT "d_has_sockets=",$dosock ? "'define'\n" : "'undef'\n"; -$osvers = `Write Sys\$Output F\$GetSyi("VERSION")`; -chomp $osvers; -$osvers =~ s/^V//; -print OUT "osvers='$osvers'\n"; -$hw_model = `Write Sys\$Output F\$GetSyi("HW_MODEL")`; -chomp $hw_model; -if ($hw_model > 1024) { - print OUT "arch='VMS_AXP'\n"; - print OUT "archname='VMS_AXP'\n"; - $archsufx = "AXP"; -} -else { - print OUT "arch='VMS_VAX'\n"; - print OUT "archname='VMS_VAX'\n"; - $archsufx = 'VAX'; -} $archlib = &VMS::Filespec::vmspath($privlib); $archlib =~ s#\]#.VMS_$archsufx\]#; $installarchlib = &VMS::Filespec::vmspath($installprivlib); $installarchlib =~ s#\]#.VMS_$archsufx\]#; print OUT "archlib='$archlib'\n"; +print OUT "archlibexp='$archlib'\n"; print OUT "installarchlib='$installarchlib'\n"; +if (open(OPT,"${outdir}crtl.opt")) { + while () { + next unless m#/(sha|lib)#i; + chomp; + push(@libs,$_); + } + close OPT; + print OUT "libs='",join(' ',@libs),"'\n"; +} +else { warn "Can't read ${outdir}crtl.opt - skipping \$Config{'libs'}"; } + +# simple pager support for perldoc +if (`most nl:` =~ /IVVERB/) { + $pager = 'more'; + if (`more nl:` =~ /IVVERB/) { $pager = 'type/page'; } +} +else { $pager = 'most'; } +print OUT "pager='$pager'\n"; + +close OUT; __END__ # This list is incomplete in comparison to what ends up in config.sh, but @@ -114,37 +186,29 @@ __END__ # The definitions in this block are constant across most systems, and # should only rarely need to be changed. -osname=VMS # DO NOT CHANGE THIS! Tests elsewhere depend on this to identify - # VMS. Use the 'arch' item below to specify hardware version. -CONFIG=true -PATCHLEVEL=001 -ld=Link -lddlflags=/Share +PATCHLEVEL=002 ccdlflags= cccdlflags= -libc= -ranlib= -eunicefix=: usedl=true -dldir=/ext/dl dlobj=dl_vms.obj dlsrc=dl_vms.c +d_dlsymun=undef so=exe dlext=exe libpth=/sys$share /sys$library -hintfile= -intsize=4 -alignbytes=8 -shrplib=define +d_stdstdio=undef +usevfork=false +castflags=0 +d_castneg=define # should be same as d_castnegfloat from config.vms signal_t=void timetype=long -usemymalloc=n builddir=perl_root:[000000] +prefix=perl_root installprivlib=perl_root:[lib] privlib=perl_root:[lib] installbin=perl_root:[000000] - -# The definitions in this block are site-specific, and will probably need to -# be changed on most systems. -myhostname=nowhere.loopback.edu -libs= # This should list RTLs other than the C RTL and IMAGELIB (e.g. socket RTL) +installman1dir=perl_root:[man.man1] +installman3dir=perl_root:[man.man3] +man1ext=.rno +man3ext=.rno +binexp=perl_root:[000000] # should be same as installbin diff --git a/vms/perlvms.pod b/vms/perlvms.pod index 722c638..87fcb5f 100644 --- a/vms/perlvms.pod +++ b/vms/perlvms.pod @@ -1,4 +1,8 @@ -=head1 Notes on Perl 5 for VMS +=head1 NAME + +perlvms - VMS-specific documentation for Perl + +=head1 DESCRIPTION Gathered below are notes describing details of Perl 5's behavior on VMS. They are a supplement to the regular Perl 5 @@ -15,9 +19,9 @@ sleep when writing Perl scripts on VMS. If you find we've missed something you think should appear here, please don't hesitate to drop a line to vmsperl@genetics.upenn.edu. -=head1 Organization of Perl +=head1 Organization of Perl Images -=head2 Perl Images +=head2 Core Images During the installation process, three Perl images are produced. F is an executable image which contains all of @@ -75,7 +79,7 @@ for the extension, and F, a Perl script which uses the C library modules supplied with Perl to generate a F file for the extension. -=head3 Installing static extensions +=head2 Installing static extensions Since static extensions are incorporated directly into F, you'll have to rebuild Perl to incorporate a @@ -94,32 +98,43 @@ of the extension, with all C<::> replaced by C<.> (e.g. the library module for extension Foo::Bar would be copied to a F<[.Foo.Bar]> subdirectory). -=head3 Installic dynamic extensions - -First, you'll need to compile the XS code into a shareable image, -either by hand or using the F supplied with the -extension. If you're building the shareable image by hand, please -note the following points: - - The shareable image must be linked to F, so it - has access to Perl's global variables and routines. In - order to specify the correct attributes for psects in - F, you should include the linker options file - F in the Link command. (This file is - generated when F is built, and is found in the - main Perl source directory. - - The entry point for the CI routine (where - I is the name of the extension, with all C<::> - replaced by C<__>) must be a universal symbol. No other - universal symbols are required to use the shareable image - with Perl, though you may want to include additional - universal symbols if you plan to share code or data among - different extensions. -The shareable image can be placed in any of several locations: - - the F<[.Auto.>IF<]> subdirectory of one of - the directories in C<@INC>, where I is the - name of the extension, with each C<::> translated to C<.> - (e.g. for extension Foo::Bar, you would use the - F<[.Auto.Foo.Bar]> subdirectory), or +=head2 Installing dynamic extensions + +In general, the distributed kit for a Perl extension includes +a file named Makefile.PL, which is a Perl program which is used +to create a F file which can be used to build and +install the files required by the extension. The kit should be +unpacked into a directory tree E under the main Perl source +directory, and the procedure for building the extension is simply + +=over 4 + + $ perl Makefile.PL ! Create Descrip.MMS + $ mmk ! Build necessary files + $ mmk test ! Run test code, if supplied + $ mmk install ! Install into public Perl tree + +=back + +VMS support for this process in the current release of Perl +is sufficient to handle most extensions. However, it does +not yet recognize extra libraries required to build shareable +images which are part of an extension, so these must be added +to the linker options file for the extension by hand. For +instance, if the F extension to Perl requires the +F shareable image in order to properly link +the Perl extension, then the line C must +be added to the linker options file F produced +during the build process for the Perl extension. + +By default, the shareable image for an extension is placed +in the F<[.Lib.Auto.I.I]> directory of the +installed Perl directory tree (where I is F or +F, and I is the name of the extension, with +each C<::> translated to C<.>). However, it can be manually +placed in any of several locations: + - the F<[.Lib.Auto.I]> subdirectory of one of + the directories in C<@INC>, or - one of the directories in C<@INC>, or - a directory which the extensions Perl library module passes to the DynaLoader when asking it to map @@ -130,10 +145,6 @@ to define a logical name I, where I is the portion of the extension's name after the last C<::>, which translates to the full file specification of the shareable image. -Once you've got the shareable image set up, you should copy the -extension's Perl library module to the appropriate library directory -(see the section above on installing static extensions). - =head1 Installation Directions for building and installing Perl 5 can be found in @@ -260,20 +271,20 @@ Perl functions were implemented in the VMS port of Perl close, closedir, cos, defined, delete, die, do, each, endpwent, eof, eval, exec*, exists, exit, exp, fileno, fork*, getc, getpwent*, getpwnam*, - getpwuid*, glob, goto, grep, hex, import, index, - int, join, keys, kill, last, lc, lcfirst, length, - local, localtime, log, m//, map, mkdir, my, next, - no, oct, open, opendir, ord, pack, pipe, pop, pos, - print, printf, push, q//, qq//, qw//, qx//, + getpwuid*, glob, gmtime*, goto, grep, hex, import, + index, int, join, keys, kill*, last, lc, lcfirst, + length, local, localtime, log, m//, map, mkdir, my, + next, no, oct, open, opendir, ord, pack, pipe, pop, + pos, print, printf, push, q//, qq//, qw//, qx//, quotemeta, rand, read, readdir, redo, ref, rename, require, reset, return, reverse, rewinddir, rindex, - rmdir, s///, scalar, seek, seekdir, select(internal)*, - setpwent, shift, sin, sleep, sort, splice, split, - sprintf, sqrt, srand, stat, study, substr, sysread, - system*, syswrite, tell, telldir, tie, time, times*, - tr///, uc, ucfirst, umask, undef, unlink*, unpack, - untie, unshift, use, utime*, values, vec, wait, - waitpid*, wantarray, warn, write, y/// + rmdir, s///, scalar, seek, seekdir, select(internal), + select (system call)*, setpwent, shift, sin, sleep, + sort, splice, split, sprintf, sqrt, srand, stat, + study, substr, sysread, system*, syswrite, tell, + telldir, tie, time, times*, tr///, uc, ucfirst, umask, + undef, unlink*, unpack, untie, unshift, use, utime*, + values, vec, wait, waitpid*, wantarray, warn, write, y/// The following functions were not implemented in the VMS port, and calling them produces a fatal error (usually) or @@ -282,11 +293,11 @@ undefined behavior (rarely, we hope): chroot, crypt, dbmclose, dbmopen, dump, fcntl, flock, getlogin, getpgrp, getppid, getpriority, getgrent, kill, getgrgid, getgrnam, setgrent, - endgrent, gmtime, ioctl, link, lstst, msgctl, - msgget, msgsend, msgrcv, readlink, - select(system call), semctl, semget, semop, - setpgrp, setpriority, shmctl, shmget, shmread, - shmwrite, socketpair, symlink, syscall, truncate + endgrent, ioctl, link, lstst, msgctl, msgget, + msgsend, msgrcv, readlink, select(system call), + semctl, semget, semop, setpgrp, setpriority, shmctl, + shmget, shmread, shmwrite, socketpair, symlink, + syscall, truncate The following functions may or may not be implemented, depending on what type of socket support you've built into @@ -380,6 +391,39 @@ contains the login directory in Unix syntax. The C<$gcos> item contains the owner field from the UAF record. The C<$quota> item is not used. +=item gmtime + +The C operator will function properly if you have a +working CRTL C routine, or if the logical name +SYS$TIMEZONE_DIFFERENTIAL is defined as the number of seconds +which must be added to UTC to yield local time. (This logical +name is defined automatically if you are running a version of +VMS with built-in UTC support.) If neither of these cases is +true, a warning message is printed, and C is returned. + +=item kill + +In most cases, C kill is implemented via the CRTL's C +function, so it will behave according to that function's +documentation. If you send a SIGKILL, however, the $DELPRC system +service is is called directly. This insures that the target +process is actually deleted, if at all possible. (The CRTL's C +function is presently implemented via $FORCEX, which is ignored by +supervisor-mode images like DCL.) + +Also, negative signal values don't do anything special under +VMS; they're just converted to the corresponding positive value. + +=item select (system call) + +If Perl was not built with socket support, the system call +version of C functions only for file descriptors attached +to sockets. It will not provide information about regular +files or pipes, since the CRTL C routine does not +provide this functionality. + =item stat EXPR Since VMS keeps track of files according to a different scheme @@ -393,7 +437,7 @@ though, so caveat scriptor. The C operator creates a subprocess, and passes its arguments to the subprocess for execution as a DCL command. -Since the subprocess is created directly via lib$spawn, any +Since the subprocess is created directly via C, any valid DCL command string may be specified. If LIST consists of the empty string, C spawns an interactive DCL subprocess, in the same fashion as typiing B at the DCL prompt. @@ -469,4 +513,9 @@ The FLAGS argument is ignored in all cases. =head1 Revision date This document was last updated on 16-Dec-1994, for Perl 5, -patchlevel 0. +patchlevel 2. + +=head1 AUTHOR + +Charles Bailey bailey@genetics.upenn.edu + diff --git a/vms/test.com b/vms/test.com index 43034a5..5c4a7a1 100644 --- a/vms/test.com +++ b/vms/test.com @@ -1,11 +1,23 @@ $! Test.Com - DCL driver for perl5 regression tests $! -$! Version 1.0 30-Sep-1994 +$! Version 1.1 4-Dec-1995 $! Charles Bailey bailey@genetics.upenn.edu $ $! A little basic setup $ On Error Then Goto wrapup -$ Set Default [.t] +$ olddef = F$Environment("Default") +$ If F$Search("t.dir").nes."" +$ Then +$ Set Default [.t] +$ Else +$ If F$TrnLNm("Perl_Root").nes."" +$ Then +$ Set Default Perl_Root:[t] +$ Else +$ Write Sys$Error "Can't find test directory" +$ Exit 44 +$ EndIf +$ EndIf $ $! Pick up a copy of perl to use for the tests $ Delete/Log/NoConfirm Perl.;* @@ -58,6 +70,8 @@ $ Delete/Log/NoConfirm Echo.Obj;* $ echo = "$" + F$Parse("Echo.Exe") $ $! And do it +$ testdir = "Directory/NoHead/NoTrail/Column=1" +$ Define/User Perlshr Sys$Disk:[-]PerlShr.Exe $ MCR Sys$Disk:[]Perl. $ Deck/Dollar=$$END-OF-TEST$$ # $RCSfile: TEST,v $$Revision: 4.1 $$Date: 92/08/07 18:27:00 $ @@ -86,7 +100,7 @@ $| = 1; chdir 't' if -f 't/TEST'; if ($ARGV[0] eq '') { - @files = split(/[ \n]/, `\$ dir/col=1/nohead/notrail [...]*.t;`); + @files = split(/[ \n]/, `\$ testdir [...]*.t;`); foreach (@files) { $fname = $_; $fname =~ s/.*\]([\w\$\-]+\.T);.*/$1/; @@ -179,5 +193,5 @@ print sprintf("u=%g s=%g cu=%g cs=%g files=%d tests=%d\n", $$END-OF-TEST$$ $ wrapup: $ If F$Search("Echo.Exe").nes."" Then Delete/Log/NoConfirm Echo.Exe;* -$ Set Default [-] +$ Set Default &olddef $ Exit diff --git a/vms/vms.c b/vms/vms.c index fef054a..9a07941 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -2,8 +2,8 @@ * * VMS-specific routines for perl5 * - * Last revised: 5-Jun-1995 by Charles Bailey bailey@genetics.upenn.edu - * Version: 5.1.5 + * Last revised: 22-Nov-1995 by Charles Bailey bailey@genetics.upenn.edu + * Version: 5.2.0 */ #include @@ -220,7 +220,8 @@ kill_file(char *name) } /* Grab any existing ACEs with this identifier in case we fail */ aclsts = fndsts = sys$change_acl(0,&type,&fildsc,findlst,0,0,&cxt); - if ( fndsts & 1 || fndsts == SS$_ACLEMPTY || fndsts == SS$_NOENTRY) { + if ( fndsts & 1 || fndsts == SS$_ACLEMPTY || fndsts == SS$_NOENTRY + || fndsts == SS$_NOMOREACE ) { /* Add the new ACE . . . */ if (!((aclsts = sys$change_acl(0,&type,&fildsc,addlst,0,0,0)) & 1)) goto yourroom; @@ -304,7 +305,7 @@ int my_utime(char *file, struct utimbuf *utimes) set_vaxc_errno(LIB$_INVARG); return -1; } - if (tovmsspec(file,vmsspec) == NULL) return -1; + if (do_tovmsspec(file,vmsspec,0) == NULL) return -1; if (utimes != NULL) { /* Convert Unix time (seconds since 01-JAN-1970 00:00:00.00) @@ -541,6 +542,7 @@ my_popen(char *cmd, char *mode) info->next=open_pipes; /* prepend to list */ open_pipes=info; + forkprocess = info->pid; return info->fp; } /*}}}*/ @@ -670,6 +672,13 @@ my_gconvert(double val, int ndig, int trail, char *buf) ** tovmspath() - convert a directory spec into a VMS-style path. ** tounixspec() - convert any file spec into a Unix-style file spec. ** tovmsspec() - convert any file spec into a VMS-style spec. +** +** Copyright 1995 by Charles Bailey +** Permission is given for non-commercial use of this code according +** to the terms of the GNU General Public License or the Perl +** Artistic License. Copies of each may be found in the Perl +** standard distribution. This software is supplied without any +** warranty whatsoever. */ static char *do_tounixspec(char *, char *, int); @@ -683,11 +692,15 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) char trndir[NAM$C_MAXRSS+1], vmsdir[NAM$C_MAXRSS+1]; if (dir == NULL) return NULL; - strcpy(trndir,dir); - while (!strpbrk(trndir,"/]:>") && my_trnlnm(trndir,trndir) != NULL) ; - dir = trndir; - dirlen = strlen(dir); + if (dir[dirlen-1] == '/') dir[--dirlen] = '\0'; + if (!strpbrk(dir+1,"/]>:")) { + strcpy(trndir,*dir == '/' ? dir + 1: dir); + while (!strpbrk(trndir,"/]>:>") && my_trnlnm(trndir,trndir) != NULL) ; + dir = trndir; + dirlen = strlen(dir); + } + if (!strpbrk(dir,"]:>")) { /* Unix-style path or plain dir name */ if (dir[0] == '.') { if (dir[1] == '\0' || (dir[1] == '/' && dir[2] == '\0')) @@ -752,7 +765,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) } retlen = dirlen + (addmfd ? 13 : 6); if (buf) retspec = buf; - else if (ts) New(7009,retspec,retlen+6,char); + else if (ts) New(7009,retspec,retlen+1,char); else retspec = __fileify_retbuf; if (addmfd) { dirlen = lastdir - dir; @@ -771,7 +784,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) } else { /* VMS-style directory spec */ char esa[NAM$C_MAXRSS+1], term; - unsigned long int cmplen, hasdev, hasdir, hastype, hasver; + unsigned long int sts, cmplen, hasdev, hasdir, hastype, hasver; struct FAB dirfab = cc$rms_fab; struct NAM savnam, dirnam = cc$rms_nam; @@ -782,23 +795,31 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) dirfab.fab$b_dns = 6; dirnam.nam$b_ess = NAM$C_MAXRSS; dirnam.nam$l_esa = esa; - if (!(sys$parse(&dirfab)&1)) { - set_errno(EVMSERR); - set_vaxc_errno(dirfab.fab$l_sts); - return NULL; - } - savnam = dirnam; - if (sys$search(&dirfab)&1) { /* Does the file really exist? */ - /* Yes; fake the fnb bits so we'll check type below */ - dirnam.nam$l_fnb |= NAM$M_EXP_TYPE | NAM$M_EXP_VER; - } - else { - if (dirfab.fab$l_sts != RMS$_FNF) { + if (!((sts = sys$parse(&dirfab))&1)) { + if (dirfab.fab$l_sts == RMS$_DIR) { + dirnam.nam$b_nop |= NAM$M_SYNCHK; + sts = sys$parse(&dirfab) & 1; + } + if (!sts) { set_errno(EVMSERR); set_vaxc_errno(dirfab.fab$l_sts); return NULL; } - dirnam = savnam; /* No; just work with potential name */ + } + else { + savnam = dirnam; + if (sys$search(&dirfab)&1) { /* Does the file really exist? */ + /* Yes; fake the fnb bits so we'll check type below */ + dirnam.nam$l_fnb |= NAM$M_EXP_TYPE | NAM$M_EXP_VER; + } + else { + if (dirfab.fab$l_sts != RMS$_FNF) { + set_errno(EVMSERR); + set_vaxc_errno(dirfab.fab$l_sts); + return NULL; + } + dirnam = savnam; /* No; just work with potential name */ + } } if (!(dirnam.nam$l_fnb & (NAM$M_EXP_DEV | NAM$M_EXP_DIR))) { cp1 = strchr(esa,']'); @@ -822,7 +843,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) if (dirnam.nam$l_fnb & NAM$M_EXP_NAME) { /* They provided at least the name; we added the type, if necessary, */ if (buf) retspec = buf; /* in sys$parse() */ - else if (ts) New(7011,retspec,dirnam.nam$b_esl,char); + else if (ts) New(7011,retspec,dirnam.nam$b_esl+1,char); else retspec = __fileify_retbuf; strcpy(retspec,esa); return retspec; @@ -836,7 +857,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) /* There's more than one directory in the path. Just roll back. */ *cp1 = term; if (buf) retspec = buf; - else if (ts) New(7011,retspec,retlen+6,char); + else if (ts) New(7011,retspec,retlen+7,char); else retspec = __fileify_retbuf; strcpy(retspec,esa); } @@ -851,7 +872,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) } retlen = dirnam.nam$b_esl - 9; /* esa - '][' - '].DIR;1' */ if (buf) retspec = buf; - else if (ts) New(7012,retspec,retlen+14,char); + else if (ts) New(7012,retspec,retlen+16,char); else retspec = __fileify_retbuf; cp1 = strstr(esa,"]["); dirlen = cp1 - esa; @@ -879,7 +900,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) } else { /* This is a top-level dir. Add the MFD to the path. */ if (buf) retspec = buf; - else if (ts) New(7012,retspec,retlen+14,char); + else if (ts) New(7012,retspec,retlen+16,char); else retspec = __fileify_retbuf; cp1 = esa; cp2 = retspec; @@ -938,7 +959,7 @@ static char *do_pathify_dirspec(char *dir,char *buf, int ts) } } if (buf) retpath = buf; - else if (ts) New(7013,retpath,retlen,char); + else if (ts) New(7013,retpath,retlen+1,char); else retpath = __pathify_retbuf; strncpy(retpath,dir,retlen-1); if (retpath[retlen-2] != '/') { /* If the path doesn't already end */ @@ -949,7 +970,7 @@ static char *do_pathify_dirspec(char *dir,char *buf, int ts) } else { /* VMS-style directory spec */ char esa[NAM$C_MAXRSS+1]; - unsigned long int cmplen; + unsigned long int sts, cmplen; struct FAB dirfab = cc$rms_fab; struct NAM savnam, dirnam = cc$rms_nam; @@ -959,7 +980,7 @@ static char *do_pathify_dirspec(char *dir,char *buf, int ts) dir[dirfab.fab$b_fns-1] == '>' || dir[dirfab.fab$b_fns-1] == ':') { /* It's already a VMS 'path' */ if (buf) retpath = buf; - else if (ts) New(7014,retpath,strlen(dir),char); + else if (ts) New(7014,retpath,strlen(dir)+1,char); else retpath = __pathify_retbuf; strcpy(retpath,dir); return retpath; @@ -967,23 +988,30 @@ static char *do_pathify_dirspec(char *dir,char *buf, int ts) dirfab.fab$l_dna = ".DIR;1"; dirfab.fab$b_dns = 6; dirfab.fab$l_nam = &dirnam; - dirnam.nam$b_ess = (unsigned char) sizeof esa; + dirnam.nam$b_ess = (unsigned char) sizeof esa - 1; dirnam.nam$l_esa = esa; - if (!(sys$parse(&dirfab)&1)) { - set_errno(EVMSERR); - set_vaxc_errno(dirfab.fab$l_sts); - return NULL; - } - savnam = dirnam; - if (!(sys$search(&dirfab)&1)) { /* Does the file really exist? */ - if (dirfab.fab$l_sts != RMS$_FNF) { + if (!((sts = sys$parse(&dirfab))&1)) { + if (dirfab.fab$l_sts == RMS$_DIR) { + dirnam.nam$b_nop |= NAM$M_SYNCHK; + sts = sys$parse(&dirfab) & 1; + } + if (!sts) { set_errno(EVMSERR); set_vaxc_errno(dirfab.fab$l_sts); return NULL; } - dirnam = savnam; /* No; just work with potential name */ } - + else { + savnam = dirnam; + if (!(sys$search(&dirfab)&1)) { /* Does the file really exist? */ + if (dirfab.fab$l_sts != RMS$_FNF) { + set_errno(EVMSERR); + set_vaxc_errno(dirfab.fab$l_sts); + return NULL; + } + dirnam = savnam; /* No; just work with potential name */ + } + } if (dirnam.nam$l_fnb & NAM$M_EXP_TYPE) { /* Was type specified? */ /* Yep; check version while we're at it, if it's there. */ cmplen = (dirnam.nam$l_fnb & NAM$M_EXP_VER) ? 6 : 4; @@ -1024,11 +1052,20 @@ static char *do_tounixspec(char *spec, char *buf, int ts) { static char __tounixspec_retbuf[NAM$C_MAXRSS+1]; char *dirend, *rslt, *cp1, *cp2, *cp3, tmp[NAM$C_MAXRSS+1]; - int devlen, dirlen; + int devlen, dirlen, retlen = NAM$C_MAXRSS+1, dashes = 0; if (spec == NULL) return NULL; + if (strlen(spec) > NAM$C_MAXRSS) return NULL; if (buf) rslt = buf; - else if (ts) New(7015,rslt,NAM$C_MAXRSS+1,char); + else if (ts) { + retlen = strlen(spec); + cp1 = strchr(spec,'['); + if (!cp1) cp1 = strchr(spec,'<'); + if (cp1) { + for (cp1++; *cp1 == '-'; cp1++) dashes++; /* VMS '-' ==> Unix '../' */ + } + New(7015,rslt,retlen+1+2*dashes,char); + } else rslt = __tounixspec_retbuf; if (strchr(spec,'/') != NULL) { strcpy(rslt,spec); @@ -1072,15 +1109,17 @@ static char *do_tounixspec(char *spec, char *buf, int ts) while (*cp3 != ':' && *cp3) cp3++; *(cp3++) = '\0'; if (strchr(cp3,']') != NULL) break; - } while (((cp3 = getenv(tmp)) != NULL) && strcpy(tmp,cp3)); + } while (((cp3 = my_getenv(tmp)) != NULL) && strcpy(tmp,cp3)); cp3 = tmp; while (*cp3) *(cp1++) = *(cp3++); *(cp1++) = '/'; - if ((devlen = strlen(tmp)) + (dirlen = strlen(cp2)) + 1 > NAM$C_MAXRSS) { - if (ts) Safefree(rslt); - set_errno(ERANGE); - set_errno(RMS$_SYN); - return NULL; + if (ts && + ((devlen = strlen(tmp)) + (dirlen = strlen(cp2)) + 1 > retlen)) { + int offset = cp1 - rslt; + + retlen = devlen + dirlen; + Renew(rslt,retlen+1+2*dashes,char); + cp1 = rslt + offset; } } else cp2++; @@ -1093,8 +1132,12 @@ static char *do_tounixspec(char *spec, char *buf, int ts) else if (*cp2 == ']' || *cp2 == '>') *(cp1++) = '/'; else if (*cp2 == '.') { *(cp1++) = '/'; - while (*(cp2+1) == ']' || *(cp2+1) == '>' || - *(cp2+1) == '[' || *(cp2+1) == '<') cp2++; + if (*(cp2+1) == ']' || *(cp2+1) == '>') { + while (*(cp2+1) == ']' || *(cp2+1) == '>' || + *(cp2+1) == '[' || *(cp2+1) == '<') cp2++; + if (!strncmp(cp2,"[000000",7) && (*(cp2+7) == ']' || + *(cp2+7) == '>' || *(cp2+7) == '.')) cp2 += 7; + } } else if (*cp2 == '-') { if (*(cp2-1) == '[' || *(cp2-1) == '<' || *(cp2-1) == '.') { @@ -1127,12 +1170,13 @@ char *tounixspec_ts(char *spec, char *buf) { return do_tounixspec(spec,buf,1); } /*{{{ char *tovmsspec[_ts](char *path, char *buf)*/ static char *do_tovmsspec(char *path, char *buf, int ts) { static char __tovmsspec_retbuf[NAM$C_MAXRSS+1]; - register char *rslt, *dirend, *cp1, *cp2; - register unsigned long int infront = 0; + char *rslt, *dirend; + register char *cp1, *cp2; + unsigned long int infront = 0, hasdir = 1; if (path == NULL) return NULL; if (buf) rslt = buf; - else if (ts) New(7016,rslt,strlen(path)+3,char); + else if (ts) New(7016,rslt,strlen(path)+9,char); else rslt = __tovmsspec_retbuf; if (strpbrk(path,"]:>") || (dirend = strrchr(path,'/')) == NULL) { @@ -1151,11 +1195,37 @@ static char *do_tovmsspec(char *path, char *buf, int ts) { cp1 = rslt; cp2 = path; if (*cp2 == '/') { + char trndev[NAM$C_MAXRSS+1]; + int islnm, rooted; + STRLEN trnend; + while (*(++cp2) != '/' && *cp2) *(cp1++) = *cp2; - *(cp1++) = ':'; - *(cp1++) = '['; - if (cp2 == dirend) while (infront++ < 6) *(cp1++) = '0'; - else cp2++; + *cp1 = '\0'; + islnm = (my_trnlnm(rslt,trndev) != Nullch); + trnend = islnm ? strlen(trndev) - 1 : 0; + islnm = trnend ? (trndev[trnend] == ']' || trndev[trnend] == '>') : 0; + rooted = islnm ? (trndev[trnend-1] == '.') : 0; + /* If the first element of the path is a logical name, determine + * whether it has to be translated so we can add more directories. */ + if (!islnm || rooted) { + *(cp1++) = ':'; + *(cp1++) = '['; + if (cp2 == dirend) while (infront++ < 6) *(cp1++) = '0'; + else cp2++; + } + else { + if (cp2 != dirend) { + if (!buf && ts) Renew(rslt,strlen(path)-strlen(rslt)+trnend+4,char); + strcpy(rslt,trndev); + cp1 = rslt + trnend; + *(cp1++) = '.'; + cp2++; + } + else { + *(cp1++) = ':'; + hasdir = 0; + } + } } else { *(cp1++) = '['; @@ -1200,7 +1270,7 @@ static char *do_tovmsspec(char *path, char *buf, int ts) { else *(cp1++) = '_'; /* fix up syntax - '.' in name not allowed */ } else { - if (*(cp1-1) == '-') *(cp1++) = '.'; + if (!infront && *(cp1-1) == '-') *(cp1++) = '.'; if (*cp2 == '/') *(cp1++) = '.'; else if (*cp2 == '.') *(cp1++) = '_'; else *(cp1++) = *cp2; @@ -1208,7 +1278,7 @@ static char *do_tovmsspec(char *path, char *buf, int ts) { } } if (*(cp1-1) == '.') cp1--; /* Unix spec ending in '/' ==> trailing '.' */ - *(cp1++) = ']'; + if (hasdir) *(cp1++) = ']'; if (*cp2) cp2++; /* check in case we ended with trailing '..' */ while (*cp2) *(cp1++) = *(cp2++); *cp1 = '\0'; @@ -1233,7 +1303,7 @@ static char *do_tovmspath(char *path, char *buf, int ts) { if (buf) return buf; else if (ts) { vmslen = strlen(vmsified); - New(7017,cp,vmslen,char); + New(7017,cp,vmslen+1,char); memcpy(cp,vmsified,vmslen); cp[vmslen] = '\0'; return cp; @@ -1262,7 +1332,7 @@ static char *do_tounixpath(char *path, char *buf, int ts) { if (buf) return buf; else if (ts) { unixlen = strlen(unixified); - New(7017,cp,unixlen,char); + New(7017,cp,unixlen+1,char); memcpy(cp,unixified,unixlen); cp[unixlen] = '\0'; return cp; @@ -1377,7 +1447,7 @@ getredirection(int *ac, char ***av) ap = argv[argc-1]; if (0 == strcmp("&", ap)) exit(background_process(--argc, argv)); - if ('&' == ap[strlen(ap)-1]) + if (*ap && '&' == ap[strlen(ap)-1]) { ap[strlen(ap)-1] = '\0'; exit(background_process(argc, argv)); @@ -2088,7 +2158,7 @@ static struct dsc$descriptor_s VMScmd = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,Nullch}; static void vms_execfree() { if (Cmd) { - safefree(Cmd); + Safefree(Cmd); Cmd = Nullch; } if (VMScmd.dsc$a_pointer) { @@ -2121,7 +2191,7 @@ setup_argstr(SV *really, SV **mark, SV **sp) cmdlen += rlen ? rlen + 1 : 0; } } - New(401,Cmd,cmdlen,char); + New(401,Cmd,cmdlen+1,char); if (tmps && *tmps) { strcpy(Cmd,tmps); @@ -2165,9 +2235,12 @@ setup_cmddsc(char *cmd, int check_img) } else isdcl = 1; if (isdcl) { /* It's a DCL command, just do it. */ - VMScmd.dsc$a_pointer = cmd; VMScmd.dsc$w_length = strlen(cmd); - if (cmd == Cmd) Cmd = Nullch; /* clear Cmd so vms_execfree isok */ + if (cmd == Cmd) { + VMScmd.dsc$a_pointer = Cmd; + Cmd = Nullch; /* Don't try to free twice in vms_execfree() */ + } + else VMScmd.dsc$a_pointer = savepvn(cmd,VMScmd.dsc$w_length); } else { /* assume first token is an image spec */ cmd = s; @@ -2188,7 +2261,7 @@ setup_cmddsc(char *cmd, int check_img) s = resspec; while (*s && !isspace(*s)) s++; *s = '\0'; - New(402,VMScmd.dsc$a_pointer,6 + s - resspec + (rest ? strlen(rest) : 0),char); + New(402,VMScmd.dsc$a_pointer,7 + s - resspec + (rest ? strlen(rest) : 0),char); strcpy(VMScmd.dsc$a_pointer,"$ MCR "); strcat(VMScmd.dsc$a_pointer,resspec); if (rest) strcat(VMScmd.dsc$a_pointer,rest); @@ -2562,6 +2635,57 @@ void my_endpwent() } /*}}}*/ + +/* my_gmtime + * If the CRTL has a real gmtime(), use it, else look for the logical + * name SYS$TIMEZONE_DIFFERENTIAL used by the native UTC routines on + * VMS >= 6.0. Can be manually defined under earlier versions of VMS + * to translate to the number of seconds which must be added to UTC + * to get to the local time of the system. + * Contributed by Chuck Lane + */ + +/*{{{struct tm *my_gmtime(const time_t *time)*/ +/* We #defined 'gmtime' as 'my_gmtime' in vmsish.h. #undef it here + * so we can call the CRTL's routine to see if it works. + */ +#undef gmtime +struct tm * +my_gmtime(const time_t *time) +{ + static int gmtime_emulation_type; + static time_t utc_offset_secs; + char *p; + time_t when; + + if (gmtime_emulation_type == 0) { + gmtime_emulation_type++; + when = 300000000; + if (gmtime(&when) == NULL) { /* CRTL gmtime() is just a stub */ + gmtime_emulation_type++; + if ((p = my_getenv("SYS$TIMEZONE_DIFFERENTIAL")) == NULL) + gmtime_emulation_type++; + else + utc_offset_secs = (time_t) atol(p); + } + } + + switch (gmtime_emulation_type) { + case 1: + return gmtime(time); + case 2: + when = *time - utc_offset_secs; + return localtime(&when); + default: + warn("gmtime not supported on this system"); + return NULL; + } +} /* end of my_gmtime() */ +/* Reset definition for later calls */ +#define gmtime(t) my_gmtime(t) +/*}}}*/ + + /* * flex_stat, flex_fstat * basic stat, but gets it right when asked to stat @@ -2584,7 +2708,7 @@ void my_endpwent() * available, do we try to pack the device name into an integer (flagged by * the sign bit (LOCKID_MASK) being set). * - * Note that encode_dev cann guarantee an 1-to-1 correspondence twixt device + * Note that encode_dev cannot guarantee an 1-to-1 correspondence twixt device * name and its encoded form, but it seems very unlikely that we will find * two files on different disks that share the same encoded device names, * and even more remote that they will share the same file id (if the test @@ -2699,7 +2823,7 @@ cando(I32 bit, I32 effective, struct stat *statbufp) _ckvmssts(retsts); return FALSE; /* Should never get to here */ } -} +} /* end of cando() */ /*}}}*/ /*{{{I32 cando_by_name(I32 bit, I32 effective, char *fname)*/ @@ -2752,7 +2876,7 @@ cando_by_name(I32 bit, I32 effective, char *fname) } retsts = sys$check_access(&objtyp,&namdsc,&usrdsc,armlst); - if (retsts == SS$_NOPRIV || retsts == RMS$_FNF || + if (retsts == SS$_NOPRIV || retsts == SS$_NOSUCHOBJ || retsts == RMS$_FNF || retsts == RMS$_DIR || retsts == RMS$_DEV) return FALSE; if (retsts == SS$_NORMAL) { if (!privused) return TRUE; @@ -2788,12 +2912,18 @@ flex_fstat(int fd, struct stat *statbuf) /*}}}*/ /*{{{ int flex_stat(char *fspec, struct stat *statbufp)*/ +/* We defined 'stat' as 'mystat' in vmsish.h so that declarations of + * 'struct stat' elsewhere in Perl would use our struct. We go back + * to the system version here, since we're actually calling their + * stat(). + */ +#undef stat int -flex_stat(char *fspec, struct stat *statbufp) +flex_stat(char *fspec, struct mystat *statbufp) { char fileified[NAM$C_MAXRSS+1]; int retval,myretval; - struct stat tmpbuf; + struct mystat tmpbuf; if (statbufp == &statcache) do_tovmsspec(fspec,namecache,0); @@ -2808,13 +2938,6 @@ flex_stat(char *fspec, struct stat *statbufp) return 0; } -/* We defined 'stat' as 'mystat' in vmsish.h so that declarations of - * 'struct stat' elsewhere in Perl would use our struct. We go back - * to the system version here, since we're actually calling their - * stat(). - */ -#undef stat - if (do_fileify_dirspec(fspec,fileified,0) == NULL) myretval = -1; else { myretval = stat(fileified,(stat_t *) &tmpbuf); @@ -2835,6 +2958,8 @@ flex_stat(char *fspec, struct stat *statbufp) return retval; } /* end of flex_stat() */ +/* Reset definition for later calls */ +#define stat mystat /*}}}*/ /*** The following glue provides 'hooks' to make some of the routines diff --git a/vms/vmsish.h b/vms/vmsish.h index 5e2bfbb..65f182c 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -2,7 +2,8 @@ * * VMS-specific C header file for perl5. * - * Last revised: 12-Dec-1994 by Charles Bailey bailey@genetics.upenn.edu + * Last revised: 01-Oct-1995 by Charles Bailey bailey@genetics.upenn.edu + * Version: 5.2.b1 */ #ifndef __vmsish_h_included @@ -22,6 +23,15 @@ # pragma message disable (GLOBALEXT,NOSHAREEXT,ADDRCONSTEXT) #endif +/* Suppress compiler warnings from DECC for VMS-specific extensions: + * GLOBALEXT, NOSHAREEXT: global[dr]ef declarations + * ADDRCONSTEXT,NEEDCONSTEXT: initialization of data with non-constant values + * (e.g. pointer fields of descriptors) + */ +#ifdef __DECC +# pragma message disable (GLOBALEXT,NOSHAREEXT,ADDRCONSTEXT,NEEDCONSTEXT) +#endif + /* DEC's C compilers and gcc use incompatible definitions of _to(upp|low)er() */ #ifdef _toupper # undef _toupper @@ -52,6 +62,13 @@ #include /* it's not , so don't use I_SYS_FILE */ #define unlink kill_file +/* The VMS C RTL has vfork() but not fork(). Both actually work in a way + * that's somewhere between Unix vfork() and VMS lib$spawn(), so it's + * probably not a good idea to use them much. That said, we'll try to + * use vfork() in either case. + */ +#define fork vfork + /* Macros to set errno using the VAX thread-safe calls, if present */ #if (defined(__DECC) || defined(__DECCXX)) && !defined(__ALPHA) # define set_errno(v) (cma$tis_errno_set_value(v)) @@ -62,30 +79,56 @@ #endif /* Handy way to vet calls to VMS system services and RTL routines. */ -#define _ckvmssts(call) { register unsigned long int __ckvms_sts; \ +#define _ckvmssts(call) do { register unsigned long int __ckvms_sts; \ if (!((__ckvms_sts=(call))&1)) { \ set_errno(EVMSERR); set_vaxc_errno(__ckvms_sts); \ - croak("Fatal VMS error at %s, line %d",__FILE__,__LINE__); } } + croak("Fatal VMS error (status=%d) at %s, line %d", \ + __ckvms_sts,__FILE__,__LINE__); } } while (0); #ifdef VMS_DO_SOCKETS #include "sockadapt.h" #endif -/* - * The following symbols are defined (or undefined) according to the RTL - * support VMS provides for the corresponding functions. These don't - * appear in config.h, so they're dealt with here. - */ #define HAS_KILL #define HAS_WAIT -/* The VMS C RTL has vfork() but not fork(). Both actually work in a way - * that's somewhere between Unix vfork() and VMS lib$spawn(), so it's - * probably not a good idea to use them much. That said, we'll try to - * use vfork() in either case. +/* VMS: + * This symbol, if defined, indicates that the program is running under + * VMS. It's a symbol automagically defined by all VMS C compilers I've seen. + * Just in case, however . . . */ +#ifndef VMS +#define VMS /**/ +#endif + +/* HAS_IOCTL: + * This symbol, if defined, indicates that the ioctl() routine is + * available to set I/O characteristics */ -#define fork vfork +#undef HAS_IOCTL /**/ + +/* HAS_UTIME: + * This symbol, if defined, indicates that the routine utime() is + * available to update the access and modification times of files. + */ +#define HAS_UTIME /**/ +/* HAS_GROUP + * This symbol, if defined, indicates that the getgrnam(), + * getgrgid(), and getgrent() routines are available to + * get group entries. + */ +#undef HAS_GROUP /**/ + +/* HAS_PASSWD + * This symbol, if defined, indicates that the getpwnam(), + * getpwuid(), and getpwent() routines are available to + * get password entries. + */ +#define HAS_PASSWD /**/ + +#define HAS_KILL +#define HAS_WAIT + /* * fwrite1() should be a routine with the same calling sequence as fwrite(), * but which outputs all of the bytes requested as a single stream (unlike @@ -117,6 +160,13 @@ struct tms { clock_t tms_cstime; /* system time, children - always 0 on VMS */ }; +/* Prior to VMS 7.0, the CRTL gmtime() routine was a stub which always + * returned NULL. Substitute our own routine, which uses the logical + * SYS$TIMEZONE_DIFFERENTIAL, whcih the native UTC support routines + * in VMS 6.0 or later use.* + */ +#define gmtime(t) my_gmtime(t) + /* VMS doesn't use a real sys_nerr, but we need this when scanning for error * messages in text strings . . . */ @@ -271,6 +321,7 @@ void seekdir _((DIR *, long)); void closedir _((DIR *)); void vmsreaddirversions _((DIR *, int)); void getredirection _((int *, char ***)); +struct tm *my_gmtime _((const time_t *)); I32 cando_by_name _((I32, I32, char *)); int flex_fstat _((int, struct stat *)); int flex_stat _((char *, struct stat *)); diff --git a/vms/writemain.pl b/vms/writemain.pl index 0208313..cd4c534 100644 --- a/vms/writemain.pl +++ b/vms/writemain.pl @@ -18,7 +18,6 @@ open (OUT,">${dir}perlmain.c") || die "$0: Can't open ${dir}perlmain.c: $!\n"; while () { - s/INTERN\.h/EXTERN\.h/; print OUT; last if /Do not delete this line--writemain depends on it/; } @@ -32,6 +31,13 @@ if (!$ok) { } +print OUT <<'EOH'; + +static void +xs_init() +{ +EOH + if (@ARGV) { # Allow for multiple names in one quoted group @exts = split(/\s+/, join(' ',@ARGV));