This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
amigaos4: whitespace only, in 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         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                 {
527                         /* for system V NIH syndrome */
528                         do_execfree();
529                         goto doshell;
530                 }
531                 S_exec_failed(aTHX_ PL_Argv[0], fd, do_report);
532                 amigaos_post_exec(fd, do_report);
533         }
534         do_execfree();
535         Safefree(buf);
536         return result;
537 }
538
539 I32 S_do_amigaos_aexec5(
540     pTHX_ SV *really, SV **mark, SV **sp, int fd, int do_report)
541 {
542         dVAR;
543         I32 result = -1;
544         PERL_ARGS_ASSERT_DO_AEXEC5;
545         if (sp > mark)
546         {
547                 const char **a;
548                 const char *tmps = NULL;
549                 Newx(PL_Argv, sp - mark + 1, const char *);
550                 a = PL_Argv;
551
552                 while (++mark <= sp)
553                 {
554                         if (*mark)
555                                 *a++ = SvPV_nolen_const(*mark);
556                         else
557                                 *a++ = "";
558                 }
559                 *a = NULL;
560                 if (really)
561                         tmps = SvPV_nolen_const(really);
562                 if ((!really && *PL_Argv[0] != '/') ||
563                         (really && *tmps != '/')) /* will execvp use PATH? */
564                         TAINT_ENV(); /* testing IFS here is overkill, probably
565                                         */
566                 PERL_FPU_PRE_EXEC
567                 if (really && *tmps)
568                 {
569                         result = myexecvp(FALSE, tmps, EXEC_ARGV_CAST(PL_Argv));
570                 }
571                 else
572                 {
573                         result = myexecvp(FALSE, PL_Argv[0],
574                                           EXEC_ARGV_CAST(PL_Argv));
575                 }
576                 PERL_FPU_POST_EXEC
577                 S_exec_failed(aTHX_(really ? tmps : PL_Argv[0]), fd, do_report);
578         }
579         amigaos_post_exec(fd, do_report);
580         do_execfree();
581         return result;
582 }
583
584 void *amigaos_system_child(void *userdata)
585 {
586         struct Task *parent;
587         I32 did_pipes;
588         int pp;
589         I32 value;
590         STRLEN n_a;
591         /* these next are declared by macros else where but I may be
592          * passing modified values here so declare them explictly but
593          * still referred to by macro below */
594
595         register SV **sp;
596         register SV **mark;
597         register PerlInterpreter *my_perl;
598
599         StdioStore store;
600
601         struct UserData *ud = (struct UserData *)userdata;
602
603         did_pipes = ud->did_pipes;
604         parent = ud->parent;
605         pp = ud->pp;
606         SP = ud->sp;
607         MARK = ud->mark;
608         my_perl = ud->my_perl;
609         PERL_SET_THX(my_perl);
610
611         amigaos_stdio_save(aTHX_ & store);
612
613         if (did_pipes)
614         {
615                 //    PerlLIO_close(pp[0]);
616         }
617         if (PL_op->op_flags & OPf_STACKED)
618         {
619                 SV *really = *++MARK;
620                 value = (I32)S_do_amigaos_aexec5(aTHX_ really, MARK, SP, pp,
621                                                  did_pipes);
622         }
623         else if (SP - MARK != 1)
624         {
625                 value = (I32)S_do_amigaos_aexec5(aTHX_ NULL, MARK, SP, pp,
626                                                  did_pipes);
627         }
628         else
629         {
630                 value = (I32)S_do_amigaos_exec3(
631                             aTHX_ SvPVx(sv_mortalcopy(*SP), n_a), pp, did_pipes);
632         }
633
634         //    Forbid();
635         //    Signal(parent, SIGBREAKF_CTRL_F);
636
637         amigaos_stdio_restore(aTHX_ & store);
638
639         return value;
640 }
641
642 static BOOL contains_whitespace(char *string)
643 {
644
645         if (string)
646         {
647
648                 if (strchr(string, ' '))
649                         return TRUE;
650                 if (strchr(string, '\t'))
651                         return TRUE;
652                 if (strchr(string, '\n'))
653                         return TRUE;
654                 if (strchr(string, 0xA0))
655                         return TRUE;
656                 if (strchr(string, '"'))
657                         return TRUE;
658         }
659         return FALSE;
660 }
661
662 static int no_of_escapes(char *string)
663 {
664         int cnt = 0;
665         char *p;
666         for (p = string; p < string + strlen(string); p++)
667         {
668                 if (*p == '"')
669                         cnt++;
670                 if (*p == '*')
671                         cnt++;
672                 if (*p == '\n')
673                         cnt++;
674                 if (*p == '\t')
675                         cnt++;
676         }
677         return cnt;
678 }
679
680 struct command_data
681 {
682         STRPTR args;
683         BPTR seglist;
684         struct Task *parent;
685 };
686
687 #undef fopen
688 #undef fgetc
689 #undef fgets
690 #undef fclose
691
692 #define __USE_RUNCOMMAND__
693
694 int myexecve(bool isperlthread,
695              const char *filename,
696              char *argv[],
697              char *envp[])
698 {
699         FILE *fh;
700         char buffer[1000];
701         int size = 0;
702         char **cur;
703         char *interpreter = 0;
704         char *interpreter_args = 0;
705         char *full = 0;
706         char *filename_conv = 0;
707         char *interpreter_conv = 0;
708         //        char *tmp = 0;
709         char *fname;
710         //        int tmpint;
711         //        struct Task *thisTask = IExec->FindTask(0);
712         int result = -1;
713
714         StdioStore store;
715
716         pTHX = NULL;
717
718         if (isperlthread)
719         {
720                 aTHX = PERL_GET_THX;
721                 /* Save away our stdio */
722                 amigaos_stdio_save(aTHX_ & store);
723         }
724
725         // adebug("%s %ld %s\n",__FUNCTION__,__LINE__,filename?filename:"NULL");
726
727         /* Calculate the size of filename and all args, including spaces and
728          * quotes */
729         size = 0; // strlen(filename) + 1;
730         for (cur = (char **)argv /* +1 */; *cur; cur++)
731         {
732                 size +=
733                     strlen(*cur) + 1 +
734                     (contains_whitespace(*cur) ? (2 + no_of_escapes(*cur)) : 0);
735         }
736         /* Check if it's a script file */
737
738         fh = fopen(filename, "r");
739         if (fh)
740         {
741                 if (fgetc(fh) == '#' && fgetc(fh) == '!')
742                 {
743                         char *p;
744                         char *q;
745                         fgets(buffer, 999, fh);
746                         p = buffer;
747                         while (*p == ' ' || *p == '\t')
748                                 p++;
749                         if (buffer[strlen(buffer) - 1] == '\n')
750                                 buffer[strlen(buffer) - 1] = '\0';
751                         if ((q = strchr(p, ' ')))
752                         {
753                                 *q++ = '\0';
754                                 if (*q != '\0')
755                                 {
756                                         interpreter_args = mystrdup(q);
757                                 }
758                         }
759                         else
760                                 interpreter_args = mystrdup("");
761
762                         interpreter = mystrdup(p);
763                         size += strlen(interpreter) + 1;
764                         size += strlen(interpreter_args) + 1;
765                 }
766
767                 fclose(fh);
768         }
769         else
770         {
771                 /* We couldn't open this why not? */
772                 if (errno == ENOENT)
773                 {
774                         /* file didn't exist! */
775                         goto out;
776                 }
777         }
778
779         /* Allocate the command line */
780         filename_conv = convert_path_u2a(filename);
781
782         if (filename_conv)
783                 size += strlen(filename_conv);
784         size += 1;
785         full = (char *)IExec->AllocVec(size + 10, MEMF_ANY | MEMF_CLEAR);
786         if (full)
787         {
788                 if (interpreter)
789                 {
790                         interpreter_conv = convert_path_u2a(interpreter);
791 #if !defined(__USE_RUNCOMMAND__)
792 #warning(using system!)
793                         sprintf(full, "%s %s %s ", interpreter_conv,
794                                 interpreter_args, filename_conv);
795 #else
796                         sprintf(full, "%s %s ", interpreter_args,
797                                 filename_conv);
798 #endif
799                         IExec->FreeVec(interpreter);
800                         IExec->FreeVec(interpreter_args);
801
802                         if (filename_conv)
803                                 IExec->FreeVec(filename_conv);
804                         fname = mystrdup(interpreter_conv);
805
806                         if (interpreter_conv)
807                                 IExec->FreeVec(interpreter_conv);
808                 }
809                 else
810                 {
811 #ifndef __USE_RUNCOMMAND__
812                         sprintf(full, "%s ", filename_conv);
813 #else
814                         sprintf(full, "");
815 #endif
816                         fname = mystrdup(filename_conv);
817                         if (filename_conv)
818                                 IExec->FreeVec(filename_conv);
819                 }
820
821                 for (cur = (char **)(argv + 1); *cur != 0; cur++)
822                 {
823                         if (contains_whitespace(*cur))
824                         {
825                                 int esc = no_of_escapes(*cur);
826
827                                 if (esc > 0)
828                                 {
829                                         char *buff = IExec->AllocVec(
830                                                          strlen(*cur) + 4 + esc,
831                                                          MEMF_ANY | MEMF_CLEAR);
832                                         char *p = *cur;
833                                         char *q = buff;
834
835                                         *q++ = '"';
836                                         while (*p != '\0')
837                                         {
838
839                                                 if (*p == '\n')
840                                                 {
841                                                         *q++ = '*';
842                                                         *q++ = 'N';
843                                                         p++;
844                                                         continue;
845                                                 }
846                                                 else if (*p == '"')
847                                                 {
848                                                         *q++ = '*';
849                                                         *q++ = '"';
850                                                         p++;
851                                                         continue;
852                                                 }
853                                                 else if (*p == '*')
854                                                 {
855                                                         *q++ = '*';
856                                                 }
857                                                 *q++ = *p++;
858                                         }
859                                         *q++ = '"';
860                                         *q++ = ' ';
861                                         *q = '\0';
862                                         strcat(full, buff);
863                                         IExec->FreeVec(buff);
864                                 }
865                                 else
866                                 {
867                                         strcat(full, "\"");
868                                         strcat(full, *cur);
869                                         strcat(full, "\" ");
870                                 }
871                         }
872                         else
873                         {
874                                 strcat(full, *cur);
875                                 strcat(full, " ");
876                         }
877                 }
878                 strcat(full, "\n");
879
880 //            if(envp)
881 //                 createvars(envp);
882
883 #ifndef __USE_RUNCOMMAND__
884                 result = IDOS->SystemTags(
885                              full, SYS_UserShell, TRUE, NP_StackSize,
886                              ((struct Process *)thisTask)->pr_StackSize, SYS_Input,
887                              ((struct Process *)thisTask)->pr_CIS, SYS_Output,
888                              ((struct Process *)thisTask)->pr_COS, SYS_Error,
889                              ((struct Process *)thisTask)->pr_CES, TAG_DONE);
890 #else
891
892                 if (fname)
893                 {
894                         BPTR seglist = IDOS->LoadSeg(fname);
895                         if (seglist)
896                         {
897                                 /* check if we have an executable! */
898                                 struct PseudoSegList *ps = NULL;
899                                 if (!IDOS->GetSegListInfoTags(
900                                             seglist, GSLI_Native, &ps, TAG_DONE))
901                                 {
902                                         IDOS->GetSegListInfoTags(
903                                             seglist, GSLI_68KPS, &ps, TAG_DONE);
904                                 }
905                                 if (ps != NULL)
906                                 {
907                                         //                    adebug("%s %ld %s
908                                         //                    %s\n",__FUNCTION__,__LINE__,fname,full);
909                                         IDOS->SetCliProgramName(fname);
910                                         //                        result=RunCommand(seglist,8*1024,full,strlen(full));
911                                         //                        result=myruncommand(seglist,8*1024,full,strlen(full),envp);
912                                         result = myruncommand(seglist, 8 * 1024,
913                                                               full, -1, envp);
914                                         errno = 0;
915                                 }
916                                 else
917                                 {
918                                         errno = ENOEXEC;
919                                 }
920                                 IDOS->UnLoadSeg(seglist);
921                         }
922                         else
923                         {
924                                 errno = ENOEXEC;
925                         }
926                         IExec->FreeVec(fname);
927                 }
928
929 #endif /* USE_RUNCOMMAND */
930
931                 IExec->FreeVec(full);
932                 if (errno == ENOEXEC)
933                 {
934                         result = -1;
935                 }
936                 goto out;
937         }
938
939         if (interpreter)
940                 IExec->FreeVec(interpreter);
941         if (filename_conv)
942                 IExec->FreeVec(filename_conv);
943
944         errno = ENOMEM;
945
946 out:
947         if (isperlthread)
948         {
949                 amigaos_stdio_restore(aTHX_ & store);
950                 STATUS_NATIVE_CHILD_SET(result);
951                 PL_exit_flags |= PERL_EXIT_EXPECTED;
952                 if (result != -1)
953                         my_exit(result);
954         }
955         return (result);
956 }