$ use64bitall = "n"
$ use64bitint = "n"
$ uselargefiles = "n"
+$ usestdstat = "n"
$ usesitecustomize = "n"
$ C_Compiler_Replace = "CC="
$ thread_upcalls = "MTU="
$!
$ IF uselargefiles .OR. uselargefiles .eqs. "define"
$ THEN
+$ echo4 "Largefile support enabled (plus standard stat support on V8.2 and later)"
+$ usestdstat = "y"
$ IF (vms_ver .GES. "8.2") .AND. (archname .NES. "VMS_VAX")
$ THEN
$ echo4 -
$ WC "ccdlflags='" + ccdlflags + "'"
$ IF uselargefiles .OR. uselargefiles .EQS. "define"
$ THEN
-$! Perl can not use _USE_STD_STAT at the moment
-$! IF d_symlink .OR. d_symlink .EQS. "define"
-$! THEN
-$! ccdefines = "_USE_STD_STAT=1"
-$! ELSE
+$ IF usestdstat .OR. usestdstat .EQS. "define"
+$ THEN
+$ ccdefines = "_USE_STD_STAT=1"
+$ ELSE
$ ccdefines = "_LARGEFILE=1"
-$! ENDIF
+$ ENDIF
$ ELSE
$ ccdefines = ""
$ ENDIF
$ ENDIF
$ IF uselargefiles .OR. uselargefiles .EQS. "define"
$ THEN
-$! Perl can not use _USE_STD_STAT at the moment
-$! IF d_symlink .or. d_symlink .eqs. "define"
-$! THEN
-$! LARGEFILE_REPLACE = "LARGEFILE=LARGEFILE=_USE_STD_STAT=1"
-$! ELSE
+$ IF usestdstat .or. usestdstat .eqs. "define"
+$ THEN
+$ LARGEFILE_REPLACE = "LARGEFILE=LARGEFILE=_USE_STD_STAT=1"
+$ ELSE
$ LARGEFILE_REPLACE = "LARGEFILE=LARGEFILE=_LARGEFILE=1"
-$! ENDIF
+$ ENDIF
$ ELSE
$ LARGEFILE_REPLACE = "LARGEFILE="
$ ENDIF
#include <uicdef.h>
#include <stsdef.h>
#include <rmsdef.h>
+#if __CRTL_VER >= 70000000 /* FIXME to earliest version */
+#include <efndef.h>
+#define NO_EFN EFN$C_ENF
+#else
+#define NO_EFN 0;
+#endif
#if __CRTL_VER < 70301000 && __CRTL_VER >= 70300000
int decc$feature_get_index(const char *name);
#include <unixlib.h>
#endif
+#pragma member_alignment save
+#pragma nomember_alignment longword
+struct item_list_3 {
+ unsigned short len;
+ unsigned short code;
+ void * bufadr;
+ unsigned short * retadr;
+};
+#pragma member_alignment restore
+
+/* More specific prototype than in starlet_c.h makes programming errors
+ more visible.
+ */
+#ifdef sys$getdviw
+#undef sys$getdviw
+#endif
+int sys$getdviw
+ (unsigned long efn,
+ unsigned short chan,
+ const struct dsc$descriptor_s * devnam,
+ const struct item_list_3 * itmlst,
+ void * iosb,
+ void * (astadr)(unsigned long),
+ void * astprm,
+ void * nullarg);
+
#if __CRTL_VER >= 70300000 && !defined(__VAX)
static int set_feature_default(const char *name, int value)
/* things like terminals and mbx's don't need this filter */
if (fd && fstat(fd,&s) == 0) {
unsigned long dviitm = DVI$_DEVCHAR, devchar;
- struct dsc$descriptor_s d_dev = {strlen(s.st_dev), DSC$K_DTYPE_T,
- DSC$K_CLASS_S, s.st_dev};
-
- _ckvmssts(lib$getdvi(&dviitm,0,&d_dev,&devchar,0,0));
- if (!(devchar & DEV$M_DIR)) { /* non directory structured...*/
- strcpy(out, s.st_dev);
- return 0;
- }
+ char device[65];
+ unsigned short dev_len;
+ struct dsc$descriptor_s d_dev;
+ char * cptr;
+ struct item_list_3 items[3];
+ int status;
+ unsigned short dvi_iosb[4];
+
+ cptr = getname(fd, out, 1);
+ if (cptr == NULL) _ckvmssts(SS$_NOSUCHDEV);
+ d_dev.dsc$a_pointer = out;
+ d_dev.dsc$w_length = strlen(out);
+ d_dev.dsc$b_dtype = DSC$K_DTYPE_T;
+ d_dev.dsc$b_class = DSC$K_CLASS_S;
+
+ items[0].len = 4;
+ items[0].code = DVI$_DEVCHAR;
+ items[0].bufadr = &devchar;
+ items[0].retadr = NULL;
+ items[1].len = 64;
+ items[1].code = DVI$_FULLDEVNAM;
+ items[1].bufadr = device;
+ items[1].retadr = &dev_len;
+ items[2].len = 0;
+ items[2].code = 0;
+
+ status = sys$getdviw
+ (NO_EFN, 0, &d_dev, items, dvi_iosb, NULL, NULL, NULL);
+ _ckvmssts(status);
+ if ($VMS_STATUS_SUCCESS(dvi_iosb[0])) {
+ device[dev_len] = 0;
+
+ if (!(devchar & DEV$M_DIR)) {
+ strcpy(out, device);
+ return 0;
+ }
+ }
}
_ckvmssts(lib$get_vm(&n, &p));
unsigned int table = LIB$K_CLI_LOCAL_SYM;
int j, wait = 0, n;
char *p, mode[10], symbol[MAX_DCL_SYMBOL+1], *vmspipe;
- char in[512], out[512], err[512], mbx[512];
+ char *in, *out, *err, mbx[512];
FILE *tpipe = 0;
char tfilebuf[NAM$C_MAXRSS+1];
pInfo info = NULL;
info->in_done = TRUE;
info->out_done = TRUE;
info->err_done = TRUE;
+
+ in = PerlMem_malloc(VMS_MAXRSS);
+ if (in == NULL) _ckvmssts(SS$_INSFMEM);
+ out = PerlMem_malloc(VMS_MAXRSS);
+ if (out == NULL) _ckvmssts(SS$_INSFMEM);
+ err = PerlMem_malloc(VMS_MAXRSS);
+ if (err == NULL) _ckvmssts(SS$_INSFMEM);
+
in[0] = out[0] = err[0] = '\0';
if ((p = strchr(mode,'F')) != NULL) { /* F -> use FILE* */
d_symbol.dsc$w_length = strlen(symbol);
_ckvmssts(lib$set_symbol(&d_sym_out, &d_symbol, &table));
+ /* Done with the names for the pipes */
+ PerlMem_free(err);
+ PerlMem_free(out);
+ PerlMem_free(in);
+
p = vmscmd->dsc$a_pointer;
while (*p == ' ' || *p == '\t') p++; /* remove leading whitespace */
if (*p == '$') p++; /* remove leading $ */
return (enc | LOCKID_MASK); /* May have already overflowed into bit 31 */
} /* end of encode_dev() */
+#define VMS_DEVICE_ENCODE(device_no, devname, new_dev_no) \
+ device_no = encode_dev(aTHX_ devname)
+#else
+#define VMS_DEVICE_ENCODE(device_no, devname, new_dev_no) \
+ device_no = new_dev_no
#endif
static int
PerlMem_free(vms_filename);
VMS_INO_T_COPY(statbufp->st_ino, statbufp->crtl_stat.st_ino);
-#ifndef _USE_STD_STAT
- statbufp->st_dev = encode_dev(aTHX_ statbufp->st_devnam);
-#endif
+ VMS_DEVICE_ENCODE
+ (statbufp->st_dev, statbufp->st_devnam, statbufp->crtl_stat.st_dev);
# ifdef RTL_USES_UTC
# ifdef VMSISH_TIME
if (decc_bug_devnull != 0) {
if (is_null_device(temp_fspec)) { /* Fake a stat() for the null device */
memset(statbufp,0,sizeof *statbufp);
- statbufp->st_dev = encode_dev(aTHX_ "_NLA0:");
+ VMS_DEVICE_ENCODE(statbufp->st_dev, "_NLA0:", 0);
statbufp->st_mode = S_IFBLK | S_IREAD | S_IWRITE | S_IEXEC;
statbufp->st_uid = 0x00010001;
statbufp->st_gid = 0x0001;
statbufp->st_devnam[0] = 0;
VMS_INO_T_COPY(statbufp->st_ino, statbufp->crtl_stat.st_ino);
-#ifndef _USE_STD_STAT
- statbufp->st_dev = encode_dev(aTHX_ statbufp->st_devnam);
-#endif
+ VMS_DEVICE_ENCODE
+ (statbufp->st_dev, statbufp->st_devnam, statbufp->crtl_stat.st_dev);
# ifdef RTL_USES_UTC
# ifdef VMSISH_TIME
if (VMSISH_TIME) {
projects / p5sagit/p5-mst-13.2.git / commitdiff