Context Navigation

source: trunk/third/perl/vms/vmsish.h @ 18450

Visit:

Revision 18450, 29.7 KB checked in by zacheiss, 21 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r18449, which included commits to RCS files with non-trunk default branches.

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: