Following 33291, on VMS we need to use the same prototypes other platforms
authorCraig A. Berry <craigberry@mac.com>
Fri, 22 Feb 2008 00:20:45 +0000 (00:20 +0000)
committerDavid Mitchell <davem@iabyn.com>
Mon, 30 Mar 2009 20:09:19 +0000 (21:09 +0100)
use in order to get the do_spawn-related assert macros defined.  Based
on suggestions by John Malmberg.

p4raw-id: //depot/perl@33343

(cherry picked from commit 9ec7171b93c2f7e007fcbb49144b664695f0d21b)

embed.fnc
pp_sys.c
proto.h
vms/vms.c
vms/vmsish.h

index b101c8d..449f366 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -237,7 +237,7 @@ pmb |bool   |do_exec        |NN const char* cmd
 p      |bool   |do_exec        |NN const char* cmd
 #endif
 
-#if defined(WIN32) || defined(__SYMBIAN32__)
+#if defined(WIN32) || defined(__SYMBIAN32__) || defined(VMS)
 Ap     |int    |do_aspawn      |NULLOK SV* really|NN SV** mark|NN SV** sp
 Ap     |int    |do_spawn       |NN char* cmd
 Ap     |int    |do_spawn_nowait|NN char* cmd
index 4fc4dbe..0f61b99 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4174,14 +4174,14 @@ PP(pp_system)
     result = 0;
     if (PL_op->op_flags & OPf_STACKED) {
        SV * const really = *++MARK;
-#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
+#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__) || defined(__VMS)
        value = (I32)do_aspawn(really, MARK, SP);
 #  else
        value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
 #  endif
     }
     else if (SP - MARK != 1) {
-#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
+#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__) || defined(__VMS)
        value = (I32)do_aspawn(NULL, MARK, SP);
 #  else
        value = (I32)do_aspawn(NULL, (void **)MARK, (void **)SP);
diff --git a/proto.h b/proto.h
index 7c41b95..474f165 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -578,7 +578,7 @@ PERL_CALLCONV bool  Perl_do_exec(pTHX_ const char* cmd)
 
 #endif
 
-#if defined(WIN32) || defined(__SYMBIAN32__)
+#if defined(WIN32) || defined(__SYMBIAN32__) || defined(VMS)
 PERL_CALLCONV int      Perl_do_aspawn(pTHX_ SV* really, SV** mark, SV** sp)
                        __attribute__nonnull__(pTHX_2)
                        __attribute__nonnull__(pTHX_3);
index 2503dea..118bc5c 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -10254,12 +10254,10 @@ Perl_vms_do_exec(pTHX_ const char *cmd)
 }  /* end of vms_do_exec() */
 /*}}}*/
 
-unsigned long int Perl_do_spawn(pTHX_ const char *);
-unsigned long int do_spawn2(pTHX_ const char *, int);
+int do_spawn2(pTHX_ const char *, int);
 
-/* {{{ unsigned long int do_aspawn(void *really,void **mark,void **sp) */
-unsigned long int
-Perl_do_aspawn(pTHX_ void *really,void **mark,void **sp)
+int
+Perl_do_aspawn(pTHX_ SV* really, SV** mark, SV** sp)
 {
 unsigned long int sts;
 char * cmd;
@@ -10272,9 +10270,9 @@ int flags = 0;
      * through do_aspawn is a value of 1, which means spawn without
      * waiting for completion -- other values are ignored.
      */
-    if (SvNIOKp(*((SV**)mark+1)) && !SvPOKp(*((SV**)mark+1))) {
+    if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
        ++mark;
-       flags = SvIVx(*(SV**)mark);
+       flags = SvIVx(*mark);
     }
 
     if (flags && flags == 1)     /* the Win32 P_NOWAIT value */
@@ -10282,7 +10280,7 @@ int flags = 0;
     else
         flags = 0;
 
-    cmd = setup_argstr(aTHX_ (SV *)really,(SV **)mark,(SV **)sp);
+    cmd = setup_argstr(aTHX_ really, mark, sp);
     sts = do_spawn2(aTHX_ cmd, flags);
     /* pp_sys will clean up cmd */
     return sts;
@@ -10292,9 +10290,9 @@ int flags = 0;
 /*}}}*/
 
 
-/* {{{unsigned long int do_spawn(char *cmd) */
-unsigned long int
-Perl_do_spawn(pTHX_ const char *cmd)
+/* {{{int do_spawn(char* cmd) */
+int
+Perl_do_spawn(pTHX_ char* cmd)
 {
     PERL_ARGS_ASSERT_DO_SPAWN;
 
@@ -10302,8 +10300,18 @@ Perl_do_spawn(pTHX_ const char *cmd)
 }
 /*}}}*/
 
-/* {{{unsigned long int do_spawn2(char *cmd) */
-unsigned long int
+/* {{{int do_spawn_nowait(char* cmd) */
+int
+Perl_do_spawn_nowait(pTHX_ char* cmd)
+{
+    PERL_ARGS_ASSERT_DO_SPAWN_NOWAIT;
+
+    return do_spawn2(aTHX_ cmd, CLI$M_NOWAIT);
+}
+/*}}}*/
+
+/* {{{int do_spawn2(char *cmd) */
+int
 do_spawn2(pTHX_ const char *cmd, int flags)
 {
   unsigned long int sts, substs;
@@ -13068,6 +13076,8 @@ case_tolerant_process_fromperl(pTHX_ CV *cv)
   XSRETURN(1);
 }
 
+#ifdef USE_ITHREADS
+
 void  
 Perl_sys_intern_dup(pTHX_ struct interp_intern *src, 
                           struct interp_intern *dst)
@@ -13077,6 +13087,8 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src,
     memcpy(dst,src,sizeof(struct interp_intern));
 }
 
+#endif
+
 void  
 Perl_sys_intern_clear(pTHX)
 {
index db35879..48a474a 100644 (file)
@@ -966,8 +966,6 @@ int Perl_flex_lstat (pTHX_ const char *, Stat_t *);
 int    Perl_flex_stat (pTHX_ const char *, Stat_t *);
 int    my_vfork (void);
 bool   Perl_vms_do_exec (pTHX_ const char *);
-unsigned long int      Perl_do_aspawn (pTHX_ void *, void **, void **);
-unsigned long int      Perl_do_spawn (pTHX_ const char *);
 FILE *  my_fdopen (int, const char *);
 int     my_fclose (FILE *);
 int     my_fwrite (const void *, size_t, size_t, FILE *);