diff options
Diffstat (limited to 'vms')
| -rw-r--r-- | vms/config.vms | 1440 | ||||
| -rw-r--r-- | vms/descrip.mms | 858 | ||||
| -rw-r--r-- | vms/gen_shrfls.pl | 229 | ||||
| -rw-r--r-- | vms/genconfig.pl | 112 | ||||
| -rw-r--r-- | vms/genopt.com | 18 | ||||
| -rw-r--r-- | vms/makefile. | 764 | ||||
| -rw-r--r-- | vms/mms2make.pl | 102 | ||||
| -rw-r--r-- | vms/perlshr.c | 13 | ||||
| -rw-r--r-- | vms/perlvms.pod | 264 | ||||
| -rw-r--r-- | vms/sockadapt.c | 43 | ||||
| -rw-r--r-- | vms/sockadapt.h | 54 | ||||
| -rw-r--r-- | vms/test.com | 184 | ||||
| -rw-r--r-- | vms/vms.c | 2095 | ||||
| -rw-r--r-- | vms/vmsish.h | 176 | ||||
| -rw-r--r-- | vms/writemain.pl | 52 |
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; |