diff options
Diffstat (limited to 'gnu/usr.bin/perl/vms')
26 files changed, 14391 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/vms/Makefile b/gnu/usr.bin/perl/vms/Makefile new file mode 100644 index 00000000000..99c5236bf73 --- /dev/null +++ b/gnu/usr.bin/perl/vms/Makefile @@ -0,0 +1,1374 @@ +#> This file produced from Descrip.MMS by mms2make.pl +#> Lines beginning with "#>" were commented out during the +#> conversion process. For more information, see mms2make.pl +#> +# Makefile for perl5 on VMS +# Last revised 22-Mar-1996 by Charles Bailey bailey@genetics.upenn.edu +# +# +# tidy -- purge files generated by executing this file +# clean -- remove all intermediate (e.g. object files, C files generated +# during build) files generated by executing this file, +# but leave `installable' files (images, library) intact +# realclean -- remove all files generated by executing this file +# cleansrc -- `realclean' + purge *.c,*.h,Makefile +# crtl.opt -- compiler-specific linker options file (made automatically) +# + +#### Start of system configuration section. #### + + +# File type to use for object files +# File type to use for object libraries +# File type to use for executable images +# File type to use for object files +O = .obj +# File type to use for object libraries +OLB = .olb +# File type to use for executable images +E = .exe + +ARCH = VMS_VAX +OBJVAL = $@ + +.first: + @ $$@[.vms]fndvers.com "" "" "[.vms]Makefile" + +# Updated by fndvers.com -- do not edit by hand +PERL_VERSION = 5_003 # + + +ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)] +ARCHCORE = [.lib.$(ARCH).$(PERL_VERSION).CORE] +ARCHAUTO = [.lib.$(ARCH).$(PERL_VERSION).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) +XTRAOBJS = +LIBS1 = $(XTRAOBJS) +DBGSPECFLAGS = /Show=(Source,Include,Expansion) +# Some versions of DECCRTL on AXP have a bug in chdir() which causes the change +# to persist after the image exits, even when this was not requested, iff +# 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."" .and. f$$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS sys$$Library + @ If f$$TrnLnm("Sys").eqs."" .and. f$$TrnLnm("VAXC$Include").nes."" Then Define/NoLog SYS VAXC$Include + +XTRACCFLAGS = /Include=[]/Object=$(O) +XTRADEF = +LIBS2 = sys$$Share:VAXCRTL/Shareable + + +DBGCCFLAGS = /NoList +DBGLINKFLAGS = /NoMap +DBG = + +# N.B. the targets for $(SOCKC) and $(SOCKH) assume that the permanent +# copies live in [.vms], and the `clean' target will delete copies of +# these files in the current default directory. +SOCKDEF = +SOCKLIB = +SOCKC = +SOCKH = +SOCKCLIS = +SOCKHLIS = +SOCKOBJ = +SOCKPM = + +# C preprocessor manifest "DEBUGGING" ==> perl -D, not the VMS debugger +CFLAGS = /Define=(DEBUGGING$(SOCKDEF)$(XTRADEF))$(XTRACCFLAGS)$(DBGCCFLAGS) +LINKFLAGS = $(DBGLINKFLAGS) + +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) "-I[.lib]" +XSUBPP = $(MINIPERL) [.lib.extutils]xsubpp -noprototypes +# Macro to invoke a preexisting copy of Perl. This is used to regenerate +# some header files when rebuilding Perl, but premade versions are provided +# in the distribution, so it's OK if this doesn't work; it's here to make +# life easier for those who modify Perl and rebuild it. +INSTPERL = perl + +# Space-separated list of "static" extensions to build into perlshr (case counts). +MYEXT = DynaLoader +# object files for these extensions; the trailing comma is required if +# there are any object files specified +# These must be built separately, or you must add rules below to build them +myextobj = [.ext.dynaloader]dl_vms$(O), +EXT = $(MYEXT) +extobj = $(myextobj) + + +#### End of system configuration section. #### + + +h1 = EXTERN.h, INTERN.h, XSUB.h, av.h, config.h, cop.h, cv.h +h2 = embed.h, form.h, gv.h, handy.h, hv.h, keywords.h, mg.h, op.h +h3 = opcode.h, patchlevel.h, perl.h, perly.h, pp.h, proto.h, regcomp.h +h4 = regexp.h, scope.h, sv.h, vmsish.h, util.h +h = $(h1), $(h2), $(h3), $(h4) $(SOCKHLIS) + +c1 = av.c, scope.c, op.c, doop.c, doio.c, dump.c, hv.c, mg.c +c2 = perl.c, perly.c, pp.c, pp_hot.c, pp_ctl.c, pp_sys.c, regcomp.c, regexec.c +c3 = gv.c, sv.c, taint.c, toke.c, util.c, deb.c, run.c, globals.c, vms.c $(SOCKCLIS) + +c = $(c1), $(c2), $(c3), miniperlmain.c, perlmain.c + +obj1 = perl$(O), gv$(O), toke$(O), perly$(O), op$(O), regcomp$(O), dump$(O), util$(O), mg$(O) +obj2 = hv$(O), av$(O), run$(O), pp_hot$(O), sv$(O), pp$(O), scope$(O), pp_ctl$(O), pp_sys$(O) +obj3 = doop$(O), doio$(O), regexec$(O), taint$(O), deb$(O), globals$(O), vms$(O) $(SOCKOBJ) + +obj = $(obj1), $(obj2), $(obj3) + +ac1 = $(ARCHCORE)EXTERN.h $(ARCHCORE)INTERN.h $(ARCHCORE)XSUB.h $(ARCHCORE)av.h +ac2 = $(ARCHCORE)config.h $(ARCHCORE)cop.h $(ARCHCORE)cv.h $(ARCHCORE)embed.h +ac3 = $(ARCHCORE)form.h $(ARCHCORE)gv.h $(ARCHCORE)handy.h $(ARCHCORE)hv.h +ac4 = $(ARCHCORE)keywords.h $(ARCHCORE)mg.h $(ARCHCORE)op.h $(ARCHCORE)opcode.h +ac5 = $(ARCHCORE)patchlevel.h $(ARCHCORE)perl.h $(ARCHCORE)perly.h +ac6 = $(ARCHCORE)pp.h $(ARCHCORE)proto.h $(ARCHCORE)regcomp.h +ac7 = $(ARCHCORE)regexp.h $(ARCHCORE)scope.h $(ARCHCORE)sv.h $(ARCHCORE)util.h +ac8 = $(ARCHCORE)vmsish.h $(ARCHCORE)$(DBG)libperl$(OLB) $(ARCHCORE)perlshr_attr.opt +ac9 = $(ARCHCORE)$(DBG)perlshr_bld.opt +acs = + +CRTL = []crtl.opt +CRTLOPTS =,$(CRTL)/Options + +.suffixes: + +.suffixes: $(O) .c .xs + +.xs.c : + $(XSUBPP) $< >$@ + + +.c$(O) : + $(CC) $(CFLAGS) $< + +.xs$(O) : + $(XSUBPP) $< >$(MMS$SOURCE_NAME).c + $(CC) $(CFLAGS) $(MMS$SOURCE_NAME).c + + +all : base extras archcorefiles preplibrary perlpods + @ $(NOOP) +base : miniperl perl + @ $(NOOP) +extras : Fcntl FileHandle Safe libmods utils podxform + @ $(NOOP) +libmods : [.lib]Config.pm $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm + @ $(NOOP) +utils : [.lib.pod]perldoc [.lib.ExtUtils]Miniperl.pm [.utils]c2ph [.utils]h2ph [.utils]h2xs [.lib]perlbug + @ $(NOOP) +podxform : [.lib.pod]pod2text [.lib.pod]pod2html [.lib.pod]pod2latex [.lib.pod]pod2man + @ $(NOOP) + +pod1 = [.lib.pod]perl.pod [.lib.pod]perlbook.pod [.lib.pod]perlbot.pod [.lib.pod]perlcall.pod +pod2 = [.lib.pod]perldata.pod [.lib.pod]perldebug.pod [.lib.pod]perldiag.pod [.lib.pod]perldsc.pod +pod3 = [.lib.pod]perlembed.pod [.lib.pod]perlform.pod [.lib.pod]perlfunc.pod [.lib.pod]perlguts.pod +pod4 = [.lib.pod]perlipc.pod [.lib.pod]perllol.pod [.lib.pod]perlmod.pod [.lib.pod]perlobj.pod +pod5 = [.lib.pod]perlop.pod [.lib.pod]perlovl.pod [.lib.pod]perlpod.pod [.lib.pod]perlre.pod +pod6 = [.lib.pod]perlref.pod [.lib.pod]perlrun.pod [.lib.pod]perlsec.pod [.lib.pod]perlstyle.pod +pod7 = [.lib.pod]perlsub.pod [.lib.pod]perlsyn.pod [.lib.pod]perltie.pod [.lib.pod]perltoc.pod +pod8 = [.lib.pod]perltrap.pod [.lib.pod]perlvar.pod [.lib.pod]perlxs.pod [.lib.pod]perlxstut.pod + +perlpods : $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) [.lib.pod]perlvms.pod + @ $(NOOP) + +archcorefiles : $(ac1) $(ac2) $(ac3) $(ac4) $(ac5) $(ac6) $(ac7) $(ac8) $(ac9) $(acs) $(ARCHAUTO)time.stamp + @ $(NOOP) + +miniperl : $(DBG)miniperl$(E) + @ Continue +miniperl_objs = miniperlmain$(O), $(obj) +$(MINIPERL_EXE) : miniperlmain$(O), $(DBG)libperl$(OLB) $(CRTL) + Link $(LINKFLAGS)/NoDebug/Exe=$@ miniperlmain$(O), $(DBG)libperl$(OLB)/Library/Include=globals $(CRTLOPTS) +$(DBG)miniperl$(E) : $(miniperl_objs), $(DBG)libperl$(OLB) $(CRTL) + Link $(LINKFLAGS)/Exe=$@ miniperlmain$(O),$(DBG)libperl$(OLB)/Library/Include=globals $(CRTLOPTS) + +$(DBG)libperl$(OLB) : $(obj) + @ If f$$Search("$@").eqs."" Then Library/Object/Create $(MMS$TARGET) + Library/Object/Replace $@ $(obj1) + Library/Object/Replace $@ $(obj2) + Library/Object/Replace $@ $(obj3) + +perlmain.c : miniperlmain.c $(MINIPERL_EXE) [.vms]writemain.pl + $(MINIPERL) [.VMS]Writemain.pl "$(EXT)" + +perl : $(DBG)perl$(E) + @ Continue +$(DBG)perl$(E) : perlmain$(O), $(DBG)perlshr$(E), $(MINIPERL_EXE) + @ $$@[.vms]genopt "PerlShr.Opt/Write" "|" "''f$$Environment("Default")'$(DBG)PerlShr$(E)/Share" + Link $(LINKFLAGS)/Exe=$@ perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option + +$(DBG)perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts + Link /NoTrace$(LINKFLAGS)/Share=$@ $(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 +# The song and dance with gen_shrfls.opt accomodates DCL's 255 character +# line length limit. +# This is a backup target used only with older versions of the DECCRTL which +# can't deal with pipes properly. See ReadMe.VMS for details. +$(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $(MINIPERL_EXE) $(MAKEFILE) $(CRTL) + @ $(MINIPERL) -e "print join('|',@ARGV),'|';" "$(CC)$(CFLAGS)" >gen_shrfls.opt + @ $(MINIPERL) -e "print join('|',@ARGV);" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)" >>gen_shrfls.opt + $(MINIPERL) [.vms]gen_shrfls.pl -f gen_shrfls.opt + @ Delete/NoLog/NoConfirm gen_shrfls.opt; + @ If f$$Search("$(DBG)perlshr_xtras.ts").nes."" Then Delete/NoLog/NoConfirm $(DBG)perlshr_xtras.ts;* + @ Copy _NLA0: $(DBG)perlshr_xtras.ts + +$(ARCHDIR)config.pm : [.lib]config.pm + Create/Directory $(ARCHDIR) + Copy [.lib]config.pm $@ + +# Once again, we accomodate DCL's 255 character buffer +[.lib]config.pm : [.vms]config.vms [.vms]genconfig.pl $(MINIPERL_EXE) + @ $(MINIPERL) -e "print join('|',@ARGV),'|';" "cc=$(CC)$(CFLAGS)" >genconfig.opt + @ $(MINIPERL) -e "print join('|',@ARGV),'|';" "ldflags=$(LINKFLAGS)|obj_ext=$(O)|exe_ext=$(E)|lib_ext=$(OLB)" >>genconfig.opt + $(MINIPERL) [.VMS]GenConfig.Pl -f genconfig.opt + @ Delete/NoLog/NoConfirm genconfig.opt; + $(MINIPERL) ConfigPM. + +[.ext.dynaloader]dl_vms.c : [.ext.dynaloader]dl_vms.xs $(MINIPERL_EXE) + $(XSUBPP) [.ext.dynaloader]dl_vms.xs >$@ + +[.ext.dynaloader]dl_vms$(O) : [.ext.dynaloader]dl_vms.c + $(CC) $(CFLAGS) /Object=$@ [.ext.dynaloader]dl_vms.c + +[.lib]DynaLoader.pm : [.ext.dynaloader]dynaloader.pm + Copy/Log/NoConfirm [.ext.dynaloader]dynaloader.pm [.lib]DynaLoader.pm + @ If f$$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto] + @ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]DynaLoader.pm + +Safe : [.lib]Safe.pm [.lib.auto.Safe]Safe$(E) + @ $(NOOP) + +[.lib]Safe.pm : [.ext.Safe]Makefile + @ If f$$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto] + @ Set Default [.ext.Safe] + $(MMS) + @ Set Default [--] + +[.lib.auto.Safe]Safe$(E) : [.ext.Safe]Makefile + @ Set Default [.ext.Safe] + $(MMS) + @ Set Default [--] + +# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir> +# ${@} necessary to distract different versions of MM[SK]/make +[.ext.Safe]Makefile : [.ext.Safe]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E) + $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Safe]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" + +FileHandle : [.lib]FileHandle.pm [.lib.auto.FileHandle]FileHandle$(E) + @ $(NOOP) + +[.lib]FileHandle.pm : [.ext.FileHandle]Makefile + @ If f$$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto] + @ Set Default [.ext.FileHandle] + $(MMS) + @ Set Default [--] + +[.lib.auto.FileHandle]FileHandle$(E) : [.ext.FileHandle]Makefile + @ Set Default [.ext.FileHandle] + $(MMS) + @ Set Default [--] + +# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir> +# ${@} necessary to distract different versions of MM[SK]/make +[.ext.FileHandle]Makefile : [.ext.FileHandle]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E) + $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.FileHandle]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" + +Fcntl : [.lib]Fcntl.pm [.lib.auto.Fcntl]Fcntl$(E) + @ $(NOOP) + +[.lib]Fcntl.pm : [.ext.Fcntl]Makefile + @ If f$$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto] + @ Set Default [.ext.Fcntl] + $(MMS) + @ Set Default [--] + +[.lib.auto.Fcntl]Fcntl$(E) : [.ext.Fcntl]Makefile + @ Set Default [.ext.Fcntl] + $(MMS) + @ Set Default [--] + +# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir> +# ${@} necessary to distract different versions of MM[SK]/make +[.ext.Fcntl]Makefile : [.ext.Fcntl]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E) + $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Fcntl]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" + +[.lib.VMS]Filespec.pm : [.vms.ext]Filespec.pm + @ If f$$Search("[.lib]VMS.Dir").eqs."" Then Create/Directory [.lib.VMS] + Copy/Log/NoConfirm [.vms.ext]Filespec.pm $@ + +[.lib.pod]perldoc : [.utils]perldoc.PL $(ARCHDIR)Config.pm + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) [.utils]perldoc.PL + Copy/Log [.utils]perldoc $@ + +[.lib.ExtUtils]Miniperl.pm : Minimod.PL miniperlmain.c $(ARCHDIR)Config.pm + $(MINIPERL) Minimod.PL >$@ + +[.utils]c2ph : [.utils]c2ph.PL $(ARCHDIR)Config.pm + $(MINIPERL) [.utils]c2ph.PL + +[.utils]h2ph : [.utils]h2ph.PL $(ARCHDIR)Config.pm + $(MINIPERL) [.utils]h2ph.PL + +[.utils]h2xs : [.utils]h2xs.PL $(ARCHDIR)Config.pm + $(MINIPERL) [.utils]h2xs.PL + +[.lib]perlbug : [.utils]perlbug.PL $(ARCHDIR)Config.pm + $(MINIPERL) [.utils]perlbug.PL + Rename/Log [.utils]perlbug $@ + +[.utils]pl2pm : [.utils]pl2pm.PL $(ARCHDIR)Config.pm + $(MINIPERL) [.utils]pl2pm.PL + +[.lib.pod]pod2html : [.pod]pod2html.PL $(ARCHDIR)Config.pm + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) [.pod]pod2html.PL + Rename/Log [.pod]pod2html $@ + +[.lib.pod]pod2latex : [.pod]pod2latex.PL $(ARCHDIR)Config.pm + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) [.pod]pod2latex.PL + Rename/Log [.pod]pod2latex $@ + +[.lib.pod]pod2man : [.pod]pod2man.PL $(ARCHDIR)Config.pm + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) [.pod]pod2man.PL + Rename/Log [.pod]pod2man $@ + +[.lib.pod]pod2text : [.pod]pod2text.PL $(ARCHDIR)Config.pm + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) [.pod]pod2text.PL + Rename/Log [.pod]pod2text $@ + +preplibrary : $(MINIPERL_EXE) $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm $(SOCKPM) + @ Write sys$$Output "Autosplitting Perl library . . ." + @ Create/Directory [.lib.auto] + @ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]*.pm [.lib.*]*.pm + +[.lib.pod]perl.pod : [.pod]perl.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perl.pod $@ + +[.lib.pod]perlbook.pod : [.pod]perlbook.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlbook.pod $@ + +[.lib.pod]perlbot.pod : [.pod]perlbot.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlbot.pod $@ + +[.lib.pod]perlcall.pod : [.pod]perlcall.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlcall.pod $@ + +[.lib.pod]perldata.pod : [.pod]perldata.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perldata.pod $@ + +[.lib.pod]perldebug.pod : [.pod]perldebug.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perldebug.pod $@ + +[.lib.pod]perldiag.pod : [.pod]perldiag.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perldiag.pod $@ + +[.lib.pod]perldsc.pod : [.pod]perldsc.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perldsc.pod $@ + +[.lib.pod]perlembed.pod : [.pod]perlembed.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlembed.pod $@ + +[.lib.pod]perlform.pod : [.pod]perlform.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlform.pod $@ + +[.lib.pod]perlfunc.pod : [.pod]perlfunc.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlfunc.pod $@ + +[.lib.pod]perlguts.pod : [.pod]perlguts.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlguts.pod $@ + +[.lib.pod]perlipc.pod : [.pod]perlipc.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlipc.pod $@ + +[.lib.pod]perllol.pod : [.pod]perllol.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perllol.pod $@ + +[.lib.pod]perlmod.pod : [.pod]perlmod.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlmod.pod $@ + +[.lib.pod]perlobj.pod : [.pod]perlobj.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlobj.pod $@ + +[.lib.pod]perlop.pod : [.pod]perlop.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlop.pod $@ + +[.lib.pod]perlovl.pod : [.pod]perlovl.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlovl.pod $@ + +[.lib.pod]perlpod.pod : [.pod]perlpod.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlpod.pod $@ + +[.lib.pod]perlre.pod : [.pod]perlre.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlre.pod $@ + +[.lib.pod]perlref.pod : [.pod]perlref.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlref.pod $@ + +[.lib.pod]perlrun.pod : [.pod]perlrun.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlrun.pod $@ + +[.lib.pod]perlsec.pod : [.pod]perlsec.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlsec.pod $@ + +[.lib.pod]perlstyle.pod : [.pod]perlstyle.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlstyle.pod $@ + +[.lib.pod]perlsub.pod : [.pod]perlsub.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlsub.pod $@ + +[.lib.pod]perlsyn.pod : [.pod]perlsyn.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlsyn.pod $@ + +[.lib.pod]perltie.pod : [.pod]perltie.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perltie.pod $@ + +[.lib.pod]perltoc.pod : [.pod]perltoc.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perltoc.pod $@ + +[.lib.pod]perltrap.pod : [.pod]perltrap.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perltrap.pod $@ + +[.lib.pod]perlvar.pod : [.pod]perlvar.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlvar.pod $@ + +[.lib.pod]perlxs.pod : [.pod]perlxs.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlxs.pod $@ + +[.lib.pod]perlxstut.pod : [.pod]perlxstut.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.pod]perlxstut.pod $@ + +[.lib.pod]perlvms.pod : [.vms]perlvms.pod + @ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log [.vms]perlvms.pod $@ + +printconfig : + @ $$@[.vms]make_command $(MMS) $(MMSQUALIFIERS) $(MMSTARGETS) + @ $$@[.vms]myconfig "$(CC)" "$(CFLAGS)" "$(LINKFLAGS)" "$(LIBS1)" "$(LIBS2)" "$(SOCKLIB)" "$(EXT)" "$(DBG)" + + +# 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 + Copy/Log [.vms]perly_c.vms $@ +perly.h : [.vms]perly_h.vms + Copy/Log [.vms]perly_h.vms $@ + +# I now supply perly.c with the kits, so the following section is +# 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" +# \$(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 +# rename y.tab.h perly.h +# $(INSTPERL) [.vms]vms_yfix.pl perly.c perly.h [.vms]perly_c.vms [.vms]perly_h.vms + +perly$(O) : perly.c, perly.h, $(h) + $(CC) $(CFLAGS) perly.c + +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 + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log EXTERN.h $@ +$(ARCHCORE)INTERN.h : INTERN.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log INTERN.h $@ +$(ARCHCORE)XSUB.h : XSUB.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log XSUB.h $@ +$(ARCHCORE)av.h : av.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log av.h $@ +$(ARCHCORE)config.h : config.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log config.h $@ +$(ARCHCORE)cop.h : cop.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log cop.h $@ +$(ARCHCORE)cv.h : cv.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log cv.h $@ +$(ARCHCORE)embed.h : embed.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log embed.h $@ +$(ARCHCORE)form.h : form.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log form.h $@ +$(ARCHCORE)gv.h : gv.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log gv.h $@ +$(ARCHCORE)handy.h : handy.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log handy.h $@ +$(ARCHCORE)hv.h : hv.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log hv.h $@ +$(ARCHCORE)keywords.h : keywords.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log keywords.h $@ +$(ARCHCORE)mg.h : mg.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log mg.h $@ +$(ARCHCORE)op.h : op.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log op.h $@ +$(ARCHCORE)opcode.h : opcode.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log opcode.h $@ +$(ARCHCORE)patchlevel.h : patchlevel.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log patchlevel.h $@ +$(ARCHCORE)perl.h : perl.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log perl.h $@ +$(ARCHCORE)perly.h : perly.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log perly.h $@ +$(ARCHCORE)pp.h : pp.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log pp.h $@ +$(ARCHCORE)proto.h : proto.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log proto.h $@ +$(ARCHCORE)regcomp.h : regcomp.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log regcomp.h $@ +$(ARCHCORE)regexp.h : regexp.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log regexp.h $@ +$(ARCHCORE)scope.h : scope.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log scope.h $@ +$(ARCHCORE)sv.h : sv.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log sv.h $@ +$(ARCHCORE)util.h : util.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log util.h $@ +$(ARCHCORE)vmsish.h : vmsish.h + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log vmsish.h $@ +$(ARCHCORE)$(DBG)libperl$(OLB) : $(DBG)libperl$(OLB) $(DBG)perlshr_xtras.ts + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(DBG)libperl$(OLB) $@ +$(ARCHCORE)perlshr_attr.opt : $(DBG)perlshr_xtras.ts + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log perlshr_attr.opt $@ +$(ARCHCORE)$(DBG)perlshr_bld.opt : $(DBG)perlshr_xtras.ts + @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(DBG)perlshr_bld.opt $@ +$(ARCHAUTO)time.stamp : + @ If f$$Search("$(ARCHDIR)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 +av$(O) : EXTERN.h +av$(O) : av.c +av$(O) : av.h +av$(O) : config.h +av$(O) : cop.h +av$(O) : cv.h +av$(O) : embed.h +av$(O) : form.h +av$(O) : gv.h +av$(O) : handy.h +av$(O) : hv.h +av$(O) : mg.h +av$(O) : op.h +av$(O) : opcode.h +av$(O) : perl.h +av$(O) : perly.h +av$(O) : pp.h +av$(O) : proto.h +av$(O) : regexp.h +av$(O) : scope.h +av$(O) : sv.h +av$(O) : vmsish.h +av$(O) : util.h +scope$(O) : EXTERN.h +scope$(O) : av.h +scope$(O) : config.h +scope$(O) : cop.h +scope$(O) : cv.h +scope$(O) : embed.h +scope$(O) : form.h +scope$(O) : gv.h +scope$(O) : handy.h +scope$(O) : hv.h +scope$(O) : mg.h +scope$(O) : op.h +scope$(O) : opcode.h +scope$(O) : perl.h +scope$(O) : perly.h +scope$(O) : pp.h +scope$(O) : proto.h +scope$(O) : regexp.h +scope$(O) : scope.c +scope$(O) : scope.h +scope$(O) : sv.h +scope$(O) : vmsish.h +scope$(O) : util.h +op$(O) : EXTERN.h +op$(O) : av.h +op$(O) : config.h +op$(O) : cop.h +op$(O) : cv.h +op$(O) : embed.h +op$(O) : form.h +op$(O) : gv.h +op$(O) : handy.h +op$(O) : hv.h +op$(O) : mg.h +op$(O) : op.c +op$(O) : op.h +op$(O) : opcode.h +op$(O) : perl.h +op$(O) : perly.h +op$(O) : pp.h +op$(O) : proto.h +op$(O) : regexp.h +op$(O) : scope.h +op$(O) : sv.h +op$(O) : vmsish.h +op$(O) : util.h +doop$(O) : EXTERN.h +doop$(O) : av.h +doop$(O) : config.h +doop$(O) : cop.h +doop$(O) : cv.h +doop$(O) : doop.c +doop$(O) : embed.h +doop$(O) : form.h +doop$(O) : gv.h +doop$(O) : handy.h +doop$(O) : hv.h +doop$(O) : mg.h +doop$(O) : op.h +doop$(O) : opcode.h +doop$(O) : perl.h +doop$(O) : perly.h +doop$(O) : pp.h +doop$(O) : proto.h +doop$(O) : regexp.h +doop$(O) : scope.h +doop$(O) : sv.h +doop$(O) : vmsish.h +doop$(O) : util.h +doio$(O) : EXTERN.h +doio$(O) : av.h +doio$(O) : config.h +doio$(O) : cop.h +doio$(O) : cv.h +doio$(O) : doio.c +doio$(O) : embed.h +doio$(O) : form.h +doio$(O) : gv.h +doio$(O) : handy.h +doio$(O) : hv.h +doio$(O) : mg.h +doio$(O) : op.h +doio$(O) : opcode.h +doio$(O) : perl.h +doio$(O) : perly.h +doio$(O) : pp.h +doio$(O) : proto.h +doio$(O) : regexp.h +doio$(O) : scope.h +doio$(O) : sv.h +doio$(O) : vmsish.h +doio$(O) : util.h +dump$(O) : EXTERN.h +dump$(O) : av.h +dump$(O) : config.h +dump$(O) : cop.h +dump$(O) : cv.h +dump$(O) : dump.c +dump$(O) : embed.h +dump$(O) : form.h +dump$(O) : gv.h +dump$(O) : handy.h +dump$(O) : hv.h +dump$(O) : mg.h +dump$(O) : op.h +dump$(O) : opcode.h +dump$(O) : perl.h +dump$(O) : perly.h +dump$(O) : pp.h +dump$(O) : proto.h +dump$(O) : regexp.h +dump$(O) : scope.h +dump$(O) : sv.h +dump$(O) : vmsish.h +dump$(O) : util.h +hv$(O) : EXTERN.h +hv$(O) : av.h +hv$(O) : config.h +hv$(O) : cop.h +hv$(O) : cv.h +hv$(O) : embed.h +hv$(O) : form.h +hv$(O) : gv.h +hv$(O) : handy.h +hv$(O) : hv.c +hv$(O) : hv.h +hv$(O) : mg.h +hv$(O) : op.h +hv$(O) : opcode.h +hv$(O) : perl.h +hv$(O) : perly.h +hv$(O) : pp.h +hv$(O) : proto.h +hv$(O) : regexp.h +hv$(O) : scope.h +hv$(O) : sv.h +hv$(O) : vmsish.h +hv$(O) : util.h +mg$(O) : EXTERN.h +mg$(O) : av.h +mg$(O) : config.h +mg$(O) : cop.h +mg$(O) : cv.h +mg$(O) : embed.h +mg$(O) : form.h +mg$(O) : gv.h +mg$(O) : handy.h +mg$(O) : hv.h +mg$(O) : mg.c +mg$(O) : mg.h +mg$(O) : op.h +mg$(O) : opcode.h +mg$(O) : perl.h +mg$(O) : perly.h +mg$(O) : pp.h +mg$(O) : proto.h +mg$(O) : regexp.h +mg$(O) : scope.h +mg$(O) : sv.h +mg$(O) : vmsish.h +mg$(O) : util.h +perl$(O) : EXTERN.h +perl$(O) : av.h +perl$(O) : config.h +perl$(O) : cop.h +perl$(O) : cv.h +perl$(O) : embed.h +perl$(O) : form.h +perl$(O) : gv.h +perl$(O) : handy.h +perl$(O) : hv.h +perl$(O) : mg.h +perl$(O) : op.h +perl$(O) : opcode.h +perl$(O) : perl.c +perl$(O) : perl.h +perl$(O) : perly.h +perl$(O) : pp.h +perl$(O) : proto.h +perl$(O) : regexp.h +perl$(O) : scope.h +perl$(O) : sv.h +perl$(O) : vmsish.h +perl$(O) : util.h +perly$(O) : EXTERN.h +perly$(O) : av.h +perly$(O) : config.h +perly$(O) : cop.h +perly$(O) : cv.h +perly$(O) : embed.h +perly$(O) : form.h +perly$(O) : gv.h +perly$(O) : handy.h +perly$(O) : hv.h +perly$(O) : mg.h +perly$(O) : op.h +perly$(O) : opcode.h +perly$(O) : perl.h +perly$(O) : perly.h +perly$(O) : perly.c +perly$(O) : pp.h +perly$(O) : proto.h +perly$(O) : regexp.h +perly$(O) : scope.h +perly$(O) : sv.h +perly$(O) : vmsish.h +perly$(O) : util.h +pp$(O) : EXTERN.h +pp$(O) : av.h +pp$(O) : config.h +pp$(O) : cop.h +pp$(O) : cv.h +pp$(O) : embed.h +pp$(O) : form.h +pp$(O) : gv.h +pp$(O) : handy.h +pp$(O) : hv.h +pp$(O) : mg.h +pp$(O) : op.h +pp$(O) : opcode.h +pp$(O) : perl.h +pp$(O) : perly.h +pp$(O) : pp.c +pp$(O) : pp.h +pp$(O) : proto.h +pp$(O) : regexp.h +pp$(O) : scope.h +pp$(O) : sv.h +pp$(O) : vmsish.h +pp$(O) : util.h +pp_ctl$(O) : EXTERN.h +pp_ctl$(O) : av.h +pp_ctl$(O) : config.h +pp_ctl$(O) : cop.h +pp_ctl$(O) : cv.h +pp_ctl$(O) : embed.h +pp_ctl$(O) : form.h +pp_ctl$(O) : gv.h +pp_ctl$(O) : handy.h +pp_ctl$(O) : hv.h +pp_ctl$(O) : mg.h +pp_ctl$(O) : op.h +pp_ctl$(O) : opcode.h +pp_ctl$(O) : perl.h +pp_ctl$(O) : perly.h +pp_ctl$(O) : pp_ctl.c +pp_ctl$(O) : pp.h +pp_ctl$(O) : proto.h +pp_ctl$(O) : regexp.h +pp_ctl$(O) : scope.h +pp_ctl$(O) : sv.h +pp_ctl$(O) : vmsish.h +pp_ctl$(O) : util.h +pp_hot$(O) : EXTERN.h +pp_hot$(O) : av.h +pp_hot$(O) : config.h +pp_hot$(O) : cop.h +pp_hot$(O) : cv.h +pp_hot$(O) : embed.h +pp_hot$(O) : form.h +pp_hot$(O) : gv.h +pp_hot$(O) : handy.h +pp_hot$(O) : hv.h +pp_hot$(O) : mg.h +pp_hot$(O) : op.h +pp_hot$(O) : opcode.h +pp_hot$(O) : perl.h +pp_hot$(O) : perly.h +pp_hot$(O) : pp_hot.c +pp_hot$(O) : pp.h +pp_hot$(O) : proto.h +pp_hot$(O) : regexp.h +pp_hot$(O) : scope.h +pp_hot$(O) : sv.h +pp_hot$(O) : vmsish.h +pp_hot$(O) : util.h +pp_sys$(O) : EXTERN.h +pp_sys$(O) : av.h +pp_sys$(O) : config.h +pp_sys$(O) : cop.h +pp_sys$(O) : cv.h +pp_sys$(O) : embed.h +pp_sys$(O) : form.h +pp_sys$(O) : gv.h +pp_sys$(O) : handy.h +pp_sys$(O) : hv.h +pp_sys$(O) : mg.h +pp_sys$(O) : op.h +pp_sys$(O) : opcode.h +pp_sys$(O) : perl.h +pp_sys$(O) : perly.h +pp_sys$(O) : pp_sys.c +pp_sys$(O) : pp.h +pp_sys$(O) : proto.h +pp_sys$(O) : regexp.h +pp_sys$(O) : scope.h +pp_sys$(O) : sv.h +pp_sys$(O) : vmsish.h +pp_sys$(O) : util.h +regcomp$(O) : EXTERN.h +regcomp$(O) : INTERN.h +regcomp$(O) : av.h +regcomp$(O) : config.h +regcomp$(O) : cop.h +regcomp$(O) : cv.h +regcomp$(O) : embed.h +regcomp$(O) : form.h +regcomp$(O) : gv.h +regcomp$(O) : handy.h +regcomp$(O) : hv.h +regcomp$(O) : mg.h +regcomp$(O) : op.h +regcomp$(O) : opcode.h +regcomp$(O) : perl.h +regcomp$(O) : perly.h +regcomp$(O) : pp.h +regcomp$(O) : proto.h +regcomp$(O) : regcomp.c +regcomp$(O) : regcomp.h +regcomp$(O) : regexp.h +regcomp$(O) : scope.h +regcomp$(O) : sv.h +regcomp$(O) : vmsish.h +regcomp$(O) : util.h +regexec$(O) : EXTERN.h +regexec$(O) : av.h +regexec$(O) : config.h +regexec$(O) : cop.h +regexec$(O) : cv.h +regexec$(O) : embed.h +regexec$(O) : form.h +regexec$(O) : gv.h +regexec$(O) : handy.h +regexec$(O) : hv.h +regexec$(O) : mg.h +regexec$(O) : op.h +regexec$(O) : opcode.h +regexec$(O) : perl.h +regexec$(O) : perly.h +regexec$(O) : pp.h +regexec$(O) : proto.h +regexec$(O) : regcomp.h +regexec$(O) : regexec.c +regexec$(O) : regexp.h +regexec$(O) : scope.h +regexec$(O) : sv.h +regexec$(O) : vmsish.h +regexec$(O) : util.h +gv$(O) : EXTERN.h +gv$(O) : av.h +gv$(O) : config.h +gv$(O) : cop.h +gv$(O) : cv.h +gv$(O) : embed.h +gv$(O) : form.h +gv$(O) : gv.c +gv$(O) : gv.h +gv$(O) : handy.h +gv$(O) : hv.h +gv$(O) : mg.h +gv$(O) : op.h +gv$(O) : opcode.h +gv$(O) : perl.h +gv$(O) : perly.h +gv$(O) : pp.h +gv$(O) : proto.h +gv$(O) : regexp.h +gv$(O) : scope.h +gv$(O) : sv.h +gv$(O) : vmsish.h +gv$(O) : util.h +sv$(O) : EXTERN.h +sv$(O) : av.h +sv$(O) : config.h +sv$(O) : cop.h +sv$(O) : cv.h +sv$(O) : embed.h +sv$(O) : form.h +sv$(O) : gv.h +sv$(O) : handy.h +sv$(O) : hv.h +sv$(O) : mg.h +sv$(O) : op.h +sv$(O) : opcode.h +sv$(O) : perl.h +sv$(O) : perly.h +sv$(O) : pp.h +sv$(O) : proto.h +sv$(O) : regexp.h +sv$(O) : scope.h +sv$(O) : sv.c +sv$(O) : sv.h +sv$(O) : vmsish.h +sv$(O) : util.h +taint$(O) : EXTERN.h +taint$(O) : av.h +taint$(O) : config.h +taint$(O) : cop.h +taint$(O) : cv.h +taint$(O) : embed.h +taint$(O) : form.h +taint$(O) : gv.h +taint$(O) : handy.h +taint$(O) : hv.h +taint$(O) : mg.h +taint$(O) : op.h +taint$(O) : opcode.h +taint$(O) : perl.h +taint$(O) : perly.h +taint$(O) : pp.h +taint$(O) : proto.h +taint$(O) : regexp.h +taint$(O) : scope.h +taint$(O) : sv.h +taint$(O) : taint.c +taint$(O) : vmsish.h +taint$(O) : util.h +toke$(O) : EXTERN.h +toke$(O) : av.h +toke$(O) : config.h +toke$(O) : cop.h +toke$(O) : cv.h +toke$(O) : embed.h +toke$(O) : form.h +toke$(O) : gv.h +toke$(O) : handy.h +toke$(O) : hv.h +toke$(O) : keywords.h +toke$(O) : mg.h +toke$(O) : op.h +toke$(O) : opcode.h +toke$(O) : perl.h +toke$(O) : perly.h +toke$(O) : pp.h +toke$(O) : proto.h +toke$(O) : regexp.h +toke$(O) : scope.h +toke$(O) : sv.h +toke$(O) : toke.c +toke$(O) : vmsish.h +toke$(O) : util.h +util$(O) : EXTERN.h +util$(O) : av.h +util$(O) : config.h +util$(O) : cop.h +util$(O) : cv.h +util$(O) : embed.h +util$(O) : form.h +util$(O) : gv.h +util$(O) : handy.h +util$(O) : hv.h +util$(O) : mg.h +util$(O) : op.h +util$(O) : opcode.h +util$(O) : perl.h +util$(O) : perly.h +util$(O) : pp.h +util$(O) : proto.h +util$(O) : regexp.h +util$(O) : scope.h +util$(O) : sv.h +util$(O) : vmsish.h +util$(O) : util.c +util$(O) : util.h +deb$(O) : EXTERN.h +deb$(O) : av.h +deb$(O) : config.h +deb$(O) : cop.h +deb$(O) : cv.h +deb$(O) : deb.c +deb$(O) : embed.h +deb$(O) : form.h +deb$(O) : gv.h +deb$(O) : handy.h +deb$(O) : hv.h +deb$(O) : mg.h +deb$(O) : op.h +deb$(O) : opcode.h +deb$(O) : perl.h +deb$(O) : perly.h +deb$(O) : pp.h +deb$(O) : proto.h +deb$(O) : regexp.h +deb$(O) : scope.h +deb$(O) : sv.h +deb$(O) : vmsish.h +deb$(O) : util.h +run$(O) : EXTERN.h +run$(O) : av.h +run$(O) : config.h +run$(O) : cop.h +run$(O) : cv.h +run$(O) : embed.h +run$(O) : form.h +run$(O) : gv.h +run$(O) : handy.h +run$(O) : hv.h +run$(O) : mg.h +run$(O) : op.h +run$(O) : opcode.h +run$(O) : perl.h +run$(O) : perly.h +run$(O) : pp.h +run$(O) : proto.h +run$(O) : regexp.h +run$(O) : run.c +run$(O) : scope.h +run$(O) : sv.h +run$(O) : vmsish.h +run$(O) : util.h +vms$(O) : EXTERN.h +vms$(O) : av.h +vms$(O) : config.h +vms$(O) : cop.h +vms$(O) : cv.h +vms$(O) : embed.h +vms$(O) : form.h +vms$(O) : gv.h +vms$(O) : handy.h +vms$(O) : hv.h +vms$(O) : mg.h +vms$(O) : op.h +vms$(O) : opcode.h +vms$(O) : perl.h +vms$(O) : perly.h +vms$(O) : pp.h +vms$(O) : proto.h +vms$(O) : regexp.h +vms$(O) : vms.c +vms$(O) : scope.h +vms$(O) : sv.h +vms$(O) : vmsish.h +vms$(O) : util.h +miniperlmain$(O) : EXTERN.h +miniperlmain$(O) : av.h +miniperlmain$(O) : config.h +miniperlmain$(O) : cop.h +miniperlmain$(O) : cv.h +miniperlmain$(O) : embed.h +miniperlmain$(O) : form.h +miniperlmain$(O) : gv.h +miniperlmain$(O) : handy.h +miniperlmain$(O) : hv.h +miniperlmain$(O) : mg.h +miniperlmain$(O) : miniperlmain.c +miniperlmain$(O) : op.h +miniperlmain$(O) : opcode.h +miniperlmain$(O) : perl.h +miniperlmain$(O) : perly.h +miniperlmain$(O) : pp.h +miniperlmain$(O) : proto.h +miniperlmain$(O) : regexp.h +miniperlmain$(O) : scope.h +miniperlmain$(O) : sv.h +miniperlmain$(O) : vmsish.h +miniperlmain$(O) : util.h +perlmain$(O) : EXTERN.h +perlmain$(O) : av.h +perlmain$(O) : config.h +perlmain$(O) : cop.h +perlmain$(O) : cv.h +perlmain$(O) : embed.h +perlmain$(O) : form.h +perlmain$(O) : gv.h +perlmain$(O) : handy.h +perlmain$(O) : hv.h +perlmain$(O) : mg.h +perlmain$(O) : op.h +perlmain$(O) : opcode.h +perlmain$(O) : perl.h +perlmain$(O) : perly.h +perlmain$(O) : perlmain.c +perlmain$(O) : pp.h +perlmain$(O) : proto.h +perlmain$(O) : regexp.h +perlmain$(O) : scope.h +perlmain$(O) : sv.h +perlmain$(O) : vmsish.h +perlmain$(O) : util.h +globals$(O) : INTERN.h +globals$(O) : av.h +globals$(O) : config.h +globals$(O) : cop.h +globals$(O) : cv.h +globals$(O) : embed.h +globals$(O) : form.h +globals$(O) : gv.h +globals$(O) : handy.h +globals$(O) : hv.h +globals$(O) : mg.h +globals$(O) : op.h +globals$(O) : opcode.h +globals$(O) : perl.h +globals$(O) : perly.h +globals$(O) : globals.c +globals$(O) : pp.h +globals$(O) : proto.h +globals$(O) : regexp.h +globals$(O) : scope.h +globals$(O) : sv.h +globals$(O) : vmsish.h +globals$(O) : util.h + +config.h : [.vms]config.vms + Copy/Log/NoConfirm [.vms]config.vms []config.h + +vmsish.h : [.vms]vmsish.h + Copy/Log/NoConfirm [.vms]vmsish.h []vmsish.h + +vms.c : [.vms]vms.c + Copy/Log/Noconfirm [.vms]vms.c [] + +$(CRTL) : $(MAKEFILE) + @ $$@[.vms]genopt "$(CRTL)/Write" "|" "$(LIBS1)|$(LIBS2)|$(SOCKLIB)" + + +cleanlis : + - If f$$Search("*.Lis").nes."" Then Delete/NoConfirm/Log *.Lis;* + - If f$$Search("*.CPP").nes."" Then Delete/NoConfirm/Log *.CPP;* + - If f$$Search("*.Map").nes."" Then Delete/NoConfirm/Log *.Map;* + +tidy : cleanlis + - If f$$Search("*.Opt;-1").nes."" Then Purge/NoConfirm/Log *.Opt + - If f$$Search("*$(O);-1").nes."" Then Purge/NoConfirm/Log *$(O) + - If f$$Search("*$(E);-1").nes."" Then Purge/NoConfirm/Log *$(E) + - If f$$Search("Config.H;-1").nes."" Then Purge/NoConfirm/Log Config.H + - If f$$Search("Config.SH;-1").nes."" Then Purge/NoConfirm/Log Config.SH + - If f$$Search("perly.c;-1").nes."" Then Purge/NoConfirm/Log perly.c + - If f$$Search("perly.h;-1").nes."" Then Purge/NoConfirm/Log perly.h + - If f$$Search("VMSish.H;-1").nes."" Then Purge/NoConfirm/Log VMSish.H + - If f$$Search("VMS.C;-1") .nes."" Then Purge/NoConfirm/Log VMS.C + - If f$$Search("Perlmain.C;-1") .nes."" Then Purge/NoConfirm/Log Perlmain.C + - If f$$Search("Perlshr_Gbl*.Mar;-1") .nes."" Then Purge/NoConfirm/Log Perlshr_Gbl*.Mar + - If f$$Search("[.Ext.DynaLoader]DL_VMS$(O);-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS$(O) + - If f$$Search("[.Ext.DynaLoader]DL_VMS.C;-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS.C + - If f$$Search("[.Ext.Safe...];-1").nes."" Then Purge/NoConfirm/Log [.Ext.Safe] + - If f$$Search("[.Ext.FileHandle...];-1").nes."" Then Purge/NoConfirm/Log [.Ext.FileHandle] + - If f$$Search("[.VMS.Ext...]*.C;-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*.C + - If f$$Search("[.VMS.Ext...]*$(O);-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*$(O) + - 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("$(ARCHDIR)Config.pm;-1").nes."" Then Purge/NoConfirm/Log $(ARCHDIR)Config.pm + - If f$$Search("[.Lib.VMS]*.*;-1").nes."" Then Purge/NoConfirm/Log [.Lib.VMS]*.* + - If f$$Search("[.Lib.Pod]*.Pod;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Pod]*.Pod + - If f$$Search("$(ARCHCORE)*.*").nes."" Then Purge/NoConfirm/Log $(ARCHCORE)*.* + - If f$$Search("[.utils]*.;-1").nes."" Then Purge/NoConfirm/Log [.utils]*. + - If f$$Search("[.lib.pod]*.;-1").nes."" Then Purge/NoConfirm/Log [.lib.pod]*. + +clean : tidy + Set Default [.ext.Fcntl] + - $(MMS) clean + Set Default [--] + Set Default [.ext.FileHandle] + - $(MMS) clean + Set Default [--] + Set Default [.ext.Safe] + - $(MMS) clean + Set Default [--] + - If f$$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_*.Opt + - If f$$Search("*$(O);*") .nes."" Then Delete/NoConfirm/Log *$(O);* + - If f$$Search("Config.H").nes."" Then Delete/NoConfirm/Log Config.H;* + - If f$$Search("Config.SH").nes."" Then Delete/NoConfirm/Log Config.SH;* + - If f$$Search(f$$Parse("sys$$Disk:[]","$(SOCKH)")).nes."" Then Delete/NoConfirm/Log $(SOCKH);* + - If f$$Search(f$$Parse("sys$$Disk:[]","$(SOCKC)")).nes."" Then Delete/NoConfirm/Log $(SOCKC);* + - If f$$Search("perly.c").nes."" Then Delete/NoConfirm/Log perly.c;* + - If f$$Search("perly.h").nes."" Then Delete/NoConfirm/Log perly.h;* + - If f$$Search("VMSish.H").nes."" Then Delete/NoConfirm/Log VMSish.H;* + - If f$$Search("VMS.C") .nes."" Then Delete/NoConfirm/Log VMS.C;* + - If f$$Search("Perlmain.C") .nes."" Then Delete/NoConfirm/Log Perlmain.C;* + - If f$$Search("Perlshr_Gbl*.Mar") .nes."" Then Delete/NoConfirm/Log Perlshr_Gbl*.Mar;* + - If f$$Search("*.TS").nes."" Then Delete/NoConfirm/Log *.TS;* + - If f$$Search("[.Ext.DynaLoader]DL_VMS$(O)").nes."" Then Delete/NoConfirm/Log [.Ext.DynaLoader]DL_VMS$(O);* + - If f$$Search("[.Ext.DynaLoader]DL_VMS.C").nes."" Then Delete/NoConfirm/Log [.Ext.DynaLoader]DL_VMS.C;* + - If f$$Search("[.Ext.Socket]Socket$(O)").nes."" Then Delete/NoConfirm/Log [.Ext.Socket]Socket$(O);* + - If f$$Search("[.Ext.Socket]Socket.C").nes."" Then Delete/NoConfirm/Log [.Ext.Socket]Socket.C;* + - If f$$Search("[.VMS.Ext...]*.C").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*.C;* + - If f$$Search("[.VMS.Ext...]*$(O)").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*$(O);* + +realclean : clean + Set Default [.ext.Fcntl] + - $(MMS) realclean + Set Default [--] + Set Default [.ext.FileHandle] + - $(MMS) realclean + Set Default [--] + Set Default [.ext.Safe] + - $(MMS) realclean + Set Default [--] + - If f$$Search("*$(OLB)").nes."" Then Delete/NoConfirm/Log *$(OLB);* + - If f$$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;* + - $(MINIPERL) -e "use File::Path; rmtree(['lib/auto','lib/VMS','lib/$(ARCH)'],1,0);" + - If f$$Search("[.Lib]DynaLoader.pm").nes."" Then Delete/NoConfirm/Log [.Lib]DynaLoader.pm;* + - If f$$Search("[.Lib]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib]Config.pm;* + - If f$$Search("[.Lib]perlbug.").nes."" Then Delete/NoConfirm/Log [.Lib]perlbug.;* + - If f$$Search("$(ARCHDIR)Config.pm").nes."" Then Delete/NoConfirm/Log $(ARCHDIR)Config.pm;* + - If f$$Search("[.lib.ExtUtils]Miniperl.pm").nes."" Then Delete/NoConfirm/Log [.lib.ExtUtils]Miniperl.pm;* + - If f$$Search("[.utils]*.").nes."" Then Delete/NoConfirm/Log [.utils]*.;* + - If f$$Search("[.lib.pod]*.pod").nes."" Then Delete/NoConfirm/Log [.lib.pod]*.pod;* + - If f$$Search("[.lib.pod]perldoc.").nes."" Then Delete/NoConfirm/Log [.lib.pod]perldoc.;* + - If f$$Search("[.lib.pod]pod2*.").nes."" Then Delete/NoConfirm/Log [.lib.pod]pod2*.;* + - If f$$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);* + +cleansrc : clean + - If f$$Search("*.C;-1").nes."" Then Purge/NoConfirm/Log *.C + - If f$$Search("*.H;-1").nes."" Then Purge/NoConfirm/Log *.H + - If f$$Search("*.VMS;-1").nes."" Then Purge/NoConfirm/Log *.VMS + - If f$$Search("[.VMS]$(MAKEFILE);-1").nes."" Then Purge/NoConfirm/Log [.VMS]$(MAKEFILE) + - If f$$Search("[.VMS]*.C;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.C + - If f$$Search("[.VMS]*.H;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.H + - If f$$Search("[.VMS]*.Pl;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.Pl + - 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 diff --git a/gnu/usr.bin/perl/vms/config.vms b/gnu/usr.bin/perl/vms/config.vms new file mode 100644 index 00000000000..203e479016a --- /dev/null +++ b/gnu/usr.bin/perl/vms/config.vms @@ -0,0 +1,1647 @@ +/* + * This file was produced by hand because the configure utilities which + * are in the perl distribution are all shell scripts. Someday, I hope + * we'll get a perl configure utility, but until then . . . + * + * Feel free to add or change things to suit your needs, but be careful + * about moving the comments which say "config-skip" - they're used by + * GenConfig.pl when producing Config.pm. + * + * config.h for VMS + * Version: 5.002_01 + */ + +/* Configuration time: 22-Mar-1996 14:45 + * Configured by: Charles Bailey bailey@genetics.upenn.edu + * Target system: VMS + */ + +#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 /**/ + +/* OSNAME: + * This symbol contains the name of the operating system, as determined + * by Configure. + */ +#define OSNAME "VMS" /**/ + +/* ARCHLIB_EXP: + * This variable, if defined, holds the name of the directory in + * which the user wants to put architecture-dependent public + * library files for $package. It is most often a local directory + * such as /usr/local/lib. Programs using this variable must be + * prepared to deal with filename expansion. If ARCHLIB_EXP is the + * same as PRIVLIB_EXP, it is not defined, since presumably the + * program already searches PRIVLIB_EXP. + */ +/* ==> NOTE <== + * This value is automatically updated by FndVers.Com + * when Perl is built. Please do not change it by hand; make + * any changes to FndVers.Com instead. + */ +#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_003" /**/ + +/* CPPSTDIN: + * This symbol contains the first part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. Typical value of "cc -E" or "/lib/cpp", but it can also + * call a wrapper. See CPPRUN. + */ +/* CPPMINUS: + * This symbol contains the second part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. This symbol will have the value "-" if CPPSTDIN needs a minus + * to specify standard input, otherwise the value is "". + */ +#define CPPSTDIN "cc/noobj/preprocess=sys$output sys$input" +#define CPPMINUS "" + +/* HAS_BCMP: + * This symbol is defined if the bcmp() routine is available to + * compare blocks of memory. + */ +#undef HAS_BCMP /**/ + +/* HAS_BCOPY: + * This symbol is defined if the bcopy() routine is available to + * copy blocks of memory. + */ +#undef HAS_BCOPY /**/ + +/* HAS_BZERO: + * This symbol is defined if the bzero() routine is available to + * set a memory block to 0. + */ +#undef HAS_BZERO /**/ + +/* CASTNEGFLOAT: + * This symbol is defined if the C compiler can cast negative + * numbers to unsigned longs, ints and shorts. + */ +/* CASTFLAGS: + * This symbol contains flags that say what difficulties the compiler + * has casting odd floating values to unsigned long: + * 0 = ok + * 1 = couldn't cast < 0 + * 2 = couldn't cast >= 0x80000000 + */ +#define CASTNEGFLOAT /**/ +#define CASTFLAGS 0 /**/ + +/* 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. + */ +#undef HAS_CHSIZE /**/ + +/* HASCONST: + * This symbol, if defined, indicates that this C compiler knows about + * the const type. There is no need to actually test for that symbol + * within your programs. The mere use of the "const" keyword will + * trigger the necessary tests. + */ +#define HASCONST /**/ +#ifndef HASCONST +#define const +#endif + +/* HAS_CRYPT: + * This symbol, if defined, indicates that the crypt routine is available + * to encrypt passwords and the like. + */ +#define 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. + */ +#undef CSH /**/ + +/* HAS_DUP2: + * This symbol, if defined, indicates that the dup2 routine is + * available to duplicate file descriptors. + */ +#define HAS_DUP2 /**/ + +/* HAS_FCHMOD: + * This symbol, if defined, indicates that the fchmod routine is available + * to change mode of opened files. If unavailable, use chmod(). + */ +#undef HAS_FCHMOD /**/ + +/* HAS_FCHOWN: + * This symbol, if defined, indicates that the fchown routine is available + * to change ownership of opened files. If unavailable, use chown(). + */ +#undef HAS_FCHOWN /**/ + +/* HAS_FCNTL: + * This symbol, if defined, indicates to the C program that + * the fcntl() function exists. + */ +#undef HAS_FCNTL /**/ + +/* HAS_FGETPOS: + * This symbol, if defined, indicates that the fgetpos routine is + * available to get the file position indicator, similar to ftell(). + */ +#define HAS_FGETPOS /**/ + +/* FLEXFILENAMES: + * This symbol, if defined, indicates that the system supports filenames + * longer than 14 characters. + */ +#define FLEXFILENAMES /**/ + +/* HAS_FLOCK: + * This symbol, if defined, indicates that the flock routine is + * available to do file locking. + */ +#undef HAS_FLOCK /**/ + +/* HAS_FSETPOS: + * This symbol, if defined, indicates that the fsetpos routine is + * available to set the file position indicator, similar to fseek(). + */ +#define HAS_FSETPOS /**/ + +/* HAS_GETGROUPS: + * This symbol, if defined, indicates that the getgroups() routine is + * available to get the list of process groups. If unavailable, multiple + * groups are probably not supported. + */ +#undef HAS_GETGROUPS /**/ + +/* HAS_UNAME: + * This symbol, if defined, indicates that the C program may use the + * uname() routine to derive the host name. See also HAS_GETHOSTNAME + * and PHOSTNAME. + */ +#undef HAS_UNAME /**/ + +/* HAS_GETPGRP: + * This symbol, if defined, indicates that the getpgrp routine is + * available to get the current process group. + */ +#undef HAS_GETPGRP /**/ + +/* HAS_GETPGRP2: + * This symbol, if defined, indicates that the getpgrp2() (as in DG/UX) + * routine is available to get the current process group. + */ +#undef HAS_GETPGRP2 /**/ + +/* HAS_GETPRIORITY: + * This symbol, if defined, indicates that the getpriority routine is + * available to get a process's priority. + */ +#undef HAS_GETPRIORITY /**/ + +/* HAS_KILLPG: + * This symbol, if defined, indicates that the killpg routine is available + * to kill process groups. If unavailable, you probably should use kill + * with a negative process number. + */ +#undef HAS_KILLPG /**/ + +/* HAS_LINK: + * This symbol, if defined, indicates that the link routine is + * available to create hard links. + */ +#undef HAS_LINK /**/ + +/* HAS_LSTAT: + * This symbol, if defined, indicates that the lstat routine is + * available to do file stats on symbolic links. + */ +#undef HAS_LSTAT /**/ + +/* HAS_LOCKF: + * This symbol, if defined, indicates that the lockf routine is + * available to do file locking. + */ +#undef HAS_LOCKF /**/ + +/* HAS_MBSTOWCS: + * This symbol, if defined, indicates that the mbstowcs routine is + * available to covert a multibyte string into a wide character string. + */ +#undef HAS_MBSTOWCS /**/ + +/* HAS_MBTOWC: + * This symbol, if defined, indicates that the mbtowc routine is available + * to covert a multibyte to a wide character. + */ +#undef HAS_MBTOWC /**/ + +/* HAS_MEMCMP: + * This symbol, if defined, indicates that the memcmp routine is available + * to compare blocks of memory. + */ +#define HAS_MEMCMP /**/ + +/* HAS_MEMCPY: + * This symbol, if defined, indicates that the memcpy routine is available + * to copy blocks of memory. + */ +#define HAS_MEMCPY /**/ + +/* HAS_MEMMOVE: + * This symbol, if defined, indicates that the memmove routine is available + * to copy potentially overlapping blocks of memory. This should be used + * only when HAS_SAFE_BCOPY is not defined. If neither is there, roll your + * own version. + */ +#define HAS_MEMMOVE /**/ + +/* HAS_MEMSET: + * This symbol, if defined, indicates that the memset routine is available + * to set blocks of memory. + */ +#define HAS_MEMSET /**/ + +/* HAS_MKDIR: + * This symbol, if defined, indicates that the mkdir routine is available + * to create directories. Otherwise you should fork off a new process to + * exec /bin/mkdir. + */ +#define HAS_MKDIR /**/ + +/* HAS_MSG: + * This symbol, if defined, indicates that the entire msg*(2) library is + * supported (IPC mechanism based on message queues). + */ +#undef HAS_MSG /**/ + +/* HAS_OPEN3: + * This manifest constant lets the C program know that the three + * argument form of open(2) is available. + */ +#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 + * <dirent.h>. See I_DIRENT. + */ +#define HAS_READDIR /**/ + +/* HAS_SEEKDIR: + * This symbol, if defined, indicates that the seekdir routine is + * available. You may have to include <dirent.h>. See I_DIRENT. + */ +#define HAS_SEEKDIR /**/ + +/* HAS_TELLDIR: + * This symbol, if defined, indicates that the telldir routine is + * available. You may have to include <dirent.h>. See I_DIRENT. + */ +#define HAS_TELLDIR /**/ + +/* HAS_REWINDDIR: + * This symbol, if defined, indicates that the rewinddir routine is + * available. You may have to include <dirent.h>. See I_DIRENT. + */ +#define HAS_REWINDDIR /**/ + +/* HAS_RENAME: + * This symbol, if defined, indicates that the rename routine is available + * to rename files. Otherwise you should do the unlink(), link(), unlink() + * trick. + */ +#define HAS_RENAME /**/ + +/* HAS_RMDIR: + * This symbol, if defined, indicates that the rmdir routine is + * available to remove directories. Otherwise you should fork off a + * new process to exec /bin/rmdir. + */ +#define HAS_RMDIR /**/ + +/* HAS_SEM: + * This symbol, if defined, indicates that the entire sem*(2) library is + * supported. + */ +#undef HAS_SEM /**/ + +/* HAS_SETEGID: + * This symbol, if defined, indicates that the setegid routine is available + * to change the effective gid of the current program. + */ +#undef HAS_SETEGID /**/ + +/* HAS_SETEUID: + * This symbol, if defined, indicates that the seteuid routine is available + * to change the effective uid of the current program. + */ +#undef HAS_SETEUID /**/ + +/* HAS_SETLOCALE: + * This symbol, if defined, indicates that the setlocale routine is + * available to handle locale-specific ctype implementations. + */ +#undef HAS_SETLOCALE /**/ + +/* HAS_SETPGID: + * This symbol, if defined, indicates that the setpgid routine is + * available to set process group ID. + */ +#undef HAS_SETPGID /**/ + +/* HAS_SETPGRP2: + * This symbol, if defined, indicates that the setpgrp2() (as in DG/UX) + * routine is available to set the current process group. + */ +#undef HAS_SETPGRP2 /**/ + +/* HAS_SETPRIORITY: + * This symbol, if defined, indicates that the setpriority routine is + * available to set a process's priority. + */ +#undef HAS_SETPRIORITY /**/ + +/* HAS_SETREGID: + * This symbol, if defined, indicates that the setregid routine is + * available to change the real and effective gid of the current + * process. + */ +/* HAS_SETRESGID: + * This symbol, if defined, indicates that the setresgid routine is + * available to change the real, effective and saved gid of the current + * process. + */ +#undef HAS_SETREGID /**/ +#undef HAS_SETRESGID /**/ + +/* HAS_SETREUID: + * This symbol, if defined, indicates that the setreuid routine is + * available to change the real and effective uid of the current + * process. + */ +/* HAS_SETRESUID: + * This symbol, if defined, indicates that the setresuid routine is + * available to change the real, effective and saved uid of the current + * process. + */ +#undef HAS_SETREUID /**/ +#undef HAS_SETRESUID /**/ + +/* HAS_SETRGID: + * This symbol, if defined, indicates that the setrgid routine is available + * to change the real gid of the current program. + */ +#undef HAS_SETRGID /**/ + +/* HAS_SETRUID: + * This symbol, if defined, indicates that the setruid routine is available + * to change the real uid of the current program. + */ +#undef HAS_SETRUID /**/ + +/* HAS_SETSID: + * This symbol, if defined, indicates that the setsid routine is + * available to set the process group ID. + */ +#undef HAS_SETSID /**/ + +/* HAS_SHM: + * This symbol, if defined, indicates that the entire shm*(2) library is + * supported. + */ +#undef HAS_SHM /**/ + +/* Shmat_t: + * This symbol holds the return type of the shmat() system call. + * Usually set to 'void *' or 'char *'. + */ +/* HAS_SHMAT_PROTOTYPE: + * This symbol, if defined, indicates that the sys/shm.h includes + * a prototype for shmat(). Otherwise, it is up to the program to + * guess one. Shmat_t shmat _((int, Shmat_t, int)) is a good guess, + * but not always right so it should be emitted by the program only + * when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs. + */ +#undef Shmat_t /**/ /* config-skip */ +#undef HAS_SHMAT_PROTOTYPE /**/ + +/* HAS_SIGACTION: + * This symbol, if defined, indicates that Vr4's sigaction() routine + * is available. + */ +#undef HAS_SIGACTION /**/ + +/* USE_STAT_BLOCKS: + * This symbol is defined if this system has a stat structure declaring + * st_blksize and st_blocks. + */ +#undef USE_STAT_BLOCKS /**/ + +/* USE_STDIO_PTR: + * This symbol is defined if the _ptr and _cnt fields (or similar) + * of the stdio FILE structure can be used to access the stdio buffer + * for a file handle. If this is defined, then the FILE_ptr(fp) + * and FILE_cnt(fp) macros will also be defined and should be used + * to access these fields. + */ +/* USE_STDIO_BASE: + * This symbol is defined if the _base field (or similar) of the + * stdio FILE structure can be used to access the stdio buffer for + * a file handle. If this is defined, then the FILE_base(fp) macro + * will also be defined and should be used to access this field. + * Also, the FILE_bufsiz(fp) macro will be defined and should be used + * to determine the number of bytes in the buffer. USE_STDIO_BASE + * will never be defined unless USE_STDIO_PTR is. + */ +/* 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. + */ +#undef USE_STDIO_PTR /**/ +#undef USE_STDIO_BASE /**/ + +/* FILE_ptr: + * This macro is used to access the _ptr field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_PTR_LVALUE: + * This symbol is defined if the FILE_ptr macro can be used as an + * lvalue. + */ +/* FILE_cnt: + * This macro is used to access the _cnt field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_CNT_LVALUE: + * This symbol is defined if the FILE_cnt macro can be used as an + * lvalue. + */ +#undef FILE_ptr +#undef STDIO_PTR_LVALUE +#undef FILE_cnt +#undef STDIO_CNT_LVALUE + +/* FILE_base: + * This macro is used to access the _base field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_BASE is defined. + */ +/* FILE_bufsiz: + * This macro is used to determine the number of bytes in the I/O + * buffer pointed to by _base field (or equivalent) of the FILE + * structure pointed to its argument. This macro will always be defined + * if USE_STDIO_BASE is defined. + */ +#undef FILE_base +#undef FILE_bufsiz + +/* USE_STRUCT_COPY: + * This symbol, if defined, indicates that this C compiler knows how + * to copy structures. If undefined, you'll need to use a block copy + * routine of some sort instead. + */ +#define USE_STRUCT_COPY /**/ + +/* HAS_STRERROR: + * This symbol, if defined, indicates that the strerror routine is + * available to translate error numbers to strings. See the writeup + * of Strerror() in this file before you try to define your own. + */ +/* HAS_SYS_ERRLIST: + * This symbol, if defined, indicates that the sys_errlist array is + * available to translate error numbers to strings. The extern int + * sys_nerr gives the size of that table. + */ +/* Strerror: + * This preprocessor symbol is defined as a macro if strerror() is + * not available to translate error numbers to strings but sys_errlist[] + * array is there. + */ +#define HAS_STRERROR /**/ +#undef HAS_SYS_ERRLIST /**/ +#ifdef HAS_STRERROR +# define Strerror(e) strerror((e),vaxc$errno) +#else +#define Strerror(e) ((e)<0||(e)>=sys_nerr?"unknown":sys_errlist[e]) /**/ /* config-skip */ +#endif + +/* HAS_SYMLINK: + * This symbol, if defined, indicates that the symlink routine is available + * to create symbolic links. + */ +#undef HAS_SYMLINK /**/ + +/* HAS_SYSCALL: + * This symbol, if defined, indicates that the syscall routine is + * available to call arbitrary system calls. If undefined, that's tough. + */ +#undef HAS_SYSCALL /**/ + +/* HAS_SYSTEM: + * This symbol, if defined, indicates that the system routine is + * available to issue a shell command. + */ +#define HAS_SYSTEM /**/ + +/* Time_t: + * This symbol holds the type returned by time(). It can be long, + * or time_t on BSD sites (in which case <sys/types.h> should be + * included). + */ +#define Time_t time_t /* Time type */ + +/* HAS_TRUNCATE: + * This symbol, if defined, indicates that the truncate routine is + * available to truncate files. + */ +#undef HAS_TRUNCATE /**/ + + +/* HAS_VFORK: + * This symbol, if defined, indicates that vfork() exists. + */ +#define HAS_VFORK /**/ + +/* Signal_t: + * This symbol's value is either "void" or "int", corresponding to the + * appropriate return type of a signal handler. Thus, you can declare + * a signal handler using "Signal_t (*handler)()", and define the + * handler using "Signal_t handler(sig)". + */ +#define Signal_t void /* Signal handler's return type */ + +/* HASVOLATILE: + * This symbol, if defined, indicates that this C compiler knows about + * the volatile declaration. + */ +#define HASVOLATILE /**/ +#ifndef HASVOLATILE +#define volatile /* config-skip */ +#endif + +/* HAS_VPRINTF: + * This symbol, if defined, indicates that the vprintf routine is available + * to printf with a pointer to an argument list. If unavailable, you + * may need to write your own, probably in terms of _doprnt(). + */ +/* USE_CHAR_VSPRINTF: + * This symbol is defined if this system has vsprintf() returning type + * (char*). The trend seems to be to declare it as "int vsprintf()". It + * is up to the package author to declare vsprintf correctly based on the + * symbol. + */ +#define HAS_VPRINTF /**/ +#undef USE_CHAR_VSPRINTF /**/ + +/* HAS_WAIT4: + * This symbol, if defined, indicates that wait4() exists. + */ +#undef HAS_WAIT4 /**/ + +/* HAS_WAITPID: + * This symbol, if defined, indicates that the waitpid routine is + * available to wait for child process. + */ +#define HAS_WAITPID /**/ + +/* HAS_WCSTOMBS: + * This symbol, if defined, indicates that the wcstombs routine is + * available to convert wide character strings to multibyte strings. + */ +#undef HAS_WCSTOMBS /**/ + +/* I_DIRENT: + * This symbol, if defined, indicates to the C program that it should + * include <dirent.h>. Using this symbol also triggers the definition + * of the Direntry_t define which ends up being 'struct dirent' or + * 'struct direct' depending on the availability of <dirent.h>. + */ +/* DIRNAMLEN: + * This symbol, if defined, indicates to the C program that the length + * of directory entry names is provided by a d_namlen field. Otherwise + * you need to do strlen() on the d_name field. + */ +#undef I_DIRENT /**/ +#define DIRNAMLEN /**/ +#define Direntry_t struct dirent + +/* I_FCNTL: + * This manifest constant tells the C program to include <fcntl.h>. + */ +#undef I_FCNTL /**/ + +/* I_GRP: + * This symbol, if defined, indicates to the C program that it should + * include <grp.h>. + */ +#undef I_GRP /**/ + +/* I_LIMITS: + * This symbol, if defined, indicates to the C program that it should + * include <limits.h> to get definition of symbols like WORD_BIT or + * LONG_MAX, i.e. machine dependant limitations. + */ +#undef I_LIMITS /**/ + +/* I_MEMORY: + * This symbol, if defined, indicates to the C program that it should + * include <memory.h>. + */ +#undef I_MEMORY /**/ + +/* I_NDBM: + * This symbol, if defined, indicates that ndbm.h exists and should + * be included. + */ +#undef I_NDBM /**/ + +/* I_STDARG: + * This symbol, if defined, indicates that <stdarg.h> exists and should + * be included. + */ +#define I_STDARG /**/ + +/* I_PWD: + * This symbol, if defined, indicates to the C program that it should + * include <pwd.h>. + */ +/* PWQUOTA: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_quota. + */ +/* PWAGE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_age. + */ +/* PWCHANGE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_change. + */ +/* PWCLASS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_class. + */ +/* PWEXPIRE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_expire. + */ +/* PWCOMMENT: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_comment. + */ +#undef I_PWD /**/ +#undef PWQUOTA /**/ +#undef PWAGE /**/ +#undef PWCHANGE /**/ +#undef PWCLASS /**/ +#undef PWEXPIRE /**/ +#define PWCOMMENT /**/ + +/* I_STDDEF: + * This symbol, if defined, indicates that <stddef.h> exists and should + * be included. + */ +#define I_STDDEF /**/ + +/* I_STDLIB: +* This symbol, if defined, indicates that <stdlib.h> exists and should +* be included. +*/ +#define I_STDLIB /**/ + +/* I_STRING: + * This symbol, if defined, indicates to the C program that it should + * include <string.h> (USG systems) instead of <strings.h> (BSD systems). + */ +#define I_STRING /**/ + +/* I_SYS_DIR: + * This symbol, if defined, indicates to the C program that it should + * include <sys/dir.h>. + */ +#undef I_SYS_DIR /**/ + +/* I_SYS_FILE: + * This symbol, if defined, indicates to the C program that it should + * include <sys/file.h> to get definition of R_OK and friends. + */ +#undef I_SYS_FILE /**/ + +/* I_SYS_IOCTL: + * This symbol, if defined, indicates that <sys/ioctl.h> exists and should + * be included. Otherwise, include <sgtty.h> or <termio.h>. + */ +#undef I_SYS_IOCTL /**/ + +/* I_SYS_NDIR: + * This symbol, if defined, indicates to the C program that it should + * include <sys/ndir.h>. + */ +#undef I_SYS_NDIR /**/ + +/* I_SYS_SELECT: + * This symbol, if defined, indicates to the C program that it should + * include <sys/select.h> in order to get definition of struct timeval. + */ +#undef I_SYS_SELECT /**/ + +/* I_DBM: + * This symbol, if defined, indicates that <dbm.h> exists and should + * be included. + */ +/* I_RPCSVC_DBM: + * This symbol, if defined, indicates that <rpcsvc/dbm.h> 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 <sys/stat.h>. + */ +#define I_SYS_STAT /**/ + +/* I_SYS_TIMES: + * This symbol, if defined, indicates to the C program that it should + * include <sys/times.h>. + */ +#undef I_SYS_TIMES /**/ + +/* I_SYS_TYPES: + * This symbol, if defined, indicates to the C program that it should + * include <sys/types.h>. + */ +#define I_SYS_TYPES /**/ + +/* I_SYS_UN: + * This symbol, if defined, indicates to the C program that it should + * include <sys/un.h> to get UNIX domain socket definitions. + */ +#undef I_SYS_UN /**/ + +/* I_TERMIO: + * This symbol, if defined, indicates that the program should include + * <termio.h> rather than <sgtty.h>. There are also differences in + * the ioctl() calls that depend on the value of this symbol. + */ +/* I_TERMIOS: + * This symbol, if defined, indicates that the program should include + * the POSIX termios.h rather than sgtty.h or termio.h. + * There are also differences in the ioctl() calls that depend on the + * value of this symbol. + */ +/* I_SGTTY: + * This symbol, if defined, indicates that the program should include + * <sgtty.h> rather than <termio.h>. There are also differences in + * the ioctl() calls that depend on the value of this symbol. + */ +#undef I_TERMIO /**/ +#undef I_SGTTY /**/ +#undef I_TERMIOS /**/ + +/* I_TIME: + * This symbol, if defined, indicates to the C program that it should + * include <time.h>. + */ +/* I_SYS_TIME: + * This symbol, if defined, indicates to the C program that it should + * include <sys/time.h>. + */ +/* I_SYS_TIME_KERNEL: + * This symbol, if defined, indicates to the C program that it should + * include <sys/time.h> with KERNEL defined. + */ +#define I_TIME /**/ +#undef I_SYS_TIME /**/ +#undef I_SYS_TIME_KERNEL /**/ + +/* I_UNISTD: + * This symbol, if defined, indicates to the C program that it should + * include <unistd.h>. + */ +#undef I_UNISTD /**/ + +/* I_UTIME: + * This symbol, if defined, indicates to the C program that it should + * include <utime.h>. + */ +#undef I_UTIME /**/ + +/* I_VARARGS: + * This symbol, if defined, indicates to the C program that it should + * include <varargs.h>. + */ +#undef I_VARARGS /**/ + + +/* I_VFORK: + * This symbol, if defined, indicates to the C program that it should + * include vfork.h. + */ +#undef I_VFORK /**/ + +/* CAN_PROTOTYPE: + * If defined, this macro indicates that the C compiler can handle + * function prototypes. + */ +/* _: + * This macro is used to declare function parameters for folks who want + * to make declarations with prototypes using a different style than + * the above macros. Use double parentheses. For example: + * + * int main _((int argc, char *argv[])); + */ +#define CAN_PROTOTYPE /**/ +#ifdef CAN_PROTOTYPE +#define _(args) args /* config-skip */ +#else +#define _(args) () /* config-skip */ +#endif + +/* RANDBITS: + * This symbol contains the number of bits of random number the rand() + * function produces. Usual values are 15, 16, and 31. + */ +#define RANDBITS 31 /**/ + + +/* Select_fd_set_t: + * This symbol holds the type used for the 2nd, 3rd, and 4th + * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET + * is defined, and 'int *' otherwise. This is only useful if you + * have select(), of course. + */ +#define Select_fd_set_t int * /**/ + +/* STDCHAR: + * This symbol is defined to be the type of char used in stdio.h. + * It has the values "unsigned char" or "char". + */ +#define STDCHAR char /**/ + +/* 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 /**/ + +/* LOC_SED: + * This symbol holds the complete pathname to the sed program. + */ +#define LOC_SED "_NLA0:" /**/ + +/* BIN: + * This symbol holds the path of the bin directory where the package will + * be installed. Program must be prepared to deal with ~name substitution. + */ +#define BIN "/perl_root/000000" /**/ + +/* HAS_ALARM: + * This symbol, if defined, indicates that the alarm routine is + * available. + */ +#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. + */ +#define CASTI32 /**/ + +/* HAS_CHOWN: + * This symbol, if defined, indicates that the chown routine is + * available. + */ +#define HAS_CHOWN /**/ + +/* HAS_CHROOT: + * This symbol, if defined, indicates that the chroot routine is + * available. + */ +#undef HAS_CHROOT /**/ + +/* HAS_CUSERID: + * This symbol, if defined, indicates that the cuserid routine is + * available to get character login names. + */ +#define HAS_CUSERID /**/ + +/* HAS_DBL_DIG: + * This symbol, if defined, indicates that this system's <float.h> + * or <limits.h> defines the symbol DBL_DIG, which is the number + * of significant digits in a double precision number. If this + * symbol is not defined, a guess of 15 is usually pretty good. + */ +#define HAS_DBL_DIG /* */ + +/* HAS_DIFFTIME: + * This symbol, if defined, indicates that the difftime routine is + * available. + */ +#define HAS_DIFFTIME /**/ + +/* HAS_FORK: + * This symbol, if defined, indicates that the fork routine is + * available. + */ +/* VMS: In vmsish.h, fork is #defined to vfork. This kludge gets around + * some obsolete code in pp.c, which should be fixed in its own right + * sometime. - C. Bailey 26-Aug-1994 + */ +#define HAS_FORK /**/ + +/* HAS_GETLOGIN: + * This symbol, if defined, indicates that the getlogin routine is + * available. + */ +#define HAS_GETLOGIN /**/ + +/* HAS_GETPPID: + * This symbol, if defined, indicates that the getppid routine is + * available. + */ +#undef HAS_GETPPID /**/ + +/* HAS_HTONL: + * This symbol, if defined, indicates that the htonl() routine (and + * friends htons() ntohl() ntohs()) are available to do network + * order byte swapping. + */ +/* HAS_HTONS: + * This symbol, if defined, indicates that the htons() routine (and + * friends htonl() ntohl() ntohs()) are available to do network + * order byte swapping. + */ +/* HAS_NTOHL: + * This symbol, if defined, indicates that the ntohl() routine (and + * friends htonl() htons() ntohs()) are available to do network + * order byte swapping. + */ +/* HAS_NTOHS: + * This symbol, if defined, indicates that the ntohs() routine (and + * friends htonl() htons() ntohl()) are available to do network + * order byte swapping. + */ +#define HAS_HTONL /**/ +#define HAS_HTONS /**/ +#define HAS_NTOHL /**/ +#define HAS_NTOHS /**/ + +/* HAS_MBLEN: + * This symbol, if defined, indicates that the mblen routine is available + * to find the number of bytes in a multibye character. + */ +#undef HAS_MBLEN /**/ + +/* HAS_MKTIME: + * This symbol, if defined, indicates that the mktime routine is + * available. + */ +#undef HAS_MKTIME /**/ + +/* HAS_NICE: + * This symbol, if defined, indicates that the nice routine is + * available. + */ +#define HAS_NICE /**/ + +/* HAS_PAUSE: + * This symbol, if defined, indicates that the pause routine is + * available. + */ +#define HAS_PAUSE /**/ + +/* HAS_PIPE: + * This symbol, if defined, indicates that the pipe routine is + * available. + */ +#define HAS_PIPE /**/ + +/* HAS_READLINK: + * This symbol, if defined, indicates that the readlink routine is + * available. + */ +#undef HAS_READLINK /**/ + +/* HAS_SETLINEBUF: + * This symbol, if defined, indicates that the setlinebuf routine is + * available to change stderr or stdout from block-buffered or unbuffered + * to a line-buffered mode. + */ +#undef HAS_SETLINEBUF /**/ + +/* HAS_STRCHR: + * This symbol is defined to indicate that the strchr()/strrchr() + * functions are available for string searching. If not, try the + * index()/rindex() pair. + */ +/* HAS_INDEX: + * This symbol is defined to indicate that the index()/rindex() + * functions are available for string searching. + */ +#define HAS_STRCHR /**/ +#undef HAS_INDEX /**/ + +/* HAS_STRCOLL: + * This symbol, if defined, indicates that the strcoll routine is + * available to compare strings using collating information. + */ +#undef HAS_STRCOLL /**/ + +/* HAS_STRXFRM: + * This symbol, if defined, indicates that the strxfrm() routine is + * available to compare strings using collating information. + */ +#undef HAS_STRXFRM /**/ + +/* HAS_TCGETPGRP: + * This symbol, if defined, indicates that the tcgetpgrp routine is + * available to get foreground process group ID. + */ +#undef HAS_TCGETPGRP /**/ + +/* HAS_TCSETPGRP: + * This symbol, if defined, indicates that the tcsetpgrp routine is + * available to set foreground process group ID. + */ +#undef HAS_TCSETPGRP /**/ + +/* HAS_TIMES: + * This symbol, if defined, indicates that the times() routine exists. + * Note that this became obsolete on some systems (SUNOS), which now + * use getrusage(). It may be necessary to include <sys/times.h>. + */ +#define HAS_TIMES /**/ + +/* HAS_TZNAME: + * This symbol, if defined, indicates that the tzname[] array is + * available to access timezone names. + */ +#undef HAS_TZNAME /**/ + +/* HAS_UMASK: + * This symbol, if defined, indicates that the umask routine is + * available to get the file creation mask. + */ +#define HAS_UMASK /**/ + +/* HAS_WCTOMB: + * This symbol, if defined, indicates that the wctomb routine is available + * to covert a wide character to a multibyte. + */ +#undef HAS_WCTOMB /**/ + +/* Fpos_t: + * This symbol holds the type used to declare file positions in libc. + * It can be fpos_t, long, uint, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Fpos_t fpos_t /* File position type */ + +/* Gid_t: + * This symbol holds the return type of getgid() and the type of + * argument to setrgid() and related functions. Typically, + * it is the type of group ids in the kernel. + * It can be int, ushort, uid_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#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 <dlfcn.h> exists and should + * be included. + */ +#undef I_DLFCN /**/ + +/* I_FLOAT: + * This symbol, if defined, indicates to the C program that it should + * include <float.h> to get definition of symbols like DBL_MAX or + * DBL_MIN, i.e. machine dependent floating point values. + */ +#define I_FLOAT /**/ + +/* I_MATH: + * This symbol, if defined, indicates to the C program that it should + * include <math.h>. + */ +#define I_MATH /**/ + +/* I_LOCALE: + * This symbol, if defined, indicates to the C program that it should + * include <locale.h>. + */ +#undef I_LOCALE /**/ + +/* I_SYS_STAT: + * This symbol, if defined, indicates to the C program that it should + * include <sys/stat.h>. + */ +#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. + * It can be int, long, off_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Off_t int /* <offset> 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 + * int or unsigned short. It may be necessary to include <sys/types.h> + * to get any typedef'ed information. + */ +#define Mode_t unsigned int /* file mode parameter for system calls*/ + +/* SSize_t: + * This symbol holds the type used by functions that return + * a count of bytes or an error condition. It must be a signed type. + * It is usually ssize_t, but may be long or int, etc. + * It may be necessary to include <sys/types.h> or <unistd.h> + * to get any typedef'ed information. + * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). + */ +#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. + */ +/* ==> NOTE <== + * This value is automatically updated by FndVers.Com + * when Perl is built. Please do not change it by hand; make + * any changes to FndVers.Com instead. + */ +#define OLDARCHLIB_EXP "/perl_root/lib/VMS_VAX" /**/ + +/* PRIVLIB_EXP: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + */ +#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. + */ +#define SITELIB_EXP "/perl_root/lib/site_perl" /**/ + +/* 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. + */ +/* ==> NOTE <== + * This value is automatically updated by FndVers.Com + * when Perl is built. Please do not change it by hand; make + * any changes to FndVers.Com instead. + */ +#define SITEARCH_EXP "/perl_root/lib/site_perl/VMS_VAX" /**/ + +/* 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 + * is often a directory that is mounted across diverse architectures. + * Programs must be prepared to deal with ~name expansion. + */ +#define SCRIPTDIR "/perl_root/script" /**/ + +/* Size_t: + * This symbol holds the type used to declare length parameters + * for string functions. It is usually size_t, but may be + * unsigned long, int, etc. It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Size_t size_t /* length paramater for string functions */ + +/* Uid_t: + * This symbol holds the type used to declare user ids in the kernel. + * It can be int, ushort, uid_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 500000) +# define Uid_t uid_t /* config-skip */ +#else +# define Uid_t unsigned int /* config-skip */ +#endif + +/* I_SYS_PARAM: + * This symbol, if defined, indicates to the C program that it should + * include <sys/param.h>. + */ +#undef I_SYS_PARAM + +/* GNUC_ATTRIBUTE_CHECK: + * This symbol indicates the C compiler can check for function attributes, + * such as printf formats. + */ +/* VMS: true for gcc, undef for VAXC/DECC. This is handled in Descrip.MMS + * C. Bailey 26-Aug-1994 + */ +/*#define GNUC_ATTRIBUTE_CHECK /**/ + +/* VOID_CLOSEDIR: + * This symbol, if defined, indicates that the closedir() routine + * does not return a value. + */ +#define VOID_CLOSEDIR /**/ + +/* HAS_DLERROR: + * This symbol, if defined, indicates that the dlerror routine is + * available. +*/ +#undef HAS_DLERROR /**/ + +/* DLSYM_NEEDS_UNDERSCORE: + * This symbol, if defined, indicates that we need to prepend an + * underscore to the symbol name before calling dlsym(). This only + * makes sense if you *have* dlsym, which we will presume is the + * case if you're using dl_dlopen.xs. + */ +#undef DLSYM_NEEDS_UNDERSCORE /* */ + +/* SETUID_SCRIPTS_ARE_SECURE_NOW: + * This symbol, if defined, indicates that setuid scripts are secure. + */ +/* DOSUID: + * This symbol, if defined, indicates that the C program should + * check the script that it is executing for setuid/setgid bits, and + * attempt to emulate setuid/setgid on systems that have disabled + * setuid #! scripts because the kernel can't do it securely. + * It is up to the package designer to make sure that this emulation + * is done securely. Among other things, it should do an fstat on + * the script it just opened to make sure it really is a setuid/setgid + * script, it should make sure the arguments passed correspond exactly + * to the argument on the #! line, and it should not trust any + * subprocesses to which it must pass the filename rather than the + * file descriptor of the script to be executed. + */ +#undef SETUID_SCRIPTS_ARE_SECURE_NOW /**/ +#undef DOSUID /**/ + +/* HAS_ISASCII: + * This manifest constant lets the C program know that the + * isascii is available. + */ +#define HAS_ISASCII /**/ + +/* HAS_LOCALECONV: + * This symbol, if defined, indicates that the localeconv routine is + * available for numeric and monetary formatting conventions. + */ +#undef HAS_LOCALECONV /**/ + +/* HAS_MKFIFO: + * This symbol, if defined, indicates that the mkfifo routine is + * available. + */ +#undef HAS_MKFIFO /**/ + +/* HAS_PATHCONF: + * This symbol, if defined, indicates that pathconf() is available + * to determine file-system related limits and options associated + * with a given filename. + */ +/* HAS_FPATHCONF: + * This symbol, if defined, indicates that pathconf() is available + * to determine file-system related limits and options associated + * with a given open file descriptor. + */ +#undef HAS_PATHCONF /**/ +#undef HAS_FPATHCONF /**/ + +/* HAS_SAFE_BCOPY: + * This symbol, if defined, indicates that the bcopy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. + */ +#undef HAS_SAFE_BCOPY /**/ + +/* HAS_SAFE_MEMCPY: + * This symbol, if defined, indicates that the memcpy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. + */ +#define HAS_SAFE_MEMCPY /**/ + +/* HAS_SETPGRP: + * This symbol, if defined, indicates that the setpgrp routine is + * available to set the current process group. + */ +/* USE_BSDPGRP: + * This symbol, if defined, indicates that the BSD notion of process + * group is to be used. For instance, you have to say setpgrp(pid, pgrp) + * instead of the USG setpgrp(). + */ +#undef HAS_SETPGRP /**/ +#undef USE_BSDPGRP /**/ + +/* HAS_SYSCONF: + * This symbol, if defined, indicates that sysconf() is available + * to determine system related limits and options. + */ +#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) + +/* Sigjmp_buf: + * This is the buffer type to be used with Sigsetjmp and Siglongjmp. + */ +/* Sigsetjmp: + * This macro is used in the same way as sigsetjmp(), but will invoke + * traditional setjmp() if sigsetjmp isn't available. + */ +/* Siglongjmp: + * This macro is used in the same way as siglongjmp(), but will invoke + * traditional longjmp() if siglongjmp isn't available. + */ +#undef HAS_SIGSETJMP /**/ +#ifdef HAS_SIGSETJMP +#define Sigjmp_buf sigjmp_buf /* config-skip */ +#define Sigsetjmp(buf,save_mask) sigsetjmp(buf,save_mask) /* config-skip */ +#define Siglongjmp(buf,retval) siglongjmp(buf,retval) /* config-skip */ +#else +#define Sigjmp_buf jmp_buf /* config-skip */ +#define Sigsetjmp(buf,save_mask) setjmp(buf) /* config-skip */ +#define Siglongjmp(buf,retval) longjmp(buf,retval) /* config-skip */ +#endif + +/* USE_DYNAMIC_LOADING: + * This symbol, if defined, indicates that dynamic loading of + * some sort is available. + */ +#define USE_DYNAMIC_LOADING /**/ + +/* STARTPERL: + * This variable contains the string to put in front of a perl + * script to make sure (one hopes) that it runs with perl and not + * some shell. + */ +#define STARTPERL "" /**/ + +/* 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 + * supported. + */ +/* HAS_SOCKETPAIR: + * This symbol, if defined, indicates that the BSD socketpair() call is + * supported. + */ +#define HAS_SOCKET /**/ /* config-skip */ +#undef HAS_SOCKETPAIR /**/ /* config-skip */ + +/* HAS_GETHOSTENT: + * This symbol, if defined, indicates that the gethostent routine is + * available to lookup host names in some data base or other. + */ +#define HAS_GETHOSTENT /**/ /* config-skip */ + +/* VMS: In general, TCP/IP header files should be included from + * sockadapt.h, instead of here, in order to keep the TCP/IP code + * together as much as possible. + */ +/* I_NETINET_IN: + * This symbol, if defined, indicates to the C program that it should + * include <netinet/in.h>. Otherwise, you may try <sys/in.h>. + */ +#undef I_NETINET_IN /**/ /* config-skip */ + +/* Groups_t: + * This symbol holds the type used for the second argument to + * getgroups(). Usually, this is the same of gidtype, but + * sometimes it isn't. It can be int, ushort, uid_t, etc... + * It may be necessary to include <sys/types.h> to get any + * typedef'ed information. This is only required if you have + * getgroups(). + */ +#ifdef HAS_GETGROUPS +#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 <db.h> 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 <db.h> 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 <net/errno.h> 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, <sys/time.h> may need to be included. + */ +#define HAS_SELECT /**/ /* config-skip */ + +#else /* VMS_DO_SOCKETS */ + +#undef HAS_SOCKET /**/ /* config-skip */ +#undef HAS_SOCKETPAIR /**/ /* config-skip */ +#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 */ + +#endif diff --git a/gnu/usr.bin/perl/vms/descrip.mms b/gnu/usr.bin/perl/vms/descrip.mms new file mode 100644 index 00000000000..7e52f19cc97 --- /dev/null +++ b/gnu/usr.bin/perl/vms/descrip.mms @@ -0,0 +1,1525 @@ +# Descrip.MMS for perl5 on VMS +# Last revised 22-Mar-1996 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 +#: a Unix-style MAKE tool, run this file through mms2make.pl, which should +#: be found in the same directory as this file. (There should be a pre-made +#: copy of Makefile for VAXC in this directory to allow you to build perl.) +#: +#: Lines beginning with "#:" will be removed by mms2make.pl when converting +#: this file to MAKE syntax. +#: +#: Usage: +#: Building with VAX C, on system without DEC C installed or with VAX C default: +#: $ MMS +#: Building with VAX C, on system with DEC C installed as default C compiler: +#: $ MMS /MACRO=("cc=CC/VAXC") +#: Building with DEC C, on system without VAX C installed or with DEC C default: +#: $ MMS /MACRO=("decc=1") +#: Building with DEC C, on system with VAX C installed as default C compiler: +#: $ MMS /MACRO=("decc=1","cc=CC/DECC") +#: Building with GNU C +#: $ MMS /MACRO=("gnuc=1") +#: To each of the above, add /Macro="__AXP__=1" if building on an AXP, +#: /Macro="__DEBUG__=1" to build a debug version +#: (i.e. VMS debugger, not perl -D), and +#: /Macro="SOCKET=1" to include socket support. +# +# tidy -- purge files generated by executing this file +# clean -- remove all intermediate (e.g. object files, C files generated +# during build) files generated by executing this file, +# but leave `installable' files (images, library) intact +# realclean -- remove all files generated by executing this file +# cleansrc -- `realclean' + purge *.c,*.h,descrip.mms +# crtl.opt -- compiler-specific linker options file (made automatically) +# + +#### Start of system configuration section. #### + + +#: >>>>> Architecture-specific options <<<<< +.ifdef AXE +# File type to use for object files +O = .abj +# File type to use for object libraries +OLB = .alb +# File type to use for executable images +E = .axe +.else +# File type to use for object files +O = .obj +# File type to use for object libraries +OLB = .olb +# File type to use for executable images +E = .exe +.endif + +.ifdef __AXP__ +DECC = 1 +ARCH = VMS_AXP +OBJVAL = $(O) +.else +ARCH = VMS_VAX +OBJVAL = $(MMS$TARGET_NAME)$(O) +.endif + +.first + @ @[.vms]fndvers.com "" "" "[.vms]descrip.mms" + +# Updated by fndvers.com -- do not edit by hand +PERL_VERSION = 5_003 # + + +ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)] +ARCHCORE = [.lib.$(ARCH).$(PERL_VERSION).CORE] +ARCHAUTO = [.lib.$(ARCH).$(PERL_VERSION).auto] + + +#: Backwards compatibility +.ifdef DECC_PIPES_BROKEN +PIPES_BROKEN = 1 +.endif + + +#: >>>>>Compiler-specific options <<<<< +.ifdef GNUC +.first + @ If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS GNU_CC_Include:[VMS] +CC = gcc +# -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) +XTRACCFLAGS = /Obj=$(MMS$TARGET_NAME)$(O)/NoCase_Hack/Optimize=2/CC1="""""-fno-builtin""""" +DBGSPECFLAGS = +XTRADEF = ,GNUC_ATTRIBUTE_CHECK +XTRAOBJS = +LIBS1 = GNU_CC:[000000]GCCLIB.OLB/Library +LIBS2 = Sys$Share:VAXCRTL/Shareable +.else +XTRAOBJS = +LIBS1 = $(XTRAOBJS) +DBGSPECFLAGS = /Show=(Source,Include,Expansion) +.ifdef decc +# Some versions of DECCRTL on AXP have a bug in chdir() which causes the change +# to persist after the image exits, even when this was not requested, iff +# 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 + @ Set Process/Privilege=(NoSYSNAM) + @ If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").nes."" Then Define/NoLog SYS DECC$System_Include +.ifdef __AXP__ + @ If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS Sys$Library +.else + @ If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS DECC$Library_Include +.endif + +LIBS2 = +XTRACCFLAGS = /Include=[]/Standard=Relaxed_ANSI/Prefix=All/Obj=$(OBJVAL) +XTRADEF = +.else # VAXC +.first + @ If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS Sys$Library + @ If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").nes."" Then Define/NoLog SYS VAXC$Include + +XTRACCFLAGS = /Include=[]/Object=$(O) +XTRADEF = +LIBS2 = Sys$Share:VAXCRTL/Shareable +.endif +.endif + + +#: >>>>> Configuration options <<<<< +#: __DEBUG__: builds images with full VMS debugger support +.ifdef __DEBUG__ +DBGCCFLAGS = /List/Debug/NoOpt$(DBGSPECFLAGS) +DBGLINKFLAGS = /Trace/Debug/Map/Full/Cross +DBG = DBG +.else +DBGCCFLAGS = /NoList +DBGLINKFLAGS = /NoMap +DBG = +.endif + +#: SOCKET: build in support for TCP/IP sockets +#: By default, used SOCKETSHR library; see ReadMe.VMS +#: for information on changing socket support +.ifdef SOCKET +SOCKDEF = ,VMS_DO_SOCKETS +SOCKLIB = SocketShr/Share +# N.B. the targets for $(SOCKC) and $(SOCKH) assume that the permanent +# copies live in [.vms], and the `clean' target will delete copies of +# these files in the current default directory. +SOCKC = sockadapt.c +SOCKH = sockadapt.h +SOCKCLIS = ,$(SOCKC) +SOCKHLIS = ,$(SOCKH) +SOCKOBJ = ,sockadapt$(O) +SOCKPM = [.lib]Socket.pm +.else +SOCKDEF = +SOCKLIB = +SOCKC = +SOCKH = +SOCKCLIS = +SOCKHLIS = +SOCKOBJ = +SOCKPM = +.endif + +# C preprocessor manifest "DEBUGGING" ==> perl -D, not the VMS debugger +CFLAGS = /Define=(DEBUGGING$(SOCKDEF)$(XTRADEF))$(XTRACCFLAGS)$(DBGCCFLAGS) +LINKFLAGS = $(DBGLINKFLAGS) + +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) "-I[.lib]" +XSUBPP = $(MINIPERL) [.lib.extutils]xsubpp -noprototypes +# Macro to invoke a preexisting copy of Perl. This is used to regenerate +# some header files when rebuilding Perl, but premade versions are provided +# in the distribution, so it's OK if this doesn't work; it's here to make +# life easier for those who modify Perl and rebuild it. +INSTPERL = perl + +# Space-separated list of "static" extensions to build into perlshr (case counts). +MYEXT = DynaLoader +# object files for these extensions; the trailing comma is required if +# there are any object files specified +# These must be built separately, or you must add rules below to build them +myextobj = [.ext.dynaloader]dl_vms$(O), +#: We include the Socket extension by default if we're building with socket +#: support, since it's small and not really worth bothering to keep track +#: of separately. +.ifdef SOCKET +EXT = $(MYEXT) Socket +extobj = $(myextobj) [.ext.socket]socket$(O), +.else +EXT = $(MYEXT) +extobj = $(myextobj) +.endif + + +#### End of system configuration section. #### + + +h1 = EXTERN.h, INTERN.h, XSUB.h, av.h, config.h, cop.h, cv.h +h2 = embed.h, form.h, gv.h, handy.h, hv.h, keywords.h, mg.h, op.h +h3 = opcode.h, patchlevel.h, perl.h, perly.h, pp.h, proto.h, regcomp.h +h4 = regexp.h, scope.h, sv.h, vmsish.h, util.h +h = $(h1), $(h2), $(h3), $(h4) $(SOCKHLIS) + +c1 = av.c, scope.c, op.c, doop.c, doio.c, dump.c, hv.c, mg.c +c2 = perl.c, perly.c, pp.c, pp_hot.c, pp_ctl.c, pp_sys.c, regcomp.c, regexec.c +c3 = gv.c, sv.c, taint.c, toke.c, util.c, deb.c, run.c, globals.c, vms.c $(SOCKCLIS) + +c = $(c1), $(c2), $(c3), miniperlmain.c, perlmain.c + +obj1 = perl$(O), gv$(O), toke$(O), perly$(O), op$(O), regcomp$(O), dump$(O), util$(O), mg$(O) +obj2 = hv$(O), av$(O), run$(O), pp_hot$(O), sv$(O), pp$(O), scope$(O), pp_ctl$(O), pp_sys$(O) +obj3 = doop$(O), doio$(O), regexec$(O), taint$(O), deb$(O), globals$(O), vms$(O) $(SOCKOBJ) + +obj = $(obj1), $(obj2), $(obj3) + +ac1 = $(ARCHCORE)EXTERN.h $(ARCHCORE)INTERN.h $(ARCHCORE)XSUB.h $(ARCHCORE)av.h +ac2 = $(ARCHCORE)config.h $(ARCHCORE)cop.h $(ARCHCORE)cv.h $(ARCHCORE)embed.h +ac3 = $(ARCHCORE)form.h $(ARCHCORE)gv.h $(ARCHCORE)handy.h $(ARCHCORE)hv.h +ac4 = $(ARCHCORE)keywords.h $(ARCHCORE)mg.h $(ARCHCORE)op.h $(ARCHCORE)opcode.h +ac5 = $(ARCHCORE)patchlevel.h $(ARCHCORE)perl.h $(ARCHCORE)perly.h +ac6 = $(ARCHCORE)pp.h $(ARCHCORE)proto.h $(ARCHCORE)regcomp.h +ac7 = $(ARCHCORE)regexp.h $(ARCHCORE)scope.h $(ARCHCORE)sv.h $(ARCHCORE)util.h +ac8 = $(ARCHCORE)vmsish.h $(ARCHCORE)$(DBG)libperl$(OLB) $(ARCHCORE)perlshr_attr.opt +ac9 = $(ARCHCORE)$(DBG)perlshr_bld.opt +.ifdef SOCKET +acs = $(ARCHCORE)$(SOCKH) +.else +acs = +.endif + +CRTL = []crtl.opt +CRTLOPTS =,$(CRTL)/Options + +.SUFFIXES + +.ifdef LINK_ONLY +.else +.SUFFIXES $(O) .c .xs + +.xs.c : + $(XSUBPP) $(MMS$SOURCE) >$(MMS$TARGET) + + +.c$(O) : + $(CC) $(CFLAGS) $(MMS$SOURCE) + +.xs$(O) : + $(XSUBPP) $(MMS$SOURCE) >$(MMS$SOURCE_NAME).c + $(CC) $(CFLAGS) $(MMS$SOURCE_NAME).c +.endif + + +all : base extras archcorefiles preplibrary perlpods + @ $(NOOP) +base : miniperl perl + @ $(NOOP) +extras : Fcntl FileHandle Safe libmods utils podxform + @ $(NOOP) +libmods : [.lib]Config.pm $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm + @ $(NOOP) +utils : [.lib.pod]perldoc [.lib.ExtUtils]Miniperl.pm [.utils]c2ph [.utils]h2ph [.utils]h2xs [.lib]perlbug + @ $(NOOP) +podxform : [.lib.pod]pod2text [.lib.pod]pod2html [.lib.pod]pod2latex [.lib.pod]pod2man + @ $(NOOP) + +pod1 = [.lib.pod]perl.pod [.lib.pod]perlbook.pod [.lib.pod]perlbot.pod [.lib.pod]perlcall.pod +pod2 = [.lib.pod]perldata.pod [.lib.pod]perldebug.pod [.lib.pod]perldiag.pod [.lib.pod]perldsc.pod +pod3 = [.lib.pod]perlembed.pod [.lib.pod]perlform.pod [.lib.pod]perlfunc.pod [.lib.pod]perlguts.pod +pod4 = [.lib.pod]perlipc.pod [.lib.pod]perllol.pod [.lib.pod]perlmod.pod [.lib.pod]perlobj.pod +pod5 = [.lib.pod]perlop.pod [.lib.pod]perlovl.pod [.lib.pod]perlpod.pod [.lib.pod]perlre.pod +pod6 = [.lib.pod]perlref.pod [.lib.pod]perlrun.pod [.lib.pod]perlsec.pod [.lib.pod]perlstyle.pod +pod7 = [.lib.pod]perlsub.pod [.lib.pod]perlsyn.pod [.lib.pod]perltie.pod [.lib.pod]perltoc.pod +pod8 = [.lib.pod]perltrap.pod [.lib.pod]perlvar.pod [.lib.pod]perlxs.pod [.lib.pod]perlxstut.pod + +perlpods : $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) [.lib.pod]perlvms.pod + @ $(NOOP) + +archcorefiles : $(ac1) $(ac2) $(ac3) $(ac4) $(ac5) $(ac6) $(ac7) $(ac8) $(ac9) $(acs) $(ARCHAUTO)time.stamp + @ $(NOOP) + +miniperl : $(DBG)miniperl$(E) + @ Continue +miniperl_objs = miniperlmain$(O), $(obj) +$(MINIPERL_EXE) : miniperlmain$(O), $(DBG)libperl$(OLB) $(CRTL) + Link $(LINKFLAGS)/NoDebug/Exe=$(MMS$TARGET) miniperlmain$(O), $(DBG)libperl$(OLB)/Library/Include=globals $(CRTLOPTS) +$(DBG)miniperl$(E) : $(miniperl_objs), $(DBG)libperl$(OLB) $(CRTL) + Link $(LINKFLAGS)/Exe=$(MMS$TARGET) miniperlmain$(O),$(DBG)libperl$(OLB)/Library/Include=globals $(CRTLOPTS) + +$(DBG)libperl$(OLB) : $(obj) + @ If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET) + Library/Object/Replace $(MMS$TARGET) $(obj1) + Library/Object/Replace $(MMS$TARGET) $(obj2) + Library/Object/Replace $(MMS$TARGET) $(obj3) + +perlmain.c : miniperlmain.c $(MINIPERL_EXE) [.vms]writemain.pl + $(MINIPERL) [.VMS]Writemain.pl "$(EXT)" + +perl : $(DBG)perl$(E) + @ Continue +$(DBG)perl$(E) : perlmain$(O), $(DBG)perlshr$(E), $(MINIPERL_EXE) + @ @[.vms]genopt "PerlShr.Opt/Write" "|" "''F$Environment("Default")'$(DBG)PerlShr$(E)/Share" +.ifdef gnuc + @ @[.vms]genopt "PerlShr.Opt/Append" "|" "$(LIBS1)|$(LIBS2)" +.endif + Link $(LINKFLAGS)/Exe=$(MMS$TARGET) perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option + +$(DBG)perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts + Link /NoTrace$(LINKFLAGS)/Share=$(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 +# The song and dance with gen_shrfls.opt accomodates DCL's 255 character +# line length limit. +.ifdef PIPES_BROKEN +# This is a backup target used only with older versions of the DECCRTL which +# can't deal with pipes properly. See ReadMe.VMS for details. +$(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $(MINIPERL_EXE) $(MAKEFILE) $(CRTL) + $(CC) $(CFLAGS)/NoObject/NoList/PreProcess=perl.i perl.h + @ $(MINIPERL) -e "print join('|',@ARGV),'|';" "~~NOCC~~perl.i~~$(CC)$(CFLAGS)" >gen_shrfls.opt + @ $(MINIPERL) -e "print join('|',@ARGV);" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)" >>gen_shrfls.opt + $(MINIPERL) [.vms]gen_shrfls.pl -f gen_shrfls.opt + @ Delete/NoLog/NoConfirm perl.i;, gen_shrfls.opt; + @ If F$Search("$(DBG)perlshr_xtras.ts").nes."" Then Delete/NoLog/NoConfirm $(DBG)perlshr_xtras.ts;* + @ Copy _NLA0: $(DBG)perlshr_xtras.ts +.else +$(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $(MINIPERL_EXE) $(MAKEFILE) $(CRTL) + @ $(MINIPERL) -e "print join('|',@ARGV),'|';" "$(CC)$(CFLAGS)" >gen_shrfls.opt + @ $(MINIPERL) -e "print join('|',@ARGV);" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)" >>gen_shrfls.opt + $(MINIPERL) [.vms]gen_shrfls.pl -f gen_shrfls.opt + @ Delete/NoLog/NoConfirm gen_shrfls.opt; + @ If F$Search("$(DBG)perlshr_xtras.ts").nes."" Then Delete/NoLog/NoConfirm $(DBG)perlshr_xtras.ts;* + @ Copy _NLA0: $(DBG)perlshr_xtras.ts +.endif + +$(ARCHDIR)config.pm : [.lib]config.pm + Create/Directory $(ARCHDIR) + Copy $(MMS$SOURCE) $(MMS$TARGET) + +# Once again, we accomodate DCL's 255 character buffer +[.lib]config.pm : [.vms]config.vms [.vms]genconfig.pl $(MINIPERL_EXE) + @ $(MINIPERL) -e "print join('|',@ARGV),'|';" "cc=$(CC)$(CFLAGS)" >genconfig.opt + @ $(MINIPERL) -e "print join('|',@ARGV),'|';" "ldflags=$(LINKFLAGS)|obj_ext=$(O)|exe_ext=$(E)|lib_ext=$(OLB)" >>genconfig.opt + $(MINIPERL) [.VMS]GenConfig.Pl -f genconfig.opt + @ Delete/NoLog/NoConfirm genconfig.opt; + $(MINIPERL) ConfigPM. + +[.ext.dynaloader]dl_vms.c : [.ext.dynaloader]dl_vms.xs $(MINIPERL_EXE) + $(XSUBPP) $(MMS$SOURCE) >$(MMS$TARGET) + +[.ext.dynaloader]dl_vms$(O) : [.ext.dynaloader]dl_vms.c + $(CC) $(CFLAGS) /Object=$(MMS$TARGET) $(MMS$SOURCE) + +[.lib]DynaLoader.pm : [.ext.dynaloader]dynaloader.pm + Copy/Log/NoConfirm [.ext.dynaloader]dynaloader.pm [.lib]DynaLoader.pm + @ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto] + @ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]DynaLoader.pm + +Safe : [.lib]Safe.pm [.lib.auto.Safe]Safe$(E) + @ $(NOOP) + +[.lib]Safe.pm : [.ext.Safe]Descrip.MMS + @ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto] + @ Set Default [.ext.Safe] + $(MMS) + @ Set Default [--] + +[.lib.auto.Safe]Safe$(E) : [.ext.Safe]Descrip.MMS + @ Set Default [.ext.Safe] + $(MMS) + @ Set Default [--] + +# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir> +# ${@} necessary to distract different versions of MM[SK]/make +[.ext.Safe]Descrip.MMS : [.ext.Safe]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E) + $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Safe]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" + +FileHandle : [.lib]FileHandle.pm [.lib.auto.FileHandle]FileHandle$(E) + @ $(NOOP) + +[.lib]FileHandle.pm : [.ext.FileHandle]Descrip.MMS + @ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto] + @ Set Default [.ext.FileHandle] + $(MMS) + @ Set Default [--] + +[.lib.auto.FileHandle]FileHandle$(E) : [.ext.FileHandle]Descrip.MMS + @ Set Default [.ext.FileHandle] + $(MMS) + @ Set Default [--] + +# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir> +# ${@} necessary to distract different versions of MM[SK]/make +[.ext.FileHandle]Descrip.MMS : [.ext.FileHandle]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E) + $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.FileHandle]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" + +Fcntl : [.lib]Fcntl.pm [.lib.auto.Fcntl]Fcntl$(E) + @ $(NOOP) + +[.lib]Fcntl.pm : [.ext.Fcntl]Descrip.MMS + @ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto] + @ Set Default [.ext.Fcntl] + $(MMS) + @ Set Default [--] + +[.lib.auto.Fcntl]Fcntl$(E) : [.ext.Fcntl]Descrip.MMS + @ Set Default [.ext.Fcntl] + $(MMS) + @ Set Default [--] + +# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir> +# ${@} necessary to distract different versions of MM[SK]/make +[.ext.Fcntl]Descrip.MMS : [.ext.Fcntl]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E) + $(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Fcntl]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" + +[.lib.VMS]Filespec.pm : [.vms.ext]Filespec.pm + @ If F$Search("[.lib]VMS.Dir").eqs."" Then Create/Directory [.lib.VMS] + Copy/Log/NoConfirm $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perldoc : [.utils]perldoc.PL $(ARCHDIR)Config.pm + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) $(MMS$SOURCE) + Copy/Log [.utils]perldoc $(MMS$TARGET) + +[.lib.ExtUtils]Miniperl.pm : Minimod.PL miniperlmain.c $(ARCHDIR)Config.pm + $(MINIPERL) $(MMS$SOURCE) >$(MMS$TARGET) + +[.utils]c2ph : [.utils]c2ph.PL $(ARCHDIR)Config.pm + $(MINIPERL) $(MMS$SOURCE) + +[.utils]h2ph : [.utils]h2ph.PL $(ARCHDIR)Config.pm + $(MINIPERL) $(MMS$SOURCE) + +[.utils]h2xs : [.utils]h2xs.PL $(ARCHDIR)Config.pm + $(MINIPERL) $(MMS$SOURCE) + +[.lib]perlbug : [.utils]perlbug.PL $(ARCHDIR)Config.pm + $(MINIPERL) $(MMS$SOURCE) + Rename/Log [.utils]perlbug $(MMS$TARGET) + +[.utils]pl2pm : [.utils]pl2pm.PL $(ARCHDIR)Config.pm + $(MINIPERL) $(MMS$SOURCE) + +[.lib.pod]pod2html : [.pod]pod2html.PL $(ARCHDIR)Config.pm + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) $(MMS$SOURCE) + Rename/Log [.pod]pod2html $(MMS$TARGET) + +[.lib.pod]pod2latex : [.pod]pod2latex.PL $(ARCHDIR)Config.pm + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) $(MMS$SOURCE) + Rename/Log [.pod]pod2latex $(MMS$TARGET) + +[.lib.pod]pod2man : [.pod]pod2man.PL $(ARCHDIR)Config.pm + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) $(MMS$SOURCE) + Rename/Log [.pod]pod2man $(MMS$TARGET) + +[.lib.pod]pod2text : [.pod]pod2text.PL $(ARCHDIR)Config.pm + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + $(MINIPERL) $(MMS$SOURCE) + Rename/Log [.pod]pod2text $(MMS$TARGET) + +preplibrary : $(MINIPERL_EXE) $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm $(SOCKPM) + @ Write Sys$Output "Autosplitting Perl library . . ." + @ Create/Directory [.lib.auto] + @ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]*.pm [.lib.*]*.pm + +[.lib.pod]perl.pod : [.pod]perl.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlbook.pod : [.pod]perlbook.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlbot.pod : [.pod]perlbot.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlcall.pod : [.pod]perlcall.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perldata.pod : [.pod]perldata.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perldebug.pod : [.pod]perldebug.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perldiag.pod : [.pod]perldiag.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perldsc.pod : [.pod]perldsc.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlembed.pod : [.pod]perlembed.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlform.pod : [.pod]perlform.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlfunc.pod : [.pod]perlfunc.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlguts.pod : [.pod]perlguts.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlipc.pod : [.pod]perlipc.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perllol.pod : [.pod]perllol.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlmod.pod : [.pod]perlmod.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlobj.pod : [.pod]perlobj.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlop.pod : [.pod]perlop.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlovl.pod : [.pod]perlovl.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlpod.pod : [.pod]perlpod.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlre.pod : [.pod]perlre.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlref.pod : [.pod]perlref.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlrun.pod : [.pod]perlrun.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlsec.pod : [.pod]perlsec.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlstyle.pod : [.pod]perlstyle.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlsub.pod : [.pod]perlsub.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlsyn.pod : [.pod]perlsyn.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perltie.pod : [.pod]perltie.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perltoc.pod : [.pod]perltoc.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perltrap.pod : [.pod]perltrap.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlvar.pod : [.pod]perlvar.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlxs.pod : [.pod]perlxs.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlxstut.pod : [.pod]perlxstut.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +[.lib.pod]perlvms.pod : [.vms]perlvms.pod + @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod] + @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +printconfig : + @ @[.vms]make_command $(MMS) $(MMSQUALIFIERS) $(MMSTARGETS) + @ @[.vms]myconfig "$(CC)" "$(CFLAGS)" "$(LINKFLAGS)" "$(LIBS1)" "$(LIBS2)" "$(SOCKLIB)" "$(EXT)" "$(DBG)" + +.ifdef SOCKET + +.ifdef LINK_ONLY +.else +$(SOCKOBJ) : $(SOCKC) $(SOCKH) + +[.ext.Socket]Socket$(O) : [.ext.Socket]Socket.c + $(CC) $(CFLAGS) /Object=$(MMS$TARGET) $(MMS$SOURCE) + +[.ext.Socket]Socket.c : [.ext.Socket]Socket.xs $(MINIPERL_EXE) + $(XSUBPP) $(MMS$SOURCE) >$(MMS$TARGET) +.endif # !LINK_ONLY + +vmsish.h : $(SOCKH) + +$(SOCKC) : [.vms]$(SOCKC) + Copy/Log/NoConfirm [.vms]$(SOCKC) []$(SOCKC) + +$(SOCKH) : [.vms]$(SOCKH) + Copy/Log/NoConfirm [.vms]$(SOCKH) []$(SOCKH) + +[.lib]Socket.pm : [.ext.Socket]Socket.pm + Copy/Log/NoConfirm $(MMS$SOURCE) $(MMS$TARGET) +.endif + +# 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 + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +perly.h : [.vms]perly_h.vms + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) + +# I now supply perly.c with the kits, so the following section is +# 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" +# \$(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 +# rename y.tab.h perly.h +# $(INSTPERL) [.vms]vms_yfix.pl perly.c perly.h [.vms]perly_c.vms [.vms]perly_h.vms + +.ifdef LINK_ONLY +.else +perly$(O) : perly.c, perly.h, $(h) + $(CC) $(CFLAGS) $(MMS$SOURCE) +.endif + +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 + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)INTERN.h : INTERN.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)XSUB.h : XSUB.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)av.h : av.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)config.h : config.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)cop.h : cop.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)cv.h : cv.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)embed.h : embed.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)form.h : form.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)gv.h : gv.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)handy.h : handy.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)hv.h : hv.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)keywords.h : keywords.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)mg.h : mg.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)op.h : op.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)opcode.h : opcode.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)patchlevel.h : patchlevel.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)perl.h : perl.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)perly.h : perly.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)pp.h : pp.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)proto.h : proto.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)regcomp.h : regcomp.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)regexp.h : regexp.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)scope.h : scope.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)sv.h : sv.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)util.h : util.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)vmsish.h : vmsish.h + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +.ifdef SOCKET +$(ARCHCORE)$(SOCKH) : $(SOCKH) + @ If F$Search("$(ARCHDIR)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 + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(MMS$SOURCE) $(MMS$TARGET) +$(ARCHCORE)perlshr_attr.opt : $(DBG)perlshr_xtras.ts + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log perlshr_attr.opt $(MMS$TARGET) +$(ARCHCORE)$(DBG)perlshr_bld.opt : $(DBG)perlshr_xtras.ts + @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE) + Copy/Log $(DBG)perlshr_bld.opt $(MMS$TARGET) +$(ARCHAUTO)time.stamp : + @ If F$Search("$(ARCHDIR)auto.dir").eqs."" Then Create/Directory $(ARCHAUTO) + @ If F$Search("$(MMS$TARGET)").eqs."" Then Copy/NoConfirm _NLA0: $(MMS$TARGET) + +.ifdef LINK_ONLY +.else +# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE +av$(O) : EXTERN.h +av$(O) : av.c +av$(O) : av.h +av$(O) : config.h +av$(O) : cop.h +av$(O) : cv.h +av$(O) : embed.h +av$(O) : form.h +av$(O) : gv.h +av$(O) : handy.h +av$(O) : hv.h +av$(O) : mg.h +av$(O) : op.h +av$(O) : opcode.h +av$(O) : perl.h +av$(O) : perly.h +av$(O) : pp.h +av$(O) : proto.h +av$(O) : regexp.h +av$(O) : scope.h +av$(O) : sv.h +av$(O) : vmsish.h +av$(O) : util.h +scope$(O) : EXTERN.h +scope$(O) : av.h +scope$(O) : config.h +scope$(O) : cop.h +scope$(O) : cv.h +scope$(O) : embed.h +scope$(O) : form.h +scope$(O) : gv.h +scope$(O) : handy.h +scope$(O) : hv.h +scope$(O) : mg.h +scope$(O) : op.h +scope$(O) : opcode.h +scope$(O) : perl.h +scope$(O) : perly.h +scope$(O) : pp.h +scope$(O) : proto.h +scope$(O) : regexp.h +scope$(O) : scope.c +scope$(O) : scope.h +scope$(O) : sv.h +scope$(O) : vmsish.h +scope$(O) : util.h +op$(O) : EXTERN.h +op$(O) : av.h +op$(O) : config.h +op$(O) : cop.h +op$(O) : cv.h +op$(O) : embed.h +op$(O) : form.h +op$(O) : gv.h +op$(O) : handy.h +op$(O) : hv.h +op$(O) : mg.h +op$(O) : op.c +op$(O) : op.h +op$(O) : opcode.h +op$(O) : perl.h +op$(O) : perly.h +op$(O) : pp.h +op$(O) : proto.h +op$(O) : regexp.h +op$(O) : scope.h +op$(O) : sv.h +op$(O) : vmsish.h +op$(O) : util.h +doop$(O) : EXTERN.h +doop$(O) : av.h +doop$(O) : config.h +doop$(O) : cop.h +doop$(O) : cv.h +doop$(O) : doop.c +doop$(O) : embed.h +doop$(O) : form.h +doop$(O) : gv.h +doop$(O) : handy.h +doop$(O) : hv.h +doop$(O) : mg.h +doop$(O) : op.h +doop$(O) : opcode.h +doop$(O) : perl.h +doop$(O) : perly.h +doop$(O) : pp.h +doop$(O) : proto.h +doop$(O) : regexp.h +doop$(O) : scope.h +doop$(O) : sv.h +doop$(O) : vmsish.h +doop$(O) : util.h +doio$(O) : EXTERN.h +doio$(O) : av.h +doio$(O) : config.h +doio$(O) : cop.h +doio$(O) : cv.h +doio$(O) : doio.c +doio$(O) : embed.h +doio$(O) : form.h +doio$(O) : gv.h +doio$(O) : handy.h +doio$(O) : hv.h +doio$(O) : mg.h +doio$(O) : op.h +doio$(O) : opcode.h +doio$(O) : perl.h +doio$(O) : perly.h +doio$(O) : pp.h +doio$(O) : proto.h +doio$(O) : regexp.h +doio$(O) : scope.h +doio$(O) : sv.h +doio$(O) : vmsish.h +doio$(O) : util.h +dump$(O) : EXTERN.h +dump$(O) : av.h +dump$(O) : config.h +dump$(O) : cop.h +dump$(O) : cv.h +dump$(O) : dump.c +dump$(O) : embed.h +dump$(O) : form.h +dump$(O) : gv.h +dump$(O) : handy.h +dump$(O) : hv.h +dump$(O) : mg.h +dump$(O) : op.h +dump$(O) : opcode.h +dump$(O) : perl.h +dump$(O) : perly.h +dump$(O) : pp.h +dump$(O) : proto.h +dump$(O) : regexp.h +dump$(O) : scope.h +dump$(O) : sv.h +dump$(O) : vmsish.h +dump$(O) : util.h +hv$(O) : EXTERN.h +hv$(O) : av.h +hv$(O) : config.h +hv$(O) : cop.h +hv$(O) : cv.h +hv$(O) : embed.h +hv$(O) : form.h +hv$(O) : gv.h +hv$(O) : handy.h +hv$(O) : hv.c +hv$(O) : hv.h +hv$(O) : mg.h +hv$(O) : op.h +hv$(O) : opcode.h +hv$(O) : perl.h +hv$(O) : perly.h +hv$(O) : pp.h +hv$(O) : proto.h +hv$(O) : regexp.h +hv$(O) : scope.h +hv$(O) : sv.h +hv$(O) : vmsish.h +hv$(O) : util.h +mg$(O) : EXTERN.h +mg$(O) : av.h +mg$(O) : config.h +mg$(O) : cop.h +mg$(O) : cv.h +mg$(O) : embed.h +mg$(O) : form.h +mg$(O) : gv.h +mg$(O) : handy.h +mg$(O) : hv.h +mg$(O) : mg.c +mg$(O) : mg.h +mg$(O) : op.h +mg$(O) : opcode.h +mg$(O) : perl.h +mg$(O) : perly.h +mg$(O) : pp.h +mg$(O) : proto.h +mg$(O) : regexp.h +mg$(O) : scope.h +mg$(O) : sv.h +mg$(O) : vmsish.h +mg$(O) : util.h +perl$(O) : EXTERN.h +perl$(O) : av.h +perl$(O) : config.h +perl$(O) : cop.h +perl$(O) : cv.h +perl$(O) : embed.h +perl$(O) : form.h +perl$(O) : gv.h +perl$(O) : handy.h +perl$(O) : hv.h +perl$(O) : mg.h +perl$(O) : op.h +perl$(O) : opcode.h +perl$(O) : perl.c +perl$(O) : perl.h +perl$(O) : perly.h +perl$(O) : pp.h +perl$(O) : proto.h +perl$(O) : regexp.h +perl$(O) : scope.h +perl$(O) : sv.h +perl$(O) : vmsish.h +perl$(O) : util.h +perly$(O) : EXTERN.h +perly$(O) : av.h +perly$(O) : config.h +perly$(O) : cop.h +perly$(O) : cv.h +perly$(O) : embed.h +perly$(O) : form.h +perly$(O) : gv.h +perly$(O) : handy.h +perly$(O) : hv.h +perly$(O) : mg.h +perly$(O) : op.h +perly$(O) : opcode.h +perly$(O) : perl.h +perly$(O) : perly.h +perly$(O) : perly.c +perly$(O) : pp.h +perly$(O) : proto.h +perly$(O) : regexp.h +perly$(O) : scope.h +perly$(O) : sv.h +perly$(O) : vmsish.h +perly$(O) : util.h +pp$(O) : EXTERN.h +pp$(O) : av.h +pp$(O) : config.h +pp$(O) : cop.h +pp$(O) : cv.h +pp$(O) : embed.h +pp$(O) : form.h +pp$(O) : gv.h +pp$(O) : handy.h +pp$(O) : hv.h +pp$(O) : mg.h +pp$(O) : op.h +pp$(O) : opcode.h +pp$(O) : perl.h +pp$(O) : perly.h +pp$(O) : pp.c +pp$(O) : pp.h +pp$(O) : proto.h +pp$(O) : regexp.h +pp$(O) : scope.h +pp$(O) : sv.h +pp$(O) : vmsish.h +pp$(O) : util.h +pp_ctl$(O) : EXTERN.h +pp_ctl$(O) : av.h +pp_ctl$(O) : config.h +pp_ctl$(O) : cop.h +pp_ctl$(O) : cv.h +pp_ctl$(O) : embed.h +pp_ctl$(O) : form.h +pp_ctl$(O) : gv.h +pp_ctl$(O) : handy.h +pp_ctl$(O) : hv.h +pp_ctl$(O) : mg.h +pp_ctl$(O) : op.h +pp_ctl$(O) : opcode.h +pp_ctl$(O) : perl.h +pp_ctl$(O) : perly.h +pp_ctl$(O) : pp_ctl.c +pp_ctl$(O) : pp.h +pp_ctl$(O) : proto.h +pp_ctl$(O) : regexp.h +pp_ctl$(O) : scope.h +pp_ctl$(O) : sv.h +pp_ctl$(O) : vmsish.h +pp_ctl$(O) : util.h +pp_hot$(O) : EXTERN.h +pp_hot$(O) : av.h +pp_hot$(O) : config.h +pp_hot$(O) : cop.h +pp_hot$(O) : cv.h +pp_hot$(O) : embed.h +pp_hot$(O) : form.h +pp_hot$(O) : gv.h +pp_hot$(O) : handy.h +pp_hot$(O) : hv.h +pp_hot$(O) : mg.h +pp_hot$(O) : op.h +pp_hot$(O) : opcode.h +pp_hot$(O) : perl.h +pp_hot$(O) : perly.h +pp_hot$(O) : pp_hot.c +pp_hot$(O) : pp.h +pp_hot$(O) : proto.h +pp_hot$(O) : regexp.h +pp_hot$(O) : scope.h +pp_hot$(O) : sv.h +pp_hot$(O) : vmsish.h +pp_hot$(O) : util.h +pp_sys$(O) : EXTERN.h +pp_sys$(O) : av.h +pp_sys$(O) : config.h +pp_sys$(O) : cop.h +pp_sys$(O) : cv.h +pp_sys$(O) : embed.h +pp_sys$(O) : form.h +pp_sys$(O) : gv.h +pp_sys$(O) : handy.h +pp_sys$(O) : hv.h +pp_sys$(O) : mg.h +pp_sys$(O) : op.h +pp_sys$(O) : opcode.h +pp_sys$(O) : perl.h +pp_sys$(O) : perly.h +pp_sys$(O) : pp_sys.c +pp_sys$(O) : pp.h +pp_sys$(O) : proto.h +pp_sys$(O) : regexp.h +pp_sys$(O) : scope.h +pp_sys$(O) : sv.h +pp_sys$(O) : vmsish.h +pp_sys$(O) : util.h +regcomp$(O) : EXTERN.h +regcomp$(O) : INTERN.h +regcomp$(O) : av.h +regcomp$(O) : config.h +regcomp$(O) : cop.h +regcomp$(O) : cv.h +regcomp$(O) : embed.h +regcomp$(O) : form.h +regcomp$(O) : gv.h +regcomp$(O) : handy.h +regcomp$(O) : hv.h +regcomp$(O) : mg.h +regcomp$(O) : op.h +regcomp$(O) : opcode.h +regcomp$(O) : perl.h +regcomp$(O) : perly.h +regcomp$(O) : pp.h +regcomp$(O) : proto.h +regcomp$(O) : regcomp.c +regcomp$(O) : regcomp.h +regcomp$(O) : regexp.h +regcomp$(O) : scope.h +regcomp$(O) : sv.h +regcomp$(O) : vmsish.h +regcomp$(O) : util.h +regexec$(O) : EXTERN.h +regexec$(O) : av.h +regexec$(O) : config.h +regexec$(O) : cop.h +regexec$(O) : cv.h +regexec$(O) : embed.h +regexec$(O) : form.h +regexec$(O) : gv.h +regexec$(O) : handy.h +regexec$(O) : hv.h +regexec$(O) : mg.h +regexec$(O) : op.h +regexec$(O) : opcode.h +regexec$(O) : perl.h +regexec$(O) : perly.h +regexec$(O) : pp.h +regexec$(O) : proto.h +regexec$(O) : regcomp.h +regexec$(O) : regexec.c +regexec$(O) : regexp.h +regexec$(O) : scope.h +regexec$(O) : sv.h +regexec$(O) : vmsish.h +regexec$(O) : util.h +gv$(O) : EXTERN.h +gv$(O) : av.h +gv$(O) : config.h +gv$(O) : cop.h +gv$(O) : cv.h +gv$(O) : embed.h +gv$(O) : form.h +gv$(O) : gv.c +gv$(O) : gv.h +gv$(O) : handy.h +gv$(O) : hv.h +gv$(O) : mg.h +gv$(O) : op.h +gv$(O) : opcode.h +gv$(O) : perl.h +gv$(O) : perly.h +gv$(O) : pp.h +gv$(O) : proto.h +gv$(O) : regexp.h +gv$(O) : scope.h +gv$(O) : sv.h +gv$(O) : vmsish.h +gv$(O) : util.h +sv$(O) : EXTERN.h +sv$(O) : av.h +sv$(O) : config.h +sv$(O) : cop.h +sv$(O) : cv.h +sv$(O) : embed.h +sv$(O) : form.h +sv$(O) : gv.h +sv$(O) : handy.h +sv$(O) : hv.h +sv$(O) : mg.h +sv$(O) : op.h +sv$(O) : opcode.h +sv$(O) : perl.h +sv$(O) : perly.h +sv$(O) : pp.h +sv$(O) : proto.h +sv$(O) : regexp.h +sv$(O) : scope.h +sv$(O) : sv.c +sv$(O) : sv.h +sv$(O) : vmsish.h +sv$(O) : util.h +taint$(O) : EXTERN.h +taint$(O) : av.h +taint$(O) : config.h +taint$(O) : cop.h +taint$(O) : cv.h +taint$(O) : embed.h +taint$(O) : form.h +taint$(O) : gv.h +taint$(O) : handy.h +taint$(O) : hv.h +taint$(O) : mg.h +taint$(O) : op.h +taint$(O) : opcode.h +taint$(O) : perl.h +taint$(O) : perly.h +taint$(O) : pp.h +taint$(O) : proto.h +taint$(O) : regexp.h +taint$(O) : scope.h +taint$(O) : sv.h +taint$(O) : taint.c +taint$(O) : vmsish.h +taint$(O) : util.h +toke$(O) : EXTERN.h +toke$(O) : av.h +toke$(O) : config.h +toke$(O) : cop.h +toke$(O) : cv.h +toke$(O) : embed.h +toke$(O) : form.h +toke$(O) : gv.h +toke$(O) : handy.h +toke$(O) : hv.h +toke$(O) : keywords.h +toke$(O) : mg.h +toke$(O) : op.h +toke$(O) : opcode.h +toke$(O) : perl.h +toke$(O) : perly.h +toke$(O) : pp.h +toke$(O) : proto.h +toke$(O) : regexp.h +toke$(O) : scope.h +toke$(O) : sv.h +toke$(O) : toke.c +toke$(O) : vmsish.h +toke$(O) : util.h +util$(O) : EXTERN.h +util$(O) : av.h +util$(O) : config.h +util$(O) : cop.h +util$(O) : cv.h +util$(O) : embed.h +util$(O) : form.h +util$(O) : gv.h +util$(O) : handy.h +util$(O) : hv.h +util$(O) : mg.h +util$(O) : op.h +util$(O) : opcode.h +util$(O) : perl.h +util$(O) : perly.h +util$(O) : pp.h +util$(O) : proto.h +util$(O) : regexp.h +util$(O) : scope.h +util$(O) : sv.h +util$(O) : vmsish.h +util$(O) : util.c +util$(O) : util.h +deb$(O) : EXTERN.h +deb$(O) : av.h +deb$(O) : config.h +deb$(O) : cop.h +deb$(O) : cv.h +deb$(O) : deb.c +deb$(O) : embed.h +deb$(O) : form.h +deb$(O) : gv.h +deb$(O) : handy.h +deb$(O) : hv.h +deb$(O) : mg.h +deb$(O) : op.h +deb$(O) : opcode.h +deb$(O) : perl.h +deb$(O) : perly.h +deb$(O) : pp.h +deb$(O) : proto.h +deb$(O) : regexp.h +deb$(O) : scope.h +deb$(O) : sv.h +deb$(O) : vmsish.h +deb$(O) : util.h +run$(O) : EXTERN.h +run$(O) : av.h +run$(O) : config.h +run$(O) : cop.h +run$(O) : cv.h +run$(O) : embed.h +run$(O) : form.h +run$(O) : gv.h +run$(O) : handy.h +run$(O) : hv.h +run$(O) : mg.h +run$(O) : op.h +run$(O) : opcode.h +run$(O) : perl.h +run$(O) : perly.h +run$(O) : pp.h +run$(O) : proto.h +run$(O) : regexp.h +run$(O) : run.c +run$(O) : scope.h +run$(O) : sv.h +run$(O) : vmsish.h +run$(O) : util.h +vms$(O) : EXTERN.h +vms$(O) : av.h +vms$(O) : config.h +vms$(O) : cop.h +vms$(O) : cv.h +vms$(O) : embed.h +vms$(O) : form.h +vms$(O) : gv.h +vms$(O) : handy.h +vms$(O) : hv.h +vms$(O) : mg.h +vms$(O) : op.h +vms$(O) : opcode.h +vms$(O) : perl.h +vms$(O) : perly.h +vms$(O) : pp.h +vms$(O) : proto.h +vms$(O) : regexp.h +vms$(O) : vms.c +vms$(O) : scope.h +vms$(O) : sv.h +vms$(O) : vmsish.h +vms$(O) : util.h +miniperlmain$(O) : EXTERN.h +miniperlmain$(O) : av.h +miniperlmain$(O) : config.h +miniperlmain$(O) : cop.h +miniperlmain$(O) : cv.h +miniperlmain$(O) : embed.h +miniperlmain$(O) : form.h +miniperlmain$(O) : gv.h +miniperlmain$(O) : handy.h +miniperlmain$(O) : hv.h +miniperlmain$(O) : mg.h +miniperlmain$(O) : miniperlmain.c +miniperlmain$(O) : op.h +miniperlmain$(O) : opcode.h +miniperlmain$(O) : perl.h +miniperlmain$(O) : perly.h +miniperlmain$(O) : pp.h +miniperlmain$(O) : proto.h +miniperlmain$(O) : regexp.h +miniperlmain$(O) : scope.h +miniperlmain$(O) : sv.h +miniperlmain$(O) : vmsish.h +miniperlmain$(O) : util.h +perlmain$(O) : EXTERN.h +perlmain$(O) : av.h +perlmain$(O) : config.h +perlmain$(O) : cop.h +perlmain$(O) : cv.h +perlmain$(O) : embed.h +perlmain$(O) : form.h +perlmain$(O) : gv.h +perlmain$(O) : handy.h +perlmain$(O) : hv.h +perlmain$(O) : mg.h +perlmain$(O) : op.h +perlmain$(O) : opcode.h +perlmain$(O) : perl.h +perlmain$(O) : perly.h +perlmain$(O) : perlmain.c +perlmain$(O) : pp.h +perlmain$(O) : proto.h +perlmain$(O) : regexp.h +perlmain$(O) : scope.h +perlmain$(O) : sv.h +perlmain$(O) : vmsish.h +perlmain$(O) : util.h +globals$(O) : INTERN.h +globals$(O) : av.h +globals$(O) : config.h +globals$(O) : cop.h +globals$(O) : cv.h +globals$(O) : embed.h +globals$(O) : form.h +globals$(O) : gv.h +globals$(O) : handy.h +globals$(O) : hv.h +globals$(O) : mg.h +globals$(O) : op.h +globals$(O) : opcode.h +globals$(O) : perl.h +globals$(O) : perly.h +globals$(O) : globals.c +globals$(O) : pp.h +globals$(O) : proto.h +globals$(O) : regexp.h +globals$(O) : scope.h +globals$(O) : sv.h +globals$(O) : vmsish.h +globals$(O) : util.h +.endif # !LINK_ONLY + +config.h : [.vms]config.vms + Copy/Log/NoConfirm [.vms]config.vms []config.h + +vmsish.h : [.vms]vmsish.h + Copy/Log/NoConfirm [.vms]vmsish.h []vmsish.h + +vms.c : [.vms]vms.c + Copy/Log/Noconfirm [.vms]vms.c [] + +$(CRTL) : $(MAKEFILE) + @ @[.vms]genopt "$(CRTL)/Write" "|" "$(LIBS1)|$(LIBS2)|$(SOCKLIB)" + + +cleanlis : + - If F$Search("*.Lis").nes."" Then Delete/NoConfirm/Log *.Lis;* + - If F$Search("*.CPP").nes."" Then Delete/NoConfirm/Log *.CPP;* + - If F$Search("*.Map").nes."" Then Delete/NoConfirm/Log *.Map;* + +tidy : cleanlis + - If F$Search("*.Opt;-1").nes."" Then Purge/NoConfirm/Log *.Opt + - If F$Search("*$(O);-1").nes."" Then Purge/NoConfirm/Log *$(O) + - If F$Search("*$(E);-1").nes."" Then Purge/NoConfirm/Log *$(E) + - If F$Search("Config.H;-1").nes."" Then Purge/NoConfirm/Log Config.H + - If F$Search("Config.SH;-1").nes."" Then Purge/NoConfirm/Log Config.SH + - If F$Search("perly.c;-1").nes."" Then Purge/NoConfirm/Log perly.c + - If F$Search("perly.h;-1").nes."" Then Purge/NoConfirm/Log perly.h + - If F$Search("VMSish.H;-1").nes."" Then Purge/NoConfirm/Log VMSish.H + - If F$Search("VMS.C;-1") .nes."" Then Purge/NoConfirm/Log VMS.C + - If F$Search("Perlmain.C;-1") .nes."" Then Purge/NoConfirm/Log Perlmain.C + - If F$Search("Perlshr_Gbl*.Mar;-1") .nes."" Then Purge/NoConfirm/Log Perlshr_Gbl*.Mar + - If F$Search("[.Ext.DynaLoader]DL_VMS$(O);-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS$(O) + - If F$Search("[.Ext.DynaLoader]DL_VMS.C;-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS.C + - If F$Search("[.Ext.Safe...];-1").nes."" Then Purge/NoConfirm/Log [.Ext.Safe] + - If F$Search("[.Ext.FileHandle...];-1").nes."" Then Purge/NoConfirm/Log [.Ext.FileHandle] + - If F$Search("[.VMS.Ext...]*.C;-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*.C + - If F$Search("[.VMS.Ext...]*$(O);-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*$(O) + - 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("$(ARCHDIR)Config.pm;-1").nes."" Then Purge/NoConfirm/Log $(ARCHDIR)Config.pm + - If F$Search("[.Lib.VMS]*.*;-1").nes."" Then Purge/NoConfirm/Log [.Lib.VMS]*.* + - If F$Search("[.Lib.Pod]*.Pod;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Pod]*.Pod + - If F$Search("$(ARCHCORE)*.*").nes."" Then Purge/NoConfirm/Log $(ARCHCORE)*.* + - If F$Search("[.utils]*.;-1").nes."" Then Purge/NoConfirm/Log [.utils]*. + - If F$Search("[.lib.pod]*.;-1").nes."" Then Purge/NoConfirm/Log [.lib.pod]*. + +clean : tidy + Set Default [.ext.Fcntl] + - $(MMS) clean + Set Default [--] + Set Default [.ext.FileHandle] + - $(MMS) clean + Set Default [--] + Set Default [.ext.Safe] + - $(MMS) clean + Set Default [--] + - If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_*.Opt + - If F$Search("*$(O);*") .nes."" Then Delete/NoConfirm/Log *$(O);* + - If F$Search("Config.H").nes."" Then Delete/NoConfirm/Log Config.H;* + - If F$Search("Config.SH").nes."" Then Delete/NoConfirm/Log Config.SH;* + - If F$Search(F$Parse("Sys$Disk:[]","$(SOCKH)")).nes."" Then Delete/NoConfirm/Log $(SOCKH);* + - If F$Search(F$Parse("Sys$Disk:[]","$(SOCKC)")).nes."" Then Delete/NoConfirm/Log $(SOCKC);* + - If F$Search("perly.c").nes."" Then Delete/NoConfirm/Log perly.c;* + - If F$Search("perly.h").nes."" Then Delete/NoConfirm/Log perly.h;* + - If F$Search("VMSish.H").nes."" Then Delete/NoConfirm/Log VMSish.H;* + - If F$Search("VMS.C") .nes."" Then Delete/NoConfirm/Log VMS.C;* + - If F$Search("Perlmain.C") .nes."" Then Delete/NoConfirm/Log Perlmain.C;* + - If F$Search("Perlshr_Gbl*.Mar") .nes."" Then Delete/NoConfirm/Log Perlshr_Gbl*.Mar;* + - If F$Search("*.TS").nes."" Then Delete/NoConfirm/Log *.TS;* + - If F$Search("[.Ext.DynaLoader]DL_VMS$(O)").nes."" Then Delete/NoConfirm/Log [.Ext.DynaLoader]DL_VMS$(O);* + - If F$Search("[.Ext.DynaLoader]DL_VMS.C").nes."" Then Delete/NoConfirm/Log [.Ext.DynaLoader]DL_VMS.C;* + - If F$Search("[.Ext.Socket]Socket$(O)").nes."" Then Delete/NoConfirm/Log [.Ext.Socket]Socket$(O);* + - If F$Search("[.Ext.Socket]Socket.C").nes."" Then Delete/NoConfirm/Log [.Ext.Socket]Socket.C;* + - If F$Search("[.VMS.Ext...]*.C").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*.C;* + - If F$Search("[.VMS.Ext...]*$(O)").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*$(O);* + +realclean : clean + Set Default [.ext.Fcntl] + - $(MMS) realclean + Set Default [--] + Set Default [.ext.FileHandle] + - $(MMS) realclean + Set Default [--] + Set Default [.ext.Safe] + - $(MMS) realclean + Set Default [--] + - If F$Search("*$(OLB)").nes."" Then Delete/NoConfirm/Log *$(OLB);* + - If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;* + - $(MINIPERL) -e "use File::Path; rmtree(['lib/auto','lib/VMS','lib/$(ARCH)'],1,0);" + - If F$Search("[.Lib]DynaLoader.pm").nes."" Then Delete/NoConfirm/Log [.Lib]DynaLoader.pm;* + - If F$Search("[.Lib]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib]Config.pm;* + - If F$Search("[.Lib]perlbug.").nes."" Then Delete/NoConfirm/Log [.Lib]perlbug.;* + - If F$Search("$(ARCHDIR)Config.pm").nes."" Then Delete/NoConfirm/Log $(ARCHDIR)Config.pm;* + - If F$Search("[.lib.ExtUtils]Miniperl.pm").nes."" Then Delete/NoConfirm/Log [.lib.ExtUtils]Miniperl.pm;* + - If F$Search("[.utils]*.").nes."" Then Delete/NoConfirm/Log [.utils]*.;* + - If F$Search("[.lib.pod]*.pod").nes."" Then Delete/NoConfirm/Log [.lib.pod]*.pod;* + - If F$Search("[.lib.pod]perldoc.").nes."" Then Delete/NoConfirm/Log [.lib.pod]perldoc.;* + - If F$Search("[.lib.pod]pod2*.").nes."" Then Delete/NoConfirm/Log [.lib.pod]pod2*.;* + - If F$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);* + +cleansrc : clean + - If F$Search("*.C;-1").nes."" Then Purge/NoConfirm/Log *.C + - If F$Search("*.H;-1").nes."" Then Purge/NoConfirm/Log *.H + - If F$Search("*.VMS;-1").nes."" Then Purge/NoConfirm/Log *.VMS + - If F$Search("[.VMS]$(MAKEFILE);-1").nes."" Then Purge/NoConfirm/Log [.VMS]$(MAKEFILE) + - If F$Search("[.VMS]*.C;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.C + - If F$Search("[.VMS]*.H;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.H + - If F$Search("[.VMS]*.Pl;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.Pl + - 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 diff --git a/gnu/usr.bin/perl/vms/ext/Filespec.pm b/gnu/usr.bin/perl/vms/ext/Filespec.pm new file mode 100644 index 00000000000..3ce67aafdab --- /dev/null +++ b/gnu/usr.bin/perl/vms/ext/Filespec.pm @@ -0,0 +1,338 @@ +# Perl hooks into the routines in vms.c for interconversion +# of VMS and Unix file specification syntax. +# +# Version: 1.1 +# Author: Charles Bailey bailey@genetics.upenn.edu +# Revised: 08-Mar-1995 + +=head1 NAME + +VMS::Filespec - convert between VMS and Unix file specification syntax + +=head1 SYNOPSIS + +use VMS::Filespec; +$vmsspec = vmsify('/my/Unix/file/specification'); +$unixspec = unixify('my:[VMS]file.specification'); +$path = pathify('my:[VMS.or.Unix.directory]specification.dir'); +$dirfile = fileify('my:[VMS.or.Unix.directory.specification]'); +$vmsdir = vmspath('my/VMS/or/Unix/directory/specification.dir'); +$unixdir = unixpath('my:[VMS.or.Unix.directory]specification.dir'); +candelete('my:[VMS.or.Unix]file.specification'); + +=head1 DESCRIPTION + +This package provides routines to simplify conversion between VMS and +Unix syntax when processing file specifications. This is useful when +porting scripts designed to run under either OS, and also allows you +to take advantage of conveniences provided by either syntax (I<e.g.> +ability to easily concatenate Unix-style specifications). In +addition, it provides an additional file test routine, C<candelete>, +which determines whether you have delete access to a file. + +If you're running under VMS, the routines in this package are special, +in that they're automatically made available to any Perl script, +whether you're running F<miniperl> or the full F<perl>. The C<use +VMS::Filespec> or C<require VMS::Filespec; import VMS::Filespec ...> +statement can be used to import the function names into the current +package, but they're always available if you use the fully qualified +name, whether or not you've mentioned the F<.pm> file in your script. +If you're running under another OS and have installed this package, it +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, or C<undef> +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 +service to expand specifications, so illegal syntax, or a relative +directory specification which extends above the tope of the current +directory path (e.g [---.foo] when in dev:[dir.sub]) will cause +errors. In general, any legal file specification will be converted +properly, but garbage input tends to produce garbage output. + +Each of these routines is prototyped as taking a single scalar +argument, so you can use them as unary operators in complex +expressions (as long as you don't use the C<&> form of +subroutine call, which bypasses prototype checking). + + +The routines provided are: + +=head2 vmsify + +Converts a file specification to VMS syntax. + +=head2 unixify + +Converts a file specification to Unix syntax. + +=head2 pathify + +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 + +Converts a directory specification to the file specification of the +directory file - that is, a string you can pass to functions like +C<stat> or C<rmdir> to manipulate the directory file. If the +input directory specification uses VMS syntax, the returned file +specification does, too; likewise for Unix syntax. As with +C<pathify>, the input file specification must have a type and +version of F<.DIR;1>, or the type and version must be omitted. + +=head2 vmspath + +Acts like C<pathify>, but insures the returned path uses VMS syntax. + +=head2 unixpath + +Acts like C<pathify>, but insures the returned path uses Unix syntax. + +=head2 candelete + +Determines whether you have delete access to a file. If you do, C<candelete> +returns true. If you don't, or its argument isn't a legal file specification, +C<candelete> returns FALSE. Unlike other file tests, the argument to +C<candelete> must be a file name (not a FileHandle), and, since it's an XSUB, +it's a list operator, so you need to be careful about parentheses. Both of +these restrictions may be removed in the future if the functionality of +C<candelete> becomes part of the Perl core. + +=head1 REVISION + +This document was last revised 22-Feb-1996, for Perl 5.002. + +=cut + +package VMS::Filespec; +require 5.002; + + +# 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( &vmsify &unixify &pathify &fileify + &vmspath &unixpath &candelete); + +@EXPORT_OK = qw( &rmsexpand ); +1; + + +__END__ + + +# The autosplit routines here are provided for use by non-VMS systems +# They are not guaranteed to function identically to the XSUBs of the +# same name, since they do not have access to the RMS system routine +# sys$parse() (in particular, no real provision is made for handling +# of complex DECnet node specifications). However, these routines +# should be adequate for most purposes. + +# A sort-of sys$parse() replacement +sub rmsexpand { + my($fspec,$defaults) = @_; + if (!$fspec) { return undef } + my($node,$dev,$dir,$name,$type,$ver,$dnode,$ddev,$ddir,$dname,$dtype,$dver); + + $fspec =~ s/:$//; + $defaults = [] unless $defaults; + $defaults = [ $defaults ] unless ref($defaults) && ref($defaults) eq 'ARRAY'; + + while ($fspec !~ m#[:>\]]# && $ENV{$fspec}) { $fspec = $ENV{$fspec} } + + if ($fspec =~ /:/) { + my($dev,$devtrn,$base); + ($dev,$base) = split(/:/,$fspec); + $devtrn = $dev; + while ($devtrn = $ENV{$devtrn}) { + if ($devtrn =~ /(.)([:>\]])$/) { + $dev .= ':', last if $1 eq '.'; + $dev = $devtrn, last; + } + } + $fspec = $dev . $base; + } + + ($node,$dev,$dir,$name,$type,$ver) = $fspec =~ + /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/; + foreach ((@$defaults,$ENV{'DEFAULT'})) { + last if $node && $ver && $type && $dev && $dir && $name; + ($dnode,$ddev,$ddir,$dname,$dtype,$dver) = + /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/; + $node = $dnode if $dnode && !$node; + $dev = $ddev if $ddev && !$dev; + $dir = $ddir if $ddir && !$dir; + $name = $dname if $dname && !$name; + $type = $dtype if $dtype && !$type; + $ver = $dver if $dver && !$ver; + } + # do this the long way to keep -w happy + $fspec = ''; + $fspec .= $node if $node; + $fspec .= $dev if $dev; + $fspec .= $dir if $dir; + $fspec .= $name if $name; + $fspec .= $type if $type; + $fspec .= $ver if $ver; + $fspec; +} + +sub vmsify ($) { + my($fspec) = @_; + my($hasdev,$dev,$defdirs,$dir,$base,@dirs,@realdirs); + + if ($fspec =~ m#^\.(\.?)/?$#) { return $1 ? '[-]' : '[]'; } + return $fspec if $fspec !~ m#/#; + ($hasdev,$dir,$base) = $fspec =~ m#(/?)(.*)/(.*)#; + @dirs = split(m#/#,$dir); + if ($base eq '.') { $base = ''; } + elsif ($base eq '..') { + push @dirs,$base; + $base = ''; + } + foreach (@dirs) { + next unless $_; # protect against // in input + next if $_ eq '.'; + if ($_ eq '..') { + if (@realdirs && $realdirs[$#realdirs] ne '-') { pop @realdirs } + else { push @realdirs, '-' } + } + else { push @realdirs, $_; } + } + if ($hasdev) { + $dev = shift @realdirs; + @realdirs = ('000000') unless @realdirs; + $base = '' unless $base; # keep -w happy + $dev . ':[' . join('.',@realdirs) . "]$base"; + } + else { + '[' . join('',map($_ eq '-' ? $_ : ".$_",@realdirs)) . "]$base"; + } +} + +sub unixify ($) { + my($fspec) = @_; + + return $fspec if $fspec !~ m#[:>\]]#; + return '.' if ($fspec eq '[]' || $fspec eq '<>'); + if ($fspec =~ m#^[<\[](\.|-+)(.*)# ) { + $fspec = ($1 eq '.' ? '' : "$1.") . $2; + my($dir,$base) = split(/[\]>]/,$fspec); + my(@dirs) = grep($_,split(m#\.#,$dir)); + if ($dirs[0] =~ /^-/) { + my($steps) = shift @dirs; + for (1..length($steps)) { unshift @dirs, '..'; } + } + join('/',@dirs) . "/$base"; + } + else { + $fspec = rmsexpand($fspec,'_N_O_T_:[_R_E_A_L_]'); + $fspec =~ s/.*_N_O_T_:(?:\[_R_E_A_L_\])?//; + my($dev,$dir,$base) = $fspec =~ m#([^:<\[]*):?[<\[](.*)[>\]](.*)#; + my(@dirs) = split(m#\.#,$dir); + if ($dirs[0] && $dirs[0] =~ /^-/) { + my($steps) = shift @dirs; + for (1..length($steps)) { unshift @dirs, '..'; } + } + "/$dev/" . join('/',@dirs) . "/$base"; + } +} + + +sub fileify ($) { + my($path) = @_; + + if (!$path) { return undef } + if ($path =~ /(.+)\.([^:>\]]*)$/) { + $path = $1; + if ($2 !~ /^dir(?:;1)?$/i) { return undef } + } + + if ($path !~ m#[/>\]]#) { + $path =~ s/:$//; + while ($ENV{$path}) { + ($path = $ENV{$path}) =~ s/:$//; + last if $path =~ m#[/>\]]#; + } + } + if ($path =~ m#[>\]]#) { + my($dir,$sep,$base) = $path =~ /(.*)([>\]])(.*)/; + $sep =~ tr/<[/>]/; + if ($base) { + "$dir$sep$base.dir;1"; + } + else { + if ($dir !~ /\./) { $dir =~ s/([<\[])/${1}000000./; } + $dir =~ s#\.(\w+)$#$sep$1#; + $dir =~ s/^.$sep//; + "$dir.dir;1"; + } + } + else { + $path =~ s#/$##; + "$path.dir;1"; + } +} + +sub pathify ($) { + my($fspec) = @_; + + if (!$fspec) { return undef } + if ($fspec =~ m#[/>\]]$#) { return $fspec; } + if ($fspec =~ m#(.+)\.([^/>\]]*)$# && $2 && $2 ne '.') { + $fspec = $1; + if ($2 !~ /^dir(?:;1)?$/i) { return undef } + } + + if ($fspec !~ m#[/>\]]#) { + $fspec =~ s/:$//; + while ($ENV{$fspec}) { + if ($ENV{$fspec} =~ m#[>\]]$#) { return $ENV{$fspec} } + else { $fspec = $ENV{$fspec} =~ s/:$// } + } + } + + if ($fspec !~ m#[>\]]#) { "$fspec/"; } + else { + if ($fspec =~ /([^>\]]+)([>\]])(.+)/) { "$1.$3$2"; } + else { $fspec; } + } +} + +sub vmspath ($) { + pathify(vmsify($_[0])); +} + +sub unixpath ($) { + pathify(unixify($_[0])); +} + +sub candelete ($) { + my($fspec) = @_; + my($parent); + + return '' unless -w $fspec; + $fspec =~ s#/$##; + if ($fspec =~ m#/#) { + ($parent = $fspec) =~ s#/[^/]+$#; + return (-w $parent); + } + elsif ($parent = fileify($fspec)) { # fileify() here to expand lnms + $parent =~ s/[>\]][^>\]]+//; + return (-w fileify($parent)); + } + else { return (-w '[-]'); } +} diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/0README.txt b/gnu/usr.bin/perl/vms/ext/Stdio/0README.txt new file mode 100644 index 00000000000..28f82b3a145 --- /dev/null +++ b/gnu/usr.bin/perl/vms/ext/Stdio/0README.txt @@ -0,0 +1,47 @@ +This directory contains the source code for the Perl extension +VMS::Stdio, which provides access from Perl to VMS-specific +stdio functions. For more specific documentation of its +function, please see the pod section of Stdio.pm. + + *** Please Note *** + +This package is the direct descendant of VMS::stdio, but as of Perl +5.002, the name has been changed to VMS::Stdio, in order to conform +to the Perl naming convention that extensions whose name begins +with a lowercase letter represent compile-time "pragmas", while +extensions which provide added functionality have names whose parts +begin with uppercase letters. In addition, the functions +vmsfopen and fgetname have been renamed vmsopen and getname, +respectively, in order to more closely resemble related Perl +I/O operators, which do not retain the 'f' from corresponding +C routine names. + +A transitional interface to the old routine names has been +provided, so that calls to these routines will generate a +warning, and be routed to the corresponding VMS::Stdio +routine. This interface will be removed in a future release, +so please update your code to use the new names. + + +===> Installation + +This extension, like most Perl extensions, should be installed +by copying the files in this directory to a location *outside* +the Perl distribution tree, and then saying + + $ perl Makefile.PL ! Build Descrip.MMS for this extension + $ MMK ! Build the extension + $ MMK test ! Run its regression tests + $ MMK install ! Install required files in public Perl tree + + +===> Revision History + +1.0 29-Nov-1994 Charles Bailey bailey@genetics.upenn.edu + original version - vmsfopen +1.1 09-Mar-1995 Charles Bailey bailey@genetics.upenn.edu + changed calling sequence to return FH/undef - like POSIX::open + added fgetname and tmpnam +2.0 28-Feb-1996 Charles Bailey bailey@genetics.upenn.edu + major rewrite for Perl 5.002: name changed to VMS::Stdio, + new functions added, and prototypes incorporated diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/Makefile.PL b/gnu/usr.bin/perl/vms/ext/Stdio/Makefile.PL new file mode 100644 index 00000000000..e5ea988818b --- /dev/null +++ b/gnu/usr.bin/perl/vms/ext/Stdio/Makefile.PL @@ -0,0 +1,3 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( 'VERSION_FROM' => 'Stdio.pm' ); diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm new file mode 100644 index 00000000000..f87631a32aa --- /dev/null +++ b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm @@ -0,0 +1,235 @@ +# VMS::Stdio - VMS extensions to Perl's stdio calls +# +# Author: Charles Bailey bailey@genetics.upenn.edu +# Version: 2.0 +# Revised: 28-Feb-1996 + +package VMS::Stdio; + +require 5.002; +use vars qw( $VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS @ISA ); +use Carp '&croak'; +use DynaLoader (); +use Exporter (); + +$VERSION = '2.0'; +@ISA = qw( Exporter DynaLoader FileHandle ); +@EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL &O_NDELAY &O_NOWAIT + &O_RDONLY &O_RDWR &O_TRUNC &O_WRONLY ); +@EXPORT_OK = qw( &flush &getname &remove &rewind &sync &tmpnam + &vmsopen &vmssysopen &waitfh ); +%EXPORT_TAGS = ( CONSTANTS => [ qw( &O_APPEND &O_CREAT &O_EXCL &O_NDELAY + &O_NOWAIT &O_RDONLY &O_RDWR &O_TRUNC + &O_WRONLY ) ], + FUNCTIONS => [ qw( &flush &getname &remove &rewind &sync + &tmpnam &vmsopen &vmssysopen &waitfh ) ] ); + +bootstrap VMS::Stdio $VERSION; + +sub AUTOLOAD { + my($constname) = $AUTOLOAD; + $constname =~ s/.*:://; + if ($constname =~ /^O_/) { + my($val) = constant($constname); + defined $val or croak("Unknown VMS::Stdio constant $constname"); + *$AUTOLOAD = sub { $val }; + } + else { # We don't know about it; hand off to FileHandle + require FileHandle; + my($obj) = shift(@_); + $obj->FileHandle::$constname(@_); + } + goto &$AUTOLOAD; +} + +sub DESTROY { close($_[0]); } + + +################################################################################ +# Intercept calls to old VMS::stdio package, complain, and hand off +# This will be removed in a future version of VMS::Stdio + +package VMS::stdio; + +sub AUTOLOAD { + my($func) = $AUTOLOAD; + $func =~ s/.*:://; + # Cheap trick: we know DynaLoader has required Carp.pm + Carp::carp("Old package VMS::stdio is now VMS::Stdio; please update your code"); + if ($func eq 'vmsfopen') { + Carp::carp("Old function &vmsfopen is now &vmsopen"); + goto &VMS::Stdio::vmsopen; + } + elsif ($func eq 'fgetname') { + Carp::carp("Old function &fgetname is now &getname"); + goto &VMS::Stdio::getname; + } + else { goto &{"VMS::Stdio::$func"}; } +} + +package VMS::Stdio; # in case we ever use AutoLoader + +1; + +__END__ + +=head1 NAME + +VMS::Stdio + +=head1 SYNOPSIS + +use VMS::Stdio qw( &flush &getname &remove &rewind &sync &tmpnam + &vmsopen &vmssysopen &waitfh ); +$uniquename = tmpnam; +$fh = vmsopen("my.file","rfm=var","alq=100",...) or die $!; +$name = getname($fh); +print $fh "Hello, world!\n"; +flush($fh); +sync($fh); +rewind($fh); +$line = <$fh>; +undef $fh; # closes file +$fh = vmssysopen("another.file", O_RDONLY | O_NDELAY, 0, "ctx=bin"); +sysread($fh,$data,128); +waitfh($fh); +close($fh); +remove("another.file"); + +=head1 DESCRIPTION + +This package gives Perl scripts access to VMS extensions to several +C stdio operations not available through Perl's CORE I/O functions. +The specific routines are described below. These functions are +prototyped as unary operators, with the exception of C<vmsopen> +and C<vmssysopen>, which can take any number of arguments, and +C<tmpnam>, which takes none. + +All of the routines are available for export, though none are +exported by default. All of the constants used by C<vmssysopen> +to specify access modes are exported by default. The routines +are associated with the Exporter tag FUNCTIONS, and the constants +are associated with the Exporter tag CONSTANTS, so you can more +easily choose what you'd like to import: + + # import constants, but not functions + use VMS::Stdio; # same as use VMS::Stdio qw( :DEFAULT ); + # import functions, but not constants + use VMS::Stdio qw( !:CONSTANTS :FUNCTIONS ); + # import both + use VMS::Stdio qw( :CONSTANTS :FUNCTIONS ); + # import neither + use VMS::Stdio (); + +Of course, you can also choose to import specific functions by +name, as usual. + +This package C<ISA> FileHandle, so that you can call FileHandle +methods on the handles returned by C<vmsopen> and C<vmssysopen>. +The FileHandle package is not initialized, however, until you +actually call a method that VMS::Stdio doesn't provide. This +is doen to save startup time for users who don't wish to use +the FileHandle methods. + +B<Note:> In order to conform to naming conventions for Perl +extensions and functions, the name of this package has been +changed to VMS::Stdio as of Perl 5.002, and the names of some +routines have been changed. Calls to the old VMS::stdio routines +will generate a warning, and will be routed to the equivalent +VMS::Stdio function. This compatibility interface will be +removed in a future release of this extension, so please +update your code to use the new routines. + +=item flush + +This function causes the contents of stdio buffers for the specified +file handle to be flushed. If C<undef> is used as the argument to +C<flush>, all currently open file handles are flushed. Like the CRTL +fflush() routine, it does not flush any underlying RMS buffers for the +file, so the data may not be flushed all the way to the disk. C<flush> +returns a true value if successful, and C<undef> if not. + +=item getname + +The C<getname> function returns the file specification associated +with a Perl FileHandle. If an error occurs, it returns C<undef>. + +=item remove + +This function deletes the file named in its argument, returning +a true value if successful and C<undef> if not. It differs from +the CORE Perl function C<unlink> in that it does not try to +reset file protection if the original protection does not give +you delete access to the file (cf. L<perlvms>). In other words, +C<remove> is equivalent to + + unlink($file) if VMS::Filespec::candelete($file); + +=item rewind + +C<rewind> resets the current position of the specified file handle +to the beginning of the file. It's really just a convenience +method equivalent in effect to C<seek($fh,0,0)>. It returns a +true value if successful, and C<undef> if it fails. + +=item sync + +This function flushes buffered data for the specified file handle +from stdio and RMS buffers all the way to disk. If successful, it +returns a true value; otherwise, it returns C<undef>. + +=item tmpnam + +The C<tmpnam> function returns a unique string which can be used +as a filename when creating temporary files. If, for some +reason, it is unable to generate a name, it returns C<undef>. + +=item vmsopen + +The C<vmsopen> function enables you to specify optional RMS arguments +to the VMS CRTL when opening a file. It is similar to the built-in +Perl C<open> function (see L<perlfunc> for a complete description), +but will only open normal files; it cannot open pipes or duplicate +existing FileHandles. Up to 8 optional arguments may follow the +file name. These arguments should be strings which specify +optional file characteristics as allowed by the CRTL. (See the +CRTL reference manual description of creat() and fopen() for details.) +If successful, C<vmsopen> returns a VMS::Stdio file handle; if an +error occurs, it returns C<undef>. + +You can use the file handle returned by C<vmsfopen> just as you +would any other Perl file handle. The class VMS::Stdio ISA +FileHandle, so you can call FileHandle methods using the handle +returned by C<vmsopen>. However, C<use>ing VMS::Stdio does not +automatically C<use> FileHandle; you must do so explicitly in +your program if you want to call FileHandle methods. This is +done to avoid the overhead of initializing the FileHandle package +in programs which intend to use the handle returned by C<vmsopen> +as a normal Perl file handle only. When the scalar containing +a VMS::Stdio file handle is overwritten, C<undef>d, or goes +out of scope, the associated file is closed automatically. + +=item vmssysopen + +This function bears the same relationship to the CORE function +C<sysopen> as C<vmsopen> does to C<open>. Its first three arguments +are the name, access flags, and permissions for the file. Like +C<vmsopen>, it takes up to 8 additional string arguments which +specify file characteristics. Its return value is identical to +that of C<vmsopen>. + +The symbolic constants for the mode argument are exported by +VMS::Stdio by default, and are also exported by the Fcntl package. + +=item waitfh + +This function causes Perl to wait for the completion of an I/O +operation on the file handle specified as its argument. It is +used with handles opened for asynchronous I/O, and performs its +task by calling the CRTL routine fwait(). + +=head1 REVISION + +This document was last revised on 28-Jan-1996, for Perl 5.002. + +=cut diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs new file mode 100644 index 00000000000..79eb95335e4 --- /dev/null +++ b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs @@ -0,0 +1,295 @@ +/* VMS::Stdio - VMS extensions to stdio routines + * + * Version: 2.0 + * Author: Charles Bailey bailey@genetics.upenn.edu + * Revised: 28-Feb-1996 + * + */ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include <file.h> + +static bool +constant(name, pval) +char *name; +IV *pval; +{ + if (strnNE(name, "O_", 2)) return FALSE; + + if (strEQ(name, "O_APPEND")) +#ifdef O_APPEND + { *pval = O_APPEND; return TRUE; } +#else + return FALSE; +#endif + if (strEQ(name, "O_CREAT")) +#ifdef O_CREAT + { *pval = O_CREAT; return TRUE; } +#else + return FALSE; +#endif + if (strEQ(name, "O_EXCL")) +#ifdef O_EXCL + { *pval = O_EXCL; return TRUE; } +#else + return FALSE; +#endif + if (strEQ(name, "O_NDELAY")) +#ifdef O_NDELAY + { *pval = O_NDELAY; return TRUE; } +#else + return FALSE; +#endif + if (strEQ(name, "O_NOWAIT")) +#ifdef O_NOWAIT + { *pval = O_NOWAIT; return TRUE; } +#else + return FALSE; +#endif + if (strEQ(name, "O_RDONLY")) +#ifdef O_RDONLY + { *pval = O_RDONLY; return TRUE; } +#else + return FALSE; +#endif + if (strEQ(name, "O_RDWR")) +#ifdef O_RDWR + { *pval = O_RDWR; return TRUE; } +#else + return FALSE; +#endif + if (strEQ(name, "O_TRUNC")) +#ifdef O_TRUNC + { *pval = O_TRUNC; return TRUE; } +#else + return FALSE; +#endif + if (strEQ(name, "O_WRONLY")) +#ifdef O_WRONLY + { *pval = O_WRONLY; return TRUE; } +#else + return FALSE; +#endif + + return FALSE; +} + + +static SV * +newFH(FILE *fp, char type) { + SV *rv, *gv = NEWSV(0,0); + GV **stashp; + HV *stash; + IO *io; + + /* Find stash for VMS::Stdio. We don't do this once at boot + * to allow for possibility of threaded Perl with per-thread + * symbol tables. This code (through io = ...) is really + * equivalent to gv_fetchpv("VMS::Stdio::__FH__",TRUE,SVt_PVIO), + * with a little less overhead, and good exercise for me. :-) */ + stashp = (GV **)hv_fetch(defstash,"VMS::",5,TRUE); + if (!stashp || *stashp == (GV *)&sv_undef) return Nullsv; + if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV(); + stashp = (GV **)hv_fetch(GvHV(*stashp),"Stdio::",7,TRUE); + if (!stashp || *stashp == (GV *)&sv_undef) return Nullsv; + if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV(); + + /* Set up GV to point to IO, and then take reference */ + gv_init(gv,stash,"__FH__",6,0); + io = GvIOp(gv) = newIO(); + IoIFP(io) = fp; + if (type != '>') IoOFP(io) = fp; + IoTYPE(io) = type; + rv = newRV(gv); + SvREFCNT_dec(gv); + return sv_bless(rv,stash); +} + +MODULE = VMS::Stdio PACKAGE = VMS::Stdio + +void +constant(name) + char * name + PROTOTYPE: $ + CODE: + IV i; + if (constant(name, &i)) + ST(0) = sv_2mortal(newSViv(i)); + else + ST(0) = &sv_undef; + +void +flush(sv) + SV * sv + PROTOTYPE: $ + CODE: + FILE *fp = Nullfp; + if (SvOK(sv)) fp = IoIFP(sv_2io(sv)); + ST(0) = fflush(fp) ? &sv_undef : &sv_yes; + +char * +getname(fp) + FILE * fp + PROTOTYPE: $ + CODE: + char fname[257]; + ST(0) = sv_newmortal(); + if (fgetname(fp,fname) != NULL) sv_setpv(ST(0),fname); + +void +rewind(fp) + FILE * fp + PROTOTYPE: $ + CODE: + ST(0) = rewind(fp) ? &sv_undef : &sv_yes; + +void +remove(name) + char *name + PROTOTYPE: $ + CODE: + ST(0) = remove(name) ? &sv_undef : &sv_yes; + +void +sync(fp) + FILE * fp + PROTOTYPE: $ + CODE: + ST(0) = fsync(fileno(fp)) ? &sv_undef : &sv_yes; + +char * +tmpnam() + PROTOTYPE: + CODE: + char fname[L_tmpnam]; + ST(0) = sv_newmortal(); + if (tmpnam(fname) != NULL) sv_setpv(ST(0),fname); + +void +vmsopen(spec,...) + char * spec + PROTOTYPE: @ + CODE: + char *args[8],mode[3] = {'r','\0','\0'}, type = '<'; + register int i, myargc; + FILE *fp; + + if (!spec || !*spec) { + SETERRNO(EINVAL,LIB$_INVARG); + XSRETURN_UNDEF; + } + if (items > 9) croak("too many args"); + + /* First, set up name and mode args from perl's string */ + if (*spec == '+') { + mode[1] = '+'; + spec++; + } + if (*spec == '>') { + if (*(spec+1) == '>') *mode = 'a', spec += 2; + else *mode = 'w', spec++; + } + else if (*spec == '<') spec++; + myargc = items - 1; + for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),na); + /* This hack brought to you by C's opaque arglist management */ + switch (myargc) { + case 0: + fp = fopen(spec,mode); + break; + case 1: + fp = fopen(spec,mode,args[0]); + break; + case 2: + fp = fopen(spec,mode,args[0],args[1]); + break; + case 3: + fp = fopen(spec,mode,args[0],args[1],args[2]); + break; + case 4: + fp = fopen(spec,mode,args[0],args[1],args[2],args[3]); + break; + case 5: + fp = fopen(spec,mode,args[0],args[1],args[2],args[3],args[4]); + break; + case 6: + fp = fopen(spec,mode,args[0],args[1],args[2],args[3],args[4],args[5]); + break; + case 7: + fp = fopen(spec,mode,args[0],args[1],args[2],args[3],args[4],args[5],args[6]); + break; + case 8: + fp = fopen(spec,mode,args[0],args[1],args[2],args[3],args[4],args[5],args[6],args[7]); + break; + } + if (fp != Nullfp) { + SV *fh = newFH(fp,(mode[1] ? '+' : (mode[0] == 'r' ? '<' : '>'))); + ST(0) = (fh ? sv_2mortal(fh) : &sv_undef); + } + else { ST(0) = &sv_undef; } + +void +vmssysopen(spec,mode,perm,...) + char * spec + int mode + int perm + PROTOTYPE: @ + CODE: + char *args[8]; + int i, myargc, fd; + FILE *fp; + SV *fh; + if (!spec || !*spec) { + SETERRNO(EINVAL,LIB$_INVARG); + XSRETURN_UNDEF; + } + if (items > 11) croak("too many args"); + myargc = items - 3; + for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),na); + /* More fun with C calls; can't combine with above because + args 2,3 of different types in fopen() and open() */ + switch (myargc) { + case 0: + fd = open(spec,mode,perm); + break; + case 1: + fd = open(spec,mode,perm,args[0]); + break; + case 2: + fd = open(spec,mode,perm,args[0],args[1]); + break; + case 3: + fd = open(spec,mode,perm,args[0],args[1],args[2]); + break; + case 4: + fd = open(spec,mode,perm,args[0],args[1],args[2],args[3]); + break; + case 5: + fd = open(spec,mode,perm,args[0],args[1],args[2],args[3],args[4]); + break; + case 6: + fd = open(spec,mode,perm,args[0],args[1],args[2],args[3],args[4],args[5]); + break; + case 7: + fd = open(spec,mode,perm,args[0],args[1],args[2],args[3],args[4],args[5],args[6]); + break; + case 8: + fd = open(spec,mode,perm,args[0],args[1],args[2],args[3],args[4],args[5],args[6],args[7]); + break; + } + i = mode & 3; + if (fd >= 0 && + ((fp = fdopen(fd, &("r\000w\000r+"[2*i]))) != Nullfp)) { + SV *fh = newFH(fp,"<>++"[i]); + ST(0) = (fh ? sv_2mortal(fh) : &sv_undef); + } + else { ST(0) = &sv_undef; } + +void +waitfh(fp) + FILE * fp + PROTOTYPE: $ + CODE: + ST(0) = fwait(fp) ? &sv_undef : &sv_yes; diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/test.pl b/gnu/usr.bin/perl/vms/ext/Stdio/test.pl new file mode 100644 index 00000000000..12e508aa1f7 --- /dev/null +++ b/gnu/usr.bin/perl/vms/ext/Stdio/test.pl @@ -0,0 +1,41 @@ +# Tests for VMS::Stdio v2.0 +use VMS::Stdio; +import VMS::Stdio qw(&flush &getname &rewind &sync); + +print "1..13\n"; +print +(defined(&getname) ? '' : 'not '), "ok 1\n"; + +$name = "test$$"; +$name++ while -e "$name.tmp"; +$fh = VMS::Stdio::vmsopen("+>$name",'ctx=rec','shr=put','fop=dlt','dna=.tmp'); +print +($fh ? '' : 'not '), "ok 2\n"; + +print +(flush($fh) ? '' : 'not '),"ok 3\n"; +print +(sync($fh) ? '' : 'not '),"ok 4\n"; + +$time = (stat("$name.tmp"))[9]; +print +($time ? '' : 'not '), "ok 5\n"; + +print 'not ' unless print $fh scalar(localtime($time)),"\n"; +print "ok 6\n"; + +print +(rewind($fh) ? '' : 'not '),"ok 7\n"; + +chop($line = <$fh>); +print +($line eq localtime($time) ? '' : 'not '), "ok 8\n"; + +($gotname) = (getname($fh) =~/\](.*);/); +print +($gotname eq "\U$name.tmp" ? '' : 'not '), "ok 9\n"; + +$sfh = VMS::Stdio::vmssysopen($name, O_RDONLY, 0, + 'ctx=rec', 'shr=put', 'dna=.tmp'); +print +($sfh ? '' : 'not ($!) '), "ok 10\n"; + +close($fh); +sysread($sfh,$line,24); +print +($line eq localtime($time) ? '' : 'not '), "ok 11\n"; + +undef $sfh; +print +(stat("$name.tmp") ? 'not ' : ''),"ok 12\n"; + +print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 13\n"; diff --git a/gnu/usr.bin/perl/vms/fndvers.com b/gnu/usr.bin/perl/vms/fndvers.com new file mode 100644 index 00000000000..f1ddc03eca9 --- /dev/null +++ b/gnu/usr.bin/perl/vms/fndvers.com @@ -0,0 +1,113 @@ +$! Brief DCL procedure to parse current Perl version out of +$! patchlevel.h, and update the version token for ARCHLIB +$! config.vms and descrip.mms if necessary. +$ err = "Write Sys$Error" +$ +$ If p1.eqs."" Then p1 = "patchlevel.h" +$ If p2.eqs."" Then p2 = F$Parse("config.vms",p1,"[.vms]") +$ If p3.eqs."" Then p3 = F$Parse("descrip.mms",p1,"[.vms]") +$ +$ If F$Search(p1).eqs."" +$ Then +$ err "Can't find ''p1' - exiting" +$ Exit 98962 ! RMS$_FNF +$ EndIf +$ plevel = "" +$ sublevel = "" +$ Open/Read patchlevel_h &p1 +$ +$ pread: +$ Read/End_Of_File=pdone patchlevel_h line +$ If F$Locate("#define PATCHLEVEL",line).ne.F$Length(line) +$ Then +$ plevel = F$Element(2," ",line) +$ If F$Length(plevel).lt.3 Then - + plevel = F$Extract(0,3 - F$Length(plevel),"000") + plevel +$ EndIf +$ If F$Locate("#define SUBVERSION",line).ne.F$Length(line) +$ Then +$ sublevel = F$Element(2," ",line) +$ If F$Length(sublevel).lt.2 Then - + sublevel = F$Extract(0,2 - F$Length(sublevel),"00") + sublevel +$ EndIf +$ If .not.(plevel.nes."" .and. sublevel.nes."") Then Goto pread +$ +$ pdone: +$ Close patchlevel_h +$! +$ If sublevel.eq.0 Then sublevel = "" +$ perl_version = "5_" + plevel + sublevel +$ If F$GetSyi("HW_MODEL").gt.1024 +$ Then +$ arch = "AXP" +$ Else +$ arch = "VAX" +$ EndIf +$ If p2.eqs."#NOFILE#" +$ Then +$ Write Sys$Output "Perl version directory name is ""''perl_version'""" +$ Exit +$ EndIf +$! +$ token = """""""""/perl_root/lib/VMS_''arch'/''perl_version'""""""""" +$ If sublevel.eqs."" Then token = token + " " +$ token = token + " /**/" +$ Call update_file "''p2'" "#define ARCHLIB_EXP" "''token'" +$ teststs = $Status +$ If .not.teststs Then Exit teststs +$! +$ If teststs.ne.1 ! current values in config.vms are appropriate +$ Then +$ token = """""""""/perl_root/lib/VMS_''arch'"""""""" /**/" +$ Call update_file "''p2'" "#define OLDARCHLIB_EXP" "''token'" +$ If .not.$Status Then Exit $Status +$! +$ token = """""""""/perl_root/lib/site_perl/VMS_''arch'"""""""" /**/" +$ Call update_file "''p2'" "#define SITEARCH_EXP" "''token'" +$ If .not.$Status Then Exit $Status +$EndIf +$! +$ token = "''perl_version'" +$ If sublevel.eqs."" Then token = token + " " +$ token = token + "#" +$ Call update_file "''p3'" "PERL_VERSION =" "''token'" +$ If .not.$Status Then Exit $Status +$ If $Status.eq.3 +$ Then +$ cmd = "MM[SK]" +$ If F$Locate("MMS",p3).eqs."" Then cmd = "make" +$ err "The PERL_VERSION macro was out of date in the file" +$ err " ''p3'" +$ err "The file has been corrected, but you must restart the build process" +$ err "by reinvoking ''cmd' to incorporate the new value." +$ Exit 44 ! SS$_ABORT +$ EndIf +$! +$ update_file: Subroutine +$ +$ If F$Search(p1).nes."" +$ Then +$ Search/Exact/Output=_NLA0: 'p1' "''p2' ''p3'" +$ If $Status.eq.%X08D78053 ! SEARCH$_NOMATCHES +$ Then +$ Open/Read/Write/Error=done file &p1 +$ +$ nextline: +$ Read/End_of_File=done file line +$ If F$Locate(p2,line).ne.F$Length(line) +$ Then +$ Write/Update file "''p2' ''p3'" +$ Goto done +$ EndIf +$ Goto nextline +$ +$ done: +$ Close file +$ Exit 3 ! Unused success status +$ EndIf +$ Exit 1 ! SS$_NORMAL +$ Else +$ err "Can't find ''p1'" +$ Exit 98962 ! RMS$_FNF +$ EndIf +$ EndSubroutine diff --git a/gnu/usr.bin/perl/vms/gen_shrfls.pl b/gnu/usr.bin/perl/vms/gen_shrfls.pl new file mode 100644 index 00000000000..256cdb51720 --- /dev/null +++ b/gnu/usr.bin/perl/vms/gen_shrfls.pl @@ -0,0 +1,379 @@ +# Create global symbol declarations, transfer vector, and +# linker options files for PerlShr. +# +# Input: +# $cflags - command line qualifiers passed to cc when preprocesing perl.h +# Note: A rather simple-minded attempt is made to restore quotes to +# a /Define clause - use with care. +# $objsuffix - file type (including '.') used for object files. +# $libperl - Perl object library. +# $extnames - package names for static extensions (used to generate +# linker options file entries for boot functions) +# $rtlopt - name of options file specifying RTLs to which PerlShr.Exe +# must be linked +# +# Output: +# PerlShr_Attr.Opt - linker options file which speficies that global vars +# be placed in NOSHR,WRT psects. Use when linking any object files +# against PerlShr.Exe, since cc places global vars in SHR,WRT psects +# by default. +# PerlShr_Bld.Opt - declares universal symbols for PerlShr.Exe +# Perlshr_Gbl*.Mar, Perlshr_Gbl*.Obj (VAX only) - declares global symbols +# for global vars (done here because gcc can't globaldef) and creates +# transfer vectors for routines on a VAX. +# PerlShr_Gbl.Opt (VAX only) - list of PerlShr_Gbl*.Obj, used for input +# to the linker when building PerlShr.Exe. +# +# To do: +# - figure out a good way to collect global vars in one psect, given that +# we can't use globaldef because of gcc. +# - then, check for existing files and preserve symbol and transfer vector +# order for upward compatibility +# - then, add GSMATCH to options file - but how do we insure that new +# library has everything old one did +# (i.e. /Define=DEBUGGING,EMBED,MULTIPLICITY)? +# +# Author: Charles Bailey bailey@genetics.upenn.edu +# Revised: 20-Feb-1996 + +require 5.000; + +$debug = $ENV{'GEN_SHRFLS_DEBUG'}; + +if ($ARGV[0] eq '-f') { + open(INP,$ARGV[1]) or die "Can't read input file $ARGV[1]: $!\n"; + print "Input taken from file $ARGV[1]\n" if $debug; + @ARGV = (); + while (<INP>) { + chomp; + push(@ARGV,split(/\|/,$_)); + } + close INP; + print "Read input data | ",join(' | ',@ARGV)," |\n" if $debug > 1; +} + +$cc_cmd = shift @ARGV; + +# Someday, we'll have $GetSyI built into perl . . . +$isvax = `\$ Write Sys\$Output F\$GetSyI(\"HW_MODEL\")` <= 1024; +print "\$isvax: \\$isvax\\\n" if $debug; + +print "Input \$cc_cmd: \\$cc_cmd\\\n" if $debug; +$docc = ($cc_cmd !~ /^~~/); +print "\$docc = $docc\n" if $debug; + +if ($docc) { + # put quotes back onto defines - they were removed by DCL on the way in + if (($prefix,$defines,$suffix) = + ($cc_cmd =~ m#(.*)/Define=(.*?)([/\s].*)#i)) { + $defines =~ s/^\((.*)\)$/$1/; + @defines = split(/,/,$defines); + $cc_cmd = "$prefix/Define=(" . join(',',grep($_ = "\"$_\"",@defines)) + . ')' . $suffix; + } + print "Filtered \$cc_cmd: \\$cc_cmd\\\n" if $debug; + + # check for gcc - if present, we'll need to use MACRO hack to + # define global symbols for shared variables + $isvaxc = 0; + $isgcc = `$cc_cmd _nla0:/Version` =~ /GNU/ + or 0; # make debug output nice + $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; + + if (-f 'perl.h') { $dir = '[]'; } + elsif (-f '[-]perl.h') { $dir = '[-]'; } + else { die "$0: Can't find perl.h\n"; } +} +else { + ($junk,$junk,$cpp_file,$cc_cmd) = split(/~~/,$cc_cmd,4); + $isgcc = $cc_cmd =~ /case_hack/i + or 0; # for nice debug output + $isvaxc = (!$isgcc && $cc_cmd !~ /standard=/i) + or 0; # again, for nice debug output + print "\$isgcc: \\$isgcc\\\n" if $debug; + print "\$isvaxc: \\$isvaxc\\\n" if $debug; + print "Not running cc, preprocesor output in \\$cpp_file\\\n" if $debug; +} + +$objsuffix = shift @ARGV; +print "\$objsuffix: \\$objsuffix\\\n" if $debug; +$dbgprefix = shift @ARGV; +print "\$dbgprefix: \\$dbgprefix\\\n" if $debug; +$olbsuffix = shift @ARGV; +print "\$olbsuffix: \\$olbsuffix\\\n" if $debug; +$libperl = "${dbgprefix}libperl$olbsuffix"; +$extnames = shift @ARGV; +print "\$extnames: \\$extnames\\\n" if $debug; +$rtlopt = shift @ARGV; +print "\$rtlopt: \\$rtlopt\\\n" if $debug; + +# 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 +# #includes perl.h will want to resolve these global symbols. +# We're using a weak test here - we basically know that the only enums +# we need to handle now are the big one in opcode.h, and the +# "typedef enum { ... } expectation" in perl.h, so we hard code +# appropriate tests below. Since we can't know in general whether a given +# enum will be used elsewhere in a globaldef, it's hard to decide a +# priori whether its constants need to be treated as global symbols. +sub scan_enum { + my($line) = @_; + + return unless $isvaxc; + + return unless /^\s+(OP|X)/; # we only want opcode and expectation enums + print "\tchecking for enum constant\n" if $debug > 1; + $line =~ s#/\*.+##; + $line =~ s/,?\s*\n?$//; + print "\tfiltered to \\$line\\\n" if $debug > 1; + if ($line =~ /(\w+)$/) { + print "\tconstant name is \\$1\\\n" if $debug > 1; + $enums{$1}++; + } +} + +sub scan_var { + my($line) = @_; + + print "\tchecking for global variable\n" if $debug > 1; + $line =~ s/INIT\(.*\)//; + $line =~ s/\[.*//; + $line =~ s/=.*//; + $line =~ s/\W*;?\s*$//; + print "\tfiltered to \\$line\\\n" if $debug > 1; + if ($line =~ /(\w+)$/) { + print "\tvar name is \\$1\\\n" if $debug > 1; + $vars{$1}++; + } +} + +sub scan_func { + my($line) = @_; + + print "\tchecking for global routine\n" if $debug > 1; + if ( $line =~ /(\w+)\s+\(/ ) { + print "\troutine name is \\$1\\\n" if $debug > 1; + if ($1 eq 'main' || $1 eq 'perl_init_ext') { + print "\tskipped\n" if $debug > 1; + } + else { $fcns{$1}++ } + } +} + +$used_expectation_enum = $used_opcode_enum = 0; # avoid warnings +if ($docc) { + open(CPP,"${cc_cmd}/NoObj/PreProc=Sys\$Output ${dir}perl.h|") + or die "$0: Can't preprocess ${dir}perl.h: $!\n"; +} +else { + open(CPP,"$cpp_file") or die "$0: Can't read preprocessed file $cpp_file: $!\n"; +} +LINE: while (<CPP>) { + while (/^#.*vmsish\.h/i .. /^#.*perl\.h/i) { + while (/__VMS_PROTOTYPES__/i .. /__VMS_SEPYTOTORP__/i) { + print "vms_proto>> $_" if $debug > 2; + if (/^EXT/) { &scan_var($_); } + else { &scan_func($_); } + last LINE unless $_ = <CPP>; + } + print "vmsish.h>> $_" if $debug > 2; + if (/^EXT/) { &scan_var($_); } + last LINE unless $_ = <CPP>; + } + while (/^#.*opcode\.h/i .. /^#.*perl\.h/i) { + print "opcode.h>> $_" if $debug > 2; + if (/^OP \*\s/) { &scan_func($_); } + if (/^EXT/) { &scan_var($_); } + if (/^\s+OP_/) { &scan_enum($_); } + last LINE unless $_ = <CPP>; + } + while (/^typedef enum/ .. /^\}/) { + print "global enum>> $_" if $debug > 2; + &scan_enum($_); + last LINE unless $_ = <CPP>; + } + while (/^#.*proto\.h/i .. /^#.*perl\.h/i) { + print "proto.h>> $_" if $debug > 2; + if (/^EXT/) { &scan_var($_); } + else { &scan_func($_); } + last LINE unless $_ = <CPP>; + } + print $_ if $debug > 3; + if (($type) = /^EXT\s+(\w+)/) { + if ($isvaxc) { + if ($type eq 'expectation') { + $used_expectation_enum++; + print "\tsaw global use of enum \"expectation\"\n" if $debug > 1; + } + if ($type eq 'opcode') { + $used_opcode_enum++; + print "\tsaw global use of enum \"opcode\"\n" if $debug > 1; + } + } + &scan_var($_); + } +} +close CPP; + + +# Kluge to determine whether we need to add EMBED prefix to +# symbols read from local list. init_os_extras() is a VMS- +# specific function whose Perl_ prefix is added in vmsish.h +# if EMBED is #defined. +$embed = exists($fcns{'Perl_init_os_extras'}) ? 'Perl_' : ''; +while (<DATA>) { + next if /^#/; + s/\s+#.*\n//; + next if /^\s*$/; + ($key,$array) = split('=',$_); + $key = "$embed$key"; + print "Adding $key to \%$array list\n" if $debug > 1; + ${$array}{$key}++; +} +foreach (split /\s+/, $extnames) { + my($pkgname) = $_; + $pkgname =~ s/::/__/g; + $fcns{"boot_$pkgname"}++; + print "Adding boot_$pkgname to \%fcns (for extension $_)\n" if $debug; +} + +# If we're using VAXC, fold in the names of the constants for enums +# we've seen as the type of global vars. +if ($isvaxc) { + foreach (keys %enums) { + if (/^OP/) { + $vars{$_}++ if $used_opcode_enum; + next; + } + if (/^X/) { + $vars{$_}++ if $used_expectation_enum; + next; + } + print STDERR "Unrecognized enum constant \"$_\" ignored\n"; + } +} + +# Eventually, we'll check against existing copies here, so we can add new +# symbols to an existing options file in an upwardly-compatible manner. + +$marord++; +open(OPTBLD,">${dir}${dbgprefix}perlshr_bld.opt") + or die "$0: Can't write to ${dir}${dbgprefix}perlshr_bld.opt: $!\n"; +if ($isvax) { + open(MAR,">${dir}perlshr_gbl${marord}.mar") + or die "$0: Can't write to ${dir}perlshr_gbl${marord}.mar: $!\n"; + print MAR "\t.title perlshr_gbl$marord\n"; +} +foreach $var (sort keys %vars) { + if ($isvax) { print OPTBLD "UNIVERSAL=$var\n"; } + else { print OPTBLD "SYMBOL_VECTOR=($var=DATA)\n"; } + # This hack brought to you by the lack of a globaldef in gcc. + if ($isgcc) { + if ($count++ > 200) { # max 254 psects/file + print MAR "\t.end\n"; + close MAR; + $marord++; + open(MAR,">${dir}perlshr_gbl${marord}.mar") + or die "$0: Can't write to ${dir}perlshr_gbl${marord}.mar: $!\n"; + print MAR "\t.title perlshr_gbl$marord\n"; + $count = 0; + } + print MAR "\t.psect ${var},long,pic,ovr,rd,wrt,noexe,noshr\n"; + print MAR "\t${var}:: .blkl 1\n"; + } +} + +print MAR "\t.psect \$transfer_vec,pic,rd,nowrt,exe,shr\n" if ($isvax); +foreach $func (sort keys %fcns) { + if ($isvax) { + print MAR "\t.transfer $func\n"; + print MAR "\t.mask $func\n"; + print MAR "\tjmp G\^${func}+2\n"; + } + else { print OPTBLD "SYMBOL_VECTOR=($func=PROCEDURE)\n"; } +} +if ($isvax) { + print MAR "\t.end\n"; + close MAR; +} + +open(OPTATTR,">${dir}perlshr_attr.opt") + or die "$0: Can't write to ${dir}perlshr_attr.opt: $!\n"; +print OPTATTR "PSECT_ATTR=\$CHAR_STRING_CONSTANTS,PIC,SHR,NOEXE,RD,NOWRT\n"; +foreach $var (sort keys %vars) { + print OPTATTR "PSECT_ATTR=${var},PIC,OVR,RD,NOEXE,WRT,NOSHR\n"; +} +close OPTATTR; + +$incstr = 'perl,globals'; +if ($isvax) { + $drvrname = "Compile_shrmars.tmp_".time; + open (DRVR,">$drvrname") or die "$0: Can't write to $drvrname: $!\n"; + print DRVR "\$ Set NoOn\n"; + print DRVR "\$ Delete/NoLog/NoConfirm $drvrname;\n"; + print DRVR "\$ old_proc_vfy = F\$Environment(\"VERIFY_PROCEDURE\")\n"; + print DRVR "\$ old_img_vfy = F\$Environment(\"VERIFY_IMAGE\")\n"; + print DRVR "\$ MCR $^X -e \"\$ENV{'LIBPERL_RDT'} = (stat('$libperl'))[9]\"\n"; + print DRVR "\$ Set Verify\n"; + print DRVR "\$ If F\$Search(\"$libperl\").eqs.\"\" Then Library/Object/Create $libperl\n"; + do { + $incstr .= ",perlshr_gbl$marord"; + print DRVR "\$ Macro/NoDebug/Object=PerlShr_Gbl${marord}$objsuffix PerlShr_Gbl$marord.Mar\n"; + print DRVR "\$ Library/Object/Replace/Log $libperl PerlShr_Gbl${marord}$objsuffix\n"; + } while (--$marord); + # We had to have a working miniperl to run this program; it's probably the + # one we just built. It depended on LibPerl, which will be changed when + # the PerlShr_Gbl* modules get inserted, so miniperl will be out of date, + # and so, therefore, will all of its dependents . . . + # We touch LibPerl here so it'll be back 'in date', and we won't rebuild + # miniperl etc., and therefore LibPerl, the next time we invoke MM[KS]. + print DRVR "\$ old_proc_vfy = F\$Verify(old_proc_vfy,old_img_vfy)\n"; + print DRVR "\$ MCR $^X -e \"utime 0, \$ENV{'LIBPERL_RDT'}, '$libperl'\"\n"; + close DRVR; +} + +# Include object modules and RTLs in options file +# Linker wants /Include and /Library on different lines +print OPTBLD "$libperl/Include=($incstr)\n"; +print OPTBLD "$libperl/Library\n"; +open(RTLOPT,$rtlopt) or die "$0: Can't read options file $rtlopt: $!\n"; +while (<RTLOPT>) { print OPTBLD; } +close RTLOPT; +close OPTBLD; + +exec "\$ \@$drvrname" if $isvax; + + +__END__ + +# Oddball cases, so we can keep the perl.h scan above simple +rcsid=vars # declared in perl.c +regarglen=vars # declared in regcomp.h +regdummy=vars # declared in regcomp.h +regkind=vars # declared in regcomp.h +simple=vars # declared in regcomp.h +varies=vars # declared in regcomp.h +watchaddr=vars # declared in run.c +watchok=vars # declared in run.c +yychar=vars # generated by byacc in perly.c +yycheck=vars # generated by byacc in perly.c +yydebug=vars # generated by byacc in perly.c +yydefred=vars # generated by byacc in perly.c +yydgoto=vars # generated by byacc in perly.c +yyerrflag=vars # generated by byacc in perly.c +yygindex=vars # generated by byacc in perly.c +yylen=vars # generated by byacc in perly.c +yylhs=vars # generated by byacc in perly.c +yylval=vars # generated by byacc in perly.c +yyname=vars # generated by byacc in perly.c +yynerrs=vars # generated by byacc in perly.c +yyrindex=vars # generated by byacc in perly.c +yyrule=vars # generated by byacc in perly.c +yysindex=vars # generated by byacc in perly.c +yytable=vars # generated by byacc in perly.c +yyval=vars # generated by byacc in perly.c diff --git a/gnu/usr.bin/perl/vms/genconfig.pl b/gnu/usr.bin/perl/vms/genconfig.pl new file mode 100644 index 00000000000..336c24b8da4 --- /dev/null +++ b/gnu/usr.bin/perl/vms/genconfig.pl @@ -0,0 +1,281 @@ +#!/usr/bin/perl +# Habit . . . +# +# Extract info from Config.VMS, and add extra data here, to generate Config.sh +# Edit the static information after __END__ to reflect your site and options +# 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. 13-Dec-1995 Charles Bailey bailey@genetics.upenn.edu +# + +unshift(@INC,'lib'); # In case someone didn't define Perl_Root + # before the build + +if ($ARGV[0] eq '-f') { + open(ARGS,$ARGV[1]) or die "Can't read data from $ARGV[1]: $!\n"; + @ARGV = (); + while (<ARGS>) { + push(@ARGV,split(/\|/,$_)); + } + close ARGS; +} + +if (-f "config.vms") { $infile = "config.vms"; $outdir = "[-]"; } +elsif (-f "[.vms]config.vms") { $infile = "[.vms]config.vms"; $outdir = "[]"; } +elsif (-f "config.h") { $infile = "config.h"; $outdir = "[]";} + +if ($infile) { print "Generating Config.sh from $infile . . .\n"; } +else { die <<EndOfGasp; +Can't find config.vms or config.h to read! + Please run this script from the perl source directory or + the VMS subdirectory in the distribution. +EndOfGasp +} +$outdir = ''; +open(IN,"$infile") || die "Can't open $infile: $!\n"; +open(OUT,">${outdir}Config.sh") || die "Can't open ${outdir}Config.sh: $!\n"; + +$time = localtime; +print OUT <<EndOfIntro; +# This file generated by GenConfig.pl on a VMS system. +# Input obtained from: +# $infile +# $0 +# Time: $time + +package='perl5' +CONFIG='true' +cf_time='$time' +ld='Link' +lddlflags='/Share' +ranlib='' +ar='' +eunicefix=':' +hint='none' +hintfile='' +intsize='4' +alignbytes='8' +shrplib='define' +usemymalloc='n' +spitshell='write sys\$output ' +EndOfIntro + +$cf_by = (getpwuid($<))[0]; +print OUT "cf_by='$cf_by'\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'; +} +$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 + my($cc,$ccflags) = split('/',$val,2); + my($d_attr); + $ccflags = "/$ccflags"; + if ($ccflags =~s!/DECC!!ig) { + $cc .= '/DECC'; + $cctype = 'decc'; + $d_attr = 'undef'; + } + elsif ($ccflags =~s!/VAXC!!ig) { + $cc .= '/VAXC'; + $cctype = 'vaxc'; + $d_attr = 'undef'; + } + elsif (`$val/NoObject/NoList _nla0:/Version` =~ /GNU/) { + $cctype = 'gcc'; + $d_attr = 'define'; + } + elsif ($archsufx eq 'VAX' && + `$val/NoObject/NoList /prefix=all _nla0:` =~ /IVQUAL/) { + $cctype = 'vaxc'; + $d_attr = 'undef'; + } + else { + $cctype = 'decc'; + $d_attr = 'undef'; + } + print OUT "vms_cc_type='$cctype'\n"; + print OUT "d_attribut='$d_attr'\n"; + print OUT "cc='$cc'\n"; + if ( ($cctype eq 'decc' and $archsufx eq 'VAX') || $cctype eq 'gcc') { + # gcc and 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. + $ccflags =~ s#/obj(?:ect)?=[^/\s]+##i; + } + print OUT "ccflags='$ccflags'\n"; + $dosock = ($ccflags =~ m!/DEF[^/]+VMS_DO_SOCKETS!i and + $ccflags !~ m!/UND[^/]+VMS_DO_SOCKETS!i); + next; + } + print OUT "$key=\'$val\'\n"; +} + +# 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" if $dosock; + $myname = ''; + } +} +$myname = $ENV{'SYS$NODE'} unless $myname; +($myhostname,$mydomain) = split(/\./,$myname,2); +print OUT "myhostname='$myhostname'\n" if $myhostname; +if ($mydomain) { + print OUT "mydomain='.$mydomain'\n"; + print OUT "perladmin='$cf_by\@$myhostname.$mydomain'\n"; + print OUT "cf_email='$cf_by\@$myhostname.$mydomain'\n"; +} +else { + print OUT "perladmin='$cf_by'\n"; + print OUT "cf_email='$cf_by'\n"; +} +chomp($hwname = `Write Sys\$Output F\$GetSyi("HW_NAME")`); +$hwname = $archsufx if $hwname =~ /IVKEYW/; # *really* old VMS version +print OUT "myuname='VMS $myname $osvers $hwname'\n"; + +while (<IN>) { # roll through the comment header in Config.VMS + last if /config-start/; +} + +while (<IN>) { + chop; + while (/\\\s*$/) { # pick up contination lines + my $line = $_; + $line =~ s/\\\s*$//; + $_ = <IN>; + s/^\s*//; + $_ = $line . $_; + } + next unless my ($blocked,$un,$token,$val) = m%^(\/\*)?\s*\#\s*(un)?def\w*\s*([A-za-z0-9]\w+)\S*\s*(.*)%; + 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. + # Fixup differences between Configure vars and config.h manifests + # This isn't comprehensize; we fix 'em as we need 'em. + $token = 'castneg' if $token eq 'castnegfloat'; + $token = 'dlsymun' if $token eq 'dlsym_needs_underscore'; + $token = 'stdstdio' if $token eq 'use_stdio_ptr'; + $token = 'stdiobase' if $token eq 'use_stdio_base'; + $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"; + } +} +close IN; + +while (<DATA>) { + next if /^\s*#/ or /^\s*$/; + s/#.*$//; s/\s*$//; + ($key,$val) = split('=',$_,2); + print OUT "$key='$val'\n"; + eval "\$$key = '$val'"; +} +# 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"; +$archlib = &VMS::Filespec::vmspath($privlib); +$installarchlib = &VMS::Filespec::vmspath($installprivlib); +$sitearch = &VMS::Filespec::vmspath($sitelib); +$archlib =~ s#\]#.VMS_$archsufx\]#; +$sitearch =~ s#\]#.VMS_$archsufx\]#; +print OUT "oldarchlib='$archlib'\n"; +print OUT "oldarchlibexp='$archlib'\n"; +($vers = $]) =~ tr/./_/; +$archlib =~ s#\]#.$vers\]#; +$installarchlib =~ s#\]#.VMS_$archsufx.$vers\]#; +print OUT "archlib='$archlib'\n"; +print OUT "archlibexp='$archlib'\n"; +print OUT "installarchlib='$installarchlib'\n"; +print OUT "sitearch='$sitearch'\n"; +print OUT "sitearchexp='$sitearch'\n"; + +if (open(OPT,"${outdir}crtl.opt")) { + while (<OPT>) { + next unless m#/(sha|lib)#i; + chomp; + if (/crtl/i || /gcclib/i) { push(@crtls,$_); } + else { push(@libs,$_); } + } + close OPT; + print OUT "libs='",join(' ',@libs),"'\n"; + push(@crtls,'(DECCRTL)') if $cctype eq 'decc'; + print OUT "libc='",join(' ',@crtls),"'\n"; +} +else { warn "Can't read ${outdir}crtl.opt - skipping 'libs' & 'libc'"; } + +if (open(PL,"${outdir}patchlevel.h")) { + while (<PL>) { + if (/^#define PATCHLEVEL\s+(\S+)/) { print OUT "PATCHLEVEL='$1'\n"; } + elsif (/^#define SUBVERSION\s+(\S+)/) { print OUT "SUBVERSION='$1'\n"; } + } + close PL; +} +else { warn "Can't read ${outdir}patchlevel.h - skipping 'PATCHLEVEL'"; } + +# simple pager support for perldoc +if (`most` =~ /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 +# should contain the essentials. Some of these definitions reflect +# options chosen when building perl or site-specific data; these should +# be hand-edited appropriately. Someday, perhaps, we'll get this automated. + +# The definitions in this block are constant across most systems, and +# should only rarely need to be changed. +ccdlflags= +cccdlflags= +usedl=true +dlobj=dl_vms.obj +dlsrc=dl_vms.c +so=exe +dlext=exe +libpth=/sys$share /sys$library +usevfork=false +castflags=0 +signal_t=void +timetype=long +builddir=perl_root:[000000] +prefix=perl_root +installprivlib=perl_root:[lib] # The *lib constants should match the +privlib=perl_root:[lib] # equivalent *(?:ARCH)LIB_EXP constants +sitelib=perl_root:[lib.site_perl] # in config.h +installbin=perl_root:[000000] +installman1dir=perl_root:[man.man1] +installman3dir=perl_root:[man.man3] +man1ext=rno +man3ext=rno +binexp=perl_root:[000000] # should be same as installbin +useposix=false diff --git a/gnu/usr.bin/perl/vms/genopt.com b/gnu/usr.bin/perl/vms/genopt.com new file mode 100644 index 00000000000..70013aec425 --- /dev/null +++ b/gnu/usr.bin/perl/vms/genopt.com @@ -0,0 +1,18 @@ +$! generates options file for vms link +$! p1 is filename and mode to open file (filename/write or filename/append) +$! p2 is delimiter separating elements of list in p3 +$! p3 is list of items to be written, one per line, into options file +$ +$ open file 'p1' +$ element=0 +$loop: +$ x=f$element(element,p2,p3) +$ if x .eqs. p2 then goto out +$ y=f$edit(x,"COLLAPSE") ! lose spaces +$ if y .nes. "" then write file y +$ element=element+1 +$ goto loop +$ +$out: +$ close file +$ exit diff --git a/gnu/usr.bin/perl/vms/make_command.com b/gnu/usr.bin/perl/vms/make_command.com new file mode 100644 index 00000000000..c3a9da8b804 --- /dev/null +++ b/gnu/usr.bin/perl/vms/make_command.com @@ -0,0 +1,21 @@ +$! MAKE_COMMAND.COM +$! Record MM[SK]/Make parameters in configuration report +$! +$! Author: Peter Prymmer <pvhp@lns62.lns.cornell.edu> +$! Version: 1.0 18-Jan-1996 +$! +$! DCL usage (choose one): +$! @MAKE_COMMAND !or +$! @MAKE_COMMAND/OUTPUT=MYCONFIG.OUT +$!------------------------------------------------ +$ $mms = "'"+p1 +$ $makeline = p2+" "+p3+" "+p4+" "+p5+" "+p6+" "+p7+" "+p8 +$quotable: +$ if f$locate("""",$makeline).lt.f$length($makeline) +$ then +$ $makeline = $makeline - """" +$ goto quotable +$ endif +$ $makeline = f$edit($makeline,"COMPRESS,TRIM") +$ write sys$output " make_cmd=''$mms'"+" ''$makeline''" +$!------------------------------------------------ diff --git a/gnu/usr.bin/perl/vms/mms2make.pl b/gnu/usr.bin/perl/vms/mms2make.pl new file mode 100644 index 00000000000..6b35e75ffbd --- /dev/null +++ b/gnu/usr.bin/perl/vms/mms2make.pl @@ -0,0 +1,122 @@ +#!/usr/bin/perl +# +# mms2make.pl - convert Descrip.MMS file to Makefile +# Version 2.2 29-Jan-1996 +# David Denholm <denholm@conmat.phys.soton.ac.uk> +# +# 1.0 06-Aug-1994 Charles Bailey bailey@genetics.upenn.edu +# - original version +# 2.0 29-Sep-1994 David Denholm <denholm@conmat.phys.soton.ac.uk> +# - take action based on MMS .if / .else / .endif +# any command line options after filenames are set in an assoc array %macros +# maintain "@condition as a stack of current conditions +# we unshift a 0 or 1 to front of @conditions at an .ifdef +# we invert top of stack at a .else +# we pop at a .endif +# we deselect any other line if $conditions[0] is 0 +# I'm being very lazy - push a 1 at start, then dont need to check for +# an empty @conditions [assume nesting in descrip.mms is correct] +# 2.1 26-Feb-1995 Charles Bailey bailey@genetics.upenn.edu +# - handle MMS macros generated by MakeMaker +# 2.2 29-Jan-1996 Charles Bailey bailey@genetics.upenn.edu +# - Fix output file name to work under Unix + +if ($#ARGV > -1 && $ARGV[0] =~ /^[\-\/]trim/i) { + $do_trim = 1; + shift @ARGV; +} +$infile = $#ARGV > -1 ? shift(@ARGV) : "Descrip.MMS"; +$outfile = $#ARGV > -1 ? shift(@ARGV) : "Makefile"; + +# set any other args in %macros - set VAXC by default +foreach (@ARGV) { $macros{"\U$_"}=1 } + +# consistency check +$macros{"DECC"} = 1 if $macros{"__AXP__"}; + +# set conditions as if there was a .if 1 around whole file +# [lazy - saves having to check for empty array - just test [0]==1] +@conditions = (1); + +open(INFIL,$infile) || die "Can't open $infile: $!\n"; +open(OUTFIL,">$outfile") || die "Can't open $outfile: $!\n"; + +print OUTFIL "#> This file produced from $infile by $0\n"; +print OUTFIL "#> Lines beginning with \"#>\" were commented out during the\n"; +print OUTFIL "#> conversion process. For more information, see $0\n"; +print OUTFIL "#>\n"; + +while (<INFIL>) { + s/$infile/$outfile/eoi; + if (/^\#/) { + if (!/^\#\:/) {print OUTFIL;} + next; + } + +# look for ".ifdef macro" and push 1 or 0 to head of @conditions +# push 0 if we are in false branch of another if + if (/^\.ifdef\s*(.+)/i) + { + print OUTFIL "#> ",$_ unless $do_trim; + unshift @conditions, ($macros{"\U$1"} ? $conditions[0] : 0); + next; + } + +# reverse $conditions[0] for .else provided surrounding if is active + if (/^\.else/i) + { + print OUTFIL "#> ",$_ unless $do_trim; + $conditions[0] = $conditions[1] && !$conditions[0]; + next; + } + +# pop top condition for .endif + if (/^\.endif/i) + { + print OUTFIL "#> ",$_ unless $do_trim; + shift @conditions; + next; + } + + next if ($do_trim && !$conditions[0]); + +# spot new rule and pick up first source file, since some versions of +# Make don't provide a macro for this + if (/[^#!]*:\s+/) { + if (/:\s+([^\s,]+)/) { $firstsrc = $1 } + else { $firstsrc = "\$<" } + } + +#convert macros we expect to see in MakeMaker-generated Descrip.MMSs + s#/Descrip=\s*\n#-f \nMMS = make\n#; + s#/Macro=\(# #; + s#MACROEND = \)#MACROEND = #; + if (m#\$\(USEMACROS\)(.*)(\$\(MACROEND\))?#) { + while (1) { + my($macros,$end) = ($1,$2); + $macros =~ s/,/ /g; # We're hosed if there're commas within a macro - + # someday, check for "" and skip contents + last if $end; + print OUTFIL $conditions[0] ? "#> " : "",$_; + $_ = <INFIL>; + m#(.*)(\$\(MACROEND\))?#; + } + } + + s/^ +/\t/; + s/^\.first/\.first:/i; + s/^\.suffixes/\.suffixes:/i; + s/\@\[\.vms\]/\$\$\@\[\.vms\]/; + s/f\$/f\$\$/goi; + s/\$\(mms\$source\)/$firstsrc/i; + s/\$\(mms\$target\)/\$\@/i; + s/\$\(mms\$target_name\)\$\(O\)/\$\@/i; + s/\$\(mms\$target_name\)/\$\*/i; + s/sys\$([^\(])/sys\$\$$1/gi; + print OUTFIL "#> " unless $conditions[0]; + print OUTFIL $_; +} + +close INFIL; +close OUTFIL; + diff --git a/gnu/usr.bin/perl/vms/myconfig.com b/gnu/usr.bin/perl/vms/myconfig.com new file mode 100644 index 00000000000..7fb728eb62b --- /dev/null +++ b/gnu/usr.bin/perl/vms/myconfig.com @@ -0,0 +1,325 @@ +$! #!/bin/sh ---> MYCONFIG.COM + +$! # This script is designed to provide a handy summary of the configuration +$! # information being used to build perl. This is especially useful if you +$! # are requesting help from comp.lang.perl.misc on usenet or via mail. + +$! DCL-ified by Peter Prymmer <pvhp@lns62.lns.cornell.edu> 22-DEC-1995 +$! DCL usage (choose one): +$! @MYCONFIG !or +$! @MYCONFIG/OUTPUT=MYCONFIG.OUT !or +$! @MYCONFIG [node::][which$disk:][[dir.subdir]]CONFIG.SH !or +$! @MYCONFIG/OUTPUT=MYCONFIG.OUT [node::][w$disk:][[dir]]CONFIG.SH +$! version 2: +$! Incorporates Charles Bailey's ideas about bootstrapping system info - +$! myconfig.com is now callable as a "myconfig" target in your maker and +$! may even work if miniperl.exe and config.sh files fail to be made. +$! Thus if: +$! MMK/DESCRIP=[.VMS] !(or MMS or MAKE) +$! does not work then try: +$! MMK/DESCRIP=[.VMS]/OUTPUT=MYPERLBUILD.PROBLEM !(or MMS or MAKE) +$! Then discuss the MYPERLBUILD.PROBLEM file with a local expert. +$! If that still does not work then try: +$! MMK/DESCRIP=[.VMS]/OUT=MYNONFIG.OUT MYCONFIG !(or MMS or MAKE) +$! send output (MYNONFIG.OUT) to an outside expert and ask politely for help. + +$ ECHO = "WRITE SYS$OUTPUT " +$ RATHER_LONG_DEFAULT_DIRECTORY_NAME = F$ENVIRONMENT("DEFAULT") + +$ if (p1.nes."").and.(p2.eqs."") +$ then RATHER_LONG_FILENAME_TO_FIND = p1 !no typo-checking (experts only) +$ else RATHER_LONG_FILENAME_TO_FIND = "CONFIG.SH" +$ endif +$Research: +$ RATHER_LONG_FILENAME_SEARCH = F$Search(RATHER_LONG_FILENAME_TO_FIND) +$ if RATHER_LONG_FILENAME_SEARCH.EQS."" +$ then +$ if f$parse(f$environment("DEFAULT"),,,"DIRECTORY",).NES."[000000]" +$ then +$ set default [-] +$ goto Research +$ else +$ ECHO "Can't find the perl config.sh file produced by Configure" +$ set default 'RATHER_LONG_DEFAULT_DIRECTORY_NAME' +$! exit 3 +$ goto cannot_find_config_sh +$ endif +$ endif + +$ open/read RATHER_LONG_CONFIG_FILE_HANDLE 'RATHER_LONG_FILENAME_SEARCH' +$Loop: +$ read/end_of_file = Done RATHER_LONG_CONFIG_FILE_HANDLE line +$ name = f$extract(0,f$locate("=",line),line) +$ start = f$locate("'",line)+1 +$ stop = f$locate("'",line) +$ value = f$extract(start,stop-start,line) +$ if (f$locate("#",name).eqs.f$length(name)).and. - + (name.nes."").and. - + (name.nes."'") - !bug in genconfig.pl (vms) for osvers='' ? + then $$'name' = "'" + value !$ not necessary but looks more sh-ish +$ goto Loop + +$Done: +$ close RATHER_LONG_CONFIG_FILE_HANDLE +$ goto spit_it_out + +$cannot_find_config_sh: +$! these parameters are assumed to be passed from make/mm[s|k]: +$! p1=$(CC), p2=$(CFLAGS), p3=$(LINKFLAGS), +$! p4=$(LIBS1), p5=$(LIBS2), p6=$(SOCKLIB), +$! p7=$(EXT), p8=$(DBG) +$! so assign to appropriate $var: +$ $cc = "'"+p1+"'" ! p1=$(CC) from make +$ $ccflags = "'"+p2+"'" ! p2=$(CFLAGS) from make +$ $ldflags = "'"+p3+"'" ! p3=$(LINKFLAGS) from make +$ $libs = "'"+p4+" "+p5+" "+p6+"'" ! p4$(LIBS1),p5$(LIBS2),p6$(SOCKLIB)frm make +$ $staticexts = "'"+p7+"'" ! p7=$(EXT) from make + +$! hard-coded stuff (for now): +$ $cppflags = "'"+"'" !(vestigal) +$ $optimize = "'"+"'" !descrip.mms has /Optimize=2 in $(XTRACCFLAGS) + +$! following assigns done via `dcl` calls in genconfig.pl anyway: +$ $osname = "'"+f$edit(f$getsyi("NODE_SWTYPE"),"COLLAPSE") !genconfig.pl has "osname='VMS'" +$ $osvers = f$edit(f$getsyi("VERSION")-"V","COLLAPSE") +$ if f$getsyi("HW_MODEL").GT.1024 +$ then $$archname = "'VMS_AXP'" !string from descrip.mms vmsperl 12-21-95 +$ else $$archname = "'VMS_VAX'" !string from descrip.mms vmsperl 12-21-95 +$ endif +$ $myname = "" +$ if $myname.eqs."" then $$myname = f$trnlnm("ARPANET_HOST_NAME") +$ if $myname.eqs."" then $$myname = f$trnlnm("INTERNET_HOST_NAME") +$ if $myname.eqs."" then $$myname = f$trnlnm("MULTINET_HOST_NAME") +$ if $myname.eqs."" then $$myname = f$trnlnm("UCX$INET_HOST_NAME") +$ if $myname.eqs."" then $$myname = f$trnlnm("TCPWARE_DOMAINNAME") +$ if $myname.eqs."" then $$myname = f$trnlnm("NEWS_ADDRESS") +$ if $myname.eqs."" then $$myname = f$trnlnm("SYS$NODE") +$! Is this same as genconfig.pl ? (spacing/order unknown): +$ $myuname=$osname+" "+$myname+" "+$osvers+" "+F$GetSyi("HW_NAME")+"'" +$ $osname = $osname+"'" +$ $osvers = "'"+$osvers+"'" + +$look_for_patchlevel_h: +$! +$ RATHER_LONG_FILENAME_TO_FIND = "PATCHLEVEL.H" +$Research_patchlevel_h: +$ RATHER_LONG_FILENAME_SEARCH = F$Search(RATHER_LONG_FILENAME_TO_FIND) +$ if RATHER_LONG_FILENAME_SEARCH.EQS."" +$ then +$ if f$parse(f$environment("DEFAULT"),,,"DIRECTORY",).NES."[000000]" +$ then +$ set default [-] +$ goto Research_patchlevel_h +$ else +$ ECHO "Can't find the header file patchlevel.h used to make config.sh" +$ set default 'RATHER_LONG_DEFAULT_DIRECTORY_NAME' +$ goto look_for_genconfig.pl +$ endif +$ endif + +$ open/read RATHER_LONG_CONFIG_FILE_HANDLE 'RATHER_LONG_FILENAME_SEARCH' +$read_patchlevel_h: +$ read/end_of_file = patchlevel_h_Done RATHER_LONG_CONFIG_FILE_HANDLE line +$ if f$locate("PATCHLEVEL",line).ne.f$length(line) +$ then +$ line = f$edit(line,"TRIM,COMPRESS") +$ $PATCHLEVEL = f$element(2," ",line) +$ if f$type($SUBVERSION).nes."" then goto patchlevel_h_Done +$ endif +$ if f$locate("SUBVERSION",line).ne.f$length(line) +$ then +$ line = f$edit(line,"TRIM,COMPRESS") +$ $SUBVERSION = f$element(2," ",line) +$ if f$type($PATCHLEVEL).nes."" then goto patchlevel_h_Done +$ endif +$ goto read_patchlevel_h + +$patchlevel_h_Done: +$ close RATHER_LONG_CONFIG_FILE_HANDLE +$ if $PATCHLEVEL.eqs."" +$ then +$ echo "warning: PATCHLEVEL was not found in ''RATHER_LONG_FILENAME_TO_FIND':" +$ endif + +$look_for_genconfig_pl: +$! +$ if f$search("VMS.DIR").nes."" then set default [.vms] +$ RATHER_LONG_FILENAME_TO_FIND = "GENCONFIG.PL" +$ genconfig_pl_dir = "" +$Research_genconfig_pl: +$ RATHER_LONG_FILENAME_SEARCH = F$Search(RATHER_LONG_FILENAME_TO_FIND) +$ if RATHER_LONG_FILENAME_SEARCH.EQS."" +$ then +$ if f$parse(f$environment("DEFAULT"),,,"DIRECTORY",).NES."[000000]" +$ then +$ set default [-] +$ goto Research_genconfig_pl +$ else +$ ECHO "Can't find the perl genconfig.pl used to make config.sh" +$ set default 'RATHER_LONG_DEFAULT_DIRECTORY_NAME' +$ goto look_for_config_vms +$ endif +$ else !genconfig.pl has been found +$ genconfig_pl_dir = f$parse(f$environment("DEFAULT"),,,"DIRECTORY",) +$ endif + +$ cnfg_keys = "package/hintfile/ld/dlext/d_stdstdio/" +$ cnfg_keys = cnfg_keys + "usevfork/usemymalloc/so/libpth/" +$ cnfg_keys = cnfg_keys + "dlsrc/cccdlflags/ccdlflags/lddlflags/" + +$ cnfg_vars = "$package/$hint/$ld/$dlext/$d_stdstdio/" +$ cnfg_vars = cnfg_vars + "$usevfork/$usemymalloc/$so/$libpth/" +$ cnfg_vars = cnfg_vars + "$dlsrc/$cccdlflags/$ccdlflags/$lddlflags/" + +$ open/read RATHER_LONG_CONFIG_FILE_HANDLE 'RATHER_LONG_FILENAME_SEARCH' +$read_genconfig_pl: +$ read/end_of_file = Genconfig_pl_Done RATHER_LONG_CONFIG_FILE_HANDLE line +$ if f$locate("=",line).ne.f$length(line) !then may be an assigment +$ then +$ name = f$edit( f$extract(0,f$locate("=",line),line), "COLLAPSE") +$ num = 0 +$key_genconfig_pl: +$ key = f$element(num,"/",cnfg_keys) +$ if (key .nes. "/").and.(key .nes. "") !not end of cnfg_keys +$ then +$ if key.eqs.name !then is key +$ then +$ start = f$locate("=",line)+1 +$ stop = f$length(line) +$ value = f$extract(start,stop-start,line) +$ var = f$element(num,"/",cnfg_vars) +$ 'var' = value +$ cnfg_keys = cnfg_keys - ("''name'/" ) !trim to shorten future matches +$ cnfg_vars = cnfg_vars - ("''var'/" ) !trim to shorten future matches +$ endif +$ num = num + 1 +$ goto key_genconfig_pl +$ endif ! not end of cnfg_keys +$ endif ! then may be an assigment +$ goto read_genconfig_pl + +$Genconfig_pl_Done: +$ close RATHER_LONG_CONFIG_FILE_HANDLE +$ if cnfg_vars.nes."" +$ then +$ echo "warning: the following variables were not found in ''RATHER_LONG_FILENAME_TO_FIND':" +$ echo "''cnfg_vars'" +$ endif + +$ if (p8.nes."").and.($ld.nes."") then $ld = $ld + " DBG='"+p8+"'" + +$look_for_config_vms: +$ RATHER_LONG_FILENAME_TO_FIND = "''genconfig_pl_dir'CONFIG.VMS" + +$Research_config_vms: +$ RATHER_LONG_FILENAME_SEARCH = F$Search(RATHER_LONG_FILENAME_TO_FIND) +$ if RATHER_LONG_FILENAME_SEARCH.EQS."" +$ then +$ if f$parse(f$environment("DEFAULT"),,,"DIRECTORY",).NES."[000000]" +$ then +$ set default [-] +$ goto Research_config_vms +$ else +$ ECHO "Can't find the perl config.vms used to make config.sh" +$ set default 'RATHER_LONG_DEFAULT_DIRECTORY_NAME' +$ stop +$ exit 3 +$ endif +$ endif + +$ cnfg_keys = "MEM_ALIGNBYTES/CASTNEGFLOAT/CASTFLAGS/RANDBITS/STDCHAR/" +$ cnfg_keys = cnfg_keys+"CASTI32/INTSIZE/VOIDFLAGS/DLSYM_NEEDS_UNDERSCORE" + +$ cnfg_vars = "$alignbytes/$d_castneg/$castflags/$randbits/$stdchar/" +$ cnfg_vars = cnfg_vars+"$d_casti32/$intsize/$voidflags/$d_dlsymun/" + +$ open/read RATHER_LONG_CONFIG_FILE_HANDLE 'RATHER_LONG_FILENAME_SEARCH' +$read_config_vms: +$ read/end_of_file = config_vms_Done RATHER_LONG_CONFIG_FILE_HANDLE line +$! look for "#define" or "#undef" +$ if (f$length(line).ne.0).and.- + ((f$locate("#define",line).eq.0).or.(f$locate("#undef",line).eq.0)) +$ then +$ line = f$edit(line,"COMPRESS, TRIM") +$ name = f$element(1," ",line) !macro +$ num = 0 +$key_config_vms: +$ key = f$element(num,"/",cnfg_keys) +$ if (key .nes. "/").and.(key .nes. "") !not end of cnfg_keys +$ then +$ if key.eqs.name !then is key +$ then +$ var = f$element(num,"/",cnfg_vars) +$ cnfg_keys = cnfg_keys - ("''name'/" ) !trim to shorten future matches +$ cnfg_vars = cnfg_vars - ("''var'/" ) !trim to shorten future matches +$ if (f$locate("#undef",line).eq.0) +$ then +$ 'var' = "'undef'" +$ else !is a #define +$strip_comment: +$ start = f$locate("/*",line) +$ if start.ne.f$length(line) !comment started +$ then +$ if f$locate("*/",line).ne.f$length(line) !comment stopped +$ then stop = f$locate("*/",line)+2 +$ else stop = f$locate("*/",line) +$ endif +$ comment = f$extract(start,stop-start,line) +$ line = line - comment +$ goto strip_comment +$ endif +$ line = f$edit(line,"TRIM") +$ start = f$locate(key,line)+f$length(key) +$ stop = f$length(line) +$ value = f$edit(f$extract(start,stop-start,line),"TRIM") +$ if (value.nes."") +$ then +$ 'var' = "'"+value+"'" +$ else +$ 'var' = "'define'" +$ endif +$ endif !#define +$ endif ! is key of interest +$ num = num + 1 +$ goto key_config_vms +$ endif ! not end of cnfg_keys +$ endif ! then may be #define or #undef of interest +$ goto read_config_vms + +$config_vms_Done: +$ close RATHER_LONG_CONFIG_FILE_HANDLE +$ if cnfg_vars.nes."" +$ then +$ echo "warning: the following variables were not found in ''RATHER_LONG_FILENAME_TO_FIND':" +$ echo "''cnfg_vars'" +$ endif + +$spit_it_out: +$! $spitshell = ECHO !<<!GROK!THIS! +$ ECHO " " +$ ECHO "Summary of my ''$package' (patchlevel ''$PATCHLEVEL' subversion ''$SUBVERSION') configuration:" +$ ECHO " Platform:" +$ ECHO " osname=''$osname', osver=''$osvers', archname=''$archname'" +$ ECHO " uname=''$myuname'" !->d_has_uname? +$ ECHO " hint=''$hint' d_sigaction='undef'" !->hintfile? +$ ECHO " static exts=''$staticexts'" ! added for VMS +$ ECHO " Compiler:" +$ ECHO " cc=''$cc', optimize=''$optimize', ld=''$ld'" +$ ECHO " cppflags=''$cppflags'" +$ ECHO " ccflags =''$ccflags'" !->vms_cc_type? +$ ECHO " ldflags =''$ldflags'" +$ ECHO " stdchar=''$stdchar', d_stdstdio=''$d_stdstdio', usevfork=''$usevfork'" +$ ECHO " voidflags=''$voidflags', castflags=''$castflags', d_casti32=''$d_casti32', d_castneg=''$d_castneg'" +$ ECHO " intsize=''$intsize', alignbytes=''$alignbytes', usemymalloc=''$usemymalloc', randbits=''$randbits'" +$ ECHO " Libraries:" +$ ECHO " so=''$so'" +$ ECHO " libpth=''$libpth'" +$ ECHO " libs=''$libs'" +$ ECHO " libc=''$libc'" +$ ECHO " Dynamic Linking:" +$ ECHO " dlsrc=''$dlsrc', dlext=''$dlext', d_dlsymun=''$d_dlsymun'" +$ ECHO " cccdlflags=''$cccdlflags', ccdlflags=''$ccdlflags', lddlflags=''$lddlflags'" +$ ECHO " " +$ !GROK!THIS! +$ SET DEFAULT 'RATHER_LONG_DEFAULT_DIRECTORY_NAME' +$ EXIT diff --git a/gnu/usr.bin/perl/vms/perlvms.pod b/gnu/usr.bin/perl/vms/perlvms.pod new file mode 100644 index 00000000000..a66df9c8df2 --- /dev/null +++ b/gnu/usr.bin/perl/vms/perlvms.pod @@ -0,0 +1,662 @@ +=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 +documentation, so we have focussed on the ways in which Perl +5 functions differently under VMS than it does under Unix, +and on the interactions between Perl and the rest of the +operating system. We haven't tried to duplicate complete +descriptions of Perl features from the main Perl +documentation, which can be found in the F<[.pod]> +subdirectory of the Perl distribution. + +We hope these notes will save you from confusion and lost +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 Installation + +Directions for building and installing Perl 5 can be found in +the file F<README.vms> in the main source directory of the +Perl distribution.. + +=head1 Organization of Perl Images + +=head2 Core Images + +During the installation process, three Perl images are produced. +F<Miniperl.Exe> is an executable image which contains all of +the basic functionality of Perl, but cannot take advantage of +Perl extensions. It is used to generate several files needed +to build the complete Perl and various extensions. Once you've +finished installing Perl, you can delete this image. + +Most of the complete Perl resides in the shareable image +F<PerlShr.Exe>, which provides a core to which the Perl executable +image and all Perl extensions are linked. You should place this +image in F<Sys$Share>, or define the logical name F<PerlShr> to +translate to the full file specification of this image. It should +be world readable. (Remember that if a user has execute only access +to F<PerlShr>, VMS will treat it as if it were a privileged shareable +image, and will therefore require all downstream shareable images to be +INSTALLed, etc.) + + +Finally, F<Perl.Exe> is an executable image containing the main +entry point for Perl, as well as some initialization code. It +should be placed in a public directory, and made world executable. +In order to run Perl with command line arguments, you should +define a foreign command to invoke this image. + +=head2 Perl Extensions + +Perl extensions are packages which provide both XS and Perl code +to add new functionality to perl. (XS is a meta-language which +simplifies writing C code which interacts with Perl, see +L<perlapi> for more details.) The Perl code for an +extension is treated like any other library module - it's +made available in your script through the appropriate +C<use> or C<require> statement, and usually defines a Perl +package containing the extension. + +The portion of the extension provided by the XS code may be +connected to the rest of Perl in either of two ways. In the +B<static> configuration, the object code for the extension is +linked directly into F<PerlShr.Exe>, and is initialized whenever +Perl is invoked. In the B<dynamic> configuration, the extension's +machine code is placed into a separate shareable image, which is +mapped by Perl's DynaLoader when the extension is C<use>d or +C<require>d in your script. This allows you to maintain the +extension as a separate entity, at the cost of keeping track of the +additional shareable image. Most extensions can be set up as either +static or dynamic. + +The source code for an extension usually resides in its own +directory. At least three files are generally provided: +I<Extshortname>F<.xs> (where I<Extshortname> is the portion of +the extension's name following the last C<::>), containing +the XS code, I<Extshortname>F<.pm>, the Perl library module +for the extension, and F<Makefile.PL>, a Perl script which uses +the C<MakeMaker> library modules supplied with Perl to generate +a F<Descrip.MMS> file for the extension. + +=head2 Installing static extensions + +Since static extensions are incorporated directly into +F<PerlShr.Exe>, you'll have to rebuild Perl to incorporate a +new extension. You should edit the main F<Descrip.MMS> or F<Makefile> +you use to build Perl, adding the extension's name to the C<ext> +macro, and the extension's object file to the C<extobj> macro. +You'll also need to build the extension's object file, either +by adding dependencies to the main F<Descrip.MMS>, or using a +separate F<Descrip.MMS> for the extension. Then, rebuild +F<PerlShr.Exe> to incorporate the new code. + +Finally, you'll need to copy the extension's Perl library +module to the F<[.>I<Extname>F<]> subdirectory under one +of the directories in C<@INC>, where I<Extname> is the name +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). + +=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<Descrip.MMS> file which can be used to build and +install the files required by the extension. The kit should be +unpacked into a directory tree B<not> under the main Perl source +directory, and the procedure for building the extension is simply + + $ perl Makefile.PL ! Create Descrip.MMS + $ mmk ! Build necessary files + $ mmk test ! Run test code, if supplied + $ mmk install ! Install into public Perl tree + +I<N.B.> The procedure by which extensions are built and +tested creates several levels (at least 4) under the +directory in which the extension's source files live. +For this reason, you shouldn't nest the source directory +too deeply in your directory structure, lest you eccedd RMS' +maximum of 8 levels of subdirectory in a filespec. (You +can use rooted logical names to get another 8 levels of +nesting, if you can't place the files near the top of +the physical directory structure.) + +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<PGPLOT> extension to Perl requires the +F<PGPLOTSHR.EXE> shareable image in order to properly link +the Perl extension, then the line C<PGPLOTSHR/Share> must +be added to the linker options file F<PGPLOT.Opt> 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<Arch>.I<Extname>F<]> directory of the +installed Perl directory tree (where I<Arch> is F<VMS_VAX> or +F<VMS_AXP>, followed by the Perl version number, and I<Extname> +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<Extname>F<]> 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 + the shareable image, or + - F<Sys$Share> or F<Sys$Library>. +If the shareable image isn't in any of these places, you'll need +to define a logical name I<Extshortname>, where I<Extshortname> +is the portion of the extension's name after the last C<::>, which +translates to the full file specification of the shareable image. + +=head1 File specifications + +=head2 Syntax + +We have tried to make Perl aware of both VMS-style and Unix- +style file specifications wherever possible. You may use +either style, or both, on the command line and in scripts, +but you may not combine the two styles within a single fle +specification. Filenames are, of course, still case- +insensitive. For consistency, most Perl routines return +filespecs using lower case letters only, regardless of the +case used in the arguments passed to them. (This is true +only when running under VMS; Perl respects the case- +sensitivity of OSs like Unix.) + +We've tried to minimize the dependence of Perl library +modules on Unix syntax, but you may find that some of these, +as well as some scripts written for Unix systems, will +require that you use Unix syntax, since they will assume that +'/' is the directory separator, I<etc.> If you find instances +of this in the Perl distribution itself, please let us know, +so we can try to work around them. + +=head2 Wildcard expansion + +File specifications containing wildcards are allowed both on +the command line and within Perl globs (e.g. <CE<lt>*.cE<gt>>). If +the wildcard filespec uses VMS syntax, the resultant +filespecs will follow VMS syntax; if a Unix-style filespec is +passed in, Unix-style filespecs will be returned. + +If the wildcard filespec contains a device or directory +specification, then the resultant filespecs will also contain +a device and directory; otherwise, device and directory +information are removed. VMS-style resultant filespecs will +contain a full device and directory, while Unix-style +resultant filespecs will contain only as much of a directory +path as was present in the input filespec. For example, if +your default directory is Perl_Root:[000000], the expansion +of C<[.t]*.*> will yield filespecs like +"perl_root:[t]base.dir", while the expansion of C<t/*/*> will +yield filespecs like "t/base.dir". (This is done to match +the behavior of glob expansion performed by Unix shells.) + +Similarly, the resultant filespec will contain the file version +only if one was present in the input filespec. + +=head2 Pipes + +Input and output pipes to Perl filehandles are supported; the +"file name" is passed to lib$spawn() for asynchronous +execution. You should be careful to close any pipes you have +opened in a Perl script, lest you leave any "orphaned" +subprocesses around when Perl exits. + +You may also use backticks to invoke a DCL subprocess, whose +output is used as the return value of the expression. The +string between the backticks is passed directly to lib$spawn +as the command to execute. In this case, Perl will wait for +the subprocess to complete before continuing. + +=head1 PERL5LIB and PERLLIB + +The PERL5LIB and PERLLIB logical names work as documented L<perl>, +except that the element separator is '|' instead of ':'. The +directory specifications may use either VMS or Unix syntax. + +=head1 Command line + +=head2 I/O redirection and backgrounding + +Perl for VMS supports redirection of input and output on the +command line, using a subset of Bourne shell syntax: + <F<file> reads stdin from F<file>, + >F<file> writes stdout to F<file>, + >>F<file> appends stdout to F<file>, + 2>F<file> writes stderr to F<file>, and + 2>>F<file> appends stderr to F<file>. + +In addition, output may be piped to a subprocess, using the +character '|'. Anything after this character on the command +line is passed to a subprocess for execution; the subprocess +takes the output of Perl as its input. + +Finally, if the command line ends with '&', the entire +command is run in the background as an asynchronous +subprocess. + +=head2 Command line switches + +The following command line switches behave differently under +VMS than described in L<perlrun>. Note also that in order +to pass uppercase switches to Perl, you need to enclose +them in double-quotes on the command line, since the CRTL +downcases all unquoted strings. + +=item -S + +If the C<-S> switch is present I<and> the script name does +not contain a directory, then Perl translates the logical +name DCL$PATH as a searchlist, using each translation as +a directory in which to look for the script. In addition, +if no file type is specified, Perl looks in each directory +for a file matching the name specified, with a blank type, +a type of F<.pl>, and a type of F<.com>, in that order. + +=item -u + +The C<-u> switch causes the VMS debugger to be invoked +after the Perl program is compiled, but before it has +run. It does not create a core dump file. + +=head1 Perl functions + +As of the time this document was last revised, the following +Perl functions were implemented in the VMS port of Perl +(functions marked with * are discussed in more detail below): + + file tests*, abs, alarm, atan, binmode*, bless, + caller, chdir, chmod, chown, chomp, chop, chr, + close, closedir, cos, crypt*, defined, delete, + die, do, dump*, each, endpwent, eof, eval, exec*, + exists, exit, exp, fileno, fork*, getc, getlogin, + getpwent*, getpwnam*, 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), + 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 +undefined behavior (rarely, we hope): + + chroot, dbmclose, dbmopen, fcntl, flock, + getpgrp, getppid, getpriority, getgrent, getgrgid, + getgrnam, setgrent, endgrent, ioctl, link, lstat, + msgctl, msgget, msgsend, msgrcv, readlink, 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 +your copy of Perl: + + accept, bind, connect, getpeername, + gethostbyname, getnetbyname, getprotobyname, + getservbyname, gethostbyaddr, getnetbyaddr, + getprotobynumber, getservbyport, gethostent, + getnetent, getprotoent, getservent, sethostent, + setnetent, setprotoent, setservent, endhostent, + endnetent, endprotoent, endservent, getsockname, + getsockopt, listen, recv, select(system call)*, + send, setsockopt, shutdown, socket + + +=item File tests + +The tests C<-b>, C<-B>, C<-c>, C<-C>, C<-d>, C<-e>, C<-f>, +C<-o>, C<-M>, C<-s>, C<-S>, C<-t>, C<-T>, and C<-z> work as +advertised. The return values for C<-r>, C<-w>, and C<-x> +tell you whether you can actually access the file; this may +not reflect the UIC-based file protections. Since real and +effective UIC don't differ under VMS, C<-O>, C<-R>, C<-W>, +and C<-X> are equivalent to C<-o>, C<-r>, C<-w>, and C<-x>. +Similarly, several other tests, including C<-A>, C<-g>, C<-k>, +C<-l>, C<-p>, and C<-u>, aren't particularly meaningful under +VMS, and the values returned by these tests reflect whatever +your CRTL C<stat()> routine does to the equivalent bits in the +st_mode field. Finally, C<-d> returns true if passed a device +specification without an explicit directory (e.g. C<DUA1:>), as +well as if passed a directory. + +Note: Some sites have reported problems when using the file-access +tests (C<-r>, C<-w>, and C<-x>) on files accessed via DEC's DFS. +Specifically, since DFS does not currently provide access to the +extended file header of files on remote volumes, attempts to +examine the ACL fail, and the file tests will return false, +with C<$!> indicating that the file does not exist. You can +use C<stat> on these files, since that checks UIC-based protection +only, and then manually check the appropriate bits, as defined by +your C compiler's F<stat.h>, in the mode value it returns, if you +need an approximation of the file's protections. + +=item binmode FILEHANDLE + +The C<binmode> operator has no effect under VMS. It will +return TRUE whenever called, but will not affect I/O +operations on the filehandle given as its argument. + +=item crypt PLAINTEXT, USER + +The C<crypt> operator uses the C<sys$hash_password> system +service to generate the hashed representation of PLAINTEXT. +If USER is a valid username, the algorithm and salt values +are taken from that user's UAF record. If it is not, then +the preferred algorithm and a salt of 0 are used. The +quadword encrypted value is returned as an 8-character string. + +The value returned by C<crypt> may be compared against +the encrypted password from the UAF returned by the C<getpw*> +functions, in order to authenticate users. If you're +going to do this, remember that the encrypted password in +the UAF was generated using uppercase username and +password strings; you'll have to upcase the arguments to +C<crypt> to insure that you'll get the proper value: + + sub validate_passwd { + my($user,$passwd) = @_; + my($pwdhash); + if ( !($pwdhash = (getpwnam($user))[1]) || + $pwdhash ne crypt("\U$passwd","\U$name") ) { + intruder_alert($name); + } + return 1; + } + +=item dump + +Rather than causing Perl to abort and dump core, the C<dump> +operator invokes the VMS debugger. If you continue to +execute the Perl program under the debugger, control will +be transferred to the label specified as the argument to +C<dump>, or, if no label was specified, back to the +beginning of the program. All other state of the program +(I<e.g.> values of variables, open file handles) are not +affected by calling C<dump>. + +=item exec LIST + +The C<exec> operator behaves in one of two different ways. +If called after a call to C<fork>, it will invoke the CRTL +C<execv()> routine, passing its arguments to the subprocess +created by C<fork> for execution. In this case, it is +subject to all limitations that affect C<execv()>. (In +particular, this usually means that the command executed in +the subprocess must be an image compiled from C source code, +and that your options for passing file descriptors and signal +handlers to the subprocess are limited.) + +If the call to C<exec> does not follow a call to C<fork>, it +will cause Perl to exit, and to invoke the command given as +an argument to C<exec> via C<lib$do_command>. If the argument +begins with a '$' (other than as part of a filespec), then it +is executed as a DCL command. Otherwise, the first token on +the command line is treated as the filespec of an image to +run, and an attempt is made to invoke it (using F<.Exe> and +the process defaults to expand the filespec) and pass the +rest of C<exec>'s argument to it as parameters. + +You can use C<exec> in both ways within the same script, as +long as you call C<fork> and C<exec> in pairs. Perl +keeps track of how many times C<fork> and C<exec> have been +called, and will call the CRTL C<execv()> routine if there have +previously been more calls to C<fork> than to C<exec>. + +=item fork + +The C<fork> operator works in the same way as the CRTL +C<vfork()> routine, which is quite different under VMS than +under Unix. Specifically, while C<fork> returns 0 after it +is called and the subprocess PID after C<exec> is called, in +both cases the thread of execution is within the parent +process, so there is no opportunity to perform operations in +the subprocess before calling C<exec>. + +In general, the use of C<fork> and C<exec> to create +subprocess is not recommended under VMS; wherever possible, +use the C<system> operator or piped filehandles instead. + +=item getpwent + +=item getpwnam + +=item getpwuid + +These operators obtain the information described in L<perlfunc>, +if you have the privileges necessary to retrieve the named user's +UAF information via C<sys$getuai>. If not, then only the C<$name>, +C<$uid>, and C<$gid> items are returned. The C<$dir> item contains +the login directory in VMS syntax, while the C<$comment> item +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<gmtime> operator will function properly if you have a +working CRTL C<gmtime()> 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<undef> is returned. + +=item kill + +In most cases, C<kill> kill is implemented via the CRTL's C<kill()> +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<kill()> +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<select> is not available at all. If socket +support is present, then the system call version of +C<select> functions only for file descriptors attached +to sockets. It will not provide information about regular +files or pipes, since the CRTL C<select()> routine does not +provide this functionality. + +=item stat EXPR + +Since VMS keeps track of files according to a different scheme +than Unix, it's not really possible to represent the file's ID +in the C<st_dev> and C<st_ino> fields of a C<struct stat>. Perl +tries its best, though, and the values it uses are pretty unlikely +to be the same for two different files. We can't guarantee this, +though, so caveat scriptor. + +=item system LIST + +The C<system> operator creates a subprocess, and passes its +arguments to the subprocess for execution as a DCL command. +Since the subprocess is created directly via C<lib$spawn()>, any +valid DCL command string may be specified. If LIST consists +of the empty string, C<system> spawns an interactive DCL subprocess, +in the same fashion as typiing B<SPAWN> at the DCL prompt. +Perl waits for the subprocess to complete before continuing +execution in the current process. + +=item times + +The array returned by the C<times> operator is divided up +according to the same rules the CRTL C<times()> routine. +Therefore, the "system time" elements will always be 0, since +there is no difference between "user time" and "system" time +under VMS, and the time accumulated by subprocess may or may +not appear separately in the "child time" field, depending on +whether L<times> keeps track of subprocesses separately. Note +especially that the VAXCRTL (at least) keeps track only of +subprocesses spawned using L<fork> and L<exec>; it will not +accumulate the times of suprocesses spawned via pipes, L<system>, +or backticks. + +=item unlink LIST + +C<unlink> will delete the highest version of a file only; in +order to delete all versions, you need to say + 1 while (unlink LIST); +You may need to make this change to scripts written for a +Unix system which expect that after a call to C<unlink>, +no files with the names passed to C<unlink> will exist. +(Note: This can be changed at compile time; if you +C<use Config> and C<$Config{'d_unlink_all_versions'}> is +C<define>, then C<unlink> will delete all versions of a +file on the first call.) + +C<unlink> will delete a file if at all possible, even if it +requires changing file protection (though it won't try to +change the protection of the parent directory). You can tell +whether you've got explicit delete access to a file by using the +C<VMS::Filespec::candelete> operator. For instance, in order +to delete only files to which you have delete access, you could +say something like + + sub safe_unlink { + my($file,$num); + foreach $file (@_) { + next unless VMS::Filespec::candelete($file); + $num += unlink $file; + } + $num; + } + +(or you could just use C<VMS::Stdio::remove>, if you've installed +the VMS::Stdio extension distributed with Perl). If C<unlink> has to +change the file protection to delete the file, and you interrupt it +in midstream, the file may be left intact, but with a changed ACL +allowing you delete access. + +=item utime LIST + +Since ODS-2, the VMS file structure for disk files, does not keep +track of access times, this operator changes only the modification +time of the file (VMS revision date). + +=item waitpid PID,FLAGS + +If PID is a subprocess started by a piped L<open>, C<waitpid> +will wait for that subprocess, and return its final +status value. If PID is a subprocess created in some other way +(e.g. SPAWNed before Perl was invoked), or is not a subprocess of +the current process, C<waitpid> will check once per second whether +the process has completed, and when it has, will return 0. (If PID +specifies a process that isn't a subprocess of the current process, +and you invoked Perl with the C<-w> switch, a warning will be issued.) + +The FLAGS argument is ignored in all cases. + +=head1 Perl variables + +=item %ENV + +Reading the elements of the %ENV array returns the +translation of the logical name specified by the key, +according to the normal search order of access modes and +logical name tables. If you append a semicolon to the +logical name, followed by an integer, that integer is +used as the translation index for the logical name, +so that you can look up successive values for search +list logical names. For instance, if you say + + $ Define STORY once,upon,a,time,there,was + $ perl -e "for ($i = 0; $i <= 6; $i++) " - + _$ -e "{ print $ENV{'foo'.$i},' '}" + +Perl will print C<ONCE UPON A TIME THERE WAS>. + +The %ENV keys C<home>, C<path>,C<term>, and C<user> +return the CRTL "environment variables" of the same +names, if these logical names are not defined. The +key C<default> returns the current default device +and directory specification, regardless of whether +there is a logical name DEFAULT defined.. + +Setting an element of %ENV defines a supervisor-mode logical +name in the process logical name table. C<Undef>ing or +C<delete>ing an element of %ENV deletes the equivalent user- +mode or supervisor-mode logical name from the process logical +name table. If you use C<undef>, the %ENV element remains +empty. If you use C<delete>, another attempt is made at +logical name translation after the deletion, so an inner-mode +logical name or a name in another logical name table will +replace the logical name just deleted. It is not possible +at present to define a search list logical name via %ENV. + +In all operations on %ENV, the key string is treated as if it +were entirely uppercase, regardless of the case actually +specified in the Perl expression. + +=item $? + +Since VMS status values are 32 bits wide, the value of C<$?> +is simply the final status value of the last subprocess to +complete. This differs from the behavior of C<$?> under Unix, +and under VMS' POSIX environment, in that the low-order 8 bits +of C<$?> do not specify whether the process terminated normally +or due to a signal, and you do not need to shift C<$?> 8 bits +to the right in order to find the process' exit status. + +=item $! + +The string value of C<$!> is that returned by the CRTL's +strerror() function, so it will include the VMS message for +VMS-specific errors. The numeric value of C<$!> is the +value of C<errno>, except if errno is EVMSERR, in which +case C<$!> contains the value of vaxc$errno. Setting C<$!> +always sets errno to the value specified. If this value is +EVMSERR, it also sets vaxc$errno to 4 (NONAME-F-NOMSG), so +that the string value of C<$!> won't reflect the VMS error +message from before C<$!> was set. + +=item $^E + +This variable provides direct access to VMS status values +in vaxc$errno, which are often more specific than the +generic Unix-style error messages in C<$!>. Its numeric value +is the value of vaxc$errno, and its string value is the +corresponding VMS message string, as retrieved by sys$getmsg(). +Setting C<$^E> sets vaxc$errno to the value specified. + +=item $| + +Setting C<$|> for an I/O stream causes data to be flushed +all the way to disk on each write (I<i.e.> not just to +the underlying RMS buffers for a file). In other words, +it's equivalent to calling fflush() and fsync() from C. + +=head1 Revision date + +This document was last updated on 28-Feb-1996, for Perl 5, +patchlevel 2. + +=head1 AUTHOR + +Charles Bailey bailey@genetics.upenn.edu + diff --git a/gnu/usr.bin/perl/vms/perly_c.vms b/gnu/usr.bin/perl/vms/perly_c.vms new file mode 100644 index 00000000000..99046823998 --- /dev/null +++ b/gnu/usr.bin/perl/vms/perly_c.vms @@ -0,0 +1,2322 @@ +/* Postprocessed by vms_yfix.pl 1.1 to add VMS declarations of globals */ +#ifndef lint +static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91"; +#endif +#define YYBYACC 1 +#line 16 "perly.y" +#include "EXTERN.h" +#include "perl.h" + +static void +dep() +{ + deprecate("\"do\" to call subroutines"); +} + +#define YYERRCODE 256 +dEXT short yylhs[] = { -1, + 31, 0, 5, 3, 6, 6, 6, 7, 7, 7, + 7, 21, 21, 21, 21, 21, 21, 11, 11, 11, + 9, 9, 9, 9, 30, 30, 8, 8, 8, 8, + 8, 8, 8, 8, 10, 10, 25, 25, 29, 29, + 1, 1, 1, 1, 2, 2, 32, 32, 28, 28, + 4, 33, 33, 34, 13, 13, 13, 12, 12, 12, + 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 22, 22, 23, 23, 23, 20, + 15, 16, 17, 18, 19, 24, 24, 24, 24, +}; +dEXT short yylen[] = { 2, + 0, 2, 4, 0, 0, 2, 2, 2, 1, 2, + 3, 1, 1, 3, 3, 3, 3, 0, 2, 6, + 6, 6, 4, 4, 0, 2, 7, 7, 5, 5, + 8, 7, 10, 3, 0, 1, 0, 1, 0, 1, + 1, 1, 1, 1, 4, 3, 5, 5, 0, 1, + 0, 3, 2, 5, 3, 3, 1, 2, 3, 1, + 3, 5, 6, 3, 5, 2, 4, 4, 1, 1, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 5, 3, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 3, 2, 3, 2, 4, 3, + 4, 1, 5, 1, 4, 5, 4, 1, 1, 1, + 5, 6, 5, 6, 5, 4, 5, 1, 1, 3, + 4, 3, 2, 2, 4, 5, 4, 5, 1, 2, + 2, 1, 2, 2, 2, 1, 3, 1, 3, 4, + 4, 6, 1, 1, 0, 1, 0, 1, 2, 2, + 2, 2, 2, 2, 2, 1, 1, 1, 1, +}; +dEXT short yydefred[] = { 1, + 0, 5, 0, 40, 51, 51, 0, 51, 6, 41, + 7, 9, 0, 42, 43, 44, 0, 0, 0, 53, + 0, 12, 4, 143, 0, 0, 118, 0, 138, 0, + 51, 51, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 10, 0, 0, 0, + 0, 0, 0, 0, 0, 8, 0, 0, 0, 0, + 0, 108, 110, 0, 0, 0, 144, 0, 46, 0, + 52, 0, 5, 156, 159, 158, 157, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 154, 0, 124, + 0, 0, 0, 0, 0, 0, 150, 0, 0, 0, + 0, 66, 0, 133, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 98, 0, 151, 152, 153, 155, + 0, 34, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 90, 91, 0, 0, 0, 0, + 0, 0, 0, 0, 11, 45, 50, 0, 0, 0, + 64, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 36, 0, 137, 139, + 0, 0, 0, 0, 0, 0, 100, 0, 122, 0, + 0, 0, 97, 26, 0, 0, 0, 0, 0, 0, + 55, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 69, 0, 70, + 0, 0, 0, 0, 0, 0, 0, 120, 0, 48, + 47, 54, 3, 0, 141, 0, 68, 101, 0, 29, + 0, 30, 0, 0, 0, 23, 0, 24, 0, 0, + 0, 140, 149, 67, 0, 125, 0, 127, 0, 99, + 0, 0, 0, 0, 0, 0, 0, 107, 0, 105, + 0, 116, 0, 121, 65, 0, 0, 0, 0, 19, + 0, 0, 0, 0, 0, 62, 126, 128, 115, 0, + 113, 0, 0, 106, 0, 111, 117, 103, 142, 27, + 28, 21, 0, 22, 0, 32, 0, 114, 112, 63, + 0, 0, 31, 0, 0, 20, 33, +}; +dEXT short yydgoto[] = { 1, + 9, 10, 83, 17, 86, 3, 11, 12, 66, 195, + 266, 67, 202, 69, 70, 71, 72, 73, 74, 75, + 197, 122, 203, 88, 187, 77, 241, 178, 13, 142, + 2, 14, 15, 16, +}; +dEXT short yysindex[] = { 0, + 0, 0, -82, 0, 0, 0, -52, 0, 0, 0, + 0, 0, 853, 0, 0, 0, -80, -256, -19, 0, + -245, 0, 0, 0, 19, 19, 0, 20, 0, 2177, + 0, 0, -2, 1, 28, 41, 133, 2177, 27, 33, + 52, 19, 1028, 2177, 1303, -210, 19, 2177, 965, 1359, + 2177, 2177, 2177, 2177, 2177, 1415, 0, 2177, 2177, 1478, + 19, 19, 19, 19, -225, 0, 71, 209, 1535, -49, + -30, 0, 0, 8, 101, 42, 0, 30, 0, -112, + 0, 2177, 0, 0, 0, 0, 0, 2177, 127, 2177, + 1535, 30, -112, 2177, 30, 2177, 30, 2177, 30, 2177, + 30, 1712, 128, 1535, 139, 1768, 965, 0, 141, 0, + 1485, -14, 1485, 65, -42, 2177, 0, 71, 0, 71, + -49, 0, 2177, 0, 1485, 334, 334, 334, -47, -47, + 92, -26, 334, 334, 0, 63, 0, 0, 0, 0, + 30, 0, 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, + 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, + 2177, 2177, 2177, 2177, 0, 0, -27, 2177, 2177, 2177, + 2177, 2177, 2177, 1824, 0, 0, 0, -48, 137, -92, + 0, 2177, 221, 2177, 30, -191, 151, -225, -22, -225, + -12, -147, 7, -147, 138, 5, 0, 2177, 0, 0, + 9, -39, 160, 2177, 1887, 2121, 0, 77, 0, 71, + 2177, 113, 0, 0, 1535, -191, -191, -191, -191, -86, + 0, -20, 395, 1485, 1566, 461, -88, 1535, 4122, 1064, + 679, 364, 1120, 728, 334, 334, 2177, 0, 2177, 0, + 174, 89, 51, 98, 55, 118, 57, 0, 11, 0, + 0, 0, 0, 175, 0, 2177, 0, 0, 30, 0, + 30, 0, 30, 30, 178, 0, 30, 0, 2177, 30, + 15, 0, 0, 0, 22, 0, 25, 0, 29, 0, + 152, 2177, 94, 2177, 59, 177, 2177, 0, 96, 0, + 97, 0, 102, 0, 0, 1190, -225, -225, -147, 0, + 2177, -147, 176, -225, 30, 0, 0, 0, 0, 205, + 0, 3039, 111, 0, 206, 0, 0, 0, 0, 0, + 0, 0, 37, 0, 1712, 0, -225, 0, 0, 0, + 30, 208, 0, -147, 30, 0, 0, +}; +dEXT short yyrindex[] = { 0, + 0, 0, 297, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 2253, 505, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 2847, 2935, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 107, 0, -35, 10, 53, 3109, + 3156, 0, 0, 2298, 1976, 0, 0, 0, 0, -23, + 0, 230, 0, 0, 0, 0, 0, 2385, 0, 0, + 1004, 0, 168, 253, 0, 0, 0, 0, 0, 0, + 0, 254, 0, 2242, 0, 0, 274, 0, 2032, 0, + 3844, 3109, 3902, 0, 0, 2385, 0, 2440, 452, 2554, + 572, 0, 0, 0, 3981, 3274, 3312, 3421, 3200, 3237, + 2661, 0, 3560, 3596, 0, 0, 0, 0, 0, 0, + 0, 0, 2714, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 909, + 0, 274, 0, 2385, 0, 39, 0, 107, 0, 107, + 0, 170, 0, 170, 0, 262, 0, 0, 0, 0, + 0, 288, 0, 0, 0, 0, 0, 0, 0, 2805, + 0, 2757, 0, 0, 2650, 49, 58, 61, 64, 365, + 0, 0, -31, 4018, 4028, 3719, 630, 2995, 0, 1623, + 4106, 4096, 4064, 3756, 3640, 3683, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 277, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 274, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 107, 107, 170, 0, + 0, 170, 0, 107, 0, 0, 0, 0, 0, 0, + 0, 13, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 300, 0, 107, 0, 0, 0, + 0, 0, 0, 170, 0, 0, 0, +}; +dEXT short yygindex[] = { 0, + 0, 0, 0, 506, -13, 255, 0, 0, 0, 18, + -180, 839, -11, 4398, 2162, 0, 0, 0, 0, 0, + 342, -57, -174, 1032, 90, 0, 0, 267, 0, -172, + 0, 0, 0, 0, +}; +#define YYTABLESIZE 4682 +dEXT short yytable[] = { 65, + 80, 68, 168, 79, 273, 57, 20, 254, 61, 80, + 250, 82, 80, 268, 212, 260, 208, 262, 261, 95, + 97, 99, 101, 57, 179, 206, 80, 80, 263, 110, + 181, 80, 253, 115, 150, 49, 124, 94, 283, 81, + 96, 170, 23, 168, 132, 270, 116, 267, 136, 272, + 13, 294, 141, 83, 61, 305, 83, 57, 209, 90, + 172, 80, 306, 239, 176, 307, 105, 98, 13, 308, + 83, 83, 106, 169, 23, 150, 170, 331, 184, 38, + 100, 188, 186, 190, 189, 192, 191, 194, 193, 16, + 196, 107, 171, 60, 201, 237, 60, 38, 17, 49, + 175, 14, 148, 149, 15, 83, 25, 16, 169, 289, + 60, 60, 315, 291, 143, 293, 17, 313, 322, 14, + 23, 324, 15, 23, 320, 321, 257, 214, 264, 265, + 173, 326, 216, 217, 218, 219, 220, 221, 222, 25, + 174, 23, 25, 25, 25, 60, 25, 177, 25, 25, + 23, 25, 23, 336, 333, 213, 242, 243, 244, 245, + 246, 247, 249, 23, 251, 25, 182, 198, 61, 18, + 25, 258, 102, 4, 5, 6, 78, 7, 8, 199, + 205, 288, 211, 4, 5, 6, 271, 7, 8, 207, + 290, 259, 275, 277, 279, 252, 269, 25, 154, 281, + 274, 280, 18, 282, 19, 18, 18, 18, 149, 18, + 292, 18, 18, 287, 18, 295, 163, 301, 311, 164, + 316, 317, 165, 166, 167, 285, 318, 286, 18, 25, + 238, 25, 25, 18, 325, 329, 57, 57, 57, 57, + 80, 80, 80, 80, 309, 297, 330, 298, 335, 299, + 300, 148, 149, 302, 148, 149, 304, 186, 57, 57, + 18, 255, 80, 80, 256, 167, 80, 148, 149, 314, + 310, 148, 149, 148, 149, 84, 144, 145, 146, 147, + 85, 148, 149, 157, 83, 83, 83, 83, 145, 323, + 49, 327, 18, 37, 18, 18, 2, 328, 148, 149, + 148, 149, 148, 149, 148, 149, 83, 83, 148, 149, + 83, 168, 35, 68, 147, 148, 149, 334, 148, 149, + 13, 337, 148, 149, 60, 60, 60, 60, 148, 39, + 148, 149, 39, 39, 39, 37, 39, 180, 39, 39, + 35, 39, 332, 150, 148, 149, 60, 60, 148, 149, + 148, 149, 148, 149, 76, 39, 148, 149, 303, 185, + 39, 0, 25, 25, 25, 25, 25, 25, 0, 25, + 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, + 25, 25, 148, 149, 0, 25, 25, 39, 25, 25, + 25, 148, 149, 0, 0, 25, 25, 25, 25, 25, + 0, 0, 25, 25, 0, 56, 0, 0, 56, 25, + 0, 148, 149, 25, 0, 25, 25, 0, 0, 39, + 0, 0, 39, 56, 168, 18, 18, 18, 18, 18, + 18, 0, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 148, 149, 0, 18, 18, + 0, 18, 18, 18, 168, 0, 150, 56, 18, 18, + 18, 18, 18, 0, 0, 18, 18, 0, 0, 0, + 148, 149, 18, 0, 0, 0, 18, 0, 18, 18, + 144, 145, 146, 147, 156, 168, 150, 156, 156, 156, + 0, 156, 143, 156, 156, 143, 156, 0, 148, 149, + 0, 151, 148, 149, 0, 152, 153, 154, 155, 143, + 143, 18, 0, 21, 143, 156, 0, 150, 156, 158, + 159, 160, 161, 0, 162, 163, 0, 0, 164, 0, + 0, 165, 166, 167, 0, 0, 92, 93, 0, 0, + 0, 0, 143, 0, 143, 136, 0, 0, 136, 0, + 0, 168, 39, 39, 39, 39, 39, 39, 0, 39, + 39, 39, 136, 136, 0, 39, 0, 136, 39, 39, + 39, 39, 0, 0, 143, 39, 39, 156, 39, 39, + 39, 0, 0, 150, 0, 39, 39, 39, 39, 39, + 0, 0, 39, 39, 0, 136, 0, 136, 0, 39, + 0, 0, 0, 39, 157, 39, 39, 157, 157, 157, + 0, 157, 102, 157, 157, 102, 157, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 136, 0, 102, + 102, 0, 0, 0, 102, 157, 56, 56, 56, 56, + 0, 164, 0, 0, 165, 166, 167, 0, 152, 153, + 154, 155, 0, 0, 0, 0, 0, 0, 56, 0, + 0, 0, 0, 0, 102, 161, 0, 162, 163, 0, + 74, 164, 0, 74, 165, 166, 167, 0, 0, 152, + 153, 154, 155, 0, 0, 0, 0, 74, 74, 0, + 0, 0, 74, 158, 159, 160, 161, 157, 162, 163, + 0, 0, 164, 0, 0, 165, 166, 167, 156, 156, + 156, 156, 156, 0, 156, 156, 156, 0, 0, 0, + 156, 0, 74, 143, 143, 143, 143, 0, 0, 0, + 0, 156, 143, 156, 156, 156, 143, 143, 143, 143, + 156, 156, 156, 156, 156, 143, 143, 156, 156, 143, + 143, 143, 143, 143, 156, 143, 143, 0, 156, 143, + 156, 156, 143, 143, 143, 163, 0, 0, 164, 168, + 0, 165, 166, 167, 0, 0, 136, 136, 136, 136, + 0, 0, 0, 0, 0, 136, 0, 0, 0, 136, + 136, 136, 136, 0, 0, 0, 0, 0, 136, 136, + 0, 150, 136, 136, 136, 136, 136, 0, 136, 136, + 0, 0, 136, 0, 0, 136, 136, 136, 168, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 157, 157, + 157, 157, 157, 0, 157, 157, 157, 0, 0, 0, + 157, 0, 0, 102, 102, 102, 102, 0, 0, 0, + 150, 157, 102, 157, 157, 157, 102, 102, 102, 102, + 157, 157, 157, 157, 157, 102, 102, 157, 157, 102, + 102, 102, 102, 102, 157, 102, 102, 0, 157, 102, + 157, 157, 102, 102, 102, 51, 118, 120, 61, 63, + 47, 0, 56, 0, 64, 59, 0, 58, 0, 0, + 0, 74, 74, 74, 74, 0, 0, 0, 0, 0, + 74, 57, 0, 0, 74, 74, 62, 74, 0, 0, + 120, 0, 0, 74, 74, 0, 120, 74, 74, 74, + 74, 74, 0, 74, 0, 0, 0, 0, 0, 0, + 0, 39, 0, 60, 39, 39, 39, 0, 39, 0, + 39, 39, 0, 39, 120, 0, 0, 0, 0, 0, + 0, 210, 0, 152, 153, 154, 155, 39, 0, 0, + 0, 0, 39, 0, 0, 23, 0, 0, 52, 160, + 161, 0, 162, 163, 0, 0, 164, 0, 0, 165, + 166, 167, 0, 0, 0, 0, 0, 51, 0, 39, + 61, 63, 47, 0, 56, 0, 64, 59, 0, 58, + 0, 0, 0, 0, 154, 155, 0, 0, 0, 0, + 0, 0, 120, 0, 0, 0, 0, 0, 62, 0, + 0, 39, 163, 0, 39, 164, 0, 0, 165, 166, + 167, 0, 0, 0, 135, 0, 0, 135, 0, 0, + 0, 0, 0, 0, 0, 60, 0, 89, 0, 0, + 51, 135, 135, 61, 63, 47, 0, 56, 0, 64, + 59, 0, 58, 108, 0, 0, 0, 0, 117, 0, + 123, 0, 0, 0, 0, 0, 0, 23, 0, 0, + 52, 62, 137, 138, 139, 140, 135, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 22, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 60, 0, + 0, 32, 0, 0, 33, 34, 35, 36, 0, 0, + 0, 37, 38, 0, 39, 40, 41, 0, 204, 0, + 0, 42, 43, 44, 45, 46, 0, 0, 48, 49, + 23, 0, 0, 52, 168, 50, 0, 0, 0, 53, + 0, 54, 55, 0, 39, 39, 39, 39, 39, 39, + 0, 39, 39, 39, 0, 0, 0, 39, 0, 0, + 39, 39, 39, 39, 0, 0, 150, 39, 39, 0, + 39, 39, 39, 0, 0, 0, 0, 39, 39, 39, + 39, 39, 0, 0, 39, 39, 0, 0, 0, 0, + 168, 39, 0, 0, 0, 39, 0, 39, 39, 0, + 0, 119, 25, 26, 27, 28, 85, 29, 30, 31, + 319, 0, 0, 32, 0, 0, 0, 0, 0, 0, + 0, 0, 150, 0, 38, 0, 39, 40, 41, 0, + 0, 0, 157, 42, 43, 44, 45, 46, 0, 0, + 48, 49, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 53, 0, 54, 55, 135, 135, 135, 135, 0, + 168, 0, 0, 0, 109, 25, 26, 27, 28, 0, + 29, 30, 31, 0, 0, 0, 32, 135, 135, 0, + 0, 0, 0, 0, 0, 0, 0, 38, 0, 39, + 40, 41, 150, 0, 0, 0, 42, 43, 44, 45, + 46, 0, 0, 48, 49, 0, 0, 0, 0, 0, + 50, 0, 0, 0, 53, 51, 54, 55, 61, 63, + 47, 0, 56, 0, 64, 59, 0, 58, 152, 153, + 154, 155, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 114, 0, 159, 160, 161, 62, 162, 163, 0, + 0, 164, 0, 0, 165, 166, 167, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 51, 0, 60, 61, 63, 47, 0, 56, 0, + 64, 59, 0, 58, 152, 153, 154, 155, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 62, 162, 163, 0, 0, 164, 52, 0, + 165, 166, 167, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 51, 0, 60, + 61, 63, 47, 0, 56, 131, 64, 59, 0, 58, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 151, 0, 0, 0, 152, 153, 154, 155, 62, 0, + 0, 23, 0, 0, 52, 0, 0, 156, 158, 159, + 160, 161, 0, 162, 163, 0, 0, 164, 0, 0, + 165, 166, 167, 0, 0, 60, 0, 0, 0, 0, + 51, 0, 0, 61, 63, 47, 0, 56, 0, 64, + 59, 0, 58, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 52, 62, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 60, 0, + 135, 32, 0, 0, 0, 168, 0, 0, 0, 0, + 0, 0, 38, 0, 39, 40, 41, 0, 0, 0, + 0, 42, 43, 44, 45, 46, 0, 157, 48, 49, + 0, 0, 0, 52, 0, 50, 0, 150, 0, 53, + 0, 54, 55, 0, 0, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 0, 168, 0, 32, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 38, 0, + 39, 40, 41, 0, 0, 0, 0, 42, 43, 44, + 45, 46, 0, 0, 48, 49, 168, 150, 0, 0, + 0, 50, 0, 82, 0, 53, 82, 54, 55, 0, + 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 82, 82, 0, 32, 0, 82, 0, 0, 150, 0, + 0, 0, 0, 0, 38, 0, 39, 40, 41, 0, + 0, 0, 0, 42, 43, 44, 45, 46, 0, 0, + 48, 49, 0, 0, 0, 82, 0, 50, 0, 0, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 0, 51, 0, 32, 61, 63, 47, + 0, 56, 0, 64, 59, 0, 58, 38, 0, 39, + 40, 41, 0, 0, 0, 0, 42, 43, 44, 45, + 46, 154, 155, 48, 49, 62, 0, 0, 0, 0, + 50, 0, 0, 0, 53, 0, 54, 55, 162, 163, + 0, 0, 164, 0, 0, 165, 166, 167, 0, 0, + 51, 0, 60, 61, 63, 47, 0, 56, 200, 64, + 59, 0, 58, 0, 0, 151, 0, 0, 0, 152, + 153, 154, 155, 0, 0, 0, 0, 0, 0, 0, + 0, 62, 156, 158, 159, 160, 161, 52, 162, 163, + 0, 0, 164, 0, 0, 165, 166, 167, 0, 0, + 152, 0, 154, 155, 0, 0, 51, 0, 60, 61, + 63, 47, 0, 56, 248, 64, 59, 0, 58, 162, + 163, 0, 0, 164, 0, 0, 165, 166, 167, 0, + 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, + 0, 0, 0, 52, 82, 82, 82, 82, 0, 0, + 0, 0, 0, 82, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 60, 0, 82, 82, 0, 51, + 82, 82, 61, 63, 47, 0, 56, 276, 64, 59, + 0, 58, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 52, + 62, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 22, 24, 25, + 26, 27, 28, 0, 29, 30, 31, 60, 0, 0, + 32, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 38, 0, 39, 40, 41, 0, 0, 0, 0, + 42, 43, 44, 45, 46, 0, 0, 48, 49, 0, + 0, 0, 52, 0, 50, 0, 119, 0, 53, 119, + 54, 55, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 119, 119, 0, 32, 0, 119, 0, + 0, 0, 0, 0, 0, 0, 0, 38, 0, 39, + 40, 41, 0, 0, 0, 0, 42, 43, 44, 45, + 46, 0, 0, 48, 49, 0, 119, 0, 119, 0, + 50, 0, 143, 0, 53, 143, 54, 55, 0, 0, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 143, + 143, 0, 32, 0, 143, 0, 0, 0, 119, 0, + 0, 0, 0, 38, 0, 39, 40, 41, 0, 0, + 0, 0, 42, 43, 44, 45, 46, 0, 0, 48, + 49, 0, 143, 0, 143, 0, 50, 0, 0, 0, + 53, 0, 54, 55, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 0, 51, 143, 32, 61, 63, 47, 0, + 56, 278, 64, 59, 0, 58, 38, 0, 39, 40, + 41, 0, 0, 0, 0, 42, 43, 44, 45, 46, + 0, 0, 48, 49, 62, 0, 87, 87, 0, 50, + 0, 0, 0, 53, 0, 54, 55, 0, 103, 0, + 0, 0, 0, 87, 112, 0, 0, 0, 87, 51, + 121, 60, 61, 63, 47, 0, 56, 0, 64, 59, + 0, 58, 87, 87, 87, 87, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 62, 0, 0, 0, 0, 0, 52, 119, 119, 119, + 119, 0, 0, 0, 0, 0, 119, 0, 0, 0, + 119, 119, 119, 119, 0, 0, 0, 60, 121, 119, + 119, 0, 0, 119, 119, 119, 119, 119, 0, 119, + 119, 0, 130, 119, 0, 130, 119, 119, 119, 0, + 0, 0, 0, 129, 0, 0, 129, 0, 0, 130, + 130, 0, 52, 143, 143, 143, 143, 0, 0, 0, + 129, 129, 143, 0, 0, 129, 143, 143, 143, 143, + 0, 0, 0, 0, 0, 143, 143, 0, 240, 143, + 143, 143, 143, 143, 130, 143, 143, 0, 104, 143, + 0, 104, 143, 143, 143, 129, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 104, 104, 0, 0, 0, + 104, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 129, 0, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 0, 0, 104, 32, + 104, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 38, 0, 39, 40, 41, 0, 0, 0, 0, 42, + 43, 44, 45, 46, 0, 0, 48, 49, 0, 0, + 0, 0, 0, 50, 0, 145, 0, 53, 145, 54, + 55, 0, 0, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 145, 145, 0, 32, 0, 145, 0, 0, + 0, 0, 0, 0, 0, 0, 38, 0, 39, 40, + 41, 0, 0, 0, 0, 42, 43, 44, 45, 46, + 0, 0, 48, 49, 0, 0, 0, 145, 0, 50, + 131, 0, 0, 53, 0, 54, 55, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 131, 131, 0, + 0, 0, 131, 0, 0, 0, 0, 145, 0, 0, + 0, 0, 0, 130, 130, 130, 130, 0, 0, 0, + 0, 0, 0, 0, 129, 129, 129, 129, 0, 0, + 131, 0, 131, 129, 0, 130, 130, 129, 129, 129, + 129, 0, 0, 0, 0, 0, 129, 129, 0, 0, + 129, 129, 129, 129, 129, 0, 129, 129, 0, 0, + 129, 0, 131, 129, 129, 129, 0, 0, 0, 104, + 104, 104, 104, 0, 0, 0, 0, 0, 104, 0, + 0, 0, 104, 104, 104, 104, 0, 0, 0, 0, + 0, 104, 104, 0, 146, 104, 104, 104, 104, 104, + 0, 104, 104, 0, 0, 104, 0, 0, 104, 104, + 104, 146, 146, 0, 0, 0, 146, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 146, 0, 146, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 145, 145, 145, 145, + 0, 0, 0, 0, 0, 145, 0, 0, 0, 145, + 145, 145, 145, 0, 0, 0, 146, 0, 145, 145, + 0, 0, 145, 145, 145, 145, 145, 0, 145, 145, + 59, 0, 145, 59, 0, 145, 145, 145, 0, 0, + 0, 96, 0, 0, 96, 0, 0, 59, 59, 0, + 0, 131, 131, 131, 131, 0, 0, 0, 96, 96, + 131, 0, 0, 96, 131, 131, 131, 131, 0, 0, + 0, 0, 0, 131, 131, 0, 0, 131, 131, 131, + 131, 131, 59, 131, 131, 0, 0, 131, 0, 0, + 131, 131, 131, 96, 58, 0, 0, 58, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 58, 58, 0, 0, 0, 58, 0, 0, 0, + 0, 0, 0, 96, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 95, 0, 0, + 95, 0, 0, 0, 0, 0, 58, 0, 0, 0, + 0, 0, 0, 0, 95, 95, 0, 0, 0, 95, + 0, 0, 0, 0, 0, 146, 146, 146, 146, 0, + 0, 0, 0, 0, 146, 0, 58, 0, 146, 146, + 146, 146, 0, 0, 0, 61, 0, 146, 146, 95, + 0, 146, 146, 146, 146, 146, 0, 146, 146, 0, + 0, 146, 61, 61, 146, 146, 146, 61, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 95, + 0, 0, 0, 0, 0, 0, 0, 145, 0, 0, + 145, 0, 0, 0, 0, 61, 0, 61, 0, 0, + 0, 0, 0, 0, 145, 145, 0, 0, 0, 145, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 59, 59, 59, 59, 0, 0, 61, 0, 0, + 0, 0, 96, 96, 96, 96, 0, 0, 0, 145, + 0, 96, 0, 59, 59, 96, 96, 96, 96, 0, + 0, 0, 0, 0, 96, 96, 0, 0, 96, 96, + 96, 96, 96, 0, 96, 96, 0, 0, 96, 0, + 0, 96, 96, 96, 0, 132, 0, 0, 132, 0, + 0, 0, 0, 0, 0, 58, 58, 58, 58, 0, + 0, 0, 132, 132, 58, 0, 0, 132, 58, 58, + 58, 58, 0, 0, 0, 0, 0, 58, 58, 0, + 0, 58, 58, 58, 58, 58, 0, 58, 58, 0, + 0, 58, 0, 0, 58, 58, 58, 132, 95, 95, + 95, 95, 0, 0, 0, 71, 0, 95, 71, 0, + 0, 95, 95, 95, 95, 0, 0, 0, 0, 0, + 95, 95, 71, 71, 95, 95, 95, 95, 95, 0, + 95, 95, 0, 0, 95, 0, 0, 95, 95, 95, + 0, 0, 0, 0, 0, 0, 61, 61, 61, 61, + 0, 0, 0, 0, 0, 61, 0, 71, 0, 61, + 61, 61, 61, 0, 0, 0, 0, 0, 61, 61, + 0, 157, 61, 61, 61, 61, 61, 0, 61, 61, + 0, 0, 61, 0, 0, 61, 61, 61, 145, 145, + 145, 145, 0, 0, 0, 0, 0, 145, 0, 168, + 0, 145, 145, 145, 145, 0, 0, 0, 0, 0, + 145, 145, 0, 0, 145, 145, 145, 145, 145, 102, + 145, 145, 102, 0, 145, 0, 0, 145, 145, 145, + 0, 150, 0, 0, 0, 0, 102, 102, 0, 0, + 0, 102, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 109, 0, 0, 109, + 0, 102, 0, 0, 0, 0, 132, 132, 132, 132, + 0, 0, 0, 109, 109, 132, 0, 0, 109, 132, + 132, 132, 132, 0, 0, 0, 0, 0, 132, 132, + 0, 0, 132, 132, 132, 132, 132, 0, 132, 132, + 92, 0, 132, 92, 0, 132, 132, 132, 109, 0, + 0, 0, 0, 0, 0, 0, 0, 92, 92, 0, + 0, 0, 92, 0, 0, 0, 71, 71, 71, 71, + 0, 0, 0, 0, 0, 0, 0, 93, 0, 0, + 93, 0, 0, 0, 0, 0, 0, 0, 71, 71, + 0, 0, 92, 0, 93, 93, 0, 0, 0, 93, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 87, 0, 0, 87, 0, 151, + 0, 0, 0, 152, 153, 154, 155, 0, 0, 93, + 0, 87, 87, 0, 0, 0, 87, 158, 159, 160, + 161, 0, 162, 163, 0, 0, 164, 0, 0, 165, + 166, 167, 88, 0, 0, 88, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 87, 0, 0, 88, + 88, 0, 0, 0, 88, 0, 0, 0, 0, 0, + 102, 102, 102, 102, 0, 0, 0, 0, 0, 102, + 0, 0, 0, 102, 102, 102, 102, 0, 0, 0, + 0, 0, 102, 102, 88, 0, 102, 102, 102, 102, + 102, 0, 102, 102, 0, 0, 102, 0, 0, 102, + 102, 102, 0, 0, 0, 0, 0, 109, 109, 109, + 109, 0, 0, 0, 0, 0, 109, 0, 0, 0, + 109, 109, 109, 109, 0, 0, 0, 0, 0, 109, + 109, 0, 0, 109, 109, 109, 109, 109, 0, 109, + 109, 89, 0, 109, 89, 0, 109, 109, 109, 0, + 0, 92, 92, 92, 92, 0, 0, 0, 89, 89, + 92, 0, 0, 89, 92, 92, 92, 92, 0, 0, + 0, 0, 0, 92, 92, 0, 0, 92, 92, 92, + 92, 92, 0, 92, 92, 0, 0, 92, 93, 93, + 93, 93, 0, 89, 0, 0, 0, 93, 0, 0, + 0, 93, 93, 93, 93, 0, 0, 0, 0, 0, + 93, 93, 0, 0, 93, 93, 93, 93, 93, 0, + 93, 93, 0, 0, 93, 87, 87, 87, 87, 0, + 0, 0, 0, 0, 87, 0, 0, 0, 87, 87, + 87, 87, 0, 0, 0, 0, 0, 87, 87, 0, + 0, 87, 87, 87, 87, 87, 0, 87, 87, 0, + 0, 0, 0, 88, 88, 88, 88, 0, 0, 0, + 0, 0, 88, 0, 0, 0, 88, 88, 88, 88, + 85, 0, 0, 85, 0, 88, 88, 0, 0, 88, + 88, 88, 88, 88, 0, 88, 88, 85, 85, 0, + 0, 0, 85, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 86, 0, 0, 86, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 85, 86, 86, 0, 0, 0, 86, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 84, 0, 0, 84, 0, 0, 0, 0, 86, 0, + 0, 0, 89, 89, 89, 89, 0, 84, 84, 0, + 0, 89, 84, 0, 0, 89, 89, 89, 89, 0, + 0, 0, 0, 0, 89, 89, 0, 0, 89, 89, + 89, 89, 89, 72, 89, 89, 72, 0, 0, 0, + 0, 0, 84, 0, 0, 0, 0, 0, 0, 0, + 72, 72, 0, 0, 0, 72, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 73, + 0, 0, 73, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 72, 73, 73, 0, 0, + 0, 73, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 75, 0, 0, 75, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 73, 0, 75, 75, 0, 0, 0, 75, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 85, 85, 85, 85, 0, 0, 0, 0, 0, + 85, 0, 0, 0, 85, 85, 85, 85, 75, 0, + 0, 0, 0, 85, 85, 0, 0, 85, 85, 85, + 85, 85, 0, 85, 85, 0, 0, 86, 86, 86, + 86, 0, 0, 0, 0, 0, 86, 0, 0, 0, + 86, 86, 86, 86, 123, 0, 0, 123, 0, 86, + 86, 0, 0, 86, 86, 86, 86, 86, 0, 86, + 86, 123, 123, 0, 0, 0, 123, 0, 0, 0, + 0, 84, 84, 84, 84, 0, 0, 0, 0, 0, + 84, 0, 0, 0, 84, 84, 84, 84, 0, 0, + 0, 0, 0, 84, 84, 0, 123, 84, 84, 84, + 84, 84, 94, 84, 84, 94, 0, 0, 0, 0, + 0, 0, 0, 0, 72, 72, 72, 72, 0, 94, + 94, 0, 0, 72, 94, 0, 0, 72, 72, 72, + 72, 0, 0, 0, 0, 0, 72, 72, 0, 0, + 72, 72, 72, 72, 72, 0, 72, 72, 0, 0, + 73, 73, 73, 73, 94, 0, 0, 0, 0, 73, + 0, 0, 0, 73, 73, 73, 73, 0, 0, 0, + 0, 0, 73, 73, 0, 0, 73, 73, 73, 73, + 73, 134, 73, 0, 134, 0, 0, 75, 75, 75, + 75, 0, 0, 0, 0, 0, 75, 0, 134, 134, + 75, 75, 0, 134, 0, 0, 0, 0, 0, 75, + 75, 0, 0, 75, 75, 75, 75, 75, 76, 75, + 0, 76, 0, 0, 0, 0, 0, 0, 77, 0, + 0, 77, 0, 134, 0, 76, 76, 0, 0, 0, + 76, 0, 0, 0, 0, 77, 77, 0, 0, 0, + 77, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 78, 0, 0, 78, 0, 0, + 76, 0, 0, 0, 0, 123, 123, 123, 123, 0, + 77, 78, 78, 0, 123, 0, 78, 0, 123, 123, + 0, 0, 0, 0, 0, 0, 79, 123, 123, 79, + 0, 123, 123, 123, 123, 123, 81, 0, 0, 81, + 0, 0, 0, 79, 79, 0, 78, 0, 79, 0, + 0, 0, 0, 81, 81, 0, 0, 0, 81, 0, + 0, 0, 0, 94, 94, 94, 94, 0, 0, 284, + 0, 0, 94, 0, 157, 0, 94, 94, 79, 0, + 0, 0, 0, 0, 0, 94, 94, 0, 81, 94, + 94, 94, 94, 94, 0, 0, 0, 0, 0, 0, + 0, 0, 168, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 150, 0, 0, 0, 0, 0, + 0, 0, 134, 134, 134, 134, 0, 0, 0, 0, + 0, 134, 0, 0, 0, 134, 134, 0, 0, 0, + 0, 0, 0, 0, 134, 134, 0, 0, 134, 134, + 134, 134, 134, 0, 0, 0, 0, 0, 0, 76, + 76, 76, 76, 0, 0, 0, 0, 0, 76, 77, + 77, 77, 77, 76, 0, 0, 0, 0, 77, 0, + 0, 76, 76, 0, 0, 76, 76, 76, 76, 76, + 0, 77, 77, 0, 0, 77, 77, 77, 77, 77, + 0, 0, 0, 0, 0, 78, 78, 78, 78, 0, + 0, 0, 0, 0, 78, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 78, 78, 0, + 0, 78, 78, 78, 78, 78, 0, 79, 79, 79, + 79, 0, 0, 0, 0, 0, 79, 81, 81, 81, + 81, 0, 0, 0, 0, 0, 81, 0, 0, 79, + 79, 0, 0, 79, 79, 79, 79, 0, 0, 81, + 81, 0, 151, 81, 81, 81, 152, 153, 154, 155, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 156, + 158, 159, 160, 161, 0, 162, 163, 91, 0, 164, + 0, 0, 165, 166, 167, 104, 0, 0, 0, 0, + 111, 113, 0, 0, 0, 0, 0, 125, 126, 127, + 128, 129, 130, 0, 0, 133, 134, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 183, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 215, 0, 0, 0, 0, 0, 0, 0, 223, 224, + 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, + 235, 236, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 296, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 312, +}; +dEXT short yycheck[] = { 13, + 257, 13, 91, 17, 44, 41, 59, 182, 36, 41, + 59, 257, 44, 194, 41, 188, 59, 190, 41, 33, + 34, 35, 36, 59, 82, 40, 58, 59, 41, 43, + 88, 63, 125, 45, 123, 59, 50, 40, 59, 59, + 40, 91, 123, 91, 56, 41, 257, 41, 60, 41, + 41, 41, 278, 41, 36, 41, 44, 93, 116, 40, + 91, 93, 41, 91, 78, 41, 40, 40, 59, 41, + 58, 59, 40, 123, 123, 123, 91, 41, 92, 41, + 40, 95, 94, 97, 96, 99, 98, 101, 100, 41, + 102, 40, 123, 41, 106, 123, 44, 59, 41, 123, + 59, 41, 294, 295, 41, 93, 0, 59, 123, 59, + 58, 59, 287, 59, 44, 59, 59, 59, 299, 59, + 123, 302, 59, 123, 297, 298, 184, 141, 276, 277, + 123, 304, 144, 145, 146, 147, 148, 149, 150, 33, + 40, 123, 36, 37, 38, 93, 40, 260, 42, 43, + 123, 45, 123, 334, 327, 93, 168, 169, 170, 171, + 172, 173, 174, 123, 178, 59, 40, 40, 36, 0, + 64, 185, 40, 266, 267, 268, 257, 270, 271, 41, + 40, 93, 91, 266, 267, 268, 198, 270, 271, 125, + 93, 41, 204, 205, 206, 59, 59, 91, 287, 211, + 41, 125, 33, 91, 257, 36, 37, 38, 295, 40, + 93, 42, 43, 40, 45, 41, 305, 40, 125, 308, + 125, 125, 311, 312, 313, 237, 125, 239, 59, 123, + 258, 125, 126, 64, 59, 125, 272, 273, 274, 275, + 272, 273, 274, 275, 93, 259, 41, 261, 41, 263, + 264, 294, 295, 267, 294, 295, 270, 269, 294, 295, + 91, 41, 294, 295, 44, 313, 298, 294, 295, 93, + 282, 294, 295, 294, 295, 257, 272, 273, 274, 275, + 262, 294, 295, 63, 272, 273, 274, 275, 59, 301, + 123, 305, 123, 41, 125, 126, 0, 93, 294, 295, + 294, 295, 294, 295, 294, 295, 294, 295, 294, 295, + 298, 91, 59, 325, 41, 294, 295, 331, 294, 295, + 59, 335, 294, 295, 272, 273, 274, 275, 41, 33, + 294, 295, 36, 37, 38, 59, 40, 83, 42, 43, + 41, 45, 325, 123, 294, 295, 294, 295, 294, 295, + 294, 295, 294, 295, 13, 59, 294, 295, 269, 93, + 64, -1, 256, 257, 258, 259, 260, 261, -1, 263, + 264, 265, 266, 267, 268, 269, 270, 271, 272, 273, + 274, 275, 294, 295, -1, 279, 280, 91, 282, 283, + 284, 294, 295, -1, -1, 289, 290, 291, 292, 293, + -1, -1, 296, 297, -1, 41, -1, -1, 44, 303, + -1, 294, 295, 307, -1, 309, 310, -1, -1, 123, + -1, -1, 126, 59, 91, 256, 257, 258, 259, 260, + 261, -1, 263, 264, 265, 266, 267, 268, 269, 270, + 271, 272, 273, 274, 275, 294, 295, -1, 279, 280, + -1, 282, 283, 284, 91, -1, 123, 93, 289, 290, + 291, 292, 293, -1, -1, 296, 297, -1, -1, -1, + 294, 295, 303, -1, -1, -1, 307, -1, 309, 310, + 272, 273, 274, 275, 33, 91, 123, 36, 37, 38, + -1, 40, 41, 42, 43, 44, 45, -1, 294, 295, + -1, 281, 294, 295, -1, 285, 286, 287, 288, 58, + 59, 6, -1, 8, 63, 64, -1, 123, 298, 299, + 300, 301, 302, -1, 304, 305, -1, -1, 308, -1, + -1, 311, 312, 313, -1, -1, 31, 32, -1, -1, + -1, -1, 91, -1, 93, 41, -1, -1, 44, -1, + -1, 91, 256, 257, 258, 259, 260, 261, -1, 263, + 264, 265, 58, 59, -1, 269, -1, 63, 272, 273, + 274, 275, -1, -1, 123, 279, 280, 126, 282, 283, + 284, -1, -1, 123, -1, 289, 290, 291, 292, 293, + -1, -1, 296, 297, -1, 91, -1, 93, -1, 303, + -1, -1, -1, 307, 33, 309, 310, 36, 37, 38, + -1, 40, 41, 42, 43, 44, 45, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 123, -1, 58, + 59, -1, -1, -1, 63, 64, 272, 273, 274, 275, + -1, 308, -1, -1, 311, 312, 313, -1, 285, 286, + 287, 288, -1, -1, -1, -1, -1, -1, 294, -1, + -1, -1, -1, -1, 93, 302, -1, 304, 305, -1, + 41, 308, -1, 44, 311, 312, 313, -1, -1, 285, + 286, 287, 288, -1, -1, -1, -1, 58, 59, -1, + -1, -1, 63, 299, 300, 301, 302, 126, 304, 305, + -1, -1, 308, -1, -1, 311, 312, 313, 257, 258, + 259, 260, 261, -1, 263, 264, 265, -1, -1, -1, + 269, -1, 93, 272, 273, 274, 275, -1, -1, -1, + -1, 280, 281, 282, 283, 284, 285, 286, 287, 288, + 289, 290, 291, 292, 293, 294, 295, 296, 297, 298, + 299, 300, 301, 302, 303, 304, 305, -1, 307, 308, + 309, 310, 311, 312, 313, 305, -1, -1, 308, 91, + -1, 311, 312, 313, -1, -1, 272, 273, 274, 275, + -1, -1, -1, -1, -1, 281, -1, -1, -1, 285, + 286, 287, 288, -1, -1, -1, -1, -1, 294, 295, + -1, 123, 298, 299, 300, 301, 302, -1, 304, 305, + -1, -1, 308, -1, -1, 311, 312, 313, 91, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 257, 258, + 259, 260, 261, -1, 263, 264, 265, -1, -1, -1, + 269, -1, -1, 272, 273, 274, 275, -1, -1, -1, + 123, 280, 281, 282, 283, 284, 285, 286, 287, 288, + 289, 290, 291, 292, 293, 294, 295, 296, 297, 298, + 299, 300, 301, 302, 303, 304, 305, -1, 307, 308, + 309, 310, 311, 312, 313, 33, 48, 49, 36, 37, + 38, -1, 40, -1, 42, 43, -1, 45, -1, -1, + -1, 272, 273, 274, 275, -1, -1, -1, -1, -1, + 281, 59, -1, -1, 285, 286, 64, 288, -1, -1, + 82, -1, -1, 294, 295, -1, 88, 298, 299, 300, + 301, 302, -1, 304, -1, -1, -1, -1, -1, -1, + -1, 33, -1, 91, 36, 37, 38, -1, 40, -1, + 42, 43, -1, 45, 116, -1, -1, -1, -1, -1, + -1, 123, -1, 285, 286, 287, 288, 59, -1, -1, + -1, -1, 64, -1, -1, 123, -1, -1, 126, 301, + 302, -1, 304, 305, -1, -1, 308, -1, -1, 311, + 312, 313, -1, -1, -1, -1, -1, 33, -1, 91, + 36, 37, 38, -1, 40, -1, 42, 43, -1, 45, + -1, -1, -1, -1, 287, 288, -1, -1, -1, -1, + -1, -1, 184, -1, -1, -1, -1, -1, 64, -1, + -1, 123, 305, -1, 126, 308, -1, -1, 311, 312, + 313, -1, -1, -1, 41, -1, -1, 44, -1, -1, + -1, -1, -1, -1, -1, 91, -1, 26, -1, -1, + 33, 58, 59, 36, 37, 38, -1, 40, -1, 42, + 43, -1, 45, 42, -1, -1, -1, -1, 47, -1, + 49, -1, -1, -1, -1, -1, -1, 123, -1, -1, + 126, 64, 61, 62, 63, 64, 93, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 256, 257, + 258, 259, 260, 261, -1, 263, 264, 265, 91, -1, + -1, 269, -1, -1, 272, 273, 274, 275, -1, -1, + -1, 279, 280, -1, 282, 283, 284, -1, 107, -1, + -1, 289, 290, 291, 292, 293, -1, -1, 296, 297, + 123, -1, -1, 126, 91, 303, -1, -1, -1, 307, + -1, 309, 310, -1, 256, 257, 258, 259, 260, 261, + -1, 263, 264, 265, -1, -1, -1, 269, -1, -1, + 272, 273, 274, 275, -1, -1, 123, 279, 280, -1, + 282, 283, 284, -1, -1, -1, -1, 289, 290, 291, + 292, 293, -1, -1, 296, 297, -1, -1, -1, -1, + 91, 303, -1, -1, -1, 307, -1, 309, 310, -1, + -1, 257, 258, 259, 260, 261, 262, 263, 264, 265, + 41, -1, -1, 269, -1, -1, -1, -1, -1, -1, + -1, -1, 123, -1, 280, -1, 282, 283, 284, -1, + -1, -1, 63, 289, 290, 291, 292, 293, -1, -1, + 296, 297, -1, -1, -1, -1, -1, 303, -1, -1, + -1, 307, -1, 309, 310, 272, 273, 274, 275, -1, + 91, -1, -1, -1, 257, 258, 259, 260, 261, -1, + 263, 264, 265, -1, -1, -1, 269, 294, 295, -1, + -1, -1, -1, -1, -1, -1, -1, 280, -1, 282, + 283, 284, 123, -1, -1, -1, 289, 290, 291, 292, + 293, -1, -1, 296, 297, -1, -1, -1, -1, -1, + 303, -1, -1, -1, 307, 33, 309, 310, 36, 37, + 38, -1, 40, -1, 42, 43, -1, 45, 285, 286, + 287, 288, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 59, -1, 300, 301, 302, 64, 304, 305, -1, + -1, 308, -1, -1, 311, 312, 313, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 33, -1, 91, 36, 37, 38, -1, 40, -1, + 42, 43, -1, 45, 285, 286, 287, 288, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 64, 304, 305, -1, -1, 308, 126, -1, + 311, 312, 313, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 33, -1, 91, + 36, 37, 38, -1, 40, 41, 42, 43, -1, 45, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 281, -1, -1, -1, 285, 286, 287, 288, 64, -1, + -1, 123, -1, -1, 126, -1, -1, 298, 299, 300, + 301, 302, -1, 304, 305, -1, -1, 308, -1, -1, + 311, 312, 313, -1, -1, 91, -1, -1, -1, -1, + 33, -1, -1, 36, 37, 38, -1, 40, -1, 42, + 43, -1, 45, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 126, 64, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 257, + 258, 259, 260, 261, -1, 263, 264, 265, 91, -1, + 93, 269, -1, -1, -1, 91, -1, -1, -1, -1, + -1, -1, 280, -1, 282, 283, 284, -1, -1, -1, + -1, 289, 290, 291, 292, 293, -1, 63, 296, 297, + -1, -1, -1, 126, -1, 303, -1, 123, -1, 307, + -1, 309, 310, -1, -1, 257, 258, 259, 260, 261, + -1, 263, 264, 265, -1, 91, -1, 269, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 280, -1, + 282, 283, 284, -1, -1, -1, -1, 289, 290, 291, + 292, 293, -1, -1, 296, 297, 91, 123, -1, -1, + -1, 303, -1, 41, -1, 307, 44, 309, 310, -1, + -1, 257, 258, 259, 260, 261, -1, 263, 264, 265, + 58, 59, -1, 269, -1, 63, -1, -1, 123, -1, + -1, -1, -1, -1, 280, -1, 282, 283, 284, -1, + -1, -1, -1, 289, 290, 291, 292, 293, -1, -1, + 296, 297, -1, -1, -1, 93, -1, 303, -1, -1, + -1, 307, -1, 309, 310, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 257, 258, 259, 260, 261, -1, + 263, 264, 265, -1, 33, -1, 269, 36, 37, 38, + -1, 40, -1, 42, 43, -1, 45, 280, -1, 282, + 283, 284, -1, -1, -1, -1, 289, 290, 291, 292, + 293, 287, 288, 296, 297, 64, -1, -1, -1, -1, + 303, -1, -1, -1, 307, -1, 309, 310, 304, 305, + -1, -1, 308, -1, -1, 311, 312, 313, -1, -1, + 33, -1, 91, 36, 37, 38, -1, 40, 41, 42, + 43, -1, 45, -1, -1, 281, -1, -1, -1, 285, + 286, 287, 288, -1, -1, -1, -1, -1, -1, -1, + -1, 64, 298, 299, 300, 301, 302, 126, 304, 305, + -1, -1, 308, -1, -1, 311, 312, 313, -1, -1, + 285, -1, 287, 288, -1, -1, 33, -1, 91, 36, + 37, 38, -1, 40, 41, 42, 43, -1, 45, 304, + 305, -1, -1, 308, -1, -1, 311, 312, 313, -1, + -1, -1, -1, -1, -1, -1, -1, 64, -1, -1, + -1, -1, -1, 126, 272, 273, 274, 275, -1, -1, + -1, -1, -1, 281, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 91, -1, 294, 295, -1, 33, + 298, 299, 36, 37, 38, -1, 40, 41, 42, 43, + -1, 45, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 126, + 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 256, 257, 258, + 259, 260, 261, -1, 263, 264, 265, 91, -1, -1, + 269, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 280, -1, 282, 283, 284, -1, -1, -1, -1, + 289, 290, 291, 292, 293, -1, -1, 296, 297, -1, + -1, -1, 126, -1, 303, -1, 41, -1, 307, 44, + 309, 310, -1, -1, 257, 258, 259, 260, 261, -1, + 263, 264, 265, 58, 59, -1, 269, -1, 63, -1, + -1, -1, -1, -1, -1, -1, -1, 280, -1, 282, + 283, 284, -1, -1, -1, -1, 289, 290, 291, 292, + 293, -1, -1, 296, 297, -1, 91, -1, 93, -1, + 303, -1, 41, -1, 307, 44, 309, 310, -1, -1, + 257, 258, 259, 260, 261, -1, 263, 264, 265, 58, + 59, -1, 269, -1, 63, -1, -1, -1, 123, -1, + -1, -1, -1, 280, -1, 282, 283, 284, -1, -1, + -1, -1, 289, 290, 291, 292, 293, -1, -1, 296, + 297, -1, 91, -1, 93, -1, 303, -1, -1, -1, + 307, -1, 309, 310, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 257, 258, 259, 260, 261, -1, 263, + 264, 265, -1, 33, 123, 269, 36, 37, 38, -1, + 40, 41, 42, 43, -1, 45, 280, -1, 282, 283, + 284, -1, -1, -1, -1, 289, 290, 291, 292, 293, + -1, -1, 296, 297, 64, -1, 25, 26, -1, 303, + -1, -1, -1, 307, -1, 309, 310, -1, 37, -1, + -1, -1, -1, 42, 43, -1, -1, -1, 47, 33, + 49, 91, 36, 37, 38, -1, 40, -1, 42, 43, + -1, 45, 61, 62, 63, 64, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 64, -1, -1, -1, -1, -1, 126, 272, 273, 274, + 275, -1, -1, -1, -1, -1, 281, -1, -1, -1, + 285, 286, 287, 288, -1, -1, -1, 91, 107, 294, + 295, -1, -1, 298, 299, 300, 301, 302, -1, 304, + 305, -1, 41, 308, -1, 44, 311, 312, 313, -1, + -1, -1, -1, 41, -1, -1, 44, -1, -1, 58, + 59, -1, 126, 272, 273, 274, 275, -1, -1, -1, + 58, 59, 281, -1, -1, 63, 285, 286, 287, 288, + -1, -1, -1, -1, -1, 294, 295, -1, 167, 298, + 299, 300, 301, 302, 93, 304, 305, -1, 41, 308, + -1, 44, 311, 312, 313, 93, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 58, 59, -1, -1, -1, + 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 123, -1, 257, 258, 259, + 260, 261, -1, 263, 264, 265, -1, -1, 91, 269, + 93, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 280, -1, 282, 283, 284, -1, -1, -1, -1, 289, + 290, 291, 292, 293, -1, -1, 296, 297, -1, -1, + -1, -1, -1, 303, -1, 41, -1, 307, 44, 309, + 310, -1, -1, 257, 258, 259, 260, 261, -1, 263, + 264, 265, 58, 59, -1, 269, -1, 63, -1, -1, + -1, -1, -1, -1, -1, -1, 280, -1, 282, 283, + 284, -1, -1, -1, -1, 289, 290, 291, 292, 293, + -1, -1, 296, 297, -1, -1, -1, 93, -1, 303, + 41, -1, -1, 307, -1, 309, 310, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 58, 59, -1, + -1, -1, 63, -1, -1, -1, -1, 123, -1, -1, + -1, -1, -1, 272, 273, 274, 275, -1, -1, -1, + -1, -1, -1, -1, 272, 273, 274, 275, -1, -1, + 91, -1, 93, 281, -1, 294, 295, 285, 286, 287, + 288, -1, -1, -1, -1, -1, 294, 295, -1, -1, + 298, 299, 300, 301, 302, -1, 304, 305, -1, -1, + 308, -1, 123, 311, 312, 313, -1, -1, -1, 272, + 273, 274, 275, -1, -1, -1, -1, -1, 281, -1, + -1, -1, 285, 286, 287, 288, -1, -1, -1, -1, + -1, 294, 295, -1, 41, 298, 299, 300, 301, 302, + -1, 304, 305, -1, -1, 308, -1, -1, 311, 312, + 313, 58, 59, -1, -1, -1, 63, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 91, -1, 93, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 272, 273, 274, 275, + -1, -1, -1, -1, -1, 281, -1, -1, -1, 285, + 286, 287, 288, -1, -1, -1, 123, -1, 294, 295, + -1, -1, 298, 299, 300, 301, 302, -1, 304, 305, + 41, -1, 308, 44, -1, 311, 312, 313, -1, -1, + -1, 41, -1, -1, 44, -1, -1, 58, 59, -1, + -1, 272, 273, 274, 275, -1, -1, -1, 58, 59, + 281, -1, -1, 63, 285, 286, 287, 288, -1, -1, + -1, -1, -1, 294, 295, -1, -1, 298, 299, 300, + 301, 302, 93, 304, 305, -1, -1, 308, -1, -1, + 311, 312, 313, 93, 41, -1, -1, 44, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 58, 59, -1, -1, -1, 63, -1, -1, -1, + -1, -1, -1, 123, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, + 44, -1, -1, -1, -1, -1, 93, -1, -1, -1, + -1, -1, -1, -1, 58, 59, -1, -1, -1, 63, + -1, -1, -1, -1, -1, 272, 273, 274, 275, -1, + -1, -1, -1, -1, 281, -1, 123, -1, 285, 286, + 287, 288, -1, -1, -1, 41, -1, 294, 295, 93, + -1, 298, 299, 300, 301, 302, -1, 304, 305, -1, + -1, 308, 58, 59, 311, 312, 313, 63, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 123, + -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, + 44, -1, -1, -1, -1, 91, -1, 93, -1, -1, + -1, -1, -1, -1, 58, 59, -1, -1, -1, 63, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 272, 273, 274, 275, -1, -1, 123, -1, -1, + -1, -1, 272, 273, 274, 275, -1, -1, -1, 93, + -1, 281, -1, 294, 295, 285, 286, 287, 288, -1, + -1, -1, -1, -1, 294, 295, -1, -1, 298, 299, + 300, 301, 302, -1, 304, 305, -1, -1, 308, -1, + -1, 311, 312, 313, -1, 41, -1, -1, 44, -1, + -1, -1, -1, -1, -1, 272, 273, 274, 275, -1, + -1, -1, 58, 59, 281, -1, -1, 63, 285, 286, + 287, 288, -1, -1, -1, -1, -1, 294, 295, -1, + -1, 298, 299, 300, 301, 302, -1, 304, 305, -1, + -1, 308, -1, -1, 311, 312, 313, 93, 272, 273, + 274, 275, -1, -1, -1, 41, -1, 281, 44, -1, + -1, 285, 286, 287, 288, -1, -1, -1, -1, -1, + 294, 295, 58, 59, 298, 299, 300, 301, 302, -1, + 304, 305, -1, -1, 308, -1, -1, 311, 312, 313, + -1, -1, -1, -1, -1, -1, 272, 273, 274, 275, + -1, -1, -1, -1, -1, 281, -1, 93, -1, 285, + 286, 287, 288, -1, -1, -1, -1, -1, 294, 295, + -1, 63, 298, 299, 300, 301, 302, -1, 304, 305, + -1, -1, 308, -1, -1, 311, 312, 313, 272, 273, + 274, 275, -1, -1, -1, -1, -1, 281, -1, 91, + -1, 285, 286, 287, 288, -1, -1, -1, -1, -1, + 294, 295, -1, -1, 298, 299, 300, 301, 302, 41, + 304, 305, 44, -1, 308, -1, -1, 311, 312, 313, + -1, 123, -1, -1, -1, -1, 58, 59, -1, -1, + -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 41, -1, -1, 44, + -1, 93, -1, -1, -1, -1, 272, 273, 274, 275, + -1, -1, -1, 58, 59, 281, -1, -1, 63, 285, + 286, 287, 288, -1, -1, -1, -1, -1, 294, 295, + -1, -1, 298, 299, 300, 301, 302, -1, 304, 305, + 41, -1, 308, 44, -1, 311, 312, 313, 93, -1, + -1, -1, -1, -1, -1, -1, -1, 58, 59, -1, + -1, -1, 63, -1, -1, -1, 272, 273, 274, 275, + -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, + 44, -1, -1, -1, -1, -1, -1, -1, 294, 295, + -1, -1, 93, -1, 58, 59, -1, -1, -1, 63, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 41, -1, -1, 44, -1, 281, + -1, -1, -1, 285, 286, 287, 288, -1, -1, 93, + -1, 58, 59, -1, -1, -1, 63, 299, 300, 301, + 302, -1, 304, 305, -1, -1, 308, -1, -1, 311, + 312, 313, 41, -1, -1, 44, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 93, -1, -1, 58, + 59, -1, -1, -1, 63, -1, -1, -1, -1, -1, + 272, 273, 274, 275, -1, -1, -1, -1, -1, 281, + -1, -1, -1, 285, 286, 287, 288, -1, -1, -1, + -1, -1, 294, 295, 93, -1, 298, 299, 300, 301, + 302, -1, 304, 305, -1, -1, 308, -1, -1, 311, + 312, 313, -1, -1, -1, -1, -1, 272, 273, 274, + 275, -1, -1, -1, -1, -1, 281, -1, -1, -1, + 285, 286, 287, 288, -1, -1, -1, -1, -1, 294, + 295, -1, -1, 298, 299, 300, 301, 302, -1, 304, + 305, 41, -1, 308, 44, -1, 311, 312, 313, -1, + -1, 272, 273, 274, 275, -1, -1, -1, 58, 59, + 281, -1, -1, 63, 285, 286, 287, 288, -1, -1, + -1, -1, -1, 294, 295, -1, -1, 298, 299, 300, + 301, 302, -1, 304, 305, -1, -1, 308, 272, 273, + 274, 275, -1, 93, -1, -1, -1, 281, -1, -1, + -1, 285, 286, 287, 288, -1, -1, -1, -1, -1, + 294, 295, -1, -1, 298, 299, 300, 301, 302, -1, + 304, 305, -1, -1, 308, 272, 273, 274, 275, -1, + -1, -1, -1, -1, 281, -1, -1, -1, 285, 286, + 287, 288, -1, -1, -1, -1, -1, 294, 295, -1, + -1, 298, 299, 300, 301, 302, -1, 304, 305, -1, + -1, -1, -1, 272, 273, 274, 275, -1, -1, -1, + -1, -1, 281, -1, -1, -1, 285, 286, 287, 288, + 41, -1, -1, 44, -1, 294, 295, -1, -1, 298, + 299, 300, 301, 302, -1, 304, 305, 58, 59, -1, + -1, -1, 63, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 41, -1, -1, 44, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 93, 58, 59, -1, -1, -1, 63, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 41, -1, -1, 44, -1, -1, -1, -1, 93, -1, + -1, -1, 272, 273, 274, 275, -1, 58, 59, -1, + -1, 281, 63, -1, -1, 285, 286, 287, 288, -1, + -1, -1, -1, -1, 294, 295, -1, -1, 298, 299, + 300, 301, 302, 41, 304, 305, 44, -1, -1, -1, + -1, -1, 93, -1, -1, -1, -1, -1, -1, -1, + 58, 59, -1, -1, -1, 63, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 41, + -1, -1, 44, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 93, 58, 59, -1, -1, + -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 41, -1, -1, 44, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 93, -1, 58, 59, -1, -1, -1, 63, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 272, 273, 274, 275, -1, -1, -1, -1, -1, + 281, -1, -1, -1, 285, 286, 287, 288, 93, -1, + -1, -1, -1, 294, 295, -1, -1, 298, 299, 300, + 301, 302, -1, 304, 305, -1, -1, 272, 273, 274, + 275, -1, -1, -1, -1, -1, 281, -1, -1, -1, + 285, 286, 287, 288, 41, -1, -1, 44, -1, 294, + 295, -1, -1, 298, 299, 300, 301, 302, -1, 304, + 305, 58, 59, -1, -1, -1, 63, -1, -1, -1, + -1, 272, 273, 274, 275, -1, -1, -1, -1, -1, + 281, -1, -1, -1, 285, 286, 287, 288, -1, -1, + -1, -1, -1, 294, 295, -1, 93, 298, 299, 300, + 301, 302, 41, 304, 305, 44, -1, -1, -1, -1, + -1, -1, -1, -1, 272, 273, 274, 275, -1, 58, + 59, -1, -1, 281, 63, -1, -1, 285, 286, 287, + 288, -1, -1, -1, -1, -1, 294, 295, -1, -1, + 298, 299, 300, 301, 302, -1, 304, 305, -1, -1, + 272, 273, 274, 275, 93, -1, -1, -1, -1, 281, + -1, -1, -1, 285, 286, 287, 288, -1, -1, -1, + -1, -1, 294, 295, -1, -1, 298, 299, 300, 301, + 302, 41, 304, -1, 44, -1, -1, 272, 273, 274, + 275, -1, -1, -1, -1, -1, 281, -1, 58, 59, + 285, 286, -1, 63, -1, -1, -1, -1, -1, 294, + 295, -1, -1, 298, 299, 300, 301, 302, 41, 304, + -1, 44, -1, -1, -1, -1, -1, -1, 41, -1, + -1, 44, -1, 93, -1, 58, 59, -1, -1, -1, + 63, -1, -1, -1, -1, 58, 59, -1, -1, -1, + 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 41, -1, -1, 44, -1, -1, + 93, -1, -1, -1, -1, 272, 273, 274, 275, -1, + 93, 58, 59, -1, 281, -1, 63, -1, 285, 286, + -1, -1, -1, -1, -1, -1, 41, 294, 295, 44, + -1, 298, 299, 300, 301, 302, 41, -1, -1, 44, + -1, -1, -1, 58, 59, -1, 93, -1, 63, -1, + -1, -1, -1, 58, 59, -1, -1, -1, 63, -1, + -1, -1, -1, 272, 273, 274, 275, -1, -1, 58, + -1, -1, 281, -1, 63, -1, 285, 286, 93, -1, + -1, -1, -1, -1, -1, 294, 295, -1, 93, 298, + 299, 300, 301, 302, -1, -1, -1, -1, -1, -1, + -1, -1, 91, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 123, -1, -1, -1, -1, -1, + -1, -1, 272, 273, 274, 275, -1, -1, -1, -1, + -1, 281, -1, -1, -1, 285, 286, -1, -1, -1, + -1, -1, -1, -1, 294, 295, -1, -1, 298, 299, + 300, 301, 302, -1, -1, -1, -1, -1, -1, 272, + 273, 274, 275, -1, -1, -1, -1, -1, 281, 272, + 273, 274, 275, 286, -1, -1, -1, -1, 281, -1, + -1, 294, 295, -1, -1, 298, 299, 300, 301, 302, + -1, 294, 295, -1, -1, 298, 299, 300, 301, 302, + -1, -1, -1, -1, -1, 272, 273, 274, 275, -1, + -1, -1, -1, -1, 281, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 294, 295, -1, + -1, 298, 299, 300, 301, 302, -1, 272, 273, 274, + 275, -1, -1, -1, -1, -1, 281, 272, 273, 274, + 275, -1, -1, -1, -1, -1, 281, -1, -1, 294, + 295, -1, -1, 298, 299, 300, 301, -1, -1, 294, + 295, -1, 281, 298, 299, 300, 285, 286, 287, 288, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 298, + 299, 300, 301, 302, -1, 304, 305, 30, -1, 308, + -1, -1, 311, 312, 313, 38, -1, -1, -1, -1, + 43, 44, -1, -1, -1, -1, -1, 50, 51, 52, + 53, 54, 55, -1, -1, 58, 59, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 90, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 143, -1, -1, -1, -1, -1, -1, -1, 151, 152, + 153, 154, 155, 156, 157, 158, 159, 160, 161, 162, + 163, 164, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 256, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 284, +}; +#define YYFINAL 1 +#ifndef YYDEBUG +#define YYDEBUG 0 +#endif +#define YYMAXTOKEN 313 +#if YYDEBUG +dEXT char * yyname[] = { +"end-of-file",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +"'!'",0,0,"'$'","'%'","'&'",0,"'('","')'","'*'","'+'","','","'-'",0,0,0,0,0,0,0, +0,0,0,0,0,"':'","';'",0,0,0,"'?'","'@'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,"'['",0,"']'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,"'{'",0,"'}'","'~'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,"WORD","METHOD","FUNCMETH","THING", +"PMFUNC","PRIVATEREF","FUNC0SUB","UNIOPSUB","LSTOPSUB","LABEL","FORMAT","SUB", +"ANONSUB","PACKAGE","USE","WHILE","UNTIL","IF","UNLESS","ELSE","ELSIF", +"CONTINUE","FOR","LOOPEX","DOTDOT","FUNC0","FUNC1","FUNC","RELOP","EQOP", +"MULOP","ADDOP","DOLSHARP","DO","LOCAL","HASHBRACK","NOAMP","OROP","ANDOP", +"NOTOP","LSTOP","ASSIGNOP","OROR","ANDAND","BITOROP","BITANDOP","UNIOP", +"SHIFTOP","MATCHOP","UMINUS","REFGEN","POWOP","PREINC","PREDEC","POSTINC", +"POSTDEC","ARROW", +}; +dEXT char * yyrule[] = { +"$accept : prog", +"$$1 :", +"prog : $$1 lineseq", +"block : '{' remember lineseq '}'", +"remember :", +"lineseq :", +"lineseq : lineseq decl", +"lineseq : lineseq line", +"line : label cond", +"line : loop", +"line : label ';'", +"line : label sideff ';'", +"sideff : error", +"sideff : expr", +"sideff : expr IF expr", +"sideff : expr UNLESS expr", +"sideff : expr WHILE expr", +"sideff : expr UNTIL expr", +"else :", +"else : ELSE block", +"else : ELSIF '(' expr ')' block else", +"cond : IF '(' expr ')' block else", +"cond : UNLESS '(' expr ')' block else", +"cond : IF block block else", +"cond : UNLESS block block else", +"cont :", +"cont : CONTINUE block", +"loop : label WHILE '(' texpr ')' block cont", +"loop : label UNTIL '(' expr ')' block cont", +"loop : label WHILE block block cont", +"loop : label UNTIL block block cont", +"loop : label FOR scalar '(' expr ')' block cont", +"loop : label FOR '(' expr ')' block cont", +"loop : label FOR '(' nexpr ';' texpr ';' nexpr ')' block", +"loop : label block cont", +"nexpr :", +"nexpr : sideff", +"texpr :", +"texpr : expr", +"label :", +"label : LABEL", +"decl : format", +"decl : subrout", +"decl : package", +"decl : use", +"format : FORMAT startsub WORD block", +"format : FORMAT startsub block", +"subrout : SUB startsub WORD proto block", +"subrout : SUB startsub WORD proto ';'", +"proto :", +"proto : THING", +"startsub :", +"package : PACKAGE WORD ';'", +"package : PACKAGE ';'", +"use : USE startsub WORD listexpr ';'", +"expr : expr ANDOP expr", +"expr : expr OROP expr", +"expr : argexpr", +"argexpr : argexpr ','", +"argexpr : argexpr ',' term", +"argexpr : term", +"listop : LSTOP indirob argexpr", +"listop : FUNC '(' indirob expr ')'", +"listop : term ARROW method '(' listexprcom ')'", +"listop : METHOD indirob listexpr", +"listop : FUNCMETH indirob '(' listexprcom ')'", +"listop : LSTOP listexpr", +"listop : FUNC '(' listexprcom ')'", +"listop : LSTOPSUB startsub block listexpr", +"method : METHOD", +"method : scalar", +"term : term ASSIGNOP term", +"term : term POWOP term", +"term : term MULOP term", +"term : term ADDOP term", +"term : term SHIFTOP term", +"term : term RELOP term", +"term : term EQOP term", +"term : term BITANDOP term", +"term : term BITOROP term", +"term : term DOTDOT term", +"term : term ANDAND term", +"term : term OROR term", +"term : term '?' term ':' term", +"term : term MATCHOP term", +"term : '-' term", +"term : '+' term", +"term : '!' term", +"term : '~' term", +"term : REFGEN term", +"term : term POSTINC", +"term : term POSTDEC", +"term : PREINC term", +"term : PREDEC term", +"term : LOCAL term", +"term : '(' expr ')'", +"term : '(' ')'", +"term : '[' expr ']'", +"term : '[' ']'", +"term : HASHBRACK expr ';' '}'", +"term : HASHBRACK ';' '}'", +"term : ANONSUB startsub proto block", +"term : scalar", +"term : star '{' expr ';' '}'", +"term : star", +"term : scalar '[' expr ']'", +"term : term ARROW '[' expr ']'", +"term : term '[' expr ']'", +"term : hsh", +"term : ary", +"term : arylen", +"term : scalar '{' expr ';' '}'", +"term : term ARROW '{' expr ';' '}'", +"term : term '{' expr ';' '}'", +"term : '(' expr ')' '[' expr ']'", +"term : '(' ')' '[' expr ']'", +"term : ary '[' expr ']'", +"term : ary '{' expr ';' '}'", +"term : THING", +"term : amper", +"term : amper '(' ')'", +"term : amper '(' expr ')'", +"term : NOAMP WORD listexpr", +"term : DO term", +"term : DO block", +"term : DO WORD '(' ')'", +"term : DO WORD '(' expr ')'", +"term : DO scalar '(' ')'", +"term : DO scalar '(' expr ')'", +"term : LOOPEX", +"term : LOOPEX term", +"term : NOTOP argexpr", +"term : UNIOP", +"term : UNIOP block", +"term : UNIOP term", +"term : UNIOPSUB term", +"term : FUNC0", +"term : FUNC0 '(' ')'", +"term : FUNC0SUB", +"term : FUNC1 '(' ')'", +"term : FUNC1 '(' expr ')'", +"term : PMFUNC '(' term ')'", +"term : PMFUNC '(' term ',' term ')'", +"term : WORD", +"term : listop", +"listexpr :", +"listexpr : argexpr", +"listexprcom :", +"listexprcom : expr", +"listexprcom : expr ','", +"amper : '&' indirob", +"scalar : '$' indirob", +"ary : '@' indirob", +"hsh : '%' indirob", +"arylen : DOLSHARP indirob", +"star : '*' indirob", +"indirob : WORD", +"indirob : scalar", +"indirob : block", +"indirob : PRIVATEREF", +}; +#endif +#define yyclearin (yychar=(-1)) +#define yyerrok (yyerrflag=0) +#ifdef YYSTACKSIZE +#ifndef YYMAXDEPTH +#define YYMAXDEPTH YYSTACKSIZE +#endif +#else +#ifdef YYMAXDEPTH +#define YYSTACKSIZE YYMAXDEPTH +#else +#define YYSTACKSIZE 500 +#define YYMAXDEPTH 500 +#endif +#endif +dEXT int yydebug; +dEXT int yynerrs; +dEXT int yyerrflag; +dEXT int yychar; +dEXT YYSTYPE yyval; +dEXT YYSTYPE yylval; +#line 571 "perly.y" + /* PROGRAM */ +#line 1394 "y_tab.c" +#define YYABORT goto yyabort +#define YYACCEPT goto yyaccept +#define YYERROR goto yyerrlab + +struct ysv { + short* yyss; + YYSTYPE* yyvs; + int oldyydebug; + int oldyynerrs; + int oldyyerrflag; + int oldyychar; + YYSTYPE oldyyval; + YYSTYPE oldyylval; +}; + +void +yydestruct(ptr) +void* ptr; +{ + struct ysv* ysave = (struct ysv*)ptr; + if (ysave->yyss) Safefree(ysave->yyss); + if (ysave->yyvs) Safefree(ysave->yyvs); + yydebug = ysave->oldyydebug; + yynerrs = ysave->oldyynerrs; + yyerrflag = ysave->oldyyerrflag; + yychar = ysave->oldyychar; + yyval = ysave->oldyyval; + yylval = ysave->oldyylval; + Safefree(ysave); +} + +int +yyparse() +{ + register int yym, yyn, yystate; + register short *yyssp; + register YYSTYPE *yyvsp; + short* yyss; + YYSTYPE* yyvs; + unsigned yystacksize = YYSTACKSIZE; + int retval = 0; +#if YYDEBUG + register char *yys; + extern char *getenv(); +#endif + + struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv)); + SAVEDESTRUCTOR(yydestruct, ysave); + ysave->oldyydebug = yydebug; + ysave->oldyynerrs = yynerrs; + ysave->oldyyerrflag = yyerrflag; + ysave->oldyychar = yychar; + ysave->oldyyval = yyval; + ysave->oldyylval = yylval; + +#if YYDEBUG + if (yys = getenv("YYDEBUG")) + { + yyn = *yys; + if (yyn >= '0' && yyn <= '9') + yydebug = yyn - '0'; + } +#endif + + yynerrs = 0; + yyerrflag = 0; + yychar = (-1); + + /* + ** Initialize private stacks (yyparse may be called from an action) + */ + ysave->yyss = yyss = (short*)safemalloc(yystacksize*sizeof(short)); + ysave->yyvs = yyvs = (YYSTYPE*)safemalloc(yystacksize*sizeof(YYSTYPE)); + if (!yyvs || !yyss) + goto yyoverflow; + + yyssp = yyss; + yyvsp = yyvs; + *yyssp = yystate = 0; + +yyloop: + if (yyn = yydefred[yystate]) goto yyreduce; + if (yychar < 0) + { + if ((yychar = yylex()) < 0) yychar = 0; +#if YYDEBUG + if (yydebug) + { + yys = 0; + if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; + if (!yys) yys = "illegal-symbol"; + fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", yystate, + yychar, yys); + } +#endif + } + if ((yyn = yysindex[yystate]) && (yyn += yychar) >= 0 && + yyn <= YYTABLESIZE && yycheck[yyn] == yychar) + { +#if YYDEBUG + if (yydebug) + fprintf(stderr, "yydebug: state %d, shifting to state %d\n", + yystate, yytable[yyn]); +#endif + if (yyssp >= yyss + yystacksize - 1) + { + /* + ** reallocate and recover. Note that pointers + ** have to be reset, or bad things will happen + */ + int yyps_index = (yyssp - yyss); + int yypv_index = (yyvsp - yyvs); + yystacksize += YYSTACKSIZE; + ysave->yyvs = yyvs = + (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE)); + ysave->yyss = yyss = + (short*)realloc((char*)yyss,yystacksize * sizeof(short)); + if (!yyvs || !yyss) + goto yyoverflow; + yyssp = yyss + yyps_index; + yyvsp = yyvs + yypv_index; + } + *++yyssp = yystate = yytable[yyn]; + *++yyvsp = yylval; + yychar = (-1); + if (yyerrflag > 0) --yyerrflag; + goto yyloop; + } + if ((yyn = yyrindex[yystate]) && (yyn += yychar) >= 0 && + yyn <= YYTABLESIZE && yycheck[yyn] == yychar) + { + yyn = yytable[yyn]; + goto yyreduce; + } + if (yyerrflag) goto yyinrecovery; +#ifdef lint + goto yynewerror; +#endif +yynewerror: + yyerror("syntax error"); +#ifdef lint + goto yyerrlab; +#endif +yyerrlab: + ++yynerrs; +yyinrecovery: + if (yyerrflag < 3) + { + yyerrflag = 3; + for (;;) + { + if ((yyn = yysindex[*yyssp]) && (yyn += YYERRCODE) >= 0 && + yyn <= YYTABLESIZE && yycheck[yyn] == YYERRCODE) + { +#if YYDEBUG + if (yydebug) + fprintf(stderr, + "yydebug: state %d, error recovery shifting to state %d\n", + *yyssp, yytable[yyn]); +#endif + if (yyssp >= yyss + yystacksize - 1) + { + /* + ** reallocate and recover. Note that pointers + ** have to be reset, or bad things will happen + */ + int yyps_index = (yyssp - yyss); + int yypv_index = (yyvsp - yyvs); + yystacksize += YYSTACKSIZE; + ysave->yyvs = yyvs = (YYSTYPE*)realloc((char*)yyvs, + yystacksize * sizeof(YYSTYPE)); + ysave->yyss = yyss = (short*)realloc((char*)yyss, + yystacksize * sizeof(short)); + if (!yyvs || !yyss) + goto yyoverflow; + yyssp = yyss + yyps_index; + yyvsp = yyvs + yypv_index; + } + *++yyssp = yystate = yytable[yyn]; + *++yyvsp = yylval; + goto yyloop; + } + else + { +#if YYDEBUG + if (yydebug) + fprintf(stderr, + "yydebug: error recovery discarding state %d\n", + *yyssp); +#endif + if (yyssp <= yyss) goto yyabort; + --yyssp; + --yyvsp; + } + } + } + else + { + if (yychar == 0) goto yyabort; +#if YYDEBUG + if (yydebug) + { + yys = 0; + if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; + if (!yys) yys = "illegal-symbol"; + fprintf(stderr, + "yydebug: state %d, error recovery discards token %d (%s)\n", + yystate, yychar, yys); + } +#endif + yychar = (-1); + goto yyloop; + } +yyreduce: +#if YYDEBUG + if (yydebug) + fprintf(stderr, "yydebug: state %d, reducing by rule %d (%s)\n", + yystate, yyn, yyrule[yyn]); +#endif + yym = yylen[yyn]; + yyval = yyvsp[1-yym]; + switch (yyn) + { +case 1: +#line 84 "perly.y" +{ +#if defined(YYDEBUG) && defined(DEBUGGING) + yydebug = (debug & 1); +#endif + expect = XSTATE; + } +break; +case 2: +#line 91 "perly.y" +{ newPROG(yyvsp[0].opval); } +break; +case 3: +#line 95 "perly.y" +{ yyval.opval = block_end(yyvsp[-3].ival,yyvsp[-2].ival,yyvsp[-1].opval); } +break; +case 4: +#line 99 "perly.y" +{ yyval.ival = block_start(); } +break; +case 5: +#line 103 "perly.y" +{ yyval.opval = Nullop; } +break; +case 6: +#line 105 "perly.y" +{ yyval.opval = yyvsp[-1].opval; } +break; +case 7: +#line 107 "perly.y" +{ yyval.opval = append_list(OP_LINESEQ, + (LISTOP*)yyvsp[-1].opval, (LISTOP*)yyvsp[0].opval); + pad_reset_pending = TRUE; + if (yyvsp[-1].opval && yyvsp[0].opval) hints |= HINT_BLOCK_SCOPE; } +break; +case 8: +#line 114 "perly.y" +{ yyval.opval = newSTATEOP(0, yyvsp[-1].pval, yyvsp[0].opval); } +break; +case 10: +#line 117 "perly.y" +{ if (yyvsp[-1].pval != Nullch) { + yyval.opval = newSTATEOP(0, yyvsp[-1].pval, newOP(OP_NULL, 0)); + } + else { + yyval.opval = Nullop; + copline = NOLINE; + } + expect = XSTATE; } +break; +case 11: +#line 126 "perly.y" +{ yyval.opval = newSTATEOP(0, yyvsp[-2].pval, yyvsp[-1].opval); + expect = XSTATE; } +break; +case 12: +#line 131 "perly.y" +{ yyval.opval = Nullop; } +break; +case 13: +#line 133 "perly.y" +{ yyval.opval = yyvsp[0].opval; } +break; +case 14: +#line 135 "perly.y" +{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[0].opval, yyvsp[-2].opval); } +break; +case 15: +#line 137 "perly.y" +{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[0].opval, yyvsp[-2].opval); } +break; +case 16: +#line 139 "perly.y" +{ yyval.opval = newLOOPOP(OPf_PARENS, 1, scalar(yyvsp[0].opval), yyvsp[-2].opval); } +break; +case 17: +#line 141 "perly.y" +{ yyval.opval = newLOOPOP(OPf_PARENS, 1, invert(scalar(yyvsp[0].opval)), yyvsp[-2].opval);} +break; +case 18: +#line 145 "perly.y" +{ yyval.opval = Nullop; } +break; +case 19: +#line 147 "perly.y" +{ yyval.opval = scope(yyvsp[0].opval); } +break; +case 20: +#line 149 "perly.y" +{ copline = yyvsp[-5].ival; + yyval.opval = newSTATEOP(0, 0, + newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); + hints |= HINT_BLOCK_SCOPE; } +break; +case 21: +#line 156 "perly.y" +{ copline = yyvsp[-5].ival; + yyval.opval = newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval); } +break; +case 22: +#line 159 "perly.y" +{ copline = yyvsp[-5].ival; + yyval.opval = newCONDOP(0, + invert(scalar(yyvsp[-3].opval)), scope(yyvsp[-1].opval), yyvsp[0].opval); } +break; +case 23: +#line 163 "perly.y" +{ copline = yyvsp[-3].ival; + deprecate("if BLOCK BLOCK"); + yyval.opval = newCONDOP(0, scope(yyvsp[-2].opval), scope(yyvsp[-1].opval), yyvsp[0].opval); } +break; +case 24: +#line 167 "perly.y" +{ copline = yyvsp[-3].ival; + deprecate("unless BLOCK BLOCK"); + yyval.opval = newCONDOP(0, invert(scalar(scope(yyvsp[-2].opval))), + scope(yyvsp[-1].opval), yyvsp[0].opval); } +break; +case 25: +#line 174 "perly.y" +{ yyval.opval = Nullop; } +break; +case 26: +#line 176 "perly.y" +{ yyval.opval = scope(yyvsp[0].opval); } +break; +case 27: +#line 180 "perly.y" +{ copline = yyvsp[-5].ival; + yyval.opval = newSTATEOP(0, yyvsp[-6].pval, + newWHILEOP(0, 1, (LOOP*)Nullop, + yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval) ); } +break; +case 28: +#line 185 "perly.y" +{ copline = yyvsp[-5].ival; + yyval.opval = newSTATEOP(0, yyvsp[-6].pval, + newWHILEOP(0, 1, (LOOP*)Nullop, + invert(scalar(yyvsp[-3].opval)), yyvsp[-1].opval, yyvsp[0].opval) ); } +break; +case 29: +#line 190 "perly.y" +{ copline = yyvsp[-3].ival; + yyval.opval = newSTATEOP(0, yyvsp[-4].pval, + newWHILEOP(0, 1, (LOOP*)Nullop, + scope(yyvsp[-2].opval), yyvsp[-1].opval, yyvsp[0].opval) ); } +break; +case 30: +#line 195 "perly.y" +{ copline = yyvsp[-3].ival; + yyval.opval = newSTATEOP(0, yyvsp[-4].pval, + newWHILEOP(0, 1, (LOOP*)Nullop, + invert(scalar(scope(yyvsp[-2].opval))), yyvsp[-1].opval, yyvsp[0].opval)); } +break; +case 31: +#line 200 "perly.y" +{ yyval.opval = newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, mod(yyvsp[-5].opval, OP_ENTERLOOP), + yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval); } +break; +case 32: +#line 203 "perly.y" +{ yyval.opval = newFOROP(0, yyvsp[-6].pval, yyvsp[-5].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval); } +break; +case 33: +#line 206 "perly.y" +{ copline = yyvsp[-8].ival; + yyval.opval = append_elem(OP_LINESEQ, + newSTATEOP(0, yyvsp[-9].pval, scalar(yyvsp[-6].opval)), + newSTATEOP(0, yyvsp[-9].pval, + newWHILEOP(0, 1, (LOOP*)Nullop, + scalar(yyvsp[-4].opval), yyvsp[0].opval, scalar(yyvsp[-2].opval)) )); } +break; +case 34: +#line 213 "perly.y" +{ yyval.opval = newSTATEOP(0, + yyvsp[-2].pval, newWHILEOP(0, 1, (LOOP*)Nullop, + Nullop, yyvsp[-1].opval, yyvsp[0].opval)); } +break; +case 35: +#line 219 "perly.y" +{ yyval.opval = Nullop; } +break; +case 37: +#line 224 "perly.y" +{ (void)scan_num("1"); yyval.opval = yylval.opval; } +break; +case 39: +#line 229 "perly.y" +{ yyval.pval = Nullch; } +break; +case 41: +#line 234 "perly.y" +{ yyval.ival = 0; } +break; +case 42: +#line 236 "perly.y" +{ yyval.ival = 0; } +break; +case 43: +#line 238 "perly.y" +{ yyval.ival = 0; } +break; +case 44: +#line 240 "perly.y" +{ yyval.ival = 0; } +break; +case 45: +#line 244 "perly.y" +{ newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } +break; +case 46: +#line 246 "perly.y" +{ newFORM(yyvsp[-1].ival, Nullop, yyvsp[0].opval); } +break; +case 47: +#line 250 "perly.y" +{ newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); } +break; +case 48: +#line 252 "perly.y" +{ newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, Nullop); expect = XSTATE; } +break; +case 49: +#line 256 "perly.y" +{ yyval.opval = Nullop; } +break; +case 51: +#line 261 "perly.y" +{ yyval.ival = start_subparse(); } +break; +case 52: +#line 265 "perly.y" +{ package(yyvsp[-1].opval); } +break; +case 53: +#line 267 "perly.y" +{ package(Nullop); } +break; +case 54: +#line 271 "perly.y" +{ utilize(yyvsp[-4].ival, yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval); } +break; +case 55: +#line 275 "perly.y" +{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } +break; +case 56: +#line 277 "perly.y" +{ yyval.opval = newLOGOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, yyvsp[0].opval); } +break; +case 58: +#line 282 "perly.y" +{ yyval.opval = yyvsp[-1].opval; } +break; +case 59: +#line 284 "perly.y" +{ yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); } +break; +case 61: +#line 289 "perly.y" +{ yyval.opval = convert(yyvsp[-2].ival, OPf_STACKED, + prepend_elem(OP_LIST, newGVREF(yyvsp[-2].ival,yyvsp[-1].opval), yyvsp[0].opval) ); } +break; +case 62: +#line 292 "perly.y" +{ yyval.opval = convert(yyvsp[-4].ival, OPf_STACKED, + prepend_elem(OP_LIST, newGVREF(yyvsp[-4].ival,yyvsp[-2].opval), yyvsp[-1].opval) ); } +break; +case 63: +#line 295 "perly.y" +{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, + prepend_elem(OP_LIST, yyvsp[-5].opval, yyvsp[-1].opval), + newUNOP(OP_METHOD, 0, yyvsp[-3].opval))); } +break; +case 64: +#line 300 "perly.y" +{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, + prepend_elem(OP_LIST, yyvsp[-1].opval, yyvsp[0].opval), + newUNOP(OP_METHOD, 0, yyvsp[-2].opval))); } +break; +case 65: +#line 305 "perly.y" +{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, + prepend_elem(OP_LIST, yyvsp[-3].opval, yyvsp[-1].opval), + newUNOP(OP_METHOD, 0, yyvsp[-4].opval))); } +break; +case 66: +#line 310 "perly.y" +{ yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); } +break; +case 67: +#line 312 "perly.y" +{ yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); } +break; +case 68: +#line 314 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, + prepend_elem(OP_LIST, newANONSUB(yyvsp[-2].ival, 0, yyvsp[-1].opval), yyvsp[0].opval), + yyvsp[-3].opval)); } +break; +case 71: +#line 325 "perly.y" +{ yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); } +break; +case 72: +#line 327 "perly.y" +{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } +break; +case 73: +#line 329 "perly.y" +{ if (yyvsp[-1].ival != OP_REPEAT) + scalar(yyvsp[-2].opval); + yyval.opval = newBINOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, scalar(yyvsp[0].opval)); } +break; +case 74: +#line 333 "perly.y" +{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } +break; +case 75: +#line 335 "perly.y" +{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } +break; +case 76: +#line 337 "perly.y" +{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } +break; +case 77: +#line 339 "perly.y" +{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } +break; +case 78: +#line 341 "perly.y" +{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } +break; +case 79: +#line 343 "perly.y" +{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } +break; +case 80: +#line 345 "perly.y" +{ yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));} +break; +case 81: +#line 347 "perly.y" +{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } +break; +case 82: +#line 349 "perly.y" +{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); } +break; +case 83: +#line 351 "perly.y" +{ yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); } +break; +case 84: +#line 353 "perly.y" +{ yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); } +break; +case 85: +#line 356 "perly.y" +{ yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); } +break; +case 86: +#line 358 "perly.y" +{ yyval.opval = yyvsp[0].opval; } +break; +case 87: +#line 360 "perly.y" +{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } +break; +case 88: +#line 362 "perly.y" +{ yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));} +break; +case 89: +#line 364 "perly.y" +{ yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); } +break; +case 90: +#line 366 "perly.y" +{ yyval.opval = newUNOP(OP_POSTINC, 0, + mod(scalar(yyvsp[-1].opval), OP_POSTINC)); } +break; +case 91: +#line 369 "perly.y" +{ yyval.opval = newUNOP(OP_POSTDEC, 0, + mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); } +break; +case 92: +#line 372 "perly.y" +{ yyval.opval = newUNOP(OP_PREINC, 0, + mod(scalar(yyvsp[0].opval), OP_PREINC)); } +break; +case 93: +#line 375 "perly.y" +{ yyval.opval = newUNOP(OP_PREDEC, 0, + mod(scalar(yyvsp[0].opval), OP_PREDEC)); } +break; +case 94: +#line 378 "perly.y" +{ yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } +break; +case 95: +#line 380 "perly.y" +{ yyval.opval = sawparens(yyvsp[-1].opval); } +break; +case 96: +#line 382 "perly.y" +{ yyval.opval = sawparens(newNULLLIST()); } +break; +case 97: +#line 384 "perly.y" +{ yyval.opval = newANONLIST(yyvsp[-1].opval); } +break; +case 98: +#line 386 "perly.y" +{ yyval.opval = newANONLIST(Nullop); } +break; +case 99: +#line 388 "perly.y" +{ yyval.opval = newANONHASH(yyvsp[-2].opval); } +break; +case 100: +#line 390 "perly.y" +{ yyval.opval = newANONHASH(Nullop); } +break; +case 101: +#line 392 "perly.y" +{ yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } +break; +case 102: +#line 394 "perly.y" +{ yyval.opval = yyvsp[0].opval; } +break; +case 103: +#line 396 "perly.y" +{ yyval.opval = newBINOP(OP_GELEM, 0, newGVREF(0,yyvsp[-4].opval), yyvsp[-2].opval); } +break; +case 104: +#line 398 "perly.y" +{ yyval.opval = yyvsp[0].opval; } +break; +case 105: +#line 400 "perly.y" +{ yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); } +break; +case 106: +#line 402 "perly.y" +{ yyval.opval = newBINOP(OP_AELEM, 0, + ref(newAVREF(yyvsp[-4].opval),OP_RV2AV), + scalar(yyvsp[-1].opval));} +break; +case 107: +#line 406 "perly.y" +{ assertref(yyvsp[-3].opval); yyval.opval = newBINOP(OP_AELEM, 0, + ref(newAVREF(yyvsp[-3].opval),OP_RV2AV), + scalar(yyvsp[-1].opval));} +break; +case 108: +#line 410 "perly.y" +{ yyval.opval = yyvsp[0].opval; } +break; +case 109: +#line 412 "perly.y" +{ yyval.opval = yyvsp[0].opval; } +break; +case 110: +#line 414 "perly.y" +{ yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));} +break; +case 111: +#line 416 "perly.y" +{ yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval)); + expect = XOPERATOR; } +break; +case 112: +#line 419 "perly.y" +{ yyval.opval = newBINOP(OP_HELEM, 0, + ref(newHVREF(yyvsp[-5].opval),OP_RV2HV), + jmaybe(yyvsp[-2].opval)); + expect = XOPERATOR; } +break; +case 113: +#line 424 "perly.y" +{ assertref(yyvsp[-4].opval); yyval.opval = newBINOP(OP_HELEM, 0, + ref(newHVREF(yyvsp[-4].opval),OP_RV2HV), + jmaybe(yyvsp[-2].opval)); + expect = XOPERATOR; } +break; +case 114: +#line 429 "perly.y" +{ yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); } +break; +case 115: +#line 431 "perly.y" +{ yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); } +break; +case 116: +#line 433 "perly.y" +{ yyval.opval = prepend_elem(OP_ASLICE, + newOP(OP_PUSHMARK, 0), + newLISTOP(OP_ASLICE, 0, + list(yyvsp[-1].opval), + ref(yyvsp[-3].opval, OP_ASLICE))); } +break; +case 117: +#line 439 "perly.y" +{ yyval.opval = prepend_elem(OP_HSLICE, + newOP(OP_PUSHMARK, 0), + newLISTOP(OP_HSLICE, 0, + list(yyvsp[-2].opval), + ref(oopsHV(yyvsp[-4].opval), OP_HSLICE))); + expect = XOPERATOR; } +break; +case 118: +#line 446 "perly.y" +{ yyval.opval = yyvsp[0].opval; } +break; +case 119: +#line 448 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); } +break; +case 120: +#line 450 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); } +break; +case 121: +#line 452 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); } +break; +case 122: +#line 455 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } +break; +case 123: +#line 458 "perly.y" +{ yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); } +break; +case 124: +#line 460 "perly.y" +{ yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); } +break; +case 125: +#line 462 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, + OPf_SPECIAL|OPf_STACKED, + prepend_elem(OP_LIST, + scalar(newCVREF( + (OPpENTERSUB_AMPER<<8), + scalar(yyvsp[-2].opval) + )),Nullop)); dep();} +break; +case 126: +#line 470 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, + OPf_SPECIAL|OPf_STACKED, + append_elem(OP_LIST, + yyvsp[-1].opval, + scalar(newCVREF( + (OPpENTERSUB_AMPER<<8), + scalar(yyvsp[-3].opval) + )))); dep();} +break; +case 127: +#line 479 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, + prepend_elem(OP_LIST, + scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();} +break; +case 128: +#line 483 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, + prepend_elem(OP_LIST, + yyvsp[-1].opval, + scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();} +break; +case 129: +#line 488 "perly.y" +{ yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL); + hints |= HINT_BLOCK_SCOPE; } +break; +case 130: +#line 491 "perly.y" +{ yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); } +break; +case 131: +#line 493 "perly.y" +{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } +break; +case 132: +#line 495 "perly.y" +{ yyval.opval = newOP(yyvsp[0].ival, 0); } +break; +case 133: +#line 497 "perly.y" +{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } +break; +case 134: +#line 499 "perly.y" +{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } +break; +case 135: +#line 501 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } +break; +case 136: +#line 504 "perly.y" +{ yyval.opval = newOP(yyvsp[0].ival, 0); } +break; +case 137: +#line 506 "perly.y" +{ yyval.opval = newOP(yyvsp[-2].ival, 0); } +break; +case 138: +#line 508 "perly.y" +{ yyval.opval = newUNOP(OP_ENTERSUB, 0, + scalar(yyvsp[0].opval)); } +break; +case 139: +#line 511 "perly.y" +{ yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); } +break; +case 140: +#line 513 "perly.y" +{ yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); } +break; +case 141: +#line 515 "perly.y" +{ yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); } +break; +case 142: +#line 517 "perly.y" +{ yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); } +break; +case 145: +#line 523 "perly.y" +{ yyval.opval = Nullop; } +break; +case 146: +#line 525 "perly.y" +{ yyval.opval = yyvsp[0].opval; } +break; +case 147: +#line 529 "perly.y" +{ yyval.opval = Nullop; } +break; +case 148: +#line 531 "perly.y" +{ yyval.opval = yyvsp[0].opval; } +break; +case 149: +#line 533 "perly.y" +{ yyval.opval = yyvsp[-1].opval; } +break; +case 150: +#line 537 "perly.y" +{ yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); } +break; +case 151: +#line 541 "perly.y" +{ yyval.opval = newSVREF(yyvsp[0].opval); } +break; +case 152: +#line 545 "perly.y" +{ yyval.opval = newAVREF(yyvsp[0].opval); } +break; +case 153: +#line 549 "perly.y" +{ yyval.opval = newHVREF(yyvsp[0].opval); } +break; +case 154: +#line 553 "perly.y" +{ yyval.opval = newAVREF(yyvsp[0].opval); } +break; +case 155: +#line 557 "perly.y" +{ yyval.opval = newGVREF(0,yyvsp[0].opval); } +break; +case 156: +#line 561 "perly.y" +{ yyval.opval = scalar(yyvsp[0].opval); } +break; +case 157: +#line 563 "perly.y" +{ yyval.opval = scalar(yyvsp[0].opval); } +break; +case 158: +#line 565 "perly.y" +{ yyval.opval = scope(yyvsp[0].opval); } +break; +case 159: +#line 568 "perly.y" +{ yyval.opval = yyvsp[0].opval; } +break; +#line 2236 "y_tab.c" + } + yyssp -= yym; + yystate = *yyssp; + yyvsp -= yym; + yym = yylhs[yyn]; + if (yystate == 0 && yym == 0) + { +#if YYDEBUG + if (yydebug) + fprintf(stderr, + "yydebug: after reduction, shifting from state 0 to state %d\n", + YYFINAL); +#endif + yystate = YYFINAL; + *++yyssp = YYFINAL; + *++yyvsp = yyval; + if (yychar < 0) + { + if ((yychar = yylex()) < 0) yychar = 0; +#if YYDEBUG + if (yydebug) + { + yys = 0; + if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; + if (!yys) yys = "illegal-symbol"; + fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", + YYFINAL, yychar, yys); + } +#endif + } + if (yychar == 0) goto yyaccept; + goto yyloop; + } + if ((yyn = yygindex[yym]) && (yyn += yystate) >= 0 && + yyn <= YYTABLESIZE && yycheck[yyn] == yystate) + yystate = yytable[yyn]; + else + yystate = yydgoto[yym]; +#if YYDEBUG + if (yydebug) + fprintf(stderr, + "yydebug: after reduction, shifting from state %d to state %d\n", + *yyssp, yystate); +#endif + if (yyssp >= yyss + yystacksize - 1) + { + /* + ** reallocate and recover. Note that pointers + ** have to be reset, or bad things will happen + */ + int yyps_index = (yyssp - yyss); + int yypv_index = (yyvsp - yyvs); + yystacksize += YYSTACKSIZE; + ysave->yyvs = yyvs = + (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE)); + ysave->yyss = yyss = + (short*)realloc((char*)yyss,yystacksize * sizeof(short)); + if (!yyvs || !yyss) + goto yyoverflow; + yyssp = yyss + yyps_index; + yyvsp = yyvs + yypv_index; + } + *++yyssp = yystate; + *++yyvsp = yyval; + goto yyloop; +yyoverflow: + yyerror("Out of memory for yacc stack"); +yyabort: + retval = 1; +yyaccept: + return retval; +} diff --git a/gnu/usr.bin/perl/vms/perly_h.vms b/gnu/usr.bin/perl/vms/perly_h.vms new file mode 100644 index 00000000000..c6ec3a41ad5 --- /dev/null +++ b/gnu/usr.bin/perl/vms/perly_h.vms @@ -0,0 +1,69 @@ +/* Postprocessed by vms_yfix.pl 1.1 to add VMS declarations of globals */ +#define WORD 257 +#define METHOD 258 +#define FUNCMETH 259 +#define THING 260 +#define PMFUNC 261 +#define PRIVATEREF 262 +#define FUNC0SUB 263 +#define UNIOPSUB 264 +#define LSTOPSUB 265 +#define LABEL 266 +#define FORMAT 267 +#define SUB 268 +#define ANONSUB 269 +#define PACKAGE 270 +#define USE 271 +#define WHILE 272 +#define UNTIL 273 +#define IF 274 +#define UNLESS 275 +#define ELSE 276 +#define ELSIF 277 +#define CONTINUE 278 +#define FOR 279 +#define LOOPEX 280 +#define DOTDOT 281 +#define FUNC0 282 +#define FUNC1 283 +#define FUNC 284 +#define RELOP 285 +#define EQOP 286 +#define MULOP 287 +#define ADDOP 288 +#define DOLSHARP 289 +#define DO 290 +#define LOCAL 291 +#define HASHBRACK 292 +#define NOAMP 293 +#define OROP 294 +#define ANDOP 295 +#define NOTOP 296 +#define LSTOP 297 +#define ASSIGNOP 298 +#define OROR 299 +#define ANDAND 300 +#define BITOROP 301 +#define BITANDOP 302 +#define UNIOP 303 +#define SHIFTOP 304 +#define MATCHOP 305 +#define UMINUS 306 +#define REFGEN 307 +#define POWOP 308 +#define PREINC 309 +#define PREDEC 310 +#define POSTINC 311 +#define POSTDEC 312 +#define ARROW 313 +typedef union { + I32 ival; + char *pval; + OP *opval; + GV *gvval; +} YYSTYPE; +#ifndef vax11c + extern YYSTYPE yylval; +#else + globalref YYSTYPE yylval; +#endif diff --git a/gnu/usr.bin/perl/vms/sockadapt.c b/gnu/usr.bin/perl/vms/sockadapt.c new file mode 100644 index 00000000000..08251d6bdfe --- /dev/null +++ b/gnu/usr.bin/perl/vms/sockadapt.c @@ -0,0 +1,43 @@ +/* sockadapt.c + * + * Author: Charles Bailey bailey@genetics.upenn.edu + * Last Revised: 29-Jan-1996 + * + * This file should contain stubs for any of the TCP/IP functions perl5 + * requires which are not supported by your TCP/IP stack. These stubs + * can attempt to emulate the routine in question, or can just return + * an error status or cause perl to die. + * + * This version is set up for perl5 with socketshr 0.9D TCP/IP support. + */ + +#include "EXTERN.h" +#include "perl.h" +#if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 50200000) +# define __sockadapt_my_netent_t __struct_netent_ptr32 +# define __sockadapt_my_addr_t __in_addr_t +# define __sockadapt_my_name_t const char * +#else +# define __sockadapt_my_netent_t struct netent * +# define __sockadapt_my_addr_t long +# define __sockadapt_my_name_t char * +#endif + +__sockadapt_my_netent_t getnetbyaddr( __sockadapt_my_addr_t net, int type) { + croak("Function \"getnetbyaddr\" not implemented in this version of perl"); + return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */ +} +__sockadapt_my_netent_t getnetbyname( __sockadapt_my_name_t name) { + croak("Function \"getnetbyname\" not implemented in this version of perl"); + return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */ +} +__sockadapt_my_netent_t getnetent() { + croak("Function \"getnetent\" not implemented in this version of perl"); + return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */ +} +void setnetent() { + croak("Function \"setnetent\" not implemented in this version of perl"); +} +void endnetent() { + croak("Function \"endnetent\" not implemented in this version of perl"); +} diff --git a/gnu/usr.bin/perl/vms/sockadapt.h b/gnu/usr.bin/perl/vms/sockadapt.h new file mode 100644 index 00000000000..18f4002f127 --- /dev/null +++ b/gnu/usr.bin/perl/vms/sockadapt.h @@ -0,0 +1,142 @@ +/* sockadapt.h + * + * Authors: Charles Bailey bailey@genetics.upenn.edu + * David Denholm denholm@conmat.phys.soton.ac.uk + * Last Revised: 17-Mar-1995 + * + * This file should include any other header files and procide any + * declarations, typedefs, and prototypes needed by perl for TCP/IP + * operations. + * + * This version is set up for perl5 with socketshr 0.9D TCP/IP support. + */ + +/* SocketShr doesn't support these routines, but the DECC RTL contains + * stubs with these names, designed to be used with the UCX socket + * library. We avoid linker collisions by substituting new names. + */ +#define getnetbyaddr no_getnetbyaddr +#define getnetbyname no_getnetbyname +#define getnetent no_getnetent +#define setnetent no_setnetent +#define endnetent no_endnetent + + +#ifdef __GNU_CC__ + +/* we may not have netdb.h etc, so lets just do this here - div */ +/* no harm doing this for all .c files - needed only by pp_sys.c */ + +struct hostent { + char *h_name; /* official name of host */ + char **h_aliases; /* alias list */ + int h_addrtype; /* host address type */ + int h_length; /* length of address */ + char **h_addr_list; /* address */ +}; +#ifdef h_addr +# undef h_addr +#endif +#define h_addr h_addr_list[0] + +struct protoent { + char *p_name; /* official protocol name */ + char **p_aliases; /* alias list */ + int p_proto; /* protocol # */ +}; + +struct servent { + char *s_name; /* official service name */ + char **s_aliases; /* alias list */ + int s_port; /* port # */ + char *s_proto; /* protocol to use */ +}; + +struct in_addr { + unsigned long s_addr; +}; + +struct sockaddr { + unsigned short sa_family; /* address family */ + char sa_data[14]; /* up to 14 bytes of direct address */ +}; + +/* + * Socket address, internet style. + */ +struct sockaddr_in { + short sin_family; + unsigned short sin_port; + struct in_addr sin_addr; + char sin_zero[8]; +}; + +struct timeval { + long tv_sec; + long tv_usec; +}; + +struct netent { + char *n_name; + char **n_aliases; + int n_addrtype; + long n_net; +}; + +/* Since socketshr.h won't declare function prototypes unless it thinks + * the system headers have already been included, we convince it that + * this is the case. + */ + +#ifndef AF_INET +# define AF_INET 2 +#endif +#ifndef IPPROTO_TCP +# define IPPROTO_TCP 6 +#endif +#ifndef __INET_LOADED +# define __INET_LOADED +#endif +#ifndef __NETDB_LOADED +# define __NETDB_LOADED +#endif + +/* Finally, we provide prototypes for routines not supported by SocketShr, + * so that the stubs in sockadapt.c won't cause complaints about + * undeclared routines. + */ + +struct netent *getnetbyaddr( long net, int type); +struct netent *getnetbyname( char *name); +struct netent *getnetent(); +void setnetent(); +void endnetent(); + +#else /* !__GNU_CC__ */ + +/* DECC and VAXC have socket headers in the system set; they're for UCX, but + * we'll assume that the actual calling sequence is identical across the + * various TCP/IP stacks; these routines are pretty standard. + */ +#include <socket.h> +#include <in.h> +#include <inet.h> +#include <netdb.h> +/* However, we don't have these two in the system headers. */ +void setnetent(); +void endnetent(); + +#endif + +#include <socketshr.h> +/* socketshr.h from SocketShr 0.9D doesn't alias fileno; it's comments say + * that the CRTL version works OK. This isn't the case, at least with + * VAXC, so we use the SocketShr version. + * N.B. This means that sockadapt.h must be included *after* stdio.h. + * This is presently the case for Perl. + */ +#ifdef fileno +# undef fileno +#endif +#define fileno si_fileno +int si_fileno(FILE *); diff --git a/gnu/usr.bin/perl/vms/test.com b/gnu/usr.bin/perl/vms/test.com new file mode 100644 index 00000000000..05ff0bba6c7 --- /dev/null +++ b/gnu/usr.bin/perl/vms/test.com @@ -0,0 +1,199 @@ +$! Test.Com - DCL driver for perl5 regression tests +$! +$! Version 1.1 4-Dec-1995 +$! Charles Bailey bailey@genetics.upenn.edu +$ +$! A little basic setup +$ On Error Then Goto wrapup +$ 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.;* +$ Copy/Log/NoConfirm [-]Perl.Exe []Perl. +$ +$! Make the environment look a little friendlier to tests which assume Unix +$ cat = "Type" +$ Macro/NoDebug/Object=Echo.Obj Sys$Input + .title echo + .psect data,wrt,noexe + dsc: + .word 0 + .byte 14 ; DSC$K_DTYPE_T + .byte 2 ; DSC$K_CLASS_D + .long 0 + .psect code,nowrt,exe + .entry echo,^m<r2,r3> + movab dsc,r2 + pushab (r2) + calls #1,G^LIB$GET_FOREIGN + movl 4(r2),r3 + movzwl (r2),r0 + addl2 4(r2),r0 + cmpl r3,r0 + bgtru sym.3 + nop + sym.1: + movb (r3),r0 + cmpb r0,#65 + blss sym.2 + cmpb r0,#90 + bgtr sym.2 + cvtbl r0,r0 + addl2 #32,r0 + cvtlb r0,(r3) + sym.2: + incl r3 + movzwl (r2),r0 + addl2 4(r2),r0 + cmpl r3,r0 + blequ sym.1 + sym.3: + pushab (r2) + calls #1,G^LIB$PUT_OUTPUT + movl #1,r0 + ret + .end echo +$ Link/NoTrace Echo.Obj; +$ 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. "''p1'" "''p2'" "''p3'" "''p4'" "''p5'" "''p6'" +$ Deck/Dollar=$$END-OF-TEST$$ +# $RCSfile: TEST,v $$Revision: 4.1 $$Date: 92/08/07 18:27:00 $ +# Modified for VMS 30-Sep-1994 Charles Bailey bailey@genetics.upenn.edu +# +# This is written in a peculiar style, since we're trying to avoid +# most of the constructs we'll be testing for. + +# skip those tests we know will fail entirely or cause perl to hang bacause +# of Unixisms +@compexcl=('cpp.t','script.t'); +@ioexcl=('argv.t','dup.t','fs.t','inplace.t','pipe.t'); +@libexcl=('anydbm.t','db-btree.t','db-hash.t','db-recno.t', + 'gdbm.t','ndbm.t','odbm.t','sdbm.t','posix.t','soundex.t'); +@opexcl=('exec.t','fork.t','glob.t','magic.t','misc.t','stat.t'); +@exclist=(@compexcl,@ioexcl,@libexcl,@opexcl); +foreach $file (@exclist) { $skip{$file}++; } + +$| = 1; + +@ARGV = grep($_,@ARGV); # remove empty elements due to "''p1'" syntax + +if ($ARGV[0] eq '-v') { + $verbose = 1; + shift; +} + +chdir 't' if -f 't/TEST'; + +if ($ARGV[0] eq '') { + foreach (<[.*]*.t>) { + s/.*[\[.]t./[./; + ($fname = $_) =~ s/.*\]//; + if ($skip{"\L$fname"}) { push(@skipped,$_); } + else { push(@ARGV,$_); } + } +} + +if (@skipped) { + print "The following tests were skipped because they rely extensively on\n"; + print " Unixisms not compatible with the current version of perl for VMS:\n"; + print "\t",join("\n\t",@skipped),"\n\n"; +} + +$bad = 0; +$good = 0; +$total = @ARGV; +while ($test = shift) { + if ($test =~ /^$/) { + next; + } + $te = $test; + chop($te); + $te .= '.' x (24 - length($te)); + open(script,"$test") || die "Can't run $test.\n"; + $_ = <script>; + close(script); + if (/#!..perl(.*)/) { + $switch = $1; + } else { + $switch = ''; + } + open(results,"\$ MCR Sys\$Disk:[]Perl. $switch $test |") || (print "can't run.\n"); + $ok = 0; + $next = 0; + while (<results>) { + if ($verbose) { + print "$te$_"; + $te = ''; + } + unless (/^#/) { + if (/^1\.\.([0-9]+)/) { + $max = $1; + $totmax += $max; + $files += 1; + $next = 1; + $ok = 1; + } else { + $next = $1, $ok = 0, last if /^not ok ([0-9]*)/; + next if /^\s*$/; # our 'echo' substitute produces one more \n than Unix' + if (/^ok (.*)/ && $1 == $next) { + $next = $next + 1; + } else { + $ok = 0; + } + } + } + } + $next = $next - 1; + if ($ok && $next == $max) { + print "${te}ok\n"; + $good = $good + 1; + } else { + $next += 1; + print "${te}FAILED on test $next\n"; + $bad = $bad + 1; + $_ = $test; + if (/^base/) { + die "Failed a basic test--cannot continue.\n"; + } + } +} + +if ($bad == 0) { + if ($ok) { + print "All tests successful.\n"; + } else { + die "FAILED--no tests were run for some reason.\n"; + } +} else { + $pct = sprintf("%.2f", $good / $total * 100); + if ($bad == 1) { + warn "Failed 1 test, $pct% okay.\n"; + } else { + warn "Failed $bad/$total tests, $pct% okay.\n"; + } +} +($user,$sys,$cuser,$csys) = times; +print sprintf("u=%g s=%g cu=%g cs=%g files=%d tests=%d\n", + $user,$sys,$cuser,$csys,$files,$totmax); +$$END-OF-TEST$$ +$ wrapup: +$ If F$Search("Echo.Exe").nes."" Then Delete/Log/NoConfirm Echo.Exe;* +$ Set Default &olddef +$ Exit diff --git a/gnu/usr.bin/perl/vms/vms.c b/gnu/usr.bin/perl/vms/vms.c new file mode 100644 index 00000000000..150747f52d2 --- /dev/null +++ b/gnu/usr.bin/perl/vms/vms.c @@ -0,0 +1,3639 @@ +/* vms.c + * + * VMS-specific routines for perl5 + * + * Last revised: 21-Jun-1996 by Charles Bailey bailey@genetics.upenn.edu + * Version: 5.2.2 + */ + +#include <acedef.h> +#include <acldef.h> +#include <armdef.h> +#include <atrdef.h> +#include <chpdef.h> +#include <climsgdef.h> +#include <descrip.h> +#include <dvidef.h> +#include <fibdef.h> +#include <float.h> +#include <fscndef.h> +#include <iodef.h> +#include <jpidef.h> +#include <libdef.h> +#include <lib$routines.h> +#include <lnmdef.h> +#include <prvdef.h> +#include <psldef.h> +#include <rms.h> +#include <shrdef.h> +#include <ssdef.h> +#include <starlet.h> +#include <stsdef.h> +#include <syidef.h> +#include <uaidef.h> +#include <uicdef.h> + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +/* gcc's header files don't #define direct access macros + * corresponding to VAXC's variant structs */ +#ifdef __GNUC__ +# define uic$v_format uic$r_uic_form.uic$v_format +# define uic$v_group uic$r_uic_form.uic$v_group +# define uic$v_member uic$r_uic_form.uic$v_member +# define prv$v_bypass prv$r_prvdef_bits0.prv$v_bypass +# define prv$v_grpprv prv$r_prvdef_bits0.prv$v_grpprv +# define prv$v_readall prv$r_prvdef_bits0.prv$v_readall +# define prv$v_sysprv prv$r_prvdef_bits0.prv$v_sysprv +#endif + + +struct itmlst_3 { + unsigned short int buflen; + unsigned short int itmcode; + void *bufadr; + unsigned short int *retlen; +}; + +static char *__mystrtolower(char *str) +{ + if (str) for (; *str; ++str) *str= tolower(*str); + return str; +} + +int +my_trnlnm(char *lnm, char *eqv, unsigned long int idx) +{ + static char __my_trnlnm_eqv[LNM$C_NAMLENGTH+1]; + unsigned short int eqvlen; + unsigned long int retsts, attr = LNM$M_CASE_BLIND; + $DESCRIPTOR(tabdsc,"LNM$FILE_DEV"); + struct dsc$descriptor_s lnmdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0}; + struct itmlst_3 lnmlst[3] = {{sizeof idx, LNM$_INDEX, &idx, 0}, + {LNM$C_NAMLENGTH, LNM$_STRING, 0, &eqvlen}, + {0, 0, 0, 0}}; + + if (!eqv) eqv = __my_trnlnm_eqv; + lnmlst[1].bufadr = (void *)eqv; + lnmdsc.dsc$a_pointer = lnm; + lnmdsc.dsc$w_length = strlen(lnm); + retsts = sys$trnlnm(&attr,&tabdsc,&lnmdsc,0,lnmlst); + if (retsts == SS$_NOLOGNAM || retsts == SS$_IVLOGNAM) { + set_vaxc_errno(retsts); set_errno(EINVAL); return 0; + } + else if (retsts & 1) { + eqv[eqvlen] = '\0'; + return 1; + } + _ckvmssts(retsts); /* Must be an error */ + return 0; /* Not reached, assuming _ckvmssts() bails out */ + +} /* end of my_trnlnm */ + +/* my_getenv + * Translate a logical name. Substitute for CRTL getenv() to avoid + * memory leak, and to keep my_getenv() and my_setenv() in the same + * domain (mostly - my_getenv() need not return a translation from + * the process logical name table) + * + * Note: Uses static buffer -- not thread-safe! + */ +/*{{{ char *my_getenv(char *lnm)*/ +char * +my_getenv(char *lnm) +{ + static char __my_getenv_eqv[LNM$C_NAMLENGTH+1]; + char uplnm[LNM$C_NAMLENGTH], *cp1, *cp2; + unsigned long int idx = 0; + + for (cp1 = lnm, cp2= uplnm; *cp1; cp1++, cp2++) *cp2 = _toupper(*cp1); + *cp2 = '\0'; + if (cp1 - lnm == 7 && !strncmp(uplnm,"DEFAULT",7)) { + getcwd(__my_getenv_eqv,sizeof __my_getenv_eqv); + return __my_getenv_eqv; + } + else { + if ((cp2 = strchr(uplnm,';')) != NULL) { + *cp2 = '\0'; + idx = strtoul(cp2+1,NULL,0); + } + if (my_trnlnm(uplnm,__my_getenv_eqv,idx)) { + return __my_getenv_eqv; + } + else { + unsigned long int retsts; + struct dsc$descriptor_s symdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0}, + valdsc = {sizeof __my_getenv_eqv,DSC$K_DTYPE_T, + DSC$K_CLASS_S, __my_getenv_eqv}; + symdsc.dsc$w_length = cp1 - lnm; + symdsc.dsc$a_pointer = uplnm; + retsts = lib$get_symbol(&symdsc,&valdsc,&(valdsc.dsc$w_length),0); + if (retsts == LIB$_INVSYMNAM) return Nullch; + if (retsts != LIB$_NOSUCHSYM) { + /* We want to return only logical names or CRTL Unix emulations */ + if (retsts & 1) return Nullch; + _ckvmssts(retsts); + } + /* Try for CRTL emulation of a Unix/POSIX name */ + else return getenv(lnm); + } + } + return Nullch; + +} /* end of my_getenv() */ +/*}}}*/ + +/*{{{ void my_setenv(char *lnm, char *eqv)*/ +void +my_setenv(char *lnm,char *eqv) +/* Define a supervisor-mode logical name in the process table. + * In the future we'll add tables, attribs, and acmodes, + * probably through a different call. + */ +{ + char uplnm[LNM$C_NAMLENGTH], *cp1, *cp2; + unsigned long int retsts, usermode = PSL$C_USER; + $DESCRIPTOR(tabdsc,"LNM$PROCESS"); + struct dsc$descriptor_s lnmdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,uplnm}, + eqvdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0}; + + for(cp1 = lnm, cp2 = uplnm; *cp1; cp1++, cp2++) *cp2 = _toupper(*cp1); + lnmdsc.dsc$w_length = cp1 - lnm; + + if (!eqv || !*eqv) { /* we're deleting a logical name */ + retsts = sys$dellnm(&tabdsc,&lnmdsc,&usermode); /* try user mode first */ + if (retsts == SS$_IVLOGNAM) return; + if (retsts != SS$_NOLOGNAM) _ckvmssts(retsts); + if (!(retsts & 1)) { + retsts = lib$delete_logical(&lnmdsc,&tabdsc); /* then supervisor mode */ + if (retsts != SS$_NOLOGNAM) _ckvmssts(retsts); + } + } + else { + eqvdsc.dsc$w_length = strlen(eqv); + eqvdsc.dsc$a_pointer = eqv; + + _ckvmssts(lib$set_logical(&lnmdsc,&eqvdsc,&tabdsc,0,0)); + } + +} /* end of my_setenv() */ +/*}}}*/ + + +/*{{{ char *my_crypt(const char *textpasswd, const char *usrname)*/ +/* my_crypt - VMS password hashing + * my_crypt() provides an interface compatible with the Unix crypt() + * C library function, and uses sys$hash_password() to perform VMS + * password hashing. The quadword hashed password value is returned + * as a NUL-terminated 8 character string. my_crypt() does not change + * the case of its string arguments; in order to match the behavior + * of LOGINOUT et al., alphabetic characters in both arguments must + * be upcased by the caller. + */ +char * +my_crypt(const char *textpasswd, const char *usrname) +{ +# ifndef UAI$C_PREFERRED_ALGORITHM +# define UAI$C_PREFERRED_ALGORITHM 127 +# endif + unsigned char alg = UAI$C_PREFERRED_ALGORITHM; + unsigned short int salt = 0; + unsigned long int sts; + struct const_dsc { + unsigned short int dsc$w_length; + unsigned char dsc$b_type; + unsigned char dsc$b_class; + const char * dsc$a_pointer; + } usrdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}, + txtdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; + struct itmlst_3 uailst[3] = { + { sizeof alg, UAI$_ENCRYPT, &alg, 0}, + { sizeof salt, UAI$_SALT, &salt, 0}, + { 0, 0, NULL, NULL}}; + static char hash[9]; + + usrdsc.dsc$w_length = strlen(usrname); + usrdsc.dsc$a_pointer = usrname; + if (!((sts = sys$getuai(0, 0, &usrdsc, uailst, 0, 0, 0)) & 1)) { + switch (sts) { + case SS$_NOGRPPRV: + case SS$_NOSYSPRV: + set_errno(EACCES); + break; + case RMS$_RNF: + set_errno(ESRCH); /* There isn't a Unix no-such-user error */ + break; + default: + set_errno(EVMSERR); + } + set_vaxc_errno(sts); + if (sts != RMS$_RNF) return NULL; + } + + txtdsc.dsc$w_length = strlen(textpasswd); + txtdsc.dsc$a_pointer = textpasswd; + if (!((sts = sys$hash_password(&txtdsc, alg, salt, &usrdsc, &hash)) & 1)) { + set_errno(EVMSERR); set_vaxc_errno(sts); return NULL; + } + + return (char *) hash; + +} /* end of my_crypt() */ +/*}}}*/ + + +static char *do_fileify_dirspec(char *, char *, int); +static char *do_tovmsspec(char *, char *, int); + +/*{{{int do_rmdir(char *name)*/ +int +do_rmdir(char *name) +{ + char dirfile[NAM$C_MAXRSS+1]; + int retval; + struct stat st; + + if (do_fileify_dirspec(name,dirfile,0) == NULL) return -1; + if (flex_stat(dirfile,&st) || !S_ISDIR(st.st_mode)) retval = -1; + else retval = kill_file(dirfile); + return retval; + +} /* end of do_rmdir */ +/*}}}*/ + +/* kill_file + * Delete any file to which user has control access, regardless of whether + * delete access is explicitly allowed. + * Limitations: User must have write access to parent directory. + * Does not block signals or ASTs; if interrupted in midstream + * may leave file with an altered ACL. + * HANDLE WITH CARE! + */ +/*{{{int kill_file(char *name)*/ +int +kill_file(char *name) +{ + char vmsname[NAM$C_MAXRSS+1]; + unsigned long int jpicode = JPI$_UIC, type = ACL$C_FILE; + unsigned long int cxt = 0, aclsts, fndsts, rmsts = -1; + struct dsc$descriptor_s fildsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; + struct myacedef { + unsigned char myace$b_length; + unsigned char myace$b_type; + unsigned short int myace$w_flags; + unsigned long int myace$l_access; + unsigned long int myace$l_ident; + } newace = { sizeof(struct myacedef), ACE$C_KEYID, 0, + ACE$M_READ | ACE$M_WRITE | ACE$M_DELETE | ACE$M_CONTROL, 0}, + oldace = { sizeof(struct myacedef), ACE$C_KEYID, 0, 0, 0}; + struct itmlst_3 + findlst[3] = {{sizeof oldace, ACL$C_FNDACLENT, &oldace, 0}, + {sizeof oldace, ACL$C_READACE, &oldace, 0},{0,0,0,0}}, + addlst[2] = {{sizeof newace, ACL$C_ADDACLENT, &newace, 0},{0,0,0,0}}, + dellst[2] = {{sizeof newace, ACL$C_DELACLENT, &newace, 0},{0,0,0,0}}, + lcklst[2] = {{sizeof newace, ACL$C_WLOCK_ACL, &newace, 0},{0,0,0,0}}, + ulklst[2] = {{sizeof newace, ACL$C_UNLOCK_ACL, &newace, 0},{0,0,0,0}}; + + if (!remove(name)) return 0; /* Can we just get rid of it? */ + + /* No, so we get our own UIC to use as a rights identifier, + * and the insert an ACE at the head of the ACL which allows us + * to delete the file. + */ + _ckvmssts(lib$getjpi(&jpicode,0,0,&(oldace.myace$l_ident),0,0)); + if (do_tovmsspec(name,vmsname,0) == NULL) return -1; + fildsc.dsc$w_length = strlen(vmsname); + fildsc.dsc$a_pointer = vmsname; + cxt = 0; + newace.myace$l_ident = oldace.myace$l_ident; + if (!((aclsts = sys$change_acl(0,&type,&fildsc,lcklst,0,0,0)) & 1)) { + set_errno(EVMSERR); + set_vaxc_errno(aclsts); + return -1; + } + /* 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 + || fndsts == SS$_NOMOREACE ) { + /* Add the new ACE . . . */ + if (!((aclsts = sys$change_acl(0,&type,&fildsc,addlst,0,0,0)) & 1)) + goto yourroom; + if ((rmsts = remove(name))) { + /* We blew it - dir with files in it, no write priv for + * parent directory, etc. Put things back the way they were. */ + if (!((aclsts = sys$change_acl(0,&type,&fildsc,dellst,0,0,0)) & 1)) + goto yourroom; + if (fndsts & 1) { + addlst[0].bufadr = &oldace; + if (!((aclsts = sys$change_acl(0,&type,&fildsc,addlst,0,0,&cxt)) & 1)) + goto yourroom; + } + } + } + + yourroom: + if (rmsts) { + fndsts = sys$change_acl(0,&type,&fildsc,ulklst,0,0,0); + if (aclsts & 1) aclsts = fndsts; + } + if (!(aclsts & 1)) { + set_errno(EVMSERR); + set_vaxc_errno(aclsts); + return -1; + } + + return rmsts; + +} /* end of kill_file() */ +/*}}}*/ + +/* my_utime - update modification time of a file + * calling sequence is identical to POSIX utime(), but under + * VMS only the modification time is changed; ODS-2 does not + * maintain access times. Restrictions differ from the POSIX + * definition in that the time can be changed as long as the + * caller has permission to execute the necessary IO$_MODIFY $QIO; + * no separate checks are made to insure that the caller is the + * owner of the file or has special privs enabled. + * Code here is based on Joe Meadows' FILE utility. + */ + +/* Adjustment from Unix epoch (01-JAN-1970 00:00:00.00) + * to VMS epoch (01-JAN-1858 00:00:00.00) + * in 100 ns intervals. + */ +static const long int utime_baseadjust[2] = { 0x4beb4000, 0x7c9567 }; + +/*{{{int my_utime(char *path, struct utimbuf *utimes)*/ +int my_utime(char *file, struct utimbuf *utimes) +{ + register int i; + long int bintime[2], len = 2, lowbit, unixtime, + secscale = 10000000; /* seconds --> 100 ns intervals */ + unsigned long int chan, iosb[2], retsts; + char vmsspec[NAM$C_MAXRSS+1], rsa[NAM$C_MAXRSS], esa[NAM$C_MAXRSS]; + struct FAB myfab = cc$rms_fab; + struct NAM mynam = cc$rms_nam; +#if defined (__DECC) && defined (__VAX) + /* VAX DEC C atrdef.h has unsigned type for pointer member atr$l_addr, + * at least through VMS V6.1, which causes a type-conversion warning. + */ +# pragma message save +# pragma message disable cvtdiftypes +#endif + struct atrdef myatr[2] = {{sizeof bintime, ATR$C_REVDATE, bintime}, {0,0,0}}; + struct fibdef myfib; +#if defined (__DECC) && defined (__VAX) + /* This should be right after the declaration of myatr, but due + * to a bug in VAX DEC C, this takes effect a statement early. + */ +# pragma message restore +#endif + struct dsc$descriptor fibdsc = {sizeof(myfib), DSC$K_DTYPE_Z, DSC$K_CLASS_S,(char *) &myfib}, + devdsc = {0,DSC$K_DTYPE_T, DSC$K_CLASS_S,0}, + fnmdsc = {0,DSC$K_DTYPE_T, DSC$K_CLASS_S,0}; + + if (file == NULL || *file == '\0') { + set_errno(ENOENT); + set_vaxc_errno(LIB$_INVARG); + 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) + * to VMS quadword time (100 nsec intervals since 01-JAN-1858 00:00:00.00). + * Since time_t is unsigned long int, and lib$emul takes a signed long int + * as input, we force the sign bit to be clear by shifting unixtime right + * one bit, then multiplying by an extra factor of 2 in lib$emul(). + */ + lowbit = (utimes->modtime & 1) ? secscale : 0; + unixtime = (long int) utimes->modtime; + unixtime >> 1; secscale << 1; + retsts = lib$emul(&secscale, &unixtime, &lowbit, bintime); + if (!(retsts & 1)) { + set_errno(EVMSERR); + set_vaxc_errno(retsts); + return -1; + } + retsts = lib$addx(bintime,utime_baseadjust,bintime,&len); + if (!(retsts & 1)) { + set_errno(EVMSERR); + set_vaxc_errno(retsts); + return -1; + } + } + else { + /* Just get the current time in VMS format directly */ + retsts = sys$gettim(bintime); + if (!(retsts & 1)) { + set_errno(EVMSERR); + set_vaxc_errno(retsts); + return -1; + } + } + + myfab.fab$l_fna = vmsspec; + myfab.fab$b_fns = (unsigned char) strlen(vmsspec); + myfab.fab$l_nam = &mynam; + mynam.nam$l_esa = esa; + mynam.nam$b_ess = (unsigned char) sizeof esa; + mynam.nam$l_rsa = rsa; + mynam.nam$b_rss = (unsigned char) sizeof rsa; + + /* Look for the file to be affected, letting RMS parse the file + * specification for us as well. I have set errno using only + * values documented in the utime() man page for VMS POSIX. + */ + retsts = sys$parse(&myfab,0,0); + if (!(retsts & 1)) { + set_vaxc_errno(retsts); + if (retsts == RMS$_PRV) set_errno(EACCES); + else if (retsts == RMS$_DIR) set_errno(ENOTDIR); + else set_errno(EVMSERR); + return -1; + } + retsts = sys$search(&myfab,0,0); + if (!(retsts & 1)) { + set_vaxc_errno(retsts); + if (retsts == RMS$_PRV) set_errno(EACCES); + else if (retsts == RMS$_FNF) set_errno(ENOENT); + else set_errno(EVMSERR); + return -1; + } + + devdsc.dsc$w_length = mynam.nam$b_dev; + devdsc.dsc$a_pointer = (char *) mynam.nam$l_dev; + + retsts = sys$assign(&devdsc,&chan,0,0); + if (!(retsts & 1)) { + set_vaxc_errno(retsts); + if (retsts == SS$_IVDEVNAM) set_errno(ENOTDIR); + else if (retsts == SS$_NOPRIV) set_errno(EACCES); + else if (retsts == SS$_NOSUCHDEV) set_errno(ENOTDIR); + else set_errno(EVMSERR); + return -1; + } + + fnmdsc.dsc$a_pointer = mynam.nam$l_name; + fnmdsc.dsc$w_length = mynam.nam$b_name + mynam.nam$b_type + mynam.nam$b_ver; + + memset((void *) &myfib, 0, sizeof myfib); +#ifdef __DECC + for (i=0;i<3;i++) myfib.fib$w_fid[i] = mynam.nam$w_fid[i]; + for (i=0;i<3;i++) myfib.fib$w_did[i] = mynam.nam$w_did[i]; + /* This prevents the revision time of the file being reset to the current + * time as a result of our IO$_MODIFY $QIO. */ + myfib.fib$l_acctl = FIB$M_NORECORD; +#else + for (i=0;i<3;i++) myfib.fib$r_fid_overlay.fib$w_fid[i] = mynam.nam$w_fid[i]; + for (i=0;i<3;i++) myfib.fib$r_did_overlay.fib$w_did[i] = mynam.nam$w_did[i]; + myfib.fib$r_acctl_overlay.fib$l_acctl = FIB$M_NORECORD; +#endif + retsts = sys$qiow(0,chan,IO$_MODIFY,iosb,0,0,&fibdsc,&fnmdsc,0,0,myatr,0); + _ckvmssts(sys$dassgn(chan)); + if (retsts & 1) retsts = iosb[0]; + if (!(retsts & 1)) { + set_vaxc_errno(retsts); + if (retsts == SS$_NOPRIV) set_errno(EACCES); + else set_errno(EVMSERR); + return -1; + } + + return 0; +} /* end of my_utime() */ +/*}}}*/ + +static void +create_mbx(unsigned short int *chan, struct dsc$descriptor_s *namdsc) +{ + static unsigned long int mbxbufsiz; + long int syiitm = SYI$_MAXBUF, dviitm = DVI$_DEVNAM; + + if (!mbxbufsiz) { + /* + * Get the SYSGEN parameter MAXBUF, and the smaller of it and the + * preprocessor consant BUFSIZ from stdio.h as the size of the + * 'pipe' mailbox. + */ + _ckvmssts(lib$getsyi(&syiitm, &mbxbufsiz, 0, 0, 0, 0)); + if (mbxbufsiz > BUFSIZ) mbxbufsiz = BUFSIZ; + } + _ckvmssts(sys$crembx(0,chan,mbxbufsiz,mbxbufsiz,0,0,0)); + + _ckvmssts(lib$getdvi(&dviitm, chan, NULL, NULL, namdsc, &namdsc->dsc$w_length)); + namdsc->dsc$a_pointer[namdsc->dsc$w_length] = '\0'; + +} /* end of create_mbx() */ + +/*{{{ my_popen and my_pclose*/ +struct pipe_details +{ + struct pipe_details *next; + FILE *fp; /* stdio file pointer to pipe mailbox */ + int pid; /* PID of subprocess */ + int mode; /* == 'r' if pipe open for reading */ + int done; /* subprocess has completed */ + unsigned long int completion; /* termination status of subprocess */ +}; + +struct exit_control_block +{ + struct exit_control_block *flink; + unsigned long int (*exit_routine)(); + unsigned long int arg_count; + unsigned long int *status_address; + unsigned long int exit_status; +}; + +static struct pipe_details *open_pipes = NULL; +static $DESCRIPTOR(nl_desc, "NL:"); +static int waitpid_asleep = 0; + +static unsigned long int +pipe_exit_routine() +{ + unsigned long int retsts = SS$_NORMAL, abort = SS$_TIMEOUT, sts; + + while (open_pipes != NULL) { + if (!open_pipes->done) { /* Tap them gently on the shoulder . . .*/ + _ckvmssts(sys$forcex(&open_pipes->pid,0,&abort)); + sleep(1); + } + if (!open_pipes->done) /* We tried to be nice . . . */ + _ckvmssts(sys$delprc(&open_pipes->pid,0)); + if (!((sts = my_pclose(open_pipes->fp))&1)) retsts = sts; + } + return retsts; +} + +static struct exit_control_block pipe_exitblock = + {(struct exit_control_block *) 0, + pipe_exit_routine, 0, &pipe_exitblock.exit_status, 0}; + + +static void +popen_completion_ast(struct pipe_details *thispipe) +{ + thispipe->done = TRUE; + if (waitpid_asleep) { + waitpid_asleep = 0; + sys$wake(0,0); + } +} + +/*{{{ FILE *my_popen(char *cmd, char *mode)*/ +FILE * +my_popen(char *cmd, char *mode) +{ + static int handler_set_up = FALSE; + char mbxname[64]; + unsigned short int chan; + unsigned long int flags=1; /* nowait - gnu c doesn't allow &1 */ + struct pipe_details *info; + struct dsc$descriptor_s namdsc = {sizeof mbxname, DSC$K_DTYPE_T, + DSC$K_CLASS_S, mbxname}, + cmddsc = {0, DSC$K_DTYPE_T, + DSC$K_CLASS_S, 0}; + + + cmddsc.dsc$w_length=strlen(cmd); + cmddsc.dsc$a_pointer=cmd; + if (cmddsc.dsc$w_length > 255) { + set_errno(E2BIG); set_vaxc_errno(CLI$_BUFOVF); + return Nullfp; + } + + New(7001,info,1,struct pipe_details); + + /* create mailbox */ + create_mbx(&chan,&namdsc); + + /* open a FILE* onto it */ + info->fp=fopen(mbxname, mode); + + /* give up other channel onto it */ + _ckvmssts(sys$dassgn(chan)); + + if (!info->fp) + return Nullfp; + + info->mode = *mode; + info->done = FALSE; + info->completion=0; + + if (*mode == 'r') { + _ckvmssts(lib$spawn(&cmddsc, &nl_desc, &namdsc, &flags, + 0 /* name */, &info->pid, &info->completion, + 0, popen_completion_ast,info,0,0,0)); + } + else { + _ckvmssts(lib$spawn(&cmddsc, &namdsc, 0 /* sys$output */, &flags, + 0 /* name */, &info->pid, &info->completion, + 0, popen_completion_ast,info,0,0,0)); + } + + if (!handler_set_up) { + _ckvmssts(sys$dclexh(&pipe_exitblock)); + handler_set_up = TRUE; + } + info->next=open_pipes; /* prepend to list */ + open_pipes=info; + + forkprocess = info->pid; + return info->fp; +} +/*}}}*/ + +/*{{{ I32 my_pclose(FILE *fp)*/ +I32 my_pclose(FILE *fp) +{ + struct pipe_details *info, *last = NULL; + unsigned long int retsts; + + for (info = open_pipes; info != NULL; last = info, info = info->next) + if (info->fp == fp) break; + + if (info == NULL) + /* get here => no such pipe open */ + croak("No such pipe open"); + + fclose(info->fp); + + if (info->done) retsts = info->completion; + else waitpid(info->pid,(int *) &retsts,0); + + /* remove from list of open pipes */ + if (last) last->next = info->next; + else open_pipes = info->next; + Safefree(info); + + return retsts; + +} /* end of my_pclose() */ + +/* sort-of waitpid; use only with popen() */ +/*{{{unsigned long int waitpid(unsigned long int pid, int *statusp, int flags)*/ +unsigned long int +waitpid(unsigned long int pid, int *statusp, int flags) +{ + struct pipe_details *info; + + for (info = open_pipes; info != NULL; info = info->next) + if (info->pid == pid) break; + + if (info != NULL) { /* we know about this child */ + while (!info->done) { + waitpid_asleep = 1; + sys$hiber(); + } + + *statusp = info->completion; + return pid; + } + else { /* we haven't heard of this child */ + $DESCRIPTOR(intdsc,"0 00:00:01"); + unsigned long int ownercode = JPI$_OWNER, ownerpid, mypid; + unsigned long int interval[2],sts; + + if (dowarn) { + _ckvmssts(lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0)); + _ckvmssts(lib$getjpi(&ownercode,0,0,&mypid,0,0)); + if (ownerpid != mypid) + warn("pid %d not a child",pid); + } + + _ckvmssts(sys$bintim(&intdsc,interval)); + while ((sts=lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0)) & 1) { + _ckvmssts(sys$schdwk(0,0,interval,0)); + _ckvmssts(sys$hiber()); + } + _ckvmssts(sts); + + /* There's no easy way to find the termination status a child we're + * not aware of beforehand. If we're really interested in the future, + * we can go looking for a termination mailbox, or chase after the + * accounting record for the process. + */ + *statusp = 0; + return pid; + } + +} /* end of waitpid() */ +/*}}}*/ +/*}}}*/ +/*}}}*/ + +/*{{{ char *my_gconvert(double val, int ndig, int trail, char *buf) */ +char * +my_gconvert(double val, int ndig, int trail, char *buf) +{ + static char __gcvtbuf[DBL_DIG+1]; + char *loc; + + loc = buf ? buf : __gcvtbuf; + if (val) { + if (!buf && ndig > DBL_DIG) ndig = DBL_DIG; + return gcvt(val,ndig,loc); + } + else { + loc[0] = '0'; loc[1] = '\0'; + return loc; + } + +} +/*}}}*/ + +/* +** The following routines are provided to make life easier when +** converting among VMS-style and Unix-style directory specifications. +** All will take input specifications in either VMS or Unix syntax. On +** failure, all return NULL. If successful, the routines listed below +** return a pointer to a buffer containing the appropriately +** reformatted spec (and, therefore, subsequent calls to that routine +** will clobber the result), while the routines of the same names with +** a _ts suffix appended will return a pointer to a mallocd string +** containing the appropriately reformatted spec. +** In all cases, only explicit syntax is altered; no check is made that +** the resulting string is valid or that the directory in question +** actually exists. +** +** fileify_dirspec() - convert a directory spec into the name of the +** directory file (i.e. what you can stat() to see if it's a dir). +** The style (VMS or Unix) of the result is the same as the style +** of the parameter passed in. +** pathify_dirspec() - convert a directory spec into a path (i.e. +** what you prepend to a filename to indicate what directory it's in). +** The style (VMS or Unix) of the result is the same as the style +** of the parameter passed in. +** tounixpath() - convert a directory spec into a Unix-style path. +** 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 1996 by Charles Bailey <bailey@genetics.upenn.edu> +** Permission is given to distribute this code as part of the Perl +** standard distribution under the terms of the GNU General Public +** License or the Perl Artistic License. Copies of each may be +** found in the Perl standard distribution. + */ + +static char *do_tounixspec(char *, char *, int); + +/*{{{ char *fileify_dirspec[_ts](char *path, char *buf)*/ +static char *do_fileify_dirspec(char *dir,char *buf,int ts) +{ + static char __fileify_retbuf[NAM$C_MAXRSS+1]; + unsigned long int dirlen, retlen, addmfd = 0; + char *retspec, *cp1, *cp2, *lastdir; + char trndir[NAM$C_MAXRSS+1], vmsdir[NAM$C_MAXRSS+1]; + + if (!dir || !*dir) { + set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL; + } + dirlen = strlen(dir); + if (dir[dirlen-1] == '/') --dirlen; + if (!dirlen) { + set_errno(ENOTDIR); + set_vaxc_errno(RMS$_DIR); + return NULL; + } + if (!strpbrk(dir+1,"/]>:")) { + strcpy(trndir,*dir == '/' ? dir + 1: dir); + while (!strpbrk(trndir,"/]>:>") && my_trnlnm(trndir,trndir,0)) ; + dir = trndir; + dirlen = strlen(dir); + } + else { + strncpy(trndir,dir,dirlen); + trndir[dirlen] = '\0'; + dir = trndir; + } + /* If we were handed a rooted logical name or spec, treat it like a + * simple directory, so that + * $ Define myroot dev:[dir.] + * ... do_fileify_dirspec("myroot",buf,1) ... + * does something useful. + */ + if (!strcmp(dir+dirlen-2,".]")) { + dir[--dirlen] = '\0'; + dir[dirlen-1] = ']'; + } + + if (!strpbrk(dir,"]:>")) { /* Unix-style path or plain dir name */ + if (dir[0] == '.') { + if (dir[1] == '\0' || (dir[1] == '/' && dir[2] == '\0')) + return do_fileify_dirspec("[]",buf,ts); + else if (dir[1] == '.' && + (dir[2] == '\0' || (dir[2] == '/' && dir[3] == '\0'))) + return do_fileify_dirspec("[-]",buf,ts); + } + if (dir[dirlen-1] == '/') { /* path ends with '/'; just add .dir;1 */ + dirlen -= 1; /* to last element */ + lastdir = strrchr(dir,'/'); + } + else if ((cp1 = strstr(dir,"/.")) != NULL) { + /* If we have "/." or "/..", VMSify it and let the VMS code + * below expand it, rather than repeating the code to handle + * relative components of a filespec here */ + do { + if (*(cp1+2) == '.') cp1++; + if (*(cp1+2) == '/' || *(cp1+2) == '\0') { + if (do_tovmsspec(dir,vmsdir,0) == NULL) return NULL; + if (do_fileify_dirspec(vmsdir,trndir,0) == NULL) return NULL; + return do_tounixspec(trndir,buf,ts); + } + cp1++; + } while ((cp1 = strstr(cp1,"/.")) != NULL); + } + else { + if (!(lastdir = cp1 = strrchr(dir,'/'))) cp1 = dir; + if ((cp2 = strchr(cp1,'.'))) { /* look for explicit type */ + if (toupper(*(cp2+1)) == 'D' && /* Yep. Is it .dir? */ + toupper(*(cp2+2)) == 'I' && + toupper(*(cp2+3)) == 'R') { + if ((cp1 = strchr(cp2,';')) || (cp1 = strchr(cp2+1,'.'))) { + if (*(cp1+1) != '1' || *(cp1+2) != '\0') { /* Version is not ;1 */ + set_errno(ENOTDIR); /* Bzzt. */ + set_vaxc_errno(RMS$_DIR); + return NULL; + } + } + dirlen = cp2 - dir; + } + else { /* There's a type, and it's not .dir. Bzzt. */ + set_errno(ENOTDIR); + set_vaxc_errno(RMS$_DIR); + return NULL; + } + } + } + /* If we lead off with a device or rooted logical, add the MFD + if we're specifying a top-level directory. */ + if (lastdir && *dir == '/') { + addmfd = 1; + for (cp1 = lastdir - 1; cp1 > dir; cp1--) { + if (*cp1 == '/') { + addmfd = 0; + break; + } + } + } + retlen = dirlen + (addmfd ? 13 : 6); + if (buf) retspec = buf; + else if (ts) New(7009,retspec,retlen+1,char); + else retspec = __fileify_retbuf; + if (addmfd) { + dirlen = lastdir - dir; + memcpy(retspec,dir,dirlen); + strcpy(&retspec[dirlen],"/000000"); + strcpy(&retspec[dirlen+7],lastdir); + } + else { + memcpy(retspec,dir,dirlen); + retspec[dirlen] = '\0'; + } + /* We've picked up everything up to the directory file name. + Now just add the type and version, and we're set. */ + strcat(retspec,".dir;1"); + return retspec; + } + else { /* VMS-style directory spec */ + char esa[NAM$C_MAXRSS+1], term, *cp; + unsigned long int sts, cmplen, haslower = 0; + struct FAB dirfab = cc$rms_fab; + struct NAM savnam, dirnam = cc$rms_nam; + + dirfab.fab$b_fns = strlen(dir); + dirfab.fab$l_fna = dir; + dirfab.fab$l_nam = &dirnam; + dirfab.fab$l_dna = ".DIR;1"; + dirfab.fab$b_dns = 6; + dirnam.nam$b_ess = NAM$C_MAXRSS; + dirnam.nam$l_esa = esa; + + for (cp = dir; *cp; cp++) + if (islower(*cp)) { haslower = 1; break; } + 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; + } + } + 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,']'); + if (!cp1) cp1 = strchr(esa,'>'); + if (cp1) { /* Should always be true */ + dirnam.nam$b_esl -= cp1 - esa - 1; + memcpy(esa,cp1 + 1,dirnam.nam$b_esl); + } + } + 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; + if (strncmp(dirnam.nam$l_type,".DIR;1",cmplen)) { + /* Something other than .DIR[;1]. Bzzt. */ + set_errno(ENOTDIR); + set_vaxc_errno(RMS$_DIR); + return NULL; + } + } + esa[dirnam.nam$b_esl] = '\0'; + 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+1,char); + else retspec = __fileify_retbuf; + strcpy(retspec,esa); + return retspec; + } + if ((cp1 = strstr(esa,".][000000]")) != NULL) { + for (cp2 = cp1 + 9; *cp2; cp1++,cp2++) *cp1 = *cp2; + *cp1 = '\0'; + dirnam.nam$b_esl -= 9; + } + if ((cp1 = strrchr(esa,']')) == NULL) cp1 = strrchr(esa,'>'); + if (cp1 == NULL) return NULL; /* should never happen */ + term = *cp1; + *cp1 = '\0'; + retlen = strlen(esa); + if ((cp1 = strrchr(esa,'.')) != NULL) { + /* 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+7,char); + else retspec = __fileify_retbuf; + strcpy(retspec,esa); + } + else { + if (dirnam.nam$l_fnb & NAM$M_ROOT_DIR) { + /* Go back and expand rooted logical name */ + dirnam.nam$b_nop = NAM$M_SYNCHK | NAM$M_NOCONCEAL; + if (!(sys$parse(&dirfab) & 1)) { + set_errno(EVMSERR); + set_vaxc_errno(dirfab.fab$l_sts); + return NULL; + } + retlen = dirnam.nam$b_esl - 9; /* esa - '][' - '].DIR;1' */ + if (buf) retspec = buf; + else if (ts) New(7012,retspec,retlen+16,char); + else retspec = __fileify_retbuf; + cp1 = strstr(esa,"]["); + dirlen = cp1 - esa; + memcpy(retspec,esa,dirlen); + if (!strncmp(cp1+2,"000000]",7)) { + retspec[dirlen-1] = '\0'; + for (cp1 = retspec+dirlen-1; *cp1 != '.' && *cp1 != '['; cp1--) ; + if (*cp1 == '.') *cp1 = ']'; + else { + memmove(cp1+8,cp1+1,retspec+dirlen-cp1); + memcpy(cp1+1,"000000]",7); + } + } + else { + memcpy(retspec+dirlen,cp1+2,retlen-dirlen); + retspec[retlen] = '\0'; + /* Convert last '.' to ']' */ + for (cp1 = retspec+retlen-1; *cp1 != '.' && *cp1 != '['; cp1--) ; + if (*cp1 == '.') *cp1 = ']'; + else { + memmove(cp1+8,cp1+1,retspec+dirlen-cp1); + memcpy(cp1+1,"000000]",7); + } + } + } + else { /* This is a top-level dir. Add the MFD to the path. */ + if (buf) retspec = buf; + else if (ts) New(7012,retspec,retlen+16,char); + else retspec = __fileify_retbuf; + cp1 = esa; + cp2 = retspec; + while (*cp1 != ':') *(cp2++) = *(cp1++); + strcpy(cp2,":[000000]"); + cp1 += 2; + strcpy(cp2+9,cp1); + } + } + /* We've set up the string up through the filename. Add the + type and version, and we're done. */ + strcat(retspec,".DIR;1"); + + /* $PARSE may have upcased filespec, so convert output to lower + * case if input contained any lowercase characters. */ + if (haslower) __mystrtolower(retspec); + return retspec; + } +} /* end of do_fileify_dirspec() */ +/*}}}*/ +/* External entry points */ +char *fileify_dirspec(char *dir, char *buf) +{ return do_fileify_dirspec(dir,buf,0); } +char *fileify_dirspec_ts(char *dir, char *buf) +{ return do_fileify_dirspec(dir,buf,1); } + +/*{{{ char *pathify_dirspec[_ts](char *path, char *buf)*/ +static char *do_pathify_dirspec(char *dir,char *buf, int ts) +{ + static char __pathify_retbuf[NAM$C_MAXRSS+1]; + unsigned long int retlen; + char *retpath, *cp1, *cp2, trndir[NAM$C_MAXRSS+1]; + + if (!dir || !*dir) { + set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL; + } + + if (*dir) strcpy(trndir,dir); + else getcwd(trndir,sizeof trndir - 1); + + while (!strpbrk(trndir,"/]:>") && my_trnlnm(trndir,trndir,0)) { + STRLEN trnlen = strlen(trndir); + + /* Trap simple rooted lnms, and return lnm:[000000] */ + if (!strcmp(trndir+trnlen-2,".]")) { + if (buf) retpath = buf; + else if (ts) New(7018,retpath,strlen(dir)+10,char); + else retpath = __pathify_retbuf; + strcpy(retpath,dir); + strcat(retpath,":[000000]"); + return retpath; + } + } + dir = trndir; + + if (!strpbrk(dir,"]:>")) { /* Unix-style path or plain dir name */ + if (*dir == '.' && (*(dir+1) == '\0' || + (*(dir+1) == '.' && *(dir+2) == '\0'))) + retlen = 2 + (*(dir+1) != '\0'); + else { + if (!(cp1 = strrchr(dir,'/'))) cp1 = dir; + if ((cp2 = strchr(cp1,'.')) && (*(cp2+1) != '.' && *(cp2+1) != '\0')) { + if (toupper(*(cp2+1)) == 'D' && /* They specified .dir. */ + toupper(*(cp2+2)) == 'I' && /* Trim it off. */ + toupper(*(cp2+3)) == 'R') { + retlen = cp2 - dir + 1; + } + else { /* Some other file type. Bzzt. */ + set_errno(ENOTDIR); + set_vaxc_errno(RMS$_DIR); + return NULL; + } + } + else { /* No file type present. Treat the filename as a directory. */ + retlen = strlen(dir) + 1; + } + } + if (buf) retpath = buf; + 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 */ + retpath[retlen-1] = '/'; /* with '/', add it. */ + retpath[retlen] = '\0'; + } + else retpath[retlen-1] = '\0'; + } + else { /* VMS-style directory spec */ + char esa[NAM$C_MAXRSS+1], *cp; + unsigned long int sts, cmplen, haslower; + struct FAB dirfab = cc$rms_fab; + struct NAM savnam, dirnam = cc$rms_nam; + + dirfab.fab$b_fns = strlen(dir); + dirfab.fab$l_fna = dir; + if (dir[dirfab.fab$b_fns-1] == ']' || + 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)+1,char); + else retpath = __pathify_retbuf; + strcpy(retpath,dir); + return retpath; + } + dirfab.fab$l_dna = ".DIR;1"; + dirfab.fab$b_dns = 6; + dirfab.fab$l_nam = &dirnam; + dirnam.nam$b_ess = (unsigned char) sizeof esa - 1; + dirnam.nam$l_esa = esa; + + for (cp = dir; *cp; cp++) + if (islower(*cp)) { haslower = 1; break; } + + 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; + } + } + 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; + if (strncmp(dirnam.nam$l_type,".DIR;1",cmplen)) { + /* Something other than .DIR[;1]. Bzzt. */ + set_errno(ENOTDIR); + set_vaxc_errno(RMS$_DIR); + return NULL; + } + } + /* OK, the type was fine. Now pull any file name into the + directory path. */ + if ((cp1 = strrchr(esa,']'))) *dirnam.nam$l_type = ']'; + else { + cp1 = strrchr(esa,'>'); + *dirnam.nam$l_type = '>'; + } + *cp1 = '.'; + *(dirnam.nam$l_type + 1) = '\0'; + retlen = dirnam.nam$l_type - esa + 2; + if (buf) retpath = buf; + else if (ts) New(7014,retpath,retlen,char); + else retpath = __pathify_retbuf; + strcpy(retpath,esa); + /* $PARSE may have upcased filespec, so convert output to lower + * case if input contained any lowercase characters. */ + if (haslower) __mystrtolower(retpath); + } + + return retpath; +} /* end of do_pathify_dirspec() */ +/*}}}*/ +/* External entry points */ +char *pathify_dirspec(char *dir, char *buf) +{ return do_pathify_dirspec(dir,buf,0); } +char *pathify_dirspec_ts(char *dir, char *buf) +{ return do_pathify_dirspec(dir,buf,1); } + +/*{{{ char *tounixspec[_ts](char *path, char *buf)*/ +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, 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) { + retlen = strlen(spec); + cp1 = strchr(spec,'['); + if (!cp1) cp1 = strchr(spec,'<'); + if (cp1) { + for (cp1++; *cp1 == '-'; cp1++) dashes++; /* VMS '-' ==> Unix '../' */ + } + New(7015,rslt,retlen+2+2*dashes,char); + } + else rslt = __tounixspec_retbuf; + if (strchr(spec,'/') != NULL) { + strcpy(rslt,spec); + return rslt; + } + + cp1 = rslt; + cp2 = spec; + dirend = strrchr(spec,']'); + if (dirend == NULL) dirend = strrchr(spec,'>'); + if (dirend == NULL) dirend = strchr(spec,':'); + if (dirend == NULL) { + strcpy(rslt,spec); + return rslt; + } + if (*cp2 != '[' && *cp2 != '<') { + *(cp1++) = '/'; + } + else { /* the VMS spec begins with directories */ + cp2++; + if (*cp2 == ']' || *cp2 == '>') { + strcpy(rslt,"./"); + return rslt; + } + else if ( *cp2 != '.' && *cp2 != '-') { + *(cp1++) = '/'; /* add the implied device into the Unix spec */ + if (getcwd(tmp,sizeof tmp,1) == NULL) { + if (ts) Safefree(rslt); + return NULL; + } + do { + cp3 = tmp; + while (*cp3 != ':' && *cp3) cp3++; + *(cp3++) = '\0'; + if (strchr(cp3,']') != NULL) break; + } while (((cp3 = my_getenv(tmp)) != NULL) && strcpy(tmp,cp3)); + cp3 = tmp; + while (*cp3) *(cp1++) = *(cp3++); + *(cp1++) = '/'; + 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 if (*cp2 == '.') cp2++; + } + for (; cp2 <= dirend; cp2++) { + if (*cp2 == ':') { + *(cp1++) = '/'; + if (*(cp2+1) == '[') cp2++; + } + else if (*cp2 == ']' || *cp2 == '>') *(cp1++) = '/'; + else if (*cp2 == '.') { + *(cp1++) = '/'; + 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) == '.') { + while (*cp2 == '-') { + cp2++; + *(cp1++) = '.'; *(cp1++) = '.'; *(cp1++) = '/'; + } + if (*cp2 != '.' && *cp2 != ']' && *cp2 != '>') { /* we don't allow */ + if (ts) Safefree(rslt); /* filespecs like */ + set_errno(EINVAL); set_vaxc_errno(RMS$_SYN); /* [fred.--foo.bar] */ + return NULL; + } + } + else *(cp1++) = *cp2; + } + else *(cp1++) = *cp2; + } + while (*cp2) *(cp1++) = *(cp2++); + *cp1 = '\0'; + + return rslt; + +} /* end of do_tounixspec() */ +/*}}}*/ +/* External entry points */ +char *tounixspec(char *spec, char *buf) { return do_tounixspec(spec,buf,0); } +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]; + 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)+9,char); + else rslt = __tovmsspec_retbuf; + if (strpbrk(path,"]:>") || + (dirend = strrchr(path,'/')) == NULL) { + if (path[0] == '.') { + if (path[1] == '\0') strcpy(rslt,"[]"); + else if (path[1] == '.' && path[2] == '\0') strcpy(rslt,"[-]"); + else strcpy(rslt,path); /* probably garbage */ + } + else strcpy(rslt,path); + return rslt; + } + if (*(dirend+1) == '.') { /* do we have trailing "/." or "/.."? */ + if (!*(dirend+2)) dirend +=2; + if (*(dirend+2) == '.' && !*(dirend+3)) dirend += 3; + } + cp1 = rslt; + cp2 = path; + if (*cp2 == '/') { + char trndev[NAM$C_MAXRSS+1]; + int islnm, rooted; + STRLEN trnend; + + while (*(++cp2) == '/') ; /* Skip multiple /s */ + while (*(++cp2) != '/' && *cp2) *(cp1++) = *cp2; + *cp1 = '\0'; + islnm = my_trnlnm(rslt,trndev,0); + 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++) = '['; + if (*cp2 == '.') { + if (*(cp2+1) == '/' || *(cp2+1) == '\0') { + cp2 += 2; /* skip over "./" - it's redundant */ + *(cp1++) = '.'; /* but it does indicate a relative dirspec */ + } + else if (*(cp2+1) == '.' && (*(cp2+2) == '/' || *(cp2+2) == '\0')) { + *(cp1++) = '-'; /* "../" --> "-" */ + cp2 += 3; + } + if (cp2 > dirend) cp2 = dirend; + } + else *(cp1++) = '.'; + } + for (; cp2 < dirend; cp2++) { + if (*cp2 == '/') { + if (*(cp2-1) == '/') continue; + if (*(cp1-1) != '.') *(cp1++) = '.'; + infront = 0; + } + else if (!infront && *cp2 == '.') { + if (cp2+1 == dirend || *(cp2+1) == '\0') { cp2++; break; } + else if (*(cp2+1) == '/') cp2++; /* skip over "./" - it's redundant */ + else if (*(cp2+1) == '.' && (*(cp2+2) == '/' || *(cp2+2) == '\0')) { + if (*(cp1-1) == '-' || *(cp1-1) == '[') *(cp1++) = '-'; /* handle "../" */ + else if (*(cp1-2) == '[') *(cp1-1) = '-'; + else { /* back up over previous directory name */ + cp1--; + while (*(cp1-1) != '.' && *(cp1-1) != '[') cp1--; + if (*(cp1-1) == '[') { + memcpy(cp1,"000000.",7); + cp1 += 7; + } + } + cp2 += 2; + if (cp2 == dirend) break; + } + else *(cp1++) = '_'; /* fix up syntax - '.' in name not allowed */ + } + else { + if (!infront && *(cp1-1) == '-') *(cp1++) = '.'; + if (*cp2 == '.') *(cp1++) = '_'; + else *(cp1++) = *cp2; + infront = 1; + } + } + if (*(cp1-1) == '.') cp1--; /* Unix spec ending in '/' ==> trailing '.' */ + if (hasdir) *(cp1++) = ']'; + if (*cp2) cp2++; /* check in case we ended with trailing '..' */ + while (*cp2) *(cp1++) = *(cp2++); + *cp1 = '\0'; + + return rslt; + +} /* end of do_tovmsspec() */ +/*}}}*/ +/* External entry points */ +char *tovmsspec(char *path, char *buf) { return do_tovmsspec(path,buf,0); } +char *tovmsspec_ts(char *path, char *buf) { return do_tovmsspec(path,buf,1); } + +/*{{{ char *tovmspath[_ts](char *path, char *buf)*/ +static char *do_tovmspath(char *path, char *buf, int ts) { + static char __tovmspath_retbuf[NAM$C_MAXRSS+1]; + int vmslen; + char pathified[NAM$C_MAXRSS+1], vmsified[NAM$C_MAXRSS+1], *cp; + + if (path == NULL) return NULL; + if (do_pathify_dirspec(path,pathified,0) == NULL) return NULL; + if (do_tovmsspec(pathified,buf ? buf : vmsified,0) == NULL) return NULL; + if (buf) return buf; + else if (ts) { + vmslen = strlen(vmsified); + New(7017,cp,vmslen+1,char); + memcpy(cp,vmsified,vmslen); + cp[vmslen] = '\0'; + return cp; + } + else { + strcpy(__tovmspath_retbuf,vmsified); + return __tovmspath_retbuf; + } + +} /* end of do_tovmspath() */ +/*}}}*/ +/* External entry points */ +char *tovmspath(char *path, char *buf) { return do_tovmspath(path,buf,0); } +char *tovmspath_ts(char *path, char *buf) { return do_tovmspath(path,buf,1); } + + +/*{{{ char *tounixpath[_ts](char *path, char *buf)*/ +static char *do_tounixpath(char *path, char *buf, int ts) { + static char __tounixpath_retbuf[NAM$C_MAXRSS+1]; + int unixlen; + char pathified[NAM$C_MAXRSS+1], unixified[NAM$C_MAXRSS+1], *cp; + + if (path == NULL) return NULL; + if (do_pathify_dirspec(path,pathified,0) == NULL) return NULL; + if (do_tounixspec(pathified,buf ? buf : unixified,0) == NULL) return NULL; + if (buf) return buf; + else if (ts) { + unixlen = strlen(unixified); + New(7017,cp,unixlen+1,char); + memcpy(cp,unixified,unixlen); + cp[unixlen] = '\0'; + return cp; + } + else { + strcpy(__tounixpath_retbuf,unixified); + return __tounixpath_retbuf; + } + +} /* end of do_tounixpath() */ +/*}}}*/ +/* External entry points */ +char *tounixpath(char *path, char *buf) { return do_tounixpath(path,buf,0); } +char *tounixpath_ts(char *path, char *buf) { return do_tounixpath(path,buf,1); } + +/* + * @(#)argproc.c 2.2 94/08/16 Mark Pizzolato (mark@infocomm.com) + * + ***************************************************************************** + * * + * Copyright (C) 1989-1994 by * + * Mark Pizzolato - INFO COMM, Danville, California (510) 837-5600 * + * * + * Permission is hereby granted for the reproduction of this software, * + * on condition that this copyright notice is included in the reproduction, * + * and that such reproduction is not for purposes of profit or material * + * gain. * + * * + * 27-Aug-1994 Modified for inclusion in perl5 * + * by Charles Bailey bailey@genetics.upenn.edu * + ***************************************************************************** + */ + +/* + * getredirection() is intended to aid in porting C programs + * to VMS (Vax-11 C). The native VMS environment does not support + * '>' and '<' I/O redirection, or command line wild card expansion, + * or a command line pipe mechanism using the '|' AND background + * command execution '&'. All of these capabilities are provided to any + * C program which calls this procedure as the first thing in the + * main program. + * The piping mechanism will probably work with almost any 'filter' type + * of program. With suitable modification, it may useful for other + * portability problems as well. + * + * Author: Mark Pizzolato mark@infocomm.com + */ +struct list_item + { + struct list_item *next; + char *value; + }; + +static void add_item(struct list_item **head, + struct list_item **tail, + char *value, + int *count); + +static void expand_wild_cards(char *item, + struct list_item **head, + struct list_item **tail, + int *count); + +static int background_process(int argc, char **argv); + +static void pipe_and_fork(char **cmargv); + +/*{{{ void getredirection(int *ac, char ***av)*/ +void +getredirection(int *ac, char ***av) +/* + * Process vms redirection arg's. Exit if any error is seen. + * If getredirection() processes an argument, it is erased + * from the vector. getredirection() returns a new argc and argv value. + * In the event that a background command is requested (by a trailing "&"), + * this routine creates a background subprocess, and simply exits the program. + * + * Warning: do not try to simplify the code for vms. The code + * presupposes that getredirection() is called before any data is + * read from stdin or written to stdout. + * + * Normal usage is as follows: + * + * main(argc, argv) + * int argc; + * char *argv[]; + * { + * getredirection(&argc, &argv); + * } + */ +{ + int argc = *ac; /* Argument Count */ + char **argv = *av; /* Argument Vector */ + char *ap; /* Argument pointer */ + int j; /* argv[] index */ + int item_count = 0; /* Count of Items in List */ + struct list_item *list_head = 0; /* First Item in List */ + struct list_item *list_tail; /* Last Item in List */ + char *in = NULL; /* Input File Name */ + char *out = NULL; /* Output File Name */ + char *outmode = "w"; /* Mode to Open Output File */ + char *err = NULL; /* Error File Name */ + char *errmode = "w"; /* Mode to Open Error File */ + int cmargc = 0; /* Piped Command Arg Count */ + char **cmargv = NULL;/* Piped Command Arg Vector */ + + /* + * First handle the case where the last thing on the line ends with + * a '&'. This indicates the desire for the command to be run in a + * subprocess, so we satisfy that desire. + */ + ap = argv[argc-1]; + if (0 == strcmp("&", ap)) + exit(background_process(--argc, argv)); + if (*ap && '&' == ap[strlen(ap)-1]) + { + ap[strlen(ap)-1] = '\0'; + exit(background_process(argc, argv)); + } + /* + * Now we handle the general redirection cases that involve '>', '>>', + * '<', and pipes '|'. + */ + for (j = 0; j < argc; ++j) + { + if (0 == strcmp("<", argv[j])) + { + if (j+1 >= argc) + { + fprintf(stderr,"No input file after < on command line"); + exit(LIB$_WRONUMARG); + } + in = argv[++j]; + continue; + } + if ('<' == *(ap = argv[j])) + { + in = 1 + ap; + continue; + } + if (0 == strcmp(">", ap)) + { + if (j+1 >= argc) + { + fprintf(stderr,"No output file after > on command line"); + exit(LIB$_WRONUMARG); + } + out = argv[++j]; + continue; + } + if ('>' == *ap) + { + if ('>' == ap[1]) + { + outmode = "a"; + if ('\0' == ap[2]) + out = argv[++j]; + else + out = 2 + ap; + } + else + out = 1 + ap; + if (j >= argc) + { + fprintf(stderr,"No output file after > or >> on command line"); + exit(LIB$_WRONUMARG); + } + continue; + } + if (('2' == *ap) && ('>' == ap[1])) + { + if ('>' == ap[2]) + { + errmode = "a"; + if ('\0' == ap[3]) + err = argv[++j]; + else + err = 3 + ap; + } + else + if ('\0' == ap[2]) + err = argv[++j]; + else + err = 2 + ap; + if (j >= argc) + { + fprintf(stderr,"No output file after 2> or 2>> on command line"); + exit(LIB$_WRONUMARG); + } + continue; + } + if (0 == strcmp("|", argv[j])) + { + if (j+1 >= argc) + { + fprintf(stderr,"No command into which to pipe on command line"); + exit(LIB$_WRONUMARG); + } + cmargc = argc-(j+1); + cmargv = &argv[j+1]; + argc = j; + continue; + } + if ('|' == *(ap = argv[j])) + { + ++argv[j]; + cmargc = argc-j; + cmargv = &argv[j]; + argc = j; + continue; + } + expand_wild_cards(ap, &list_head, &list_tail, &item_count); + } + /* + * Allocate and fill in the new argument vector, Some Unix's terminate + * the list with an extra null pointer. + */ + New(7002, argv, item_count+1, char *); + *av = argv; + for (j = 0; j < item_count; ++j, list_head = list_head->next) + argv[j] = list_head->value; + *ac = item_count; + if (cmargv != NULL) + { + if (out != NULL) + { + fprintf(stderr,"'|' and '>' may not both be specified on command line"); + exit(LIB$_INVARGORD); + } + pipe_and_fork(cmargv); + } + + /* Check for input from a pipe (mailbox) */ + + if (in == NULL && 1 == isapipe(0)) + { + char mbxname[L_tmpnam]; + long int bufsize; + long int dvi_item = DVI$_DEVBUFSIZ; + $DESCRIPTOR(mbxnam, ""); + $DESCRIPTOR(mbxdevnam, ""); + + /* Input from a pipe, reopen it in binary mode to disable */ + /* carriage control processing. */ + + fgetname(stdin, mbxname,1); + mbxnam.dsc$a_pointer = mbxname; + mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer); + lib$getdvi(&dvi_item, 0, &mbxnam, &bufsize, 0, 0); + mbxdevnam.dsc$a_pointer = mbxname; + mbxdevnam.dsc$w_length = sizeof(mbxname); + dvi_item = DVI$_DEVNAM; + lib$getdvi(&dvi_item, 0, &mbxnam, 0, &mbxdevnam, &mbxdevnam.dsc$w_length); + mbxdevnam.dsc$a_pointer[mbxdevnam.dsc$w_length] = '\0'; + set_errno(0); + set_vaxc_errno(1); + freopen(mbxname, "rb", stdin); + if (errno != 0) + { + fprintf(stderr,"Can't reopen input pipe (name: %s) in binary mode",mbxname); + exit(vaxc$errno); + } + } + if ((in != NULL) && (NULL == freopen(in, "r", stdin, "mbc=32", "mbf=2"))) + { + fprintf(stderr,"Can't open input file %s as stdin",in); + exit(vaxc$errno); + } + if ((out != NULL) && (NULL == freopen(out, outmode, stdout, "mbc=32", "mbf=2"))) + { + fprintf(stderr,"Can't open output file %s as stdout",out); + exit(vaxc$errno); + } + if (err != NULL) { + FILE *tmperr; + if (NULL == (tmperr = fopen(err, errmode, "mbc=32", "mbf=2"))) + { + fprintf(stderr,"Can't open error file %s as stderr",err); + exit(vaxc$errno); + } + fclose(tmperr); + if (NULL == freopen(err, "a", stderr, "mbc=32", "mbf=2")) + { + exit(vaxc$errno); + } + } +#ifdef ARGPROC_DEBUG + fprintf(stderr, "Arglist:\n"); + for (j = 0; j < *ac; ++j) + fprintf(stderr, "argv[%d] = '%s'\n", j, argv[j]); +#endif +} /* end of getredirection() */ +/*}}}*/ + +static void add_item(struct list_item **head, + struct list_item **tail, + char *value, + int *count) +{ + if (*head == 0) + { + New(7003,*head,1,struct list_item); + *tail = *head; + } + else { + New(7004,(*tail)->next,1,struct list_item); + *tail = (*tail)->next; + } + (*tail)->value = value; + ++(*count); +} + +static void expand_wild_cards(char *item, + struct list_item **head, + struct list_item **tail, + int *count) +{ +int expcount = 0; +unsigned long int context = 0; +int isunix = 0; +char *had_version; +char *had_device; +int had_directory; +char *devdir; +char vmsspec[NAM$C_MAXRSS+1]; +$DESCRIPTOR(filespec, ""); +$DESCRIPTOR(defaultspec, "SYS$DISK:[]"); +$DESCRIPTOR(resultspec, ""); +unsigned long int zero = 0, sts; + + if (strcspn(item, "*%") == strlen(item)) + { + add_item(head, tail, item, count); + return; + } + resultspec.dsc$b_dtype = DSC$K_DTYPE_T; + resultspec.dsc$b_class = DSC$K_CLASS_D; + resultspec.dsc$a_pointer = NULL; + if ((isunix = (int) strchr(item,'/')) != (int) NULL) + filespec.dsc$a_pointer = do_tovmsspec(item,vmsspec,0); + if (!isunix || !filespec.dsc$a_pointer) + filespec.dsc$a_pointer = item; + filespec.dsc$w_length = strlen(filespec.dsc$a_pointer); + /* + * Only return version specs, if the caller specified a version + */ + had_version = strchr(item, ';'); + /* + * Only return device and directory specs, if the caller specifed either. + */ + had_device = strchr(item, ':'); + had_directory = (isunix || NULL != strchr(item, '[')) || (NULL != strchr(item, '<')); + + while (1 == (1 & (sts = lib$find_file(&filespec, &resultspec, &context, + &defaultspec, 0, 0, &zero)))) + { + char *string; + char *c; + + New(7005,string,resultspec.dsc$w_length+1,char); + strncpy(string, resultspec.dsc$a_pointer, resultspec.dsc$w_length); + string[resultspec.dsc$w_length] = '\0'; + if (NULL == had_version) + *((char *)strrchr(string, ';')) = '\0'; + if ((!had_directory) && (had_device == NULL)) + { + if (NULL == (devdir = strrchr(string, ']'))) + devdir = strrchr(string, '>'); + strcpy(string, devdir + 1); + } + /* + * Be consistent with what the C RTL has already done to the rest of + * the argv items and lowercase all of these names. + */ + for (c = string; *c; ++c) + if (isupper(*c)) + *c = tolower(*c); + if (isunix) trim_unixpath(string,item); + add_item(head, tail, string, count); + ++expcount; + } + if (sts != RMS$_NMF) + { + set_vaxc_errno(sts); + switch (sts) + { + case RMS$_FNF: + case RMS$_DIR: + set_errno(ENOENT); break; + case RMS$_DEV: + set_errno(ENODEV); break; + case RMS$_SYN: + set_errno(EINVAL); break; + case RMS$_PRV: + set_errno(EACCES); break; + default: + _ckvmssts(sts); + } + } + if (expcount == 0) + add_item(head, tail, item, count); + _ckvmssts(lib$sfree1_dd(&resultspec)); + _ckvmssts(lib$find_file_end(&context)); +} + +static int child_st[2];/* Event Flag set when child process completes */ + +static unsigned short child_chan;/* I/O Channel for Pipe Mailbox */ + +static unsigned long int exit_handler(int *status) +{ +short iosb[4]; + + if (0 == child_st[0]) + { +#ifdef ARGPROC_DEBUG + fprintf(stderr, "Waiting for Child Process to Finish . . .\n"); +#endif + fflush(stdout); /* Have to flush pipe for binary data to */ + /* terminate properly -- <tp@mccall.com> */ + sys$qiow(0, child_chan, IO$_WRITEOF, iosb, 0, 0, 0, 0, 0, 0, 0, 0); + sys$dassgn(child_chan); + fclose(stdout); + sys$synch(0, child_st); + } + return(1); +} + +static void sig_child(int chan) +{ +#ifdef ARGPROC_DEBUG + fprintf(stderr, "Child Completion AST\n"); +#endif + if (child_st[0] == 0) + child_st[0] = 1; +} + +static struct exit_control_block exit_block = + { + 0, + exit_handler, + 1, + &exit_block.exit_status, + 0 + }; + +static void pipe_and_fork(char **cmargv) +{ + char subcmd[2048]; + $DESCRIPTOR(cmddsc, ""); + static char mbxname[64]; + $DESCRIPTOR(mbxdsc, mbxname); + int pid, j; + unsigned long int zero = 0, one = 1; + + strcpy(subcmd, cmargv[0]); + for (j = 1; NULL != cmargv[j]; ++j) + { + strcat(subcmd, " \""); + strcat(subcmd, cmargv[j]); + strcat(subcmd, "\""); + } + cmddsc.dsc$a_pointer = subcmd; + cmddsc.dsc$w_length = strlen(cmddsc.dsc$a_pointer); + + create_mbx(&child_chan,&mbxdsc); +#ifdef ARGPROC_DEBUG + fprintf(stderr, "Pipe Mailbox Name = '%s'\n", mbxdsc.dsc$a_pointer); + fprintf(stderr, "Sub Process Command = '%s'\n", cmddsc.dsc$a_pointer); +#endif + _ckvmssts(lib$spawn(&cmddsc, &mbxdsc, 0, &one, + 0, &pid, child_st, &zero, sig_child, + &child_chan)); +#ifdef ARGPROC_DEBUG + fprintf(stderr, "Subprocess's Pid = %08X\n", pid); +#endif + sys$dclexh(&exit_block); + if (NULL == freopen(mbxname, "wb", stdout)) + { + fprintf(stderr,"Can't open output pipe (name %s)",mbxname); + } +} + +static int background_process(int argc, char **argv) +{ +char command[2048] = "$"; +$DESCRIPTOR(value, ""); +static $DESCRIPTOR(cmd, "BACKGROUND$COMMAND"); +static $DESCRIPTOR(null, "NLA0:"); +static $DESCRIPTOR(pidsymbol, "SHELL_BACKGROUND_PID"); +char pidstring[80]; +$DESCRIPTOR(pidstr, ""); +int pid; +unsigned long int flags = 17, one = 1, retsts; + + strcat(command, argv[0]); + while (--argc) + { + strcat(command, " \""); + strcat(command, *(++argv)); + strcat(command, "\""); + } + value.dsc$a_pointer = command; + value.dsc$w_length = strlen(value.dsc$a_pointer); + _ckvmssts(lib$set_symbol(&cmd, &value)); + retsts = lib$spawn(&cmd, &null, 0, &flags, 0, &pid); + if (retsts == 0x38250) { /* DCL-W-NOTIFY - We must be BATCH, so retry */ + _ckvmssts(lib$spawn(&cmd, &null, 0, &one, 0, &pid)); + } + else { + _ckvmssts(retsts); + } +#ifdef ARGPROC_DEBUG + fprintf(stderr, "%s\n", command); +#endif + sprintf(pidstring, "%08X", pid); + fprintf(stderr, "%s\n", pidstring); + pidstr.dsc$a_pointer = pidstring; + pidstr.dsc$w_length = strlen(pidstr.dsc$a_pointer); + lib$set_symbol(&pidsymbol, &pidstr); + return(SS$_NORMAL); +} +/*}}}*/ +/***** End of code taken from Mark Pizzolato's argproc.c package *****/ + +/* trim_unixpath() + * Trim Unix-style prefix off filespec, so it looks like what a shell + * glob expansion would return (i.e. from specified prefix on, not + * full path). Note that returned filespec is Unix-style, regardless + * of whether input filespec was VMS-style or Unix-style. + * + * fspec is filespec to be trimmed, and wildspec is wildcard spec used to + * determine prefix (both may be in VMS or Unix syntax). + * + * Returns !=0 on success, with trimmed filespec replacing contents of + * fspec, and 0 on failure, with contents of fpsec unchanged. + */ +/*{{{int trim_unixpath(char *fspec, char *wildspec)*/ +int +trim_unixpath(char *fspec, char *wildspec) +{ + char unixified[NAM$C_MAXRSS+1], unixwild[NAM$C_MAXRSS+1], + *template, *base, *cp1, *cp2; + register int tmplen, reslen = 0; + + if (!wildspec || !fspec) return 0; + if (strpbrk(wildspec,"]>:") != NULL) { + if (do_tounixspec(wildspec,unixwild,0) == NULL) return 0; + else template = unixified; + } + else template = wildspec; + if (strpbrk(fspec,"]>:") != NULL) { + if (do_tounixspec(fspec,unixified,0) == NULL) return 0; + else base = unixified; + /* reslen != 0 ==> we had to unixify resultant filespec, so we must + * check to see that final result fits into (isn't longer than) fspec */ + reslen = strlen(fspec); + } + else base = fspec; + + /* No prefix or absolute path on wildcard, so nothing to remove */ + if (!*template || *template == '/') { + if (base == fspec) return 1; + tmplen = strlen(unixified); + if (tmplen > reslen) return 0; /* not enough space */ + /* Copy unixified resultant, including trailing NUL */ + memmove(fspec,unixified,tmplen+1); + return 1; + } + + /* Find prefix to template consisting of path elements without wildcards */ + if ((cp1 = strpbrk(template,"*%?")) == NULL) + for (cp1 = template; *cp1; cp1++) ; + else while (cp1 > template && *cp1 != '/') cp1--; + for (cp2 = base; *cp2; cp2++) ; /* Find end of resultant filespec */ + + /* Wildcard was in first element, so we don't have a reliable string to + * match against. Guess where to trim resultant filespec by counting + * directory levels in the Unix template. (We could do this instead of + * string matching in all cases, since Unix doesn't have a ... wildcard + * that can expand into multiple levels of subdirectory, but we try for + * the string match so our caller can interpret foo/.../bar.* as + * [.foo...]bar.* if it wants, and only get burned if there was a + * wildcard in the first word (in which case, caveat caller). */ + if (cp1 == template) { + int subdirs = 0; + for ( ; *cp1; cp1++) if (*cp1 == '/') subdirs++; + /* need to back one more '/' than in template, to pick up leading dirname */ + subdirs++; + while (cp2 > base) { + if (*cp2 == '/') subdirs--; + if (!subdirs) break; /* quit without decrement when we hit last '/' */ + cp2--; + } + /* ran out of directories on resultant; allow for already trimmed + * resultant, which hits start of string looking for leading '/' */ + if (subdirs && (cp2 != base || subdirs != 1)) return 0; + /* Move past leading '/', if there is one */ + base = cp2 + (*cp2 == '/' ? 1 : 0); + tmplen = strlen(base); + if (reslen && tmplen > reslen) return 0; /* not enough space */ + memmove(fspec,base,tmplen+1); /* copy result to fspec, with trailing NUL */ + return 1; + } + /* We have a prefix string of complete directory names, so we + * try to find it on the resultant filespec */ + else { + tmplen = cp1 - template; + if (!memcmp(base,template,tmplen)) { /* Nothing before prefix; we're done */ + if (reslen) { /* we converted to Unix syntax; copy result over */ + tmplen = cp2 - base; + if (tmplen > reslen) return 0; /* not enough space */ + memmove(fspec,base,tmplen+1); /* Copy trimmed spec + trailing NUL */ + } + return 1; + } + for ( ; cp2 - base > tmplen; base++) { + if (*base != '/') continue; + if (!memcmp(base + 1,template,tmplen)) break; + } + + if (cp2 - base == tmplen) return 0; /* Not there - not good */ + base++; /* Move past leading '/' */ + if (reslen && cp2 - base > reslen) return 0; /* not enough space */ + /* Copy down remaining portion of filespec, including trailing NUL */ + memmove(fspec,base,cp2 - base + 1); + return 1; + } + +} /* end of trim_unixpath() */ +/*}}}*/ + + +/* + * VMS readdir() routines. + * Written by Rich $alz, <rsalz@bbn.com> in August, 1990. + * This code has no copyright. + * + * 21-Jul-1994 Charles Bailey bailey@genetics.upenn.edu + * Minor modifications to original routines. + */ + + /* Number of elements in vms_versions array */ +#define VERSIZE(e) (sizeof e->vms_versions / sizeof e->vms_versions[0]) + +/* + * Open a directory, return a handle for later use. + */ +/*{{{ DIR *opendir(char*name) */ +DIR * +opendir(char *name) +{ + DIR *dd; + char dir[NAM$C_MAXRSS+1]; + + /* Get memory for the handle, and the pattern. */ + New(7006,dd,1,DIR); + if (do_tovmspath(name,dir,0) == NULL) { + Safefree((char *)dd); + return(NULL); + } + New(7007,dd->pattern,strlen(dir)+sizeof "*.*" + 1,char); + + /* Fill in the fields; mainly playing with the descriptor. */ + (void)sprintf(dd->pattern, "%s*.*",dir); + dd->context = 0; + dd->count = 0; + dd->vms_wantversions = 0; + dd->pat.dsc$a_pointer = dd->pattern; + dd->pat.dsc$w_length = strlen(dd->pattern); + dd->pat.dsc$b_dtype = DSC$K_DTYPE_T; + dd->pat.dsc$b_class = DSC$K_CLASS_S; + + return dd; +} /* end of opendir() */ +/*}}}*/ + +/* + * Set the flag to indicate we want versions or not. + */ +/*{{{ void vmsreaddirversions(DIR *dd, int flag)*/ +void +vmsreaddirversions(DIR *dd, int flag) +{ + dd->vms_wantversions = flag; +} +/*}}}*/ + +/* + * Free up an opened directory. + */ +/*{{{ void closedir(DIR *dd)*/ +void +closedir(DIR *dd) +{ + (void)lib$find_file_end(&dd->context); + Safefree(dd->pattern); + Safefree((char *)dd); +} +/*}}}*/ + +/* + * Collect all the version numbers for the current file. + */ +static void +collectversions(dd) + DIR *dd; +{ + struct dsc$descriptor_s pat; + struct dsc$descriptor_s res; + struct dirent *e; + char *p, *text, buff[sizeof dd->entry.d_name]; + int i; + unsigned long context, tmpsts; + + /* Convenient shorthand. */ + e = &dd->entry; + + /* Add the version wildcard, ignoring the "*.*" put on before */ + i = strlen(dd->pattern); + New(7008,text,i + e->d_namlen + 3,char); + (void)strcpy(text, dd->pattern); + (void)sprintf(&text[i - 3], "%s;*", e->d_name); + + /* Set up the pattern descriptor. */ + pat.dsc$a_pointer = text; + pat.dsc$w_length = i + e->d_namlen - 1; + pat.dsc$b_dtype = DSC$K_DTYPE_T; + pat.dsc$b_class = DSC$K_CLASS_S; + + /* Set up result descriptor. */ + res.dsc$a_pointer = buff; + res.dsc$w_length = sizeof buff - 2; + res.dsc$b_dtype = DSC$K_DTYPE_T; + res.dsc$b_class = DSC$K_CLASS_S; + + /* Read files, collecting versions. */ + for (context = 0, e->vms_verscount = 0; + e->vms_verscount < VERSIZE(e); + e->vms_verscount++) { + tmpsts = lib$find_file(&pat, &res, &context); + if (tmpsts == RMS$_NMF || context == 0) break; + _ckvmssts(tmpsts); + buff[sizeof buff - 1] = '\0'; + if ((p = strchr(buff, ';'))) + e->vms_versions[e->vms_verscount] = atoi(p + 1); + else + e->vms_versions[e->vms_verscount] = -1; + } + + _ckvmssts(lib$find_file_end(&context)); + Safefree(text); + +} /* end of collectversions() */ + +/* + * Read the next entry from the directory. + */ +/*{{{ struct dirent *readdir(DIR *dd)*/ +struct dirent * +readdir(DIR *dd) +{ + struct dsc$descriptor_s res; + char *p, buff[sizeof dd->entry.d_name]; + unsigned long int tmpsts; + + /* Set up result descriptor, and get next file. */ + res.dsc$a_pointer = buff; + res.dsc$w_length = sizeof buff - 2; + res.dsc$b_dtype = DSC$K_DTYPE_T; + res.dsc$b_class = DSC$K_CLASS_S; + tmpsts = lib$find_file(&dd->pat, &res, &dd->context); + if ( tmpsts == RMS$_NMF || dd->context == 0) return NULL; /* None left. */ + if (!(tmpsts & 1)) { + set_vaxc_errno(tmpsts); + switch (tmpsts) { + case RMS$_PRV: + set_errno(EACCES); break; + case RMS$_DEV: + set_errno(ENODEV); break; + case RMS$_DIR: + case RMS$_FNF: + set_errno(ENOENT); break; + default: + set_errno(EVMSERR); + } + return NULL; + } + dd->count++; + /* Force the buffer to end with a NUL, and downcase name to match C convention. */ + buff[sizeof buff - 1] = '\0'; + for (p = buff; !isspace(*p); p++) *p = _tolower(*p); + *p = '\0'; + + /* Skip any directory component and just copy the name. */ + if ((p = strchr(buff, ']'))) (void)strcpy(dd->entry.d_name, p + 1); + else (void)strcpy(dd->entry.d_name, buff); + + /* Clobber the version. */ + if ((p = strchr(dd->entry.d_name, ';'))) *p = '\0'; + + dd->entry.d_namlen = strlen(dd->entry.d_name); + dd->entry.vms_verscount = 0; + if (dd->vms_wantversions) collectversions(dd); + return &dd->entry; + +} /* end of readdir() */ +/*}}}*/ + +/* + * Return something that can be used in a seekdir later. + */ +/*{{{ long telldir(DIR *dd)*/ +long +telldir(DIR *dd) +{ + return dd->count; +} +/*}}}*/ + +/* + * Return to a spot where we used to be. Brute force. + */ +/*{{{ void seekdir(DIR *dd,long count)*/ +void +seekdir(DIR *dd, long count) +{ + int vms_wantversions; + + /* If we haven't done anything yet... */ + if (dd->count == 0) + return; + + /* Remember some state, and clear it. */ + vms_wantversions = dd->vms_wantversions; + dd->vms_wantversions = 0; + _ckvmssts(lib$find_file_end(&dd->context)); + dd->context = 0; + + /* The increment is in readdir(). */ + for (dd->count = 0; dd->count < count; ) + (void)readdir(dd); + + dd->vms_wantversions = vms_wantversions; + +} /* end of seekdir() */ +/*}}}*/ + +/* VMS subprocess management + * + * my_vfork() - just a vfork(), after setting a flag to record that + * the current script is trying a Unix-style fork/exec. + * + * vms_do_aexec() and vms_do_exec() are called in response to the + * perl 'exec' function. If this follows a vfork call, then they + * call out the the regular perl routines in doio.c which do an + * execvp (for those who really want to try this under VMS). + * Otherwise, they do exactly what the perl docs say exec should + * do - terminate the current script and invoke a new command + * (See below for notes on command syntax.) + * + * do_aspawn() and do_spawn() implement the VMS side of the perl + * 'system' function. + * + * Note on command arguments to perl 'exec' and 'system': When handled + * in 'VMSish fashion' (i.e. not after a call to vfork) The args + * are concatenated to form a DCL command string. If the first arg + * begins with '$' (i.e. the perl script had "\$ Type" or some such), + * the the command string is hrnded off to DCL directly. Otherwise, + * the first token of the command is taken as the filespec of an image + * to run. The filespec is expanded using a default type of '.EXE' and + * the process defaults for device, directory, etc., and the resultant + * filespec is invoked using the DCL verb 'MCR', and passed the rest of + * the command string as parameters. This is perhaps a bit compicated, + * but I hope it will form a happy medium between what VMS folks expect + * from lib$spawn and what Unix folks expect from exec. + */ + +static int vfork_called; + +/*{{{int my_vfork()*/ +int +my_vfork() +{ + vfork_called++; + return vfork(); +} +/*}}}*/ + + +static struct dsc$descriptor_s VMScmd = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,Nullch}; + +static void +vms_execfree() { + if (Cmd) { + Safefree(Cmd); + Cmd = Nullch; + } + if (VMScmd.dsc$a_pointer) { + Safefree(VMScmd.dsc$a_pointer); + VMScmd.dsc$w_length = 0; + VMScmd.dsc$a_pointer = Nullch; + } +} + +static char * +setup_argstr(SV *really, SV **mark, SV **sp) +{ + char *junk, *tmps = Nullch; + register size_t cmdlen = 0; + size_t rlen; + register SV **idx; + + idx = mark; + if (really) { + tmps = SvPV(really,rlen); + if (*tmps) { + cmdlen += rlen + 1; + idx++; + } + } + + for (idx++; idx <= sp; idx++) { + if (*idx) { + junk = SvPVx(*idx,rlen); + cmdlen += rlen ? rlen + 1 : 0; + } + } + New(401,Cmd,cmdlen+1,char); + + if (tmps && *tmps) { + strcpy(Cmd,tmps); + mark++; + } + else *Cmd = '\0'; + while (++mark <= sp) { + if (*mark) { + strcat(Cmd," "); + strcat(Cmd,SvPVx(*mark,na)); + } + } + return Cmd; + +} /* end of setup_argstr() */ + + +static unsigned long int +setup_cmddsc(char *cmd, int check_img) +{ + char resspec[NAM$C_MAXRSS+1]; + $DESCRIPTOR(defdsc,".EXE"); + $DESCRIPTOR(resdsc,resspec); + struct dsc$descriptor_s imgdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; + unsigned long int cxt = 0, flags = 1, retsts; + register char *s, *rest, *cp; + register int isdcl = 0; + + s = cmd; + while (*s && isspace(*s)) s++; + if (check_img) { + if (*s == '$') { /* Check whether this is a DCL command: leading $ and */ + isdcl = 1; /* no dev/dir separators (i.e. not a foreign command) */ + for (cp = s; *cp && *cp != '/' && !isspace(*cp); cp++) { + if (*cp == ':' || *cp == '[' || *cp == '<') { + isdcl = 0; + break; + } + } + } + } + else isdcl = 1; + if (isdcl) { /* It's a DCL command, just do it. */ + VMScmd.dsc$w_length = strlen(cmd); + 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; + while (*s && !isspace(*s)) s++; + rest = *s ? s : 0; + imgdsc.dsc$a_pointer = cmd; + imgdsc.dsc$w_length = s - cmd; + retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,0,&flags); + if (!(retsts & 1)) { + /* just hand off status values likely to be due to user error */ + if (retsts == RMS$_FNF || retsts == RMS$_DNF || + retsts == RMS$_DEV || retsts == RMS$_DIR || retsts == RMS$_SYN || + (retsts & STS$M_CODE) == (SHR$_NOWILD & STS$M_CODE)) return retsts; + else { _ckvmssts(retsts); } + } + else { + _ckvmssts(lib$find_file_end(&cxt)); + s = resspec; + while (*s && !isspace(*s)) s++; + *s = '\0'; + 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); + VMScmd.dsc$w_length = strlen(VMScmd.dsc$a_pointer); + } + } + + return (VMScmd.dsc$w_length > 255 ? CLI$_BUFOVF : SS$_NORMAL); + +} /* end of setup_cmddsc() */ + + +/* {{{ bool vms_do_aexec(SV *really,SV **mark,SV **sp) */ +bool +vms_do_aexec(SV *really,SV **mark,SV **sp) +{ + if (sp > mark) { + if (vfork_called) { /* this follows a vfork - act Unixish */ + vfork_called--; + if (vfork_called < 0) { + warn("Internal inconsistency in tracking vforks"); + vfork_called = 0; + } + else return do_aexec(really,mark,sp); + } + /* no vfork - act VMSish */ + return vms_do_exec(setup_argstr(really,mark,sp)); + + } + + return FALSE; +} /* end of vms_do_aexec() */ +/*}}}*/ + +/* {{{bool vms_do_exec(char *cmd) */ +bool +vms_do_exec(char *cmd) +{ + + if (vfork_called) { /* this follows a vfork - act Unixish */ + vfork_called--; + if (vfork_called < 0) { + warn("Internal inconsistency in tracking vforks"); + vfork_called = 0; + } + else return do_exec(cmd); + } + + { /* no vfork - act VMSish */ + unsigned long int retsts; + + if ((retsts = setup_cmddsc(cmd,1)) & 1) + retsts = lib$do_command(&VMScmd); + + set_errno(EVMSERR); + set_vaxc_errno(retsts); + if (dowarn) + warn("Can't exec \"%s\": %s", VMScmd.dsc$a_pointer, Strerror(errno)); + vms_execfree(); + } + + return FALSE; + +} /* end of vms_do_exec() */ +/*}}}*/ + +unsigned long int do_spawn(char *); + +/* {{{ unsigned long int do_aspawn(SV *really,SV **mark,SV **sp) */ +unsigned long int +do_aspawn(SV *really,SV **mark,SV **sp) +{ + if (sp > mark) return do_spawn(setup_argstr(really,mark,sp)); + + return SS$_ABORT; +} /* end of do_aspawn() */ +/*}}}*/ + +/* {{{unsigned long int do_spawn(char *cmd) */ +unsigned long int +do_spawn(char *cmd) +{ + unsigned long int substs, hadcmd = 1; + + if (!cmd || !*cmd) { + hadcmd = 0; + _ckvmssts(lib$spawn(0,0,0,0,0,0,&substs,0,0,0,0,0,0)); + } + else if ((substs = setup_cmddsc(cmd,0)) & 1) { + _ckvmssts(lib$spawn(&VMScmd,0,0,0,0,0,&substs,0,0,0,0,0,0)); + } + + if (!(substs&1)) { + set_errno(EVMSERR); + set_vaxc_errno(substs); + if (dowarn) + warn("Can't spawn \"%s\": %s", + hadcmd ? VMScmd.dsc$a_pointer : "", Strerror(errno)); + } + vms_execfree(); + return substs; + +} /* end of do_spawn() */ +/*}}}*/ + +/* + * A simple fwrite replacement which outputs itmsz*nitm chars without + * introducing record boundaries every itmsz chars. + */ +/*{{{ int my_fwrite(void *src, size_t itmsz, size_t nitm, FILE *dest)*/ +int +my_fwrite(void *src, size_t itmsz, size_t nitm, FILE *dest) +{ + register char *cp, *end; + + end = (char *)src + itmsz * nitm; + + while ((char *)src <= end) { + for (cp = src; cp <= end; cp++) if (!*cp) break; + if (fputs(src,dest) == EOF) return EOF; + if (cp < end) + if (fputc('\0',dest) == EOF) return EOF; + src = cp + 1; + } + + return 1; + +} /* end of my_fwrite() */ +/*}}}*/ + +/* + * Here are replacements for the following Unix routines in the VMS environment: + * getpwuid Get information for a particular UIC or UID + * getpwnam Get information for a named user + * getpwent Get information for each user in the rights database + * setpwent Reset search to the start of the rights database + * endpwent Finish searching for users in the rights database + * + * getpwuid, getpwnam, and getpwent return a pointer to the passwd structure + * (defined in pwd.h), which contains the following fields:- + * struct passwd { + * char *pw_name; Username (in lower case) + * char *pw_passwd; Hashed password + * unsigned int pw_uid; UIC + * unsigned int pw_gid; UIC group number + * char *pw_unixdir; Default device/directory (VMS-style) + * char *pw_gecos; Owner name + * char *pw_dir; Default device/directory (Unix-style) + * char *pw_shell; Default CLI name (eg. DCL) + * }; + * If the specified user does not exist, getpwuid and getpwnam return NULL. + * + * pw_uid is the full UIC (eg. what's returned by stat() in st_uid). + * not the UIC member number (eg. what's returned by getuid()), + * getpwuid() can accept either as input (if uid is specified, the caller's + * UIC group is used), though it won't recognise gid=0. + * + * Note that in VMS it is necessary to have GRPPRV or SYSPRV to return + * information about other users in your group or in other groups, respectively. + * If the required privilege is not available, then these routines fill only + * the pw_name, pw_uid, and pw_gid fields (the others point to an empty + * string). + * + * By Tim Adye (T.J.Adye@rl.ac.uk), 10th February 1995. + */ + +/* sizes of various UAF record fields */ +#define UAI$S_USERNAME 12 +#define UAI$S_IDENT 31 +#define UAI$S_OWNER 31 +#define UAI$S_DEFDEV 31 +#define UAI$S_DEFDIR 63 +#define UAI$S_DEFCLI 31 +#define UAI$S_PWD 8 + +#define valid_uic(uic) ((uic).uic$v_format == UIC$K_UIC_FORMAT && \ + (uic).uic$v_member != UIC$K_WILD_MEMBER && \ + (uic).uic$v_group != UIC$K_WILD_GROUP) + +static char __empty[]= ""; +static struct passwd __passwd_empty= + {(char *) __empty, (char *) __empty, 0, 0, + (char *) __empty, (char *) __empty, (char *) __empty, (char *) __empty}; +static int contxt= 0; +static struct passwd __pwdcache; +static char __pw_namecache[UAI$S_IDENT+1]; + +/* + * This routine does most of the work extracting the user information. + */ +static int fillpasswd (const char *name, struct passwd *pwd) +{ + static struct { + unsigned char length; + char pw_gecos[UAI$S_OWNER+1]; + } owner; + static union uicdef uic; + static struct { + unsigned char length; + char pw_dir[UAI$S_DEFDEV+UAI$S_DEFDIR+1]; + } defdev; + static struct { + unsigned char length; + char unixdir[UAI$_DEFDEV+UAI$S_DEFDIR+1]; + } defdir; + static struct { + unsigned char length; + char pw_shell[UAI$S_DEFCLI+1]; + } defcli; + static char pw_passwd[UAI$S_PWD+1]; + + static unsigned short lowner, luic, ldefdev, ldefdir, ldefcli, lpwd; + struct dsc$descriptor_s name_desc; + unsigned long int sts; + + static struct itmlst_3 itmlst[]= { + {UAI$S_OWNER+1, UAI$_OWNER, &owner, &lowner}, + {sizeof(uic), UAI$_UIC, &uic, &luic}, + {UAI$S_DEFDEV+1, UAI$_DEFDEV, &defdev, &ldefdev}, + {UAI$S_DEFDIR+1, UAI$_DEFDIR, &defdir, &ldefdir}, + {UAI$S_DEFCLI+1, UAI$_DEFCLI, &defcli, &ldefcli}, + {UAI$S_PWD, UAI$_PWD, pw_passwd, &lpwd}, + {0, 0, NULL, NULL}}; + + name_desc.dsc$w_length= strlen(name); + name_desc.dsc$b_dtype= DSC$K_DTYPE_T; + name_desc.dsc$b_class= DSC$K_CLASS_S; + name_desc.dsc$a_pointer= (char *) name; + +/* Note that sys$getuai returns many fields as counted strings. */ + sts= sys$getuai(0, 0, &name_desc, &itmlst, 0, 0, 0); + if (sts == SS$_NOSYSPRV || sts == SS$_NOGRPPRV || sts == RMS$_RNF) { + set_vaxc_errno(sts); set_errno(sts == RMS$_RNF ? EINVAL : EACCES); + } + else { _ckvmssts(sts); } + if (!(sts & 1)) return 0; /* out here in case _ckvmssts() doesn't abort */ + + if ((int) owner.length < lowner) lowner= (int) owner.length; + if ((int) defdev.length < ldefdev) ldefdev= (int) defdev.length; + if ((int) defdir.length < ldefdir) ldefdir= (int) defdir.length; + if ((int) defcli.length < ldefcli) ldefcli= (int) defcli.length; + memcpy(&defdev.pw_dir[ldefdev], &defdir.unixdir[0], ldefdir); + owner.pw_gecos[lowner]= '\0'; + defdev.pw_dir[ldefdev+ldefdir]= '\0'; + defcli.pw_shell[ldefcli]= '\0'; + if (valid_uic(uic)) { + pwd->pw_uid= uic.uic$l_uic; + pwd->pw_gid= uic.uic$v_group; + } + else + warn("getpwnam returned invalid UIC %#o for user \"%s\""); + pwd->pw_passwd= pw_passwd; + pwd->pw_gecos= owner.pw_gecos; + pwd->pw_dir= defdev.pw_dir; + pwd->pw_unixdir= do_tounixpath(defdev.pw_dir, defdir.unixdir,1); + pwd->pw_shell= defcli.pw_shell; + if (pwd->pw_unixdir && pwd->pw_unixdir[0]) { + int ldir; + ldir= strlen(pwd->pw_unixdir) - 1; + if (pwd->pw_unixdir[ldir]=='/') pwd->pw_unixdir[ldir]= '\0'; + } + else + strcpy(pwd->pw_unixdir, pwd->pw_dir); + __mystrtolower(pwd->pw_unixdir); + return 1; +} + +/* + * Get information for a named user. +*/ +/*{{{struct passwd *getpwnam(char *name)*/ +struct passwd *my_getpwnam(char *name) +{ + struct dsc$descriptor_s name_desc; + union uicdef uic; + unsigned long int status, stat; + + __pwdcache = __passwd_empty; + if (!fillpasswd(name, &__pwdcache)) { + /* We still may be able to determine pw_uid and pw_gid */ + name_desc.dsc$w_length= strlen(name); + name_desc.dsc$b_dtype= DSC$K_DTYPE_T; + name_desc.dsc$b_class= DSC$K_CLASS_S; + name_desc.dsc$a_pointer= (char *) name; + if ((stat = sys$asctoid(&name_desc, &uic, 0)) == SS$_NORMAL) { + __pwdcache.pw_uid= uic.uic$l_uic; + __pwdcache.pw_gid= uic.uic$v_group; + } + else { + if (stat == SS$_NOSUCHID || stat == SS$_IVIDENT || stat == RMS$_PRV) { + set_vaxc_errno(stat); + set_errno(stat == RMS$_PRV ? EACCES : EINVAL); + return NULL; + } + else { _ckvmssts(stat); } + } + } + strncpy(__pw_namecache, name, sizeof(__pw_namecache)); + __pw_namecache[sizeof __pw_namecache - 1] = '\0'; + __pwdcache.pw_name= __pw_namecache; + return &__pwdcache; +} /* end of my_getpwnam() */ +/*}}}*/ + +/* + * Get information for a particular UIC or UID. + * Called by my_getpwent with uid=-1 to list all users. +*/ +/*{{{struct passwd *my_getpwuid(Uid_t uid)*/ +struct passwd *my_getpwuid(Uid_t uid) +{ + const $DESCRIPTOR(name_desc,__pw_namecache); + unsigned short lname; + union uicdef uic; + unsigned long int status; + + if (uid == (unsigned int) -1) { + do { + status = sys$idtoasc(-1, &lname, &name_desc, &uic, 0, &contxt); + if (status == SS$_NOSUCHID || status == RMS$_PRV) { + set_vaxc_errno(status); + set_errno(status == RMS$_PRV ? EACCES : EINVAL); + my_endpwent(); + return NULL; + } + else { _ckvmssts(status); } + } while (!valid_uic (uic)); + } + else { + uic.uic$l_uic= uid; + if (!uic.uic$v_group) + uic.uic$v_group= getgid(); + if (valid_uic(uic)) + status = sys$idtoasc(uic.uic$l_uic, &lname, &name_desc, 0, 0, 0); + else status = SS$_IVIDENT; + if (status == SS$_IVIDENT || status == SS$_NOSUCHID || + status == RMS$_PRV) { + set_vaxc_errno(status); set_errno(status == RMS$_PRV ? EACCES : EINVAL); + return NULL; + } + else { _ckvmssts(status); } + } + __pw_namecache[lname]= '\0'; + __mystrtolower(__pw_namecache); + + __pwdcache = __passwd_empty; + __pwdcache.pw_name = __pw_namecache; + +/* Fill in the uid and gid in case fillpasswd can't (eg. no privilege). + The identifier's value is usually the UIC, but it doesn't have to be, + so if we can, we let fillpasswd update this. */ + __pwdcache.pw_uid = uic.uic$l_uic; + __pwdcache.pw_gid = uic.uic$v_group; + + fillpasswd(__pw_namecache, &__pwdcache); + return &__pwdcache; + +} /* end of my_getpwuid() */ +/*}}}*/ + +/* + * Get information for next user. +*/ +/*{{{struct passwd *my_getpwent()*/ +struct passwd *my_getpwent() +{ + return (my_getpwuid((unsigned int) -1)); +} +/*}}}*/ + +/* + * Finish searching rights database for users. +*/ +/*{{{void my_endpwent()*/ +void my_endpwent() +{ + if (contxt) { + _ckvmssts(sys$finish_rdb(&contxt)); + contxt= 0; + } +} +/*}}}*/ + + +/* 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 <lane@duphy4.physics.drexel.edu> + */ + +/*{{{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 + * a Unix-style path ending in a directory name (e.g. dir1/dir2/dir3) + */ + +/* encode_dev packs a VMS device name string into an integer to allow + * simple comparisons. This can be used, for example, to check whether two + * files are located on the same device, by comparing their encoded device + * names. Even a string comparison would not do, because stat() reuses the + * device name buffer for each call; so without encode_dev, it would be + * necessary to save the buffer and use strcmp (this would mean a number of + * changes to the standard Perl code, to say nothing of what a Perl script + * would have to do. + * + * The device lock id, if it exists, should be unique (unless perhaps compared + * with lock ids transferred from other nodes). We have a lock id if the disk is + * mounted cluster-wide, which is when we tend to get long (host-qualified) + * device names. Thus we use the lock id in preference, and only if that isn't + * 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 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 + * is to check for the same file). + * + * A better method might be to use sys$device_scan on the first call, and to + * search for the device, returning an index into the cached array. + * The number returned would be more intelligable. + * This is probably not worth it, and anyway would take quite a bit longer + * on the first call. + */ +#define LOCKID_MASK 0x80000000 /* Use 0 to force device name use only */ +static dev_t encode_dev (const char *dev) +{ + int i; + unsigned long int f; + dev_t enc; + char c; + const char *q; + + if (!dev || !dev[0]) return 0; + +#if LOCKID_MASK + { + struct dsc$descriptor_s dev_desc; + unsigned long int status, lockid, item = DVI$_LOCKID; + + /* For cluster-mounted disks, the disk lock identifier is unique, so we + can try that first. */ + dev_desc.dsc$w_length = strlen (dev); + dev_desc.dsc$b_dtype = DSC$K_DTYPE_T; + dev_desc.dsc$b_class = DSC$K_CLASS_S; + dev_desc.dsc$a_pointer = (char *) dev; + _ckvmssts(lib$getdvi(&item, 0, &dev_desc, &lockid, 0, 0)); + if (lockid) return (lockid & ~LOCKID_MASK); + } +#endif + + /* Otherwise we try to encode the device name */ + enc = 0; + f = 1; + i = 0; + for (q = dev + strlen(dev); q--; q >= dev) { + if (isdigit (*q)) + c= (*q) - '0'; + else if (isalpha (toupper (*q))) + c= toupper (*q) - 'A' + (char)10; + else + continue; /* Skip '$'s */ + i++; + if (i>6) break; /* 36^7 is too large to fit in an unsigned long int */ + if (i>1) f *= 36; + enc += f * (unsigned long int) c; + } + return (enc | LOCKID_MASK); /* May have already overflowed into bit 31 */ + +} /* end of encode_dev() */ + +static char namecache[NAM$C_MAXRSS+1]; + +static int +is_null_device(name) + const char *name; +{ + /* The VMS null device is named "_NLA0:", usually abbreviated as "NL:". + The underscore prefix, controller letter, and unit number are + independently optional; for our purposes, the colon punctuation + is not. The colon can be trailed by optional directory and/or + filename, but two consecutive colons indicates a nodename rather + than a device. [pr] */ + if (*name == '_') ++name; + if (tolower(*name++) != 'n') return 0; + if (tolower(*name++) != 'l') return 0; + if (tolower(*name) == 'a') ++name; + if (*name == '0') ++name; + return (*name++ == ':') && (*name != ':'); +} + +/* Do the permissions allow some operation? Assumes statcache already set. */ +/* Do this via $Check_Access on VMS, since the CRTL stat() returns only a + * subset of the applicable information. + */ +/*{{{I32 cando(I32 bit, I32 effective, struct stat *statbufp)*/ +I32 +cando(I32 bit, I32 effective, struct stat *statbufp) +{ + if (statbufp == &statcache) + return cando_by_name(bit,effective,namecache); + else { + char fname[NAM$C_MAXRSS+1]; + unsigned long int retsts; + struct dsc$descriptor_s devdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}, + namdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; + + /* If the struct mystat is stale, we're OOL; stat() overwrites the + device name on successive calls */ + devdsc.dsc$a_pointer = statbufp->st_devnam; + devdsc.dsc$w_length = strlen(statbufp->st_devnam); + namdsc.dsc$a_pointer = fname; + namdsc.dsc$w_length = sizeof fname - 1; + + retsts = lib$fid_to_name(&devdsc,&(statbufp->st_ino),&namdsc, + &namdsc.dsc$w_length,0,0); + if (retsts & 1) { + fname[namdsc.dsc$w_length] = '\0'; + return cando_by_name(bit,effective,fname); + } + else if (retsts == SS$_NOSUCHDEV || retsts == SS$_NOSUCHFILE) { + warn("Can't get filespec - stale stat buffer?\n"); + return FALSE; + } + _ckvmssts(retsts); + return FALSE; /* Should never get to here */ + } +} /* end of cando() */ +/*}}}*/ + + +/*{{{I32 cando_by_name(I32 bit, I32 effective, char *fname)*/ +I32 +cando_by_name(I32 bit, I32 effective, char *fname) +{ + static char usrname[L_cuserid]; + static struct dsc$descriptor_s usrdsc = + {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, usrname}; + char vmsname[NAM$C_MAXRSS+1], fileified[NAM$C_MAXRSS+1]; + unsigned long int objtyp = ACL$C_FILE, access, retsts, privused, iosb[2]; + unsigned short int retlen; + struct dsc$descriptor_s namdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; + union prvdef curprv; + struct itmlst_3 armlst[3] = {{sizeof access, CHP$_ACCESS, &access, &retlen}, + {sizeof privused, CHP$_PRIVUSED, &privused, &retlen},{0,0,0,0}}; + struct itmlst_3 jpilst[2] = {{sizeof curprv, JPI$_CURPRIV, &curprv, &retlen}, + {0,0,0,0}}; + + if (!fname || !*fname) return FALSE; + /* Make sure we expand logical names, since sys$check_access doesn't */ + if (!strpbrk(fname,"/]>:")) { + strcpy(fileified,fname); + while (!strpbrk(fileified,"/]>:>") && my_trnlnm(fileified,fileified,0)) ; + fname = fileified; + } + if (!do_tovmsspec(fname,vmsname,1)) return FALSE; + retlen = namdsc.dsc$w_length = strlen(vmsname); + namdsc.dsc$a_pointer = vmsname; + if (vmsname[retlen-1] == ']' || vmsname[retlen-1] == '>' || + vmsname[retlen-1] == ':') { + if (!do_fileify_dirspec(vmsname,fileified,1)) return FALSE; + namdsc.dsc$w_length = strlen(fileified); + namdsc.dsc$a_pointer = fileified; + } + + if (!usrdsc.dsc$w_length) { + cuserid(usrname); + usrdsc.dsc$w_length = strlen(usrname); + } + + switch (bit) { + case S_IXUSR: + case S_IXGRP: + case S_IXOTH: + access = ARM$M_EXECUTE; + break; + case S_IRUSR: + case S_IRGRP: + case S_IROTH: + access = ARM$M_READ; + break; + case S_IWUSR: + case S_IWGRP: + case S_IWOTH: + access = ARM$M_WRITE; + break; + case S_IDUSR: + case S_IDGRP: + case S_IDOTH: + access = ARM$M_DELETE; + break; + default: + return FALSE; + } + + retsts = sys$check_access(&objtyp,&namdsc,&usrdsc,armlst); +#ifndef SS$_NOSUCHOBJECT /* Older versions of ssdef.h don't have this */ +# define SS$_NOSUCHOBJECT 2696 +#endif + if (retsts == SS$_NOPRIV || retsts == SS$_NOSUCHOBJECT || + retsts == RMS$_FNF || retsts == RMS$_DIR || + retsts == RMS$_DEV) { + set_errno(retsts == SS$_NOPRIV ? EACCES : ENOENT); set_vaxc_errno(retsts); + return FALSE; + } + if (retsts == SS$_NORMAL) { + if (!privused) return TRUE; + /* We can get access, but only by using privs. Do we have the + necessary privs currently enabled? */ + _ckvmssts(sys$getjpiw(0,0,0,jpilst,iosb,0,0)); + if ((privused & CHP$M_BYPASS) && !curprv.prv$v_bypass) return FALSE; + if ((privused & CHP$M_SYSPRV) && !curprv.prv$v_sysprv && + !curprv.prv$v_bypass) return FALSE; + if ((privused & CHP$M_GRPPRV) && !curprv.prv$v_grpprv && + !curprv.prv$v_sysprv && !curprv.prv$v_bypass) return FALSE; + if ((privused & CHP$M_READALL) && !curprv.prv$v_readall) return FALSE; + return TRUE; + } + _ckvmssts(retsts); + + return FALSE; /* Should never get here */ + +} /* end of cando_by_name() */ +/*}}}*/ + + +/*{{{ int flex_fstat(int fd, struct stat *statbuf)*/ +int +flex_fstat(int fd, struct stat *statbuf) +{ + char fspec[NAM$C_MAXRSS+1]; + + if (!getname(fd,fspec,1)) return -1; + return flex_stat(fspec,statbuf); + +} /* end of flex_fstat() */ +/*}}}*/ + +/*{{{ 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 mystat *statbufp) +{ + char fileified[NAM$C_MAXRSS+1]; + int retval,myretval; + struct mystat tmpbuf; + + + if (statbufp == &statcache) do_tovmsspec(fspec,namecache,0); + if (is_null_device(fspec)) { /* Fake a stat() for the null device */ + memset(statbufp,0,sizeof *statbufp); + statbufp->st_dev = encode_dev("_NLA0:"); + statbufp->st_mode = S_IFBLK | S_IREAD | S_IWRITE | S_IEXEC; + statbufp->st_uid = 0x00010001; + statbufp->st_gid = 0x0001; + time((time_t *)&statbufp->st_mtime); + statbufp->st_atime = statbufp->st_ctime = statbufp->st_mtime; + return 0; + } + + if (do_fileify_dirspec(fspec,fileified,0) == NULL) myretval = -1; + else { + myretval = stat(fileified,(stat_t *) &tmpbuf); + } + retval = stat(fspec,(stat_t *) statbufp); + if (!myretval) { + if (retval == -1) { + *statbufp = tmpbuf; + retval = 0; + } + else if (!retval) { /* Dir with same name. Substitute it. */ + statbufp->st_mode &= ~S_IFDIR; + statbufp->st_mode |= tmpbuf.st_mode & S_IFDIR; + strcpy(namecache,fileified); + } + } + if (!retval) statbufp->st_dev = encode_dev(statbufp->st_devnam); + return retval; + +} /* end of flex_stat() */ +/* Reset definition for later calls */ +#define stat mystat +/*}}}*/ + +/*{{{char *my_getlogin()*/ +/* VMS cuserid == Unix getlogin, except calling sequence */ +char * +my_getlogin() +{ + static char user[L_cuserid]; + return cuserid(user); +} +/*}}}*/ + + +/* rmscopy - copy a file using VMS RMS routines + * + * Copies contents and attributes of spec_in to spec_out, except owner + * and protection information. Name and type of spec_in are used as + * defaults for spec_out. The third parameter specifies whether rmscopy() + * should try to propagate timestamps from the input file to the output file. + * If it is less than 0, no timestamps are preserved. If it is 0, then + * rmscopy() will behave similarly to the DCL COPY command: timestamps are + * propagated to the output file at creation iff the output file specification + * did not contain an explicit name or type, and the revision date is always + * updated at the end of the copy operation. If it is greater than 0, then + * it is interpreted as a bitmask, in which bit 0 indicates that timestamps + * other than the revision date should be propagated, and bit 1 indicates + * that the revision date should be propagated. + * + * Returns 1 on success; returns 0 and sets errno and vaxc$errno on failure. + * + * Copyright 1996 by Charles Bailey <bailey@genetics.upenn.edu>. + * Incorporates, with permission, some code from EZCOPY by Tim Adye + * <T.J.Adye@rl.ac.uk>. Permission is given to distribute this code + * as part of the Perl standard distribution under the terms of the + * GNU General Public License or the Perl Artistic License. Copies + * of each may be found in the Perl standard distribution. + */ +/*{{{int rmscopy(char *src, char *dst, int preserve_dates)*/ +int +rmscopy(char *spec_in, char *spec_out, int preserve_dates) +{ + char vmsin[NAM$C_MAXRSS+1], vmsout[NAM$C_MAXRSS+1], esa[NAM$C_MAXRSS], + rsa[NAM$C_MAXRSS], ubf[32256]; + unsigned long int i, sts, sts2; + struct FAB fab_in, fab_out; + struct RAB rab_in, rab_out; + struct NAM nam; + struct XABDAT xabdat; + struct XABFHC xabfhc; + struct XABRDT xabrdt; + struct XABSUM xabsum; + + if (!spec_in || !*spec_in || !do_tovmsspec(spec_in,vmsin,1) || + !spec_out || !*spec_out || !do_tovmsspec(spec_out,vmsout,1)) { + set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG); + return 0; + } + + fab_in = cc$rms_fab; + fab_in.fab$l_fna = vmsin; + fab_in.fab$b_fns = strlen(vmsin); + fab_in.fab$b_shr = FAB$M_SHRPUT | FAB$M_UPI; + fab_in.fab$b_fac = FAB$M_BIO | FAB$M_GET; + fab_in.fab$l_fop = FAB$M_SQO; + fab_in.fab$l_nam = &nam; + fab_in.fab$l_xab = (void *) &xabdat; + + nam = cc$rms_nam; + nam.nam$l_rsa = rsa; + nam.nam$b_rss = sizeof(rsa); + nam.nam$l_esa = esa; + nam.nam$b_ess = sizeof (esa); + nam.nam$b_esl = nam.nam$b_rsl = 0; + + xabdat = cc$rms_xabdat; /* To get creation date */ + xabdat.xab$l_nxt = (void *) &xabfhc; + + xabfhc = cc$rms_xabfhc; /* To get record length */ + xabfhc.xab$l_nxt = (void *) &xabsum; + + xabsum = cc$rms_xabsum; /* To get key and area information */ + + if (!((sts = sys$open(&fab_in)) & 1)) { + set_vaxc_errno(sts); + switch (sts) { + case RMS$_FNF: + case RMS$_DIR: + set_errno(ENOENT); break; + case RMS$_DEV: + set_errno(ENODEV); break; + case RMS$_SYN: + set_errno(EINVAL); break; + case RMS$_PRV: + set_errno(EACCES); break; + default: + set_errno(EVMSERR); + } + return 0; + } + + fab_out = fab_in; + fab_out.fab$w_ifi = 0; + fab_out.fab$b_fac = FAB$M_BIO | FAB$M_PUT; + fab_out.fab$b_shr = FAB$M_SHRGET | FAB$M_UPI; + fab_out.fab$l_fop = FAB$M_SQO; + fab_out.fab$l_fna = vmsout; + fab_out.fab$b_fns = strlen(vmsout); + fab_out.fab$l_dna = nam.nam$l_name; + fab_out.fab$b_dns = nam.nam$l_name ? nam.nam$b_name + nam.nam$b_type : 0; + + if (preserve_dates == 0) { /* Act like DCL COPY */ + nam.nam$b_nop = NAM$M_SYNCHK; + fab_out.fab$l_xab = NULL; /* Don't disturb data from input file */ + if (!((sts = sys$parse(&fab_out)) & 1)) { + set_errno(sts == RMS$_SYN ? EINVAL : EVMSERR); + set_vaxc_errno(sts); + return 0; + } + fab_out.fab$l_xab = (void *) &xabdat; + if (nam.nam$l_fnb & (NAM$M_EXP_NAME | NAM$M_EXP_TYPE)) preserve_dates = 1; + } + fab_out.fab$l_nam = (void *) 0; /* Done with NAM block */ + if (preserve_dates < 0) /* Clear all bits; we'll use it as a */ + preserve_dates =0; /* bitmask from this point forward */ + + if (!(preserve_dates & 1)) fab_out.fab$l_xab = (void *) &xabfhc; + if (!((sts = sys$create(&fab_out)) & 1)) { + set_vaxc_errno(sts); + switch (sts) { + case RMS$_DIR: + set_errno(ENOENT); break; + case RMS$_DEV: + set_errno(ENODEV); break; + case RMS$_SYN: + set_errno(EINVAL); break; + case RMS$_PRV: + set_errno(EACCES); break; + default: + set_errno(EVMSERR); + } + return 0; + } + fab_out.fab$l_fop |= FAB$M_DLT; /* in case we have to bail out */ + if (preserve_dates & 2) { + /* sys$close() will process xabrdt, not xabdat */ + xabrdt = cc$rms_xabrdt; + xabrdt.xab$q_rdt = xabdat.xab$q_rdt; + fab_out.fab$l_xab = (void *) &xabrdt; + } + + rab_in = cc$rms_rab; + rab_in.rab$l_fab = &fab_in; + rab_in.rab$l_rop = RAB$M_BIO; + rab_in.rab$l_ubf = ubf; + rab_in.rab$w_usz = sizeof ubf; + if (!((sts = sys$connect(&rab_in)) & 1)) { + sys$close(&fab_in); sys$close(&fab_out); + set_errno(EVMSERR); set_vaxc_errno(sts); + return 0; + } + + rab_out = cc$rms_rab; + rab_out.rab$l_fab = &fab_out; + rab_out.rab$l_rbf = ubf; + if (!((sts = sys$connect(&rab_out)) & 1)) { + sys$close(&fab_in); sys$close(&fab_out); + set_errno(EVMSERR); set_vaxc_errno(sts); + return 0; + } + + while ((sts = sys$read(&rab_in))) { /* always true */ + if (sts == RMS$_EOF) break; + rab_out.rab$w_rsz = rab_in.rab$w_rsz; + if (!(sts & 1) || !((sts = sys$write(&rab_out)) & 1)) { + sys$close(&fab_in); sys$close(&fab_out); + set_errno(EVMSERR); set_vaxc_errno(sts); + return 0; + } + } + + fab_out.fab$l_fop &= ~FAB$M_DLT; /* We got this far; keep the output */ + sys$close(&fab_in); sys$close(&fab_out); + sts = (fab_in.fab$l_sts & 1) ? fab_out.fab$l_sts : fab_in.fab$l_sts; + if (!(sts & 1)) { + set_errno(EVMSERR); set_vaxc_errno(sts); + return 0; + } + + return 1; + +} /* end of rmscopy() */ +/*}}}*/ + + +/*** The following glue provides 'hooks' to make some of the routines + * from this file available from Perl. These routines are sufficiently + * basic, and are required sufficiently early in the build process, + * that's it's nice to have them available to miniperl as well as the + * full Perl, so they're set up here instead of in an extension. The + * Perl code which handles importation of these names into a given + * package lives in [.VMS]Filespec.pm in @INC. + */ + +void +rmsexpand_fromperl(CV *cv) +{ + dXSARGS; + char esa[NAM$C_MAXRSS], rsa[NAM$C_MAXRSS], *cp, *out; + struct FAB myfab = cc$rms_fab; + struct NAM mynam = cc$rms_nam; + STRLEN speclen; + unsigned long int retsts, haslower = 0; + + myfab.fab$l_fna = SvPV(ST(0),speclen); + myfab.fab$b_fns = speclen; + myfab.fab$l_nam = &mynam; + + mynam.nam$l_esa = esa; + mynam.nam$b_ess = sizeof esa; + mynam.nam$l_rsa = rsa; + mynam.nam$b_rss = sizeof rsa; + + retsts = sys$parse(&myfab,0,0); + if (!(retsts & 1)) { + set_vaxc_errno(retsts); + if (retsts == RMS$_PRV) set_errno(EACCES); + else if (retsts == RMS$_DEV) set_errno(ENODEV); + else if (retsts == RMS$_DIR) set_errno(ENOTDIR); + else set_errno(EVMSERR); + XSRETURN_UNDEF; + } + retsts = sys$search(&myfab,0,0); + if (!(retsts & 1) && retsts != RMS$_FNF) { + set_vaxc_errno(retsts); + if (retsts == RMS$_PRV) set_errno(EACCES); + else set_errno(EVMSERR); + XSRETURN_UNDEF; + } + /* If the input filespec contained any lowercase characters, + * downcase the result for compatibility with Unix-minded code. */ + for (out = myfab.fab$l_fna; *out; out++) + if (islower(*out)) { haslower = 1; break; } + if (mynam.nam$b_rsl) { out = rsa; speclen = mynam.nam$b_rsl; } + else { out = esa; speclen = mynam.nam$b_esl; } + if (!(mynam.nam$l_fnb & NAM$M_EXP_VER)) + speclen = mynam.nam$l_type - out; + out[speclen] = '\0'; + if (haslower) __mystrtolower(out); + + ST(0) = sv_2mortal(newSVpv(out, speclen)); +} + +void +vmsify_fromperl(CV *cv) +{ + dXSARGS; + char *vmsified; + + if (items != 1) croak("Usage: VMS::Filespec::vmsify(spec)"); + vmsified = do_tovmsspec(SvPV(ST(0),na),NULL,1); + ST(0) = sv_newmortal(); + if (vmsified != NULL) sv_usepvn(ST(0),vmsified,strlen(vmsified)); + XSRETURN(1); +} + +void +unixify_fromperl(CV *cv) +{ + dXSARGS; + char *unixified; + + if (items != 1) croak("Usage: VMS::Filespec::unixify(spec)"); + unixified = do_tounixspec(SvPV(ST(0),na),NULL,1); + ST(0) = sv_newmortal(); + if (unixified != NULL) sv_usepvn(ST(0),unixified,strlen(unixified)); + XSRETURN(1); +} + +void +fileify_fromperl(CV *cv) +{ + dXSARGS; + char *fileified; + + if (items != 1) croak("Usage: VMS::Filespec::fileify(spec)"); + fileified = do_fileify_dirspec(SvPV(ST(0),na),NULL,1); + ST(0) = sv_newmortal(); + if (fileified != NULL) sv_usepvn(ST(0),fileified,strlen(fileified)); + XSRETURN(1); +} + +void +pathify_fromperl(CV *cv) +{ + dXSARGS; + char *pathified; + + if (items != 1) croak("Usage: VMS::Filespec::pathify(spec)"); + pathified = do_pathify_dirspec(SvPV(ST(0),na),NULL,1); + ST(0) = sv_newmortal(); + if (pathified != NULL) sv_usepvn(ST(0),pathified,strlen(pathified)); + XSRETURN(1); +} + +void +vmspath_fromperl(CV *cv) +{ + dXSARGS; + char *vmspath; + + if (items != 1) croak("Usage: VMS::Filespec::vmspath(spec)"); + vmspath = do_tovmspath(SvPV(ST(0),na),NULL,1); + ST(0) = sv_newmortal(); + if (vmspath != NULL) sv_usepvn(ST(0),vmspath,strlen(vmspath)); + XSRETURN(1); +} + +void +unixpath_fromperl(CV *cv) +{ + dXSARGS; + char *unixpath; + + if (items != 1) croak("Usage: VMS::Filespec::unixpath(spec)"); + unixpath = do_tounixpath(SvPV(ST(0),na),NULL,1); + ST(0) = sv_newmortal(); + if (unixpath != NULL) sv_usepvn(ST(0),unixpath,strlen(unixpath)); + XSRETURN(1); +} + +void +candelete_fromperl(CV *cv) +{ + dXSARGS; + char fspec[NAM$C_MAXRSS+1], *fsp; + SV *mysv; + IO *io; + + if (items != 1) croak("Usage: VMS::Filespec::candelete(spec)"); + + mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0); + if (SvTYPE(mysv) == SVt_PVGV) { + if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),fspec)) { + set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG); + ST(0) = &sv_no; + XSRETURN(1); + } + fsp = fspec; + } + else { + if (mysv != ST(0) || !(fsp = SvPV(mysv,na)) || !*fsp) { + set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG); + ST(0) = &sv_no; + XSRETURN(1); + } + } + + ST(0) = cando_by_name(S_IDUSR,0,fsp) ? &sv_yes : &sv_no; + XSRETURN(1); +} + +void +rmscopy_fromperl(CV *cv) +{ + dXSARGS; + char inspec[NAM$C_MAXRSS+1], outspec[NAM$C_MAXRSS+1], *inp, *outp; + int date_flag; + struct dsc$descriptor indsc = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}, + outdsc = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; + unsigned long int sts; + SV *mysv; + IO *io; + + if (items < 2 || items > 3) + croak("Usage: File::Copy::rmscopy(from,to[,date_flag])"); + + mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0); + if (SvTYPE(mysv) == SVt_PVGV) { + if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),inspec)) { + set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG); + ST(0) = &sv_no; + XSRETURN(1); + } + inp = inspec; + } + else { + if (mysv != ST(0) || !(inp = SvPV(mysv,na)) || !*inp) { + set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG); + ST(0) = &sv_no; + XSRETURN(1); + } + } + mysv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1); + if (SvTYPE(mysv) == SVt_PVGV) { + if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),outspec)) { + set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG); + ST(0) = &sv_no; + XSRETURN(1); + } + outp = outspec; + } + else { + if (mysv != ST(1) || !(outp = SvPV(mysv,na)) || !*outp) { + set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG); + ST(0) = &sv_no; + XSRETURN(1); + } + } + date_flag = (items == 3) ? SvIV(ST(2)) : 0; + + ST(0) = rmscopy(inp,outp,date_flag) ? &sv_yes : &sv_no; + XSRETURN(1); +} + +void +init_os_extras() +{ + char* file = __FILE__; + + newXSproto("VMS::Filespec::rmsexpand",rmsexpand_fromperl,file,"$"); + newXSproto("VMS::Filespec::vmsify",vmsify_fromperl,file,"$"); + newXSproto("VMS::Filespec::unixify",unixify_fromperl,file,"$"); + newXSproto("VMS::Filespec::pathify",pathify_fromperl,file,"$"); + newXSproto("VMS::Filespec::fileify",fileify_fromperl,file,"$"); + newXSproto("VMS::Filespec::vmspath",vmspath_fromperl,file,"$"); + newXSproto("VMS::Filespec::unixpath",unixpath_fromperl,file,"$"); + newXSproto("VMS::Filespec::candelete",candelete_fromperl,file,"$"); + newXS("File::Copy::rmscopy",rmscopy_fromperl,file); + return; +} + +/* End of vms.c */ diff --git a/gnu/usr.bin/perl/vms/vms_yfix.pl b/gnu/usr.bin/perl/vms/vms_yfix.pl new file mode 100644 index 00000000000..33af914b25c --- /dev/null +++ b/gnu/usr.bin/perl/vms/vms_yfix.pl @@ -0,0 +1,56 @@ +# This script takes the output produced from perly.y by byacc and +# the perly.fixer shell script (i.e. the perly.c and perly.h built +# for Unix systems) and patches them to produce copies containing +# appropriate declarations for VMS handling of global symbols. +# +# If it finds that the input files are already patches for VMS, +# it just copies the input to the output. +# +# Revised 29-Jan-1996 by Charles Bailey bailey@genetics.upenn.edu + +$VERSION = '1.1'; + +($cinfile,$hinfile,$coutfile,$houtfile) = @ARGV; + +open C,$cinfile or die "Can't read $cinfile: $!\n"; +open COUT, ">$coutfile" or die "Can't create $coutfile: $!\n"; +print COUT <<EOH; +/* Postprocessed by vms_yfix.pl $VERSION to add VMS declarations of globals */ +EOH +while (<C>) { + # "y.tab.c" is illegal as a VMS filename; DECC 5.2/VAX preprocessor + # doesn't like this. + if ( s/^#line\s+(\d+)\s+"y.tab.c"/#line $1 "y_tab.c"/ ) { 1; } + else { + # add the dEXT tag to definitions of global vars, so we'll insert + # a globaldef when perly.c is compiled + s/^(short|int|YYSTYPE|char \*)\s*yy/dEXT $1 yy/; + } + print COUT; +} +close C; +close COUT; + +open H,$hinfile or die "Can't read $hinfile: $!\n"; +open HOUT, ">$houtfile" or die "Can't create $houtfile: $!\n"; +print HOUT <<EOH; +/* Postprocessed by vms_yfix.pl $VERSION to add VMS declarations of globals */ +EOH +$hfixed = 0; # keep -w happy +while (<H>) { + $hfixed = /globalref/ unless $hfixed; # we've already got a fixed copy + next if /^extern YYSTYPE yylval/; # we've got a Unix version, and this + # is what we want to replace + print HOUT; +} +close H; + +print HOUT <<'EODECL' unless $hfixed; +#ifndef vax11c + extern YYSTYPE yylval; +#else + globalref YYSTYPE yylval; +#endif +EODECL + +close HOUT; diff --git a/gnu/usr.bin/perl/vms/vmsish.h b/gnu/usr.bin/perl/vms/vmsish.h new file mode 100644 index 00000000000..0685985d56e --- /dev/null +++ b/gnu/usr.bin/perl/vms/vmsish.h @@ -0,0 +1,425 @@ +/* vmsish.h + * + * VMS-specific C header file for perl5. + * + * Last revised: 01-Oct-1995 by Charles Bailey bailey@genetics.upenn.edu + * Version: 5.1.6 + */ + +#ifndef __vmsish_h_included +#define __vmsish_h_included + +#include <descrip.h> /* for dirent struct definitions */ +#include <libdef.h> /* status codes for various places */ +#include <rmsdef.h> /* at which errno and vaxc$errno are */ +#include <ssdef.h> /* explicitly set in the perl source code */ + +/* Suppress compiler warnings from DECC for VMS-specific extensions: + * GLOBALEXT, NOSHAREEXT: global[dr]ef declarations + * ADDRCONSTEXT: initialization of data with non-constant values + * (e.g. pointer fields of descriptors) + */ +#ifdef __DECC +# 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 +#endif +#define _toupper(c) (((c) < 'a' || (c) > 'z') ? (c) : (c) & ~040) +#ifdef _tolower +# undef _tolower +#endif +#define _tolower(c) (((c) < 'A' || (c) > 'Z') ? (c) : (c) | 040) +/* DECC 1.3 has a funny definition of abs; it's fixed in DECC 4.0, so this + * can go away once DECC 1.3 isn't in use any more. */ +#if defined(__ALPHA) && defined(__DECC) +#undef abs +#define abs(__x) __ABS(__x) +#undef labs +#define labs(__x) __LABS(__x) +#endif /* __ALPHA && __DECC */ + +/* Assorted things to look like Unix */ +#ifdef __GNUC__ +#ifndef _IOLBF /* gcc's stdio.h doesn't define this */ +#define _IOLBF 1 +#endif +#endif +#include <processes.h> /* for vfork() */ +#include <unixio.h> +#include <unixlib.h> +#include <file.h> /* it's not <sys/file.h>, so don't use I_SYS_FILE */ + +/* Our own contribution to PerlShr's global symbols . . . */ +#ifdef EMBED +# define my_trnlnm Perl_my_trnlnm +# define my_getenv Perl_my_getenv +# define my_crypt Perl_my_crypt +# define waitpid Perl_waitpid +# define my_gconvert Perl_my_gconvert +# define do_rmdir Perl_do_rmdir +# define kill_file Perl_kill_file +# define my_utime Perl_my_utime +# define fileify_dirspec Perl_fileify_dirspec +# define fileify_dirspec_ts Perl_fileify_dirspec_ts +# define pathify_dirspec Perl_pathify_dirspec +# define pathify_dirspec_ts Perl_pathify_dirspec_ts +# define tounixspec Perl_tounixspec +# define tounixspec_ts Perl_tounixspec_ts +# define tovmsspec Perl_tovmsspec +# define tovmsspec_ts Perl_tovmsspec_ts +# define tounixpath Perl_tounixpath +# define tounixpath_ts Perl_tounixpath_ts +# define tovmspath Perl_tovmspath +# define tovmspath_ts Perl_tovmspath_ts +# define getredirection Perl_getredirection +# define opendir Perl_opendir +# define readdir Perl_readdir +# define telldir Perl_telldir +# define seekdir Perl_seekdir +# define closedir Perl_closedir +# define vmsreaddirversions Perl_vmsreaddirversions +# define getredirection Perl_getredirection +# define my_gmtime Perl_my_gmtime +# define cando_by_name Perl_cando_by_name +# define flex_fstat Perl_flex_fstat +# define flex_stat Perl_flex_stat +# define trim_unixpath Perl_trim_unixpath +# define vms_do_aexec Perl_vms_do_aexec +# define vms_do_exec Perl_vms_do_exec +# define do_aspawn Perl_do_aspawn +# define do_spawn Perl_do_spawn +# define my_fwrite Perl_my_fwrite +# define my_getpwnam Perl_my_getpwnam +# define my_getpwuid Perl_my_getpwuid +# define my_getpwent Perl_my_getpwent +# define my_endpwent Perl_my_endpwent +# define my_getlogin Perl_my_getlogin +# define rmscopy Perl_rmscopy +# define init_os_extras Perl_init_os_extras +#endif + +/* Delete if at all possible, changing protections if necessary. */ +#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)) +# define set_vaxc_errno(v) (vaxc$errno = (v)) +#else +# define set_errno(v) (errno = (v)) +# define set_vaxc_errno(v) (vaxc$errno = (v)) +#endif + +/* Handy way to vet calls to VMS system services and RTL routines. */ +#define _ckvmssts(call) STMT_START { register unsigned long int __ckvms_sts; \ + if (!((__ckvms_sts=(call))&1)) { \ + set_errno(EVMSERR); set_vaxc_errno(__ckvms_sts); \ + croak("Fatal VMS error (status=%d) at %s, line %d", \ + __ckvms_sts,__FILE__,__LINE__); } } STMT_END + +#ifdef VMS_DO_SOCKETS +#include "sockadapt.h" +#endif + +#define BIT_BUCKET "_NLA0:" +#define PERL_SYS_INIT(c,v) getredirection((c),(v)) +#define PERL_SYS_TERM() +#define dXSUB_SYS int dummy +#define HAS_KILL +#define HAS_WAIT + +/* 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 + */ +#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 + * fwrite() itself, which on some systems outputs several distinct records + * if the number_of_items parameter is >1). + */ +#define fwrite1 my_fwrite + +/* Use our own rmdir() */ +#define rmdir(name) do_rmdir(name) + +/* Assorted fiddling with sigs . . . */ +# include <signal.h> +#define ABORT() abort() + +/* Used with our my_utime() routine in vms.c */ +struct utimbuf { + time_t actime; + time_t modtime; +}; +#define utime my_utime + +/* This is what times() returns, but <times.h> calls it tbuffer_t on VMS */ + +struct tms { + clock_t tms_utime; /* user time */ + clock_t tms_stime; /* system time - always 0 on VMS */ + clock_t tms_cutime; /* user time, children */ + 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 . . . + */ + +#define sys_nerr EVMSERR /* EVMSERR is as high as we can go. */ + +/* Look up new %ENV values on the fly */ +#define DYNAMIC_ENV_FETCH 1 +#define ENV_HV_NAME "%EnV%VmS%" + +/* Thin jacket around cuserid() tomatch Unix' calling sequence */ +#define getlogin my_getlogin + +/* Ditto for sys$hash_passwrod() . . . */ +#define crypt my_crypt + +/* Use our own stat() clones, which handle Unix-style directory names */ +#define Stat(name,bufptr) flex_stat(name,bufptr) +#define Fstat(fd,bufptr) flex_fstat(fd,bufptr) + +/* By default, flush data all the way to disk, not just to RMS buffers */ +#define Fflush(fp) ((fflush(fp) || fsync(fileno(fp))) ? EOF : 0) + +/* Setup for the dirent routines: + * opendir(), closedir(), readdir(), seekdir(), telldir(), and + * vmsreaddirversions(), and preprocessor stuff on which these depend: + * Written by Rich $alz, <rsalz@bbn.com> in August, 1990. + * This code has no copyright. + */ + /* Data structure returned by READDIR(). */ +struct dirent { + char d_name[256]; /* File name */ + int d_namlen; /* Length of d_name */ + int vms_verscount; /* Number of versions */ + int vms_versions[20]; /* Version numbers */ +}; + + /* Handle returned by opendir(), used by the other routines. You + * are not supposed to care what's inside this structure. */ +typedef struct _dirdesc { + long context; + int vms_wantversions; + unsigned long int count; + char *pattern; + struct dirent entry; + struct dsc$descriptor_s pat; +} DIR; + +#define rewinddir(dirp) seekdir((dirp), 0) + +/* used for our emulation of getpw* */ +struct passwd { + char *pw_name; /* Username */ + char *pw_passwd; + Uid_t pw_uid; /* UIC member number */ + Gid_t pw_gid; /* UIC group number */ + char *pw_comment; /* Default device/directory (Unix-style) */ + char *pw_gecos; /* Owner */ + char *pw_dir; /* Default device/directory (VMS-style) */ + char *pw_shell; /* Default CLI name (eg. DCL) */ +}; +#define pw_unixdir pw_comment /* Default device/directory (Unix-style) */ +#define getpwnam my_getpwnam +#define getpwuid my_getpwuid +#define getpwent my_getpwent +#define endpwent my_endpwent +#define setpwent my_endpwent + +/* Our own stat_t substitute, since we play with st_dev and st_ino - + * we want atomic types so Unix-bound code which compares these fields + * for two files will work most of the time under VMS. + * N.B. 1. The st_ino hack assumes that sizeof(unsigned short[3]) == + * sizeof(unsigned) + sizeof(unsigned short). We can't use a union type + * to map the unsigned int we want and the unsigned short[3] the CRTL + * returns into the same member, since gcc has different ideas than DECC + * and VAXC about sizing union types. + * N.B 2. The routine cando() in vms.c assumes that &stat.st_ino is the + * address of a FID. + */ +/* First, grab the system types, so we don't clobber them later */ +#include <stat.h> +/* Since we've got to match the size of the CRTL's stat_t, we need + * to mimic DECC's alignment settings. + */ +#if defined(__DECC) || defined(__DECCXX) +# pragma __member_alignment __save +# pragma __nomember_alignment +#endif +#if defined(__DECC) +# pragma __message __save +# pragma __message disable (__MISALGNDSTRCT) +# pragma __message disable (__MISALGNDMEM) +#endif +struct mystat +{ + char *st_devnam; /* pointer to device name */ + unsigned st_ino; /* hack - CRTL uses unsigned short[3] for */ + unsigned short rvn; /* FID (num,seq,rvn) */ + unsigned short st_mode; /* file "mode" i.e. prot, dir, reg, etc. */ + int st_nlink; /* for compatibility - not really used */ + unsigned st_uid; /* from ACP - QIO uic field */ + unsigned short st_gid; /* group number extracted from st_uid */ + dev_t st_rdev; /* for compatibility - always zero */ + off_t st_size; /* file size in bytes */ + unsigned st_atime; /* file access time; always same as st_mtime */ + unsigned st_mtime; /* last modification time */ + unsigned st_ctime; /* file creation time */ + char st_fab_rfm; /* record format */ + char st_fab_rat; /* record attributes */ + char st_fab_fsz; /* fixed header size */ + unsigned st_dev; /* encoded device name */ +}; +#define stat mystat +typedef unsigned mydev_t; +#define dev_t mydev_t +typedef unsigned myino_t; +#define ino_t myino_t +#if defined(__DECC) || defined(__DECCXX) +# pragma __member_alignment __restore +#endif +#if defined(__DECC) +# pragma __message __restore +#endif +/* Cons up a 'delete' bit for testing access */ +#define S_IDUSR (S_IWUSR | S_IXUSR) +#define S_IDGRP (S_IWGRP | S_IXGRP) +#define S_IDOTH (S_IWOTH | S_IXOTH) + +/* Prototypes for functions unique to vms.c. Don't include replacements + * for routines in the mainline source files excluded by #ifndef VMS; + * their prototypes are already in proto.h. + * + * In order to keep Gen_ShrFls.Pl happy, functions which are to be made + * available to images linked to PerlShr.Exe must be declared between the + * __VMS_PROTOTYPES__ and __VMS_SEPYTOTORP__ lines, and must be in the form + * <data type><TAB>name<WHITESPACE>_((<prototype args>)); + */ +/* prototype section start marker; `typedef' passes through cpp */ +typedef char __VMS_PROTOTYPES__; +int my_trnlnm _((char *, char *, unsigned long int)); +char * my_getenv _((char *)); +char * my_crypt _((const char *, const char *)); +unsigned long int waitpid _((unsigned long int, int *, int)); +char * my_gconvert _((double, int, int, char *)); +int do_rmdir _((char *)); +int kill_file _((char *)); +int my_utime _((char *, struct utimbuf *)); +char * fileify_dirspec _((char *, char *)); +char * fileify_dirspec_ts _((char *, char *)); +char * pathify_dirspec _((char *, char *)); +char * pathify_dirspec_ts _((char *, char *)); +char * tounixspec _((char *, char *)); +char * tounixspec_ts _((char *, char *)); +char * tovmsspec _((char *, char *)); +char * tovmsspec_ts _((char *, char *)); +char * tounixpath _((char *, char *)); +char * tounixpath_ts _((char *, char *)); +char * tovmspath _((char *, char *)); +char * tovmspath_ts _((char *, char *)); +void getredirection _(()); +DIR * opendir _((char *)); +struct dirent * readdir _((DIR *)); +long telldir _((DIR *)); +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 *)); +int trim_unixpath _((char *, char*)); +bool vms_do_aexec _((SV *, SV **, SV **)); +bool vms_do_exec _((char *)); +unsigned long int do_aspawn _((SV *, SV **, SV **)); +unsigned long int do_spawn _((char *)); +int my_fwrite _((void *, size_t, size_t, FILE *)); +struct passwd * my_getpwnam _((char *name)); +struct passwd * my_getpwuid _((Uid_t uid)); +struct passwd * my_getpwent _(()); +void my_endpwent _(()); +char * my_getlogin _(()); +int rmscopy _((char *, char *, int)); +void init_os_extras _(()); +typedef char __VMS_SEPYTOTORP__; +/* prototype section end marker; `typedef' passes through cpp */ + +#ifndef VMS_DO_SOCKETS +/* This relies on tricks in perl.h to pick up that these manifest constants + * are undefined and set up conversion routines. It will then redefine + * these manifest constants, so the actual values will match config.h + */ +#undef HAS_HTONS +#undef HAS_NTOHS +#undef HAS_HTONL +#undef HAS_NTOHL +#endif + +#define TMPPATH "sys$scratch:perl-eXXXXXX" + +#endif /* __vmsish_h_included */ diff --git a/gnu/usr.bin/perl/vms/writemain.pl b/gnu/usr.bin/perl/vms/writemain.pl new file mode 100644 index 00000000000..eb059f810a7 --- /dev/null +++ b/gnu/usr.bin/perl/vms/writemain.pl @@ -0,0 +1,70 @@ +#!./miniperl +# +# Create perlmain.c from miniperlmain.c, adding code to boot the +# extensions listed on the command line. In addition, create a +# linker options file which causes the bootstrap routines for +# these extension to be universal symbols in PerlShr.Exe. +# +# Last modified 29-Nov-1994 by Charles Bailey bailey@genetics.upenn.edu +# + +if (-f 'miniperlmain.c') { $dir = ''; } +elsif (-f '../miniperlmain.c') { $dir = '../'; } +else { die "$0: Can't find miniperlmain.c\n"; } + +open (IN,"${dir}miniperlmain.c") + || die "$0: Can't open ${dir}miniperlmain.c: $!\n"; +open (OUT,">${dir}perlmain.c") + || die "$0: Can't open ${dir}perlmain.c: $!\n"; + +while (<IN>) { + print OUT; + last if /Do not delete this line--writemain depends on it/; +} +$ok = !eof(IN); +close IN; + +if (!$ok) { + close OUT; + unlink "${dir}perlmain.c"; + die "$0: Can't find marker line in ${dir}miniperlmain.c - aborting\n"; +} + + +print OUT <<'EOH'; + +static void +xs_init() +{ + dXSUB_SYS; +EOH + +if (@ARGV) { + # Allow for multiple names in one quoted group + @exts = split(/\s+/, join(' ',@ARGV)); +} + +if (@exts) { + print OUT " char *file = __FILE__;\n"; + foreach $ext (@exts) { + my($subname) = $ext; + $subname =~ s/::/__/g; + print OUT "extern void boot_${subname} _((CV* cv));\n" + } + foreach $ext (@exts) { + my($subname) = $ext; + $subname =~ s/::/__/g; + print "Adding $ext . . .\n"; + if ($ext eq 'DynaLoader') { + # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'! + # boot_DynaLoader is called directly in DynaLoader.pm + print OUT " newXS(\"${ext}::boot_${ext}\", boot_${subname}, file);\n" + } + else { + print OUT " newXS(\"${ext}::bootstrap\", boot_${subname}, file);\n" + } + } +} + +print OUT "}\n"; +close OUT; |