}
if (!thatio) {
#ifdef EINVAL
- SETERRNO(EINVAL,VMS_SS_IVCHAN);
+ SETERRNO(EINVAL,SS$_IVCHAN);
#endif
goto say_false;
}
gv = PL_argvgv;
if (!gv || SvTYPE(gv) != SVt_PVGV) {
if (not_implicit)
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
return FALSE;
}
io = GvIO(gv);
if (not_implicit) {
if (ckWARN(WARN_UNOPENED)) /* no check for closed here */
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
}
return FALSE;
}
IoOFP(io) = IoIFP(io) = Nullfp;
}
else if (not_implicit) {
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
}
return retval;
}
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_RMS_IFI);
+ SETERRNO(EBADF,RMS$_IFI);
return (Off_t)-1;
}
}
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_RMS_IFI);
+ SETERRNO(EBADF,RMS$_IFI);
return FALSE;
}
return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence);
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_RMS_IFI);
+ SETERRNO(EBADF,RMS$_IFI);
return (Off_t)-1;
}
opbuf = SvPV(opstr, opsize);
if (opsize < 3 * SHORTSIZE
|| (opsize % (3 * SHORTSIZE))) {
- SETERRNO(EINVAL,VMS_LIB_INVARG);
+ SETERRNO(EINVAL,LIB$_INVARG);
return -1;
}
SETERRNO(0,0);
if (shmctl(id, IPC_STAT, &shmds) == -1)
return -1;
if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
- SETERRNO(EFAULT,VMS_SS_ACCVIO); /* can't do as caller requested */
+ SETERRNO(EFAULT,SS$_ACCVIO); /* can't do as caller requested */
return -1;
}
shm = (char *)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
break;
case '!':
- /* Don't be merge these two SETERRNO calls because
- * the idea is to make non-VMS places not to see
- * the dollar in the identifier: that is non-ANSI. */
-#ifdef VMS
- SETERRNO(0, (SvIV(sv) == EVMSERR) ? 4 : vaxc$errno);
-#else
- SETERRNO(SvIOK(sv) ? SvIVX(sv) : SvOK(sv) ? sv_2iv(sv) : 0, 0);
-#endif
+ SETERRNO(SvIOK(sv) ? SvIVX(sv) : SvOK(sv) ? sv_2iv(sv) : 0,
+ (SvIV(sv) == EVMSERR) ? 4 : vaxc$errno);
break;
case '<':
PL_uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
long _stksize = 64 * 1024;
#endif
-/* If the compiler is in such a strict mood that it doesn't
- * even like the third argument of main(). */
-#if (defined(__DECC) && defined(__STDC__) && __STDC__ == 1)
-# define STRICT_ANSI_DISLIKES_ENVP
-#endif
-
int
-main(int argc, char **argv
-#ifndef STRICT_ANSI_DISLIKES_ENVP
- , char **envp
-#endif
- )
+main(int argc, char **argv, char **env)
{
int exitstatus;
/* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */
PERL_GPROF_MONCONTROL(0);
- /* The default PERL_SYS_INIT3 ignores envp but e.g. OS/2 uses it. */
- PERL_SYS_INIT3(&argc,&argv,&envp);
+ PERL_SYS_INIT3(&argc,&argv,&env);
#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
/* XXX Ideally, this should really be happening in perl_alloc() or
/* now parse the script */
- SETERRNO(0,VMS_SS_NORMAL);
+ SETERRNO(0,SS$_NORMAL);
PL_error_count = 0;
#ifdef MACOS_TRADITIONAL
if (gMacPerl_SyntaxError = (yyparse() || PL_error_count)) {
# define SETERRNO(errcode,vmserrcode) (errno = (errcode))
#endif
-/* These definitions are sneaky.
- * Their only purpose is to avoid warnings on strict ANSI (non-VMS)
- * compilers which can get huffy about dollars in identifiers,
- * which is common practise in VMS. The definitions in the
- * non-VMS branch are not used (since the VMS error code is
- * unsurprisingly not of much use in non-VMS) -- but their only
- * point is to be something non-dollared. Neither are all instances
- * of dollared variables hidden this way, only at the spots where
- * non-VMS platforms see them. */
-#ifdef VMS
-#define VMS_LIB_INVARGV LIB$_INVARG
-#define VMS_RMS_DIR RMS$_DIR
-#define VMS_RMS_FAC RMS$_FAC
-#define VMS_RMS_IFI RMS$_IFI
-#define VMS_RMS_ISI RMS$_ISI
-#define VMS_SS_ACCVIO SS$_ACCVIO
-#define VMS_SS_IVCHAN SS$_IVCHAN
-#define VMS_SS_NORMAL SS$_NORMAL
-#else
-#define VMS_LIB_INVARG EINVAL
-#define VMS_RMS_DIR EBADF
-#define VMS_RMS_FAC 0
-#define VMS_RMS_IFI EBADF
-#define VMS_RMS_ISI EBADF
-#define VMS_SS_ACCVIO EFAULT
-#define VMS_SS_IVCHAN EBADF
-#define VMS_SS_NORMAL 0
-#endif
-
#ifdef USE_5005THREADS
# define ERRSV (thr->errsv)
# define DEFSV THREADSV(0)
if (f && *f)
return (*PerlIOBase(f)->tab->Close) (f);
else {
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
return -1;
}
}
return new;
}
else {
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
return NULL;
}
}
if (f && *f)
return (*PerlIOBase(f)->tab->Fileno) (f);
else {
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
return -1;
}
}
if (f && *f)
return (*PerlIOBase(f)->tab->Read) (f, vbuf, count);
else {
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
return -1;
}
}
if (f && *f)
return (*PerlIOBase(f)->tab->Unread) (f, vbuf, count);
else {
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
return -1;
}
}
if (f && *f)
return (*PerlIOBase(f)->tab->Write) (f, vbuf, count);
else {
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
return -1;
}
}
if (f && *f)
return (*PerlIOBase(f)->tab->Seek) (f, offset, whence);
else {
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
return -1;
}
}
if (f && *f)
return (*PerlIOBase(f)->tab->Tell) (f);
else {
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
return -1;
}
}
}
else {
PerlIO_debug("Cannot flush f=%p :%s\n", f, tab->name);
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
return -1;
}
}
else {
PerlIO_debug("Cannot flush f=%p\n", f);
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
return -1;
}
}
if (f && *f)
return (*PerlIOBase(f)->tab->Fill) (f);
else {
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
return -1;
}
}
if (f && *f)
return (PerlIOBase(f)->flags & PERLIO_F_UTF8) != 0;
else {
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
return -1;
}
}
if (f && *f)
return (*PerlIOBase(f)->tab->Eof) (f);
else {
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
return -1;
}
}
if (f && *f)
return (*PerlIOBase(f)->tab->Error) (f);
else {
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
return -1;
}
}
if (f && *f)
(*PerlIOBase(f)->tab->Clearerr) (f);
else
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
}
#undef PerlIO_setlinebuf
if (f && *f)
(*PerlIOBase(f)->tab->Setlinebuf) (f);
else
- SETERRNO(EBADF, VMS_SS_IVCHAN);
+ SETERRNO(EBADF, SS$_IVCHAN);
}
#undef PerlIO_has_base
l->flags |= PERLIO_F_TRUNCATE | PERLIO_F_CANWRITE;
break;
default:
- SETERRNO(EINVAL, VMS_LIB_INVARG);
+ SETERRNO(EINVAL, LIB$_INVARG);
return -1;
}
while (*mode) {
l->flags |= PERLIO_F_CRLF;
break;
default:
- SETERRNO(EINVAL, VMS_LIB_INVARG);
+ SETERRNO(EINVAL, LIB$_INVARG);
return -1;
}
}
*/
oflags |= O_BINARY;
if (*mode || oflags == -1) {
- SETERRNO(EINVAL, VMS_LIB_INVARG);
+ SETERRNO(EINVAL, LIB$_INVARG);
oflags = -1;
}
return oflags;
if (!page_size) {
#if defined(HAS_SYSCONF) && (defined(_SC_PAGESIZE) || defined(_SC_PAGE_SIZE))
{
- SETERRNO(0, VMS_SS_NORMAL);
+ SETERRNO(0, SS$_NORMAL);
# ifdef _SC_PAGESIZE
page_size = sysconf(_SC_PAGESIZE);
# else
if (f && len == sizeof(Off_t))
return PerlIO_seek(f, *posn, SEEK_SET);
}
- SETERRNO(EINVAL, VMS_SS_IVCHAN);
+ SETERRNO(EINVAL, SS$_IVCHAN);
return -1;
}
#else
#endif
}
}
- SETERRNO(EINVAL, VMS_SS_IVCHAN);
+ SETERRNO(EINVAL, SS$_IVCHAN);
return -1;
}
#endif
RETPUSHUNDEF;
}
else
- SETERRNO(0, VMS_SS_NORMAL);
+ SETERRNO(0, SS$_NORMAL);
/* Assume success here to prevent recursive requirement. */
len = strlen(name);
goto had_magic;
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_RMS_IFI);
+ SETERRNO(EBADF,RMS$_IFI);
goto just_say_no;
}
else if (!(fp = IoOFP(io))) {
else if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
}
- SETERRNO(EBADF,IoIFP(io)?VMS_RMS_FAC:VMS_RMS_IFI);
+ SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
}
else {
if (!(io = GvIO(gv))) {
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_RMS_IFI);
+ SETERRNO(EBADF,RMS$_IFI);
goto just_say_no;
}
else if (!(fp = IoOFP(io))) {
else if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
}
- SETERRNO(EBADF,IoIFP(io)?VMS_RMS_FAC:VMS_RMS_IFI);
+ SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
}
else {
if (result)
RETPUSHYES;
if (!errno)
- SETERRNO(EBADF,VMS_RMS_IFI);
+ SETERRNO(EBADF,RMS$_IFI);
RETPUSHUNDEF;
}
#else
if (!io || !argsv || !IoIFP(io)) {
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_RMS_IFI); /* well, sort of... */
+ SETERRNO(EBADF,RMS$_IFI); /* well, sort of... */
RETPUSHUNDEF;
}
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
value = 0;
- SETERRNO(EBADF,VMS_RMS_IFI);
+ SETERRNO(EBADF,RMS$_IFI);
}
PUSHi(value);
RETURN;
report_evil_fh(gv, io, PL_op->op_type);
if (IoIFP(io))
do_close(gv, FALSE);
- SETERRNO(EBADF,VMS_LIB_INVARG);
+ SETERRNO(EBADF,LIB$_INVARG);
RETPUSHUNDEF;
}
nuts:
if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_sock_func, "bind");
nuts:
if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_sock_func, "connect");
nuts:
if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_sock_func, "listen");
nuts:
if (ckWARN(WARN_CLOSED))
report_evil_fh(ggv, ggv ? GvIO(ggv) : 0, PL_op->op_type);
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
badexit:
RETPUSHUNDEF;
nuts:
if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_sock_func, "shutdown");
nuts:
if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, optype);
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
RETPUSHUNDEF;
nuts:
if (ckWARN(WARN_CLOSED))
report_evil_fh(gv, io, optype);
- SETERRNO(EBADF,VMS_SS_IVCHAN);
+ SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
RETPUSHUNDEF;
gv = cGVOP_gv;
report_evil_fh(gv, GvIO(gv), PL_op->op_type);
}
- SETERRNO(EBADF,VMS_RMS_IFI);
+ SETERRNO(EBADF,RMS$_IFI);
RETPUSHUNDEF;
}
}
RETPUSHYES;
nope:
if (!errno)
- SETERRNO(EBADF,VMS_RMS_DIR);
+ SETERRNO(EBADF,RMS$_DIR);
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_dir_func, "opendir");
nope:
if (!errno)
- SETERRNO(EBADF,VMS_RMS_ISI);
+ SETERRNO(EBADF,RMS$_ISI);
if (GIMME == G_ARRAY)
RETURN;
else
RETURN;
nope:
if (!errno)
- SETERRNO(EBADF,VMS_RMS_ISI);
+ SETERRNO(EBADF,RMS$_ISI);
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_dir_func, "telldir");
RETPUSHYES;
nope:
if (!errno)
- SETERRNO(EBADF,VMS_RMS_ISI);
+ SETERRNO(EBADF,RMS$_ISI);
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_dir_func, "seekdir");
RETPUSHYES;
nope:
if (!errno)
- SETERRNO(EBADF,VMS_RMS_ISI);
+ SETERRNO(EBADF,RMS$_ISI);
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_dir_func, "rewinddir");
RETPUSHYES;
nope:
if (!errno)
- SETERRNO(EBADF,VMS_RMS_IFI);
+ SETERRNO(EBADF,RMS$_IFI);
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_dir_func, "closedir");
if (pdb)
return pdb;
- SETERRNO(0,VMS_SS_NORMAL);
+ SETERRNO(0,SS$_NORMAL);
return "BEGIN { require 'perl5db.pl' }";
}
return "";