summaryrefslogtreecommitdiff
path: root/vms
diff options
context:
space:
mode:
authorLarry Wall <lwall@netlabs.com>1994-10-17 23:00:00 +0000
committerLarry Wall <lwall@netlabs.com>1994-10-17 23:00:00 +0000
commita0d0e21ea6ea90a22318550944fe6cb09ae10cda (patch)
treefaca1018149b736b1142f487e44d1ff2de5cc1fa /vms
parent85e6fe838fb25b257a1b363debf8691c0992ef71 (diff)
downloadperl-a0d0e21ea6ea90a22318550944fe6cb09ae10cda.tar.gz
perl 5.000perl-5.000
[editor's note: this commit combines approximate 4 months of furious releases of Andy Dougherty and Larry Wall - see pod/perlhist.pod for details. Andy notes that; Alas neither my "Irwin AccuTrack" nor my DC 600A quarter-inch cartridge backup tapes from that era seem to be readable anymore. I guess 13 years exceeds the shelf life for that backup technology :-(. ]
Diffstat (limited to 'vms')
-rw-r--r--vms/config.vms1440
-rw-r--r--vms/descrip.mms858
-rw-r--r--vms/gen_shrfls.pl229
-rw-r--r--vms/genconfig.pl112
-rw-r--r--vms/genopt.com18
-rw-r--r--vms/makefile.764
-rw-r--r--vms/mms2make.pl102
-rw-r--r--vms/perlshr.c13
-rw-r--r--vms/perlvms.pod264
-rw-r--r--vms/sockadapt.c43
-rw-r--r--vms/sockadapt.h54
-rw-r--r--vms/test.com184
-rw-r--r--vms/vms.c2095
-rw-r--r--vms/vmsish.h176
-rw-r--r--vms/writemain.pl52
15 files changed, 6404 insertions, 0 deletions
diff --git a/vms/config.vms b/vms/config.vms
new file mode 100644
index 0000000000..6deaac7eca
--- /dev/null
+++ b/vms/config.vms
@@ -0,0 +1,1440 @@
+/*
+ * 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
+ */
+
+/* Configuration time: 12-Oct-1994 17:00
+ * Configured by: Charles Bailey bailey@genetics.upenn.edu
+ * Target system: VMS
+ */
+
+#ifndef _config_h_
+#define _config_h_
+
+/* MEM_ALIGNBYTES:
+ * This symbol contains the number of bytes required to align a
+ * double. Usual values are 2, 4 and 8.
+ */
+#define MEM_ALIGNBYTES 8 /**/
+
+/* BYTEORDER:
+ * This symbol hold the hexadecimal constant defined in byteorder,
+ * i.e. 0x1234 or 0x4321, etc...
+ */
+#define BYTEORDER 0x1234 /* large digits for MSB */
+
+/* ARCHLIB:
+ * 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 is the
+ * same as PRIVLIB, it is not defined, since presumably the
+ * program already searches PRIVLIB.
+ */
+#undef ARCHLIB /**/
+
+/* CAT2:
+ * This macro catenates 2 tokens together.
+ */
+/* STRINGIFY:
+ * This macro surrounds its token with double quotes.
+ */
+#ifdef __STDC__
+#define CAT2(a,b) a##b /* config-skip */
+#define CAT3(a,b,c) a##b##c /* config-skip */
+#define CAT4(a,b,c,d) a##b##c##d /* config-skip */
+#define CAT5(a,b,c,d,e) a##b##c##d##e /* config-skip */
+#define STRINGIFY(a) #a /* config-skip */
+#else
+#define CAT2(a,b) a/**/b /* config-skip */
+#define CAT3(a,b,c) a/**/b/**/c /* config-skip */
+#define CAT4(a,b,c,d) a/**/b/**/c/**/d /* config-skip */
+#define CAT5(a,b,c,d,e) a/**/b/**/c/**/d/**/e /* config-skip */
+#define STRINGIFY(a) "a" /* config-skip */
+#endif
+
+/* CPPSTDIN:
+ * This symbol contains the first part of the string which will invoke
+ * the C preprocessor on the standard input and produce to standard
+ * 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 /**/
+
+/* CHARSPRINTF:
+ * This symbol is defined if this system declares "char *sprintf()" in
+ * stdio.h. The trend seems to be to declare it as "int sprintf()". It
+ * is up to the package author to declare sprintf correctly based on the
+ * symbol.
+ */
+#undef CHARSPRINTF /**/
+
+/* HAS_CHSIZE:
+ * This symbol, if defined, indicates that the chsize routine is available
+ * to truncate files. You might need a -lx to get this routine.
+ */
+#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.
+ */
+#undef HAS_CRYPT /**/
+
+/* 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_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_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.
+ */
+#undef HAS_SELECT /**/
+
+/* 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 char * /**/ /* config-skip */
+#undef HAS_SHMAT_PROTOTYPE /**/
+
+/* 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_STD_STDIO:
+ * This symbol is defined if this system has a FILE structure declaring
+ * _ptr and _cnt in stdio.h.
+ */
+#undef USE_STD_STDIO /**/
+
+/* 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 /**/
+
+/* 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.
+ */
+#undef 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 /**/
+#undef 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 /**/
+
+/* HAS_IOCTL:
+ * This symbol, if defined, indicates that the ioctl() routine is
+ * available to set I/O characteristics
+ */
+#undef HAS_IOCTL /**/
+
+/* I_SYS_NDIR:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <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_SYS_TIMES:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/times.h>.
+ */
+#undef I_SYS_TIMES /**/
+
+/* 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 /**/
+
+/* HAS_UTIME:
+ * This symbol, if defined, indicates that the routine utime() is
+ * available to update the access and modification times of files.
+ */
+#undef HAS_UTIME /**/
+
+/* I_STDARG:
+ * This symbol, if defined, indicates that <stdarg.h> exists and should
+ * be included.
+ */
+/* I_VARARGS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <varargs.h>.
+ */
+#define I_STDARG /**/
+#undef I_VARARGS /**/
+
+
+/* I_VFORK:
+ * This symbol, if defined, indicates to the C program that it should
+ * include vfork.h.
+ */
+#undef I_VFORK /**/
+
+/* INTSIZE:
+ * This symbol contains the size of an int, so that the C preprocessor
+ * can make decisions based on it.
+ */
+#define INTSIZE 4 /**/
+
+
+/* CAN_PROTOTYPE:
+ * If defined, this macro indicates that the C compiler can handle
+ * function prototypes.
+ */
+/* _:
+ * 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 fd_set * /**/
+
+/* 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 /**/
+
+/* 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
+
+
+/* EUNICE:
+ * This symbol, if defined, indicates that the program is being compiled
+ * under the EUNICE package under VMS. The program will need to handle
+ * things like files that don't go away the first time you unlink them,
+ * due to version numbering. It will also need to compensate for lack
+ * of a respectable link() command.
+ */
+/* VMS:
+ * This symbol, if defined, indicates that the program is running under
+ * VMS. It is currently only set in conjunction with the EUNICE symbol.
+ */
+#define EUNICE /**/
+/* This symbol is automagically defined by all VMS C compilers I've seen.
+ * Just in case, however . . . */
+#ifndef VMS
+#define VMS /**/
+#endif
+
+/* LOC_SED:
+ * This symbol holds the complete pathname to the sed program.
+ */
+#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 /**/
+
+/* 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.
+ */
+#undef HAS_GETLOGIN /**/
+
+/* HAS_GETPPID:
+ * This symbol, if defined, indicates that the getppid routine is
+ * available.
+ */
+#undef HAS_GETPPID /**/
+
+/* HAS_GROUP:
+ * This symbol, if defined, indicates that the group routine is
+ * available.
+ */
+#undef HAS_GROUP /**/
+
+
+/* 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_PASSWD:
+ * This symbol, if defined, indicates that the passwd routine is
+ * available.
+ */
+#undef HAS_PASSWD /**/
+
+/* 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 /**/
+
+/* VOIDSIG:
+ * This symbol is defined if this system declares "void (*signal(...))()" in
+ * signal.h. The old way was to declare it as "int (*signal(...))()". It
+ * is up to the package author to declare things correctly based on the
+ * symbol.
+ */
+#define VOIDSIG /**/
+
+/* HAS_WCTOMB:
+ * This symbol, if defined, indicates that the wctomb routine is available
+ * to covert a wide character to a multibyte.
+ */
+#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.
+ */
+#define Gid_t unsigned int /* Type for getgid(), etc... */
+
+/* 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 /**/
+
+/* 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 */
+/* Malloc_t:
+ * This symbol is the type of pointer returned by malloc and realloc.
+ */
+#define Malloc_t void * /**/
+
+/* MYMALLOC:
+ * This symbol, if defined, indicates that we're using our own malloc.
+ */
+#undef MYMALLOC /**/
+
+/* 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 */
+
+
+/* PRIVLIB:
+ * This symbol contains the name of the private library for this package.
+ * The library is private in the sense that it needn't be in anyone's
+ * execution path, but it should be accessible by the world. The program
+ * should be prepared to do ~ expansion.
+ */
+#define PRIVLIB "/perl_root/lib" /**/
+
+/* 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" /**/
+
+/* SIG_NAME:
+ * This symbol contains a list of signal names in order. This is intended
+ * to be used as a static array initialization, like this:
+ * char *sig_name[] = { SIG_NAME };
+ * The signals in the list are separated with commas, and each signal
+ * is surrounded by double quotes. There is no leading SIG in the signal
+ * name, i.e. SIGQUIT is known as "QUIT".
+ */
+#define SIG_NAME "HUP","INT","QUIT","ILL","TRAP","IOT","EMT","FPE","KILL",\
+ "BUS","SEGV","SYS","PIPE","ALRM","TERM"
+
+/* Size_t:
+ * This symbol holds the type used to declare length parameters
+ * for string functions. It is usually size_t, but may be
+ * 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.
+ */
+#define Uid_t unsigned int /* UID type */
+
+/* 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_DREM:
+ * This symbol, if defined, indicates that the drem routine is
+ * available. This is a Pyramid routine that is the same as
+ * fmod.
+ */
+#undef HAS_DREM /**/
+
+/* HAS_FMOD:
+ * This symbol, if defined, indicates that the fmod routine is
+ * available.
+ */
+#define HAS_FMOD /**/
+
+/* Gconvert:
+ * This preprocessor macro is defined to convert a floating point
+ * number to a string without a trailing decimal point. This
+ * emulates the behavior of sprintf("%g"), but is sometimes much more
+ * efficient. If gconvert() is not available, but gcvt() drops the
+ * trailing decimal point, then gcvt() is used. If all else fails,
+ * a macro using sprintf("%g") is used.
+ */
+#define Gconvert(x,n,t,b) my_gconvert(x,n,t,b)
+
+/* HAS_ISASCII:
+ * This manifest constant lets the C program know that the
+ * isascii is available.
+ */
+#define HAS_ISASCII /**/
+
+/* USE_LINUX_STDIO:
+ * This symbol is defined if this system has a FILE structure declaring
+ * _IO_read_base, _IO_read_ptr, and _IO_read_end in stdio.h.
+ */
+#undef USE_LINUX_STDIO /**/
+
+/* HAS_LOCALECONV:
+ * This symbol, if defined, indicates that the localeconv routine is
+ * available for numeric and monetary formatting conventions.
+ */
+#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 /**/
+
+/* USE_DYNAMIC_LOADING:
+ * This symbol, if defined, indicates that dynamic loading of
+ * some sort is available.
+ */
+#define USE_DYNAMIC_LOADING /**/
+
+#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
+
+/* I_NET_ERRNO:
+ * This symbol, if defined, indicates that <net/errno.h> exists and
+ * should be included.
+*/
+#undef I_NET_ERRNO /**/ /* 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 */
+
+#endif /* !VMS_DO_SOCKETS */
+
+#endif
diff --git a/vms/descrip.mms b/vms/descrip.mms
new file mode 100644
index 0000000000..bd30a87095
--- /dev/null
+++ b/vms/descrip.mms
@@ -0,0 +1,858 @@
+# Descrip.MMS for perl5 on VMS
+# Last revised 12-Oct-1994 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, on system with GCC command installed in DCLTABLES:
+#: $ MMS /MACRO=("gnuc=1")
+#: Building with GNU C, on system without GCC command installed in DCLTABLES:
+#: $ MMS /MACRO=("gnuc=1") gcc_cld_setup,all
+#: note: `gcc_cld_setup' target must explicitly precede `all' or `[mini]perl'
+#:
+#: 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 files generated by executing this file
+# cleansrc -- `clean' + purge *.c,*.h,descrip.mms
+# gcc_cld_setup -- GCC initialization; see above
+# crtl.opt -- compiler-specific linker options file (made automatically)
+#
+
+#### Start of system configuration section. ####
+
+.ifdef AXE
+# File type to use for object files
+O = .abj
+# File type to use for executable images
+E = .axe
+.else
+# File type to use for object files
+O = .obj
+# File type to use for executable images
+E = .exe
+.endif
+
+# used to incorporate 'custom' malloc routines
+mallocsrc =
+mallocobj =
+
+#: Process hardware architecture macros
+.ifdef __AXP__
+SYMOPT =
+DECC = 1
+.else
+# We need separate MACRO files declaring global symbols
+SYMOPT = ,perlshr_gbl.opt/Option
+.endif
+
+#: Process compiler selection macros
+.ifdef GNUC
+.first
+ @ If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS GNU_CC_Include:[VMS]
+CC = gcc
+XTRACCFLAGS = /Obj=$(MMS$TARGET_NAME)$(O)
+DBGSPECFLAGS =
+XTRADEF = ,GNUC_ATTRIBUTE_CHECK
+XTRAOBJS =
+LIBS1 = GNU_CC:[000000]GCCLIB.OLB/Library
+LIBS2 = Sys$Share:VAXCRTL.Exe/Shareable
+.else
+.first
+ @ If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS Sys$Library
+XTRAOBJS =
+LIBS1 = $(XTRAOBJS)
+DBGSPECFLAGS = /Show=(Source,Include,Expansion)
+.ifdef decc
+LIBS2 =
+XTRACCFLAGS = /Standard=VAXC/Include=[]/Prefix=All/Obj=$(MMS$TARGET_NAME)$(O)
+XTRADEF =
+.else # VAXC
+XTRACCFLAGS = /Include=[]/Object=$(O)
+XTRADEF =
+LIBS2 = Sys$Share:VAXCRTL.Exe/Shareable
+.endif
+.endif
+
+.ifdef __DEBUG__
+DBGCCFLAGS = /List/Debug/NoOpt$(DBGSPECFLAGS)
+DBGLINKFLAGS = /Debug/Map/Full/Cross
+DBG = DBG
+.else
+DBGCCFLAGS = /NoList
+DBGLINKFLAGS = /NoMap
+DBG =
+.endif
+
+# Process option macros
+.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)
+.else
+SOCKDEF =
+SOCKLIB =
+SOCKC =
+SOCKH =
+SOCKCLIS =
+SOCKHLIS =
+SOCKOBJ =
+.endif
+
+# DEBUGGING ==> perl -D, not the VMS debugger
+CFLAGS = /Define=(DEBUGGING$(SOCKDEF)$(XTRADEF))$(XTRACCFLAGS)$(DBGCCFLAGS)
+LINKFLAGS = $(DBGLINKFLAGS)
+
+MAKEFILE = [.VMS]Descrip.MMS # this file
+NOOP = continue
+
+XSUBPP = MCR Sys$Disk:[]Miniperl$(E) [.ext]xsubpp -typemap [-]typemap
+# List of extensions to build into perlmain; enclose each in quotes and
+# separate by spaces.
+EXT = "DynaLoader"
+# Source and object files for these extensions; leading comma is required
+# These must be built separately, or you must add rules below to build them
+extobj = , [.ext.dynaloader]dl_vms$(O)
+
+#### 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 $(mallocsrc)
+c2 = mg.c, perly.c, pp.c, pp_ctl.c, pp_hot.c, pp_sys.c, regcomp.c, regexec.c
+c3 = gv.c, sv.c, taint.c, toke.c, util.c, deb.c, run.c, vms.c $(SOCKCLIS)
+
+c = $(c1), $(c2), $(c3), perl.c, miniperlmain.c, perlmain.c
+
+obj1 = av$(O), scope$(O), op$(O), doop$(O), doio$(O), dump$(O), hv$(O) $(mallocobj)
+obj2 = mg$(O), perly$(O), pp$(O), pp_ctl$(O), pp_hot$(O), pp_sys$(O), regcomp$(O), regexec$(O)
+obj3 = gv$(O), sv$(O), taint$(O), toke$(O), util$(O), deb$(O), run$(O), vms$(O) $(SOCKOBJ)
+
+obj = $(obj1), $(obj2), $(obj3)
+
+CRTL = []crtl.opt
+CRTLOPTS =,$(CRTL)/Options
+
+.SUFFIXES
+.SUFFIXES $(O) .c
+
+.c$(O) :
+ $(CC) $(CFLAGS) $(MMS$SOURCE)
+
+all : base extras
+ @ $(NOOP)
+base : $(DBG)miniperl$(E) perl$(E) [.lib]Config.pm
+ @ $(NOOP)
+extras : [.lib]DynaLoader.pm
+ @ $(NOOP)
+
+miniperl_objs = miniperlmain$(O), perl$(O), $(obj)
+miniperl$(E) : $(miniperl_objs) , coreobjs.opt $(CRTL)
+ Link $(LINKFLAGS)/NoDebug/Exe=$(MMS$TARGET) miniperlmain$(O), perl$(O), coreobjs.opt/Option $(CRTLOPTS)
+.ifdef DBG
+$(DBG)miniperl$(E) : $(miniperl_objs) , coreobjs.opt $(CRTL)
+ Link $(LINKFLAGS)/Exe=$(MMS$TARGET) miniperlmain$(O), perl$(O), coreobjs.opt/Option $(CRTLOPTS)
+.endif
+
+# Use an options file to list object files since some Makes don't feed
+# long lines to DCL properly
+coreobjs.opt : $(MAKEFILE)
+ @ @[.vms]genopt "$(MMS$TARGET)/Write" "|" "$(obj1)"
+ @ @[.vms]genopt "$(MMS$TARGET)/Append" "|" "$(obj2)"
+ @ @[.vms]genopt "$(MMS$TARGET)/Append" "|" "$(obj3)"
+
+perlmain.c : miniperlmain.c miniperl$(E)
+ MCR Sys$Disk:[]Miniperl$(E) [.VMS]Writemain.pl $(EXT)
+
+perl$(E) : perlmain$(O) $(extobj), perlshr$(E), perlshr_attr.opt $(CRTL)
+ @ @[.vms]genopt "PerlShr.Opt/Write" "|" "''F$Environment("Default")'$(DBG)PerlShr$(E)/Share"
+ Link $(LINKFLAGS)/Exe=$(DBG)$(MMS$TARGET) perlmain$(O) $(extobj),[]perlshr.opt/Option,perlshr_attr.opt/Option
+shr_objs = perlshr$(O) ,perl$(O), $(obj)
+perlshr$(E) : $(shr_objs) ,perlshr_xtras.ts ,coreobjs.opt ,$(CRTL)
+ Link $(LINKFLAGS)/Share/Exe=$(DBG)$(MMS$TARGET) perlshr$(O), perl$(O), coreobjs.opt/Option $(SYMOPT) , perlshr_attr.opt/Option, perlshr_sym.opt/Option $(CRTLOPTS)
+perlshr$(O) : [.vms]perlshr.c
+ $(CC) $(CFLAGS)/NoOptimize/Object=$(MMS$TARGET) $(MMS$SOURCE)
+# The following files are built in one go by gen_shrfls.pl:
+# perlshr_attr.opt, perlshr_sym.opt - VAX and AXP
+# perlshr_gbl*.mar, perlshr_gbl*$(O), perlshr_gbl.opt - VAX only
+.ifdef DECC_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.
+perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl miniperl$(E) $(MAKEFILE)
+ $(CC) $(CFLAGS)/NoObject/NoList/PreProcess=perl.i perl.h
+ MCR Sys$Disk:[]Miniperl$(E) [.vms]gen_shrfls.pl "~~NOCC~~perl.i" $(O)
+ @ Delete/NoLog/NoConfirm perl.i;
+ @ Copy NLA0: perlshr_xtras.ts
+ @ Purge/NoLog/NoConfirm perlshr_xtras.ts
+.else
+perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl miniperl$(E) $(MAKEFILE)
+ MCR Sys$Disk:[]Miniperl$(E) [.vms]gen_shrfls.pl "$(CC)$(CFLAGS)" $(O)
+ @ Copy NLA0: perlshr_xtras.ts
+ @ Purge/NoLog/NoConfirm perlshr_xtras.ts
+.endif
+
+[.lib]config.pm : [.vms]config.vms [.vms]genconfig.pl miniperl$(E)
+ MCR Sys$Disk:[]Miniperl$(E) [.VMS]GenConfig.Pl
+ MCR Sys$Disk:[]Miniperl$(E) ConfigPM.
+
+[.ext.dynaloader]dl_vms.c : [.ext.dynaloader]dl_vms.xs miniperl$(E)
+ $(XSUBPP) $(MMS$SOURCE) >$(MMS$TARGET)
+
+[.ext.dynaloader]dl_vms$(O) : [.ext.dynaloader]dl_vms.c
+ $(CC) $(CFLAGS) /Object=$(MMS$TARGET) $(MMS$SOURCE)
+
+preplibrary : miniperl$(E) [.lib]Config.pm
+ @ Create/Directory [.lib.auto]
+ MCR Sys$Disk:[]Miniperl$(E) "-Ilib" -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]*.pm [.lib.*]*.pm
+
+[.lib]DynaLoader.pm : [.ext.dynaloader]dynaloader.pm preplibrary
+ Copy/Log/NoConfirm [.ext.dynaloader]dynaloader.pm [.lib]DynaLoader.pm
+ MCR Sys$Disk:[]Miniperl$(E) autosplit DynaLoader
+
+.ifdef SOCKET
+$(SOCKOBJ) : $(SOCKC) $(SOCKH)
+
+vmsish.h : $(SOCKH)
+
+$(SOCKC) : [.vms]$(SOCKC)
+ Copy/Log/NoConfirm [.vms]$(SOCKC) []$(SOCKC)
+
+$(SOCKH) : [.vms]$(SOCKH)
+ Copy/Log/NoConfirm [.vms]$(SOCKH) []$(SOCKH)
+.endif
+
+#opcode.h : opcode.pl
+# MCR Sys$Disk:[]Miniperl$(E) opcode.pl
+
+perly.h : perly.c # Quick and dirty 'touch'
+ Copy/Log/NoConfirm perly.h; ;
+ Delete/Log/NoConfirm perly.h;-1
+
+# I now supply perly.c with the kits, so the following section is
+# commented out if you don't have byacc.
+
+# perly.c:
+# @ echo 'Expect' 80 shift/reduce and 62 reduce/reduce conflicts
+# \$(BYACC) -d perly.y
+# sh \$(shellflags) ./perly.fixer y.tab.c perly.c
+# mv y.tab.h perly.h
+# echo 'extern YYSTYPE yylval;' >>perly.h
+
+perly$(O) : perly.c, perly.h, $(h)
+ $(CC) $(CFLAGS) $(MMS$SOURCE)
+
+test : perl$(E)
+ - @[.VMS]Test.Com
+
+# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
+# If this runs make out of memory, delete /usr/include lines.
+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) : 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) : 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) : 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) : 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) : 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) : 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) : 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
+malloc$(O) : EXTERN.h
+malloc$(O) : av.h
+malloc$(O) : config.h
+malloc$(O) : cop.h
+malloc$(O) : cv.h
+malloc$(O) : embed.h
+malloc$(O) : form.h
+malloc$(O) : gv.h
+malloc$(O) : handy.h
+malloc$(O) : hv.h
+malloc$(O) : malloc.c
+malloc$(O) : mg.h
+malloc$(O) : op.h
+malloc$(O) : opcode.h
+malloc$(O) : perl.h
+malloc$(O) : pp.h
+malloc$(O) : proto.h
+malloc$(O) : regexp.h
+malloc$(O) : scope.h
+malloc$(O) : sv.h
+malloc$(O) : vmsish.h
+malloc$(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) : 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
+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.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) : 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
+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) : 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) : 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) : 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) : 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) : 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) : 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) : 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) : 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) : INTERN.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) : 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) : INTERN.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) : 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
+
+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("*.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("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("[.Lib.Auto...]*.al;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Auto...]*.al
+ - If F$Search("[.Lib.Auto...]autosplit.ts;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Auto...]autosplit.ts
+
+clean : tidy
+ - If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_Attr.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("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;*
+
+realclean : clean
+ - If F$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);*
+ - If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*
+ - If F$Search("[.Lib.Auto...]*.al;-1").nes."" Then Delete/NoConfirm/Log [.Lib.Auto...]*.al;*
+ - If F$Search("[.Lib.Auto...]autosplit.ts;-1").nes."" Then Delete/NoConfirm/Log [.Lib.Auto...]autosplit.ts;*
+
+cleansrc : clean
+ - If F$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);*
+ - 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("$(MAKEFILE);-1").nes."" Then Purge/NoConfirm/Log $(MAKEFILE)
+ - 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("[.Lib.Auto...]*.al").nes."" Then Delete/NoConfirm/Log [.Lib.Auto...]*.al;*
+ - If F$Search("[.Lib.Auto...]autosplit.ts;").nes."" Then Delete/NoConfirm/Log [.Lib.Auto...]autosplit.ts;*
+ - If F$Search("[.Lib]Config.pm;").nes."" Then Delete/NoConfirm/Log [.Lib]Config.pm;*
diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl
new file mode 100644
index 0000000000..120c355cd7
--- /dev/null
+++ b/vms/gen_shrfls.pl
@@ -0,0 +1,229 @@
+# 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.
+#
+# 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_Sym.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: 21-Sep-1994
+
+require 5.000;
+
+$debug = $ENV{'GEN_SHRFLS_DEBUG'};
+$cc_cmd = shift @ARGV;
+print "Input \$cc_cmd: \\$cc_cmd\\\n" if $debug;
+$docc = ($cc_cmd !~ /~~NOCC~~/);
+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;
+
+ if (-f 'perl.h') { $dir = '[]'; }
+ elsif (-f '[-]perl.h') { $dir = '[-]'; }
+ else { die "$0: Can't find perl.h\n"; }
+}
+else { ($cpp_file) = ($cc_cmd =~ /~~NOCC~~(.*)/) }
+
+$objsuffix = shift @ARGV;
+print "\$objsuffix: \\$objsuffix\\\n" if $debug;
+
+# Someday, we'll have $GetSyI built into perl . . .
+$isvax = `\$ Write Sys\$Output F\$GetSyI(\"HW_MODEL\")` <= 1024;
+print "\$isvax: \\$isvax\\\n" if $debug;
+
+sub scan_var {
+ my($line) = @_;
+
+ print "\tchecking for global variable\n" if $debug;
+ $line =~ s/INIT\(.*\)//;
+ $line =~ s/\[.*//;
+ $line =~ s/=.*//;
+ $line =~ s/\W*;?\s*$//;
+ print "\tfiltered to \\$line\\\n" if $debug;
+ if ($line =~ /(\w+)$/) {
+ print "\tvar name is \\$1\\\n" if $debug;
+ $vars{$1}++;
+ }
+}
+
+sub scan_func {
+ my($line) = @_;
+
+ print "\tchecking for global routine\n" if $debug;
+ if ( /(\w+)\s+\(/ ) {
+ print "\troutine name is \\$1\\\n" if $debug;
+ if ($1 eq 'main' || $1 eq 'perl_init_ext') {
+ print "\tskipped\n" if $debug;
+ }
+ else { $funcs{$1}++ }
+ }
+}
+
+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 $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;
+ &scan_func($_);
+ if (/^EXT/) { &scan_var($_); }
+ last LINE unless $_ = <CPP>;
+ }
+ print "vmsish.h>> $_" if $debug;
+ if (/^EXT/) { &scan_var($_); }
+ last LINE unless $_ = <CPP>;
+ }
+ while (/^#.*opcode\.h/i .. /^#.*perl\.h/i) {
+ print "opcode.h>> $_" if $debug;
+ if (/^OP \*\s/) { &scan_func($_); }
+ if (/^EXT/) { &scan_var($_); }
+ last LINE unless $_ = <CPP>;
+ }
+ while (/^#.*proto\.h/i .. /^#.*perl\.h/i) {
+ print "proto.h>> $_" if $debug;
+ &scan_func($_);
+ if (/^EXT/) { &scan_var($_); }
+ last LINE unless $_ = <CPP>;
+ }
+ print $_ if $debug;
+ if (/^EXT/) { &scan_var($_); }
+}
+close CPP;
+while (<DATA>) {
+ next if /^#/;
+ s/\s+#.*\n//;
+ ($key,$array) = split('=',$_);
+ print "Adding $key to \%$array list\n" if $debug;
+ ${$array}{$key}++;
+}
+
+# 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(OPTSYM,">${dir}perlshr_sym.opt")
+ or die "$0: Can't write to ${dir}perlshr_sym.opt: $!\n";
+open(OPTATTR,">${dir}perlshr_attr.opt")
+ or die "$0: Can't write to ${dir}perlshr_attr.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 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";
+ if ($isvax) { print OPTSYM "UNIVERSAL=$var\n"; }
+ else { print OPTSYM "SYMBOL_VECTOR=($var=DATA)\n"; }
+ if ($isvax) {
+ 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";
+ $count = 0;
+ }
+ # This hack brought to you by the lack of a globaldef in gcc.
+ 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 %funcs) {
+ if ($isvax) {
+ print MAR "\t.transfer $func\n";
+ print MAR "\t.mask $func\n";
+ print MAR "\tjmp L\^${func}+2\n";
+ }
+ else { print OPTSYM "SYMBOL_VECTOR=($func=PROCEDURE)\n"; }
+}
+
+close OPTSYM;
+close OPTATTR;
+if ($isvax) {
+ print MAR "\t.end\n";
+ close MAR;
+ open (GBLOPT,">PerlShr_Gbl.Opt") or die "$0: Can't write to PerlShr_Gbl.Opt: $!\n";
+ $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 "\$ Set Verify\n";
+ do {
+ print GBLOPT "PerlShr_Gbl${marord}$objsuffix\n";
+ print DRVR "\$ Macro/NoDebug/Object=PerlShr_Gbl${marord}$objsuffix PerlShr_Gbl$marord.Mar\n";
+ } while (--$marord);
+ print DRVR "\$ old_proc_vfy = F\$Verify(old_proc_vfy,old_img_vfy)\n";
+ close DRVR;
+ close GBLOPT;
+ exec "\$ \@$drvrname";
+}
+__END__
+
+# Oddball cases, so we can keep the perl.h scan above simple
+error=vars # declared in perl.h only when DOINIT defined by INTERN.h
+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/vms/genconfig.pl b/vms/genconfig.pl
new file mode 100644
index 0000000000..18bc9851db
--- /dev/null
+++ b/vms/genconfig.pl
@@ -0,0 +1,112 @@
+#!/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.
+#
+# Rev. 30-Sep-1994 Charles Bailey bailey@genetics.upenn.edu
+#
+
+unshift(@INC,'lib'); # In case someone didn't define Perl_Root
+ # before the build
+require 'ctime.pl' || die "Couldn't execute ctime.pl: $!\n";
+
+if (-f "config.vms") { $infile = "config.vms"; $outdir = "[-]"; }
+elsif (-f "[.vms]config.vms") { $infile = "[.vms]config.vms"; $outdir = "[]"; }
+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";
+select OUT;
+
+
+$time = &ctime(time());
+print <<EndOfIntro;
+# This file generated by GenConfig.pl on a VMS system.
+# Input obtained from:
+# $infile
+# $0
+# Time: $time
+
+EndOfIntro
+
+while (<IN>) { # roll through the comment header in Config.VMS
+ last if /^#define _config_h_/;
+}
+
+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/;
+ $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 "$token=\'$val\'\n"; }
+ else {
+ $token = "d_$token" unless $token =~ /^i_/;
+ print "$token=\'$state\'\n"; }
+}
+close IN;
+
+while (<DATA>) {
+ next if /^\s*#/ or /^\s*$/;
+ s/#.*$//; s/\s*$//;
+ ($key,$val) = split('=',$_,2);
+ print "$key=\'$val\'\n";
+}
+
+__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.
+osname=VMS # DO NOT CHANGE THIS! Tests elsewhere depend on this to identify
+ # VMS. Use the 'arch' item below to specify hardware version.
+CONFIG=true
+PATCHLEVEL=0
+dldir=/ext/dl
+dlobj=dl_vms.obj
+dlsrc=dl_vms.c
+so=exe
+dlext=exe
+libpth=/sys$share /sys$library
+hintfile=
+intsize=4
+alignbytes=8
+shrplib=define
+signal_t=void
+timetype=long
+usemymalloc=n
+builddir=perl_root:[000000]
+
+# The definitions in this block are site-specific, and will probably need to
+# be changed on most systems.
+myhostname=nowhere.loopback.edu
+arch=VAX
+osvers=5.5-2
+cppflags=/Define=(DEBUGGING)
+d_vms_do_sockets=undef #=define if perl5 built with socket support
+d_has_sockets=undef # This should have the same value as d_vms_do_sockets
+libs= # This should list RTLs other than the C RTL and IMAGELIB (e.g. socket RTL)
diff --git a/vms/genopt.com b/vms/genopt.com
new file mode 100644
index 0000000000..70013aec42
--- /dev/null
+++ b/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/vms/makefile. b/vms/makefile.
new file mode 100644
index 0000000000..bc5a58c46f
--- /dev/null
+++ b/vms/makefile.
@@ -0,0 +1,764 @@
+#> 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 30-Sep-1994 by Charles Bailey bailey@genetics.upenn.edu
+#
+#
+# tidy -- purge files generated by executing this file
+# clean -- remove all files generated by executing this file
+# cleansrc -- `clean' + purge *.c,*.h,Makefile.
+# gcc_cld_setup -- GCC initialization; see above
+# 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 executable images
+# File type to use for object files
+O = .obj
+# File type to use for executable images
+E = .exe
+
+# used to incorporate 'custom' malloc routines
+mallocsrc =
+mallocobj =
+
+# We need separate MACRO files declaring global symbols
+SYMOPT = ,perlshr_gbl.opt/Option
+
+.first:
+ @ If f$$TrnLnm("Sys").eqs."" Then Define/NoLog SYS sys$$Library
+XTRAOBJS =
+LIBS1 = $(XTRAOBJS)
+DBGSPECFLAGS = /Show=(Source,Include,Expansion)
+XTRACCFLAGS = /Include=[]/Object=$(O)
+XTRADEF =
+LIBS2 = sys$$Share:VAXCRTL.Exe/Shareable
+
+DBGCCFLAGS = /NoList
+DBGLINKFLAGS = /NoMap
+DBG =
+
+# Process option macros
+# 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 =
+
+# DEBUGGING ==> perl -D, not the VMS debugger
+CFLAGS = /Define=(DEBUGGING$(SOCKDEF)$(XTRADEF))$(XTRACCFLAGS)$(DBGCCFLAGS)
+LINKFLAGS = $(DBGLINKFLAGS)
+
+MAKEFILE = [.VMS]Makefile. # this file
+NOOP = continue
+
+XSUBPP = MCR sys$$Disk:[]Miniperl$(E) [.ext]xsubpp -typemap [-]typemap
+# List of extensions to build into perlmain; enclose each in quotes and
+# separate by spaces.
+EXT = "DynaLoader"
+# Source and object files for these extensions; leading comma is required
+# These must be built separately, or you must add rules below to build them
+extobj = , [.ext.dynaloader]dl_vms$(O)
+
+#### 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 $(mallocsrc)
+c2 = mg.c, perly.c, pp.c, pp_ctl.c, pp_hot.c, pp_sys.c, regcomp.c, regexec.c
+c3 = gv.c, sv.c, taint.c, toke.c, util.c, deb.c, run.c, vms.c $(SOCKCLIS)
+
+c = $(c1), $(c2), $(c3), perl.c, miniperlmain.c, perlmain.c
+
+obj1 = av$(O), scope$(O), op$(O), doop$(O), doio$(O), dump$(O), hv$(O) $(mallocobj)
+obj2 = mg$(O), perly$(O), pp$(O), pp_ctl$(O), pp_hot$(O), pp_sys$(O), regcomp$(O), regexec$(O)
+obj3 = gv$(O), sv$(O), taint$(O), toke$(O), util$(O), deb$(O), run$(O), vms$(O) $(SOCKOBJ)
+
+obj = $(obj1), $(obj2), $(obj3)
+
+CRTL = []crtl.opt
+CRTLOPTS =,$(CRTL)/Options
+
+.suffixes:
+.suffixes: $(O) .c
+
+.c$(O) :
+ $(CC) $(CFLAGS) $<
+
+all : base extras
+ @ $(NOOP)
+base : $(DBG)miniperl$(E) perl$(E) [.lib]Config.pm
+ @ $(NOOP)
+extras : [.lib]DynaLoader.pm
+ @ $(NOOP)
+
+miniperl_objs = miniperlmain$(O), perl$(O), $(obj)
+miniperl$(E) : $(miniperl_objs) , coreobjs.opt $(CRTL)
+ Link $(LINKFLAGS)/NoDebug/Exe=$@ miniperlmain$(O), perl$(O), coreobjs.opt/Option $(CRTLOPTS)
+
+# Use an options file to list object files since some Makes don't feed
+# long lines to DCL properly
+coreobjs.opt : $(MAKEFILE)
+ @ $$@[.vms]genopt "$@/Write" "|" "$(obj1)"
+ @ $$@[.vms]genopt "$@/Append" "|" "$(obj2)"
+ @ $$@[.vms]genopt "$@/Append" "|" "$(obj3)"
+
+perlmain.c : miniperlmain.c miniperl$(E)
+ MCR sys$$Disk:[]Miniperl$(E) [.VMS]Writemain.pl $(EXT)
+
+perl$(E) : perlmain$(O) $(extobj), perlshr$(E), perlshr_attr.opt $(CRTL)
+ @ $$@[.vms]genopt "PerlShr.Opt/Write" "|" "''f$$Environment("Default")'$(DBG)PerlShr$(E)/Share"
+ Link $(LINKFLAGS)/Exe=$(DBG)$@ perlmain$(O) $(extobj),[]perlshr.opt/Option,perlshr_attr.opt/Option
+shr_objs = perlshr$(O) ,perl$(O), $(obj)
+perlshr$(E) : $(shr_objs) ,perlshr_xtras.ts ,coreobjs.opt ,$(CRTL)
+ Link $(LINKFLAGS)/Share/Exe=$(DBG)$@ perlshr$(O), perl$(O), coreobjs.opt/Option $(SYMOPT) , perlshr_attr.opt/Option, perlshr_sym.opt/Option $(CRTLOPTS)
+perlshr$(O) : [.vms]perlshr.c
+ $(CC) $(CFLAGS)/NoOptimize/Object=$@ [.vms]perlshr.c
+# The following files are built in one go by gen_shrfls.pl:
+# perlshr_attr.opt, perlshr_sym.opt - VAX and AXP
+# perlshr_gbl*.mar, perlshr_gbl*$(O), perlshr_gbl.opt - VAX only
+# 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.
+perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl miniperl$(E) $(MAKEFILE)
+ MCR sys$$Disk:[]Miniperl$(E) [.vms]gen_shrfls.pl "$(CC)$(CFLAGS)" $(O)
+ @ Copy NLA0: perlshr_xtras.ts
+ @ Purge/NoLog/NoConfirm perlshr_xtras.ts
+
+[.lib]config.pm : [.vms]config.vms [.vms]genconfig.pl miniperl$(E)
+ MCR sys$$Disk:[]Miniperl$(E) [.VMS]GenConfig.Pl
+ MCR sys$$Disk:[]Miniperl$(E) ConfigPM.
+
+[.ext.dynaloader]dl_vms.c : [.ext.dynaloader]dl_vms.xs miniperl$(E)
+ $(XSUBPP) [.ext.dynaloader]dl_vms.xs >$@
+
+[.ext.dynaloader]dl_vms$(O) : [.ext.dynaloader]dl_vms.c
+ $(CC) $(CFLAGS) /Object=$@ [.ext.dynaloader]dl_vms.c
+
+preplibrary : miniperl$(E) [.lib]Config.pm
+ @ Create/Directory [.lib.auto]
+ MCR sys$$Disk:[]Miniperl$(E) "-Ilib" -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]*.pm [.lib.*]*.pm
+
+[.lib]DynaLoader.pm : [.ext.dynaloader]dynaloader.pm preplibrary
+ Copy/Log/NoConfirm [.ext.dynaloader]dynaloader.pm [.lib]DynaLoader.pm
+ MCR sys$$Disk:[]Miniperl$(E) autosplit DynaLoader
+
+
+#opcode.h : opcode.pl
+# MCR Sys$Disk:[]Miniperl$(E) opcode.pl
+
+perly.h : perly.c # Quick and dirty 'touch'
+ Copy/Log/NoConfirm perly.h; ;
+ Delete/Log/NoConfirm perly.h;-1
+
+# I now supply perly.c with the kits, so the following section is
+# commented out if you don't have byacc.
+
+# perly.c:
+# @ echo 'Expect' 80 shift/reduce and 62 reduce/reduce conflicts
+# \$(BYACC) -d perly.y
+# sh \$(shellflags) ./perly.fixer y.tab.c perly.c
+# mv y.tab.h perly.h
+# echo 'extern YYSTYPE yylval;' >>perly.h
+
+perly$(O) : perly.c, perly.h, $(h)
+ $(CC) $(CFLAGS) perly.c
+
+test : perl$(E)
+ - @[.VMS]Test.Com
+
+# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
+# If this runs make out of memory, delete /usr/include lines.
+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) : 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) : 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) : 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) : 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) : 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) : 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) : 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
+malloc$(O) : EXTERN.h
+malloc$(O) : av.h
+malloc$(O) : config.h
+malloc$(O) : cop.h
+malloc$(O) : cv.h
+malloc$(O) : embed.h
+malloc$(O) : form.h
+malloc$(O) : gv.h
+malloc$(O) : handy.h
+malloc$(O) : hv.h
+malloc$(O) : malloc.c
+malloc$(O) : mg.h
+malloc$(O) : op.h
+malloc$(O) : opcode.h
+malloc$(O) : perl.h
+malloc$(O) : pp.h
+malloc$(O) : proto.h
+malloc$(O) : regexp.h
+malloc$(O) : scope.h
+malloc$(O) : sv.h
+malloc$(O) : vmsish.h
+malloc$(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) : 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
+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.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) : 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
+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) : 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) : 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) : 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) : 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) : 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) : 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) : 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) : 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) : INTERN.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) : 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) : INTERN.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) : 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
+
+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("*.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("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("[.Lib.Auto...]*.al;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Auto...]*.al
+ - If f$$Search("[.Lib.Auto...]autosplit.ts;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Auto...]autosplit.ts
+
+clean : tidy
+ - If f$$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_Attr.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("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;*
+
+realclean : clean
+ - If f$$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);*
+ - If f$$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*
+ - If f$$Search("[.Lib.Auto...]*.al;-1").nes."" Then Delete/NoConfirm/Log [.Lib.Auto...]*.al;*
+ - If f$$Search("[.Lib.Auto...]autosplit.ts;-1").nes."" Then Delete/NoConfirm/Log [.Lib.Auto...]autosplit.ts;*
+
+cleansrc : clean
+ - If f$$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);*
+ - 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("$(MAKEFILE);-1").nes."" Then Purge/NoConfirm/Log $(MAKEFILE)
+ - 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("[.Lib.Auto...]*.al").nes."" Then Delete/NoConfirm/Log [.Lib.Auto...]*.al;*
+ - If f$$Search("[.Lib.Auto...]autosplit.ts;").nes."" Then Delete/NoConfirm/Log [.Lib.Auto...]autosplit.ts;*
+ - If f$$Search("[.Lib]Config.pm;").nes."" Then Delete/NoConfirm/Log [.Lib]Config.pm;*
diff --git a/vms/mms2make.pl b/vms/mms2make.pl
new file mode 100644
index 0000000000..54db616c86
--- /dev/null
+++ b/vms/mms2make.pl
@@ -0,0 +1,102 @@
+#!/usr/bin/perl
+#
+# mms2make.pl - convert Descrip.MMS file to Makefile
+# Version 2.0 29-Sep-1994
+# 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]
+
+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 = "\$<" }
+ }
+
+ 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/vms/perlshr.c b/vms/perlshr.c
new file mode 100644
index 0000000000..92e6d44cf5
--- /dev/null
+++ b/vms/perlshr.c
@@ -0,0 +1,13 @@
+/* perlshr.c
+ *
+ * Small stub to create object module containing global variables
+ * for use in PerlShr.C. Written as a separate file because some
+ * old Make implementations won't deal correctly with DCL Open/Write
+ * statements in the makefile.
+ *
+ */
+
+#include "INTERN.h"
+#include "perl.h"
+
+/* That's it. */
diff --git a/vms/perlvms.pod b/vms/perlvms.pod
new file mode 100644
index 0000000000..77ec503f61
--- /dev/null
+++ b/vms/perlvms.pod
@@ -0,0 +1,264 @@
+=head1 Notes on Perl5 for VMS
+
+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 thatn it does under Unix,
+and on teh interactions between perl and the rest of the
+operating system. We haven't tried to duplicate complete
+descriptions of perl5 features from the main perl
+documentation, which can be found in the F<[.pod]>
+subdirectory of the perl 5 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.
+
+=head2 Installation
+
+Directions for building and installing perl 5 can be found in
+the file F<ReadMe.VMS> in the main source directory of the
+perl5 distribution..
+
+=head2 File specifications
+
+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
+specfication. Filenames are, of course, still case-
+insensitive. For consistency, most perl5 routines return
+filespecs using lower case latters only, regardless of the
+case used in the arguments passed to them. (This is true
+only when running under VMS; perl5 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, 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 Command line redirection
+
+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> wrtits 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 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.
+
+=head2 Wildcard expansion
+
+File specifications containing wildcards are allowed both on
+the command line and within perl globs (e.g. <C<*.c>>). 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 the file version only
+if one was present in the input filespec.
+
+=head2 %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. In addition, the keys C<home>,
+C<path>,C<term>, and C<user> return the CRTL "environment
+variables" of the same names. The key C<default> returns the
+current default device and directory specification.
+
+Setting an element of %ENV defines a supervisor-mode logical
+name in the process logical name table. B<Undef>ing or
+B<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 B<undef>, the %ENV element remains
+empty. If you use B<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.
+
+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.
+
+=head2 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, defined, delete, die, do,
+ each, eof, eval, exec*, exists, exit, exp, fileno,
+ fork*, getc, glob, goto, grep, hex, import, index,
+ int, join, keys, kill, last, lc, lcfirst, length,
+ local, localtime, log, m//, map, mkdir, my, next,
+ no, oct, open, opendir, ord, pack, pipe, pop, pos,
+ print, printf, push, q//, qq//, qw//, qx//,
+ quotemeta, rand, read, readdir, redo, ref, rename,
+ require, reset, return, reverse, rewinddir, rindex,
+ rmdir, s///, scalar, seek, seekdir, select(internal)*,
+ 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, values, vec, wait, 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, crypt, dbmclose, dbmopen, dump, fcntl,
+ flock, getlogin, getpgrp, getppid, getpriority,
+ getpwent, getgrent, kill, getgrgid, getgrnam,
+ getpwnam, getpwuid, setpwent, setgrent,
+ endpwent, endgrent, gmtime, ioctl, link, lstst,
+ msgctl, msgget, msgsend, msgrcv, readlink,
+ select(system call), semctl, semget, semop,
+ setpgrp, setpriority, shmctl, shmget, shmread,
+ shmwrite, socketpair, symlink, syscall, truncate,
+ utime, waitpid
+
+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, send, setsockopt,
+ shutdown, socket
+
+
+=item File tests
+
+The tests -b, -B, -c, -C, -d, -e, -f, -o, -M, -s, -S, -t, -T,
+and -z work as advertised. The return values for -r, -w, and
+-x tell you whether you can actually access the file; this
+may mot reflect the UIC-based file protections. Since real
+and effective UIC don't differ under VMS, -O, -R, -W, and -X
+are equivalent to -o, -r, -w, and -x. Similarly, several
+other tests, including -A, -g, -k, -l,-p, and -u, aren't
+particularly meaningful under VMS, and the values returned by
+these tests reflect whatever your CRTL stat() routine does to
+the equivalent bits in the st_mode field.
+
+=item binmode
+
+The B<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 exec
+
+The B<exec> operator behaves in one of two different ways.
+If called after a call to B<fork>, it will invoke the CRTL
+L<execv()> routine, passing its arguments to the subprocess
+created by B<fork> for execution. In this case, it is
+subject to all limitation that affect L<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 B<exec> does not follow a call to B<fork>, it
+will cause perl to exit, and to invoke the command given as
+an argument to B<exec> via 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 B<exec>'s argument to it as parameters.
+
+You can use B<exec> in both ways within the same script, as
+long as you call B<fork> and B<exec> in pairs. Perl only
+keeps track of whether B<fork> has been called since the last
+call to B<exec> when figuring out what to do, so multiple
+calls to B<fork> do not generate multiple levels of "fork
+context".
+
+=item fork
+
+The B<fork> operator works in the same way as the CRTL
+L<fork()> routine, which is quite different under VMS than
+under Unix. Sepcifically, while B<fork> returns 0 after it
+is called and the subprocess PID after B<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 B<exec>.
+
+In general, the use of B<fork> and B<exec> to create
+subprocess is not recommended under VMS; wherever possible,
+use the B<system> operator or piped filehandles instead.
+
+=item system
+
+The B<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 lib$spawn, any
+valid DCL command string may be specified. Perl waits for
+the subprocess to complete before continuing execution in the
+current process.
+
+=item times
+
+The array returned by the B<times> operator is divided up
+according to the same rules the CRTL L<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.
+
+=head2 Revision date
+
+This document was last updated on 16-Oct-1994, for perl 5,
+patchlevel 0.
diff --git a/vms/sockadapt.c b/vms/sockadapt.c
new file mode 100644
index 0000000000..fc42bcc5a4
--- /dev/null
+++ b/vms/sockadapt.c
@@ -0,0 +1,43 @@
+/* sockadapt.c
+ *
+ * Author: Charles Bailey bailey@genetics.upenn.edu
+ * Last Revised: 05-Oct-1994
+ *
+ * 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.9A TCP/IP support.
+ */
+
+#include "sockadapt.h"
+
+#ifdef __STDC__
+#define STRINGIFY(a) #a /* config-skip */
+#else
+#define STRINGIFY(a) "a" /* config-skip */
+#endif
+
+#define FATALSTUB(func) \
+ void func() {\
+ croak("Function %s not implemented in this version of perl",\
+ STRINGIFY(func));\
+ }
+
+FATALSTUB(endhostent);
+FATALSTUB(endnetent);
+FATALSTUB(endprotoent);
+FATALSTUB(endservent);
+FATALSTUB(gethostent);
+FATALSTUB(getnetbyaddr);
+FATALSTUB(getnetbyname);
+FATALSTUB(getnetent);
+FATALSTUB(getprotobyname);
+FATALSTUB(getprotobynumber);
+FATALSTUB(getprotoent);
+FATALSTUB(getservent);
+FATALSTUB(sethostent);
+FATALSTUB(setnetent);
+FATALSTUB(setprotoent);
+FATALSTUB(setservent);
diff --git a/vms/sockadapt.h b/vms/sockadapt.h
new file mode 100644
index 0000000000..60890bddce
--- /dev/null
+++ b/vms/sockadapt.h
@@ -0,0 +1,54 @@
+/* sockadapt.h
+ *
+ * Authors: Charles Bailey bailey@genetics.upenn.edu
+ * David Denholm denholm@conmat.phys.soton.ac.uk
+ * Last Revised: 05-Oct-1994
+ *
+ * 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.9A TCP/IP support.
+ */
+
+#include <socketshr.h>
+
+/* we may not have socket.h etc, so lets just do these here - div */
+/* built up from a variety of sources */
+/* no harm doing this for all .c files - needed only by pp_sys.c */
+
+struct hostent {
+ char *h_name;
+ char *h_aliases;
+ int h_addrtype;
+ int h_length;
+ char **h_addr_list;
+};
+#define h_addr h_addr_list[0]
+
+struct sockaddr_in {
+ short sin_family;
+ unsigned short sin_port;
+ unsigned long sin_addr;
+ char sin_zero[8];
+};
+
+struct netent {
+ char *n_name;
+ char **n_aliases;
+ int n_addrtype;
+ long n_net;
+};
+
+struct servent {
+ char *s_name; /* official service name */
+ char **s_aliases; /* alias list */
+ int s_port; /* port # */
+ char *s_proto; /* protocol to use */
+};
+
+struct protoent {
+ char *p_name; /* official protocol name */
+ char **p_aliases; /* alias list */
+ int p_proto; /* protocol # */
+};
diff --git a/vms/test.com b/vms/test.com
new file mode 100644
index 0000000000..3e42a11474
--- /dev/null
+++ b/vms/test.com
@@ -0,0 +1,184 @@
+$! Test.Com - DCL driver for perl5 regression tests
+$!
+$! Version 1.0 30-Sep-1994
+$! Charles Bailey bailey@genetics.upenn.edu
+$
+$! A little basic setup
+$ On Error Then Goto wrapup
+$ olddef = F$Environment("Default")
+$ Set Default Perl_Root:[t]
+$
+$! 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 = "$Perl_Root:[T]Echo.Exe"
+$
+$! And do it
+$ MCR Sys$Disk:[]Perl.
+$ 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;
+
+#if ($ARGV[0] eq '-v') {
+ $verbose = 1;
+# shift;
+#}
+
+chdir 't' if -f 't/TEST';
+
+if ($ARGV[0] eq '') {
+ @files = split(/[ \n]/, `\$ dir/col=1/nohead/notrail [...]*.t;`);
+ foreach (@files) {
+ $fname = $_;
+ $fname =~ s/.*\]([\w\$\-]+\.T);.*/$1/;
+ 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);
+}
+
+$bad = 0;
+$good = 0;
+$total = @ARGV;
+while ($test = shift) {
+ if ($test =~ /^$/) {
+ next;
+ }
+ $te = $test;
+ chop($te);
+ print "$te" . '.' x (15 - length($te)) . "\n";
+ 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 $_;
+ }
+ 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 "ok\n";
+ $good = $good + 1;
+ } else {
+ $next += 1;
+ print "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/vms/vms.c b/vms/vms.c
new file mode 100644
index 0000000000..26aeecb4a5
--- /dev/null
+++ b/vms/vms.c
@@ -0,0 +1,2095 @@
+/* VMS-specific routines for perl5
+ *
+ * Last revised: 09-Oct-1994
+ */
+
+#include <acedef.h>
+#include <acldef.h>
+#include <armdef.h>
+#include <chpdef.h>
+#include <descrip.h>
+#include <dvidef.h>
+#include <float.h>
+#include <fscndef.h>
+#include <iodef.h>
+#include <jpidef.h>
+#include <libdef.h>
+#include <lib$routines.h>
+#include <lnmdef.h>
+#include <psldef.h>
+#include <rms.h>
+#include <shrdef.h>
+#include <ssdef.h>
+#include <starlet.h>
+#include <stsdef.h>
+#include <syidef.h>
+
+
+#include "EXTERN.h"
+#include "perl.h"
+
+struct itmlst_3 {
+ unsigned short int buflen;
+ unsigned short int itmcode;
+ void *bufadr;
+ unsigned long int retlen;
+};
+
+static unsigned long int sts;
+
+#define _cksts(call) \
+ if (!(sts=(call))&1) { \
+ errno = EVMSERR; vaxc$errno = sts; \
+ croak("fatal error at %s, line %d",__FILE__,__LINE__); \
+ } else { 1; }
+
+/* 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 short int eqvlen;
+ unsigned long int retsts, attr = LNM$M_CASE_BLIND;
+ $DESCRIPTOR(sysdiskdsc,"SYS$DISK");
+ $DESCRIPTOR(tabdsc,"LNM$FILE_DEV");
+ struct dsc$descriptor_s lnmdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,uplnm},
+ eqvdsc = {sizeof __my_getenv_eqv,DSC$K_DTYPE_T,
+ DSC$K_CLASS_S, __my_getenv_eqv};
+ struct itmlst_3 lnmlst[2] = {sizeof __my_getenv_eqv - 1, LNM$_STRING,
+ __my_getenv_eqv, &eqvlen, 0, 0, 0, 0};
+
+ for (cp1 = lnm, cp2= uplnm; *cp1; cp1++, cp2++) *cp2 = _toupper(*cp1);
+ *cp2 = '\0';
+ lnmdsc.dsc$w_length = cp1 - lnm;
+ if (lnmdsc.dsc$w_length = 7 && !strncmp(uplnm,"DEFAULT",7)) {
+ _cksts(sys$trnlnm(&attr,&tabdsc,&sysdiskdsc,0,lnmlst));
+ eqvdsc.dsc$a_pointer += eqvlen;
+ eqvdsc.dsc$w_length = sizeof __my_getenv_eqv - eqvlen - 1;
+ _cksts(sys$setddir(0,&eqvlen,&eqvdsc));
+ eqvdsc.dsc$a_pointer[eqvlen] = '\0';
+ return __my_getenv_eqv;
+ }
+ else {
+ retsts = sys$trnlnm(&attr,&tabdsc,&lnmdsc,0,lnmlst);
+ if (retsts != SS$_NOLOGNAM) {
+ if (retsts & 1) {
+ __my_getenv_eqv[eqvlen] = '\0';
+ return __my_getenv_eqv;
+ }
+ _cksts(retsts);
+ }
+ else {
+ retsts = lib$get_symbol(&lnmdsc,&eqvdsc,&(eqvdsc.dsc$w_length),0);
+ if (retsts != LIB$_NOSUCHSYM) {
+ /* We want to return only logical names or CRTL Unix emulations */
+ if (retsts & 1) return Nullch;
+ _cksts(retsts);
+ }
+ else return getenv(lnm); /* Try for CRTL emulation of a Unix/POSIX name */
+ }
+ }
+ return NULL;
+
+} /* 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$_NOLOGNAM) _cksts(retsts);
+ if (!(retsts & 1)) {
+ retsts = lib$delete_logical(&lnmdsc,&tabdsc); /* then supervisor mode */
+ if (retsts != SS$_NOLOGNAM) _cksts(retsts);
+ }
+ }
+ else {
+ eqvdsc.dsc$w_length = strlen(eqv);
+ eqvdsc.dsc$a_pointer = eqv;
+
+ _cksts(lib$set_logical(&lnmdsc,&eqvdsc,&tabdsc,0,0));
+ }
+
+} /* end of my_setenv() */
+/*}}}*/
+
+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;
+ stat_t 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 uics[2] = {0,0}, 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 ace$b_length;
+ unsigned char ace$b_type;
+ unsigned short int ace$w_flags;
+ unsigned long int ace$l_access;
+ unsigned long int ace$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.
+ */
+ _cksts(lib$getjpi(&jpicode,0,0,&(oldace.ace$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.ace$l_ident = oldace.ace$l_ident;
+ if (!((aclsts = sys$change_acl(0,&type,&fildsc,lcklst,0,0,0)) & 1)) {
+ errno = EVMSERR;
+ 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) {
+ /* 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)) {
+ errno = EVMSERR;
+ vaxc$errno = aclsts;
+ return -1;
+ }
+
+ return rmsts;
+
+} /* end of kill_file() */
+/*}}}*/
+
+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.
+ */
+ _cksts(lib$getsyi(&syiitm, &mbxbufsiz, 0, 0, 0, 0));
+ if (mbxbufsiz > BUFSIZ) mbxbufsiz = BUFSIZ;
+ }
+ _cksts(sys$crembx(0,chan,mbxbufsiz,mbxbufsiz,0,0,0));
+
+ _cksts(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;
+ int pid;
+ unsigned long int completion;
+};
+
+static struct pipe_details *open_pipes = NULL;
+static $DESCRIPTOR(nl_desc, "NL:");
+static int waitpid_asleep = 0;
+
+static void
+popen_completion_ast(unsigned long int unused)
+{
+ if (waitpid_asleep) {
+ waitpid_asleep = 0;
+ sys$wake(0,0);
+ }
+}
+
+/*{{{ FILE *my_popen(char *cmd, char *mode)*/
+FILE *
+my_popen(char *cmd, char *mode)
+{
+ 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};
+
+
+ New(7001,info,1,struct pipe_details);
+
+ info->completion=0; /* I assume this will remain 0 until terminates */
+
+ /* create mailbox */
+ create_mbx(&chan,&namdsc);
+
+ /* open a FILE* onto it */
+ info->fp=fopen(mbxname, mode);
+
+ /* give up other channel onto it */
+ _cksts(sys$dassgn(chan));
+
+ if (!info->fp)
+ return Nullfp;
+
+ cmddsc.dsc$w_length=strlen(cmd);
+ cmddsc.dsc$a_pointer=cmd;
+
+ if (strcmp(mode,"r")==0) {
+ _cksts(lib$spawn(&cmddsc, &nl_desc, &namdsc, &flags,
+ 0 /* name */, &info->pid, &info->completion,
+ 0, popen_completion_ast,0,0,0,0));
+ }
+ else {
+ _cksts(lib$spawn(&cmddsc, &namdsc, 0 /* sys$output */,
+ 0 /* name */, &info->pid, &info->completion));
+ }
+
+ info->next=open_pipes; /* prepend to list */
+ open_pipes=info;
+
+ return info->fp;
+}
+/*}}}*/
+
+/*{{{ I32 my_pclose(FILE *fp)*/
+I32 my_pclose(FILE *fp)
+{
+ struct pipe_details *info, *last = NULL;
+ unsigned long int abort = SS$_TIMEOUT, 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("my_pclose() - no such pipe open ???");
+
+ if (!info->completion) { /* Tap them gently on the shoulder . . .*/
+ _cksts(sys$forcex(&info->pid,0,&abort));
+ sleep(1);
+ }
+ if (!info->completion) /* We tried to be nice . . . */
+ _cksts(sys$delprc(&info->pid));
+
+ fclose(info->fp);
+ /* remove from list of open pipes */
+ if (last) last->next = info->next;
+ else open_pipes = info->next;
+ retsts = info->completion;
+ Safefree(info);
+
+ return retsts;
+} /* end of my_pclose() */
+
+#ifndef HAS_WAITPID
+/* 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;
+ unsigned long int abort = SS$_TIMEOUT;
+
+ for (info = open_pipes; info != NULL; info = info->next)
+ if (info->pid == pid) break;
+
+ if (info != NULL) { /* we know about this child */
+ while (!info->completion) {
+ 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];
+
+ _cksts(lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0));
+ _cksts(lib$getjpi(&ownercode,0,0,&mypid,0,0));
+ if (ownerpid != mypid)
+ croak("pid %d not a child",pid);
+
+ _cksts(sys$bintim(&intdsc,interval));
+ while ((sts=lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0)) & 1) {
+ _cksts(sys$schdwk(0,0,interval,0));
+ _cksts(sys$hiber());
+ }
+ _cksts(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() */
+#endif
+/*}}}*/
+/*}}}*/
+/*}}}*/
+
+/*{{{ 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 static 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.
+ */
+
+/*{{{ 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;
+
+ if (dir == NULL) return NULL;
+
+ dirlen = strlen(dir);
+ if (!strpbrk(dir,"]:>")) { /* Unix-style path or plain dir name */
+ if (dir[dirlen-1] == '/') { /* path ends with '/'; just add .dir;1 */
+ dirlen -= 1; /* to last element */
+ lastdir = strrchr(dir,'/');
+ }
+ 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 */
+ errno = ENOTDIR; /* Bzzt. */
+ return NULL;
+ }
+ }
+ dirlen = cp2 - dir;
+ }
+ else { /* There's a type, and it's not .dir. Bzzt. */
+ errno = ENOTDIR;
+ 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+6,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;
+ unsigned long int sts, cmplen;
+ 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;
+ dirnam.nam$b_ess = NAM$C_MAXRSS;
+ dirnam.nam$l_esa = esa;
+ dirnam.nam$b_nop = NAM$M_SYNCHK;
+ if (!(sys$parse(&dirfab)&1)) {
+ errno = EVMSERR;
+ vaxc$errno = dirfab.fab$l_sts;
+ return NULL;
+ }
+ savnam = dirnam;
+ if (sys$search(&dirfab)&1) { /* Does the file really exist? */
+ /* Yes; fake the fnb bits so we'll check type below */
+ dirnam.nam$l_fnb |= NAM$M_EXP_TYPE | NAM$M_EXP_VER;
+ }
+ else {
+ if (dirfab.fab$l_sts != RMS$_FNF) {
+ errno = EVMSERR;
+ 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. */
+ errno = ENOTDIR;
+ return NULL;
+ }
+ else { /* Ok, it was .DIR[;1]; copy over everything up to the */
+ retlen = dirnam.nam$l_type - esa; /* file name. */
+ if (buf) retspec = buf;
+ else if (ts) New(7010,retspec,retlen+6,char);
+ else retspec = __fileify_retbuf;
+ strncpy(retspec,esa,retlen);
+ retspec[retlen] = '\0';
+ }
+ }
+ else {
+ /* They didn't explicitly specify the directory file. Ignore
+ any file names in the input, pull off the last element of the
+ directory path, and make it the file name. If you want to
+ pay attention to filenames without .dir in the input, just use
+ ".DIR;1" as a default filespec for the $PARSE */
+ esa[dirnam.nam$b_esl] = '\0';
+ 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+6,char);
+ else retspec = __fileify_retbuf;
+ strcpy(retspec,esa);
+ }
+ else { /* This is a top-level dir. Add the MFD to the path. */
+ if (buf) retspec = buf;
+ else if (ts) New(7012,retspec,retlen+14,char);
+ else retspec = __fileify_retbuf;
+ cp1 = esa;
+ cp2 = retspec;
+ while (*cp1 != ':') *(cp2++) = *(cp1++);
+ strcpy(cp2,":[000000]");
+ cp1 += 2;
+ strcpy(cp2+9,cp1);
+ }
+ }
+ /* Again, we've set up the string up through the filename. Add the
+ type and version, and we're done. */
+ strcat(retspec,".DIR;1");
+ 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;
+
+ if (dir == NULL) return NULL;
+
+ if (!strpbrk(dir,"]:>")) { /* Unix-style path or plain dir name */
+ if (!(cp1 = strrchr(dir,'/'))) cp1 = dir;
+ if (cp2 = strchr(cp1,'.')) {
+ 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. */
+ errno = ENOTDIR;
+ 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,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];
+ unsigned long int sts, cmplen;
+ 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;
+ dirnam.nam$b_ess = sizeof esa;
+ dirnam.nam$l_esa = esa;
+ dirnam.nam$b_nop = NAM$M_SYNCHK;
+ if (!(sys$parse(&dirfab)&1)) {
+ errno = EVMSERR;
+ vaxc$errno = dirfab.fab$l_sts;
+ return NULL;
+ }
+ savnam = dirnam;
+ if (sys$search(&dirfab)&1) { /* Does the file really exist? */
+ /* Yes; fake the fnb bits so we'll check type below */
+ dirnam.nam$l_fnb |= NAM$M_EXP_TYPE | NAM$M_EXP_VER;
+ }
+ else {
+ if (dirfab.fab$l_sts != RMS$_FNF) {
+ errno = EVMSERR;
+ 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. */
+ errno = ENOTDIR;
+ 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;
+ }
+ else {
+ /* There wasn't a type on the input, so ignore any file names as
+ well. If you want to pay attention to filenames without .dir
+ in the input, just use ".DIR;1" as a default filespec for
+ the $PARSE and set retlen thus
+ retlen = (dirnam.nam$b_rsl ? dirnam.nam$b_rsl : dirnam.nam$b_esl);
+ */
+ retlen = dirnam.nam$l_name - esa;
+ esa[retlen] = '\0';
+ }
+ if (buf) retpath = buf;
+ else if (ts) New(7014,retpath,retlen,char);
+ else retpath = __pathify_retbuf;
+ strcpy(retpath,esa);
+ }
+
+ 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;
+
+ if (spec == NULL || *spec == '\0') return NULL;
+ if (buf) rslt = buf;
+ else if (ts) New(7015,rslt,NAM$C_MAXRSS+1,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 != '[') {
+ *(cp1++) = '/';
+ }
+ else { /* the VMS spec begins with directories */
+ cp2++;
+ if (*cp2 == '-') {
+ while (*cp2 == '-') {
+ *(cp1++) = '.'; *(cp1++) = '.'; *(cp1++) = '/';
+ cp2++;
+ }
+ if (*cp2 != '.' && *cp2 != ']' && *cp2 != '>') { /* we don't allow */
+ if (ts) Safefree(rslt); /* filespecs like */
+ errno = EVMSERR; vaxc$errno = RMS$_SYN; /* [--foo.bar] */
+ return NULL;
+ }
+ cp2++;
+ }
+ else if ( *(cp2) != '.') { /* add the implied device into the Unix spec */
+ *(cp1++) = '/';
+ 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 = getenv(tmp)) != NULL) && strcpy(tmp,cp3));
+ cp3 = tmp;
+ while (*cp3) *(cp1++) = *(cp3++);
+ *(cp1++) = '/';
+ if ((devlen = strlen(tmp)) + (dirlen = strlen(cp2)) + 1 > NAM$C_MAXRSS) {
+ if (ts) Safefree(rslt);
+ errno = ERANGE;
+ return NULL;
+ }
+ }
+ else cp2++;
+ }
+ for (; cp2 <= dirend; cp2++) {
+ if (*cp2 == ':') {
+ *(cp1++) = '/';
+ if (*(cp2+1) == '[') cp2++;
+ }
+ else if (*cp2 == ']' || *cp2 == '>') *(cp1++) = '/';
+ else if (*cp2 == '.') {
+ *(cp1++) = '/';
+ while (*(cp2+1) == ']' || *(cp2+1) == '>' ||
+ *(cp2+1) == '[' || *(cp2+1) == '<') cp2++;
+ }
+ 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 */
+ errno = EVMSERR; vaxc$errno = RMS$_SYN; /* [--foo.bar] */
+ return NULL;
+ }
+ cp2++;
+ }
+ 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, *cp1, *cp2;
+
+ if (path == NULL || *path == '\0') return NULL;
+ if (buf) rslt = buf;
+ else if (ts) New(7016,rslt,strlen(path)+1,char);
+ else rslt = __tovmsspec_retbuf;
+ if (strchr(path,']') != NULL || strchr(path,'>') != NULL ||
+ (dirend = strrchr(path,'/')) == NULL) {
+ strcpy(rslt,path);
+ return rslt;
+ }
+ cp1 = rslt;
+ cp2 = path;
+ if (*cp2 == '/') {
+ while (*(++cp2) != '/' && *cp2) *(cp1++) = *cp2;
+ *(cp1++) = ':';
+ *(cp1++) = '[';
+ cp2++;
+ }
+ else {
+ *(cp1++) = '[';
+ *(cp1++) = '.';
+ }
+ for (; cp2 < dirend; cp2++) *(cp1++) = (*cp2 == '/') ? '.' : *cp2;
+ *(cp1++) = ']';
+ cp2++;
+ 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 || *path == '\0') 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,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 || *path == '\0') 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,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 */
+ stat_t statbuf; /* fstat buffer */
+
+ /*
+ * 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[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)
+ {
+ errno = EINVAL;
+ croak("No input file");
+ }
+ in = argv[++j];
+ continue;
+ }
+ if ('<' == *(ap = argv[j]))
+ {
+ in = 1 + ap;
+ continue;
+ }
+ if (0 == strcmp(">", ap))
+ {
+ if (j+1 >= argc)
+ {
+ errno = EINVAL;
+ croak("No input file");
+ }
+ 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)
+ {
+ errno = EINVAL;
+ croak("No output file");
+ }
+ 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 = 1 + ap;
+ if (j >= argc)
+ {
+ errno = EINVAL;
+ croak("No error file");
+ }
+ continue;
+ }
+ if (0 == strcmp("|", argv[j]))
+ {
+ if (j+1 >= argc)
+ {
+ errno = EPIPE;
+ croak("No command into which to pipe");
+ }
+ 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)
+ {
+ errno = EINVAL;
+ croak("'|' and '>' may not both be specified on command line");
+ }
+ pipe_and_fork(cmargv);
+ }
+
+ /* Check for input from a pipe (mailbox) */
+
+ if (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. */
+
+ if (in != NULL)
+ {
+ errno = EINVAL;
+ croak("'|' and '<' may not both be specified on command line");
+ }
+ fgetname(stdin, mbxname);
+ 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';
+ errno = 0;
+ freopen(mbxname, "rb", stdin);
+ if (errno != 0)
+ {
+ croak("Error reopening pipe (name: %s) in binary mode",mbxname);
+ }
+ }
+ if ((in != NULL) && (NULL == freopen(in, "r", stdin, "mbc=32", "mbf=2")))
+ {
+ croak("Can't open input file %s",in);
+ }
+ if ((out != NULL) && (NULL == freopen(out, outmode, stdout, "mbc=32", "mbf=2")))
+ {
+ croak("Can't open output file %s",out);
+ }
+ if ((err != NULL) && (NULL == freopen(err, errmode, stderr, "mbc=32", "mbf=2")))
+ {
+ croak("Can't open error file %s",err);
+ }
+#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;
+int context = 0;
+int isunix = 0;
+int status;
+int status_value;
+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;
+
+ 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 = strchr(item,'/'))
+ 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&lib$find_file(&filespec, &resultspec, &context,
+ &defaultspec, 0, &status_value, &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(item,string);
+ add_item(head, tail, string, count);
+ ++expcount;
+ }
+ if (expcount == 0)
+ add_item(head, tail, item, count);
+ lib$sfree1_dd(&resultspec);
+ lib$find_file_end(&context);
+}
+
+static int child_st[2];/* Event Flag set when child process completes */
+
+static short child_chan;/* I/O Channel for Pipe Mailbox */
+
+static 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
+ {
+ struct exit_control_block *flink;
+ int (*exit_routine)();
+ int arg_count;
+ int *status_address;
+ int exit_status;
+ } 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);
+ short iosb[4];
+ int status;
+ int pid, j;
+ short dvi_item = DVI$_DEVNAM;
+ 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
+ if (0 == (1&(vaxc$errno = lib$spawn(&cmddsc, &mbxdsc, 0, &one,
+ 0, &pid, child_st, &zero, sig_child,
+ &child_chan))))
+ {
+ errno = EVMSERR;
+ croak("Can't spawn subprocess");
+ }
+#ifdef ARGPROC_DEBUG
+ fprintf(stderr, "Subprocess's Pid = %08X\n", pid);
+#endif
+ sys$dclexh(&exit_block);
+ if (NULL == freopen(mbxname, "wb", stdout))
+ {
+ croak("Can't open pipe mailbox for output");
+ }
+}
+
+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;
+
+ 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);
+ if (0 == (1&(vaxc$errno = lib$set_symbol(&cmd, &value))))
+ {
+ errno = EVMSERR;
+ croak("Can't create symbol for subprocess command");
+ }
+ if ((0 == (1&(vaxc$errno = lib$spawn(&cmd, &null, 0, &flags, 0, &pid)))) &&
+ (vaxc$errno != 0x38250))
+ {
+ errno = EVMSERR;
+ croak("Can't spawn subprocess");
+ }
+ if (vaxc$errno == 0x38250) /* We must be BATCH, so retry */
+ if (0 == (1&(vaxc$errno = lib$spawn(&cmd, &null, 0, &one, 0, &pid))))
+ {
+ errno = EVMSERR;
+ croak("Can't spawn subprocess");
+ }
+#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 *****/
+
+/*
+ * 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)
+ */
+
+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 != ':');
+}
+
+/*{{{ 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)) return -1;
+ return flex_stat(fspec,statbuf);
+
+} /* end of flex_fstat() */
+/*}}}*/
+
+/*{{{ int flex_stat(char *fspec, struct stat *statbufp)*/
+flex_stat(char *fspec, struct stat *statbufp)
+{
+ char fileified[NAM$C_MAXRSS+1];
+ int retval,myretval;
+ struct stat tmpbuf;
+
+
+ if (statbufp == &statcache) strcpy(namecache,fspec);
+ if (is_null_device(fspec)) { /* Fake a stat() for the null device */
+ memset(statbufp,0,sizeof *statbufp);
+ statbufp->st_dev = "_NLA0:";
+ statbufp->st_mode = S_IFBLK | S_IREAD | S_IWRITE | S_IEXEC;
+ statbufp->st_uid = 0x00010001;
+ statbufp->st_gid = 0x0001;
+ time(&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,&tmpbuf);
+ }
+ retval = stat(fspec,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);
+ }
+ }
+ return retval;
+
+} /* end of flex_stat() */
+/*}}}*/
+
+/* 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.
+ *
+ * Returns !=0 on success, 0 on failure.
+ */
+/*{{{int trim_unixpath(char *template, char *fspec)*/
+int
+trim_unixpath(char *template, char *fspec)
+{
+ char unixified[NAM$C_MAXRSS+1], *base, *cp1, *cp2;
+ register int tmplen;
+
+ if (strpbrk(fspec,"]>:") != NULL) {
+ if (do_tounixspec(fspec,unixified,0) == NULL) return 0;
+ else base = unixified;
+ }
+ else base = fspec;
+ for (cp2 = base; *cp2; cp2++) ; /* Find end of filespec */
+
+ /* 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--;
+ if (cp1 == template) return 1; /* Wildcard was up front - no prefix to clip */
+ tmplen = cp1 - template;
+
+ /* Try to find template prefix on filespec */
+ if (!memcmp(base,template,tmplen)) return 1; /* Nothing before prefix - we're done */
+ 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 '/' */
+ /* Copy down remaining portion of filespec, including trailing NUL */
+ memmove(fspec,base,cp2 - base + 1);
+ return 1;
+
+} /* end of trim_unixpath() */
+/*}}}*/
+
+/* 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)
+{
+ unsigned long int objtyp = ACL$C_FILE, access, retsts;
+ unsigned short int retlen;
+ struct dsc$descriptor_s namdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, namecache};
+ static char usrname[L_cuserid];
+ static struct dsc$descriptor_s usrdsc =
+ {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, usrname};
+ struct itmlst_3 armlst[2] = {sizeof access, CHP$_ACCESS, &access, &retlen,
+ 0, 0, 0, 0};
+
+ if (!usrdsc.dsc$w_length) {
+ cuserid(usrname);
+ usrdsc.dsc$w_length = strlen(usrname);
+ }
+ namdsc.dsc$w_length = strlen(namecache);
+ 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_READ;
+ break;
+ default:
+ return FALSE;
+ }
+
+ retsts = sys$check_access(&objtyp,&namdsc,&usrdsc,armlst);
+ if (retsts == SS$_NORMAL) return TRUE;
+ if (retsts == SS$_NOPRIV) return FALSE;
+ _cksts(retsts);
+
+ return FALSE; /* Should never get here */
+
+} /* end of cando() */
+/*}}}*/
+
+/*
+ * 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;
+ _cksts(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;
+ }
+
+ _cksts(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];
+ int i;
+ 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;
+ dd->count++;
+ tmpsts = lib$find_file(&dd->pat, &res, &dd->context);
+ if ( tmpsts == RMS$_NMF || dd->context == 0) return NULL; /* None left. */
+
+ /* 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;
+ unsigned long int tmpsts;
+
+ /* 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;
+ _cksts(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 = 1;
+ return vfork();
+}
+/*}}}*/
+
+static void
+setup_argstr(SV *really, SV **mark, SV **sp, char **argstr)
+{
+ char *tmps, *junk;
+ register size_t cmdlen = 0;
+ size_t rlen;
+ register SV **idx;
+
+ idx = mark;
+ if (really && *(tmps = SvPV(really,rlen))) {
+ cmdlen += rlen + 1;
+ idx++;
+ }
+
+ for (idx++; idx <= sp; idx++) {
+ if (*idx) {
+ junk = SvPVx(*idx,rlen);
+ cmdlen += rlen ? rlen + 1 : 0;
+ }
+ }
+ New(401,*argstr,cmdlen, char);
+
+ if (*tmps) {
+ strcpy(*argstr,tmps);
+ mark++;
+ }
+ else **argstr = '\0';
+ while (++mark <= sp) {
+ if (*mark) {
+ strcat(*argstr," ");
+ strcat(*argstr,SvPVx(*mark,na));
+ }
+ }
+
+} /* end of setup_argstr() */
+
+static unsigned long int
+setup_cmddsc(char *cmd, struct dsc$descriptor_s *cmddsc, 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. */
+ cmddsc->dsc$a_pointer = cmd;
+ cmddsc->dsc$w_length = strlen(cmd);
+ }
+ 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 & STS$M_CODE) == (SHR$_NOWILD & STS$M_CODE)) return retsts;
+ else {
+ _cksts(retsts);
+ _cksts(lib$find_file_end(&cxt));
+ s = resspec;
+ while (*s && !isspace(*s)) s++;
+ *s = '\0';
+ New(402,Cmd,6 + s - resspec + (rest ? strlen(rest) : 0),char);
+ strcpy(Cmd,"$ MCR ");
+ strcat(Cmd,resspec);
+ if (rest) strcat(Cmd,rest);
+ cmddsc->dsc$a_pointer = Cmd;
+ cmddsc->dsc$w_length = strlen(Cmd);
+ }
+ }
+
+ return 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 = 0;
+ do_aexec(really,mark,sp);
+ }
+ else { /* no vfork - act VMSish */
+ setup_argstr(really,mark,sp,&Argv);
+ return vms_do_exec(Argv);
+ }
+ }
+
+ 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 = 0;
+ do_exec(cmd);
+ }
+ else { /* no vfork - act VMSish */
+ struct dsc$descriptor_s cmddsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+
+ if ((vaxc$errno = setup_cmddsc(cmd,&cmddsc,1)) & 1)
+ vaxc$errno = lib$do_command(&cmddsc);
+
+ errno = EVMSERR;
+ if (dowarn)
+ warn("Can't exec \"%s\": %s", cmddsc.dsc$a_pointer, Strerror(errno));
+ do_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) {
+ setup_argstr(really,mark,sp,&Argv);
+ return do_spawn(Argv);
+ }
+
+ return SS$_ABORT;
+} /* end of do_aspawn() */
+/*}}}*/
+
+/* {{{unsigned long int do_spawn(char *cmd) */
+unsigned long int
+do_spawn(char *cmd)
+{
+ struct dsc$descriptor_s cmddsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+ unsigned long int substs;
+
+ if ((substs = setup_cmddsc(cmd,&cmddsc,0)) & 1)
+ _cksts(lib$spawn(&cmddsc,&nl_desc,0,0,0,&substs,0,0,0,0,0));
+
+ if (!(substs&1)) {
+ vaxc$errno = substs;
+ errno = EVMSERR;
+ if (dowarn)
+ warn("Can't exec \"%s\": %s", cmddsc.dsc$a_pointer, Strerror(errno));
+ }
+ 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() */
+/*}}}*/
+
+#ifndef VMS_DO_SOCKETS
+/***** The following two routines are temporary, and should be removed,
+ * along with the corresponding #defines in vmsish.h, when TCP/IP support
+ * has been added to the VMS port of perl5. (The temporary hacks are
+ * here now sho that pack can handle type N elements.)
+ * - C. Bailey 16-Aug-1994
+ *****/
+
+/*{{{ unsigned short int tmp_shortflip(unsigned short int val)*/
+unsigned short int
+tmp_shortflip(unsigned short int val)
+{
+ return val << 8 | val >> 8;
+}
+/*}}}*/
+
+/*{{{ unsigned long int tmp_longflip(unsigned long int val)*/
+unsigned long int
+tmp_longflip(unsigned long int val)
+{
+ unsigned long int scratch = val;
+ unsigned char savbyte, *tmp;
+
+ tmp = (unsigned char *) &scratch;
+ savbyte = tmp[0]; tmp[0] = tmp[3]; tmp[3] = savbyte;
+ savbyte = tmp[1]; tmp[1] = tmp[2]; tmp[2] = savbyte;
+
+ return scratch;
+}
+/*}}}*/
+#endif
diff --git a/vms/vmsish.h b/vms/vmsish.h
new file mode 100644
index 0000000000..ec0dbde2eb
--- /dev/null
+++ b/vms/vmsish.h
@@ -0,0 +1,176 @@
+/* vmsish.h
+ *
+ * VMS-specific C header file for perl5.
+ *
+ * Last revised: 09-Oct-1994 by Charles Bailey bailey@genetics.upenn.edu
+ */
+
+#ifndef __vmsish_h_included
+#define __vmsish_h_included
+
+#include <descrip.h> /* for dirent struct definitions */
+
+/* Assorted things to look like Unix */
+#ifdef __GNUC__
+#ifndef _IOLBF /* gcc's stdio.h doesn't define this */
+#define _IOLBF 1
+#endif
+#else
+#include <processes.h> /* for vfork() */
+#include <unixio.h>
+#endif
+#include <unixlib.h>
+#include <file.h> /* it's not <sys/file.h>, so don't use I_SYS_FILE */
+#define unlink remove
+
+#ifdef VMS_DO_SOCKETS
+#include "sockadapt.h"
+#endif
+
+/*
+ * The following symbols are defined (or undefined) according to the RTL
+ * support VMS provides for the corresponding functions. These don't
+ * appear in config.h, so they're dealt with here.
+ */
+#define HAS_KILL
+#define HAS_WAIT
+
+/* The VMS C RTL has vfork() but not fork(). Both actually work in a way
+ * that's somewhere between Unix vfork() and VMS lib$spawn(), so it's
+ * probably not a good idea to use them much. That said, we'll try to
+ * use vfork() in either case.
+ */
+#define fork vfork
+
+/*
+ * 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()
+
+/* 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 */
+};
+
+/* 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%"
+
+/* 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)
+
+/* 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)
+
+
+/* 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>));
+ */
+typedef char __VMS_PROTOTYPES__; /* prototype section start marker */
+char * my_getenv _((char *));
+#ifndef HAS_WAITPID /* Not a real waitpid - use only with popen from vms.c! */
+unsigned long int waitpid _((unsigned long int, int *, int));
+#endif
+char * my_gconvert _((double, int, int, char *));
+int do_rmdir _((char *));
+int kill_file _((char *));
+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 ***));
+int flex_fstat _((int, stat_t *));
+int flex_stat _((char *, stat_t *));
+int trim_unixpath _((char *, char*));
+struct sv; /* forward declaration for vms_do_aexec and do_aspawn */
+ /* real declaration is in sv.h */
+#define bool char /* This must match handy.h */
+bool vms_do_aexec _((struct sv *, struct sv **, struct sv **));
+bool vms_do_exec _((char *));
+unsigned long int do_aspawn _((struct sv *, struct sv **, struct sv **));
+unsigned long int do_spawn _((char *));
+int my_fwrite _((void *, size_t, size_t, FILE *));
+typedef char __VMS_SEPYTOTORP__; /* prototype section end marker */
+
+#ifndef VMS_DO_SOCKETS
+/***** The following four #defines are temporary, and should be removed,
+ * along with the corresponding routines in vms.c, when TCP/IP support
+ * is integrated into the VMS port of perl5. (The temporary hacks are
+ * here for now so pack can handle type N elements.)
+ * - C. Bailey 26-Aug-1994
+ *****/
+unsigned short int tmp_shortflip _((unsigned short int));
+unsigned long int tmp_longflip _((unsigned long int));
+#define htons(us) tmp_shortflip(us)
+#define ntohs(us) tmp_shortflip(us)
+#define htonl(ul) tmp_longflip(ul)
+#define ntohl(ul) tmp_longflip(ul)
+#endif
+
+#endif /* __vmsish_h_included */
diff --git a/vms/writemain.pl b/vms/writemain.pl
new file mode 100644
index 0000000000..38b6670b10
--- /dev/null
+++ b/vms/writemain.pl
@@ -0,0 +1,52 @@
+#!./miniperl
+#
+# Create perlmain.c from miniperlmain.c, adding code to boot the
+# extensions listed on the command line.
+#
+
+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>) {
+ s/INTERN\.h/EXTERN\.h/;
+ 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";
+}
+
+
+if ($#ARGV > -1) {
+ print OUT " char *file = __FILE__;\n";
+}
+
+foreach $ext (@ARGV) {
+ print OUT "extern void boot_${ext} _((CV* cv));\n"
+}
+
+foreach $ext (@ARGV) {
+ 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_${ext}, file);\n"
+ }
+ else {
+ print OUT " newXS(\"${ext}::bootstrap\", boot_${ext}, file);\n"
+ }
+}
+
+print OUT "}\n";
+close OUT;