This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
amigaos4: move the amigaos exec code under amigaos4
[perl5.git] / amigaos4 / amigaio.c
1 /* amigaio.c mixes amigaos and perl APIs,
2  * as opposed to amigaos.c which is pure amigaos */
3
4 #include "EXTERN.h"
5 #include "perl.h"
6
7 #include "amigaos4/amigaio.h"
8 #include "amigaos.h"
9
10 #ifdef WORD
11 #  undef WORD
12 #  define WORD int16
13 #endif
14
15 #include <stdio.h>
16
17 #include <exec/semaphores.h>
18 #include <exec/exectags.h>
19 #include <proto/exec.h>
20 #include <proto/dos.h>
21 #include <dos/dos.h>
22
23 void amigaos_stdio_get(pTHX_ StdioStore *store)
24 {
25         store->astdin =
26             amigaos_get_file(PerlIO_fileno(IoIFP(GvIO(PL_stdingv))));
27         store->astderr =
28             amigaos_get_file(PerlIO_fileno(IoIFP(GvIO(PL_stderrgv))));
29         store->astdout = amigaos_get_file(
30             PerlIO_fileno(IoIFP(GvIO(gv_fetchpv("STDOUT", TRUE, SVt_PVIO)))));
31 }
32
33 void amigaos_stdio_save(pTHX_ StdioStore *store)
34 {
35         amigaos_stdio_get(aTHX_ store);
36         store->oldstdin = IDOS->SelectInput(store->astdin);
37         store->oldstderr = IDOS->SelectErrorOutput(store->astderr);
38         store->oldstdout = IDOS->SelectOutput(store->astdout);
39 }
40
41 void amigaos_stdio_restore(pTHX_ const StdioStore *store)
42 {
43         IDOS->SelectInput(store->oldstdin);
44         IDOS->SelectErrorOutput(store->oldstderr);
45         IDOS->SelectOutput(store->oldstdout);
46 }
47
48 void amigaos_post_exec(int fd, int do_report)
49 {
50         /* We *must* write something to our pipe or else
51          * the other end hangs */
52         if (do_report)
53         {
54                 int e = errno;
55                 PerlLIO_write(fd, (void *)&e, sizeof(e));
56                 PerlLIO_close(fd);
57         }
58 }
59
60 PerlIO *Perl_my_popen(pTHX_ const char *cmd, const char *mode)
61 {
62         PERL_FLUSHALL_FOR_CHILD;
63         /* Call system's popen() to get a FILE *, then import it.
64          * used 0 for 2nd parameter to PerlIO_importFILE;
65          * apparently not used
66         */
67         //    FILE *f=amigaos_popen(cmd,mode);
68         //    fprintf(stderr,"popen returned %d\n",f);
69         return PerlIO_importFILE(amigaos_popen(cmd, mode), 0);
70         //   return PerlIO_importFILE(f, 0);
71 }
72
73 #ifdef USE_ITHREADS
74
75 /* An arbitrary number to start with, should work out what the real max should
76  * be */
77
78 #ifndef MAX_THREADS
79 #  define MAX_THREADS 64
80 #endif
81
82 #define REAPED 0
83 #define ACTIVE 1
84 #define EXITED -1
85
86 struct thread_info
87 {
88         pthread_t ti_pid;
89         int ti_children;
90         pthread_t ti_parent;
91         struct MsgPort *ti_port;
92 };
93
94 static struct thread_info pseudo_children[MAX_THREADS];
95 static int num_pseudo_children = 0;
96 static struct SignalSemaphore fork_array_sema;
97
98 void amigaos4_init_fork_array()
99 {
100         IExec->InitSemaphore(&fork_array_sema);
101         pseudo_children[0].ti_pid = (pthread_t)IExec->FindTask(0);
102         pseudo_children[0].ti_parent = -1;
103         pseudo_children[0].ti_port =
104             (struct MsgPort *)IExec->AllocSysObjectTags(ASOT_PORT, TAG_DONE);
105 }
106
107 void amigaos4_dispose_fork_array()
108 {
109         while (pseudo_children[0].ti_children > 0)
110         {
111                 void *msg;
112                 IExec->WaitPort(pseudo_children[0].ti_port);
113                 msg = IExec->GetMsg(pseudo_children[0].ti_port);
114                 if (msg)
115                         IExec->FreeSysObject(ASOT_MESSAGE, msg);
116                 pseudo_children[0].ti_children--;
117         }
118         IExec->FreeSysObject(ASOT_PORT, pseudo_children[0].ti_port);
119 }
120
121 struct thread_exit_message
122 {
123         struct Message tem_Message;
124         pthread_t tem_pid;
125         int tem_status;
126 };
127
128 int getnextchild()
129 {
130         int i;
131         for (i = 0; i < MAX_THREADS; i++)
132         {
133                 if (pseudo_children[i].ti_pid == 0)
134                         return i;
135         }
136         return -1;
137 }
138
139 int findparent(pthread_t pid)
140 {
141         int i;
142         for (i = 0; i < MAX_THREADS; i++)
143         {
144                 if (pseudo_children[i].ti_pid == pid)
145                         return i;
146         }
147         return -1;
148 }
149
150 struct child_arg
151 {
152         struct Task *ca_parent_task;
153         pthread_t ca_parent;
154         PerlInterpreter *ca_interp;
155 };
156
157 static THREAD_RET_TYPE amigaos4_start_child(void *arg)
158 {
159
160         PerlInterpreter *my_perl =
161             (PerlInterpreter *)((struct child_arg *)arg)->ca_interp;
162         ;
163
164         GV *tmpgv;
165         int status;
166         int parent;
167         int nextchild;
168         pthread_t pseudo_id = pthread_self();
169
170 #ifdef PERL_SYNC_FORK
171         static long sync_fork_id = 0;
172         long id = ++sync_fork_id;
173 #endif
174
175         /* before we do anything set up our process semaphore and add
176            a new entry to the pseudochildren */
177
178         /* get next available slot */
179         /* should not fail here! */
180
181         IExec->ObtainSemaphore(&fork_array_sema);
182
183         nextchild = getnextchild();
184
185         pseudo_children[nextchild].ti_pid = pseudo_id;
186         pseudo_children[nextchild].ti_parent =
187             ((struct child_arg *)arg)->ca_parent;
188         pseudo_children[nextchild].ti_port =
189             (struct MsgPort *)IExec->AllocSysObjectTags(ASOT_PORT, TAG_DONE);
190
191         num_pseudo_children++;
192         IExec->ReleaseSemaphore(&fork_array_sema);
193
194         /* We're set up let the parent continue */
195
196         IExec->Signal(((struct child_arg *)arg)->ca_parent_task,
197                       SIGBREAKF_CTRL_F);
198
199         PERL_SET_THX(my_perl);
200         if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV)))
201         {
202                 SV *sv = GvSV(tmpgv);
203                 SvREADONLY_off(sv);
204                 sv_setiv(sv, (IV)pseudo_id);
205                 SvREADONLY_on(sv);
206         }
207         hv_clear(PL_pidstatus);
208
209         /* push a zero on the stack (we are the child) */
210         {
211                 dSP;
212                 dTARGET;
213                 PUSHi(0);
214                 PUTBACK;
215         }
216
217         /* continue from next op */
218         PL_op = PL_op->op_next;
219
220         {
221                 dJMPENV;
222                 volatile int oldscope = PL_scopestack_ix;
223
224         restart:
225                 JMPENV_PUSH(status);
226                 switch (status)
227                 {
228                 case 0:
229                         CALLRUNOPS(aTHX);
230                         status = 0;
231                         break;
232                 case 2:
233                         while (PL_scopestack_ix > oldscope)
234                         {
235                                 LEAVE;
236                         }
237                         FREETMPS;
238                         PL_curstash = PL_defstash;
239                         if (PL_endav && !PL_minus_c)
240                                 call_list(oldscope, PL_endav);
241                         status = STATUS_EXIT;
242                         break;
243                 case 3:
244                         if (PL_restartop)
245                         {
246                                 POPSTACK_TO(PL_mainstack);
247                                 PL_op = PL_restartop;
248                                 PL_restartop = (OP *)NULL;
249                                 ;
250                                 goto restart;
251                         }
252                         PerlIO_printf(Perl_error_log, "panic: restartop\n");
253                         FREETMPS;
254                         status = 1;
255                         break;
256                 }
257                 JMPENV_POP;
258
259                 /* XXX hack to avoid perl_destruct() freeing optree */
260                 PL_main_root = (OP *)NULL;
261         }
262
263         {
264                 do_close(PL_stdingv, FALSE);
265                 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO),
266                          FALSE); /* PL_stdoutgv - ISAGN */
267                 do_close(PL_stderrgv, FALSE);
268         }
269
270         /* destroy everything (waits for any pseudo-forked children) */
271
272         /* wait for any remaining children */
273
274         while (pseudo_children[nextchild].ti_children > 0)
275         {
276                 if (IExec->WaitPort(pseudo_children[nextchild].ti_port))
277                 {
278                         void *msg =
279                             IExec->GetMsg(pseudo_children[nextchild].ti_port);
280                         IExec->FreeSysObject(ASOT_MESSAGE, msg);
281                         pseudo_children[nextchild].ti_children--;
282                 }
283         }
284         if (PL_scopestack_ix <= 1)
285         {
286                 perl_destruct(my_perl);
287         }
288         perl_free(my_perl);
289
290         IExec->ObtainSemaphore(&fork_array_sema);
291         parent = findparent(pseudo_children[nextchild].ti_parent);
292         pseudo_children[nextchild].ti_pid = 0;
293         pseudo_children[nextchild].ti_parent = 0;
294         IExec->FreeSysObject(ASOT_PORT, pseudo_children[nextchild].ti_port);
295         pseudo_children[nextchild].ti_port = NULL;
296
297         IExec->ReleaseSemaphore(&fork_array_sema);
298
299         {
300                 if (parent >= 0)
301                 {
302                         struct thread_exit_message *tem =
303                             (struct thread_exit_message *)
304                                 IExec->AllocSysObjectTags(
305                                     ASOT_MESSAGE, ASOMSG_Size,
306                                     sizeof(struct thread_exit_message),
307                                     ASOMSG_Length,
308                                     sizeof(struct thread_exit_message));
309                         if (tem)
310                         {
311                                 tem->tem_pid = pseudo_id;
312                                 tem->tem_status = status;
313                                 IExec->PutMsg(pseudo_children[parent].ti_port,
314                                               (struct Message *)tem);
315                         }
316                 }
317         }
318 #ifdef PERL_SYNC_FORK
319         return id;
320 #else
321         return (void *)status;
322 #endif
323 }
324
325 #endif /* USE_ITHREADS */
326
327 Pid_t amigaos_fork()
328 {
329         dTHX;
330         pthread_t id;
331         int handle;
332         struct child_arg arg;
333         if (num_pseudo_children >= MAX_THREADS)
334         {
335                 errno = EAGAIN;
336                 return -1;
337         }
338         arg.ca_interp = perl_clone((PerlInterpreter *)aTHX, CLONEf_COPY_STACKS);
339         arg.ca_parent_task = IExec->FindTask(NULL);
340         arg.ca_parent =
341             pthread_self() ? pthread_self() : (pthread_t)IExec->FindTask(0);
342
343         handle = pthread_create(&id, NULL, amigaos4_start_child, (void *)&arg);
344         pseudo_children[findparent(arg.ca_parent)].ti_children++;
345
346         IExec->Wait(SIGBREAKF_CTRL_F);
347
348         PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
349         if (handle)
350         {
351                 errno = EAGAIN;
352                 return -1;
353         }
354         return id;
355 }
356
357 Pid_t amigaos_waitpid(pTHX_ int optype, Pid_t pid, void *argflags)
358 {
359         int result;
360         if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
361         {
362                 result = pthread_join(pid, argflags);
363         }
364         else
365         {
366                 while ((result = pthread_join(pid, argflags)) == -1 &&
367                        errno == EINTR)
368                 {
369                         //          PERL_ASYNC_CHECK();
370                 }
371         }
372         return result;
373 }
374
375 void amigaos_fork_set_userdata(
376     pTHX_ struct UserData *userdata, I32 did_pipes, int pp, SV **sp, SV **mark)
377 {
378         userdata->parent = IExec->FindTask(0);
379         userdata->did_pipes = did_pipes;
380         userdata->pp = pp;
381         userdata->sp = sp;
382         userdata->mark = mark;
383         userdata->my_perl = aTHX;
384 }
385
386 /* AmigaOS specific versions of #?exec#? solely for use in amigaos_system_child
387  */
388
389 static void S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
390 {
391         const int e = errno;
392 //    PERL_ARGS_ASSERT_EXEC_FAILED;
393         if (e)
394         {
395                 if (ckWARN(WARN_EXEC))
396                         Perl_warner(aTHX_ packWARN(WARN_EXEC),
397                                     "Can't exec \"%s\": %s", cmd, Strerror(e));
398         }
399         if (do_report)
400         {
401                 /* XXX silently ignore failures */
402                 PERL_UNUSED_RESULT(PerlLIO_write(fd, (void *)&e, sizeof(int)));
403                 PerlLIO_close(fd);
404         }
405 }
406
407 static I32 S_do_amigaos_exec3(pTHX_ const char *incmd, int fd, int do_report)
408 {
409         dVAR;
410         const char **a;
411         char *s;
412         char *buf;
413         char *cmd;
414         /* Make a copy so we can change it */
415         const Size_t cmdlen = strlen(incmd) + 1;
416         I32 result = -1;
417
418         PERL_ARGS_ASSERT_DO_EXEC3;
419
420         Newx(buf, cmdlen, char);
421         cmd = buf;
422         memcpy(cmd, incmd, cmdlen);
423
424         while (*cmd && isSPACE(*cmd))
425                 cmd++;
426
427         /* see if there are shell metacharacters in it */
428
429         if (*cmd == '.' && isSPACE(cmd[1]))
430                 goto doshell;
431
432         if (strnEQ(cmd, "exec", 4) && isSPACE(cmd[4]))
433                 goto doshell;
434
435         s = cmd;
436         while (isWORDCHAR(*s))
437                 s++; /* catch VAR=val gizmo */
438         if (*s == '=')
439                 goto doshell;
440
441         for (s = cmd; *s; s++)
442         {
443                 if (*s != ' ' && !isALPHA(*s) &&
444                     strchr("$&*(){}[]'\";\\|?<>~`\n", *s))
445                 {
446                         if (*s == '\n' && !s[1])
447                         {
448                                 *s = '\0';
449                                 break;
450                         }
451                         /* handle the 2>&1 construct at the end */
452                         if (*s == '>' && s[1] == '&' && s[2] == '1' &&
453                             s > cmd + 1 && s[-1] == '2' && isSPACE(s[-2]) &&
454                             (!s[3] || isSPACE(s[3])))
455                         {
456                                 const char *t = s + 3;
457
458                                 while (*t && isSPACE(*t))
459                                         ++t;
460                                 if (!*t && (PerlLIO_dup2(1, 2) != -1))
461                                 {
462                                         s[-2] = '\0';
463                                         break;
464                                 }
465                         }
466                 doshell:
467                         PERL_FPU_PRE_EXEC
468                         result = myexecl(FALSE, PL_sh_path, "sh", "-c", cmd,
469                                          (char *)NULL);
470                         PERL_FPU_POST_EXEC
471                         S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
472                         amigaos_post_exec(fd, do_report);
473                         Safefree(buf);
474                         return result;
475                 }
476         }
477
478         Newx(PL_Argv, (s - cmd) / 2 + 2, const char *);
479         PL_Cmd = savepvn(cmd, s - cmd);
480         a = PL_Argv;
481         for (s = PL_Cmd; *s;)
482         {
483                 while (isSPACE(*s))
484                         s++;
485                 if (*s)
486                         *(a++) = s;
487                 while (*s && !isSPACE(*s))
488                         s++;
489                 if (*s)
490                         *s++ = '\0';
491         }
492         *a = NULL;
493         if (PL_Argv[0])
494         {
495                 PERL_FPU_PRE_EXEC
496                 result = myexecvp(FALSE, PL_Argv[0], EXEC_ARGV_CAST(PL_Argv));
497                 PERL_FPU_POST_EXEC
498                 if (errno == ENOEXEC)
499                 { /* for system V NIH syndrome */
500                         do_execfree();
501                         goto doshell;
502                 }
503                 S_exec_failed(aTHX_ PL_Argv[0], fd, do_report);
504                 amigaos_post_exec(fd, do_report);
505         }
506         do_execfree();
507         Safefree(buf);
508         return result;
509 }
510
511 I32 S_do_amigaos_aexec5(
512     pTHX_ SV *really, SV **mark, SV **sp, int fd, int do_report)
513 {
514         dVAR;
515         I32 result = -1;
516         PERL_ARGS_ASSERT_DO_AEXEC5;
517         if (sp > mark)
518         {
519                 const char **a;
520                 const char *tmps = NULL;
521                 Newx(PL_Argv, sp - mark + 1, const char *);
522                 a = PL_Argv;
523
524                 while (++mark <= sp)
525                 {
526                         if (*mark)
527                                 *a++ = SvPV_nolen_const(*mark);
528                         else
529                                 *a++ = "";
530                 }
531                 *a = NULL;
532                 if (really)
533                         tmps = SvPV_nolen_const(really);
534                 if ((!really && *PL_Argv[0] != '/') ||
535                         (really && *tmps != '/')) /* will execvp use PATH? */
536                         TAINT_ENV(); /* testing IFS here is overkill, probably
537                                         */
538                 PERL_FPU_PRE_EXEC
539                 if (really && *tmps)
540                 {
541                         result = myexecvp(FALSE, tmps, EXEC_ARGV_CAST(PL_Argv));
542                 }
543                 else
544                 {
545                         result = myexecvp(FALSE, PL_Argv[0],
546                                           EXEC_ARGV_CAST(PL_Argv));
547                 }
548                 PERL_FPU_POST_EXEC
549                 S_exec_failed(aTHX_(really ? tmps : PL_Argv[0]), fd, do_report);
550         }
551         amigaos_post_exec(fd, do_report);
552         do_execfree();
553         return result;
554 }
555
556 void *amigaos_system_child(void *userdata)
557 {
558         struct Task *parent;
559         I32 did_pipes;
560         int pp;
561         I32 value;
562         STRLEN n_a;
563         /* these next are declared by macros else where but I may be
564          * passing modified values here so declare them explictly but
565          * still referred to by macro below */
566
567         register SV **sp;
568         register SV **mark;
569         register PerlInterpreter *my_perl;
570
571         StdioStore store;
572
573         struct UserData *ud = (struct UserData *)userdata;
574
575         did_pipes = ud->did_pipes;
576         parent = ud->parent;
577         pp = ud->pp;
578         SP = ud->sp;
579         MARK = ud->mark;
580         my_perl = ud->my_perl;
581         PERL_SET_THX(my_perl);
582
583         amigaos_stdio_save(aTHX_ & store);
584
585         if (did_pipes)
586         {
587                 //    PerlLIO_close(pp[0]);
588         }
589         if (PL_op->op_flags & OPf_STACKED)
590         {
591                 SV *really = *++MARK;
592                 value = (I32)S_do_amigaos_aexec5(aTHX_ really, MARK, SP, pp,
593                                                  did_pipes);
594         }
595         else if (SP - MARK != 1)
596         {
597                 value = (I32)S_do_amigaos_aexec5(aTHX_ NULL, MARK, SP, pp,
598                                                  did_pipes);
599         }
600         else
601         {
602                 value = (I32)S_do_amigaos_exec3(
603                     aTHX_ SvPVx(sv_mortalcopy(*SP), n_a), pp, did_pipes);
604         }
605
606         //    Forbid();
607         //    Signal(parent, SIGBREAKF_CTRL_F);
608
609         amigaos_stdio_restore(aTHX_ & store);
610
611         return value;
612 }
613
614 static BOOL contains_whitespace(char *string)
615 {
616
617         if (string)
618         {
619
620                 if (strchr(string, ' '))
621                         return TRUE;
622                 if (strchr(string, '\t'))
623                         return TRUE;
624                 if (strchr(string, '\n'))
625                         return TRUE;
626                 if (strchr(string, 0xA0))
627                         return TRUE;
628                 if (strchr(string, '"'))
629                         return TRUE;
630         }
631         return FALSE;
632 }
633
634 static int no_of_escapes(char *string)
635 {
636         int cnt = 0;
637         char *p;
638         for (p = string; p < string + strlen(string); p++)
639         {
640                 if (*p == '"')
641                         cnt++;
642                 if (*p == '*')
643                         cnt++;
644                 if (*p == '\n')
645                         cnt++;
646                 if (*p == '\t')
647                         cnt++;
648         }
649         return cnt;
650 }
651
652 struct command_data
653 {
654         STRPTR args;
655         BPTR seglist;
656         struct Task *parent;
657 };
658
659 #undef fopen
660 #undef fgetc
661 #undef fgets
662 #undef fclose
663
664 #define __USE_RUNCOMMAND__
665
666 int myexecve(bool isperlthread,
667              const char *filename,
668              char *argv[],
669              char *envp[])
670 {
671         FILE *fh;
672         char buffer[1000];
673         int size = 0;
674         char **cur;
675         char *interpreter = 0;
676         char *interpreter_args = 0;
677         char *full = 0;
678         char *filename_conv = 0;
679         char *interpreter_conv = 0;
680         //        char *tmp = 0;
681         char *fname;
682         //        int tmpint;
683         //        struct Task *thisTask = IExec->FindTask(0);
684         int result = -1;
685
686         StdioStore store;
687
688         pTHX = NULL;
689
690         if (isperlthread)
691         {
692                 aTHX = PERL_GET_THX;
693                 /* Save away our stdio */
694                 amigaos_stdio_save(aTHX_ & store);
695         }
696
697         // adebug("%s %ld %s\n",__FUNCTION__,__LINE__,filename?filename:"NULL");
698
699         /* Calculate the size of filename and all args, including spaces and
700          * quotes */
701         size = 0; // strlen(filename) + 1;
702         for (cur = (char **)argv /* +1 */; *cur; cur++)
703         {
704                 size +=
705                     strlen(*cur) + 1 +
706                     (contains_whitespace(*cur) ? (2 + no_of_escapes(*cur)) : 0);
707         }
708         /* Check if it's a script file */
709
710         fh = fopen(filename, "r");
711         if (fh)
712         {
713                 if (fgetc(fh) == '#' && fgetc(fh) == '!')
714                 {
715                         char *p;
716                         char *q;
717                         fgets(buffer, 999, fh);
718                         p = buffer;
719                         while (*p == ' ' || *p == '\t')
720                                 p++;
721                         if (buffer[strlen(buffer) - 1] == '\n')
722                                 buffer[strlen(buffer) - 1] = '\0';
723                         if ((q = strchr(p, ' ')))
724                         {
725                                 *q++ = '\0';
726                                 if (*q != '\0')
727                                 {
728                                         interpreter_args = mystrdup(q);
729                                 }
730                         }
731                         else
732                                 interpreter_args = mystrdup("");
733
734                         interpreter = mystrdup(p);
735                         size += strlen(interpreter) + 1;
736                         size += strlen(interpreter_args) + 1;
737                 }
738
739                 fclose(fh);
740         }
741         else
742         {
743                 /* We couldn't open this why not? */
744                 if (errno == ENOENT)
745                 {
746                         /* file didn't exist! */
747                         goto out;
748                 }
749         }
750
751         /* Allocate the command line */
752         filename_conv = convert_path_u2a(filename);
753
754         if (filename_conv)
755                 size += strlen(filename_conv);
756         size += 1;
757         full = (char *)IExec->AllocVec(size + 10, MEMF_ANY | MEMF_CLEAR);
758         if (full)
759         {
760                 if (interpreter)
761                 {
762                         interpreter_conv = convert_path_u2a(interpreter);
763 #if !defined(__USE_RUNCOMMAND__)
764 #warning(using system!)
765                         sprintf(full, "%s %s %s ", interpreter_conv,
766                                 interpreter_args, filename_conv);
767 #else
768                         sprintf(full, "%s %s ", interpreter_args,
769                                 filename_conv);
770 #endif
771                         IExec->FreeVec(interpreter);
772                         IExec->FreeVec(interpreter_args);
773
774                         if (filename_conv)
775                                 IExec->FreeVec(filename_conv);
776                         fname = mystrdup(interpreter_conv);
777
778                         if (interpreter_conv)
779                                 IExec->FreeVec(interpreter_conv);
780                 }
781                 else
782                 {
783 #ifndef __USE_RUNCOMMAND__
784                         sprintf(full, "%s ", filename_conv);
785 #else
786                         sprintf(full, "");
787 #endif
788                         fname = mystrdup(filename_conv);
789                         if (filename_conv)
790                                 IExec->FreeVec(filename_conv);
791                 }
792
793                 for (cur = (char **)(argv + 1); *cur != 0; cur++)
794                 {
795                         if (contains_whitespace(*cur))
796                         {
797                                 int esc = no_of_escapes(*cur);
798
799                                 if (esc > 0)
800                                 {
801                                         char *buff = IExec->AllocVec(
802                                             strlen(*cur) + 4 + esc,
803                                             MEMF_ANY | MEMF_CLEAR);
804                                         char *p = *cur;
805                                         char *q = buff;
806
807                                         *q++ = '"';
808                                         while (*p != '\0')
809                                         {
810
811                                                 if (*p == '\n')
812                                                 {
813                                                         *q++ = '*';
814                                                         *q++ = 'N';
815                                                         p++;
816                                                         continue;
817                                                 }
818                                                 else if (*p == '"')
819                                                 {
820                                                         *q++ = '*';
821                                                         *q++ = '"';
822                                                         p++;
823                                                         continue;
824                                                 }
825                                                 else if (*p == '*')
826                                                 {
827                                                         *q++ = '*';
828                                                 }
829                                                 *q++ = *p++;
830                                         }
831                                         *q++ = '"';
832                                         *q++ = ' ';
833                                         *q = '\0';
834                                         strcat(full, buff);
835                                         IExec->FreeVec(buff);
836                                 }
837                                 else
838                                 {
839                                         strcat(full, "\"");
840                                         strcat(full, *cur);
841                                         strcat(full, "\" ");
842                                 }
843                         }
844                         else
845                         {
846                                 strcat(full, *cur);
847                                 strcat(full, " ");
848                         }
849                 }
850                 strcat(full, "\n");
851
852 //            if(envp)
853 //                 createvars(envp);
854
855 #ifndef __USE_RUNCOMMAND__
856                 result = IDOS->SystemTags(
857                     full, SYS_UserShell, TRUE, NP_StackSize,
858                     ((struct Process *)thisTask)->pr_StackSize, SYS_Input,
859                     ((struct Process *)thisTask)->pr_CIS, SYS_Output,
860                     ((struct Process *)thisTask)->pr_COS, SYS_Error,
861                     ((struct Process *)thisTask)->pr_CES, TAG_DONE);
862 #else
863
864                 if (fname)
865                 {
866                         BPTR seglist = IDOS->LoadSeg(fname);
867                         if (seglist)
868                         {
869                                 /* check if we have an executable! */
870                                 struct PseudoSegList *ps = NULL;
871                                 if (!IDOS->GetSegListInfoTags(
872                                         seglist, GSLI_Native, &ps, TAG_DONE))
873                                 {
874                                         IDOS->GetSegListInfoTags(
875                                             seglist, GSLI_68KPS, &ps, TAG_DONE);
876                                 }
877                                 if (ps != NULL)
878                                 {
879                                         //                    adebug("%s %ld %s
880                                         //                    %s\n",__FUNCTION__,__LINE__,fname,full);
881                                         IDOS->SetCliProgramName(fname);
882                                         //                        result=RunCommand(seglist,8*1024,full,strlen(full));
883                                         //                        result=myruncommand(seglist,8*1024,full,strlen(full),envp);
884                                         result = myruncommand(seglist, 8 * 1024,
885                                                               full, -1, envp);
886                                         errno = 0;
887                                 }
888                                 else
889                                 {
890                                         errno = ENOEXEC;
891                                 }
892                                 IDOS->UnLoadSeg(seglist);
893                         }
894                         else
895                         {
896                                 errno = ENOEXEC;
897                         }
898                         IExec->FreeVec(fname);
899                 }
900
901 #endif /* USE_RUNCOMMAND */
902
903                 IExec->FreeVec(full);
904                 if (errno == ENOEXEC)
905                 {
906                         result = -1;
907                 }
908                 goto out;
909         }
910
911         if (interpreter)
912                 IExec->FreeVec(interpreter);
913         if (filename_conv)
914                 IExec->FreeVec(filename_conv);
915
916         errno = ENOMEM;
917
918 out:
919         if (isperlthread)
920         {
921                 amigaos_stdio_restore(aTHX_ & store);
922                 STATUS_NATIVE_CHILD_SET(result);
923                 PL_exit_flags |= PERL_EXIT_EXPECTED;
924                 if (result != -1)
925                         my_exit(result);
926         }
927         return (result);
928 }