From: Jarkko Hietaniemi Date: Fri, 22 Mar 2002 20:34:28 +0000 (+0000) Subject: EPOC update from Olaf Flebbe. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=85ca448a836bf0ba175d8874ee540094ff909f93;p=p5sagit%2Fp5-mst-13.2.git EPOC update from Olaf Flebbe. p4raw-id: //depot/perl@15426 --- diff --git a/epoc/config.sh b/epoc/config.sh index fad379c..83673ef 100644 --- a/epoc/config.sh +++ b/epoc/config.sh @@ -33,8 +33,8 @@ apirevision='' apisubversion='' apiversion='' ar='arm-epoc-pe-ar' -archlib='?:/perl/lib/5.7.3/epoc' -archlibexp='?:/perl/lib/5.7.3/epoc' +archlib='/usr/lib/perl/5.7.3/epoc' +archlibexp='/usr/lib/perl/5.7.3/epoc' archname64='' archname='epoc' archobjs='epoc.o epocish.o epoc_stubs.o' @@ -611,19 +611,6 @@ i_vfork='undef' ignore_versioned_solibs='' incpath='' inews='' -installarchlib='/home/of/PERL/perl/lib/5.6.0/epoc' -installbin='/home/of/PERL/System/Programs/' -installman1dir='/home/of/PERL/man1' -installman3dir='/home/of/PERL/man3' -installprefix='' -installprefixexp='' -installprivlib='/home/of/PERL/perl/lib/5.6.0/' -installscript='/home/of/PERL/bin/' -installsitearch='/home/of/PERL/site/lib/site_perl/5.6.0/epoc' -installsitelib='/home/of/PERL/perl/lib/site_perl/5.6.0' -installstyle='' -installusrbinperl='undef' -installvendorlib='' intsize='4' known_extensions='Data/Dumper File/Glob IO Socket Fcntl Sys/Hostname Errno' ksh='' @@ -728,8 +715,8 @@ pmake='' pr='' prefix='' prefixexp='' -privlib='?:/perl/lib/5.7.3' -privlibexp='?:/perl/lib/5.7.3' +privlib='/usr/lib/perl/5.7.3' +privlibexp='/usr/lib/perl/5.7.3' procselfexe='' prototype='define' ptrsize='4' @@ -784,11 +771,11 @@ sig_num='0' sig_num_init='0, 0' sig_size='1' signal_t='void' -sitearch='?:/perl/lib/site_perl/5.7.3/epoc' -sitearchexp='?:/perl/lib/site_perl/5.7.3/epoc' -sitelib='?:/perl/lib/site_perl/5.7.3/' -sitelib_stem='?:/perl/lib/site_perl' -sitelibexp='?:/perl/lib/site_perl/5.7.3/' +sitearch='/usr/lib/perl/site_perl/5.7.3/epoc' +sitearchexp='/usr/lib/perl/site_perl/5.7.3/epoc' +sitelib='/usr/lib/perl/site_perl/5.7.3/' +sitelib_stem='/usr/lib/perl/site_perl' +sitelibexp='/usr/lib/perl/site_perl/5.7.3/' siteprefix='' siteprefixexp='' sizesize='4' @@ -1121,5 +1108,18 @@ d_SCNfldbl='undef' d_perl_otherlibdirs='undef' nvsize='16' issymlink='' +installarchlib='/home/of/PERL/perl/lib/5.6.0/epoc' +installbin='/home/of/PERL/System/Programs/' +installman1dir='/home/of/PERL/man1' +installman3dir='/home/of/PERL/man3' +installprefix='' +installprefixexp='' +installprivlib='/home/of/PERL/perl/lib/5.6.0/' +installscript='/home/of/PERL/bin/' +installsitearch='/home/of/PERL/site/lib/site_perl/5.6.0/epoc' +installsitelib='/home/of/PERL/perl/lib/site_perl/5.6.0' +installstyle='' +installusrbinperl='undef' +installvendorlib='' diff --git a/epoc/createpkg.pl b/epoc/createpkg.pl index 39cd8c4..c4032bf 100644 --- a/epoc/createpkg.pl +++ b/epoc/createpkg.pl @@ -3,39 +3,37 @@ use File::Find; use Cwd; -$VERSION="5.7"; -$PATCH="1"; -$EPOC_VERSION=27; +$VERSION="5.7.3"; +$EPOC_VERSION=1; sub filefound { my $f = $File::Find::name; - return if ( $f =~ /CVS|unicode|CPAN|ExtUtils|IPC|User|DB.pm|\.a$|\.ld$|\.exists$|\.pod$/i); + return if ( $f =~ /CVS|Unicode|unicore|CPAN|ExtUtils|IPC|User|DB.pm|\.a$|\.ld$|\.exists$|\.pod$|\.t$/i); my $back = $f; my $psiback = $back; - $psiback =~ s|.*/lib/|\\perl\\lib\\$VERSION.$PATCH\\|; - + $psiback =~ s|.*/lib/|\\emx\\lib\\perl\\$VERSION\\|; + $psiback =~ s|/|\\|g; print OUT "\"$back\"-\"!:$psiback\"\n" if ( -f $f ); } open OUT,">perl.pkg"; -print OUT "#{\"perl$VERSION\"},(0x100051d8),$PATCH,$EPOC_VERSION,0\n"; -print OUT "\"" . cwd . "/Artistic.txt\"-\"\",FT,TA\n"; -print OUT "\"" . cwd . "/perl\"-\"!:\\system\\programs\\perl.exe\"\n"; +print OUT "#{\"perl$VERSION\"},(0x100051d8),0,$EPOC_VERSION,0\n"; +print OUT "\"" . cwd . "/Artistic.txt\"-\"\",FT,TC\n"; +print OUT "\"" . cwd . "/perl\"-\"!:\\emx\\bin\\perl.exe\"\n"; find(\&filefound, cwd.'/lib'); -# print OUT "@\"G:\\lib\\stdlib.sis\",(0x0100002c3)\n"; open IN, "Artistic.txt"; while (my $line = ) { chomp $line; - print OUT "$line\x13\x10"; + print OUT "$line\r\n"; } close IN; diff --git a/epoc/epoc.c b/epoc/epoc.c index 1348109..88dca1e 100644 --- a/epoc/epoc.c +++ b/epoc/epoc.c @@ -10,88 +10,8 @@ #include #include #include +#include -void -Perl_epoc_init(int *argcp, char ***argvp) { - int i; - int truecount=0; - char **lastcp = (*argvp); - char *ptr; - -#if 0 - epoc_spawn_posix_server(); -#endif - for (i=0; i< *argcp; i++) { - if ((*argvp)[i]) { - if (*((*argvp)[i]) == '<') { - if (strlen((*argvp)[i]) > 1) { - ptr =((*argvp)[i])+1; - } else { - i++; - ptr = ((*argvp)[i]); - } - freopen( ptr, "r", stdin); - } else if (*((*argvp)[i]) == '>') { - if (strlen((*argvp)[i]) > 1) { - ptr =((*argvp)[i])+1; - } else { - i++; - ptr = ((*argvp)[i]); - } - freopen( ptr, "w", stdout); - } else if ((*((*argvp)[i]) == '2') && (*(((*argvp)[i])+1) == '>')) { - if (strcmp( (*argvp)[i], "2>&1") == 0) { - dup2( fileno( stdout), fileno( stderr)); - } else { - if (strlen((*argvp)[i]) > 2) { - ptr =((*argvp)[i])+2; - } else { - i++; - ptr = ((*argvp)[i]); - } - freopen( ptr, "w", stderr); - } - } else { - *lastcp++ = (*argvp)[i]; - truecount++; - } - } - } - *argcp=truecount; - - -} - - -#ifdef __MARM__ -/* Symbian forgot to include __fixunsdfi into the MARM euser.lib */ -/* This is from libgcc2.c , gcc-2.7.2.3 */ - -typedef unsigned int UQItype __attribute__ ((mode (QI))); -typedef int SItype __attribute__ ((mode (SI))); -typedef unsigned int USItype __attribute__ ((mode (SI))); -typedef int DItype __attribute__ ((mode (DI))); -typedef unsigned int UDItype __attribute__ ((mode (DI))); - -typedef float SFtype __attribute__ ((mode (SF))); -typedef float DFtype __attribute__ ((mode (DF))); - - - -extern DItype __fixunssfdi (SFtype a); -extern DItype __fixunsdfdi (DFtype a); - - -USItype -__fixunsdfsi (a) - DFtype a; -{ - if (a >= - (DFtype) (- 2147483647L -1) ) - return (SItype) (a + (- 2147483647L -1) ) - (- 2147483647L -1) ; - return (SItype) a; -} - -#endif #include "EXTERN.h" #include "perl.h" @@ -100,26 +20,7 @@ __fixunsdfsi (a) int do_spawn( char *cmd) { dTHX; - char *argv0, *ptr; - char *cmdptr = cmd; - int ret; - - argv0 = ptr = malloc( strlen(cmd) + 1); - - while (*cmdptr && !isSPACE( *cmdptr)) { - *ptr = *cmdptr; - if (*ptr == '/') { - *ptr = '\\'; - } - ptr++; cmdptr++; - } - while (*cmdptr && isSPACE( *cmdptr)) { - cmdptr++; - } - *ptr = '\0'; - ret = epoc_spawn( argv0, cmdptr); - free( argv0); - return ret; + return system( cmd); } int @@ -134,12 +35,11 @@ do_aspawn ( void *vreally, void **vmark, void **vsp) { char **argv; char *str; char *p2, **ptr; - char *cmd, *cmdline; + char *cmd; int rc; int index = 0; - int len = 0; if (sp<=mark) return -1; @@ -151,30 +51,13 @@ do_aspawn ( void *vreally, void **vmark, void **vsp) { argv[index] = str; else argv[index] = ""; - - len += strlen(argv[ index++]) + 1; } argv[index++] = 0; cmd = strdup((const char*)(really ? SvPV_nolen(really) : argv[0])); - for (p2=cmd; *p2 != '\0'; p2++) { - /* Change / to \ */ - if ( *p2 == '/') - *p2 = '\\'; - } - - cmdline = (char * ) malloc( len + 1); - cmdline[ 0] = '\0'; - while (*argv != NULL) { - strcat( cmdline, *ptr++); - strcat( cmdline, " "); - } - + spawnvp( P_WAIT, cmd, argv); free( argv); - - rc = epoc_spawn( cmd, cmdline); - free( cmdline); free( cmd); return rc; diff --git a/epoc/epoc_stubs.c b/epoc/epoc_stubs.c index c1c6bcf..2d1b09d 100644 --- a/epoc/epoc_stubs.c +++ b/epoc/epoc_stubs.c @@ -6,62 +6,13 @@ * */ -#include - -int getgid() {return 0;} -int getegid() {return 0;} -int geteuid() {return 0;} -int getuid() {return 0;} int setgid() {return -1;} int setuid() {return -1;} - -int Perl_my_popen( int a, int b) { - return NULL; -} -int Perl_my_pclose( int a) { - return NULL; -} - -int kill() {return -1;} -signal() { } - int execv() { return -1;} int execvp() { return -1;} void Perl_do_exec() {} -/*------------------------------------------------------------------*/ -/* Two dummy functions implement getproto* */ -/*------------------------------------------------------------------*/ -#include -#include -#include - - -static struct protoent protos[2] = { - {"tcp", NULL, IPPROTO_TCP} , - {"udp", NULL, IPPROTO_UDP}}; - -struct protoent *getprotobyname (const char *st) { - - if (!strcmp( st, "tcp")) { - return &protos[0]; - } - if (!strcmp( st, "udp")) { - return &protos[1]; - } - return NULL; -} - -struct protoent *getprotobynumber ( int i) { - if (i == IPPROTO_TCP) { - return &protos[0]; - } - if (i == IPPROTO_UDP) { - return &protos[1]; - } - return NULL; -} diff --git a/epoc/epocish.c b/epoc/epocish.c index a8b9597..d457fff 100644 --- a/epoc/epocish.c +++ b/epoc/epocish.c @@ -15,42 +15,6 @@ extern "C" { -#if 1 -int -epoc_spawn( char *cmd, char *cmdline) { - RProcess p; - TRequestStatus status; - TInt rc; - - rc = p.Create( _L( cmd), _L( cmdline)); - if (rc != KErrNone) { - return -1; - } - - p.Resume(); - - p.Logon( status); - User::WaitForRequest( status); - p.Kill( 0); - if (status!=KErrNone) { - return -1; - } - return 0; -} -#else -int -epoc_spawn( char *cmd, char *cmdline) { - int len = strlen(cmd) + strlen(cmdline) + 4; - char *n = (char *) malloc( len); - int r; - strcpy( n, cmd); - strcat( n, " "); - strcat( n, cmdline); - r = system( n); - free( n); - return r; -} -#endif /* Workaround for defect strtoul(). Values with leading + are zero */ @@ -61,19 +25,6 @@ unsigned long int epoc_strtoul(const char *nptr, char **endptr, return strtoul( nptr, endptr, base); } -/* Workaround for defect atof(), see java defect list for epoc */ -double epoc_atof( char* str) { - TReal64 aRes; - - while (TChar( *str).IsSpace()) { - str++; - } - - TLex lex( _L( str)); - TInt err = lex.Val( aRes, TChar( '.')); - return aRes; -} - void epoc_gcvt( double x, int digits, unsigned char *buf) { TRealFormat trel; @@ -87,8 +38,4 @@ void epoc_gcvt( double x, int digits, unsigned char *buf) { } } -#if 0 -void epoc_spawn_posix_server() { - SpawnPosixServerThread(); -} -#endif + diff --git a/epoc/epocish.h b/epoc/epocish.h index ae4970f..a98faa0 100644 --- a/epoc/epocish.h +++ b/epoc/epocish.h @@ -107,14 +107,14 @@ /* these should be set in a hint file, not here */ #ifndef PERL_SYS_INIT -# define PERL_SYS_INIT(c,v) Perl_epoc_init(c,v); MALLOC_INIT +# define PERL_SYS_INIT(c,v) MALLOC_INIT #endif #ifndef PERL_SYS_TERM #define PERL_SYS_TERM() MALLOC_TERM #endif -#define BIT_BUCKET "NUL:" +#define BIT_BUCKET "/dev/null" #define dXSUB_SYS @@ -136,8 +136,6 @@ atof() in ER5 stdlib depends on locale. */ -double epoc_atof( const char *ptr); -#define atof(a) epoc_atof(a) #define strtoul(a,b,c) epoc_strtoul(a,b,c) #define init_os_extras Perl_init_os_extras @@ -146,3 +144,5 @@ double epoc_atof( const char *ptr); #define ARG_MAX 4096 +#define ECONNABORTED 0xdead + diff --git a/pp_sys.c b/pp_sys.c index 941760b..f250428 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -2291,7 +2291,7 @@ PP(pp_socket) PP(pp_sockpair) { -#if defined (HAS_SOCKETPAIR) || (defined (HAS_SOCKET) && defined(SOCK_DGRAM) && defined(AF_INET) && defined(PF_INET)) +#if defined (HAS_SOCKETPAIR) || (defined (HAS_SOCKET) && defined(SOCK_DGRAM) && defined(AF_INET) && defined(PF_INET) && defined(HAS_SELECT)) dSP; GV *gv1; GV *gv2; diff --git a/util.c b/util.c index 828ddd4..cd13986 100644 --- a/util.c +++ b/util.c @@ -2192,7 +2192,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode) return PerlIO_fdopen(p[This], mode); } #else -#if defined(atarist) +#if defined(atarist) || defined(EPOC) FILE *popen(); PerlIO * Perl_my_popen(pTHX_ char *cmd, char *mode) @@ -2577,7 +2577,7 @@ Perl_pidgone(pTHX_ Pid_t pid, int status) return; } -#if defined(atarist) || defined(OS2) +#if defined(atarist) || defined(OS2) || defined(EPOC) int pclose(); #ifdef HAS_FORK int /* Cannot prototype with I32 @@ -4199,7 +4199,9 @@ S_socketpair_udp (int fd[2]) { return -1; } } +#endif /* EMULATE_SOCKETPAIR_UDP */ +#if !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET) && defined(AF_INET) && defined(PF_INET) int Perl_my_socketpair (int family, int type, int protocol, int fd[2]) { /* Stevens says that family must be AF_LOCAL, protocol 0. @@ -4278,7 +4280,7 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) { return 0; abort_tidy_up_and_fail: - errno = ECONNABORTED; /* I hope this is portable and appropriate. */ + errno = ECONNABORTED; /* I hope this is portable and appropriate. */ tidy_up_and_fail: { int save_errno = errno; @@ -4292,8 +4294,7 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) { return -1; } } -#endif /* !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET) */ -#ifdef HAS_SOCKETPAIR +#else /* In any case have a stub so that there's code corresponding * to the my_socketpair in global.sym. */ int