[perl5.git] / amigaos4 / amigaio.c

/* amigaio.c mixes amigaos and perl APIs,
 * as opposed to amigaos.c which is pure amigaos */

#include "EXTERN.h"
#include "perl.h"

#include "amigaos4/amigaio.h"
#include "amigaos.h"

#ifdef WORD
#  undef WORD
#  define WORD int16
#endif

#include <exec/semaphores.h>
#include <exec/exectags.h>
#include <proto/exec.h>
#include <proto/dos.h>
#include <dos/dos.h>

void amigaos_stdio_get(pTHX_ StdioStore *store)
{
        store->astdin =
            amigaos_get_file(PerlIO_fileno(IoIFP(GvIO(PL_stdingv))));
        store->astderr =
            amigaos_get_file(PerlIO_fileno(IoIFP(GvIO(PL_stderrgv))));
        store->astdout = amigaos_get_file(
            PerlIO_fileno(IoIFP(GvIO(gv_fetchpv("STDOUT", TRUE, SVt_PVIO)))));
}

void amigaos_stdio_save(pTHX_ StdioStore *store)
{
        amigaos_stdio_get(aTHX_ store);
        store->oldstdin = IDOS->SelectInput(store->astdin);
        store->oldstderr = IDOS->SelectErrorOutput(store->astderr);
        store->oldstdout = IDOS->SelectOutput(store->astdout);
}

void amigaos_stdio_restore(pTHX_ const StdioStore *store)
{
        IDOS->SelectInput(store->oldstdin);
        IDOS->SelectErrorOutput(store->oldstderr);
        IDOS->SelectOutput(store->oldstdout);
}

void amigaos_post_exec(int fd, int do_report)
{
        /* We *must* write something to our pipe or else
         * the other end hangs */
        if (do_report)
        {
                int e = errno;
                PerlLIO_write(fd, (void *)&e, sizeof(e));
                PerlLIO_close(fd);
        }
}

PerlIO *Perl_my_popen(pTHX_ const char *cmd, const char *mode)
{
        PERL_FLUSHALL_FOR_CHILD;
        /* Call system's popen() to get a FILE *, then import it.
         * used 0 for 2nd parameter to PerlIO_importFILE;
         * apparently not used
        */
        //    FILE *f=amigaos_popen(cmd,mode);
        //    fprintf(stderr,"popen returned %d\n",f);
        return PerlIO_importFILE(amigaos_popen(cmd, mode), 0);
        //   return PerlIO_importFILE(f, 0);
}

#ifdef USE_ITHREADS

/* An arbitrary number to start with, should work out what the real max should
 * be */

#ifndef MAX_THREADS
#  define MAX_THREADS 64
#endif

#define REAPED 0
#define ACTIVE 1
#define EXITED -1

struct thread_info
{
        pthread_t ti_pid;
        int ti_children;
        pthread_t ti_parent;
        struct MsgPort *ti_port;
};

static struct thread_info pseudo_children[MAX_THREADS];
static int num_pseudo_children = 0;
static struct SignalSemaphore fork_array_sema;

void amigaos4_init_fork_array()
{
        IExec->InitSemaphore(&fork_array_sema);
        pseudo_children[0].ti_pid = (pthread_t)IExec->FindTask(0);
        pseudo_children[0].ti_parent = -1;
        pseudo_children[0].ti_port =
            (struct MsgPort *)IExec->AllocSysObjectTags(ASOT_PORT, TAG_DONE);
}

void amigaos4_dispose_fork_array()
{
        while (pseudo_children[0].ti_children > 0)
        {
                void *msg;
                IExec->WaitPort(pseudo_children[0].ti_port);
                msg = IExec->GetMsg(pseudo_children[0].ti_port);
                if (msg)
                        IExec->FreeSysObject(ASOT_MESSAGE, msg);
                pseudo_children[0].ti_children--;
        }
        IExec->FreeSysObject(ASOT_PORT, pseudo_children[0].ti_port);
}

struct thread_exit_message
{
        struct Message tem_Message;
        pthread_t tem_pid;
        int tem_status;
};

int getnextchild()
{
        int i;
        for (i = 0; i < MAX_THREADS; i++)
        {
                if (pseudo_children[i].ti_pid == 0)
                        return i;
        }
        return -1;
}

int findparent(pthread_t pid)
{
        int i;
        for (i = 0; i < MAX_THREADS; i++)
        {
                if (pseudo_children[i].ti_pid == pid)
                        return i;
        }
        return -1;
}

struct child_arg
{
        struct Task *ca_parent_task;
        pthread_t ca_parent;
        PerlInterpreter *ca_interp;
};

static THREAD_RET_TYPE amigaos4_start_child(void *arg)
{

        PerlInterpreter *my_perl =
            (PerlInterpreter *)((struct child_arg *)arg)->ca_interp;
        ;

        GV *tmpgv;
        int status;
        int parent;
        int nextchild;
        pthread_t pseudo_id = pthread_self();

#ifdef PERL_SYNC_FORK
        static long sync_fork_id = 0;
        long id = ++sync_fork_id;
#endif

        /* before we do anything set up our process semaphore and add
           a new entry to the pseudochildren */

        /* get next available slot */
        /* should not fail here! */

        IExec->ObtainSemaphore(&fork_array_sema);

        nextchild = getnextchild();

        pseudo_children[nextchild].ti_pid = pseudo_id;
        pseudo_children[nextchild].ti_parent =
            ((struct child_arg *)arg)->ca_parent;
        pseudo_children[nextchild].ti_port =
            (struct MsgPort *)IExec->AllocSysObjectTags(ASOT_PORT, TAG_DONE);

        num_pseudo_children++;
        IExec->ReleaseSemaphore(&fork_array_sema);

        /* We're set up let the parent continue */

        IExec->Signal(((struct child_arg *)arg)->ca_parent_task,
                      SIGBREAKF_CTRL_F);

        PERL_SET_THX(my_perl);
        if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV)))
        {
                SV *sv = GvSV(tmpgv);
                SvREADONLY_off(sv);
                sv_setiv(sv, (IV)pseudo_id);
                SvREADONLY_on(sv);
        }
        hv_clear(PL_pidstatus);

        /* push a zero on the stack (we are the child) */
        {
                dSP;
                dTARGET;
                PUSHi(0);
                PUTBACK;
        }

        /* continue from next op */
        PL_op = PL_op->op_next;

        {
                dJMPENV;
                volatile int oldscope = PL_scopestack_ix;

        restart:
                JMPENV_PUSH(status);
                switch (status)
                {
                case 0:
                        CALLRUNOPS(aTHX);
                        status = 0;
                        break;
                case 2:
                        while (PL_scopestack_ix > oldscope)
                        {
                                LEAVE;
                        }
                        FREETMPS;
                        PL_curstash = PL_defstash;
                        if (PL_endav && !PL_minus_c)
                                call_list(oldscope, PL_endav);
                        status = STATUS_EXIT;
                        break;
                case 3:
                        if (PL_restartop)
                        {
                                POPSTACK_TO(PL_mainstack);
                                PL_op = PL_restartop;
                                PL_restartop = (OP *)NULL;
                                ;
                                goto restart;
                        }
                        PerlIO_printf(Perl_error_log, "panic: restartop\n");
                        FREETMPS;
                        status = 1;
                        break;
                }
                JMPENV_POP;

                /* XXX hack to avoid perl_destruct() freeing optree */
                PL_main_root = (OP *)NULL;
        }

        {
                do_close(PL_stdingv, FALSE);
                do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO),
                         FALSE); /* PL_stdoutgv - ISAGN */
                do_close(PL_stderrgv, FALSE);
        }

        /* destroy everything (waits for any pseudo-forked children) */

        /* wait for any remaining children */

        while (pseudo_children[nextchild].ti_children > 0)
        {
                if (IExec->WaitPort(pseudo_children[nextchild].ti_port))
                {
                        void *msg =
                            IExec->GetMsg(pseudo_children[nextchild].ti_port);
                        IExec->FreeSysObject(ASOT_MESSAGE, msg);
                        pseudo_children[nextchild].ti_children--;
                }
        }
        if (PL_scopestack_ix <= 1)
        {
                perl_destruct(my_perl);
        }
        perl_free(my_perl);

        IExec->ObtainSemaphore(&fork_array_sema);
        parent = findparent(pseudo_children[nextchild].ti_parent);
        pseudo_children[nextchild].ti_pid = 0;
        pseudo_children[nextchild].ti_parent = 0;
        IExec->FreeSysObject(ASOT_PORT, pseudo_children[nextchild].ti_port);
        pseudo_children[nextchild].ti_port = NULL;

        IExec->ReleaseSemaphore(&fork_array_sema);

        {
                if (parent >= 0)
                {
                        struct thread_exit_message *tem =
                            (struct thread_exit_message *)
                                IExec->AllocSysObjectTags(
                                    ASOT_MESSAGE, ASOMSG_Size,
                                    sizeof(struct thread_exit_message),
                                    ASOMSG_Length,
                                    sizeof(struct thread_exit_message));
                        if (tem)
                        {
                                tem->tem_pid = pseudo_id;
                                tem->tem_status = status;
                                IExec->PutMsg(pseudo_children[parent].ti_port,
                                              (struct Message *)tem);
                        }
                }
        }
#ifdef PERL_SYNC_FORK
        return id;
#else
        return (void *)status;
#endif
}

#endif /* USE_ITHREADS */

Pid_t amigaos_fork()
{
        dTHX;
        pthread_t id;
        int handle;
        struct child_arg arg;
        if (num_pseudo_children >= MAX_THREADS)
        {
                errno = EAGAIN;
                return -1;
        }
        arg.ca_interp = perl_clone((PerlInterpreter *)aTHX, CLONEf_COPY_STACKS);
        arg.ca_parent_task = IExec->FindTask(NULL);
        arg.ca_parent =
            pthread_self() ? pthread_self() : (pthread_t)IExec->FindTask(0);

        handle = pthread_create(&id, NULL, amigaos4_start_child, (void *)&arg);
        pseudo_children[findparent(arg.ca_parent)].ti_children++;

        IExec->Wait(SIGBREAKF_CTRL_F);

        PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
        if (handle)
        {
                errno = EAGAIN;
                return -1;
        }
        return id;
}

Pid_t amigaos_waitpid(pTHX_ int optype, Pid_t pid, void *argflags)
{
        int result;
        if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
        {
                result = pthread_join(pid, argflags);
        }
        else
        {
                while ((result = pthread_join(pid, argflags)) == -1 &&
                       errno == EINTR)
                {
                        //          PERL_ASYNC_CHECK();
                }
        }
        return result;
}

void amigaos_fork_set_userdata(
    pTHX_ struct UserData *userdata, I32 did_pipes, int pp, SV **sp, SV **mark)
{
        userdata->parent = IExec->FindTask(0);
        userdata->did_pipes = did_pipes;
        userdata->pp = pp;
        userdata->sp = sp;
        userdata->mark = mark;
        userdata->my_perl = aTHX;
}

void *amigaos_system_child(void *userdata)
{
        struct Task *parent;
        I32 did_pipes;
        int pp;
        I32 value;
        STRLEN n_a;
        /* these next are declared by macros else where but I may be
         * passing modified values here so declare them explictly but
         * still referred to by macro below */

        register SV **sp;
        register SV **mark;
        register PerlInterpreter *my_perl;

        StdioStore store;

        struct UserData *ud = (struct UserData *)userdata;

        did_pipes = ud->did_pipes;
        parent = ud->parent;
        pp = ud->pp;
        SP = ud->sp;
        MARK = ud->mark;
        my_perl = ud->my_perl;
        PERL_SET_THX(my_perl);

        amigaos_stdio_save(aTHX_ & store);

        if (did_pipes)
        {
                //    PerlLIO_close(pp[0]);
        }
        if (PL_op->op_flags & OPf_STACKED)
        {
                SV *really = *++MARK;
                value = (I32)do_aexec5(really, MARK, SP, pp, did_pipes);
        }
        else if (SP - MARK != 1)
        {
                value = (I32)do_aexec5(NULL, MARK, SP, pp, did_pipes);
        }
        else
        {
                value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp,
                                      did_pipes);
        }

        //    Forbid();
        //    Signal(parent, SIGBREAKF_CTRL_F);

        amigaos_stdio_restore(aTHX_ & store);

        return value;
}
Commit	Line	Data
a83a2cd1 AB	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 <exec/semaphores.h>
	16	#include <exec/exectags.h>
	17	#include <proto/exec.h>
	18	#include <proto/dos.h>
	19	#include <dos/dos.h>
	20
	21	void amigaos_stdio_get(pTHX_ StdioStore *store)
	22	{
	23	store->astdin =
	24	amigaos_get_file(PerlIO_fileno(IoIFP(GvIO(PL_stdingv))));
	25	store->astderr =
	26	amigaos_get_file(PerlIO_fileno(IoIFP(GvIO(PL_stderrgv))));
	27	store->astdout = amigaos_get_file(
	28	PerlIO_fileno(IoIFP(GvIO(gv_fetchpv("STDOUT", TRUE, SVt_PVIO)))));
	29	}
	30
	31	void amigaos_stdio_save(pTHX_ StdioStore *store)
	32	{
	33	amigaos_stdio_get(aTHX_ store);
	34	store->oldstdin = IDOS->SelectInput(store->astdin);
	35	store->oldstderr = IDOS->SelectErrorOutput(store->astderr);
	36	store->oldstdout = IDOS->SelectOutput(store->astdout);
	37	}
	38
	39	void amigaos_stdio_restore(pTHX_ const StdioStore *store)
	40	{
	41	IDOS->SelectInput(store->oldstdin);
	42	IDOS->SelectErrorOutput(store->oldstderr);
	43	IDOS->SelectOutput(store->oldstdout);
	44	}
	45
	46	void amigaos_post_exec(int fd, int do_report)
	47	{
	48	/* We must write something to our pipe or else
	49	* the other end hangs */
	50	if (do_report)
	51	{
	52	int e = errno;
	53	PerlLIO_write(fd, (void *)&e, sizeof(e));
	54	PerlLIO_close(fd);
	55	}
	56	}
	57
	58	PerlIO Perl_my_popen(pTHX_ const char cmd, const char *mode)
	59	{
	60	PERL_FLUSHALL_FOR_CHILD;
	61	/* Call system's popen() to get a FILE *, then import it.
	62	* used 0 for 2nd parameter to PerlIO_importFILE;
	63	* apparently not used
	64	*/
65	// FILE *f=amigaos_popen(cmd,mode);
66	// fprintf(stderr,"popen returned %d\n",f);
67	return PerlIO_importFILE(amigaos_popen(cmd, mode), 0);
68	// return PerlIO_importFILE(f, 0);
69	}
70
71	#ifdef USE_ITHREADS
72
73	/* An arbitrary number to start with, should work out what the real max should
74	* be */
75
76	#ifndef MAX_THREADS
77	# define MAX_THREADS 64
78	#endif
79
80	#define REAPED 0
81	#define ACTIVE 1
82	#define EXITED -1
83
84	struct thread_info
85	{
86	pthread_t ti_pid;
87	int ti_children;
88	pthread_t ti_parent;
89	struct MsgPort *ti_port;
90	};
91
92	static struct thread_info pseudo_children[MAX_THREADS];
93	static int num_pseudo_children = 0;
94	static struct SignalSemaphore fork_array_sema;
95
96	void amigaos4_init_fork_array()
97	{
98	IExec->InitSemaphore(&fork_array_sema);
99	pseudo_children[0].ti_pid = (pthread_t)IExec->FindTask(0);
100	pseudo_children[0].ti_parent = -1;
101	pseudo_children[0].ti_port =
102	(struct MsgPort *)IExec->AllocSysObjectTags(ASOT_PORT, TAG_DONE);
103	}
104
105	void amigaos4_dispose_fork_array()
106	{
107	while (pseudo_children[0].ti_children > 0)
108	{
109	void *msg;
110	IExec->WaitPort(pseudo_children[0].ti_port);
111	msg = IExec->GetMsg(pseudo_children[0].ti_port);
112	if (msg)
113	IExec->FreeSysObject(ASOT_MESSAGE, msg);
114	pseudo_children[0].ti_children--;
115	}
116	IExec->FreeSysObject(ASOT_PORT, pseudo_children[0].ti_port);
117	}
118
119	struct thread_exit_message
120	{
121	struct Message tem_Message;
122	pthread_t tem_pid;
123	int tem_status;
124	};
125
126	int getnextchild()
127	{
128	int i;
129	for (i = 0; i < MAX_THREADS; i++)
130	{
131	if (pseudo_children[i].ti_pid == 0)
132	return i;
133	}
134	return -1;
135	}
136
137	int findparent(pthread_t pid)
138	{
139	int i;
140	for (i = 0; i < MAX_THREADS; i++)
141	{
142	if (pseudo_children[i].ti_pid == pid)
143	return i;
144	}
145	return -1;
146	}
147
148	struct child_arg
149	{
150	struct Task *ca_parent_task;
151	pthread_t ca_parent;
152	PerlInterpreter *ca_interp;
153	};
154
155	static THREAD_RET_TYPE amigaos4_start_child(void *arg)
156	{
157
158	PerlInterpreter *my_perl =
159	(PerlInterpreter )((struct child_arg )arg)->ca_interp;
160	;
161
162	GV *tmpgv;
163	int status;
164	int parent;
165	int nextchild;
166	pthread_t pseudo_id = pthread_self();
167
168	#ifdef PERL_SYNC_FORK
169	static long sync_fork_id = 0;
170	long id = ++sync_fork_id;
171	#endif
172
173	/* before we do anything set up our process semaphore and add
174	a new entry to the pseudochildren */
175
176	/* get next available slot */
177	/* should not fail here! */
178
179	IExec->ObtainSemaphore(&fork_array_sema);
180
181	nextchild = getnextchild();
182
183	pseudo_children[nextchild].ti_pid = pseudo_id;
184	pseudo_children[nextchild].ti_parent =
185	((struct child_arg *)arg)->ca_parent;
186	pseudo_children[nextchild].ti_port =
187	(struct MsgPort *)IExec->AllocSysObjectTags(ASOT_PORT, TAG_DONE);
188
189	num_pseudo_children++;
190	IExec->ReleaseSemaphore(&fork_array_sema);
191
192	/* We're set up let the parent continue */
193
194	IExec->Signal(((struct child_arg *)arg)->ca_parent_task,
195	SIGBREAKF_CTRL_F);
196
197	PERL_SET_THX(my_perl);
198	if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV)))
199	{
200	SV *sv = GvSV(tmpgv);
201	SvREADONLY_off(sv);
202	sv_setiv(sv, (IV)pseudo_id);
203	SvREADONLY_on(sv);
204	}
205	hv_clear(PL_pidstatus);
206
207	/* push a zero on the stack (we are the child) */
208	{
209	dSP;
210	dTARGET;
211	PUSHi(0);
212	PUTBACK;
213	}
214
215	/* continue from next op */
216	PL_op = PL_op->op_next;
217
218	{
219	dJMPENV;
220	volatile int oldscope = PL_scopestack_ix;
221
222	restart:
223	JMPENV_PUSH(status);
224	switch (status)
225	{
226	case 0:
227	CALLRUNOPS(aTHX);
228	status = 0;
229	break;
230	case 2:
231	while (PL_scopestack_ix > oldscope)
232	{
233	LEAVE;
234	}
235	FREETMPS;
236	PL_curstash = PL_defstash;
237	if (PL_endav && !PL_minus_c)
238	call_list(oldscope, PL_endav);
239	status = STATUS_EXIT;
240	break;
241	case 3:
242	if (PL_restartop)
243	{
244	POPSTACK_TO(PL_mainstack);
245	PL_op = PL_restartop;
246	PL_restartop = (OP *)NULL;
247	;
248	goto restart;
249	}
250	PerlIO_printf(Perl_error_log, "panic: restartop\n");
251	FREETMPS;
252	status = 1;
253	break;
254	}
255	JMPENV_POP;
256
257	/* XXX hack to avoid perl_destruct() freeing optree */
258	PL_main_root = (OP *)NULL;
259	}
260
261	{
262	do_close(PL_stdingv, FALSE);
263	do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO),
264	FALSE); /* PL_stdoutgv - ISAGN */
265	do_close(PL_stderrgv, FALSE);
266	}
267
268	/* destroy everything (waits for any pseudo-forked children) */
269
270	/* wait for any remaining children */
271
272	while (pseudo_children[nextchild].ti_children > 0)
273	{
274	if (IExec->WaitPort(pseudo_children[nextchild].ti_port))
275	{
276	void *msg =
277	IExec->GetMsg(pseudo_children[nextchild].ti_port);
278	IExec->FreeSysObject(ASOT_MESSAGE, msg);
279	pseudo_children[nextchild].ti_children--;
280	}
281	}
282	if (PL_scopestack_ix <= 1)
283	{
284	perl_destruct(my_perl);
285	}
286	perl_free(my_perl);
287
288	IExec->ObtainSemaphore(&fork_array_sema);
289	parent = findparent(pseudo_children[nextchild].ti_parent);
290	pseudo_children[nextchild].ti_pid = 0;
291	pseudo_children[nextchild].ti_parent = 0;
292	IExec->FreeSysObject(ASOT_PORT, pseudo_children[nextchild].ti_port);
293	pseudo_children[nextchild].ti_port = NULL;
294
295	IExec->ReleaseSemaphore(&fork_array_sema);
296
297	{
298	if (parent >= 0)
299	{
300	struct thread_exit_message *tem =
301	(struct thread_exit_message *)
302	IExec->AllocSysObjectTags(
303	ASOT_MESSAGE, ASOMSG_Size,
304	sizeof(struct thread_exit_message),
305	ASOMSG_Length,
306	sizeof(struct thread_exit_message));
307	if (tem)
308	{
309	tem->tem_pid = pseudo_id;
310	tem->tem_status = status;
311	IExec->PutMsg(pseudo_children[parent].ti_port,
312	(struct Message *)tem);
313	}
314	}
315	}
316	#ifdef PERL_SYNC_FORK
317	return id;
318	#else
319	return (void *)status;
320	#endif
321	}
322
323	#endif /* USE_ITHREADS */
324
325	Pid_t amigaos_fork()
326	{
327	dTHX;
328	pthread_t id;
329	int handle;
330	struct child_arg arg;
331	if (num_pseudo_children >= MAX_THREADS)
332	{
333	errno = EAGAIN;
334	return -1;
335	}
336	arg.ca_interp = perl_clone((PerlInterpreter *)aTHX, CLONEf_COPY_STACKS);
337	arg.ca_parent_task = IExec->FindTask(NULL);
338	arg.ca_parent =
339	pthread_self() ? pthread_self() : (pthread_t)IExec->FindTask(0);
340
341	handle = pthread_create(&id, NULL, amigaos4_start_child, (void *)&arg);
342	pseudo_children[findparent(arg.ca_parent)].ti_children++;
343
344	IExec->Wait(SIGBREAKF_CTRL_F);
345
346	PERL_SET_THX(aTHX); /* XXX perl_clone() set TLS /
347	if (handle)
348	{
349	errno = EAGAIN;
350	return -1;
351	}
352	return id;
353	}
354
355	Pid_t amigaos_waitpid(pTHX_ int optype, Pid_t pid, void *argflags)
356	{
357	int result;
358	if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
359	{
360	result = pthread_join(pid, argflags);
361	}
362	else
363	{
364	while ((result = pthread_join(pid, argflags)) == -1 &&
365	errno == EINTR)
366	{
367	// PERL_ASYNC_CHECK();
368	}
369	}
370	return result;
371	}
372
373	void amigaos_fork_set_userdata(
374	pTHX_ struct UserData userdata, I32 did_pipes, int pp, SV sp, SV *mark)
375	{
376	userdata->parent = IExec->FindTask(0);
377	userdata->did_pipes = did_pipes;
378	userdata->pp = pp;
379	userdata->sp = sp;
380	userdata->mark = mark;
381	userdata->my_perl = aTHX;
382	}
383
384	void amigaos_system_child(void userdata)
385	{
386	struct Task *parent;
387	I32 did_pipes;
388	int pp;
389	I32 value;
390	STRLEN n_a;
391	/* these next are declared by macros else where but I may be
392	* passing modified values here so declare them explictly but
393	* still referred to by macro below */
394
395	register SV **sp;
396	register SV **mark;
397	register PerlInterpreter *my_perl;
398
399	StdioStore store;
400
401	struct UserData ud = (struct UserData )userdata;
402
403	did_pipes = ud->did_pipes;
404	parent = ud->parent;
405	pp = ud->pp;
406	SP = ud->sp;
407	MARK = ud->mark;
408	my_perl = ud->my_perl;
409	PERL_SET_THX(my_perl);
410
411	amigaos_stdio_save(aTHX_ & store);
412
413	if (did_pipes)
414	{
415	// PerlLIO_close(pp[0]);
416	}
417	if (PL_op->op_flags & OPf_STACKED)
418	{
419	SV really = ++MARK;
420	value = (I32)do_aexec5(really, MARK, SP, pp, did_pipes);
421	}
422	else if (SP - MARK != 1)
423	{
424	value = (I32)do_aexec5(NULL, MARK, SP, pp, did_pipes);
425	}
426	else
427	{
428	value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp,
429	did_pipes);
430	}
431
432	// Forbid();
433	// Signal(parent, SIGBREAKF_CTRL_F);
434
435	amigaos_stdio_restore(aTHX_ & store);
436
437	return value;
438	}