This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
OS/2 build
authorIlya Zakharevich <ilya@math.berkeley.edu>
Wed, 29 Oct 2003 14:00:18 +0000 (06:00 -0800)
committerNicholas Clark <nick@ccl4.org>
Sun, 2 Nov 2003 18:22:16 +0000 (18:22 +0000)
Message-ID: <20031029220017.GA26384@math.berkeley.edu>

p4raw-id: //depot/perl@21620

ext/DynaLoader/DynaLoader_pm.PL
makedef.pl
os2/Makefile.SHs
os2/OS2/REXX/REXX.xs
os2/os2.c
os2/os2_base.t
os2/os2ish.h
os2/perl2cmd.pl
perlio.c

index 8a3e6e1..8dfb5d4 100644 (file)
@@ -229,6 +229,15 @@ sub bootstrap {
        "  dynamic loading or has the $module module statically linked into it.)\n")
        unless defined(&dl_load_file);
 
+EOT
+
+print OUT <<'EOT' if $^O eq 'os2';
+    # Can dynaload, but cannot dynaload Perl modules...
+    die 'Dynaloaded Perl modules are not available in this build of Perl' if $OS2::is_static;
+
+EOT
+
+print OUT <<'EOT';
     my @modparts = split(/::/,$module);
     my $modfname = $modparts[-1];
 
index 6c6bafe..3db62ab 100644 (file)
@@ -377,6 +377,8 @@ elsif ($PLATFORM eq 'os2') {
                    dlsym
                    dlerror
                    dlclose
+                   dup2
+                   dup
                    my_tmpfile
                    my_tmpnam
                    my_flock
@@ -1340,7 +1342,10 @@ foreach my $symbol (sort keys %export) {
 }
 
 if ($PLATFORM eq 'os2') {
-       print "; LAST_ORDINAL=$sym_ord\n";
+       print <<EOP;
+    dll_perlmain=main
+; LAST_ORDINAL=$sym_ord
+EOP
 }
 
 sub emit_symbol {
index baefec9..87f0b37 100644 (file)
@@ -43,7 +43,7 @@ AOUT_CLDFLAGS_DLL     = -Zexe -Zmt -Zcrtdll -Zstack 32000
 SO_CCCMD       = \$(CC) $ccflags \$(OPTIMIZE)
 
 LD_OPT         = \$(OPTIMIZE)
-PERL_DLL_LD_OPT = -Zmap -Zlinker /map
+PERL_DLL_LD_OPT = -Zmap -Zlinker /map/li
 
 PERL_DLL_BASE  = perl$dll_post
 PERL_DLL       = \$(PERL_DLL_BASE)\$(DLSUFFIX)
@@ -55,11 +55,15 @@ AOUT_EXTRA_LIBS     = $aout_extra_libs
 
 $spitshell >>Makefile <<'!NO!SUBS!'
 PREPLIBRARY_LIBPERL = $(LIBPERL)
-$(LIBPERL): perl.imp $(PERL_DLL) perl5.def libperl_override.lib
+$(LIBPERL): perl.imp perl5.def libperl_override.lib
        emximp -o $(LIBPERL) perl.imp
        cp $(LIBPERL) perl.lib
 
-libperl_override.imp: os2/os2add.sym miniperl
+imp_version: $(FIRSTMAKEFILE)
+       echo $(PERL_DLL_BASE) > imp_version.tmp
+       sh mv-if-diff imp_version.tmp $@
+
+libperl_override.imp: os2/os2add.sym miniperl imp_version
        ./miniperl -wnle 'print "$$_\t$(PERL_DLL_BASE)\t$$_\t?"' os2/os2add.sym > tmp.imp
        echo    'strdup $(PERL_DLL_BASE)        Perl_strdup     ?' >> tmp.imp
        echo    'putenv $(PERL_DLL_BASE)        Perl_putenv     ?' >> tmp.imp
@@ -68,10 +72,20 @@ libperl_override.imp: os2/os2add.sym miniperl
 libperl_override.lib: libperl_override.imp
        emximp -o $@ libperl_override.imp
 
+libperl_dllmain.imp: imp_version
+       echo    'main   $(PERL_DLL_BASE)        dll_perlmain    ?' >> tmpdll.imp
+       sh mv-if-diff tmpdll.imp $@
+
+libperl_dllmain.lib: libperl_dllmain.imp
+       emximp -o $@ libperl_dllmain.imp
+
+libperl_dllmain.a: libperl_dllmain.imp
+       emximp -o $@ libperl_dllmain.imp
+
 $(AOUT_LIBPERL_DLL): perl.imp $(PERL_DLL) perl5.def
        emximp -o $(AOUT_LIBPERL_DLL) perl.imp
 
-perl.imp: perl5.def
+perl.imp: perl5.def imp_version
        emximp -o perl.imp perl5.def
        echo    'emx_calloc             emxlibcm        400     ?' >> $@
        echo    'emx_free               emxlibcm        401     ?' >> $@
@@ -82,7 +96,8 @@ perl.imp: perl5.def
        perlrexx test_prep_perl_ test_prep_perl_sys test_prep_perl_stat \
        test_prep_perl_stat_aout test_prep_various \
        stat_aout_harness aout_harness stat_harness sys_harness all_harness \
-       stat_aout_test aout_test stat_test sys_test all_test
+       stat_aout_test aout_test stat_test sys_test all_test \
+       perl___harness test_harness_redir
 
 perl_dll: $(PERL_DLL)
 
@@ -91,8 +106,8 @@ perl_dll_t: t/$(PERL_DLL)
 t/$(PERL_DLL): $(PERL_DLL)
        $(LNS) $(PERL_DLL) t/$(PERL_DLL)
 
-$(PERL_DLL): $(obj) perl5.def perl$(OBJ_EXT)
-       $(LD) $(LD_OPT) $(LDDLFLAGS) $(PERL_DLL_LD_OPT) -o $@ perl$(OBJ_EXT) $(obj) $(libs) perl5.def || ( rm $(PERL_DLL) && sh -c false )
+$(PERL_DLL): $(obj) perl5.def perl$(OBJ_EXT) perlmain$(OBJ_EXT) $(DYNALOADER)
+       $(LD) $(LD_OPT) $(LDDLFLAGS) $(PERL_DLL_LD_OPT) -o $@ perl$(OBJ_EXT) $(obj) perlmain$(OBJ_EXT) $(DYNALOADER) $(libs) perl5.def || ( rm $(PERL_DLL) && sh -c false )
 
 perl5.olddef: perl.linkexp
        echo "LIBRARY '$(PERL_DLL_BASE)' INITINSTANCE TERMINSTANCE"     > $@
@@ -155,9 +170,16 @@ dlfcn.h: os2/dlfcn.h
        cp -f $< $@
 
 # Non-Forking dynamically loaded perl
+# Make many: they are useful in low-memory conditions (floppy boot?  Lot of shared memory used?)
 
-perl___$(EXE_EXT) perl___: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
-       $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o perl___ perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LIBPERL) `cat ext.libs` $(libs) -Zlinker /map/PM:VIO
+perl___$(EXE_EXT) perl___: $& libperl_dllmain$(LIB_EXT)
+       $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o perl___ libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
+       $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -Zstack 8192 -o perl___8 libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
+       $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -Zstack 4096 -o perl___4 libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
+       $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -Zstack 2048 -o perl___2 libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
+       $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -Zstack 1024 -o perl___1 libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
+       $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -Zstack 512 -o perl___05 libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
+       $(SHRPENV) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -Zstack 320 -o perl___03 libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
 
 # This one is compiled -Zsys, so cannot do many things:
 
@@ -166,16 +188,16 @@ STAT_CLDFLAGS = -Zexe -Zomf -Zmt -Zstack 32000
 
 # Non-forking dynamically loaded perl with a wrong CRT library:
 
-perl_stat: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
-       $(SHRPENV) $(CC) $(STAT_CLDFLAGS) $(CCDLFLAGS) -o $@ perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LIBPERL) `cat ext.libs` $(libs) -Zlinker /map/PM:VIO
+perl_stat perl_stat$(EXE_EXT): $& libperl_dllmain$(LIB_EXT)
+       $(SHRPENV) $(CC) $(STAT_CLDFLAGS) $(CCDLFLAGS) -o perl_stat libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
 
 # Remove -Zcrtdll, add -Zsys
 SYS_CLDFLAGS = $(STAT_CLDFLAGS) -Zsys
 
 # Non-Forking dynamically loaded perl without EMX - so with wrong CRT library
 
-perl_sys: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
-       $(SHRPENV) $(CC) $(SYS_CLDFLAGS) $(CCDLFLAGS) -o $@ perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LIBPERL) `cat ext.libs` $(libs) -Zlinker /map/PM:VIO
+perl_sys perl_sys$(EXE_EXT): $& libperl_dllmain$(LIB_EXT)
+       $(SHRPENV) $(CC) $(SYS_CLDFLAGS) $(CCDLFLAGS) -o perl_sys libperl_dllmain$(LIB_EXT) -Zlinker /map/PM:VIO
 
 installcmd : 
        @perl -e 'die qq{Give the option INSTALLCMDDIR=... to make!} if $$ARGV[0] eq ""' $(INSTALLCMDDIR)
@@ -203,7 +225,7 @@ $(DYNALOADER_OBJ) : $(DYNALOADER)
 $(AOUT_LIBPERL) : $(aout_obj) perl$(AOUT_OBJ_EXT)
        rm -f $@
        $(AOUT_AR) rcu $@ perl$(AOUT_OBJ_EXT) $(aout_obj)
-       cp $@ perl.a
+       cp $@ perl$(AOUT_LIB_EXT)
 
 .c$(AOUT_OBJ_EXT):
        $(AOUT_CCCMD) $(PLDLFLAGS) -c $*.c
@@ -214,9 +236,14 @@ opmini$(AOUT_OBJ_EXT): op.c
 perlmain(AOUT_OBJ_EXT): perlmain.c
        $(AOUT_CCCMD_DLL) $(PLDLFLAGS) -c perlmain.c
 
-aout_perlmain.c: miniperlmain.c config.sh makefile $(static_ext_autoinit)
-       sh writemain $(DYNALOADER) $(aout_static_lib) > tmp
-       sh mv-if-diff tmp aout_perlmain.c
+# Assume that extensions are at most 4 deep (this is so with 5.8.1)
+aout_extlist: $(aout_static_ext)
+       echo lib/auto/*.a lib/auto/*/*.a lib/auto/*/*/*.a lib/auto/*/*/*/*.a | tr ' ' '\n' | grep -v '\*' > $@.tmp
+       sh mv-if-diff $@.tmp $@
+
+aout_perlmain.c: miniperlmain.c config.sh makefile $(static_ext_autoinit) $(aout_static_ext) writemain aout_extlist
+       sh writemain `cat aout_extlist` > aout_perlmain.tmp
+       sh mv-if-diff aout_perlmain.tmp aout_perlmain.c
 
 _preplibrary = miniperl lib/Config.pm lib/lib.pm lib/re.pm
 
@@ -228,35 +255,35 @@ miniperl_: $& miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) opmini$(AOUT_OBJ_EXT)
 # Need a miniperl_ dependency, since $(AOUT_DYNALOADER) is build via implicit
 # rules, thus would not rebuild miniperl_ via an explicit rule
 
-perl_$(EXE_EXT) perl_: $& miniperl_ aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(AOUT_DYNALOADER) $(aout_static_ext) ext.libs
-       $(CC) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o perl_ aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER) $(aout_static_ext) $(AOUT_LIBPERL) `cat ext.libs` $(libs)
+perl_$(EXE_EXT) perl_: $& miniperl_ aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(AOUT_DYNALOADER) $(aout_static_ext) ext.libs aout_extlist
+       $(CC) $(AOUT_CLDFLAGS) $(CCDLFLAGS) $(OPTIMIZE) -o perl_ aout_perlmain$(AOUT_OBJ_EXT) `cat aout_extlist` $(AOUT_LIBPERL) `cat ext.libs` $(libs)
 
 # Remove -Zcrtdll
 STAT_AOUT_CLDFLAGS = -Zexe -Zmt -Zstack 32000
 
 # Forking dynamically loaded perl with a wrong CRT library:
 
-perl_stat_aout$(EXE_EXT) perl_stat_aout: $& perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER_OBJ) $(aout_static_ext_dll) $(AOUT_LIBPERL_DLL) ext.libs
-       $(SHRPENV) $(CC) $(STAT_AOUT_CLDFLAGS) $(CCDLFLAGS) -o $@ perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER_OBJ) $(aout_static_ext_dll) $(AOUT_LIBPERL_DLL) `cat ext.libs` $(libs)
+perl_stat_aout$(EXE_EXT) perl_stat_aout: $& libperl_dllmain$(AOUT_LIB_EXT)
+       $(SHRPENV) $(CC) $(STAT_AOUT_CLDFLAGS) $(CCDLFLAGS) $(OPTIMIZE) -o perl_stat_aout libperl_dllmain$(AOUT_LIB_EXT)
 
 PERLREXX_DLL = perlrexx.dll
 
-perl : perl__ perl___ $(PERLREXX_DLL)
+perl perl$(EXE_EXT) : perl__ perl___ $(PERLREXX_DLL) $(PERL_DLL)
 
 # Dynamically loaded PM-application perl:
 
-perl__$(EXE_EXT) perl__: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
-       $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o perl__ perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LIBPERL) `cat ext.libs` $(libs) -Zlinker /PM:PM
+perl__$(EXE_EXT) perl__: $& libperl_dllmain$(LIB_EXT)
+       $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o perl__ libperl_dllmain$(LIB_EXT) -Zlinker /PM:PM
 
 # Forking dynamically loaded perl:
 
-perl$(EXE_EXT) perl: $& perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER_OBJ) $(aout_static_ext_dll) $(AOUT_LIBPERL_DLL) ext.libs
-       $(CC) $(AOUT_CLDFLAGS_DLL) $(CCDLFLAGS) -o perl perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER_OBJ) $(aout_static_ext_dll) $(AOUT_LIBPERL_DLL) `cat ext.libs` $(libs)
+perl$(EXE_EXT) perl: $& libperl_dllmain$(AOUT_LIB_EXT)
+       $(CC) $(AOUT_CLDFLAGS_DLL) $(CCDLFLAGS) -o perl libperl_dllmain$(AOUT_LIB_EXT)
 
 clean: aout_clean
 
 aout_clean:
-       -rm *perl_.* *.o *.a lib/auto/*/*.a ext/*/Makefile.aout
+       -rm *perl_.* *.o *.a lib/auto/*/*.a lib/auto/*/*/*.a lib/auto/*/*/*/*.a ext/*/Makefile.aout ext/*/*/Makefile.aout  ext/*/*/*/Makefile.aout
 
 aout_install: perl_ aout_install.perl
 
@@ -351,7 +378,10 @@ perl___harness: test_prep_perl___
 
 all_test: test aout_test perl___test sys_test stat_test stat_aout_test
 
-all_harness: test_harness aout_harness perl___harness sys_harness stat_harness stat_aout_harness
+test_harness_redir: test_prep
+       -PERL=./perl $(MAKE) TESTFILE=harness _test $(REDIR_TEST)
+
+all_harness: test_harness_redir aout_harness perl___harness sys_harness stat_harness stat_aout_harness
 
 !NO!SUBS!
 
@@ -385,7 +415,7 @@ do
                else
                    # Need to treat subsubdirectories manually
                    dd_treated=''
-                   for ddd in $dd/*
+                   for ddd in $dd/*            # ext/*/*/*/Makefile.PL
                    do
                        if test ! -d $ddd; then
                            continue
@@ -404,6 +434,12 @@ do
        fi
 done
 
+# ext/threads is marked as NORECURS, so we need to specialcase it
+if echo "$static_ext $dynamic_ext" | grep -q threads/shared ; then
+   preci="$preci ext/threads/%/Makefile.aout"
+   dirs="$dirs ext/threads"
+fi
+
 $spitshell >>Makefile <<!GROK!THIS!
 .PRECIOUS : $preci
 
index 10ee7ec..43bdcac 100644 (file)
@@ -52,6 +52,8 @@ static LONG    APIENTRY (*pRexxStart) (LONG, PRXSTRING, PSZ, PRXSTRING,
                                    PSZ, LONG, PRXSYSEXIT, PSHORT, PRXSTRING);
 static APIRET  APIENTRY (*pRexxRegisterFunctionExe) (PSZ,
                                                  RexxFunctionHandler *);
+static APIRET  APIENTRY (*pRexxRegisterSubcomExe)  (PCSZ pszEnvName, PFN pfnEntryPoint,
+    PUCHAR pUserArea);
 static APIRET  APIENTRY (*pRexxDeregisterFunction) (PSZ);
 
 static ULONG (*pRexxVariablePool) (PSHVBLOCK pRequest);
@@ -313,11 +315,13 @@ initialize(void)
     *(PFN *)&pRexxDeregisterFunction
        = loadByOrdinal(ORD_RexxDeregisterFunction, 1);
     *(PFN *)&pRexxVariablePool = loadByOrdinal(ORD_RexxVariablePool, 1);
+    *(PFN *)&pRexxRegisterSubcomExe
+       = loadByOrdinal(ORD_RexxRegisterSubcomExe, 1);
     needstrs(8);
     needvars(8);
     trace = getenv("PERL_REXX_DEBUG");
      
-    rc = RexxRegisterSubcomExe("PERLEVAL", (PFN)&SubCommandPerlEval, NULL);
+    rc = pRexxRegisterSubcomExe("PERLEVAL", (PFN)&SubCommandPerlEval, NULL);
 }
 
 static int
index 88b5f5d..e8e10d9 100644 (file)
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -620,6 +620,8 @@ static const struct {
   {&pmwin_handle, NULL, 780},          /* WinLoadPointer */
   {&pmwin_handle, NULL, 828},          /* WinQuerySysPointer */
   {&doscalls_handle, NULL, 417},       /* DosReplaceModule */
+  {&doscalls_handle, NULL, 976},       /* DosPerfSysCall */
+  {&rexxapi_handle, "RexxRegisterSubcomExe", 0},
 };
 
 HMODULE
@@ -759,15 +761,17 @@ get_sysinfo(ULONG pid, ULONG flags)
     ULONG rc, buf_len = QSS_INI_BUFFER;
     PQTOPLEVEL psi;
 
-    if (!pidtid_lookup) {
-       pidtid_lookup = 1;
-       *(PFN*)&pDosVerifyPidTid = loadByOrdinal(ORD_DosVerifyPidTid, 0);
-    }
-    if (pDosVerifyPidTid) {    /* Warp3 or later */
-       /* Up to some fixpak QuerySysState() kills the system if a non-existent
-          pid is used. */
-       if (CheckOSError(pDosVerifyPidTid(pid, 1)))
-           return 0;
+    if (pid) {
+       if (!pidtid_lookup) {
+           pidtid_lookup = 1;
+           *(PFN*)&pDosVerifyPidTid = loadByOrdinal(ORD_DosVerifyPidTid, 0);
+       }
+       if (pDosVerifyPidTid) { /* Warp3 or later */
+           /* Up to some fixpak QuerySysState() kills the system if a non-existent
+              pid is used. */
+           if (CheckOSError(pDosVerifyPidTid(pid, 1)))
+               return 0;
+        }
     }
     New(1322, pbuffer, buf_len, char);
     /* QSS_PROCESS | QSS_MODULE | QSS_SEMAPHORES | QSS_SHARED */
@@ -1127,7 +1131,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag)
                           does not append ".exe", so we could have
                           reached this place). */
                        sv_catpv(scrsv, ".exe");
-                       scr = SvPV(scrsv, n_a); /* Reload */
+                       PL_Argv[0] = scr = SvPV(scrsv, n_a);    /* Reload */
                        if (PerlLIO_stat(scr,&PL_statbuf) >= 0
                            && !S_ISDIR(PL_statbuf.st_mode)) {  /* Found */
                                real_name = scr;
@@ -1851,6 +1855,109 @@ XS(XS_OS2_replaceModule)
     XSRETURN_EMPTY;
 }
 
+/* APIRET APIENTRY DosPerfSysCall(ULONG ulCommand, ULONG ulParm1,
+                                  ULONG ulParm2, ULONG ulParm3); */
+
+DeclOSFuncByORD(ULONG,perfSysCall,ORD_DosPerfSysCall,
+               (ULONG ulCommand, ULONG ulParm1, ULONG ulParm2, ULONG ulParm3),
+               (ulCommand, ulParm1, ulParm2, ulParm3))
+
+#ifndef CMD_KI_RDCNT
+#  define CMD_KI_RDCNT 0x63
+#endif
+#ifndef CMD_KI_GETQTY
+#  define CMD_KI_GETQTY 0x41
+#endif
+#ifndef QSV_NUMPROCESSORS
+#  define QSV_NUMPROCESSORS         26
+#endif
+
+typedef unsigned long long myCPUUTIL[4];       /* time/idle/busy/intr */
+
+/*
+NO_OUTPUT ULONG
+perfSysCall(ULONG ulCommand, ULONG ulParm1, ULONG ulParm2, ULONG ulParm3)
+    PREINIT:
+       ULONG rc;
+    POSTCALL:
+       if (!RETVAL)
+           croak_with_os2error("perfSysCall() error");
+ */
+
+static int
+numprocessors(void)
+{
+    ULONG res;
+
+    if (DosQuerySysInfo(QSV_NUMPROCESSORS, QSV_NUMPROCESSORS, (PVOID)&res, sizeof(res)))
+       return 1;                       /* Old system? */
+    return res;
+}
+
+XS(XS_OS2_perfSysCall); /* prototype to pass -Wmissing-prototypes */
+XS(XS_OS2_perfSysCall)
+{
+    dXSARGS;
+    if (items < 0 || items > 4)
+       Perl_croak(aTHX_ "Usage: OS2::perfSysCall(ulCommand = CMD_KI_RDCNT, ulParm1= 0, ulParm2= 0, ulParm3= 0)");
+    SP -= items;
+    {
+       dXSTARG;
+       ULONG RETVAL, ulCommand, ulParm1, ulParm2, ulParm3, res;
+       myCPUUTIL u[64];
+       int total = 0, tot2 = 0;
+
+       if (items < 1)
+           ulCommand = CMD_KI_RDCNT;
+       else {
+           ulCommand = (ULONG)SvUV(ST(0));
+       }
+
+       if (items < 2) {
+           total = (ulCommand == CMD_KI_RDCNT ? numprocessors() : 0);
+           ulParm1 = (total ? (ULONG)u : 0);
+
+           if (total > C_ARRAY_LENGTH(u))
+               croak("Unexpected number of processors: %d", total);
+       } else {
+           ulParm1 = (ULONG)SvUV(ST(1));
+       }
+
+       if (items < 3) {
+           tot2 = (ulCommand == CMD_KI_GETQTY);
+           ulParm2 = (tot2 ? (ULONG)&res : 0);
+       } else {
+           ulParm2 = (ULONG)SvUV(ST(2));
+       }
+
+       if (items < 4)
+           ulParm3 = 0;
+       else {
+           ulParm3 = (ULONG)SvUV(ST(3));
+       }
+
+       RETVAL = perfSysCall(ulCommand, ulParm1, ulParm2, ulParm3);
+       if (!RETVAL)
+           croak_with_os2error("perfSysCall() error");
+       if (total) {
+           int i,j;
+
+           if (GIMME_V != G_ARRAY) {
+               PUSHn(u[0][0]);         /* Total ticks on the first processor */
+               XSRETURN(1);
+           }
+           for (i=0; i < total; i++)
+               for (j=0; j < 4; j++)
+                   PUSHs(sv_2mortal(newSVnv(u[i][j])));
+           XSRETURN(4*total);
+       }
+       if (tot2) {
+           PUSHu(res);
+           XSRETURN(1);
+       }
+    }
+    XSRETURN_EMPTY;
+}
 
 #define PERL_PATCHLEVEL_H_IMPLICIT     /* Do not init local_patches. */
 #include "patchlevel.h"
@@ -3503,6 +3610,7 @@ Xs_OS2_init(pTHX)
         newXS("Cwd::sys_cwd", XS_Cwd_sys_cwd, file);
         newXS("Cwd::sys_abspath", XS_Cwd_sys_abspath, file);
         newXS("OS2::replaceModule", XS_OS2_replaceModule, file);
+        newXS("OS2::perfSysCall", XS_OS2_perfSysCall, file);
         newXSproto("OS2::_control87", XS_OS2__control87, file, "$$");
         newXSproto("OS2::get_control87", XS_OS2_get_control87, file, "");
         newXSproto("OS2::set_control87", XS_OS2_set_control87, file, ";$$");
@@ -3521,6 +3629,11 @@ Xs_OS2_init(pTHX)
 #ifdef PERL_IS_AOUT
        sv_setiv(GvSV(gv), 1);
 #endif
+       gv = gv_fetchpv("OS2::is_static", TRUE, SVt_PV);
+       GvMULTI_on(gv);
+#ifdef PERL_IS_AOUT
+       sv_setiv(GvSV(gv), 1);
+#endif
        gv = gv_fetchpv("OS2::can_fork", TRUE, SVt_PV);
        GvMULTI_on(gv);
        sv_setiv(GvSV(gv), exe_is_aout());
@@ -3923,6 +4036,40 @@ Perl_OS2_init3(char **env, void **preg, int flags)
     _control87(MCW_EM, MCW_EM);
 }
 
+int
+fd_ok(int fd)
+{
+    static ULONG max_fh = 0;
+
+    if (!(_emx_env & 0x200)) return 1;         /* not OS/2. */
+    if (fd >= max_fh) {                                /* Renew */
+       LONG delta = 0;
+
+       if (DosSetRelMaxFH(&delta, &max_fh))    /* Assume it OK??? */
+           return 1;
+    }
+    return fd < max_fh;
+}
+
+/* Kernels up to Oct 2003 trap on (invalid) dup(max_fh); [off-by-one + double fault].  */
+int
+dup2(int from, int to)
+{
+    if (fd_ok(from < to ? to : from))
+       return _dup2(from, to);
+    errno = EBADF;
+    return -1;
+}
+
+int
+dup(int from)
+{
+    if (fd_ok(from))
+       return _dup(from);
+    errno = EBADF;
+    return -1;
+}
+
 #undef tmpnam
 #undef tmpfile
 
index f65a64c..80181b7 100644 (file)
@@ -32,10 +32,17 @@ $lpe =~ s#\\#/#g;
 
 like($lpe, qr/\Q$s_cwd/);
 
-is(uc OS2::DLLname(1), uc $Config{dll_name});
-like(OS2::DLLname, qr#\Q/$Config{dll_name}\E\.dll$#i );
-(my $root_cwd = $s_cwd) =~ s,/t$,,;
-like(OS2::DLLname, qr#^\Q$root_cwd\E(/t)?\Q/$Config{dll_name}\E\.dll#i );
+if (uc OS2::DLLname() eq uc $^X) {     # Static build
+  my ($short) = ($^X =~ m,.*[/\\]([^.]+),);
+  is(uc OS2::DLLname(1), uc $short);
+  is(uc OS2::DLLname, uc $^X );                # automatically
+  is(1,1);                             # automatically...
+} else {
+  is(uc OS2::DLLname(1), uc $Config{dll_name});
+  like(OS2::DLLname, qr#\Q/$Config{dll_name}\E\.dll$#i );
+  (my $root_cwd = $s_cwd) =~ s,/t$,,;
+  like(OS2::DLLname, qr#^\Q$root_cwd\E(/t)?\Q/$Config{dll_name}\E\.dll#i );
+}
 is(OS2::DLLname, OS2::DLLname(2));
 like(OS2::DLLname(0), qr#^(\d+)$# );
 
index a4145ea..accba2a 100644 (file)
@@ -687,6 +687,8 @@ enum entries_ordinals {
     ORD_WinLoadPointer,
     ORD_WinQuerySysPointer,
     ORD_DosReplaceModule,
+    ORD_DosPerfSysCall,
+    ORD_RexxRegisterSubcomExe,
     ORD_NENTRIES
 };
 
index f9cc03b..4db40a0 100644 (file)
@@ -16,14 +16,25 @@ EOU
 $idir = $Config{installbin};
 $indir =~ s|\\|/|g ;
 
+my %seen;
+
 foreach $file (<$idir/*>) {
-  next if $file =~ /\.exe/i;
+  next if $file =~ /\.(exe|bak)/i;
   $base = $file;
   $base =~ s/\.$//;            # just in case...
   $base =~ s|.*/||;
-  $file =~ s|/|\\|g ;
+  $base =~ s|\.pl$||;
+  #$file =~ s|/|\\|g ;
+  warn "Clashing output name for $file, skipping" if $seen{$base}++;
   print "Processing $file => $dir\\$base.cmd\n";
-  system 'cmd.exe', '/c', "echo extproc perl -S>$dir\\$base.cmd";
-  system 'cmd.exe', '/c', "type $file >> $dir\\$base.cmd";
+  open IN, '<', $file or warn, next;
+  open OUT, '>', "$dir/$base.cmd" or warn, next;
+  my $firstline = <IN>;
+  my $flags = '';
+  $flags = $2 if $firstline =~ /^#!\s*(\S+)\s+-([^#]+?)\s*(#|$)/;
+  print OUT "extproc perl -S$flags\n$firstline";
+  print OUT $_ while <IN>;
+  close IN or warn, next;
+  close OUT or warn, next;
 }
 
index cda36f8..f058df9 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -2875,6 +2875,10 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
      */
     f->_file = -1;
     return 1;
+#  elif defined(__EMX__)
+    /* f->_flags &= ~_IOOPEN; */       /* Will leak stream->_buffer */
+    f->_handle = -1;
+    return 1;
 #  elif defined(__CYGWIN__)
     /* There may be a better way on CYGWIN:
         - we could insert a dummy func in the _close function entry