This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix for failure to match $foo =~ /(?i)/ (from Ilya Zakharevich)
[perl5.git] / epoc / epoc.c
CommitLineData
ae2d1787
OF
1/*
2 * Copyright (c) 1999 Olaf Flebbe o.flebbe@gmx.de
3 *
4 * You may distribute under the terms of either the GNU General Public
5 * License or the Artistic License, as specified in the README file.
6 *
7 */
4d2c4e07
OF
8
9#include <stdlib.h>
ae2d1787
OF
10#include <string.h>
11#include <stdio.h>
12#include <sys/unistd.h>
13
ae2d1787
OF
14void
15Perl_epoc_init(int *argcp, char ***argvp) {
16 int i;
17 int truecount=0;
18 char **lastcp = (*argvp);
19 char *ptr;
20 for (i=0; i< *argcp; i++) {
21 if ((*argvp)[i]) {
22 if (*((*argvp)[i]) == '<') {
23 if (strlen((*argvp)[i]) > 1) {
24 ptr =((*argvp)[i])+1;
25 } else {
26 i++;
27 ptr = ((*argvp)[i]);
28 }
29 freopen( ptr, "r", stdin);
30 } else if (*((*argvp)[i]) == '>') {
31 if (strlen((*argvp)[i]) > 1) {
32 ptr =((*argvp)[i])+1;
33 } else {
34 i++;
35 ptr = ((*argvp)[i]);
36 }
37 freopen( ptr, "w", stdout);
38 } else if ((*((*argvp)[i]) == '2') && (*(((*argvp)[i])+1) == '>')) {
39 if (strcmp( (*argvp)[i], "2>&1") == 0) {
40 dup2( fileno( stdout), fileno( stderr));
41 } else {
42 if (strlen((*argvp)[i]) > 2) {
43 ptr =((*argvp)[i])+2;
44 } else {
45 i++;
46 ptr = ((*argvp)[i]);
47 }
48 freopen( ptr, "w", stderr);
49 }
50 } else {
51 *lastcp++ = (*argvp)[i];
52 truecount++;
53 }
54 }
55 }
56 *argcp=truecount;
57
4d2c4e07 58
4d2c4e07
OF
59}
60
4d2c4e07
OF
61#ifdef __MARM__
62/* Symbian forgot to include __fixunsdfi into the MARM euser.lib */
63/* This is from libgcc2.c , gcc-2.7.2.3 */
64
65typedef unsigned int UQItype __attribute__ ((mode (QI)));
66typedef int SItype __attribute__ ((mode (SI)));
67typedef unsigned int USItype __attribute__ ((mode (SI)));
68typedef int DItype __attribute__ ((mode (DI)));
69typedef unsigned int UDItype __attribute__ ((mode (DI)));
70
71typedef float SFtype __attribute__ ((mode (SF)));
72typedef float DFtype __attribute__ ((mode (DF)));
73
74
75
76extern DItype __fixunssfdi (SFtype a);
77extern DItype __fixunsdfdi (DFtype a);
78
79
80USItype
81__fixunsdfsi (a)
82 DFtype a;
83{
84 if (a >= - (DFtype) (- 2147483647L -1) )
85 return (SItype) (a + (- 2147483647L -1) ) - (- 2147483647L -1) ;
86 return (SItype) a;
87}
88
3a2f06e9
GS
89#include "EXTERN.h"
90#include "perl.h"
91#include "XSUB.h"
92
93int
94do_aspawn( pTHX_ SV *really,SV **mark,SV **sp) {
95 return do_spawn( really, mark, sp);
96}
97
98int
99do_spawn (pTHX_ SV *really,SV **mark,SV **sp)
100{
101 dTHR;
102 int rc;
103 char **a,*cmd,**ptr, *cmdline, **argv, *p2;
104 STRLEN n_a;
105 size_t len = 0;
106
107 if (sp<=mark)
108 return -1;
109
110 a=argv=ptr=(char**) malloc ((sp-mark+3)*sizeof (char*));
111
112 while (++mark <= sp) {
113 if (*mark)
114 *a = SvPVx(*mark, n_a);
115 else
116 *a = "";
117 len += strlen( *a) + 1;
118 a++;
119 }
120 *a = Nullch;
121
122 if (!(really && *(cmd = SvPV(really, n_a)))) {
123 cmd = argv[0];
124 argv++;
125 }
126
127 cmdline = (char * ) malloc( len + 1);
128 cmdline[ 0] = '\0';
129 while (*argv != NULL) {
130 strcat( cmdline, *argv++);
131 strcat( cmdline, " ");
132 }
133
134 for (p2=cmd; *p2 != '\0'; p2++) {
135 /* Change / to \ */
136 if ( *p2 == '/')
137 *p2 = '\\';
138 }
139 rc = epoc_spawn( cmd, cmdline);
140 free( ptr);
141 free( cmdline);
142
143 return rc;
144}
145
146
4d2c4e07 147#endif