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