[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 */

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