# define WORD int16
#endif
+#include <stdio.h>
+
#include <exec/semaphores.h>
#include <exec/exectags.h>
#include <proto/exec.h>
userdata->my_perl = aTHX;
}
+/* AmigaOS specific versions of #?exec#? solely for use in amigaos_system_child
+ */
+
+static void S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
+{
+ const int e = errno;
+// PERL_ARGS_ASSERT_EXEC_FAILED;
+ if (e)
+ {
+ if (ckWARN(WARN_EXEC))
+ Perl_warner(aTHX_ packWARN(WARN_EXEC),
+ "Can't exec \"%s\": %s", cmd, Strerror(e));
+ }
+ if (do_report)
+ {
+ /* XXX silently ignore failures */
+ PERL_UNUSED_RESULT(PerlLIO_write(fd, (void *)&e, sizeof(int)));
+ PerlLIO_close(fd);
+ }
+}
+
+static I32 S_do_amigaos_exec3(pTHX_ const char *incmd, int fd, int do_report)
+{
+ dVAR;
+ const char **a;
+ char *s;
+ char *buf;
+ char *cmd;
+ /* Make a copy so we can change it */
+ const Size_t cmdlen = strlen(incmd) + 1;
+ I32 result = -1;
+
+ PERL_ARGS_ASSERT_DO_EXEC3;
+
+ Newx(buf, cmdlen, char);
+ cmd = buf;
+ memcpy(cmd, incmd, cmdlen);
+
+ while (*cmd && isSPACE(*cmd))
+ cmd++;
+
+ /* see if there are shell metacharacters in it */
+
+ if (*cmd == '.' && isSPACE(cmd[1]))
+ goto doshell;
+
+ if (strnEQ(cmd, "exec", 4) && isSPACE(cmd[4]))
+ goto doshell;
+
+ s = cmd;
+ while (isWORDCHAR(*s))
+ s++; /* catch VAR=val gizmo */
+ if (*s == '=')
+ goto doshell;
+
+ for (s = cmd; *s; s++)
+ {
+ if (*s != ' ' && !isALPHA(*s) &&
+ strchr("$&*(){}[]'\";\\|?<>~`\n", *s))
+ {
+ if (*s == '\n' && !s[1])
+ {
+ *s = '\0';
+ break;
+ }
+ /* handle the 2>&1 construct at the end */
+ if (*s == '>' && s[1] == '&' && s[2] == '1' &&
+ s > cmd + 1 && s[-1] == '2' && isSPACE(s[-2]) &&
+ (!s[3] || isSPACE(s[3])))
+ {
+ const char *t = s + 3;
+
+ while (*t && isSPACE(*t))
+ ++t;
+ if (!*t && (PerlLIO_dup2(1, 2) != -1))
+ {
+ s[-2] = '\0';
+ break;
+ }
+ }
+ doshell:
+ PERL_FPU_PRE_EXEC
+ result = myexecl(FALSE, PL_sh_path, "sh", "-c", cmd,
+ (char *)NULL);
+ PERL_FPU_POST_EXEC
+ S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
+ amigaos_post_exec(fd, do_report);
+ Safefree(buf);
+ return result;
+ }
+ }
+
+ Newx(PL_Argv, (s - cmd) / 2 + 2, const char *);
+ PL_Cmd = savepvn(cmd, s - cmd);
+ a = PL_Argv;
+ for (s = PL_Cmd; *s;)
+ {
+ while (isSPACE(*s))
+ s++;
+ if (*s)
+ *(a++) = s;
+ while (*s && !isSPACE(*s))
+ s++;
+ if (*s)
+ *s++ = '\0';
+ }
+ *a = NULL;
+ if (PL_Argv[0])
+ {
+ PERL_FPU_PRE_EXEC
+ result = myexecvp(FALSE, PL_Argv[0], EXEC_ARGV_CAST(PL_Argv));
+ PERL_FPU_POST_EXEC
+ if (errno == ENOEXEC)
+ { /* for system V NIH syndrome */
+ do_execfree();
+ goto doshell;
+ }
+ S_exec_failed(aTHX_ PL_Argv[0], fd, do_report);
+ amigaos_post_exec(fd, do_report);
+ }
+ do_execfree();
+ Safefree(buf);
+ return result;
+}
+
+I32 S_do_amigaos_aexec5(
+ pTHX_ SV *really, SV **mark, SV **sp, int fd, int do_report)
+{
+ dVAR;
+ I32 result = -1;
+ PERL_ARGS_ASSERT_DO_AEXEC5;
+ if (sp > mark)
+ {
+ const char **a;
+ const char *tmps = NULL;
+ Newx(PL_Argv, sp - mark + 1, const char *);
+ a = PL_Argv;
+
+ while (++mark <= sp)
+ {
+ if (*mark)
+ *a++ = SvPV_nolen_const(*mark);
+ else
+ *a++ = "";
+ }
+ *a = NULL;
+ if (really)
+ tmps = SvPV_nolen_const(really);
+ if ((!really && *PL_Argv[0] != '/') ||
+ (really && *tmps != '/')) /* will execvp use PATH? */
+ TAINT_ENV(); /* testing IFS here is overkill, probably
+ */
+ PERL_FPU_PRE_EXEC
+ if (really && *tmps)
+ {
+ result = myexecvp(FALSE, tmps, EXEC_ARGV_CAST(PL_Argv));
+ }
+ else
+ {
+ result = myexecvp(FALSE, PL_Argv[0],
+ EXEC_ARGV_CAST(PL_Argv));
+ }
+ PERL_FPU_POST_EXEC
+ S_exec_failed(aTHX_(really ? tmps : PL_Argv[0]), fd, do_report);
+ }
+ amigaos_post_exec(fd, do_report);
+ do_execfree();
+ return result;
+}
+
void *amigaos_system_child(void *userdata)
{
struct Task *parent;
if (PL_op->op_flags & OPf_STACKED)
{
SV *really = *++MARK;
- value = (I32)do_aexec5(really, MARK, SP, pp, did_pipes);
+ value = (I32)S_do_amigaos_aexec5(aTHX_ really, MARK, SP, pp,
+ did_pipes);
}
else if (SP - MARK != 1)
{
- value = (I32)do_aexec5(NULL, MARK, SP, pp, did_pipes);
+ value = (I32)S_do_amigaos_aexec5(aTHX_ NULL, MARK, SP, pp,
+ did_pipes);
}
else
{
- value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp,
- did_pipes);
+ value = (I32)S_do_amigaos_exec3(
+ aTHX_ SvPVx(sv_mortalcopy(*SP), n_a), pp, did_pipes);
}
// Forbid();
return value;
}
+
+static BOOL contains_whitespace(char *string)
+{
+
+ if (string)
+ {
+
+ if (strchr(string, ' '))
+ return TRUE;
+ if (strchr(string, '\t'))
+ return TRUE;
+ if (strchr(string, '\n'))
+ return TRUE;
+ if (strchr(string, 0xA0))
+ return TRUE;
+ if (strchr(string, '"'))
+ return TRUE;
+ }
+ return FALSE;
+}
+
+static int no_of_escapes(char *string)
+{
+ int cnt = 0;
+ char *p;
+ for (p = string; p < string + strlen(string); p++)
+ {
+ if (*p == '"')
+ cnt++;
+ if (*p == '*')
+ cnt++;
+ if (*p == '\n')
+ cnt++;
+ if (*p == '\t')
+ cnt++;
+ }
+ return cnt;
+}
+
+struct command_data
+{
+ STRPTR args;
+ BPTR seglist;
+ struct Task *parent;
+};
+
+#undef fopen
+#undef fgetc
+#undef fgets
+#undef fclose
+
+#define __USE_RUNCOMMAND__
+
+int myexecve(bool isperlthread,
+ const char *filename,
+ char *argv[],
+ char *envp[])
+{
+ FILE *fh;
+ char buffer[1000];
+ int size = 0;
+ char **cur;
+ char *interpreter = 0;
+ char *interpreter_args = 0;
+ char *full = 0;
+ char *filename_conv = 0;
+ char *interpreter_conv = 0;
+ // char *tmp = 0;
+ char *fname;
+ // int tmpint;
+ // struct Task *thisTask = IExec->FindTask(0);
+ int result = -1;
+
+ StdioStore store;
+
+ pTHX = NULL;
+
+ if (isperlthread)
+ {
+ aTHX = PERL_GET_THX;
+ /* Save away our stdio */
+ amigaos_stdio_save(aTHX_ & store);
+ }
+
+ // adebug("%s %ld %s\n",__FUNCTION__,__LINE__,filename?filename:"NULL");
+
+ /* Calculate the size of filename and all args, including spaces and
+ * quotes */
+ size = 0; // strlen(filename) + 1;
+ for (cur = (char **)argv /* +1 */; *cur; cur++)
+ {
+ size +=
+ strlen(*cur) + 1 +
+ (contains_whitespace(*cur) ? (2 + no_of_escapes(*cur)) : 0);
+ }
+ /* Check if it's a script file */
+
+ fh = fopen(filename, "r");
+ if (fh)
+ {
+ if (fgetc(fh) == '#' && fgetc(fh) == '!')
+ {
+ char *p;
+ char *q;
+ fgets(buffer, 999, fh);
+ p = buffer;
+ while (*p == ' ' || *p == '\t')
+ p++;
+ if (buffer[strlen(buffer) - 1] == '\n')
+ buffer[strlen(buffer) - 1] = '\0';
+ if ((q = strchr(p, ' ')))
+ {
+ *q++ = '\0';
+ if (*q != '\0')
+ {
+ interpreter_args = mystrdup(q);
+ }
+ }
+ else
+ interpreter_args = mystrdup("");
+
+ interpreter = mystrdup(p);
+ size += strlen(interpreter) + 1;
+ size += strlen(interpreter_args) + 1;
+ }
+
+ fclose(fh);
+ }
+ else
+ {
+ /* We couldn't open this why not? */
+ if (errno == ENOENT)
+ {
+ /* file didn't exist! */
+ goto out;
+ }
+ }
+
+ /* Allocate the command line */
+ filename_conv = convert_path_u2a(filename);
+
+ if (filename_conv)
+ size += strlen(filename_conv);
+ size += 1;
+ full = (char *)IExec->AllocVec(size + 10, MEMF_ANY | MEMF_CLEAR);
+ if (full)
+ {
+ if (interpreter)
+ {
+ interpreter_conv = convert_path_u2a(interpreter);
+#if !defined(__USE_RUNCOMMAND__)
+#warning(using system!)
+ sprintf(full, "%s %s %s ", interpreter_conv,
+ interpreter_args, filename_conv);
+#else
+ sprintf(full, "%s %s ", interpreter_args,
+ filename_conv);
+#endif
+ IExec->FreeVec(interpreter);
+ IExec->FreeVec(interpreter_args);
+
+ if (filename_conv)
+ IExec->FreeVec(filename_conv);
+ fname = mystrdup(interpreter_conv);
+
+ if (interpreter_conv)
+ IExec->FreeVec(interpreter_conv);
+ }
+ else
+ {
+#ifndef __USE_RUNCOMMAND__
+ sprintf(full, "%s ", filename_conv);
+#else
+ sprintf(full, "");
+#endif
+ fname = mystrdup(filename_conv);
+ if (filename_conv)
+ IExec->FreeVec(filename_conv);
+ }
+
+ for (cur = (char **)(argv + 1); *cur != 0; cur++)
+ {
+ if (contains_whitespace(*cur))
+ {
+ int esc = no_of_escapes(*cur);
+
+ if (esc > 0)
+ {
+ char *buff = IExec->AllocVec(
+ strlen(*cur) + 4 + esc,
+ MEMF_ANY | MEMF_CLEAR);
+ char *p = *cur;
+ char *q = buff;
+
+ *q++ = '"';
+ while (*p != '\0')
+ {
+
+ if (*p == '\n')
+ {
+ *q++ = '*';
+ *q++ = 'N';
+ p++;
+ continue;
+ }
+ else if (*p == '"')
+ {
+ *q++ = '*';
+ *q++ = '"';
+ p++;
+ continue;
+ }
+ else if (*p == '*')
+ {
+ *q++ = '*';
+ }
+ *q++ = *p++;
+ }
+ *q++ = '"';
+ *q++ = ' ';
+ *q = '\0';
+ strcat(full, buff);
+ IExec->FreeVec(buff);
+ }
+ else
+ {
+ strcat(full, "\"");
+ strcat(full, *cur);
+ strcat(full, "\" ");
+ }
+ }
+ else
+ {
+ strcat(full, *cur);
+ strcat(full, " ");
+ }
+ }
+ strcat(full, "\n");
+
+// if(envp)
+// createvars(envp);
+
+#ifndef __USE_RUNCOMMAND__
+ result = IDOS->SystemTags(
+ full, SYS_UserShell, TRUE, NP_StackSize,
+ ((struct Process *)thisTask)->pr_StackSize, SYS_Input,
+ ((struct Process *)thisTask)->pr_CIS, SYS_Output,
+ ((struct Process *)thisTask)->pr_COS, SYS_Error,
+ ((struct Process *)thisTask)->pr_CES, TAG_DONE);
+#else
+
+ if (fname)
+ {
+ BPTR seglist = IDOS->LoadSeg(fname);
+ if (seglist)
+ {
+ /* check if we have an executable! */
+ struct PseudoSegList *ps = NULL;
+ if (!IDOS->GetSegListInfoTags(
+ seglist, GSLI_Native, &ps, TAG_DONE))
+ {
+ IDOS->GetSegListInfoTags(
+ seglist, GSLI_68KPS, &ps, TAG_DONE);
+ }
+ if (ps != NULL)
+ {
+ // adebug("%s %ld %s
+ // %s\n",__FUNCTION__,__LINE__,fname,full);
+ IDOS->SetCliProgramName(fname);
+ // result=RunCommand(seglist,8*1024,full,strlen(full));
+ // result=myruncommand(seglist,8*1024,full,strlen(full),envp);
+ result = myruncommand(seglist, 8 * 1024,
+ full, -1, envp);
+ errno = 0;
+ }
+ else
+ {
+ errno = ENOEXEC;
+ }
+ IDOS->UnLoadSeg(seglist);
+ }
+ else
+ {
+ errno = ENOEXEC;
+ }
+ IExec->FreeVec(fname);
+ }
+
+#endif /* USE_RUNCOMMAND */
+
+ IExec->FreeVec(full);
+ if (errno == ENOEXEC)
+ {
+ result = -1;
+ }
+ goto out;
+ }
+
+ if (interpreter)
+ IExec->FreeVec(interpreter);
+ if (filename_conv)
+ IExec->FreeVec(filename_conv);
+
+ errno = ENOMEM;
+
+out:
+ if (isperlthread)
+ {
+ amigaos_stdio_restore(aTHX_ & store);
+ STATUS_NATIVE_CHILD_SET(result);
+ PL_exit_flags |= PERL_EXIT_EXPECTED;
+ if (result != -1)
+ my_exit(result);
+ }
+ return (result);
+}
#ifndef _AMIGAIO_H
#define _AMIGAIO_H
+#ifndef H_PERL
#include "../perl.h"
+#endif
struct StdioStore
{
#include <fcntl.h>
#include <ctype.h>
#include <stdarg.h>
+#include <stdbool.h>
+#undef WORD
+#define WORD int16
#include <dos/dos.h>
#include <proto/dos.h>
char **myenviron = NULL;
char **origenviron = NULL;
-int myexecve(const char *path, char *argv[], char *envp[]);
static void createvars(char **envp);
struct args
return myargs.result;
}
-static char *mystrdup(const char *s)
+char *mystrdup(const char *s)
{
char *result = NULL;
size_t size;
struct Task *parent;
};
-int myexecvp(const char *filename, char *argv[])
+int myexecvp(bool isperlthread, const char *filename, char *argv[])
{
// adebug("%s %ld
//%s\n",__FUNCTION__,__LINE__,filename?filename:"NULL");
} while (*p++ != '\0');
}
- res = myexecve(filename, argv, myenviron);
+ res = myexecve(isperlthread, filename, argv, myenviron);
return res;
}
-int myexecv(const char *path, char *argv[])
+int myexecv(bool isperlthread, const char *path, char *argv[])
{
- return myexecve(path, argv, myenviron);
+ return myexecve(isperlthread, path, argv, myenviron);
}
-int myexecl(const char *path, ...)
+int myexecl(bool isperlthread, const char *path, ...)
{
va_list va;
char *argv[1024]; /* 1024 enough? let's hope so! */
} while (argv[i++] != NULL);
va_end(va);
- return myexecve(path, argv, myenviron);
+ return myexecve(isperlthread, path, argv, myenviron);
}
+#if 0
+
int myexecve(const char *filename, char *argv[], char *envp[])
{
FILE *fh;
// struct Task *thisTask = IExec->FindTask(0);
int result = -1;
+ StdioStore store;
+
+ dTHX;
+ if(aTHX) // I hope this is NULL when not on a interpreteer thread nor to level.
+ {
+ /* Save away our stdio */
+ amigaos_stdio_save(aTHX_ & store);
+ }
+
// adebug("%s %ld %s\n",__FUNCTION__,__LINE__,filename?filename:"NULL");
/* Calculate the size of filename and all args, including spaces and
if (errno == ENOENT)
{
/* file didn't exist! */
- return -1;
+ goto out;
}
}
IExec->FreeVec(full);
if (errno == ENOEXEC)
- return -1;
- return result;
+ {
+ result = -1;
+ }
+ goto out;
}
if (interpreter)
errno = ENOMEM;
- return -1;
+out:
+
+ amigaos_stdio_restore(aTHX_ &store);
+ STATUS_NATIVE_CHILD_SET(result);
+ PL_exit_flags |= PERL_EXIT_EXPECTED;
+ if (result != -1) my_exit(result);
+
+ return(result);
}
+#endif
+
int pause(void)
{
fprintf(stderr, "Pause not implemented\n");
* argv[]
*/
- myexecvp(argv[0], argv);
+ myexecvp(FALSE, argv[0], argv);
if (command)
IExec->FreeVec(command);
#include <stdio.h>
#if defined(__CLIB2__)
-# include <dos.h>
+#include <dos.h>
#endif
#if defined(__NEWLIB__)
-#
include <amiga_platform.h>
+#include <amiga_platform.h>
#endif
#if 1
-int myexecve(const char *path, char *argv[], char *env[]);
-int myexecvp(const char *filename, char *argv[]);
-int myexecv(const char *path, char *argv[]);
-int myexecl(const char *path, ...);
+int myexecve(bool isperlthread, const char *path, char *argv[], char *env[]);
+int myexecvp(bool isperlthread, const char *filename, char *argv[]);
+int myexecv(bool isperlthread, const char *path, char *argv[]);
+int myexecl(bool isperlthread, const char *path, ...);
#endif
-#define execve(path, argv, env) myexecve(path, argv, env)
-#define execvp(filename, argv) myexecvp(filename, argv)
-#define execv(path, argv) myexecv(path, argv)
-#define execl(path, ...) myexecl(path, __VA_ARGS__)
+#define execve(path, argv, env) myexecve(TRUE, path, argv, env)
+#define execvp(filename, argv) myexecvp(TRUE, filename, argv)
+#define execv(path, argv) myexecv(TRUE, path, argv)
+#define execl(path, ...) myexecl(TRUE, path, __VA_ARGS__)
int pipe(int filedes[2]);
void amigaos4_obtain_environ();
void amigaos4_release_environ();
+char *mystrdup(const char *s);
+
+char *convert_path_u2a(const char *filename);
+char *convert_path_a2u(const char *filename);
+
/* signal.h */
// #define SIGQUIT SIGABRT
// BOOL constructed;
-
-
#endif
{
const int e = errno;
PERL_ARGS_ASSERT_EXEC_FAILED;
-#ifdef __amigaos4__
- if (e)
-#endif
- {
- if (ckWARN(WARN_EXEC))
- Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
- cmd, Strerror(e));
- }
+
+ if (ckWARN(WARN_EXEC))
+ Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
+ cmd, Strerror(e));
if (do_report) {
/* XXX silently ignore failures */
PERL_UNUSED_RESULT(PerlLIO_write(fd, (void*)&e, sizeof(int)));
}
}
-DO_EXEC_TYPE
+bool
Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp,
int fd, int do_report)
{
dVAR;
- DO_EXEC_TYPE result = DO_EXEC_FAILURE;
PERL_ARGS_ASSERT_DO_AEXEC5;
- PERL_UNUSED_VAR(result); /* if DO_EXEC_TYPE is bool */
#if defined(__SYMBIAN32__) || defined(__LIBCATAMOUNT__)
Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
#else
TAINT_ENV(); /* testing IFS here is overkill, probably */
PERL_FPU_PRE_EXEC
if (really && *tmps) {
- result =
- (DO_EXEC_TYPE)
- PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv));
+ PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv));
} else {
- result =
- (DO_EXEC_TYPE)
- PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
+ PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
}
PERL_FPU_POST_EXEC
S_exec_failed(aTHX_ (really ? tmps : PL_Argv[0]), fd, do_report);
}
do_execfree();
#endif
- return DO_EXEC_RETVAL(result);
+ return FALSE;
}
void
#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
-DO_EXEC_TYPE
+bool
Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
{
dVAR;
char *cmd;
/* Make a copy so we can change it */
const Size_t cmdlen = strlen(incmd) + 1;
- DO_EXEC_TYPE result = DO_EXEC_FAILURE;
- PERL_UNUSED_VAR(result); /* if DO_EXEC_TYPE is bool */
PERL_ARGS_ASSERT_DO_EXEC3;
if (s[-1] == '\'') {
*--s = '\0';
PERL_FPU_PRE_EXEC
- result =
- (DO_EXEC_TYPE)
- PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL);
+ PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL);
PERL_FPU_POST_EXEC
*s = '\'';
S_exec_failed(aTHX_ PL_cshname, fd, do_report);
Safefree(buf);
- return DO_EXEC_RETVAL(result);
+ return FALSE;
}
}
}
}
doshell:
PERL_FPU_PRE_EXEC
- result =
- (DO_EXEC_TYPE)
- PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL);
+ PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL);
PERL_FPU_POST_EXEC
S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
-#if defined (__amigaos4__)
- amigaos_post_exec(fd, do_report);
-#endif
Safefree(buf);
- return DO_EXEC_RETVAL(result);
+ return FALSE;
}
}
*a = NULL;
if (PL_Argv[0]) {
PERL_FPU_PRE_EXEC
- result =
- (DO_EXEC_TYPE)
- PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
+ PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
PERL_FPU_POST_EXEC
if (errno == ENOEXEC) { /* for system V NIH syndrome */
do_execfree();
}
do_execfree();
Safefree(buf);
- return DO_EXEC_RETVAL(result);
+ return FALSE;
}
#endif /* OS2 || WIN32 */
pr |void |die_unwind |NN SV* msv
Ap |void |dounwind |I32 cxix
: FIXME
-pmb |DO_EXEC_TYPE|do_aexec |NULLOK SV* really|NN SV** mark|NN SV** sp
+pmb |bool|do_aexec |NULLOK SV* really|NN SV** mark|NN SV** sp
: Used in pp_sys.c
-p |DO_EXEC_TYPE|do_aexec5 |NULLOK SV* really|NN SV** mark|NN SV** sp|int fd|int do_report
+p |bool|do_aexec5 |NULLOK SV* really|NN SV** mark|NN SV** sp|int fd|int do_report
Ap |int |do_binmode |NN PerlIO *fp|int iotype|int mode
: Used in pp.c
Ap |bool |do_close |NULLOK GV* gv|bool not_implicit
p |bool |do_eof |NN GV* gv
#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
-pm |DO_EXEC_TYPE|do_exec |NN const char* cmd
+pm |bool|do_exec |NN const char* cmd
#else
-p |DO_EXEC_TYPE|do_exec |NN const char* cmd
+p |bool|do_exec |NN const char* cmd
#endif
#if defined(WIN32) || defined(__SYMBIAN32__) || defined(VMS)
Ap |int |do_spawn_nowait|NN char* cmd
#endif
#if !defined(WIN32)
-p |DO_EXEC_TYPE|do_exec3 |NN const char *incmd|int fd|int do_report
+p |bool|do_exec3 |NN const char *incmd|int fd|int do_report
#endif
p |void |do_execfree
#if defined(PERL_IN_DOIO_C)
vaxc$errno = PL_statusvalue_vms = MY_POSIX_EXIT ? \
(C_FAC_POSIX | (1 << 3) | STS$K_ERROR | STS$M_INHIB_MSG) : SS$_ABORT)
+#elif defined(__amigaos4__)
+ /* A somewhat experimental attempt to simulate posix return code values */
+# define STATUS_NATIVE PL_statusvalue_posix
+# define STATUS_NATIVE_CHILD_SET(n) \
+ STMT_START { \
+ PL_statusvalue_posix = (n); \
+ if (PL_statusvalue_posix < 0) { \
+ PL_statusvalue = -1; \
+ } \
+ else { \
+ PL_statusvalue = n << 8; \
+ } \
+ } STMT_END
+# define STATUS_UNIX_SET(n) \
+ STMT_START { \
+ PL_statusvalue = (n); \
+ if (PL_statusvalue != -1) \
+ PL_statusvalue &= 0xFFFF; \
+ } STMT_END
+# define STATUS_UNIX_EXIT_SET(n) STATUS_UNIX_SET(n)
+# define STATUS_EXIT_SET(n) STATUS_UNIX_SET(n)
+# define STATUS_CURRENT STATUS_UNIX
+# define STATUS_EXIT STATUS_UNIX
+# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_posix = 0)
+# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_posix = 1)
+
#else
# define STATUS_NATIVE PL_statusvalue_posix
# if defined(WCOREDUMP)
# include "win32iop.h"
#endif
-/* DO_EXEC_TYPE is the return type of the do_*exec*() functions.
- * For UNIXish platforms where the exec functions by definition
- * return only failure, it can be bool (for success, they do not
- * return). For other platforms, where the calling entity may
- * return, the return value may be more complex. */
-#if defined(__amigaos4__)
-# define DO_EXEC_TYPE I32
-# define DO_EXEC_FAILURE -1
-# define DO_EXEC_RETVAL(val) (val)
-#else
-# define DO_EXEC_TYPE bool
-# define DO_EXEC_FAILURE FALSE
-# define DO_EXEC_RETVAL(val) FALSE
-#endif
#include "proto.h"
{
dSP; dMARK; dORIGMARK; dTARGET;
I32 value;
-#if defined(__amigaos4__)
- StdioStore store;
-#endif
if (TAINTING_get) {
TAINT_ENV();
MARK = ORIGMARK;
TAINT_PROPER("exec");
}
-#if defined(__amigaos4__)
- /* Make sure redirection behaves after exec. Yes, in AmigaOS the
- * original process continues after exec, since processes are more
- * like threads. */
- amigaos_stdio_save(aTHX_ &store);
-#endif
+
PERL_FLUSHALL_FOR_CHILD;
if (PL_op->op_flags & OPf_STACKED) {
SV * const really = *++MARK;
value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
#endif
}
-
-#if defined(__amigaos4__)
- amigaos_stdio_restore(aTHX_ &store);
- STATUS_NATIVE_CHILD_SET(value);
- PL_exit_flags |= PERL_EXIT_EXPECTED;
- if (value != -1) my_exit(value);
-#endif
SP = ORIGMARK;
XPUSHi(value);
RETURN;
#define PERL_ARGS_ASSERT_DIE_UNWIND \
assert(msv)
-/* PERL_CALLCONV DO_EXEC_TYPE Perl_do_aexec(pTHX_ SV* really, SV** mark, SV** sp); */
+/* PERL_CALLCONV bool Perl_do_aexec(pTHX_ SV* really, SV** mark, SV** sp); */
#define PERL_ARGS_ASSERT_DO_AEXEC \
assert(mark); assert(sp)
-PERL_CALLCONV DO_EXEC_TYPE Perl_do_aexec5(pTHX_ SV* really, SV** mark, SV** sp, int fd, int do_report);
+PERL_CALLCONV bool Perl_do_aexec5(pTHX_ SV* really, SV** mark, SV** sp, int fd, int do_report);
#define PERL_ARGS_ASSERT_DO_AEXEC5 \
assert(mark); assert(sp)
PERL_CALLCONV int Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode);
PERL_CALLCONV void Perl_sv_nounlocking(pTHX_ SV *sv);
#endif
#if !(defined(PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION))
-PERL_CALLCONV DO_EXEC_TYPE Perl_do_exec(pTHX_ const char* cmd);
+PERL_CALLCONV bool Perl_do_exec(pTHX_ const char* cmd);
#define PERL_ARGS_ASSERT_DO_EXEC \
assert(cmd)
#endif
# endif
#endif
#if !defined(WIN32)
-PERL_CALLCONV DO_EXEC_TYPE Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report);
+PERL_CALLCONV bool Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report);
#define PERL_ARGS_ASSERT_DO_EXEC3 \
assert(incmd)
#endif
PERL_CALLCONV OP * Perl_op_refcnt_inc(pTHX_ OP *o);
#endif
#if defined(PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION)
-/* PERL_CALLCONV DO_EXEC_TYPE Perl_do_exec(pTHX_ const char* cmd); */
+/* PERL_CALLCONV bool Perl_do_exec(pTHX_ const char* cmd); */
#endif
#if defined(PERL_DONT_CREATE_GVSV)
/* PERL_CALLCONV GV* Perl_gv_SVadd(pTHX_ GV *gv); */
https://perl5.git.perl.org / perl5.git / commitdiff