home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / vms / vmsish.h < prev    next >
C/C++ Source or Header  |  2000-03-18  |  25KB  |  726 lines
  1. /*  vmsish.h
  2.  *
  3.  * VMS-specific C header file for perl5.
  4.  *
  5.  * Last revised: 16-Sep-1998 by Charles Bailey  bailey@newman.upenn.edu
  6.  * Version: 5.5.2
  7.  */
  8.  
  9. #ifndef __vmsish_h_included
  10. #define __vmsish_h_included
  11.  
  12. #include <descrip.h> /* for dirent struct definitions */
  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. #include <stsdef.h>  /* bitmasks for exit status testing */
  17.  
  18. /* Suppress compiler warnings from DECC for VMS-specific extensions:
  19.  * ADDRCONSTEXT,NEEDCONSTEXT: initialization of data with non-constant values
  20.  *                            (e.g. pointer fields of descriptors)
  21.  */
  22. #ifdef __DECC
  23. #  pragma message disable (ADDRCONSTEXT,NEEDCONSTEXT)
  24. #endif
  25.  
  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)
  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 */
  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
  49. #endif
  50. #include <processes.h> /* for vfork() */
  51. #include <unixio.h>
  52. #include <unixlib.h>
  53. #include <file.h>  /* it's not <sys/file.h>, so don't use I_SYS_FILE */
  54. #if defined(__DECC) && defined(__DECC_VER) && __DECC_VER > 20000000
  55. #  include <unistd.h> /* DECC has this; VAXC and gcc don't */
  56. #endif
  57.  
  58. /* VAXC doesn't have a unary plus operator, so we need to get there indirectly */
  59. #if defined(VAXC) && !defined(__DECC)
  60. #  define NO_UNARY_PLUS
  61. #endif
  62.  
  63. #ifdef NO_PERL_TYPEDEFS /* a2p; we don't want Perl's special routines */
  64. #  define DONT_MASK_RTL_CALLS
  65. #endif
  66.  
  67. /* Note that we do, in fact, have this */
  68. #define HAS_GETENV_SV
  69. #define HAS_GETENV_LEN
  70.  
  71. #ifndef DONT_MASK_RTL_CALLS
  72. #  ifdef getenv
  73. #    undef getenv
  74. #  endif
  75.   /* getenv used for regular logical names */
  76. #  define getenv(v) my_getenv(v,TRUE)
  77. #endif
  78. #ifdef getenv_len
  79. #  undef getenv_len
  80. #endif
  81. #define getenv_len(v,l) my_getenv_len(v,l,TRUE)
  82.  
  83. /* DECC introduces this routine in the RTL as of VMS 7.0; for now,
  84.  * we'll use ours, since it gives us the full VMS exit status. */
  85. #define waitpid my_waitpid
  86.  
  87. /* Don't redeclare standard RTL routines in Perl's header files;
  88.  * VMS history or extensions makes some of the formal protoypes
  89.  * differ from the common Unix forms.
  90.  */
  91. #define DONT_DECLARE_STD 1
  92.  
  93. /* Our own contribution to PerlShr's global symbols . . . */
  94. #define vmstrnenv        Perl_vmstrnenv
  95. #define my_trnlnm        Perl_my_trnlnm
  96. #define my_getenv_len        Perl_my_getenv_len
  97. #define prime_env_iter    Perl_prime_env_iter
  98. #define vmssetenv        Perl_vmssetenv
  99. #if !defined(PERL_IMPLICIT_CONTEXT)
  100. #define my_setenv        Perl_my_setenv
  101. #define my_getenv        Perl_my_getenv
  102. #else
  103. #define my_setenv(a,b)        Perl_my_setenv(aTHX_ a,b)
  104. #define my_getenv(a,b)        Perl_my_getenv(aTHX_ a,b)
  105. #endif
  106. #define my_crypt        Perl_my_crypt
  107. #define my_waitpid        Perl_my_waitpid
  108. #define my_gconvert        Perl_my_gconvert
  109. #define do_rmdir        Perl_do_rmdir
  110. #define kill_file        Perl_kill_file
  111. #define my_mkdir        Perl_my_mkdir
  112. #define my_utime        Perl_my_utime
  113. #define rmsexpand    Perl_rmsexpand
  114. #define rmsexpand_ts    Perl_rmsexpand_ts
  115. #define fileify_dirspec    Perl_fileify_dirspec
  116. #define fileify_dirspec_ts    Perl_fileify_dirspec_ts
  117. #define pathify_dirspec    Perl_pathify_dirspec
  118. #define pathify_dirspec_ts    Perl_pathify_dirspec_ts
  119. #define tounixspec        Perl_tounixspec
  120. #define tounixspec_ts        Perl_tounixspec_ts
  121. #define tovmsspec        Perl_tovmsspec
  122. #define tovmsspec_ts        Perl_tovmsspec_ts
  123. #define tounixpath        Perl_tounixpath
  124. #define tounixpath_ts        Perl_tounixpath_ts
  125. #define tovmspath        Perl_tovmspath
  126. #define tovmspath_ts        Perl_tovmspath_ts
  127. #define vms_image_init    Perl_vms_image_init
  128. #define opendir        Perl_opendir
  129. #define readdir        Perl_readdir
  130. #define telldir        Perl_telldir
  131. #define seekdir        Perl_seekdir
  132. #define closedir        Perl_closedir
  133. #define vmsreaddirversions    Perl_vmsreaddirversions
  134. #define my_gmtime        Perl_my_gmtime
  135. #define my_localtime        Perl_my_localtime
  136. #define my_time        Perl_my_time
  137. #define my_sigemptyset        Perl_my_sigemptyset
  138. #define my_sigfillset         Perl_my_sigfillset
  139. #define my_sigaddset          Perl_my_sigaddset
  140. #define my_sigdelset          Perl_my_sigdelset
  141. #define my_sigismember        Perl_my_sigismember
  142. #define my_sigprocmask        Perl_my_sigprocmask
  143. #define cando_by_name        Perl_cando_by_name
  144. #define flex_fstat        Perl_flex_fstat
  145. #define flex_stat        Perl_flex_stat
  146. #define trim_unixpath        Perl_trim_unixpath
  147. #define my_vfork        Perl_my_vfork
  148. #define vms_do_aexec        Perl_vms_do_aexec
  149. #define vms_do_exec        Perl_vms_do_exec
  150. #define do_aspawn        Perl_do_aspawn
  151. #define do_spawn        Perl_do_spawn
  152. #define my_fwrite        Perl_my_fwrite
  153. #define my_flush        Perl_my_flush
  154. #define my_getpwnam        Perl_my_getpwnam
  155. #define my_getpwuid        Perl_my_getpwuid
  156. #define my_getpwent        Perl_my_getpwent
  157. #define my_endpwent        Perl_my_endpwent
  158. #define my_getlogin        Perl_my_getlogin
  159. #define rmscopy        Perl_rmscopy
  160. #define init_os_extras    Perl_init_os_extras
  161.  
  162. /* Delete if at all possible, changing protections if necessary. */
  163. #define unlink kill_file
  164.  
  165. /* 
  166.  * Intercept calls to fork, so we know whether subsequent calls to
  167.  * exec should be handled in VMSish or Unixish style.
  168.  */
  169. #define fork my_vfork
  170. #ifndef DONT_MASK_RTL_CALLS     /* #defined in vms.c so we see real vfork */
  171. #  ifdef vfork
  172. #    undef vfork
  173. #  endif
  174. #  define vfork my_vfork
  175. #endif
  176.  
  177. /* BIG_TIME:
  178.  *    This symbol is defined if Time_t is an unsigned type on this system.
  179.  */
  180. #define BIG_TIME
  181.  
  182. /* ACME_MESS:
  183.  *    This symbol, if defined, indicates that error messages should be 
  184.  *    should be generated in a format that allows the use of the Acme
  185.  *    GUI/editor's autofind feature.
  186.  */
  187. #undef ACME_MESS    /**/
  188.  
  189. /* ALTERNATE_SHEBANG:
  190.  *    This symbol, if defined, contains a "magic" string which may be used
  191.  *    as the first line of a Perl program designed to be executed directly
  192.  *    by name, instead of the standard Unix #!.  If ALTERNATE_SHEBANG
  193.  *    begins with a character other then #, then Perl will only treat
  194.  *    it as a command line if if finds the string "perl" in the first
  195.  *    word; otherwise it's treated as the first line of code in the script.
  196.  *    (IOW, Perl won't hand off to another interpreter via an alternate
  197.  *    shebang sequence that might be legal Perl code.)
  198.  */
  199. #define ALTERNATE_SHEBANG "$"
  200.  
  201. /* Lower case entry points for these are missing in some earlier RTLs 
  202.  * so we borrow the defines and declares from errno.h and upcase them.
  203.  */
  204. #if defined(VMS_WE_ARE_CASE_SENSITIVE) && (__DECC_VER < 50500000)
  205. #  define errno      (*CMA$TIS_ERRNO_GET_ADDR())
  206. #  define vaxc$errno (*CMA$TIS_VMSERRNO_GET_ADDR())
  207.    int *CMA$TIS_ERRNO_GET_ADDR     (void);   /* UNIX style error code        */
  208.    int *CMA$TIS_VMSERRNO_GET_ADDR  (void);   /* VMS error (errno == EVMSERR) */
  209. #endif
  210.  
  211. /* Macros to set errno using the VAX thread-safe calls, if present */
  212. #if (defined(__DECC) || defined(__DECCXX)) && !defined(__ALPHA)
  213. #  define set_errno(v)      (cma$tis_errno_set_value(v))
  214.    void cma$tis_errno_set_value(int __value);  /* missing in some errno.h */
  215. #  define set_vaxc_errno(v) (vaxc$errno = (v))
  216. #else
  217. #  define set_errno(v)      (errno = (v))
  218. #  define set_vaxc_errno(v) (vaxc$errno = (v))
  219. #endif
  220.  
  221. /* Support for 'vmsish' behaviors enabled with C<use vmsish> pragma */
  222.  
  223. #define COMPLEX_STATUS    1    /* We track both "POSIX" and VMS values */
  224.  
  225. #define HINT_V_VMSISH        24
  226. #define HINT_M_VMSISH_HUSHED    0x20000000 /* stifle error msgs on exit */
  227. #define HINT_M_VMSISH_STATUS    0x40000000 /* system, $? return VMS status */
  228. #define HINT_M_VMSISH_TIME    0x80000000 /* times are local, not UTC */
  229. #define NATIVE_HINTS        (PL_hints >> HINT_V_VMSISH)  /* used in op.c */
  230.  
  231. #define TEST_VMSISH(h)    (PL_curcop->op_private & ((h) >> HINT_V_VMSISH))
  232. #define VMSISH_HUSHED    TEST_VMSISH(HINT_M_VMSISH_HUSHED)
  233. #define VMSISH_STATUS    TEST_VMSISH(HINT_M_VMSISH_STATUS)
  234. #define VMSISH_TIME    TEST_VMSISH(HINT_M_VMSISH_TIME)
  235.  
  236. /* Flags for vmstrnenv() */
  237. #define PERL__TRNENV_SECURE 0x01
  238.  
  239. /* Handy way to vet calls to VMS system services and RTL routines. */
  240. #define _ckvmssts(call) STMT_START { register unsigned long int __ckvms_sts; \
  241.   if (!((__ckvms_sts=(call))&1)) { \
  242.   set_errno(EVMSERR); set_vaxc_errno(__ckvms_sts); \
  243.   Perl_croak(aTHX_ "Fatal VMS error (status=%d) at %s, line %d", \
  244.   __ckvms_sts,__FILE__,__LINE__); } } STMT_END
  245.  
  246. /* Same thing, but don't call back to Perl's croak(); useful for errors
  247.  * occurring during startup, before Perl's state is initialized */
  248. #define _ckvmssts_noperl(call) STMT_START { register unsigned long int __ckvms_sts; \
  249.   if (!((__ckvms_sts=(call))&1)) { \
  250.   set_errno(EVMSERR); set_vaxc_errno(__ckvms_sts); \
  251.   fprintf(Perl_debug_log,"Fatal VMS error (status=%d) at %s, line %d", \
  252.   __ckvms_sts,__FILE__,__LINE__); lib$signal(__ckvms_sts); } } STMT_END
  253.  
  254. #ifdef VMS_DO_SOCKETS
  255. #include "sockadapt.h"
  256. #endif
  257.  
  258. #define BIT_BUCKET "_NLA0:"
  259. #define PERL_SYS_INIT(c,v)    vms_image_init((c),(v)); MALLOC_INIT
  260. #define PERL_SYS_TERM()        OP_REFCNT_TERM; MALLOC_TERM
  261. #define dXSUB_SYS
  262. #define HAS_KILL
  263. #define HAS_WAIT
  264.  
  265. #define PERL_FS_VER_FMT        "%d_%d_%d"
  266. /* Temporary; we need to add support for this to Configure.Com */
  267. #ifdef PERL_INC_VERSION_LIST
  268. #  undef PERL_INC_VERSION_LIST
  269. #endif
  270.  
  271. /* VMS:
  272.  *    This symbol, if defined, indicates that the program is running under
  273.  *    VMS.  It's a symbol automagically defined by all VMS C compilers I've seen.
  274.  * Just in case, however . . . */
  275. #ifndef VMS
  276. #define VMS        /**/
  277. #endif
  278.  
  279. /* HAS_IOCTL:
  280.  *    This symbol, if defined, indicates that the ioctl() routine is
  281.  *    available to set I/O characteristics
  282.  */
  283. #undef    HAS_IOCTL        /**/
  284.  
  285. /* HAS_UTIME:
  286.  *    This symbol, if defined, indicates that the routine utime() is
  287.  *    available to update the access and modification times of files.
  288.  */
  289. #define HAS_UTIME        /**/
  290.  
  291. /* HAS_GROUP
  292.  *    This symbol, if defined, indicates that the getgrnam() and
  293.  *    getgrgid() routines are available to get group entries.
  294.  *    The getgrent() has a separate definition, HAS_GETGRENT.
  295.  */
  296. #undef HAS_GROUP        /**/
  297.  
  298. /* HAS_PASSWD
  299.  *    This symbol, if defined, indicates that the getpwnam() and
  300.  *    getpwuid() routines are available to get password entries.
  301.  *    The getpwent() has a separate definition, HAS_GETPWENT.
  302.  */
  303. #define HAS_PASSWD        /**/
  304.  
  305. #define HAS_KILL
  306. #define HAS_WAIT
  307.   
  308. /* USEMYBINMODE
  309.  *    This symbol, if defined, indicates that the program should
  310.  *    use the routine my_binmode(FILE *fp, char iotype, int mode) to insure
  311.  *    that a file is in "binary" mode -- that is, that no translation
  312.  *    of bytes occurs on read or write operations.
  313.  */
  314. #undef USEMYBINMODE
  315.  
  316. /* Stat_t:
  317.  *    This symbol holds the type used to declare buffers for information
  318.  *    returned by stat().  It's usually just struct stat.  It may be necessary
  319.  *    to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
  320.  *    information.
  321.  */
  322. /* VMS:
  323.  * We need this typedef to point to the new type even if DONT_MASK_RTL_CALLS
  324.  * is in effect, since Perl's thread.h embeds one of these structs in its
  325.  * thread data struct, and our struct mystat is a different size from the
  326.  * regular struct stat (cf. note above about having to pad struct to work
  327.  * around bug in compiler.)
  328.  * It's OK to pass one of these to the RTL's stat(), though, since the
  329.  * fields it fills are the same in each struct.
  330.  */
  331. #define Stat_t struct mystat
  332.  
  333. /* USE_STAT_RDEV:
  334. *    This symbol is defined if this system has a stat structure declaring
  335. *    st_rdev
  336. *    VMS: Field exists in POSIXish version of struct stat(), but is not used.
  337. */
  338. #undef USE_STAT_RDEV        /**/
  339.  
  340. /*
  341.  * fwrite1() should be a routine with the same calling sequence as fwrite(),
  342.  * but which outputs all of the bytes requested as a single stream (unlike
  343.  * fwrite() itself, which on some systems outputs several distinct records
  344.  * if the number_of_items parameter is >1).
  345.  */
  346. #define fwrite1 my_fwrite
  347.  
  348. /* By default, flush data all the way to disk, not just to RMS buffers */
  349. #define Fflush(fp) my_flush(fp)
  350.  
  351. /* Use our own rmdir() */
  352. #define rmdir(name) do_rmdir(name)
  353.  
  354. /* Assorted fiddling with sigs . . . */
  355. # include <signal.h>
  356. #define ABORT() abort()
  357.     /* VAXC's signal.h doesn't #define SIG_ERR, but provides BADSIG instead. */
  358. #if !defined(SIG_ERR) && defined(BADSIG)
  359. #  define SIG_ERR BADSIG
  360. #endif
  361.  
  362.  
  363. /* Used with our my_utime() routine in vms.c */
  364. struct utimbuf {
  365.   time_t actime;
  366.   time_t modtime;
  367. };
  368. #define utime my_utime
  369.  
  370. /* This is what times() returns, but <times.h> calls it tbuffer_t on VMS
  371.  * prior to v7.0.  We check the DECC manifest to see whether it's already
  372.  * done this for us, relying on the fact that perl.h #includes <time.h>
  373.  * before it #includes "vmsish.h".
  374.  */
  375.  
  376. #ifndef __TMS
  377.   struct tms {
  378.     clock_t tms_utime;    /* user time */
  379.     clock_t tms_stime;    /* system time - always 0 on VMS */
  380.     clock_t tms_cutime;   /* user time, children */
  381.     clock_t tms_cstime;   /* system time, children - always 0 on VMS */
  382.   };
  383. #else
  384.    /* The new headers change the times() prototype to tms from tbuffer */
  385. #  define tbuffer_t struct tms
  386. #endif
  387.  
  388. /* Substitute our own routines for gmtime(), localtime(), and time(),
  389.  * which allow us to implement the vmsish 'time' pragma, and work
  390.  * around absence of system-level UTC support on old versions of VMS.
  391.  */
  392. #define gmtime(t) my_gmtime(t)
  393. #define localtime(t) my_localtime(t)
  394. #define time(t) my_time(t)
  395.  
  396. /* If we're using an older version of VMS whose Unix signal emulation
  397.  * isn't very POSIXish, then roll our own.
  398.  */
  399. #if __VMS_VER < 70000000 || __DECC_VER < 50200000
  400. #  define HOMEGROWN_POSIX_SIGNALS
  401. #endif
  402. #ifdef HOMEGROWN_POSIX_SIGNALS
  403. #  define sigemptyset(t) my_sigemptyset(t)
  404. #  define sigfillset(t) my_sigfillset(t)
  405. #  define sigaddset(t, u) my_sigaddset(t, u)
  406. #  define sigdelset(t, u) my_sigdelset(t, u)
  407. #  define sigismember(t, u) my_sigismember(t, u)
  408. #  define sigprocmask(t, u, v) my_sigprocmask(t, u, v)
  409. #  ifndef _SIGSET_T
  410.    typedef int sigset_t;
  411. #  endif
  412.    /* The tools for sigprocmask() are there, just not the routine itself */
  413. #  ifndef SIG_UNBLOCK
  414. #    define SIG_UNBLOCK 1
  415. #  endif
  416. #  ifndef SIG_BLOCK
  417. #    define SIG_BLOCK 2
  418. #  endif
  419. #  ifndef SIG_SETMASK
  420. #    define SIG_SETMASK 3
  421. #  endif
  422. #  define sigaction sigvec
  423. #  define sa_flags sv_onstack
  424. #  define sa_handler sv_handler
  425. #  define sa_mask sv_mask
  426. #  define sigsuspend(set) sigpause(*set)
  427. #  define sigpending(a) (not_here("sigpending"),0)
  428. #endif
  429.  
  430. /* VMS doesn't use a real sys_nerr, but we need this when scanning for error
  431.  * messages in text strings . . .
  432.  */
  433.  
  434. #define sys_nerr EVMSERR  /* EVMSERR is as high as we can go. */
  435.  
  436. /* Look up new %ENV values on the fly */
  437. #define DYNAMIC_ENV_FETCH 1
  438. #define ENV_HV_NAME "%EnV%VmS%"
  439.   /* Special getenv function for retrieving %ENV elements. */
  440. #define ENVgetenv(v) my_getenv(v,FALSE)
  441. #define ENVgetenv_len(v,l) my_getenv_len(v,l,FALSE)
  442.  
  443.  
  444. /* Thin jacket around cuserid() tomatch Unix' calling sequence */
  445. #define getlogin my_getlogin
  446.  
  447. /* Ditto for sys$hash_passwrod() . . . */
  448. #define crypt  my_crypt
  449.  
  450. /* Tweak arg to mkdir first, so we can tolerate trailing /. */
  451. #define Mkdir(dir,mode) my_mkdir((dir),(mode))
  452.  
  453. /* Use our own stat() clones, which handle Unix-style directory names */
  454. #define Stat(name,bufptr) flex_stat(name,bufptr)
  455. #define Fstat(fd,bufptr) flex_fstat(fd,bufptr)
  456.  
  457. /* Setup for the dirent routines:
  458.  * opendir(), closedir(), readdir(), seekdir(), telldir(), and
  459.  * vmsreaddirversions(), and preprocessor stuff on which these depend:
  460.  *    Written by Rich $alz, <rsalz@bbn.com> in August, 1990.
  461.  */
  462.     /* Data structure returned by READDIR(). */
  463. struct dirent {
  464.     char    d_name[256];        /* File name        */
  465.     int        d_namlen;            /* Length of d_name */
  466.     int        vms_verscount;        /* Number of versions    */
  467.     int        vms_versions[20];    /* Version numbers    */
  468. };
  469.  
  470.     /* Handle returned by opendir(), used by the other routines.  You
  471.      * are not supposed to care what's inside this structure. */
  472. typedef struct _dirdesc {
  473.     long            context;
  474.     int                vms_wantversions;
  475.     unsigned long int           count;
  476.     char            *pattern;
  477.     struct dirent        entry;
  478.     struct dsc$descriptor_s    pat;
  479. } DIR;
  480.  
  481. #define rewinddir(dirp)        seekdir((dirp), 0)
  482.  
  483. /* used for our emulation of getpw* */
  484. struct passwd {
  485.         char    *pw_name;    /* Username */
  486.         char    *pw_passwd;
  487.         Uid_t   pw_uid;      /* UIC member number */
  488.         Gid_t   pw_gid;      /* UIC group  number */
  489.         char    *pw_comment; /* Default device/directory (Unix-style) */
  490.         char    *pw_gecos;   /* Owner */
  491.         char    *pw_dir;     /* Default device/directory (VMS-style) */
  492.         char    *pw_shell;   /* Default CLI name (eg. DCL) */
  493. };
  494. #define pw_unixdir pw_comment  /* Default device/directory (Unix-style) */
  495. #define getpwnam my_getpwnam
  496. #define getpwuid my_getpwuid
  497. #define getpwent my_getpwent
  498. #define endpwent my_endpwent
  499. #define setpwent my_endpwent
  500.  
  501. /* Our own stat_t substitute, since we play with st_dev and st_ino -
  502.  * we want atomic types so Unix-bound code which compares these fields
  503.  * for two files will work most of the time under VMS.
  504.  * N.B. 1. The st_ino hack assumes that sizeof(unsigned short[3]) ==
  505.  * sizeof(unsigned) + sizeof(unsigned short).  We can't use a union type
  506.  * to map the unsigned int we want and the unsigned short[3] the CRTL
  507.  * returns into the same member, since gcc has different ideas than DECC
  508.  * and VAXC about sizing union types.
  509.  * N.B 2. The routine cando() in vms.c assumes that &stat.st_ino is the
  510.  * address of a FID.
  511.  */
  512. /* First, grab the system types, so we don't clobber them later */
  513. #include <stat.h>
  514. /* Since we've got to match the size of the CRTL's stat_t, we need
  515.  * to mimic DECC's alignment settings.
  516.  */
  517. #if defined(__DECC) || defined(__DECCXX)
  518. #  pragma __member_alignment __save
  519. #  pragma __nomember_alignment
  520. #endif
  521. #if defined(__DECC) 
  522. #  pragma __message __save
  523. #  pragma __message disable (__MISALGNDSTRCT)
  524. #  pragma __message disable (__MISALGNDMEM)
  525. #endif
  526. struct mystat
  527. {
  528.         char *st_devnam;  /* pointer to device name */
  529.         unsigned st_ino;    /* hack - CRTL uses unsigned short[3] for */
  530.         unsigned short rvn; /* FID (num,seq,rvn) */
  531.         unsigned short st_mode;    /* file "mode" i.e. prot, dir, reg, etc. */
  532.         int    st_nlink;    /* for compatibility - not really used */
  533.         unsigned st_uid;    /* from ACP - QIO uic field */
  534.         unsigned short st_gid;    /* group number extracted from st_uid */
  535.         dev_t   st_rdev;    /* for compatibility - always zero */
  536.         off_t   st_size;    /* file size in bytes */
  537.         unsigned st_atime;    /* file access time; always same as st_mtime */
  538.         unsigned st_mtime;    /* last modification time */
  539.         unsigned st_ctime;    /* file creation time */
  540.         char    st_fab_rfm;    /* record format */
  541.         char    st_fab_rat;    /* record attributes */
  542.         char    st_fab_fsz;    /* fixed header size */
  543.         unsigned st_dev;    /* encoded device name */
  544.         /* Pad struct out to integral number of longwords, since DECC 5.6/VAX
  545.          * has a bug in dealing with offsets in structs in which are embedded
  546.          * other structs whose size is an odd number of bytes.  (An even
  547.          * number of bytes is enough to make it happy, but we go for natural
  548.          * alignment anyhow.)
  549.          */
  550.         char    st_fill1[sizeof(void *) - (3*sizeof(unsigned short) + 3*sizeof(char))%sizeof(void *)];
  551. };
  552. typedef unsigned mydev_t;
  553. typedef unsigned myino_t;
  554.  
  555. /*
  556.  * DEC C previous to 6.0 corrupts the behavior of the /prefix
  557.  * qualifier with the extern prefix pragma.  This provisional
  558.  * hack circumvents this prefix pragma problem in previous 
  559.  * precompilers.
  560.  */
  561. #if defined(__VMS_VER) && __VMS_VER >= 70000000
  562. #  if defined(VMS_WE_ARE_CASE_SENSITIVE) && (__DECC_VER < 60000000)
  563. #    pragma __extern_prefix save
  564. #    pragma __extern_prefix ""  /* set to empty to prevent prefixing */
  565. #    define geteuid decc$__unix_geteuid
  566. #    define getuid decc$__unix_getuid
  567. #    define stat(__p1,__p2)   decc$__utc_stat(__p1,__p2)
  568. #    define fstat(__p1,__p2)  decc$__utc_fstat(__p1,__p2)
  569. #    pragma __extern_prefix restore
  570. #  endif
  571. #endif
  572.  
  573. #ifndef DONT_MASK_RTL_CALLS  /* defined for vms.c so we can see RTL calls */
  574. #  ifdef stat
  575. #    undef stat
  576. #  endif
  577. #  define stat mystat
  578. #  define dev_t mydev_t
  579. #  define ino_t myino_t
  580. #endif
  581. #if defined(__DECC) || defined(__DECCXX)
  582. #  pragma __member_alignment __restore
  583. #endif
  584. #if defined(__DECC) 
  585. #  pragma __message __restore
  586. #endif
  587. /* Cons up a 'delete' bit for testing access */
  588. #define S_IDUSR (S_IWUSR | S_IXUSR)
  589. #define S_IDGRP (S_IWGRP | S_IXGRP)
  590. #define S_IDOTH (S_IWOTH | S_IXOTH)
  591.  
  592.  
  593. /* Prototypes for functions unique to vms.c.  Don't include replacements
  594.  * for routines in the mainline source files excluded by #ifndef VMS;
  595.  * their prototypes are already in proto.h.
  596.  *
  597.  * In order to keep Gen_ShrFls.Pl happy, functions which are to be made
  598.  * available to images linked to PerlShr.Exe must be declared between the
  599.  * __VMS_PROTOTYPES__ and __VMS_SEPYTOTORP__ lines, and must be in the form
  600.  *    <data type><TAB>name<WHITESPACE>(<prototype args>);
  601.  */
  602.  
  603. #ifdef NO_PERL_TYPEDEFS
  604.   /* We don't have Perl typedefs available (e.g. when building a2p), so
  605.      we fake them here.  N.B.  There is *no* guarantee that the faked
  606.      prototypes will actually match the real routines.  If you want to
  607.      call Perl routines, include perl.h to get the real typedefs.  */
  608. #  ifndef bool
  609. #    define bool int
  610. #    define __MY_BOOL_TYPE_FAKE
  611. #  endif
  612. #  ifndef I32
  613. #    define I32  int
  614. #    define __MY_I32_TYPE_FAKE
  615. #  endif
  616. #  ifndef SV
  617. #    define SV   void   /* Since we only see SV * in prototypes */
  618. #    define __MY_SV_TYPE_FAKE
  619. #  endif
  620. #endif
  621.  
  622. void    prime_env_iter (void);
  623. void    init_os_extras ();
  624. /* prototype section start marker; `typedef' passes through cpp */
  625. typedef char  __VMS_PROTOTYPES__;
  626. int    vmstrnenv (const char *, char *, unsigned long int, struct dsc$descriptor_s **, unsigned long int);
  627. int    my_trnlnm (const char *, char *, unsigned long int);
  628. #if !defined(PERL_IMPLICIT_CONTEXT)
  629. char *    Perl_my_getenv (const char *, bool);
  630. #else
  631. char *    Perl_my_getenv (pTHX_ const char *, bool);
  632. #endif
  633. char *    my_getenv_len (const char *, unsigned long *, bool);
  634. int    vmssetenv (char *, char *, struct dsc$descriptor_s **);
  635. char *    my_crypt (const char *, const char *);
  636. Pid_t    my_waitpid (Pid_t, int *, int);
  637. char *    my_gconvert (double, int, int, char *);
  638. int    do_rmdir (char *);
  639. int    kill_file (char *);
  640. int    my_mkdir (char *, Mode_t);
  641. int    my_utime (char *, struct utimbuf *);
  642. char *    rmsexpand (char *, char *, char *, unsigned);
  643. char *    rmsexpand_ts (char *, char *, char *, unsigned);
  644. char *    fileify_dirspec (char *, char *);
  645. char *    fileify_dirspec_ts (char *, char *);
  646. char *    pathify_dirspec (char *, char *);
  647. char *    pathify_dirspec_ts (char *, char *);
  648. char *    tounixspec (char *, char *);
  649. char *    tounixspec_ts (char *, char *);
  650. char *    tovmsspec (char *, char *);
  651. char *    tovmsspec_ts (char *, char *);
  652. char *    tounixpath (char *, char *);
  653. char *    tounixpath_ts (char *, char *);
  654. char *    tovmspath (char *, char *);
  655. char *    tovmspath_ts (char *, char *);
  656. void    vms_image_init (int *, char ***);
  657. DIR *    opendir (char *);
  658. struct dirent *    readdir (DIR *);
  659. long    telldir (DIR *);
  660. void    seekdir (DIR *, long);
  661. void    closedir (DIR *);
  662. void    vmsreaddirversions (DIR *, int);
  663. struct tm *    my_gmtime (const time_t *);
  664. struct tm *    my_localtime (const time_t *);
  665. time_t    my_time (time_t *);
  666. #ifdef HOMEGROWN_POSIX_SIGNALS
  667. int     my_sigemptyset (sigset_t *);
  668. int     my_sigfillset  (sigset_t *);
  669. int     my_sigaddset   (sigset_t *, int);
  670. int     my_sigdelset   (sigset_t *, int);
  671. int     my_sigismember (sigset_t *, int);
  672. int     my_sigprocmask (int, sigset_t *, sigset_t *);
  673. #endif
  674. I32    cando_by_name (I32, Uid_t, char *);
  675. int    flex_fstat (int, Stat_t *);
  676. int    flex_stat (const char *, Stat_t *);
  677. int    trim_unixpath (char *, char*, int);
  678. int    my_vfork ();
  679. bool    vms_do_aexec (SV *, SV **, SV **);
  680. bool    vms_do_exec (char *);
  681. unsigned long int    do_aspawn (void *, void **, void **);
  682. unsigned long int    do_spawn (char *);
  683. int    my_fwrite (void *, size_t, size_t, FILE *);
  684. int    my_flush (FILE *);
  685. struct passwd *    my_getpwnam (char *name);
  686. struct passwd *    my_getpwuid (Uid_t uid);
  687. struct passwd *    my_getpwent ();
  688. void    my_endpwent ();
  689. char *    my_getlogin ();
  690. int    rmscopy (char *, char *, int);
  691. typedef char __VMS_SEPYTOTORP__;
  692. /* prototype section end marker; `typedef' passes through cpp */
  693.  
  694. #ifdef NO_PERL_TYPEDEFS  /* We'll try not to scramble later files */
  695. #  ifdef __MY_BOOL_TYPE_FAKE
  696. #    undef bool
  697. #    undef __MY_BOOL_TYPE_FAKE
  698. #  endif
  699. #  ifdef __MY_I32_TYPE_FAKE
  700. #    undef I32
  701. #    undef __MY_I32_TYPE_FAKE
  702. #  endif
  703. #  ifdef __MY_SV_TYPE_FAKE
  704. #    undef SV
  705. #    undef __MY_SV_TYPE_FAKE
  706. #  endif
  707. #endif
  708.  
  709. #ifndef VMS_DO_SOCKETS
  710. /* This relies on tricks in perl.h to pick up that these manifest constants
  711.  * are undefined and set up conversion routines.  It will then redefine
  712.  * these manifest constants, so the actual values will match config.h
  713.  */
  714. #undef HAS_HTONS
  715. #undef HAS_NTOHS
  716. #undef HAS_HTONL
  717. #undef HAS_NTOHL
  718. #endif
  719.  
  720. /* The C RTL manual says to undef the macro for DEC C 5.2 and lower. */
  721. #if defined(fileno) && defined(__DECC_VER) && __DECC_VER < 50300000
  722. #  undef fileno 
  723. #endif 
  724.  
  725. #endif  /* __vmsish_h_included */
  726.