Olaf Flebbe <o.flebbe@gmx.de>
http://www.linuxstart.com/~oflebbe/perl/perl5.html
-2000-02-20
+2000-05-15
=====================================================================
Introduction
EPOC is a OS for palmtops and mobile phones. For more informations look at:
http://www.symbian.com/
-This is a port of Perl version 5.5.650 to EPOC. It runs on the Perl
-Series 5, Series 5mx and the Psion Revo. I have no reports for other
-EPOC devices.
+This is a port of Perl version 5.6.0 to EPOC. It runs on the Perl
+Series 5, Series 5mx and the Psion Revo and on the Ericson M128.
Features are left out, because of restrictions of the POSIX support.
I'm offering this port "as is". You can ask me questions, but I can't
guarantee I'll be able to answer them; I don't know much about Perl
-internals myself;
+internals myself.
# libperl.a is _the_ library both in dll and static cases
# $(LIBPERL)$(LIB_EXT) expands to this name dependless of build model
#
+# NOTE: The "-Wl,-Bstatic $(LLIBPERL) -Wl,-Bdynamic" is required to give
+# the import library linking priority over the dynamic library, since both
+# the .dll and .a are in the same directory. When the new standard for
+# naming import/dynamic/static libraries emerges this should be updated.
+#
$spitshell >>Makefile <<'!NO!SUBS!'
perl: $& perlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs
- $(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+ $(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) -Wl,-Bstatic $(LLIBPERL) -Wl,-Bdynamic `cat ext.libs` $(libs)
pureperl: $& perlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs
$(SHRPENV) $(LDLIBPTH) purify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
#endif
#endif
+
+#define HALF_UPGRADE(start,end) { \
+ U8* new; \
+ STRLEN len; \
+ len = end-start; \
+ new = bytes_to_utf8(start, &len); \
+ Copy(new,start,len,U8*); \
+ end = start + len; \
+ }
+
+
STATIC I32
-S_do_trans_simple(pTHX_ SV *sv) /* SPC - OK */
+S_do_trans_simple(pTHX_ SV *sv)
{
dTHR;
U8 *s;
+ U8 *d;
U8 *send;
+ U8 *dstart;
I32 matches = 0;
- I32 hasutf = SvUTF8(sv);
+ I32 sutf = SvUTF8(sv);
STRLEN len;
short *tbl;
I32 ch;
s = (U8*)SvPV(sv, len);
send = s + len;
+ /* First, take care of non-UTF8 input strings, because they're easy */
+ if (!sutf) {
while (s < send) {
- if (hasutf && *s & 0x80)
- s+=UTF8SKIP(s); /* Given that we're here because tbl is !UTF8...*/
- else {
if ((ch = tbl[*s]) >= 0) {
matches++;
- *s = ch;
- }
+ *s++ = ch;
+ } else
s++;
}
- }
SvSETMAGIC(sv);
+ return matches;
+ }
+ /* Allow for expansion: $_="a".chr(400); tr/a/\xFE/, FE needs encoding */
+ Newz(0, d, len*2+1, U8);
+ dstart = d;
+ while (s < send) {
+ I32 ulen;
+ short c;
+
+ ulen = 1;
+ /* Need to check this, otherwise 128..255 won't match */
+ c = utf8_to_uv(s, &ulen);
+ if (c < 0x100 && (ch = tbl[(short)c]) >= 0) {
+ matches++;
+ if (ch < 0x80)
+ *d++ = ch;
+ else
+ d = uv_to_utf8(d,ch);
+ s += ulen;
+ } else { /* No match -> copy */
+ while (ulen--)
+ *d++ = *s++;
+ }
+ }
+ *d='\0';
+ sv_setpvn(sv, dstart, d - dstart);
+ SvUTF8_on(sv);
+ SvLEN_set(sv, 2*len+1);
+ SvSETMAGIC(sv);
return matches;
}
if (hasutf && *s & 0x80)
s+=UTF8SKIP(s);
else {
- if (tbl[*s] >= 0)
+ UV c;
+ I32 ulen;
+ ulen = 1;
+ if (hasutf)
+ c = utf8_to_uv(s,&ulen);
+ else
+ c = *s;
+ if (c < 0x100 && tbl[c] >= 0)
matches++;
- s++;
+ s+=ulen;
}
}
}
STATIC I32
-S_do_trans_complex(pTHX_ SV *sv)/* SPC - OK */
+S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
{
dTHR;
U8 *s;
if ((uv = swash_fetch(rv, s)) < none) {
s += UTF8SKIP(s);
matches++;
- if (uv & 0x80 && !isutf) {
- /* Sneaky-upgrade dstart...d */
- U8* new;
- STRLEN len;
- len = dstart - d;
- new = bytes_to_utf8(dstart, &len);
- Copy(new,dstart,len,U8*);
- d = dstart + len;
- isutf++;
- }
+ if (uv & 0x80 && !isutf++)
+ HALF_UPGRADE(dstart,d);
d = uv_to_utf8(d, uv);
}
else if (uv == none) {
int i;
i = UTF8SKIP(s);
- if (i > 1 && !isutf) {
- U8* new;
- STRLEN len;
- len = dstart - d;
- new = bytes_to_utf8(dstart, &len);
- Copy(new,dstart,len,U8*);
- d = dstart + len;
- isutf++;
- }
+ if (i > 1 && !isutf++)
+ HALF_UPGRADE(dstart,d);
while(i--)
*d++ = *s++;
}
i = UTF8SKIP(s);
s += i;
matches++;
- if (i > 1 && !isutf) {
- U8* new;
- STRLEN len;
- len = dstart - d;
- new = bytes_to_utf8(dstart, &len);
- Copy(new,dstart,len,U8*);
- d = dstart + len;
- isutf++;
- }
+ if (i > 1 && !isutf++)
+ HALF_UPGRADE(dstart,d);
d = uv_to_utf8(d, final);
}
else
s += UTF8SKIP(s);
}
*d = '\0';
- SvPV_set(sv, dstart);
- SvCUR_set(sv, d - dstart);
+ sv_setpvn(sv, dstart, d - dstart);
SvSETMAGIC(sv);
if (isutf)
SvUTF8_on(sv);
U8 *d;
I32 matches = 0;
I32 squash = PL_op->op_private & OPpTRANS_SQUASH;
- I32 from_utf = PL_op->op_private & OPpTRANS_FROM_UTF;
- I32 to_utf = PL_op->op_private & OPpTRANS_TO_UTF;
I32 del = PL_op->op_private & OPpTRANS_DELETE;
SV* rv = (SV*)cSVOP->op_sv;
HV* hv = (HV*)SvRV(rv);
UV uv;
STRLEN len;
U8 *dst;
+ I32 isutf = SvUTF8(sv);
s = (U8*)SvPV(sv, len);
send = s + len;
if (svp)
final = SvUV(*svp);
- if (PL_op->op_private & OPpTRANS_GROWS) {
- I32 bits = 16;
-
- svp = hv_fetch(hv, "BITS", 4, FALSE);
- if (svp)
- bits = (I32)SvIV(*svp);
-
- Newz(801, d, len * (bits >> 3) + 1, U8);
+ Newz(0, d, len*2+1, U8);
dst = d;
- }
- else {
- d = s;
- dst = 0;
- }
if (squash) {
UV puv = 0xfeedface;
while (s < send) {
- if (from_utf) {
+ if (SvUTF8(sv))
uv = swash_fetch(rv, s);
- }
else {
U8 tmpbuf[2];
uv = *s++;
}
uv = swash_fetch(rv, tmpbuf);
}
+
if (uv < none) {
matches++;
if (uv != puv) {
- if (uv >= 0x80 && to_utf)
+ if (uv & 0x80 && !isutf++)
+ HALF_UPGRADE(dst,d);
d = uv_to_utf8(d, uv);
- else
- *d++ = (U8)uv;
puv = uv;
}
- if (from_utf)
s += UTF8SKIP(s);
continue;
}
else if (uv == none) { /* "none" is unmapped character */
- if (from_utf) {
- if (*s < 0x80)
- *d++ = *s++;
- else if (to_utf) {
- int i;
- for (i = UTF8SKIP(s); i; --i)
- *d++ = *s++;
- }
- else {
I32 ulen;
*d++ = (U8)utf8_to_uv(s, &ulen);
s += ulen;
- }
- }
- else { /* must be to_utf only */
- d = uv_to_utf8(d, s[-1]);
- }
puv = 0xfeedface;
continue;
}
else if (uv == extra && !del) {
matches++;
if (uv != puv) {
- if (final >= 0x80 && to_utf)
d = uv_to_utf8(d, final);
- else
- *d++ = (U8)final;
puv = final;
}
- if (from_utf)
s += UTF8SKIP(s);
continue;
}
matches++; /* "none+1" is delete character */
- if (from_utf)
s += UTF8SKIP(s);
}
}
else {
while (s < send) {
- if (from_utf) {
+ if (SvUTF8(sv))
uv = swash_fetch(rv, s);
- }
else {
U8 tmpbuf[2];
uv = *s++;
}
if (uv < none) {
matches++;
- if (uv >= 0x80 && to_utf)
d = uv_to_utf8(d, uv);
- else
- *d++ = (U8)uv;
- if (from_utf)
s += UTF8SKIP(s);
continue;
}
else if (uv == none) { /* "none" is unmapped character */
- if (from_utf) {
- if (*s < 0x80)
- *d++ = *s++;
- else if (to_utf) {
- int i;
- for (i = UTF8SKIP(s); i; --i)
- *d++ = *s++;
- }
- else {
I32 ulen;
*d++ = (U8)utf8_to_uv(s, &ulen);
s += ulen;
- }
- }
- else { /* must be to_utf only */
- d = uv_to_utf8(d, s[-1]);
- }
continue;
}
else if (uv == extra && !del) {
matches++;
- if (final >= 0x80 && to_utf)
d = uv_to_utf8(d, final);
- else
- *d++ = (U8)final;
- if (from_utf)
s += UTF8SKIP(s);
continue;
}
matches++; /* "none+1" is delete character */
- if (from_utf)
s += UTF8SKIP(s);
}
}
crosscompile='define'
cryptlib=''
csh='csh'
-d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+d_Gconvert='epoc_gcvt((x),(n),(b))'
d_PRIEldbl='undef'
d_PRIFldbl='undef'
d_PRIGldbl='undef'
d_iconv='undef'
d_index='undef'
d_inetaton='define'
-d_int64t='undef'
+d_int64_t='undef'
d_iovec_s='undef'
d_isascii='define'
d_isnan='define'
eunicefix=':'
exe_ext=''
expr='expr'
-extensions='Data/Dumper File/Glob IO Socket'
+extensions='Data/Dumper File/Glob IO Socket Fcntl'
fflushNULL='undef'
fflushall='define'
find=''
installusrbinperl='undef'
installvendorlib=''
intsize='4'
-known_extensions='Data/Dumper File/Glob IO Socket'
+known_extensions='Data/Dumper File/Glob IO Socket Fcntl'
ksh=''
large=''
ld='echo'
smail=''
small=''
so=''
-socksizetype='int'
+socksizetype='size_t'
sockethdr=''
socketlib=''
sort='sort'
ssizetype='long'
startperl=''
startsh='#!/bin/sh'
-static_ext='Data/Dumper File/Glob IO Socket'
+static_ext='Data/Dumper File/Glob IO Socket Fcntl'
stdchar='char'
stdio_base=''
stdio_bufsiz=''
useithreads='undef'
inc_version_list=' '
inc_version_list_init='0'
+d_madvise='undef'
+d_mkdtemp='undef'
+d_mkstemp='undef'
+d_mkstemps='undef'
+d_mmap='undef'
+d_mprotect='undef'
+d_msync='undef'
+d_munmap='undef'
+d_qgcvt='undef'
+d_socklen_t='undef'
+d_vendorarch=''
+i_iconv='undef'
+i_ieeefp='undef'
+i_sunmath='undef'
+i_syslog='undef'
+i_sysmman='undef'
+i_sysutsname='undef'
+installvendorarch=''
+mmaptype=''
+revision='5'
+sizesize='4'
+socksizetype='int'
+
+double='undef'
+usemorebits='undef'
+usemultiplicity='undef'
+usemymalloc='n'
+usenm=''
+useopcode=''
+useperlio='undef'
+useposix=''
+usesfio=''
+useshrplib=''
+usesocks='undef'
+usethreads='undef'
+usevendorprefix=''
+usevfork=''
+usrinc=''
+uuname=''
+vendorlib=''
+vendorlib_stem=''
+vendorlibexp=''
+vendorprefix=''
+vendorprefixexp=''
+version='5.6.0'
+vi=''
+voidflags='15'
+xlibpth=''
+zcat=''
+zip=''
+# Configure command line arguments.
+config_arg0=''
+config_args=''
+config_argc=11
+config_arg1=''
+config_arg2=''
+config_arg3=''
+config_arg4=''
+config_arg5=''
+config_arg6=''
+config_arg7=''
+config_arg8=''
+config_arg9=''
+config_arg10=''
+config_arg11=''
+PERL_REVISION=5
+PERL_VERSION=6
+PERL_SUBVERSION=0
+PERL_API_REVISION=5
+PERL_API_VERSION=6
+PERL_API_SUBVERSION=0
+CONFIGDOTSH=true
+# Variables propagated from previous config.sh file.
+pp_sys_cflags=''
+epocish_cflags='ccflags="$cflags -xc++"'
+ivtype='int'
+uvtype='unsigned int'
+i8type='char'
+u8type='unsigned char'
+i16type='short'
+u16type='unsigned short'
+i32type='int'
+u32type='unsigned int'
+i64type='long long'
+u64type='unsigned long long'
+d_quad='define'
+quadtype='long long'
+quadtype='unsigned long long'
+quadkind='QUAD_IS_LONG_LONG'
+nvtype='double'
+ivsize='4'
+uvsize='4'
+i8size='1'
+u8size='1'
+i16size='2'
+u16size='2'
+i32size='4'
+u32size='4'
+i64size='8'
+u64size='8'
+d_fs_data_s='undef'
+d_fseeko='undef'
+d_ldbl_dig='undef'
+d_sqrtl='undef'
+d_getmnt='undef'
+d_statfs_f_flags='undef'
+d_statfs_s='undef'
+d_ustat='undef'
+i_sysstatfs='undef'
+i_sysvfs='undef'
+i_ustat='undef'
+uidsize='2'
+uidsign='1'
+gidsize='2'
+gidsign='1'
+ivdformat='"ld"'
+uvuformat='"lu"'
+uvoformat='"lo"'
+uvxformat='"lx"'
+uidformat='"hu"'
+gidformat='"hu"'
+d_strtold='undef'
+d_strtoll='undef'
+d_strtouq='undef'
+d_nv_preserves_uv='define'
+use5005threads='undef'
+useithreads='undef'
+inc_version_list=' '
+inc_version_list_init='0'
+d_madvise='undef'
+d_mkdtemp='undef'
+d_mkstemp='undef'
+d_mkstemps='undef'
+d_mmap='undef'
+d_mprotect='undef'
+d_msync='undef'
+d_munmap='undef'
+d_qgcvt='undef'
+d_socklen_t='undef'
+d_vendorarch=''
+i_iconv='undef'
+i_ieeefp='undef'
+i_sunmath='undef'
+i_syslog='undef'
+i_sysmman='undef'
+i_sysutsname='undef'
+installvendorarch=''
+mmaptype=''
+revision='5'
+sizesize='4'
+socksizetype='int'
+xs_apiversion='5.005'
+d_getcwd='define'
+i_sysmode='undef'
+d_vendorarch='undef'
+
use File::Find;
use Cwd;
-$VERSION="5.5";
-$PATCH="650";
-$EPOC_VERSION=19;
+$VERSION="5.6";
+$PATCH="0";
+$EPOC_VERSION=20;
$CROSSCOMPILEPATH=cwd;
-$CROSSREPLACEPATH="H:\\devel\\perl5.5.650";
+$CROSSREPLACEPATH="H:\\perl";
sub filefound {
*
*/
-/* This is indeed C++ Code !! */
+/* This is C++ Code !! */
#include <e32std.h>
return 0;
}
+
+ /* Workaround for defect atof(), see java defect list for epoc */
+ double epoc_atof( const char* str) {
+ TReal64 aRes;
+
+ TLex lex( _L( str));
+ TInt err = lex.Val( aRes, TChar( '.'));
+ return aRes;
+ }
+
+ void epoc_gcvt( double x, int digits, unsigned char *buf) {
+ TRealFormat trel;
+
+ trel.iPlaces = digits;
+ trel.iPoint = TChar( '.');
+
+ TPtr result( buf, 80);
+
+ result.Num( x, trel);
+ result.Append( TChar( 0));
+ }
}
/* getsockname returns the size of struct sockaddr_in *without* padding */
#define BOGUS_GETNAME_RETURN 8
-/* Yes, size_t is size_t */
-#define Sock_size_t size_t
-
/*
read() on a socket blocks until buf is filled completly,
recv() returns each massage
/* No /dev/random available*/
#define PERL_NO_DEV_RANDOM
+
+/*
+ work around for buggy atof():
+ atof() in ER5 stdlib depends on locale.
+*/
+
+double epoc_atof( const char *ptr);
+#define atof(a) epoc_atof(a)
+
+
difftime mktime strftime tzset tzname)],
unistd_h => [qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET
- STRERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK
+ STDERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK
_PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON
_PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX
_PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED
=item Constants
-R_OK SEEK_CUR SEEK_END SEEK_SET STDIN_FILENO STDOUT_FILENO STRERR_FILENO W_OK X_OK
+R_OK SEEK_CUR SEEK_END SEEK_SET STDIN_FILENO STDOUT_FILENO STDERR_FILENO W_OK X_OK
=back
#else
goto not_there;
#endif
- if (strEQ(name, "STRERR_FILENO"))
-#ifdef STRERR_FILENO
- return STRERR_FILENO;
+ if (strEQ(name, "STDERR_FILENO"))
+#ifdef STDERR_FILENO
+ return STDERR_FILENO;
#else
goto not_there;
#endif
case "$cc" in
'') cc='cc' # cc is gcc2 in 4.0
cccdlflags="-fPIC"
- ccdlflags=" " ;;
+ ccdlflags="-rdynamic -Wl,-rpath,$privlib/$archname/CORE"
+ ;;
esac
case "$ld" in
of Perl executables, some of which may support fork, some not. Try
changing the name you call Perl by to C<perl_>, C<perl__>, and so on.
+=item Unsupported script encoding
+
+(F) Your program file begins with a Unicode Byte Order Mark (BOM) which
+declares it to be in a Unicode encoding that Perl cannot yet read.
+
=item Unsupported socket function "%s" called
(F) Your machine doesn't support the Berkeley socket mechanism, or at
# don't make this lexical
$i = 1;
-print "1..20\n";
+print "1..23\n";
sub do_require {
%INC = ();
print $x;
$i++;
+# UTF-encoded things
+my $utf8 = chr(0xFEFF);
+my $utf16 = chr(255).chr(254);
+do_require("${utf8}print \"ok $i\n\"; 1;\n");
+$i++;
+do_require("$utf8\nprint \"ok $i\n\"; 1;\n");
+$i++;
+do_require("$utf16\n1;");
+print "ok $i\n" if $@ =~ /Unsupported script encoding/;
+
END { 1 while unlink 'bleah.pm'; 1 while unlink 'bleah.do'; }
# ***interaction with pod (don't put any thing after here)***
}
#endif
-#if 0
+#ifdef PERL_UTF16_FILTER
STATIC I32
S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
goto retry;
}
do {
+ bool bof;
+ bof = PL_rsfp && (PerlIO_tell(PL_rsfp)==0); /* *Before* read! */
if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
fake_eof:
if (PL_rsfp) {
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_doextract = FALSE;
}
- }
+ }
+ if (bof)
+ s = swallow_bom(s);
incline(s);
} while (PL_doextract);
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
PerlIO_close(PL_rsfp);
PL_rsfp = fp;
}
+
+STATIC char*
+S_swallow_bom(pTHX_ char *s) {
+ STRLEN slen;
+ slen = SvCUR(PL_linestr);
+ switch (*s) {
+ case -1:
+ if ((s[1] & 255) == 254) {
+ /* UTF-16 little-endian */
+#ifdef PERL_UTF16_FILTER
+ U8 *news;
+#endif
+ s+=2;
+ if (*s == 0 && s[1] == 0) /* UTF-32 little-endian */
+ Perl_croak(aTHX_ "Unsupported script encoding");
+#ifdef PERL_UTF16_FILTER
+ filter_add(S_utf16rev_textfilter, NULL);
+ New(898, news, (PL_bufend - s) * 3 / 2 + 1, U8);
+ PL_bufend = utf16_to_utf8((U16*)s, news, PL_bufend - s);
+ s = news;
+#else
+ Perl_croak(aTHX_ "Unsupported script encoding");
+#endif
+ }
+ break;
+
+ case -2:
+ if ((s[1] & 255) == 255) { /* UTF-16 big-endian */
+#ifdef PERL_UTF16_FILTER
+ U8 *news;
+ filter_add(S_utf16_textfilter, NULL);
+ New(898, news, (PL_bufend - s) * 3 / 2 + 1, U8);
+ PL_bufend = utf16_to_utf8((U16*)s, news, PL_bufend - s);
+ s = news;
+#else
+ Perl_croak(aTHX_ "Unsupported script encoding");
+#endif
+ }
+ break;
+
+ case -17:
+ if ( slen>2 && (s[1] & 255) == 187 && (s[2] & 255) == 191) {
+ s+=3; /* UTF-8 */
+ }
+ break;
+ case 0:
+ if (slen > 3 && s[1] == 0 && /* UTF-32 big-endian */
+ s[2] & 255 == 254 && s[3] & 255 == 255)
+ Perl_croak(aTHX_ "Unsupported script encoding");
+}
+return s;
+}
projects / p5sagit/p5-mst-13.2.git / commitdiff