diff options
-rw-r--r-- | MANIFEST | 3 | ||||
-rwxr-xr-x | configpm | 58 | ||||
-rw-r--r-- | makedef.pl | 92 | ||||
-rw-r--r-- | wince/Makefile.ce | 151 | ||||
-rw-r--r-- | wince/cecopy-lib.pl | 6 | ||||
-rw-r--r-- | wince/comp.pl | 41 | ||||
-rw-r--r-- | wince/compile.bat | 25 | ||||
-rw-r--r-- | wince/config.ce | 19 | ||||
-rw-r--r-- | wince/config_h.PL | 16 | ||||
-rw-r--r-- | wince/perldll.def | 1040 | ||||
-rw-r--r-- | wince/win32io.c | 370 | ||||
-rw-r--r-- | wince/wince.c | 110 |
12 files changed, 759 insertions, 1172 deletions
@@ -2742,6 +2742,7 @@ wince/bin/pl2bat.pl WinCE port wince/bin/runperl.pl WinCE port wince/bin/search.pl WinCE port wince/cecopy-lib.pl WinCE port +wince/compile.bat WinCE port wince/comp.pl WinCE port wince/config.ce WinCE port wince/config.h WinCE port @@ -2762,7 +2763,6 @@ wince/include/time.h WinCE port wince/Makefile.ce WinCE port wince/makeico.pl WinCE port wince/perl.rc WinCE port -wince/perldll.def WinCE port wince/perllib.c WinCE port wince/perlmain.c WinCE port wince/README.compile WinCE port @@ -2774,6 +2774,7 @@ wince/win32.h WinCE port wince/win32iop.h WinCE port wince/win32thread.c WinCE port wince/win32thread.h WinCE port +wince/win32io.c WinCE port wince/wince.c WinCE port wince/wince.h WinCE port wince/wincesck.c WinCE port @@ -1,7 +1,36 @@ #!./miniperl -w -my $config_pm = $ARGV[0] || 'lib/Config.pm'; +# following options are recognized: +# --no-glossary - no glossary file inclusion, for compactness +# --cross=PALTFORM - crosscompiling for PLATFORM +my %opts = ( + # %known_opts enumerates allowed opts as well as specifies default and initial values + my %known_opts = ( + 'cross' => '', + 'glossary' => 1, + ), + # options itself + my %specified_opts = ( + (map {/^--([\-_\w]+)=(.*)$/} @ARGV), # --opt=smth + (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV), # --opt --no-opt --noopt + ), +); +die "option '$_' is not recognized" for grep {!exists $known_opts{$_}} keys %specified_opts; +@ARGV = grep {!/^--/} @ARGV; + +my $config_pm; my $glossary = $ARGV[1] || 'Porting/Glossary'; + +if ($opts{cross}) { + # creating cross-platform config file + mkdir "xlib"; + mkdir "xlib/$opts{cross}"; + $config_pm = $ARGV[0] || "xlib/$opts{cross}/Config.pm"; +} +else { + $config_pm = $ARGV[0] || 'lib/Config.pm'; +} + @ARGV = "./config.sh"; # list names to put first (and hence lookup fastest) @@ -414,7 +443,9 @@ in such cases. ENDOFTAIL -open(GLOS, "<$glossary") or die "Can't open $glossary: $!"; +if ($opts{glossary}) { + open(GLOS, "<$glossary") or die "Can't open $glossary: $!"; +} %seen = (); $text = 0; $/ = ''; @@ -468,10 +499,12 @@ EOF s/n[\0]t/n't/g; # undo can't, won't damage } -<GLOS>; # Skip the preamble -while (<GLOS>) { - process; - print CONFIG; +if ($opts{glossary}) { + <GLOS>; # Skip the preamble + while (<GLOS>) { + process; + print CONFIG; + } } print CONFIG <<'ENDOFTAIL'; @@ -491,6 +524,19 @@ ENDOFTAIL close(CONFIG); close(GLOS); +# Now create Cross.pm if needed +if ($opts{cross}) { + open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!"; + print CROSS <<"EOS"; +sub BEGIN { + \@INC = map {/\\blib\\b/?(do{local \$_=\$_;s/\\blib\\b/xlib\\/$opts{cross}/;\$_},\$_):(\$_)} \@INC; +} +1; +EOS + close CROSS; +} + + # Now do some simple tests on the Config.pm file we have created unshift(@INC,'lib'); require $config_pm; diff --git a/makedef.pl b/makedef.pl index 2ed95d1e72..ffe69b3028 100644 --- a/makedef.pl +++ b/makedef.pl @@ -17,12 +17,12 @@ while (@ARGV) { $define{$1} = $2 if ($flag =~ /^-D(\w+)=(.+)$/); $CCTYPE = $1 if ($flag =~ /^CCTYPE=(\w+)$/); $PLATFORM = $1 if ($flag =~ /^PLATFORM=(\w+)$/); - if ($PLATFORM eq 'netware') { - $FILETYPE = $1 if ($flag =~ /^FILETYPE=(\w+)$/); - } + if ($PLATFORM eq 'netware') { + $FILETYPE = $1 if ($flag =~ /^FILETYPE=(\w+)$/); + } } -my @PLATFORM = qw(aix win32 os2 MacOS netware); +my @PLATFORM = qw(aix win32 wince os2 MacOS netware); my %PLATFORM; @PLATFORM{@PLATFORM} = (); @@ -42,7 +42,7 @@ my $perlio_sym = "perlio.sym"; if ($PLATFORM eq 'aix') { # Nothing for now. } -elsif ($PLATFORM eq 'win32' || $PLATFORM eq 'netware') { +elsif ($PLATFORM =~ /^win(?:32|ce)$/ || $PLATFORM eq 'netware') { $CCTYPE = "MSVC" unless defined $CCTYPE; foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym, $pp_sym, $globvar_sym, $perlio_sym) { @@ -56,7 +56,7 @@ elsif ($PLATFORM eq 'MacOS') { } } -unless ($PLATFORM eq 'win32' || $PLATFORM eq 'MacOS' || $PLATFORM eq 'netware') { +unless ($PLATFORM eq 'win32' || $PLATFORM eq 'wince' || $PLATFORM eq 'MacOS' || $PLATFORM eq 'netware') { open(CFG,$config_sh) || die "Cannot open $config_sh: $!\n"; while (<CFG>) { if (/^(?:ccflags|optimize)='(.+)'$/) { @@ -106,9 +106,10 @@ if ($define{USE_ITHREADS} && $PLATFORM ne 'win32' && $^O ne 'darwin') { my $sym_ord = 0; -if ($PLATFORM eq 'win32') { +if ($PLATFORM =~ /^win(?:32|ce)$/) { warn join(' ',keys %define)."\n"; - print "LIBRARY perl58\n"; + ($dll = ($define{PERL_DLL} || "perl58")) =~ s/\.dll$//i; + print "LIBRARY $dll\n"; print "DESCRIPTION 'Perl interpreter'\n"; print "EXPORTS\n"; if ($define{PERL_IMPLICIT_SYS}) { @@ -243,6 +244,77 @@ if ($PLATFORM eq 'win32') { Perl_my_popen )]; } +elsif ($PLATFORM eq 'wince') { + skip_symbols [qw( + PL_statusvalue_vms + PL_archpat_auto + PL_cryptseen + PL_DBcv + PL_generation + PL_lastgotoprobe + PL_linestart + PL_modcount + PL_pending_ident + PL_sortcxix + PL_sublex_info + PL_timesbuf + PL_collation_ix + PL_collation_name + PL_collation_standard + PL_collxfrm_base + PL_collxfrm_mult + PL_numeric_compat1 + PL_numeric_local + PL_numeric_name + PL_numeric_radix_sv + PL_numeric_standard + PL_vtbl_collxfrm + Perl_sv_collxfrm + setgid + setuid + win32_async_check + win32_free_childdir + win32_free_childenv + win32_get_childdir + win32_get_childenv + win32_spawnvp + main + Perl_ErrorNo + Perl_GetVars + Perl_do_exec3 + Perl_do_ipcctl + Perl_do_ipcget + Perl_do_msgrcv + Perl_do_msgsnd + Perl_do_semop + Perl_do_shmio + Perl_dump_fds + Perl_init_thread_intern + Perl_my_bzero + Perl_my_bcopy + Perl_my_htonl + Perl_my_ntohl + Perl_my_swap + Perl_my_chsize + Perl_same_dirent + Perl_setenv_getix + Perl_unlnk + Perl_watch + Perl_safexcalloc + Perl_safexmalloc + Perl_safexfree + Perl_safexrealloc + Perl_my_memcmp + Perl_my_memset + PL_cshlen + PL_cshname + PL_opsave + Perl_do_exec + Perl_getenv_len + Perl_my_pclose + Perl_my_popen + )]; +} elsif ($PLATFORM eq 'aix') { skip_symbols([qw( Perl_dump_fds @@ -880,7 +952,7 @@ while (<DATA>) { try_symbol($_); } -if ($PLATFORM eq 'win32') { +if ($PLATFORM =~ /^win(?:32|ce)$/) { foreach my $symbol (qw( setuid setgid @@ -1221,7 +1293,7 @@ sub emit_symbol { sub output_symbol { my $symbol = shift; - if ($PLATFORM eq 'win32') { + if ($PLATFORM =~ /^win(?:32|ce)$/) { $symbol = "_$symbol" if $CCTYPE eq 'BORLAND'; print "\t$symbol\n"; # XXX: binary compatibility between compilers is an exercise diff --git a/wince/Makefile.ce b/wince/Makefile.ce index a4b4bf4b66..a57fcfa5fe 100644 --- a/wince/Makefile.ce +++ b/wince/Makefile.ce @@ -6,19 +6,32 @@ SRCDIR = .. PV = 57 INST_VER = 5.7.3 +# INSTALL_ROOT specifies a path where this perl will be installed on CE device INSTALL_ROOT=/netzwerk/sprache/perl +INST_TOP=$(INSTALL_ROOT) +INST_VER= # PERLCEDIR shoud be set to current directory PERLCEDIR = H:\src\wince\perl\wince -WCEROOT = N:\Windows CE Tools +# WCEROOT is a directory where Windows CE Tools was installed WCEROOT = D:\Windows CE Tools -NTPERL = N:\Programme\perl\bin\perl.exe -NTPERL = D:\Programme\ActiveState\perl-5.6\bin\Perl.exe -CEPATH = N:\Programme\Microsoft eMbedded Tools\EVC\WCE211\BIN + +# HPERL stands for host perl, which is perl on local desktop machine +# which is usually ..\miniperl.exe +#HPERL = N:\Programme\perl\bin\perl.exe +HPERL = $(MAKEDIR)\..\miniperl.exe + CEPATH = D:\Programme\Microsoft eMbedded Tools\EVC\WCE211\BIN CELIBDLLDIR = h:\src\wince\celib-palm-3.0 CECONSOLEDIR = h:\src\wince\w32console + +# specify following options to build perl on local machine, by MSVC +MSVCDIR = D:\MSVStudio\VC98 +CCHOME = $(MSVCDIR) +CCINCDIR = $(CCHOME)\include +CCLIBDIR = $(CCHOME)\lib + # Only for WIN2000 #YES = /y COPY = copy $(YES) @@ -28,6 +41,15 @@ RCOPY = xcopy $(YES) /f /r /i /e /d # cecopy program. Make shure it is in your path, as well as cemkdir, cedel CECOPY = cecopy +# +# Comment out next assign to disable perl's I/O subsystem and use compiler's +# stdio for IO - depending on your compiler vendor and run time library you may +# then get a number of fails from make test i.e. bugs - complain to them not us ;-). +# You will also be unable to take full advantage of perl5.8's support for multiple +# encodings and may see lower IO performance. You have been warned. +USE_PERLIO = define + + NOOP = @echo # keep this untouched! NULL = @@ -377,6 +399,10 @@ USE_ITHREADS = undef USE_IMP_SYS = undef !ENDIF +!IF "$(USE_PERLIO)" == "" +USE_PERLIO = undef +!ENDIF + !IF "$(USE_PERLCRT)" == "" USE_PERLCRT = undef !ENDIF @@ -398,6 +424,10 @@ BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_CONTEXT BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_SYS !ENDIF +!IF "$(USE_PERLIO)" == "define" +BUILDOPT = $(BUILDOPT) -DUSE_PERLIO +!ENDIF + # new option - automatically defined in perl.h... #BUILDOPT = $(BUILDOPT) -DUSE_ENVIRON_ARRAY @@ -500,7 +530,7 @@ CFGH_TMPL = config_H.ce # # filenames given to xsubpp must have forward slashes (since it puts # full pathnames in #line strings) -XSUBPP = $(NTPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp \ +XSUBPP = $(HPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp \ -C++ -prototypes MICROCORE_SRC = \ @@ -713,6 +743,7 @@ CFG_VARS = \ "useithreads=$(USE_ITHREADS)" \ "usethreads=$(USE_5005THREADS)" \ "usemultiplicity=$(USE_MULTI)" \ + "useperlio=$(USE_PERLIO)" \ "LINK_FLAGS=$(LDLIBPATH) $(LINK_FLAGS) $(SUBSYS)" \ "optimize=$(OPTIMIZE)" @@ -720,24 +751,25 @@ CFG_VARS = \ # Top targets # -all: $(MINIMOD) $(CONFIGPM) $(PERLEXE) +all: hostminiperl $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c $(CONFIGPM): config.h ..\config.sh ..\minimod.pl - cd .. && $(NTPERL) configpm + cd .. && $(HPERL) configpm + cd .. && $(HPERL) configpm --cross=wince --no-glossary -mkdir $(COREDIR) $(XCOPY) ..\*.h $(COREDIR)\*.* $(XCOPY) *.h $(COREDIR)\*.* $(XCOPY) ..\ext\re\re.pm $(LIBDIR)\*.* $(RCOPY) include $(COREDIR)\*.* - $(NTPERL) -I..\lib config_h.PL "INST_VER=$(INST_VER)" + $(HPERL) -I..\lib config_h.PL "INST_VER=$(INST_VER)" ..\config.sh config.h: config.ce config_sh.PL - $(NTPERL) -I..\lib config_sh.PL $(CFG_VARS) config.ce > ..\config.sh + $(HPERL) -I..\lib config_sh.PL $(CFG_VARS) config.ce > ..\config.sh $(MINIMOD) : ..\minimod.pl - cd .. && $(NTPERL) minimod.pl > lib\ExtUtils\Miniperl.pm + cd .. && $(HPERL) minimod.pl > lib\ExtUtils\Miniperl.pm perlmain.c : runperl.c $(COPY) runperl.c perlmain.c @@ -745,8 +777,8 @@ perlmain.c : runperl.c $(DYNALOADER).c: $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) if not exist $(AUTODIR) mkdir $(AUTODIR) cd $(EXTDIR)\$(*B) - $(NTPERL) -I..\..\lib $(*B)_pm.PL - $(NTPERL) -I..\..\lib XSLoader_pm.PL + $(HPERL) -I..\..\lib $(*B)_pm.PL + $(HPERL) -I..\..\lib XSLoader_pm.PL cd ..\..\wince $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) $(XCOPY) $(EXTDIR)\$(*B)\XSLoader.pm $(LIBDIR)\$(NULL) @@ -759,103 +791,103 @@ $(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs $(DUMPER_DLL): $(PERLEXE) $(DUMPER).xs cd $(EXTDIR)\Data\$(*B) - $(NTPERL) -I..\..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\..\wince $(DPROF_DLL): $(PERLEXE) $(DPROF).xs cd $(EXTDIR)\Devel\$(*B) - $(NTPERL) -I..\..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\..\wince $(GLOB_DLL): $(PERLEXE) $(GLOB).xs cd $(EXTDIR)\File\$(*B) - $(NTPERL) -I..\..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\..\wince $(PEEK_DLL): $(PERLEXE) $(PEEK).xs cd $(EXTDIR)\Devel\$(*B) - $(NTPERL) -I..\..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\..\wince $(RE_DLL): $(PERLEXE) $(RE).xs cd $(EXTDIR)\$(*B) - $(NTPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\wince $(B_DLL): $(PERLEXE) $(B).xs cd $(EXTDIR)\$(*B) - $(NTPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\wince $(THREAD_DLL): $(PERLEXE) $(THREAD).xs cd $(EXTDIR)\$(*B) - $(NTPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\wince $(ATTRS_DLL): $(PERLEXE) $(ATTRS).xs cd $(EXTDIR)\$(*B) - $(NTPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\wince $(POSIX_DLL): $(PERLEXE) $(POSIX).xs cd $(EXTDIR)\$(*B) - $(NTPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\wince $(IO_DLL): $(PERLEXE) $(IO).xs cd $(EXTDIR)\$(*B) - $(NTPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\wince $(SDBM_FILE_DLL) : $(PERLEXE) $(SDBM_FILE).xs cd $(EXTDIR)\$(*B) - $(NTPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\wince $(FCNTL_DLL): $(PERLEXE) $(FCNTL).xs cd $(EXTDIR)\$(*B) - $(NTPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\wince $(OPCODE_DLL): $(PERLEXE) $(OPCODE).xs cd $(EXTDIR)\$(*B) - $(NTPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\wince $(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs cd $(EXTDIR)\$(*B) - $(NTPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\wince $(HOSTNAME_DLL): $(PERLEXE) $(HOSTNAME).xs cd $(EXTDIR)\Sys\$(*B) - $(NTPERL) -I..\..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\..\wince $(BYTELOADER_DLL): $(PERLEXE) $(BYTELOADER).xs cd $(EXTDIR)\$(*B) - $(NTPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\wince $(ERRNO_PM): $(PERLEXE) $(ERRNO)_pm.PL cd $(EXTDIR)\$(*B) - $(NTPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(HPERL) -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl $(MAKE) cd ..\..\wince @@ -875,7 +907,7 @@ clean: install_perlexe: $(PERLEXE) cedel /speicherkarte2/bin/perl.exe - $(CECOPY) pc:../perl.exe ce:/speicherkarte2/bin + $(CECOPY) pc:../perl.exe ce:$(INSTALL_ROOT)/bin install_perldll: $(PERLDLL) cedel /speicherkarte2/bin/perl$(PV).dll @@ -888,17 +920,17 @@ test_perl: ceexec /speicherkarte2/bin/perl.exe /speicherkarte2/bin/test.pl install_lib: ../lib/Config.pm - $(CECOPY) pc:../lib/Config.pm ce:/speicherkarte2/usr/lib/perl5 + $(CECOPY) pc:../lib/Config.pm ce:$(INSTALL_ROOT)/lib !ELSEIF "$(MACHINE)" == "wince-arm-hpc" install_perlexe: $(PERLEXE) -cedel /speicherkarte/bin/perl.exe - $(CECOPY) pc:$(MACHINE)/perl.exe ce:/speicherkarte/bin + $(CECOPY) pc:$(MACHINE)/perl.exe ce:$(INSTALL_ROOT)/bin install_perldll: $(PERLDLL) -cedel /speicherkarte/bin/perl$(PV).dll - $(CECOPY) pc:$(MACHINE)/perl$(PV).dll ce:/speicherkarte/bin + $(CECOPY) pc:$(MACHINE)/perl$(PV).dll ce:$(INSTALL_ROOT)/bin install_perl: install_perlexe install_perldll @@ -907,7 +939,7 @@ test_perl: ceexec /speicherkarte/bin/perl.exe /speicherkarte/bin/test.pl install_lib: ../lib/Config.pm - $(CECOPY) pc:../lib/Config.pm ce:/speicherkarte/usr/lib/perl5 + $(CECOPY) pc:../lib/Config.pm ce:$(INSTALL_ROOT)/lib !ELSEIF "$(MACHINE)" == "wince-mips-hpc" @@ -924,7 +956,7 @@ test_perl: ceexec /netzwerk/compaq/bin/perl.exe $(INSTALL_ROOT)/test.pl install_lib: ../lib/Config.pm - $(CECOPY) pc:../lib/Config.pm ce:/netzwerk/compaq/usr/lib/perl5 + $(CECOPY) pc:../lib/Config.pm ce:$(INSTALL_ROOT)/lib !ELSEIF "$(MACHINE)" == "wince-x86em-pocket" @@ -934,10 +966,10 @@ install_lib: ftpcopy ../lib/Exporter/Heavy.pm ftp!ftp@localhost:/perl/lib/Exporter install_perlexe: $(PERLEXE) - $(CECOPY) pc:../perl.exe ce:/netzwerk/compaq/bin + $(CECOPY) pc:../perl.exe ce:$(INSTALL_ROOT)/bin install_perldll: $(PERLDLL) - $(CECOPY) pc:../perl$(PV).dll ce:/netzwerk/compaq/bin + $(CECOPY) pc:../perl$(PV).dll ce:$(INSTALL_ROOT)/bin install_perl: install_perlexe install_perldll @@ -994,6 +1026,10 @@ $(DLLDIR)\DynaLoader.obj {$(SRCDIR)/wince}.c{$(DLLDIR)}.obj: $(CC) -c $(CFLAGS) -DPERL_EXTERNAL_GLOB -Fo$(DLLDIR)\ $< +perldll.def : $(HPERL) $(CONFIGPM) ..\global.sym ..\pp.sym ...\makedef.pl + $(HPERL) -w ..\makedef.pl PLATFORM=wince $(OPTIMIZE) $(DEFINES) $(BUILDOPT) \ + CCTYPE=$(CCTYPE) -DPERL_DLL=$(PERLDLL) > perldll.def + $(PERLDLL) : $(DLLDIR) perldll.def $(XDLLOBJS) $(PERLDLL_RES) $(LINK32) -dll -def:perldll.def -out:$@ \ $(SUBSYS) $(LDLIBPATH) \ @@ -1049,43 +1085,28 @@ makedist: all dlls !if "$(MACHINE)" == "wince-arm-hpc-wce300" install: all - $(CECOPY) pc:$(MACHINE)/perl.exe ce:/speicherkarte/bin - $(CECOPY) pc:$(MACHINE)/perl$(PV).dll ce:/speicherkarte/bin + $(CECOPY) pc:$(MACHINE)/perl.exe ce:$(INSTALL_ROOT)/bin + $(CECOPY) pc:$(MACHINE)/perl$(PV).dll ce:$(INSTALL_ROOT)/bin install_dlls: dlls - $(CECOPY) pc:../lib/auto/IO/io.dll ce:/speicherkarte/usr/lib/perl5/auto/IO/io.dll + $(CECOPY) pc:../lib/auto/IO/io.dll ce:$(INSTALL_ROOT)/lib/auto/IO/io.dll !else install: all -cemkdir "$(INSTALL_ROOT)" -cemkdir "$(INSTALL_ROOT)\bin" -cemkdir "$(INSTALL_ROOT)\lib" $(CECOPY) "pc:$(MACHINE)/perl.exe" "ce:$(INSTALL_ROOT)/bin" - $(CECOPY) "pc:$(MACHINE)/perl.dll" "ce:$(INSTALL_ROOT)/bin" - $(CECOPY) "pc:../lib/Config.pm" "ce:$(INSTALL_ROOT)/lib" -!endif - -!if "$(MACHINE)" == "wince-arm-hpc-wce211" -install: all - $(CECOPY) pc:$(MACHINE)/perl.exe ce:/speicherkarte/bin - $(CECOPY) pc:$(MACHINE)/perl$(PV).dll ce:/speicherkarte/bin + $(CECOPY) "pc:$(MACHINE)/perl$(PV).dll" "ce:$(INSTALL_ROOT)/bin" + $(CECOPY) "pc:../xlib/wince/Config.pm" "ce:$(INSTALL_ROOT)/lib" !endif -!if "$(MACHINE)" == "wince-mips-hpc-wce211" -install: - $(CECOPY) pc:$(MACHINE)/perl.exe ce:/bin - $(CECOPY) pc:$(MACHINE)/perl$(PV).dll ce:/bin -!endif +perl.ico: + $(HPERL) makeico.pl -!if "$(MACHINE)" == "wince-mips-hpc-wce200" -install: - $(CECOPY) pc:$(MACHINE)/perl.exe ce:/bin - $(CECOPY) pc:$(MACHINE)/perl$(PV).dll ce:/bin -!endif +hostminiperl: ..\miniperl.exe -!if "$(MACHINE)" == "wince-sh3-hpc-wce211" -install: - $(CECOPY) pc:$(MACHINE)/perl.exe ce:$(INSTALL_ROOT)/bin - $(CECOPY) pc:$(MACHINE)/perl$(PV).dll ce:$(INSTALL_ROOT)/bin -!endif +..\miniperl.exe: + cd ../win32 + set PATH=$(CCHOME)\bin;$(PATH) + $(MAKE) -f Makefile "CCHOME=$(MSVCDIR)" "CCINCDIR=$(CCHOME)\include" "CCLIBDIR=$(CCHOME)\lib" "INCLUDE=$(CCHOME)\include" "LIB=$(CCHOME)\lib" "LINK_FLAGS=" ..\config.h ..\miniperl.exe + cd ../wince -perl.ico: - perl makeico.pl diff --git a/wince/cecopy-lib.pl b/wince/cecopy-lib.pl index 8281b0c20c..f194ffd55a 100644 --- a/wince/cecopy-lib.pl +++ b/wince/cecopy-lib.pl @@ -12,8 +12,8 @@ sub mk { $r=~/^(.*)\/[^\/]*?$/; mk($1); } - system("$^X comp.pl --do cemkdir [p]\\lib\\$r"); - print STDERR "$^X comp.pl --do cemkpath [p]\\lib\\$r\n"; + print STDERR "..\\miniperl.exe comp.pl --do cemkdir [p]\\lib\\$r\n"; + system("..\\miniperl.exe -I..\\lib comp.pl --do cemkdir [p]\\lib\\$r"); $dirs{$r}++; } for (@files) { @@ -22,7 +22,7 @@ for (@files) { mk($1); } # currently no stripping POD - system("$^X comp.pl --do cecopy pc:..\\lib\\$_ ce:[p]\\lib\\$_"); + system("..\\miniperl.exe -I..\\lib comp.pl --copy pc:..\\lib\\$_ ce:[p]\\lib\\$_"); } sub BEGIN { diff --git a/wince/comp.pl b/wince/comp.pl index 8ecc95855d..ea061ee280 100644 --- a/wince/comp.pl +++ b/wince/comp.pl @@ -2,21 +2,12 @@ helper script to make life for PerlCE easier. -You need edit values for @defs array to reflect your changes and then do - - perl comp.pl [any-additional-options] - -This will call - nmake -f Makefile.ce -with most parameters overrided as you specified and additional options -(such as build target) will also be prepended to command line to execute. - -There are also additional different modes for running this script: +There are different modes for running this script: perl comp.pl --run [any-command-line-arguments] and perl comp.pl --do [any-command-line-arguments] and - perl comp.pl --copy-pm pc:[pc-location] ce:[ce-location] + perl comp.pl --copy pc:[pc-location] ce:[ce-location] --run executes this build of perl on CE device with arguments provided --run=test will display a predefined messagebox that say everything is ok. @@ -37,32 +28,16 @@ and =cut -use Cwd; use strict; +use Cross; +use Config; # edit value of $inst_root variable to reflect your desired location of # built perl -my $inst_root = "\\Storage Card\\perl-tests\\perl\@16225"; -my @defs = ( - "\"PV=\"", - "\"INST_VER=\"", - "\"INSTALL_ROOT=$inst_root\"", - "\"WCEROOT=$ENV{SDKROOT}\"", - "NTPERL=$^X", #todo: check version: this must be (almost?) current version - "\"CEPATH=$ENV{WCEROOT}\"", - "CELIBDLLDIR=d:\\personal\\pocketPC\\celib-palm-3.0", - "CECONSOLEDIR=d:\\personal\\pocketPC\\w32console", - "YES=/y", - "CFG=RELEASE", - "MACHINE=wince-mips-pocket-wce300", - "PERLCEDIR=".cwd, - #NIY "\"CECOPY=\$(NTPERL) \$(PERLCEDIR)\\$0 --copy=compact\"", - "\"CECOPY=\$(NTPERL) \$(PERLCEDIR)\\$0 --copy\"", -); +my $inst_root = $Config{prefix}; my %opts = ( - # %known_opts enumerates allowed opts as well as specifies default - # and initial values + # %known_opts enumerates allowed opts as well as specifies default and initial values my %known_opts = ( 'do' => '', 'run' => '', @@ -98,9 +73,7 @@ elsif ($opts{'copy'}) { system("cecopy",@ARGV); } else { - my $cmd = "nmake -f Makefile.ce @defs @ARGV"; - print $cmd; - system($cmd); + # todo } diff --git a/wince/compile.bat b/wince/compile.bat new file mode 100644 index 0000000000..582d422e81 --- /dev/null +++ b/wince/compile.bat @@ -0,0 +1,25 @@ +@echo off +rem +rem edit ARG-xxx variable to reflect your system and run +rem compile.bat [target] [additional parameters for nmake] +rem + +set ARG-1=PV= +set ARG-2=INST_VER= +set ARG-3=INSTALL_ROOT=\Storage Card\perl-tests\perl@16376 +set ARG-4=WCEROOT=%SDKROOT% +set ARG-5=CEPATH=%WCEROOT% +set ARG-6=CELIBDLLDIR=d:\personal\pocketPC\celib-palm-3.0 +set ARG-7=CECONSOLEDIR=d:\personal\pocketPC\w32console + +rem Only for WIN2000 +set ARG-8=YES=/y + +set ARG-9=CFG=RELEASE +set ARG-10=MACHINE=wince-mips-pocket-wce300 +set ARG-11=PERLCEDIR=$(MAKEDIR) +set ARG-12=MSVCDIR=D:\MSVStudio\VC98 +set ARG-13=CECOPY=$(HPERL) -I$(PERLCEDIR)\lib $(PERLCEDIR)\comp.pl --copy +set ARG-14=USE_PERLIO=undef + +nmake -f Makefile.ce "%ARG-1%" "%ARG-2%" "%ARG-3%" "%ARG-4%" "%ARG-5%" "%ARG-6%" "%ARG-7%" "%ARG-8%" "%ARG-9%" "%ARG-10%" "%ARG-11%" "%ARG-12%" "%ARG-13%" "%ARG-14%" %1 %2 %3 %4 %5 %6 %7 %8 %9 diff --git a/wince/config.ce b/wince/config.ce index 9e42882296..07eed645f3 100644 --- a/wince/config.ce +++ b/wince/config.ce @@ -43,7 +43,7 @@ byteorder='1234' c='' castflags='0' cat='type' -cc='cl' +cc='~CC~' cccdlflags=' ' ccdlflags=' ' ccflags='-DWIN32' @@ -61,14 +61,14 @@ compress='' contains='grep' cp='copy' cpio='' -cpp='cl -nologo -E' +cpp='~CC~ -nologo -E' cpp_stuff='42' cppccsymbols='' cppflags='-DWIN32' cpplast='' cppminus='' -cpprun='cl -nologo -E' -cppstdin='cl -nologo -E' +cpprun='~CC~ -nologo -E' +cppstdin='~CC~ -nologo -E' cppsymbols='' crosscompile='undef' crypt_r_proto='0' @@ -331,7 +331,7 @@ d_setgrps='undef' d_sethent='undef' d_sethostent_r='undef' d_setlinebuf='undef' -d_setlocale='undef' +d_setlocale='define' d_setlocale_r='undef' d_setnent='undef' d_setnetent_r='undef' @@ -379,7 +379,7 @@ d_stdio_stream_array='undef' d_stdiobase='undef' d_stdstdio='undef' d_strchr='define' -d_strcoll='undef' +d_strcoll='define' d_strctcpy='define' d_strerrm='strerror(e)' d_strerror='define' @@ -529,6 +529,7 @@ i_gdbm='undef' i_grp='undef' i_ieeefp='undef' i_inttypes='undef' +i_langinfo='undef' i_limits='define' i_locale='undef' i_machcthr='undef' @@ -542,6 +543,7 @@ i_neterrno='undef' i_netinettcp='undef' i_niin='undef' i_poll='undef' +i_prot='undef' i_pthread='undef' i_pwd='undef' i_rpcsvcdbm='define' @@ -701,6 +703,7 @@ optimize='-O' orderlib='false' osname='MSWin32' osvers='4.0' +otherlibdirs='' package='perl5' pager='more /e' passcat='' @@ -852,7 +855,7 @@ use5005threads='undef' use64bitall='undef' use64bitint='undef' usedl='define' -useithreads='undef' +useithreads='~USE_ITHREADS~' uselargefiles='undef' uselongdouble='undef' usemorebits='undef' @@ -860,7 +863,7 @@ usemultiplicity='undef' usemymalloc='n' usenm='false' useopcode='true' -useperlio='define' +useperlio='~USE_PERLIO~' useposix='true' usesfio='false' useshrplib='yes' diff --git a/wince/config_h.PL b/wince/config_h.PL index d78a62ea59..957966c59f 100644 --- a/wince/config_h.PL +++ b/wince/config_h.PL @@ -1,5 +1,11 @@ # -use Config; +BEGIN { warn "Running ".__FILE__."\n" }; +BEGIN + { + require "../lib/Config.pm"; + die "../Config.pm:$@" if $@; + Config::->import; + } use File::Compare qw(compare); use File::Copy qw(copy); my $name = $0; @@ -13,6 +19,8 @@ while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/) $opt{CONFIG_H} ||= 'config.h'; +warn "Writing $opt{CONFIG_H}\n"; + my $patchlevel = $opt{INST_VER}; $patchlevel =~ s|^[\\/]||; $patchlevel =~ s|~VERSION~|$Config{version}|g; @@ -68,9 +76,9 @@ close(H); close(SH); -chmod(0666,"config.h"); -copy("$file.new","config.h") || die "Cannot copy:$!"; -chmod(0444,"config.h"); +chmod(0666,"../lib/CORE/config.h"); +copy("$file.new","../lib/CORE/config.h") || die "Cannot copy:$!"; +chmod(0444,"../lib/CORE/config.h"); if (compare("$file.new",$file)) { diff --git a/wince/perldll.def b/wince/perldll.def deleted file mode 100644 index c95e33a2a0..0000000000 --- a/wince/perldll.def +++ /dev/null @@ -1,1040 +0,0 @@ -LIBRARY Perl - -EXPORTS - PL_AMG_names - PL_Argv - PL_Cmd - PL_DBgv - PL_DBline - PL_DBsignal - PL_DBsingle - PL_DBsub - PL_DBtrace - PL_No - PL_Sv - PL_Xpv - PL_Yes - PL_amagic_generation - PL_an - PL_argvgv - PL_argvout_stack - PL_argvoutgv - PL_av_fetch_sv - PL_basetime - PL_beginav - PL_bitcount - PL_bodytarget - PL_bostr - PL_bufend - PL_bufptr - PL_check - PL_checkav - PL_chopset - PL_colors - PL_colorset - PL_compcv - PL_compiling - PL_comppad - PL_comppad_name - PL_comppad_name_fill - PL_comppad_name_floor - PL_cop_seqmax - PL_copline - PL_curcop - PL_curcopdb - PL_curinterp - PL_curpad - PL_curpm - PL_curstack - PL_curstackinfo - PL_curstash - PL_curstname - PL_dbargs - PL_debstash - PL_debug - PL_defgv - PL_defoutgv - PL_defstash - PL_delaymagic - PL_diehook - PL_dirty - PL_do_undump - PL_doextract - PL_doswitches - PL_dowarn - PL_dumpindent - PL_e_script - PL_efloatbuf - PL_efloatsize - PL_egid - PL_endav - PL_envgv - PL_errgv - PL_error_count - PL_errors - PL_euid - PL_eval_root - PL_eval_start - PL_evalseq - PL_exit_flags - PL_exitlist - PL_exitlistlen - PL_expect - PL_extralen - PL_fdpid - PL_filemode - PL_firstgv - PL_fold - PL_fold_locale - PL_forkprocess - PL_formfeed - PL_formtarget - PL_freq - PL_gensym - PL_gid - PL_glob_index - PL_globalstash - PL_he_root - PL_hexdigit - PL_hintgv - PL_hints - PL_hv_fetch_ent_mh - PL_hv_fetch_sv - PL_in_clean_all - PL_in_clean_objs - PL_in_eval - PL_in_my - PL_in_my_stash - PL_incgv - PL_initav - PL_inplace - PL_last_in_gv - PL_last_lop - PL_last_lop_op - PL_last_swash_hv - PL_last_swash_key - PL_last_swash_klen - PL_last_swash_slen - PL_last_swash_tmps - PL_last_uni - PL_lastfd - PL_lastscream - PL_laststatval - PL_laststype - PL_lex_brackets - PL_lex_brackstack - PL_lex_casemods - PL_lex_casestack - PL_lex_defer - PL_lex_dojoin - PL_lex_expect - PL_lex_formbrack - PL_lex_inpat - PL_lex_inwhat - PL_lex_op - PL_lex_repl - PL_lex_starts - PL_lex_state - PL_lex_stuff - PL_lineary - PL_linestr - PL_localizing - PL_localpatches - PL_main_cv - PL_main_root - PL_main_start - PL_mainstack - PL_markstack - PL_markstack_max - PL_markstack_ptr - PL_max_intro_pending - PL_maxo - PL_maxscream - PL_maxsysfd - PL_mess_sv - PL_min_intro_pending - PL_minus_F - PL_minus_a - PL_minus_c - PL_minus_l - PL_minus_n - PL_minus_p - PL_modglobal - PL_multi_close - PL_multi_end - PL_multi_open - PL_multi_start - PL_multiline - PL_na - PL_nexttoke - PL_nexttype - PL_nextval - PL_nice_chunk - PL_nice_chunk_size - PL_no_aelem - PL_no_dir_func - PL_no_func - PL_no_helem - PL_no_mem - PL_no_modify - PL_no_myglob - PL_no_security - PL_no_sock_func - PL_no_symref - PL_no_usym - PL_no_wrongref - PL_nomemok - PL_nrs - PL_ofmt - PL_oldbufptr - PL_oldname - PL_oldoldbufptr - PL_op - PL_op_desc - PL_op_mask - PL_op_name - PL_op_seqmax - PL_opargs - PL_origalen - PL_origargc - PL_origargv - PL_origenviron - PL_origfilename - PL_osname - PL_pad_reset_pending - PL_padix - PL_padix_floor - PL_patchlevel - PL_patleave - PL_perl_destruct_level - PL_perldb - PL_pidstatus - PL_ppaddr - PL_preambleav - PL_preambled - PL_preprocess - PL_profiledata - PL_psig_name - PL_psig_ptr - PL_reg_call_cc - PL_reg_curpm - PL_reg_eval_set - PL_reg_flags - PL_reg_ganch - PL_reg_leftiter - PL_reg_magic - PL_reg_maxiter - PL_reg_oldcurpm - PL_reg_oldpos - PL_reg_oldsaved - PL_reg_oldsavedlen - PL_reg_poscache - PL_reg_poscache_size - PL_reg_re - PL_reg_start_tmp - PL_reg_start_tmpl - PL_reg_starttry - PL_reg_sv - PL_reg_whilem_seen - PL_regbol - PL_regcc - PL_regcode - PL_regcomp_parse - PL_regcomp_rx - PL_regcompp - PL_regdata - PL_regdummy - PL_regendp - PL_regeol - PL_regexecp - PL_regflags - PL_regfree - PL_regindent - PL_reginput - PL_regint_start - PL_regint_string - PL_reginterp_cnt - PL_regkind - PL_reglastparen - PL_regnarrate - PL_regnaughty - PL_regnpar - PL_regprecomp - PL_regprogram - PL_regsawback - PL_regseen - PL_regsize - PL_regstartp - PL_regtill - PL_regxend - PL_replgv - PL_restartop - PL_retstack - PL_retstack_ix - PL_retstack_max - PL_rs - PL_rsfp - PL_rsfp_filters - PL_runops - PL_savestack - PL_savestack_ix - PL_savestack_max - PL_sawampersand - PL_scopestack - PL_scopestack_ix - PL_scopestack_max - PL_screamfirst - PL_screamnext - PL_secondgv - PL_seen_evals - PL_seen_zerolen - PL_sh_path - PL_sig_name - PL_sig_num - PL_sighandlerp - PL_simple - PL_sortcop - PL_sortstash - PL_splitstr - PL_srand_called - PL_stack_base - PL_stack_max - PL_stack_sp - PL_start_env - PL_statbuf - PL_statcache - PL_statgv - PL_statname - PL_statusvalue - PL_stderrgv - PL_stdingv - PL_strtab - PL_sub_generation - PL_subline - PL_subname - PL_sv_arenaroot - PL_sv_count - PL_sv_no - PL_sv_objcount - PL_sv_root - PL_sv_undef - PL_sv_yes - PL_sys_intern - PL_tainted - PL_tainting - PL_tmps_floor - PL_tmps_ix - PL_tmps_max - PL_tmps_stack - PL_tokenbuf - PL_top_env - PL_toptarget - PL_uid - PL_unsafe - PL_utf8_alnum - PL_utf8_alnumc - PL_utf8_alpha - PL_utf8_ascii - PL_utf8_cntrl - PL_utf8_digit - PL_utf8_graph - PL_utf8_lower - PL_utf8_mark - PL_utf8_print - PL_utf8_punct - PL_utf8_space - PL_utf8_tolower - PL_utf8_totitle - PL_utf8_toupper - PL_utf8_upper - PL_utf8_xdigit - PL_utf8skip - PL_uudmap - PL_uuemap - PL_varies - PL_vtbl_amagic - PL_vtbl_amagicelem - PL_vtbl_arylen - PL_vtbl_bm - PL_vtbl_dbline - PL_vtbl_defelem - PL_vtbl_env - PL_vtbl_envelem - PL_vtbl_fm - PL_vtbl_glob - PL_vtbl_isa - PL_vtbl_isaelem - PL_vtbl_mglob - PL_vtbl_nkeys - PL_vtbl_pack - PL_vtbl_packelem - PL_vtbl_pos - PL_vtbl_regdata - PL_vtbl_regdatum - PL_vtbl_regexp - PL_vtbl_sig - PL_vtbl_sigelem - PL_vtbl_substr - PL_vtbl_sv - PL_vtbl_taint - PL_vtbl_uvar - PL_vtbl_vec - PL_warn_nl - PL_warn_nosemi - PL_warn_reserved - PL_warn_uninit - PL_warnhook - PL_widesyscalls - PL_xiv_arenaroot - PL_xiv_root - PL_xnv_root - PL_xpv_root - PL_xpvav_root - PL_xpvbm_root - PL_xpvcv_root - PL_xpvhv_root - PL_xpviv_root - PL_xpvlv_root - PL_xpvmg_root - PL_xpvnv_root - PL_xrv_root - PL_yychar - PL_yydebug - PL_yyerrflag - PL_yylval - PL_yynerrs - PL_yyval - PerlIO_canset_cnt - PerlIO_exportFILE - PerlIO_fast_gets - PerlIO_fdopen - PerlIO_findFILE - PerlIO_getc - PerlIO_getname - PerlIO_getpos - PerlIO_has_base - PerlIO_has_cntptr - PerlIO_importFILE - PerlIO_init - PerlIO_open - PerlIO_printf - PerlIO_putc - PerlIO_puts - PerlIO_releaseFILE - PerlIO_reopen - PerlIO_rewind - PerlIO_setpos - PerlIO_sprintf - PerlIO_stdoutf - PerlIO_tmpfile - PerlIO_ungetc - PerlIO_vprintf - PerlIO_vsprintf - Perl_Gv_AMupdate - Perl_amagic_call - Perl_av_clear - Perl_av_delete - Perl_av_exists - Perl_av_extend - Perl_av_fake - Perl_av_fetch - Perl_av_fill - Perl_av_len - Perl_av_make - Perl_av_pop - Perl_av_push - Perl_av_reify - Perl_av_shift - Perl_av_store - Perl_av_undef - Perl_av_unshift - Perl_avhv_delete_ent - Perl_avhv_exists_ent - Perl_avhv_fetch_ent - Perl_avhv_iternext - Perl_avhv_iterval - Perl_avhv_keys - Perl_avhv_store_ent - Perl_block_gimme - Perl_call_argv - Perl_call_atexit - Perl_call_list - Perl_call_method - Perl_call_pv - Perl_call_sv - Perl_cast_i32 - Perl_cast_iv - Perl_cast_ulong - Perl_cast_uv - Perl_croak - Perl_cv_const_sv - Perl_cv_undef - Perl_cx_dump - Perl_delimcpy - Perl_die - Perl_do_binmode - Perl_do_close - Perl_do_gv_dump - Perl_do_gvgv_dump - Perl_do_hv_dump - Perl_do_magic_dump - Perl_do_op_dump - Perl_do_open - Perl_do_open9 - Perl_do_pmop_dump - Perl_do_sv_dump - Perl_dounwind - Perl_dowantarray - Perl_dump_all - Perl_dump_eval - Perl_dump_form - Perl_dump_indent - Perl_dump_packsubs - Perl_dump_sub - Perl_dump_vindent - Perl_eval_pv - Perl_eval_sv - Perl_fbm_compile - Perl_fbm_instr - Perl_filter_add - Perl_filter_del - Perl_filter_read - Perl_form - Perl_fprintf_nocontext - Perl_free_tmps - Perl_get_av - Perl_get_context - Perl_get_cv - Perl_get_hv - Perl_get_op_descs - Perl_get_op_names - Perl_get_ppaddr - Perl_get_sv - Perl_get_vtbl - Perl_gp_free - Perl_gp_ref - Perl_gv_AVadd - Perl_gv_HVadd - Perl_gv_IOadd - Perl_gv_autoload4 - Perl_gv_check - Perl_gv_dump - Perl_gv_efullname - Perl_gv_efullname3 - Perl_gv_fetchfile - Perl_gv_fetchmeth - Perl_gv_fetchmethod - Perl_gv_fetchmethod_autoload - Perl_gv_fetchpv - Perl_gv_fullname - Perl_gv_fullname3 - Perl_gv_init - Perl_gv_stashpv - Perl_gv_stashpvn - Perl_gv_stashsv - Perl_hv_clear - Perl_hv_delayfree_ent - Perl_hv_delete - Perl_hv_delete_ent - Perl_hv_exists - Perl_hv_exists_ent - Perl_hv_fetch - Perl_hv_fetch_ent - Perl_hv_free_ent - Perl_hv_iterinit - Perl_hv_iterkey - Perl_hv_iterkeysv - Perl_hv_iternext - Perl_hv_iternextsv - Perl_hv_iterval - Perl_hv_ksplit - Perl_hv_magic - Perl_hv_store - Perl_hv_store_ent - Perl_hv_undef - Perl_ibcmp - Perl_ibcmp_locale - Perl_init_i18nl10n - Perl_init_i18nl14n - Perl_init_os_extras - Perl_init_stacks - Perl_instr - Perl_is_uni_alnum - Perl_is_uni_alnum_lc - Perl_is_uni_alnumc - Perl_is_uni_alnumc_lc - Perl_is_uni_alpha - Perl_is_uni_alpha_lc - Perl_is_uni_ascii - Perl_is_uni_ascii_lc - Perl_is_uni_cntrl - Perl_is_uni_cntrl_lc - Perl_is_uni_digit - Perl_is_uni_digit_lc - Perl_is_uni_graph - Perl_is_uni_graph_lc - Perl_is_uni_idfirst - Perl_is_uni_idfirst_lc - Perl_is_uni_lower - Perl_is_uni_lower_lc - Perl_is_uni_print - Perl_is_uni_print_lc - Perl_is_uni_punct - Perl_is_uni_punct_lc - Perl_is_uni_space - Perl_is_uni_space_lc - Perl_is_uni_upper - Perl_is_uni_upper_lc - Perl_is_uni_xdigit - Perl_is_uni_xdigit_lc - Perl_is_utf8_alnum - Perl_is_utf8_alnumc - Perl_is_utf8_alpha - Perl_is_utf8_ascii - Perl_is_utf8_char - Perl_is_utf8_cntrl - Perl_is_utf8_digit - Perl_is_utf8_graph - Perl_is_utf8_idfirst - Perl_is_utf8_lower - Perl_is_utf8_mark - Perl_is_utf8_print - Perl_is_utf8_punct - Perl_is_utf8_space - Perl_is_utf8_upper - Perl_is_utf8_xdigit - Perl_leave_scope - Perl_load_module - Perl_looks_like_number - Perl_magic_dump - Perl_markstack_grow - Perl_mess - Perl_mg_clear - Perl_mg_copy - Perl_mg_find - Perl_mg_free - Perl_mg_get - Perl_mg_length - Perl_mg_magical - Perl_mg_set - Perl_mg_size - Perl_moreswitches - Perl_my_atof - Perl_my_exit - Perl_my_failure_exit - Perl_my_fflush_all - Perl_my_lstat - Perl_my_setenv - Perl_my_stat - Perl_newANONATTRSUB - Perl_newANONHASH - Perl_newANONLIST - Perl_newANONSUB - Perl_newASSIGNOP - Perl_newATTRSUB - Perl_newAV - Perl_newAVREF - Perl_newBINOP - Perl_newCONDOP - Perl_newCONSTSUB - Perl_newCVREF - Perl_newFORM - Perl_newFOROP - Perl_newGVOP - Perl_newGVREF - Perl_newGVgen - Perl_newHV - Perl_newHVREF - Perl_newHVhv - Perl_newIO - Perl_newLISTOP - Perl_newLOGOP - Perl_newLOOPEX - Perl_newLOOPOP - Perl_newMYSUB - Perl_newNULLLIST - Perl_newOP - Perl_newPADOP - Perl_newPMOP - Perl_newPROG - Perl_newPVOP - Perl_newRANGE - Perl_newRV - Perl_newRV_noinc - Perl_newSLICEOP - Perl_newSTATEOP - Perl_newSUB - Perl_newSV - Perl_newSVOP - Perl_newSVREF - Perl_newSViv - Perl_newSVnv - Perl_newSVpv - Perl_newSVpvf - Perl_newSVpvn - Perl_newSVrv - Perl_newSVsv - Perl_newSVuv - Perl_newUNOP - Perl_newWHILEOP - Perl_newXS - Perl_new_collate - Perl_new_ctype - Perl_new_numeric - Perl_new_stackinfo - Perl_ninstr - Perl_op_dump - Perl_op_free - Perl_pad_sv - Perl_pmflag - Perl_pmop_dump - Perl_pop_scope - Perl_pregcomp - Perl_pregexec - Perl_pregfree - Perl_push_scope - Perl_re_intuit_start - Perl_re_intuit_string - Perl_regdump - Perl_regexec_flags - Perl_reginitcolors - Perl_regnext - Perl_repeatcpy - Perl_require_pv - Perl_rninstr - Perl_runops_standard - Perl_safesyscalloc - Perl_safesysfree - Perl_safesysmalloc - Perl_safesysrealloc - Perl_save_I16 - Perl_save_I32 - Perl_save_I8 - Perl_save_aelem - Perl_save_alloc - Perl_save_aptr - Perl_save_ary - Perl_save_clearsv - Perl_save_delete - Perl_save_destructor - Perl_save_destructor_x - Perl_save_freepv - Perl_save_freesv - Perl_save_generic_svref - Perl_save_gp - Perl_save_hash - Perl_save_helem - Perl_save_hints - Perl_save_hptr - Perl_save_int - Perl_save_item - Perl_save_iv - Perl_save_list - Perl_save_long - Perl_save_nogv - Perl_save_pptr - Perl_save_re_context - Perl_save_scalar - Perl_save_sptr - Perl_save_svref - Perl_save_threadsv - Perl_save_vptr - Perl_savepv - Perl_savepvn - Perl_savestack_grow - Perl_scan_bin - Perl_scan_hex - Perl_scan_num - Perl_scan_oct - Perl_screaminstr - Perl_set_context - Perl_set_numeric_local - Perl_set_numeric_radix - Perl_set_numeric_standard - Perl_stack_grow - Perl_start_subparse - Perl_str_to_version - Perl_sv_2bool - Perl_sv_2cv - Perl_sv_2io - Perl_sv_2iv - Perl_sv_2mortal - Perl_sv_2nv - Perl_sv_2pv - Perl_sv_2pv_nolen - Perl_sv_2pvbyte - Perl_sv_2pvbyte_nolen - Perl_sv_2pvutf8 - Perl_sv_2pvutf8_nolen - Perl_sv_2uv - Perl_sv_backoff - Perl_sv_bless - Perl_sv_catpv - Perl_sv_catpv_mg - Perl_sv_catpvf - Perl_sv_catpvf_mg - Perl_sv_catpvn - Perl_sv_catpvn_mg - Perl_sv_catsv - Perl_sv_catsv_mg - Perl_sv_chop - Perl_sv_clear - Perl_sv_cmp - Perl_sv_cmp_locale - Perl_sv_compile_2op - Perl_sv_dec - Perl_sv_derived_from - Perl_sv_dump - Perl_sv_eq - Perl_sv_force_normal - Perl_sv_free - Perl_sv_gets - Perl_sv_grow - Perl_sv_inc - Perl_sv_insert - Perl_sv_isa - Perl_sv_isobject - Perl_sv_iv - Perl_sv_len - Perl_sv_len_utf8 - Perl_sv_magic - Perl_sv_mortalcopy - Perl_sv_newmortal - Perl_sv_newref - Perl_sv_nv - Perl_sv_pos_b2u - Perl_sv_pos_u2b - Perl_sv_pv - Perl_sv_pvbyte - Perl_sv_pvbyten - Perl_sv_pvbyten_force - Perl_sv_pvn - Perl_sv_pvn_force - Perl_sv_pvutf8 - Perl_sv_pvutf8n - Perl_sv_pvutf8n_force - Perl_sv_reftype - Perl_sv_replace - Perl_sv_report_used - Perl_sv_reset - Perl_sv_rvweaken - Perl_sv_setiv - Perl_sv_setiv_mg - Perl_sv_setnv - Perl_sv_setnv_mg - Perl_sv_setpv - Perl_sv_setpv_mg - Perl_sv_setpvf - Perl_sv_setpvf_mg - Perl_sv_setpviv - Perl_sv_setpviv_mg - Perl_sv_setpvn - Perl_sv_setpvn_mg - Perl_sv_setref_iv - Perl_sv_setref_nv - Perl_sv_setref_pv - Perl_sv_setref_pvn - Perl_sv_setsv - Perl_sv_setsv_mg - Perl_sv_setuv - Perl_sv_setuv_mg - Perl_sv_taint - Perl_sv_tainted - Perl_sv_true - Perl_sv_unmagic - Perl_sv_unref - Perl_sv_untaint - Perl_sv_upgrade - Perl_sv_usepvn - Perl_sv_usepvn_mg - Perl_sv_utf8_decode - Perl_sv_utf8_downgrade - Perl_sv_utf8_encode - Perl_sv_utf8_upgrade - Perl_sv_uv - Perl_sv_vcatpvf - Perl_sv_vcatpvf_mg - Perl_sv_vcatpvfn - Perl_sv_vsetpvf - Perl_sv_vsetpvf_mg - Perl_sv_vsetpvfn - Perl_swash_fetch - Perl_swash_init - Perl_taint_env - Perl_taint_proper - Perl_tmps_grow - Perl_to_uni_lower - Perl_to_uni_title - Perl_to_uni_upper - Perl_to_utf8_lower - Perl_to_utf8_title - Perl_to_utf8_upper - Perl_unsharepvn - Perl_utf16_to_utf8 - Perl_utf16_to_utf8_reversed - Perl_utf8_distance - Perl_utf8_hop - Perl_utf8_to_uvchr - Perl_uvchr_to_utf8 - Perl_vcroak - Perl_vdeb - Perl_vform - Perl_vload_module - Perl_vmess - Perl_vnewSVpvf - Perl_vwarn - Perl_vwarner - Perl_warn - Perl_warner - Perl_win32_init - RunPerl - boot_DynaLoader - perl_alloc - perl_construct - perl_destruct - perl_free - perl_parse - perl_run - win32_abort - win32_accept - win32_access - win32_alarm - win32_bind - win32_calloc - win32_chdir - win32_chmod - win32_clearerr - win32_close - win32_closedir - win32_closesocket - win32_connect - win32_crypt - win32_dup - win32_dup2 - win32_dynaload - win32_endhostent - win32_endnetent - win32_endprotoent - win32_endservent - win32_environ - win32_eof - win32_errno - win32_execv - win32_execvp - win32_fclose - win32_fcloseall - win32_fdopen - win32_feof - win32_ferror - win32_fflush - win32_fgetc - win32_fgetpos - win32_fgets - win32_fileno - win32_flock - win32_flushall - win32_fopen - win32_fprintf - win32_fputc - win32_fputs - win32_fread - win32_free - win32_freopen - win32_fseek - win32_fsetpos - win32_fstat - win32_ftell - win32_fwrite - win32_getc - win32_getchar - win32_getenv - win32_gethostbyaddr - win32_gethostbyname - win32_gethostname - win32_getnetbyaddr - win32_getnetbyname - win32_getnetent - win32_getpeername - win32_getpid - win32_getprotobyname - win32_getprotobynumber - win32_getprotoent - win32_gets - win32_getservbyname - win32_getservbyport - win32_getservent - win32_getsockname - win32_getsockopt - win32_htonl - win32_htons - win32_inet_addr - win32_inet_ntoa - win32_ioctl - win32_ioctlsocket - win32_kill - win32_link - win32_listen - win32_longpath - win32_lseek - win32_malloc - win32_mkdir - win32_ntohl - win32_ntohs - win32_open - win32_opendir - win32_os_id - win32_perror - win32_pipe - win32_printf - win32_putc - win32_putchar - win32_putenv - win32_puts - win32_read - win32_readdir - win32_realloc - win32_recv - win32_recvfrom - win32_rename - win32_rewind - win32_rewinddir - win32_rmdir - win32_seekdir - win32_select - win32_send - win32_sendto - win32_setbuf - win32_sethostent - win32_setmode - win32_setnetent - win32_setprotoent - win32_setservent - win32_setsockopt - win32_setvbuf - win32_shutdown - win32_sleep - win32_socket - win32_stat - win32_stderr - win32_stdin - win32_stdout - win32_str_os_error - win32_strerror - win32_tell - win32_telldir - win32_times - win32_tmpfile - win32_uname - win32_ungetc - win32_unlink - win32_utime - win32_vfprintf - win32_vprintf - win32_waitpid - win32_write - Perl_pp_pack - Perl_pp_unpack - Perl_sv_2pv_flags - Perl_sv_catpvn_flags - Perl_sv_catsv_flags - Perl_sv_setsv_flags diff --git a/wince/win32io.c b/wince/win32io.c new file mode 100644 index 0000000000..3683490ac4 --- /dev/null +++ b/wince/win32io.c @@ -0,0 +1,370 @@ +#define PERL_NO_GET_CONTEXT +#define WIN32_LEAN_AND_MEAN +#define WIN32IO_IS_STDIO +#include <tchar.h> +#ifdef __GNUC__ +#define Win32_Winsock +#endif +#include <windows.h> +#include <cewin32.h> + +#include <sys/stat.h> +#include "EXTERN.h" +#include "perl.h" + +#ifdef PERLIO_LAYERS + +#include "perliol.h" + +#define NO_XSLOCKS +#include "XSUB.h" + + +/* Bottom-most level for Win32 case */ + +typedef struct +{ + struct _PerlIO base; /* The generic part */ + HANDLE h; /* OS level handle */ + IV refcnt; /* REFCNT for the "fd" this represents */ + int fd; /* UNIX like file descriptor - index into fdtable */ +} PerlIOWin32; + +PerlIOWin32 *fdtable[256]; +IV max_open_fd = -1; + +IV +PerlIOWin32_popped(pTHX_ PerlIO *f) +{ + PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); + if (--s->refcnt > 0) + { + *f = PerlIOBase(f)->next; + return 1; + } + fdtable[s->fd] = NULL; + return 0; +} + +IV +PerlIOWin32_fileno(pTHX_ PerlIO *f) +{ + return PerlIOSelf(f,PerlIOWin32)->fd; +} + +IV +PerlIOWin32_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) +{ + IV code = PerlIOBase_pushed(aTHX_ f,mode,arg); + if (*PerlIONext(f)) + { + PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); + s->fd = PerlIO_fileno(PerlIONext(f)); + } + PerlIOBase(f)->flags |= PERLIO_F_OPEN; + return code; +} + +PerlIO * +PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) +{ + const char *tmode = mode; + HANDLE h = INVALID_HANDLE_VALUE; + if (f) + { + /* Close if already open */ + if (PerlIOBase(f)->flags & PERLIO_F_OPEN) + (*PerlIOBase(f)->tab->Close)(aTHX_ f); + } + if (narg > 0) + { + char *path = SvPV_nolen(*args); + DWORD access = 0; + DWORD share = 0; + DWORD create = -1; + DWORD attr = FILE_ATTRIBUTE_NORMAL; + if (*mode == '#') + { + /* sysopen - imode is UNIX-like O_RDONLY etc. + - do_open has converted that back to string form in mode as well + - perm is UNIX like permissions + */ + mode++; + } + else + { + /* Normal open - decode mode string */ + } + switch(*mode) + { + case 'r': + access = GENERIC_READ; + create = OPEN_EXISTING; + if (*++mode == '+') + { + access |= GENERIC_WRITE; + create = OPEN_ALWAYS; + mode++; + } + break; + + case 'w': + access = GENERIC_WRITE; + create = TRUNCATE_EXISTING; + if (*++mode == '+') + { + access |= GENERIC_READ; + mode++; + } + break; + + case 'a': + access = GENERIC_WRITE; + create = OPEN_ALWAYS; + if (*++mode == '+') + { + access |= GENERIC_READ; + mode++; + } + break; + } + if (*mode == 'b') + { + mode++; + } + else if (*mode == 't') + { + mode++; + } + if (*mode || create == -1) + { + //FIX-ME: SETERRNO(EINVAL,LIB$_INVARG); + XCEMessageBoxA(NULL, "NEED TO IMPLEMENT a place in ../wince/win32io.c", "Perl(developer)", 0); + return NULL; + } + if (!(access & GENERIC_WRITE)) + share = FILE_SHARE_READ; + h = CreateFileW(path,access,share,NULL,create,attr,NULL); + if (h == INVALID_HANDLE_VALUE) + { + if (create == TRUNCATE_EXISTING) + h = CreateFileW(path,access,share,NULL,(create = OPEN_ALWAYS),attr,NULL); + } + } + else + { + /* fd open */ + h = INVALID_HANDLE_VALUE; + if (fd >= 0 && fd <= max_open_fd) + { + PerlIOWin32 *s = fdtable[fd]; + if (s) + { + s->refcnt++; + if (!f) + f = PerlIO_allocate(aTHX); + *f = &s->base; + return f; + } + } + if (*mode == 'I') + { + mode++; + switch(fd) + { + case 0: + h = XCEGetStdHandle(STD_INPUT_HANDLE); + break; + case 1: + h = XCEGetStdHandle(STD_OUTPUT_HANDLE); + break; + case 2: + h = XCEGetStdHandle(STD_ERROR_HANDLE); + break; + } + } + } + if (h != INVALID_HANDLE_VALUE) + fd = win32_open_osfhandle((intptr_t) h, PerlIOUnix_oflags(tmode)); + if (fd >= 0) + { + PerlIOWin32 *s; + if (!f) + f = PerlIO_allocate(aTHX); + s = PerlIOSelf(PerlIO_push(aTHX_ f,self,tmode,PerlIOArg),PerlIOWin32); + s->h = h; + s->fd = fd; + s->refcnt = 1; + if (fd >= 0) + { + fdtable[fd] = s; + if (fd > max_open_fd) + max_open_fd = fd; + } + return f; + } + if (f) + { + /* FIXME: pop layers ??? */ + } + return NULL; +} + +SSize_t +PerlIOWin32_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) +{ + PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); + DWORD len; + if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) + return 0; + if (ReadFile(s->h,vbuf,count,&len,NULL)) + { + return len; + } + else + { + if (GetLastError() != NO_ERROR) + { + PerlIOBase(f)->flags |= PERLIO_F_ERROR; + return -1; + } + else + { + if (count != 0) + PerlIOBase(f)->flags |= PERLIO_F_EOF; + return 0; + } + } +} + +SSize_t +PerlIOWin32_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) +{ + PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); + DWORD len; + if (WriteFile(s->h,vbuf,count,&len,NULL)) + { + return len; + } + else + { + PerlIOBase(f)->flags |= PERLIO_F_ERROR; + return -1; + } +} + +IV +PerlIOWin32_seek(pTHX_ PerlIO *f, Off_t offset, int whence) +{ + static const DWORD where[3] = { FILE_BEGIN, FILE_CURRENT, FILE_END }; + PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); + DWORD high = (sizeof(offset) > sizeof(DWORD)) ? (DWORD)(offset >> 32) : 0; + DWORD low = (DWORD) offset; + DWORD res = SetFilePointer(s->h,low,&high,where[whence]); + if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR) + { + return 0; + } + else + { + return -1; + } +} + +Off_t +PerlIOWin32_tell(pTHX_ PerlIO *f) +{ + PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); + DWORD high = 0; + DWORD res = SetFilePointer(s->h,0,&high,FILE_CURRENT); + if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR) + { + return ((Off_t) high << 32) | res; + } + return (Off_t) -1; +} + +IV +PerlIOWin32_close(pTHX_ PerlIO *f) +{ + PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); + if (s->refcnt == 1) + { + if (CloseHandle(s->h)) + { + s->h = INVALID_HANDLE_VALUE; + return -1; + } + } + PerlIOBase(f)->flags &= ~PERLIO_F_OPEN; + return 0; +} + +PerlIO * +PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params, int flags) +{ + PerlIOWin32 *os = PerlIOSelf(f,PerlIOWin32); + HANDLE proc = GetCurrentProcess(); + HANDLE new; +//vvv todo if (DuplicateHandle(proc, os->h, proc, &new, 0, FALSE, DUPLICATE_SAME_ACCESS)) + if (0) + { + char mode[8]; + int fd = win32_open_osfhandle((intptr_t) new, PerlIOUnix_oflags(PerlIO_modestr(o,mode))); + if (fd >= 0) + { + f = PerlIOBase_dup(aTHX_ f, o, params, flags); + if (f) + { + PerlIOWin32 *fs = PerlIOSelf(f,PerlIOWin32); + fs->h = new; + fs->fd = fd; + fs->refcnt = 1; + fdtable[fd] = fs; + if (fd > max_open_fd) + max_open_fd = fd; + } + else + { + win32_close(fd); + } + } + else + { + CloseHandle(new); + } + } + return f; +} + +PerlIO_funcs PerlIO_win32 = { + "win32", + sizeof(PerlIOWin32), + PERLIO_K_RAW, + PerlIOWin32_pushed, + PerlIOWin32_popped, + PerlIOWin32_open, + NULL, /* getarg */ + PerlIOWin32_fileno, + PerlIOWin32_dup, + PerlIOWin32_read, + PerlIOBase_unread, + PerlIOWin32_write, + PerlIOWin32_seek, + PerlIOWin32_tell, + PerlIOWin32_close, + PerlIOBase_noop_ok, /* flush */ + PerlIOBase_noop_fail, /* fill */ + PerlIOBase_eof, + PerlIOBase_error, + PerlIOBase_clearerr, + PerlIOBase_setlinebuf, + NULL, /* get_base */ + NULL, /* get_bufsiz */ + NULL, /* get_ptr */ + NULL, /* get_cnt */ + NULL, /* set_ptrcnt */ +}; + + +#endif diff --git a/wince/wince.c b/wince/wince.c index 7aabdd7dc5..8a4eb05f59 100644 --- a/wince/wince.c +++ b/wince/wince.c @@ -1632,7 +1632,115 @@ win32_open_osfhandle(intptr_t osfhandle, int flags) int fh; char fileflags=0; /* _osfile flags */ - XCEMessageBoxA(NULL, "NEED TO IMPLEMENT a place in ../wince/wince.c(win32_open_osfhandle)", "Perl(developer)", 0); + XCEMessageBoxA(NULL, "NEED TO IMPLEMENT in wince/wince.c(win32_open_osfhandle)", "error", 0); Perl_croak_nocontext("win32_open_osfhandle() TBD on this platform"); return 0; } + +int +win32_get_osfhandle(intptr_t osfhandle, int flags) +{ + int fh; + char fileflags=0; /* _osfile flags */ + + XCEMessageBoxA(NULL, "NEED TO IMPLEMENT in wince/wince.c(win32_get_osfhandle)", "error", 0); + Perl_croak_nocontext("win32_get_osfhandle() TBD on this platform"); + return 0; +} + +/* + * a popen() clone that respects PERL5SHELL + * + * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000 + */ + +DllExport PerlIO* +win32_popen(const char *command, const char *mode) +{ + XCEMessageBoxA(NULL, "NEED TO IMPLEMENT in wince/wince.c(win32_popen)", "error", 0); + Perl_croak_nocontext("win32_popen() TBD on this platform"); +} + +/* + * pclose() clone + */ + +DllExport int +win32_pclose(PerlIO *pf) +{ +#ifdef USE_RTL_POPEN + return _pclose(pf); +#else + dTHX; + int childpid, status; + SV *sv; + + LOCK_FDPID_MUTEX; + sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE); + + if (SvIOK(sv)) + childpid = SvIVX(sv); + else + childpid = 0; + + if (!childpid) { + errno = EBADF; + return -1; + } + +#ifdef USE_PERLIO + PerlIO_close(pf); +#else + fclose(pf); +#endif + SvIVX(sv) = 0; + UNLOCK_FDPID_MUTEX; + + if (win32_waitpid(childpid, &status, 0) == -1) + return -1; + + return status; + +#endif /* USE_RTL_POPEN */ +} + +FILE * +win32_fdupopen(FILE *pf) +{ + FILE* pfdup; + fpos_t pos; + char mode[3]; + int fileno = win32_dup(win32_fileno(pf)); + + XCEMessageBoxA(NULL, "NEED TO IMPLEMENT a place in .../wince/wince.c(win32_fdupopen)", "Perl(developer)", 0); + Perl_croak_nocontext("win32_fdupopen() TBD on this platform"); + +#if 0 + /* open the file in the same mode */ + if((pf)->_flag & _IOREAD) { + mode[0] = 'r'; + mode[1] = 0; + } + else if((pf)->_flag & _IOWRT) { + mode[0] = 'a'; + mode[1] = 0; + } + else if((pf)->_flag & _IORW) { + mode[0] = 'r'; + mode[1] = '+'; + mode[2] = 0; + } + + /* it appears that the binmode is attached to the + * file descriptor so binmode files will be handled + * correctly + */ + pfdup = win32_fdopen(fileno, mode); + + /* move the file pointer to the same position */ + if (!fgetpos(pf, &pos)) { + fsetpos(pfdup, &pos); + } +#endif + return pfdup; +} |