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