[p5sagit/p5-mst-13.2.git] / vms / vmsish.h

/*  vmsish.h
 *
 * VMS-specific C header file for perl5.
 *
 * Last revised: 01-Oct-1995 by Charles Bailey  bailey@genetics.upenn.edu
 * Version: 5.1.6
 */

#ifndef __vmsish_h_included
#define __vmsish_h_included

#include <descrip.h> /* for dirent struct definitions */
#include <libdef.h>  /* status codes for various places */
#include <rmsdef.h>  /* at which errno and vaxc$errno are */
#include <ssdef.h>   /* explicitly set in the perl source code */
#include <stsdef.h>

/* Suppress compiler warnings from DECC for VMS-specific extensions:
 * GLOBALEXT, NOSHAREEXT, READONLYEXT: global[dr]ef declarations
 * ADDRCONSTEXT,NEEDCONSTEXT: initialization of data with non-constant values
 *                            (e.g. pointer fields of descriptors)
 */
#ifdef __DECC
#  pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT,ADDRCONSTEXT,NEEDCONSTEXT)
#endif

/* DEC's C compilers and gcc use incompatible definitions of _to(upp|low)er() */
#ifdef _toupper
#  undef _toupper
#endif
#define _toupper(c) (((c) < 'a' || (c) > 'z') ? (c) : (c) & ~040)
#ifdef _tolower
#  undef _tolower
#endif
#define _tolower(c) (((c) < 'A' || (c) > 'Z') ? (c) : (c) | 040)
/* DECC 1.3 has a funny definition of abs; it's fixed in DECC 4.0, so this
 * can go away once DECC 1.3 isn't in use any more. */
#if defined(__ALPHA) && defined(__DECC)
#undef abs
#define abs(__x)        __ABS(__x)
#undef labs
#define labs(__x)        __LABS(__x)
#endif /* __ALPHA && __DECC */

/* Assorted things to look like Unix */
#ifdef __GNUC__
#ifndef _IOLBF /* gcc's stdio.h doesn't define this */
#define _IOLBF 1
#endif
#endif
#include <processes.h> /* for vfork() */
#include <unixio.h>
#include <unixlib.h>
#include <file.h>  /* it's not <sys/file.h>, so don't use I_SYS_FILE */
#if defined(__DECC) && defined(__DECC_VER) && __DECC_VER > 20000000
#  include <unistd.h> /* DECC has this; VAXC and gcc don't */
#endif

/* Our own contribution to PerlShr's global symbols . . . */
#ifdef EMBED
#  define my_trnlnm		Perl_my_trnlnm
#  define my_getenv		Perl_my_getenv
#  define prime_env_iter	Perl_prime_env_iter
#  define my_setenv		Perl_my_setenv
#  define my_crypt		Perl_my_crypt
#  define waitpid		Perl_waitpid
#  define my_gconvert		Perl_my_gconvert
#  define do_rmdir		Perl_do_rmdir
#  define kill_file		Perl_kill_file
#  define my_utime		Perl_my_utime
#  define rmsexpand	Perl_rmsexpand
#  define rmsexpand_ts	Perl_rmsexpand_ts
#  define fileify_dirspec	Perl_fileify_dirspec
#  define fileify_dirspec_ts	Perl_fileify_dirspec_ts
#  define pathify_dirspec	Perl_pathify_dirspec
#  define pathify_dirspec_ts	Perl_pathify_dirspec_ts
#  define tounixspec		Perl_tounixspec
#  define tounixspec_ts		Perl_tounixspec_ts
#  define tovmsspec		Perl_tovmsspec
#  define tovmsspec_ts		Perl_tovmsspec_ts
#  define tounixpath		Perl_tounixpath
#  define tounixpath_ts		Perl_tounixpath_ts
#  define tovmspath		Perl_tovmspath
#  define tovmspath_ts		Perl_tovmspath_ts
#  define getredirection	Perl_getredirection
#  define opendir		Perl_opendir
#  define readdir		Perl_readdir
#  define telldir		Perl_telldir
#  define seekdir		Perl_seekdir
#  define closedir		Perl_closedir
#  define vmsreaddirversions	Perl_vmsreaddirversions
#  define getredirection	Perl_getredirection
#  define my_gmtime		Perl_my_gmtime
#  define cando_by_name		Perl_cando_by_name
#  define flex_fstat		Perl_flex_fstat
#  define flex_stat		Perl_flex_stat
#  define trim_unixpath		Perl_trim_unixpath
#  define my_vfork		Perl_my_vfork
#  define vms_do_aexec		Perl_vms_do_aexec
#  define vms_do_exec		Perl_vms_do_exec
#  define do_aspawn		Perl_do_aspawn
#  define do_spawn		Perl_do_spawn
#  define my_fwrite		Perl_my_fwrite
#  define my_binmode		Perl_my_binmode
#  define my_getpwnam		Perl_my_getpwnam
#  define my_getpwuid		Perl_my_getpwuid
#  define my_getpwent		Perl_my_getpwent
#  define my_endpwent		Perl_my_endpwent
#  define my_getlogin		Perl_my_getlogin
#  define rmscopy		Perl_rmscopy
#  define init_os_extras	Perl_init_os_extras
#endif

/* Delete if at all possible, changing protections if necessary. */
#define unlink kill_file

/* 
 * Intercept calls to fork, so we know whether subsequent calls to
 * exec should be handled in VMSish or Unixish style.
 */
#define fork my_vfork
#ifndef __DONT_MASK_VFORK  /* #defined in vms.c so we see real vfork */
#  ifdef vfork
#    undef vfork
#  endif
#  define vfork my_vfork
#endif

/* BIG_TIME:
 *	This symbol is defined if Time_t is an unsigned type on this system.
 */
#define BIG_TIME

/* USE_STAT_RDEV:
 *	This symbol is defined if this system has a stat structure declaring
 *	st_rdev
 */
#define USE_STAT_RDEV 	/**/

/* ACME_MESS:
 *	This symbol, if defined, indicates that error messages should be 
 *	should be generated in a format that allows the use of the Acme
 *	GUI/editor's autofind feature.
 */
#undef ACME_MESS	/**/

/* ALTERNATE_SHEBANG:
 *	This symbol, if defined, contains a "magic" string which may be used
 *	as the first line of a Perl program designed to be executed directly
 *	by name, instead of the standard Unix #!.  If ALTERNATE_SHEBANG
 *	begins with a character other then #, then Perl will only treat
 *	it as a command line if if finds the string "perl" in the first
 *	word; otherwise it's treated as the first line of code in the script.
 *	(IOW, Perl won't hand off to another interpreter via an alternate
 *	shebang sequence that might be legal Perl code.)
 */
#define ALTERNATE_SHEBANG "$"

/* Macros to set errno using the VAX thread-safe calls, if present */
#if (defined(__DECC) || defined(__DECCXX)) && !defined(__ALPHA)
#  define set_errno(v)      (cma$tis_errno_set_value(v))
   void cma$tis_errno_set_value(int __value);  /* missing in some errno.h */
#  define set_vaxc_errno(v) (vaxc$errno = (v))
#else
#  define set_errno(v)      (errno = (v))
#  define set_vaxc_errno(v) (vaxc$errno = (v))
#endif

/* Handy way to vet calls to VMS system services and RTL routines. */
#define _ckvmssts(call) STMT_START { register unsigned long int __ckvms_sts; \
  if (!((__ckvms_sts=(call))&1)) { \
  set_errno(EVMSERR); set_vaxc_errno(__ckvms_sts); \
  croak("Fatal VMS error (status=%d) at %s, line %d", \
  __ckvms_sts,__FILE__,__LINE__); } } STMT_END

/* Same thing, but don't call back to Perl's croak(); useful for errors
 * occurring during startup, before Perl's state is initialized */
#define _ckvmssts_noperl(call) STMT_START { register unsigned long int __ckvms_sts; \
  if (!((__ckvms_sts=(call))&1)) { \
  set_errno(EVMSERR); set_vaxc_errno(__ckvms_sts); \
  fprintf(Perl_debug_log,"Fatal VMS error (status=%d) at %s, line %d", \
  __ckvms_sts,__FILE__,__LINE__); lib$signal(__ckvms_sts); } } STMT_END

#ifdef VMS_DO_SOCKETS
#include "sockadapt.h"
#endif

#define BIT_BUCKET "_NLA0:"
#define PERL_SYS_INIT(c,v)  getredirection((c),(v))
#define PERL_SYS_TERM()
#define dXSUB_SYS int dummy
#define HAS_KILL
#define HAS_WAIT

/* VMS:
 *	This symbol, if defined, indicates that the program is running under
 *	VMS.  It's a symbol automagically defined by all VMS C compilers I've seen.
 * Just in case, however . . . */
#ifndef VMS
#define VMS		/**/
#endif

/* HAS_IOCTL:
 *	This symbol, if defined, indicates that the ioctl() routine is
 *	available to set I/O characteristics
 */
#undef	HAS_IOCTL		/**/
 
/* HAS_UTIME:
 *	This symbol, if defined, indicates that the routine utime() is
 *	available to update the access and modification times of files.
 */
#define HAS_UTIME		/**/

/* HAS_GROUP
 *	This symbol, if defined, indicates that the getgrnam(),
 *	getgrgid(), and getgrent() routines are available to 
 *	get group entries.
 */
#undef HAS_GROUP		/**/

/* HAS_PASSWD
 *	This symbol, if defined, indicates that the getpwnam(),
 *	getpwuid(), and getpwent() routines are available to 
 *	get password entries.
 */
#define HAS_PASSWD		/**/

#define HAS_KILL
#define HAS_WAIT
  
/* USEMYBINMODE
 *	This symbol, if defined, indicates that the program should
 *	use the routine my_binmode(FILE *fp, char iotype) to insure
 *	that a file is in "binary" mode -- that is, that no translation
 *	of bytes occurs on read or write operations.
 */
#define USEMYBINMODE

/*
 * 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()
    /* VAXC's signal.h doesn't #define SIG_ERR, but provides BADSIG instead. */
#if !defined(SIG_ERR) && defined(BADSIG)
#  define SIG_ERR BADSIG
#endif


/* Used with our my_utime() routine in vms.c */
struct utimbuf {
  time_t actime;
  time_t modtime;
};
#define utime my_utime

/* This is what times() returns, but <times.h> calls it tbuffer_t on VMS
 * prior to v7.0.  We check the DECC manifest to see whether it's already
 * done this for us, relying on the fact that perl.h #includes <time.h>
 * before it #includes "vmsish.h".
 */

#ifndef __TMS
  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 */
  };
#else
   /* The new headers change the times() prototype to tms from tbuffer */
#  define tbuffer_t struct tms
#endif

/* Prior to VMS 7.0, the CRTL gmtime() routine was a stub which always
 * returned NULL.  Substitute our own routine, which uses the logical
 * SYS$TIMEZONE_DIFFERENTIAL, whcih the native UTC support routines
 * in VMS 6.0 or later use.*
 */
#define gmtime(t) my_gmtime(t)

/* VMS doesn't use a real sys_nerr, but we need this when scanning for error
 * messages in text strings . . .
 */

#define sys_nerr EVMSERR  /* EVMSERR is as high as we can go. */

/* Look up new %ENV values on the fly */
#define DYNAMIC_ENV_FETCH 1
#define ENV_HV_NAME "%EnV%VmS%"

/* Thin jacket around cuserid() tomatch Unix' calling sequence */
#define getlogin my_getlogin

/* Ditto for sys$hash_passwrod() . . . */
#define crypt  my_crypt

/* Use our own stat() clones, which handle Unix-style directory names */
#define Stat(name,bufptr) flex_stat(name,bufptr)
#define Fstat(fd,bufptr) flex_fstat(fd,bufptr)

/* By default, flush data all the way to disk, not just to RMS buffers */
#define Fflush(fp) ((fflush(fp) || fsync(fileno(fp))) ? EOF : 0)

/* Setup for the dirent routines:
 * opendir(), closedir(), readdir(), seekdir(), telldir(), and
 * vmsreaddirversions(), and preprocessor stuff on which these depend:
 *    Written by Rich $alz, <rsalz@bbn.com> in August, 1990.
 *    This code has no copyright.
 */
    /* Data structure returned by READDIR(). */
struct dirent {
    char	d_name[256];		/* File name		*/
    int		d_namlen;			/* Length of d_name */
    int		vms_verscount;		/* Number of versions	*/
    int		vms_versions[20];	/* Version numbers	*/
};

    /* Handle returned by opendir(), used by the other routines.  You
     * are not supposed to care what's inside this structure. */
typedef struct _dirdesc {
    long			context;
    int				vms_wantversions;
    unsigned long int           count;
    char			*pattern;
    struct dirent		entry;
    struct dsc$descriptor_s	pat;
} DIR;

#define rewinddir(dirp)		seekdir((dirp), 0)

/* used for our emulation of getpw* */
struct passwd {
        char    *pw_name;    /* Username */
        char    *pw_passwd;
        Uid_t   pw_uid;      /* UIC member number */
        Gid_t   pw_gid;      /* UIC group  number */
        char    *pw_comment; /* Default device/directory (Unix-style) */
        char    *pw_gecos;   /* Owner */
        char    *pw_dir;     /* Default device/directory (VMS-style) */
        char    *pw_shell;   /* Default CLI name (eg. DCL) */
};
#define pw_unixdir pw_comment  /* Default device/directory (Unix-style) */
#define getpwnam my_getpwnam
#define getpwuid my_getpwuid
#define getpwent my_getpwent
#define endpwent my_endpwent
#define setpwent my_endpwent

/* Our own stat_t substitute, since we play with st_dev and st_ino -
 * we want atomic types so Unix-bound code which compares these fields
 * for two files will work most of the time under VMS.
 * N.B. 1. The st_ino hack assumes that sizeof(unsigned short[3]) ==
 * sizeof(unsigned) + sizeof(unsigned short).  We can't use a union type
 * to map the unsigned int we want and the unsigned short[3] the CRTL
 * returns into the same member, since gcc has different ideas than DECC
 * and VAXC about sizing union types.
 * N.B 2. The routine cando() in vms.c assumes that &stat.st_ino is the
 * address of a FID.
 */
/* First, grab the system types, so we don't clobber them later */
#include <stat.h>
/* Since we've got to match the size of the CRTL's stat_t, we need
 * to mimic DECC's alignment settings.
 */
#if defined(__DECC) || defined(__DECCXX)
#  pragma __member_alignment __save
#  pragma __nomember_alignment
#endif
#if defined(__DECC) 
#  pragma __message __save
#  pragma __message disable (__MISALGNDSTRCT)
#  pragma __message disable (__MISALGNDMEM)
#endif
struct mystat
{
        char *st_devnam;  /* pointer to device name */
        unsigned st_ino;    /* hack - CRTL uses unsigned short[3] for */
        unsigned short rvn; /* FID (num,seq,rvn) */
        unsigned short st_mode;	/* file "mode" i.e. prot, dir, reg, etc. */
        int	st_nlink;	/* for compatibility - not really used */
        unsigned st_uid;	/* from ACP - QIO uic field */
        unsigned short st_gid;	/* group number extracted from st_uid */
        dev_t   st_rdev;	/* for compatibility - always zero */
        off_t   st_size;	/* file size in bytes */
        unsigned st_atime;	/* file access time; always same as st_mtime */
        unsigned st_mtime;	/* last modification time */
        unsigned st_ctime;	/* file creation time */
        char	st_fab_rfm;	/* record format */
        char	st_fab_rat;	/* record attributes */
        char	st_fab_fsz;	/* fixed header size */
        unsigned st_dev;	/* encoded device name */
};
#define stat mystat
typedef unsigned mydev_t;
#define dev_t mydev_t
typedef unsigned myino_t;
#define ino_t myino_t
#if defined(__DECC) || defined(__DECCXX)
#  pragma __member_alignment __restore
#endif
#if defined(__DECC) 
#  pragma __message __restore
#endif
/* Cons up a 'delete' bit for testing access */
#define S_IDUSR (S_IWUSR | S_IXUSR)
#define S_IDGRP (S_IWGRP | S_IXGRP)
#define S_IDOTH (S_IWOTH | S_IXOTH)

/* Prototypes for functions unique to vms.c.  Don't include replacements
 * for routines in the mainline source files excluded by #ifndef VMS;
 * their prototypes are already in proto.h.
 *
 * In order to keep Gen_ShrFls.Pl happy, functions which are to be made
 * available to images linked to PerlShr.Exe must be declared between the
 * __VMS_PROTOTYPES__ and __VMS_SEPYTOTORP__ lines, and must be in the form
 *    <data type><TAB>name<WHITESPACE>_((<prototype args>));
 */

#ifdef NO_PERL_TYPEDEFS
  /* We don't have Perl typedefs available (e.g. when building a2p), so
     we fake them here.  N.B.  There is *no* guarantee that the faked
     prototypes will actually match the real routines.  If you want to
     call Perl routines, include perl.h to get the real typedefs.  */
#  ifndef bool
#    define bool int
#    define __MY_BOOL_TYPE_FAKE
#  endif
#  ifndef I32
#    define I32  int
#    define __MY_I32_TYPE_FAKE
#  endif
#  ifndef SV
#    define SV   void   /* Since we only see SV * in prototypes */
#    define __MY_SV_TYPE_FAKE
#  endif
#endif

void	prime_env_iter _((void));
void	getredirection _((int *, char ***));
void	init_os_extras _(());
/* prototype section start marker; `typedef' passes through cpp */
typedef char  __VMS_PROTOTYPES__;
int	my_trnlnm _((char *, char *, unsigned long int));
char *	my_getenv _((char *));
char *	my_crypt _((const char *, const char *));
unsigned long int	waitpid _((unsigned long int, int *, int));
char *	my_gconvert _((double, int, int, char *));
int	do_rmdir _((char *));
int	kill_file _((char *));
int	my_utime _((char *, struct utimbuf *));
char *	rmsexpand _((char *, char *, char *, unsigned));
char *	rmsexpand_ts _((char *, char *, char *, unsigned));
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));
struct tm *my_gmtime _((const time_t *));
I32	cando_by_name _((I32, I32, char *));
int	flex_fstat _((int, struct stat *));
int	flex_stat _((char *, struct stat *));
int	trim_unixpath _((char *, char*, int));
int	my_vfork _(());
bool	vms_do_aexec _((SV *, SV **, SV **));
bool	vms_do_exec _((char *));
unsigned long int	do_aspawn _((SV *, SV **, SV **));
unsigned long int	do_spawn _((char *));
int	my_fwrite _((void *, size_t, size_t, FILE *));
FILE *	my_binmode _((FILE *, char));
struct passwd *	my_getpwnam _((char *name));
struct passwd *	my_getpwuid _((Uid_t uid));
struct passwd *	my_getpwent _(());
void	my_endpwent _(());
char *	my_getlogin _(());
int	rmscopy _((char *, char *, int));
typedef char __VMS_SEPYTOTORP__;
/* prototype section end marker; `typedef' passes through cpp */

#ifdef NO_PERL_TYPEDEFS  /* We'll try not to scramble later files */
#  ifdef __MY_BOOL_TYPE_FAKE
#    undef bool
#    undef __MY_BOOL_TYPE_FAKE
#  endif
#  ifdef __MY_I32_TYPE_FAKE
#    undef I32
#    undef __MY_I32_TYPE_FAKE
#  endif
#  ifdef __MY_SV_TYPE_FAKE
#    undef SV
#    undef __MY_SV_TYPE_FAKE
#  endif
#endif

#ifndef VMS_DO_SOCKETS
/* This relies on tricks in perl.h to pick up that these manifest constants
 * are undefined and set up conversion routines.  It will then redefine
 * these manifest constants, so the actual values will match config.h
 */
#undef HAS_HTONS
#undef HAS_NTOHS
#undef HAS_HTONL
#undef HAS_NTOHL
#endif

#define TMPPATH "sys$scratch:perl-eXXXXXX"

#endif  /* __vmsish_h_included */
Commit	Line	Data
a0d0e21e	1	/* vmsish.h
	2	*
	3	* VMS-specific C header file for perl5.
	4	*
e518068a	5	* Last revised: 01-Oct-1995 by Charles Bailey bailey@genetics.upenn.edu
c07a80fd	6	* Version: 5.1.6
a0d0e21e	7	*/
	8
	9	#ifndef __vmsish_h_included
	10	#define __vmsish_h_included
	11
	12	#include <descrip.h> /* for dirent struct definitions */
748a9306	13	#include <libdef.h> /* status codes for various places */
	14	#include <rmsdef.h> /* at which errno and vaxc$errno are */
	15	#include <ssdef.h> /* explicitly set in the perl source code */
f86702cc	16	#include <stsdef.h>
748a9306	17
4633a7c4	18	/* Suppress compiler warnings from DECC for VMS-specific extensions:
36477c24	19	* GLOBALEXT, NOSHAREEXT, READONLYEXT: global[dr]ef declarations
e518068a	20	* ADDRCONSTEXT,NEEDCONSTEXT: initialization of data with non-constant values
	21	* (e.g. pointer fields of descriptors)
	22	*/
	23	#ifdef __DECC
36477c24	24	# pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT,ADDRCONSTEXT,NEEDCONSTEXT)
e518068a	25	#endif
e518068a	26
748a9306	27	/* DEC's C compilers and gcc use incompatible definitions of _to(upp\|low)er() */
	28	#ifdef _toupper
	29	# undef _toupper
	30	#endif
	31	#define _toupper(c) (((c) < 'a' \|\| (c) > 'z') ? (c) : (c) & ~040)
	32	#ifdef _tolower
	33	# undef _tolower
	34	#endif
	35	#define _tolower(c) (((c) < 'A' \|\| (c) > 'Z') ? (c) : (c) \| 040)
4633a7c4	36	/* DECC 1.3 has a funny definition of abs; it's fixed in DECC 4.0, so this
	37	* can go away once DECC 1.3 isn't in use any more. */
	38	#if defined(__ALPHA) && defined(__DECC)
	39	#undef abs
	40	#define abs(__x) __ABS(__x)
	41	#undef labs
	42	#define labs(__x) __LABS(__x)
	43	#endif /* __ALPHA && __DECC */
a0d0e21e	44
	45	/* Assorted things to look like Unix */
	46	#ifdef __GNUC__
	47	#ifndef _IOLBF /* gcc's stdio.h doesn't define this */
	48	#define _IOLBF 1
	49	#endif
748a9306	50	#endif
a0d0e21e	51	#include <processes.h> /* for vfork() */
a0d0e21e	52	#include <unixio.h>
a0d0e21e	53	#include <unixlib.h>
a0d0e21e	54	#include <file.h> /* it's not <sys/file.h>, so don't use I_SYS_FILE */
774d564b	55	#if defined(__DECC) && defined(__DECC_VER) && __DECC_VER > 20000000
bbce6d69	56	# include <unistd.h> /* DECC has this; VAXC and gcc don't */
bbce6d69	57	#endif
bf109933	58
	59	/* Our own contribution to PerlShr's global symbols . . . */
	60	#ifdef EMBED
	61	# define my_trnlnm Perl_my_trnlnm
	62	# define my_getenv Perl_my_getenv
94c456c4	63	# define prime_env_iter Perl_prime_env_iter
94c456c4	64	# define my_setenv Perl_my_setenv
bf109933	65	# define my_crypt Perl_my_crypt
	66	# define waitpid Perl_waitpid
	67	# define my_gconvert Perl_my_gconvert
	68	# define do_rmdir Perl_do_rmdir
	69	# define kill_file Perl_kill_file
	70	# define my_utime Perl_my_utime
bbce6d69	71	# define rmsexpand Perl_rmsexpand
bbce6d69	72	# define rmsexpand_ts Perl_rmsexpand_ts
bf109933	73	# define fileify_dirspec Perl_fileify_dirspec
	74	# define fileify_dirspec_ts Perl_fileify_dirspec_ts
	75	# define pathify_dirspec Perl_pathify_dirspec
	76	# define pathify_dirspec_ts Perl_pathify_dirspec_ts
	77	# define tounixspec Perl_tounixspec
	78	# define tounixspec_ts Perl_tounixspec_ts
	79	# define tovmsspec Perl_tovmsspec
	80	# define tovmsspec_ts Perl_tovmsspec_ts
	81	# define tounixpath Perl_tounixpath
	82	# define tounixpath_ts Perl_tounixpath_ts
	83	# define tovmspath Perl_tovmspath
	84	# define tovmspath_ts Perl_tovmspath_ts
	85	# define getredirection Perl_getredirection
	86	# define opendir Perl_opendir
	87	# define readdir Perl_readdir
	88	# define telldir Perl_telldir
	89	# define seekdir Perl_seekdir
	90	# define closedir Perl_closedir
	91	# define vmsreaddirversions Perl_vmsreaddirversions
	92	# define getredirection Perl_getredirection
	93	# define my_gmtime Perl_my_gmtime
	94	# define cando_by_name Perl_cando_by_name
	95	# define flex_fstat Perl_flex_fstat
	96	# define flex_stat Perl_flex_stat
	97	# define trim_unixpath Perl_trim_unixpath
0414b1a0	98	# define my_vfork Perl_my_vfork
bf109933	99	# define vms_do_aexec Perl_vms_do_aexec
	100	# define vms_do_exec Perl_vms_do_exec
	101	# define do_aspawn Perl_do_aspawn
	102	# define do_spawn Perl_do_spawn
	103	# define my_fwrite Perl_my_fwrite
0414b1a0	104	# define my_binmode Perl_my_binmode
bf109933	105	# define my_getpwnam Perl_my_getpwnam
	106	# define my_getpwuid Perl_my_getpwuid
	107	# define my_getpwent Perl_my_getpwent
	108	# define my_endpwent Perl_my_endpwent
	109	# define my_getlogin Perl_my_getlogin
	110	# define rmscopy Perl_rmscopy
	111	# define init_os_extras Perl_init_os_extras
	112	#endif
	113
	114	/* Delete if at all possible, changing protections if necessary. */
748a9306	115	#define unlink kill_file
748a9306	116
0414b1a0	117	/*
	118	* Intercept calls to fork, so we know whether subsequent calls to
	119	* exec should be handled in VMSish or Unixish style.
	120	*/
	121	#define fork my_vfork
	122	#ifndef __DONT_MASK_VFORK /* #defined in vms.c so we see real vfork */
	123	# ifdef vfork
	124	# undef vfork
	125	# endif
	126	# define vfork my_vfork
	127	#endif
	128
	129	/* BIG_TIME:
	130	* This symbol is defined if Time_t is an unsigned type on this system.
	131	*/
	132	#define BIG_TIME
	133
	134	/* USE_STAT_RDEV:
	135	* This symbol is defined if this system has a stat structure declaring
	136	* st_rdev
e518068a	137	*/
0414b1a0	138	#define USE_STAT_RDEV /**/
	139
	140	/* ACME_MESS:
	141	* This symbol, if defined, indicates that error messages should be
	142	* should be generated in a format that allows the use of the Acme
	143	* GUI/editor's autofind feature.
	144	*/
	145	#undef ACME_MESS /**/
e518068a	146
44a8e56a	147	/* ALTERNATE_SHEBANG:
	148	* This symbol, if defined, contains a "magic" string which may be used
	149	* as the first line of a Perl program designed to be executed directly
	150	* by name, instead of the standard Unix #!. If ALTERNATE_SHEBANG
	151	* begins with a character other then #, then Perl will only treat
	152	* it as a command line if if finds the string "perl" in the first
	153	* word; otherwise it's treated as the first line of code in the script.
	154	* (IOW, Perl won't hand off to another interpreter via an alternate
	155	* shebang sequence that might be legal Perl code.)
	156	*/
	157	#define ALTERNATE_SHEBANG "$"
	158
748a9306	159	/* Macros to set errno using the VAX thread-safe calls, if present */
	160	#if (defined(__DECC) \|\| defined(__DECCXX)) && !defined(__ALPHA)
	161	# define set_errno(v) (cma$tis_errno_set_value(v))
774d564b	162	void cma$tis_errno_set_value(int __value); /* missing in some errno.h */
748a9306	163	# define set_vaxc_errno(v) (vaxc$errno = (v))
	164	#else
	165	# define set_errno(v) (errno = (v))
	166	# define set_vaxc_errno(v) (vaxc$errno = (v))
	167	#endif
	168
	169	/* Handy way to vet calls to VMS system services and RTL routines. */
bf109933	170	#define _ckvmssts(call) STMT_START { register unsigned long int __ckvms_sts; \
748a9306	171	if (!((__ckvms_sts=(call))&1)) { \
748a9306	172	set_errno(EVMSERR); set_vaxc_errno(__ckvms_sts); \
e518068a	173	croak("Fatal VMS error (status=%d) at %s, line %d", \
bf109933	174	__ckvms_sts,__FILE__,__LINE__); } } STMT_END
a0d0e21e	175
0414b1a0	176	/* Same thing, but don't call back to Perl's croak(); useful for errors
	177	* occurring during startup, before Perl's state is initialized */
	178	#define _ckvmssts_noperl(call) STMT_START { register unsigned long int __ckvms_sts; \
	179	if (!((__ckvms_sts=(call))&1)) { \
	180	set_errno(EVMSERR); set_vaxc_errno(__ckvms_sts); \
	181	fprintf(Perl_debug_log,"Fatal VMS error (status=%d) at %s, line %d", \
	182	__ckvms_sts,__FILE__,__LINE__); lib$signal(__ckvms_sts); } } STMT_END
	183
a0d0e21e	184	#ifdef VMS_DO_SOCKETS
	185	#include "sockadapt.h"
	186	#endif
	187
c07a80fd	188	#define BIT_BUCKET "_NLA0:"
c07a80fd	189	#define PERL_SYS_INIT(c,v) getredirection((c),(v))
bf109933	190	#define PERL_SYS_TERM()
bf109933	191	#define dXSUB_SYS int dummy
a0d0e21e	192	#define HAS_KILL
	193	#define HAS_WAIT
	194
e518068a	195	/* VMS:
	196	* This symbol, if defined, indicates that the program is running under
	197	* VMS. It's a symbol automagically defined by all VMS C compilers I've seen.
	198	* Just in case, however . . . */
	199	#ifndef VMS
	200	#define VMS /**/
	201	#endif
	202
	203	/* HAS_IOCTL:
	204	* This symbol, if defined, indicates that the ioctl() routine is
	205	* available to set I/O characteristics
a0d0e21e	206	*/
e518068a	207	#undef HAS_IOCTL /**/
	208
	209	/* HAS_UTIME:
	210	* This symbol, if defined, indicates that the routine utime() is
	211	* available to update the access and modification times of files.
	212	*/
	213	#define HAS_UTIME /**/
a0d0e21e	214
e518068a	215	/* HAS_GROUP
	216	* This symbol, if defined, indicates that the getgrnam(),
	217	* getgrgid(), and getgrent() routines are available to
	218	* get group entries.
	219	*/
	220	#undef HAS_GROUP /**/
	221
	222	/* HAS_PASSWD
	223	* This symbol, if defined, indicates that the getpwnam(),
	224	* getpwuid(), and getpwent() routines are available to
	225	* get password entries.
	226	*/
	227	#define HAS_PASSWD /**/
	228
	229	#define HAS_KILL
	230	#define HAS_WAIT
	231
0414b1a0	232	/* USEMYBINMODE
	233	* This symbol, if defined, indicates that the program should
	234	* use the routine my_binmode(FILE *fp, char iotype) to insure
	235	* that a file is in "binary" mode -- that is, that no translation
	236	* of bytes occurs on read or write operations.
	237	*/
	238	#define USEMYBINMODE
	239
a0d0e21e	240	/*
	241	* fwrite1() should be a routine with the same calling sequence as fwrite(),
	242	* but which outputs all of the bytes requested as a single stream (unlike
	243	* fwrite() itself, which on some systems outputs several distinct records
	244	* if the number_of_items parameter is >1).
	245	*/
	246	#define fwrite1 my_fwrite
	247
	248	/* Use our own rmdir() */
	249	#define rmdir(name) do_rmdir(name)
	250
	251	/* Assorted fiddling with sigs . . . */
	252	# include <signal.h>
	253	#define ABORT() abort()
5f05dabc	254	/* VAXC's signal.h doesn't #define SIG_ERR, but provides BADSIG instead. */
	255	#if !defined(SIG_ERR) && defined(BADSIG)
	256	# define SIG_ERR BADSIG
	257	#endif
	258
a0d0e21e	259
748a9306	260	/* Used with our my_utime() routine in vms.c */
	261	struct utimbuf {
	262	time_t actime;
	263	time_t modtime;
	264	};
	265	#define utime my_utime
	266
0414b1a0	267	/* This is what times() returns, but <times.h> calls it tbuffer_t on VMS
	268	* prior to v7.0. We check the DECC manifest to see whether it's already
	269	* done this for us, relying on the fact that perl.h #includes <time.h>
	270	* before it #includes "vmsish.h".
	271	*/
a0d0e21e	272
0414b1a0	273	#ifndef __TMS
	274	struct tms {
	275	clock_t tms_utime; /* user time */
	276	clock_t tms_stime; /* system time - always 0 on VMS */
	277	clock_t tms_cutime; /* user time, children */
	278	clock_t tms_cstime; /* system time, children - always 0 on VMS */
	279	};
5f05dabc	280	#else
	281	/* The new headers change the times() prototype to tms from tbuffer */
	282	# define tbuffer_t struct tms
0414b1a0	283	#endif
a0d0e21e	284
e518068a	285	/* Prior to VMS 7.0, the CRTL gmtime() routine was a stub which always
	286	* returned NULL. Substitute our own routine, which uses the logical
	287	* SYS$TIMEZONE_DIFFERENTIAL, whcih the native UTC support routines
	288	* in VMS 6.0 or later use.*
	289	*/
	290	#define gmtime(t) my_gmtime(t)
	291
a0d0e21e	292	/* VMS doesn't use a real sys_nerr, but we need this when scanning for error
	293	* messages in text strings . . .
	294	*/
	295
	296	#define sys_nerr EVMSERR /* EVMSERR is as high as we can go. */
	297
	298	/* Look up new %ENV values on the fly */
	299	#define DYNAMIC_ENV_FETCH 1
	300	#define ENV_HV_NAME "%EnV%VmS%"
	301
c07a80fd	302	/* Thin jacket around cuserid() tomatch Unix' calling sequence */
	303	#define getlogin my_getlogin
	304
	305	/* Ditto for sys$hash_passwrod() . . . */
	306	#define crypt my_crypt
	307
a0d0e21e	308	/* Use our own stat() clones, which handle Unix-style directory names */
	309	#define Stat(name,bufptr) flex_stat(name,bufptr)
	310	#define Fstat(fd,bufptr) flex_fstat(fd,bufptr)
	311
a5f75d66	312	/* By default, flush data all the way to disk, not just to RMS buffers */
	313	#define Fflush(fp) ((fflush(fp) \|\| fsync(fileno(fp))) ? EOF : 0)
	314
a0d0e21e	315	/* Setup for the dirent routines:
	316	* opendir(), closedir(), readdir(), seekdir(), telldir(), and
	317	* vmsreaddirversions(), and preprocessor stuff on which these depend:
	318	* Written by Rich $alz, <rsalz@bbn.com> in August, 1990.
	319	* This code has no copyright.
	320	*/
	321	/* Data structure returned by READDIR(). */
	322	struct dirent {
	323	char d_name[256]; /* File name */
	324	int d_namlen; /* Length of d_name */
	325	int vms_verscount; /* Number of versions */
	326	int vms_versions[20]; /* Version numbers */
	327	};
	328
	329	/* Handle returned by opendir(), used by the other routines. You
	330	* are not supposed to care what's inside this structure. */
	331	typedef struct _dirdesc {
	332	long context;
	333	int vms_wantversions;
	334	unsigned long int count;
	335	char *pattern;
	336	struct dirent entry;
	337	struct dsc$descriptor_s pat;
	338	} DIR;
	339
	340	#define rewinddir(dirp) seekdir((dirp), 0)
	341
748a9306	342	/* used for our emulation of getpw* */
	343	struct passwd {
	344	char pw_name; / Username */
	345	char *pw_passwd;
	346	Uid_t pw_uid; /* UIC member number */
	347	Gid_t pw_gid; /* UIC group number */
	348	char pw_comment; / Default device/directory (Unix-style) */
	349	char pw_gecos; / Owner */
	350	char pw_dir; / Default device/directory (VMS-style) */
	351	char pw_shell; / Default CLI name (eg. DCL) */
	352	};
	353	#define pw_unixdir pw_comment /* Default device/directory (Unix-style) */
	354	#define getpwnam my_getpwnam
	355	#define getpwuid my_getpwuid
	356	#define getpwent my_getpwent
	357	#define endpwent my_endpwent
	358	#define setpwent my_endpwent
	359
	360	/* Our own stat_t substitute, since we play with st_dev and st_ino -
	361	* we want atomic types so Unix-bound code which compares these fields
c07a80fd	362	* for two files will work most of the time under VMS.
	363	* N.B. 1. The st_ino hack assumes that sizeof(unsigned short[3]) ==
	364	* sizeof(unsigned) + sizeof(unsigned short). We can't use a union type
	365	* to map the unsigned int we want and the unsigned short[3] the CRTL
	366	* returns into the same member, since gcc has different ideas than DECC
	367	* and VAXC about sizing union types.
	368	* N.B 2. The routine cando() in vms.c assumes that &stat.st_ino is the
	369	* address of a FID.
748a9306	370	*/
	371	/* First, grab the system types, so we don't clobber them later */
	372	#include <stat.h>
	373	/* Since we've got to match the size of the CRTL's stat_t, we need
	374	* to mimic DECC's alignment settings.
	375	*/
	376	#if defined(__DECC) \|\| defined(__DECCXX)
	377	# pragma __member_alignment __save
	378	# pragma __nomember_alignment
	379	#endif
	380	#if defined(__DECC)
	381	# pragma __message __save
	382	# pragma __message disable (__MISALGNDSTRCT)
	383	# pragma __message disable (__MISALGNDMEM)
	384	#endif
	385	struct mystat
	386	{
	387	char st_devnam; / pointer to device name */
c07a80fd	388	unsigned st_ino; /* hack - CRTL uses unsigned short[3] for */
c07a80fd	389	unsigned short rvn; /* FID (num,seq,rvn) */
748a9306	390	unsigned short st_mode; /* file "mode" i.e. prot, dir, reg, etc. */
	391	int st_nlink; /* for compatibility - not really used */
	392	unsigned st_uid; /* from ACP - QIO uic field */
	393	unsigned short st_gid; /* group number extracted from st_uid */
	394	dev_t st_rdev; /* for compatibility - always zero */
	395	off_t st_size; /* file size in bytes */
	396	unsigned st_atime; /* file access time; always same as st_mtime */
	397	unsigned st_mtime; /* last modification time */
	398	unsigned st_ctime; /* file creation time */
	399	char st_fab_rfm; /* record format */
	400	char st_fab_rat; /* record attributes */
	401	char st_fab_fsz; /* fixed header size */
	402	unsigned st_dev; /* encoded device name */
	403	};
748a9306	404	#define stat mystat
	405	typedef unsigned mydev_t;
	406	#define dev_t mydev_t
c07a80fd	407	typedef unsigned myino_t;
748a9306	408	#define ino_t myino_t
	409	#if defined(__DECC) \|\| defined(__DECCXX)
	410	# pragma __member_alignment __restore
	411	#endif
	412	#if defined(__DECC)
	413	# pragma __message __restore
	414	#endif
	415	/* Cons up a 'delete' bit for testing access */
	416	#define S_IDUSR (S_IWUSR \| S_IXUSR)
	417	#define S_IDGRP (S_IWGRP \| S_IXGRP)
	418	#define S_IDOTH (S_IWOTH \| S_IXOTH)
a0d0e21e	419
	420	/* Prototypes for functions unique to vms.c. Don't include replacements
	421	* for routines in the mainline source files excluded by #ifndef VMS;
	422	* their prototypes are already in proto.h.
	423	*
	424	* In order to keep Gen_ShrFls.Pl happy, functions which are to be made
	425	* available to images linked to PerlShr.Exe must be declared between the
	426	* __VMS_PROTOTYPES__ and __VMS_SEPYTOTORP__ lines, and must be in the form
	427	* <data type><TAB>name<WHITESPACE>_((<prototype args>));
	428	*/
94c456c4	429
44a8e56a	430	#ifdef NO_PERL_TYPEDEFS
	431	/* We don't have Perl typedefs available (e.g. when building a2p), so
	432	we fake them here. N.B. There is no guarantee that the faked
	433	prototypes will actually match the real routines. If you want to
	434	call Perl routines, include perl.h to get the real typedefs. */
	435	# ifndef bool
	436	# define bool int
	437	# define __MY_BOOL_TYPE_FAKE
	438	# endif
	439	# ifndef I32
	440	# define I32 int
	441	# define __MY_I32_TYPE_FAKE
	442	# endif
	443	# ifndef SV
	444	# define SV void /* Since we only see SV * in prototypes */
	445	# define __MY_SV_TYPE_FAKE
	446	# endif
	447	#endif
	448
94c456c4	449	void prime_env_iter _((void));
	450	void getredirection _((int , char **));
	451	void init_os_extras _(());
c07a80fd	452	/* prototype section start marker; `typedef' passes through cpp */
	453	typedef char __VMS_PROTOTYPES__;
	454	int my_trnlnm _((char , char , unsigned long int));
a0d0e21e	455	char * my_getenv _((char *));
c07a80fd	456	char * my_crypt _((const char , const char ));
a0d0e21e	457	unsigned long int waitpid _((unsigned long int, int *, int));
a0d0e21e	458	char * my_gconvert _((double, int, int, char *));
	459	int do_rmdir _((char *));
	460	int kill_file _((char *));
748a9306	461	int my_utime _((char , struct utimbuf ));
bbce6d69	462	char * rmsexpand _((char , char , char *, unsigned));
bbce6d69	463	char * rmsexpand_ts _((char , char , char *, unsigned));
a0d0e21e	464	char * fileify_dirspec _((char , char ));
	465	char * fileify_dirspec_ts _((char , char ));
	466	char * pathify_dirspec _((char , char ));
	467	char * pathify_dirspec_ts _((char , char ));
	468	char * tounixspec _((char , char ));
	469	char * tounixspec_ts _((char , char ));
	470	char * tovmsspec _((char , char ));
	471	char * tovmsspec_ts _((char , char ));
	472	char * tounixpath _((char , char ));
	473	char * tounixpath_ts _((char , char ));
	474	char * tovmspath _((char , char ));
	475	char * tovmspath_ts _((char , char ));
	476	void getredirection _(());
	477	DIR * opendir _((char *));
	478	struct dirent * readdir _((DIR *));
	479	long telldir _((DIR *));
	480	void seekdir _((DIR *, long));
	481	void closedir _((DIR *));
	482	void vmsreaddirversions _((DIR *, int));
e518068a	483	struct tm my_gmtime _((const time_t ));
748a9306	484	I32 cando_by_name _((I32, I32, char *));
	485	int flex_fstat _((int, struct stat *));
	486	int flex_stat _((char , struct stat ));
f86702cc	487	int trim_unixpath _((char , char, int));
0414b1a0	488	int my_vfork _(());
748a9306	489	bool vms_do_aexec _((SV , SV , SV *));
a0d0e21e	490	bool vms_do_exec _((char *));
748a9306	491	unsigned long int do_aspawn _((SV , SV , SV *));
a0d0e21e	492	unsigned long int do_spawn _((char *));
a0d0e21e	493	int my_fwrite _((void , size_t, size_t, FILE ));
0414b1a0	494	FILE * my_binmode _((FILE *, char));
748a9306	495	struct passwd * my_getpwnam _((char *name));
	496	struct passwd * my_getpwuid _((Uid_t uid));
	497	struct passwd * my_getpwent _(());
	498	void my_endpwent _(());
c07a80fd	499	char * my_getlogin _(());
bf109933	500	int rmscopy _((char , char , int));
c07a80fd	501	typedef char __VMS_SEPYTOTORP__;
c07a80fd	502	/* prototype section end marker; `typedef' passes through cpp */
a0d0e21e	503
44a8e56a	504	#ifdef NO_PERL_TYPEDEFS /* We'll try not to scramble later files */
	505	# ifdef __MY_BOOL_TYPE_FAKE
	506	# undef bool
	507	# undef __MY_BOOL_TYPE_FAKE
	508	# endif
	509	# ifdef __MY_I32_TYPE_FAKE
	510	# undef I32
	511	# undef __MY_I32_TYPE_FAKE
	512	# endif
	513	# ifdef __MY_SV_TYPE_FAKE
	514	# undef SV
	515	# undef __MY_SV_TYPE_FAKE
	516	# endif
	517	#endif
	518
a0d0e21e	519	#ifndef VMS_DO_SOCKETS
748a9306	520	/* This relies on tricks in perl.h to pick up that these manifest constants
	521	* are undefined and set up conversion routines. It will then redefine
	522	* these manifest constants, so the actual values will match config.h
	523	*/
	524	#undef HAS_HTONS
	525	#undef HAS_NTOHS
	526	#undef HAS_HTONL
	527	#undef HAS_NTOHL
a0d0e21e	528	#endif
a0d0e21e	529
482b294c	530	#define TMPPATH "sys$scratch:perl-eXXXXXX"
482b294c	531
a0d0e21e	532	#endif /* __vmsish_h_included */