This collects OS/2-specific patches for problems (and OS/2-specific
enhancements) which do not affect build of Perl itself, and do not affect
the test suite.

This description starts with patches to files used outside of OS/2 too; then
I document patches to OS/2-specific files.

Enjoy,
Ilya

./lib/ExtUtils/MM_Unix.pm
	"doc_inst_perl" target may get confused in absense of Makefile.PL;
 	enable parallel build of subdirs (useful due to the way static
	perl binary distribution is created).

./ext/DynaLoader/XSLoader_pm.PL
	OS/2-specific change: static build can load generic DLLs, but cannot
		load Perl extensions with DLLs

./emacs/ptags
	Assumes that `which' is present

./perl.c
	REMOVE a questionable OS/2-specific action

./util.c
	Enable multi-argument pipes

============================================
./MANIFEST
	Reflect 3 new added files: os2/os2_pipe.t os2/OS2/Process/t/os2_atoms.t
		os2/OS2/Process/t/os2_clipboard.t

./os2/os2.c
	return TRUE from OS2::* builtins, extend Perl stack for SysPerfCall,
	recognize a couple more system-error names and new entries in DevCap,
	off-by-one bug in SysInfo, pipe creation logic and DosOpen

./os2/os2_pipe.t
	New tests for pipe creation logic

./os2/os2ish.h
	Protect a declaration breaking x2p build

./os2/Makefile.SHs
	Extra dependency added, needed for "out-of-order" make commands

./os2/OS2/REXX/DLL/Changes
./os2/OS2/REXX/DLL/DLL.pm
	Extra flag for libPath_find() - find a DLL as system search does

./os2/OS2/Process/Process.pm
./os2/OS2/Process/Process.xs
	More robust handling of clipboard, more consistent return values
		from APIs, move creation of TTY from perl5db.pl to here;
	Update the docs;
	New functions os2constant(), WindowStyle(), ClipbrdText_2byte(),
		ClipbrdTextUCS2le(), ClipbrdText_set() nonlocal-exit-safe,
		ClipbrdFmtAtoms(), ClipbrdFmtNames(), MessageBoxH(),
		DeleteAtom(), DestroyAtomTable(), io_term();
		new aliases WindowBits_set(), WindowPtr_set(),
		WindowULong_set(), WindowUShort_set();
		cosmetic changes to MessageBox2(), local clipboard and
		Flushing-Window, ClipboardText would not overflow the
		shared memory region (via MemoryRegionSize()),

./os2/OS2/Process/t/os2_atoms.t
./os2/OS2/Process/t/os2_clipboard.t
	New test files

./os2/OS2/Process/t/os2_process.t
	Handle always-on-top windows in tests of window listing,

--- ./lib/ExtUtils/MM_Unix.pm.orig	Sat May 21 02:42:56 2005
+++ ./lib/ExtUtils/MM_Unix.pm	Tue Nov 28 02:56:38 2006
@@ -2490,7 +2490,7 @@ doc_inst_perl:
 		MAP_LIBPERL "$(MAP_LIBPERL)" \
 		>> }.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{
 
-};
+} if -f 'Makefile.PL';
 
     push @m, q{
 inst_perl: pure_inst_perl doc_inst_perl
@@ -3366,6 +3366,7 @@ sub test {
     }
     # note: 'test.pl' name is also hardcoded in init_dirscan()
     my(@m);
+    my $subdirs_test = ($self->{DIR} && @{$self->{DIR}} ? 'subdirs-test' : '');
     push(@m,"
 TEST_VERBOSE=0
 TEST_TYPE=test_\$(LINKTYPE)
@@ -3375,17 +3376,17 @@ TESTDB_SW = -d
 
 testdb :: testdb_\$(LINKTYPE)
 
-test :: \$(TEST_TYPE)
+test :: \$(TEST_TYPE) $subdirs_test
 ");
 
     foreach my $dir (@{ $self->{DIR} }) {
         my $test = $self->oneliner(sprintf <<'CODE', $dir);
 chdir '%s';  
-system '$(MAKE) test $(PASTHRU)' 
+system '$(MAKE) -f $(FIRST_MAKEFILE) test $(PASTHRU)' 
     if -f '$(FIRST_MAKEFILE)';
 CODE
 
-        push(@m, "\t\$(NOECHO) $test\n");
+        push(@m, "\nsubdirs-test ::\n\t\$(NOECHO) $test\n");
     }
 
     push(@m, "\t\$(NOECHO) \$(ECHO) 'No tests defined for \$(NAME) extension.'\n")
--- ./ext/DynaLoader/XSLoader_pm.PL-pre-build	Sun Oct 16 06:50:04 2005
+++ ./ext/DynaLoader/XSLoader_pm.PL	Tue Nov 28 02:42:26 2006
@@ -62,6 +62,13 @@ print OUT <<'EOT' if defined &DynaLoader
 
 EOT
 
+print OUT <<'EOT' if $^O eq 'os2';
+
+    # os2 static build 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 $modpname = join('/',@modparts);
     my $modlibname = (caller())[1];
diff -pru perl-5.8.7-min-patched/emacs/ptags perl-5.8.7-patched/emacs/ptags
--- perl-5.8.7-min-patched/emacs/ptags	Wed Sep 10 21:12:22 2003
+++ perl-5.8.7-patched/emacs/ptags	Mon Nov 27 20:59:04 2006
@@ -36,7 +36,7 @@ case "$1" in
     echo "Building TAGS with relative paths"
 esac
 
-emacs=`(which emacs || which xemacs) 2>/dev/null`
+emacs=`(which emacs || which xemacs || echo emacs) 2>/dev/null`
 [ -x "$emacs" ] || { echo "can't find emacs or xemacs in PATH"; exit 1; }
 
 # Insure proper order (.h after .c, .xs before .c in subdirs):
diff -pru perl-5.8.7-min-patched/perl.c perl-5.8.7-patched/perl.c
--- perl-5.8.7-min-patched/perl.c	Fri Apr 22 07:14:26 2005
+++ perl-5.8.7-patched/perl.c	Mon Nov 27 20:59:10 2006
@@ -1235,11 +1235,7 @@ setuid perl scripts securely.\n");
 	 }
 	 /* Can we grab env area too to be used as the area for $0? */
 	 if (PL_origenviron) {
-	      if ((PL_origenviron[0] == s + 1
-#ifdef OS2
-		   || (PL_origenviron[0] == s + 9 && (s += 8))
-#endif 
-		  )
+	      if ((PL_origenviron[0] == s + 1)
 		  ||
 		  (aligned &&
 		   (PL_origenviron[0] >  s &&
@@ -1247,7 +1243,7 @@ setuid perl scripts securely.\n");
 		    INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask)))
 		 )
 	      {
-#ifndef OS2
+#ifndef OS2		/* ENVIRON is read by the kernel too. */
 		   s = PL_origenviron[0];
 		   while (*s) s++;
 #endif
diff -pru perl-5.8.7-min-patched/util.c perl-5.8.7-patched/util.c
--- perl-5.8.7-min-patched/util.c	Mon May 30 05:44:14 2005
+++ perl-5.8.7-patched/util.c	Mon Nov 27 20:59:12 2006
@@ -2071,8 +2071,12 @@ Perl_my_popen_list(pTHX_ char *mode, int
 	 PerlLIO_close(pp[0]);
     return PerlIO_fdopen(p[This], mode);
 #else
+#  ifdef OS2	/* Same, without fork()ing and all extra overhead... */
+    return my_syspopen4(aTHX_ Nullch, mode, n, args);
+#  else
     Perl_croak(aTHX_ "List form of piped open not implemented");
     return (PerlIO *) NULL;
+#  endif
 #endif
 }
 
--- ./MANIFEST-ini	Tue Jan 31 15:27:52 2006
+++ ./MANIFEST	Mon Dec 18 00:41:10 2006
@@ -2205,6 +2205,7 @@ os2/dl_os2.c			Addon for dl_open
 os2/Makefile.SHs		Shared library generation for OS/2
 os2/os2add.sym			Overriding symbols to export
 os2/os2_base.t			Additional tests for builtin methods
+os2/os2_pipe.t			Tests for pipe creation logic
 os2/os2.c			Additional code for OS/2
 os2/OS2/ExtAttr/Changes		EA access module
 os2/OS2/ExtAttr/ExtAttr.pm	EA access module
@@ -2228,6 +2229,8 @@ os2/OS2/Process/Process.xs	system() cons
 os2/OS2/Process/t/os2_process_kid.t	Tests
 os2/OS2/Process/t/os2_process.t	Tests
 os2/OS2/Process/t/os2_process_text.t	Tests
+os2/OS2/Process/t/os2_atoms.t		Test for OS2::Process
+os2/OS2/Process/t/os2_clipboard.t	Test for OS2::Process
 os2/OS2/REXX/Changes		DLL access module
 os2/OS2/REXX/DLL/Changes	DLL access module
 os2/OS2/REXX/DLL/DLL.pm		DLL access module
--- perl-5.8.8/os2.c.orig-a	Fri Jul  8 08:56:16 2005
+++ perl-5.8.8/os2.c	Tue Dec 12 22:31:02 2006
@@ -490,7 +490,7 @@ os2_cond_wait(perl_cond *c, perl_mutex *
     int rc;
     STRLEN n_a;
     if ((rc = DosResetEventSem(*c,&n_a)) && (rc != ERROR_ALREADY_RESET))
-	Perl_rc = rc, croak_with_os2error("panic: COND_WAIT-reset");
+	Perl_rc = CheckOSError(rc), croak_with_os2error("panic: COND_WAIT-reset");
     if (m) MUTEX_UNLOCK(m);					
     if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT))
 	&& (rc != ERROR_INTERRUPT))
@@ -1469,42 +1469,47 @@ do_spawn3(pTHX_ char *cmd, int execf, in
     return rc;
 }
 
+#define ASPAWN_WAIT	0
+#define ASPAWN_EXEC	1
+#define ASPAWN_NOWAIT	2
+
 /* Array spawn/exec.  */
 int
-os2_aspawn4(pTHX_ SV *really, register SV **vmark, register SV **vsp, int execing)
+os2_aspawn_4(pTHX_ SV *really, register SV **args, I32 cnt, int execing)
 {
-    register SV **mark = (SV **)vmark;
-    register SV **sp = (SV **)vsp;
+    register SV **argp = (SV **)args;
+    register SV **last = argp + cnt;
     register char **a;
     int rc;
     int flag = P_WAIT, flag_set = 0;
     STRLEN n_a;
 
-    if (sp > mark) {
-	Newx(PL_Argv, sp - mark + 3, char*);
+    if (cnt) {
+	Newx(PL_Argv, cnt + 3, char*); /* 3 extra to expand #! */
 	a = PL_Argv;
 
-	if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
-		++mark;
-		flag = SvIVx(*mark);
-		flag_set = 1;
-
-	}
+	if (cnt > 1 && SvNIOKp(*argp) && !SvPOKp(*argp)) {
+	    flag = SvIVx(*argp);
+	    flag_set = 1;
+	} else
+	    --argp;
 
-	while (++mark <= sp) {
-	    if (*mark)
-		*a++ = SvPVx(*mark, n_a);
+	while (++argp < last) {
+	    if (*argp)
+		*a++ = SvPVx(*argp, n_a);
 	    else
 		*a++ = "";
 	}
 	*a = Nullch;
 
 	if ( flag_set && (a == PL_Argv + 1)
-	     && !really && !execing ) { 		/* One arg? */
+	     && !really && execing == ASPAWN_WAIT ) { 		/* One arg? */
 	    rc = do_spawn3(aTHX_ a[-1], EXECF_SPAWN_BYFLAG, flag);
-	} else
-	    rc = do_spawn_ve(aTHX_ really, flag,
-			     (execing ? EXECF_EXEC : EXECF_SPAWN), NULL, 0);
+	} else {
+	    const int execf[3] = {EXECF_SPAWN, EXECF_EXEC, EXECF_SPAWN_NOWAIT};
+	    
+	    rc = do_spawn_ve(aTHX_ really, flag, execf[execing], NULL, 0);
+	}
     } else
     	rc = -1;
     do_execfree();
@@ -1515,14 +1520,14 @@ os2_aspawn4(pTHX_ SV *really, register S
 int
 os2_do_aspawn(pTHX_ SV *really, register SV **vmark, register SV **vsp)
 {
-    return os2_aspawn4(aTHX_ really, vmark, vsp, 0);
+    return os2_aspawn_4(aTHX_ really, vmark + 1, vsp - vmark, ASPAWN_WAIT);
 }
 
 /* Array exec.  */
 bool
 Perl_do_aexec(pTHX_ SV* really, SV** vmark, SV** vsp)
 {
-    return os2_aspawn4(aTHX_ really, vmark, vsp, 1);
+    return os2_aspawn_4(aTHX_ really, vmark + 1, vsp - vmark, ASPAWN_EXEC);
 }
 
 int
@@ -1551,7 +1556,7 @@ os2exec(pTHX_ char *cmd)
 }
 
 PerlIO *
-my_syspopen(pTHX_ char *cmd, char *mode)
+my_syspopen4(pTHX_ char *cmd, char *mode, I32 cnt, SV** args)
 {
 #ifndef USE_POPEN
     int p[2];
@@ -1599,7 +1604,10 @@ my_syspopen(pTHX_ char *cmd, char *mode)
     fcntl(p[this], F_SETFD, FD_CLOEXEC);
     if (newfd != -1)
 	fcntl(newfd, F_SETFD, FD_CLOEXEC);
-    pid = do_spawn_nowait(aTHX_ cmd);
+    if (cnt) {	/* Args: "Real cmd", before first arg, the last, execing */
+	pid = os2_aspawn_4(aTHX_ Nullsv, args, cnt, ASPAWN_NOWAIT);
+    } else
+	pid = do_spawn_nowait(aTHX_ cmd);
     if (newfd == -1)
 	close(*mode == 'r');		/* It was closed initially */
     else if (newfd != (*mode == 'r')) {	/* Probably this check is not needed */
@@ -1630,6 +1638,9 @@ my_syspopen(pTHX_ char *cmd, char *mode)
     PerlIO *res;
     SV *sv;
 
+    if (cnt)
+	Perl_croak(aTHX_ "List form of piped open not implemented");
+
 #  ifdef TRYSHELL
     res = popen(cmd, mode);
 #  else
@@ -1648,6 +1659,12 @@ my_syspopen(pTHX_ char *cmd, char *mode)
 
 }
 
+PerlIO *
+my_syspopen(pTHX_ char *cmd, char *mode)
+{
+    return my_syspopen4(aTHX_ cmd, mode, 0, NULL);
+}
+
 /******************************************************************/
 
 #ifndef HAS_FORK
@@ -1868,7 +1885,7 @@ XS(XS_OS2_replaceModule)
 	if (!replaceModule(target, source, backup))
 	    croak_with_os2error("replaceModule() error");
     }
-    XSRETURN_EMPTY;
+    XSRETURN_YES;
 }
 
 /* APIRET APIENTRY DosPerfSysCall(ULONG ulCommand, ULONG ulParm1,
@@ -1955,6 +1972,7 @@ XS(XS_OS2_perfSysCall)
 	RETVAL = perfSysCall(ulCommand, ulParm1, ulParm2, ulParm3);
 	if (!RETVAL)
 	    croak_with_os2error("perfSysCall() error");
+	XSprePUSH;
 	if (total) {
 	    int i,j;
 
@@ -1962,6 +1980,7 @@ XS(XS_OS2_perfSysCall)
 		PUSHn(u[0][0]);		/* Total ticks on the first processor */
 		XSRETURN(1);
 	    }
+	    EXTEND(SP, 4*total);
 	    for (i=0; i < total; i++)
 		for (j=0; j < 4; j++)
 		    PUSHs(sv_2mortal(newSVnv(u[i][j])));
@@ -2087,6 +2106,21 @@ os2error(int rc)
 	    case PMERR_NOT_IN_A_PM_SESSION:
 		name = "PMERR_NOT_IN_A_PM_SESSION";
 		break;
+	    case PMERR_INVALID_ATOM:
+		name = "PMERR_INVALID_ATOM";
+		break;
+	    case PMERR_INVALID_HATOMTBL:
+		name = "PMERR_INVALID_HATOMTMB";
+		break;
+	    case PMERR_INVALID_INTEGER_ATOM:
+		name = "PMERR_INVALID_INTEGER_ATOM";
+		break;
+	    case PMERR_INVALID_ATOM_NAME:
+		name = "PMERR_INVALID_ATOM_NAME";
+		break;
+	    case PMERR_ATOM_NAME_NOT_FOUND:
+		name = "PMERR_ATOM_NAME_NOT_FOUND";
+		break;
 	    }
 	    sprintf(s, "%s%s[No description found in OSO001.MSG]", 
 		    name, (*name ? "=" : ""));
@@ -2699,7 +2733,7 @@ XS(XS_OS2_ms_sleep)		/* for testing only
     ms = SvUV(ST(0));
     lim = items > 1 ? SvUV(ST(1)) : ms + 1;
     async_mssleep(ms, lim);
-    XSRETURN_EMPTY;
+    XSRETURN_YES;
 }
 
 ULONG (*pDosTmrQueryFreq) (PULONG);
@@ -2866,20 +2900,35 @@ XS(XS_OS2_DevCap)
 					  - CAPS_FAMILY + 1,
 					si)))
 	    rc1 = Perl_rc;
+	else {
+	    EXTEND(SP,2*(CAPS_DEVICE_POLYSET_POINTS - CAPS_FAMILY + 1));
+	    while (i < CAPS_DEVICE_POLYSET_POINTS - CAPS_FAMILY + 1) {
+		ST(j) = sv_newmortal();
+		sv_setpv(ST(j++), dc_fields[i]);
+		ST(j) = sv_newmortal();
+		sv_setiv(ST(j++), si[i]);
+		i++;
+	    }
+	    i = CAPS_DEVICE_POLYSET_POINTS + 1;
+	    while (i < CAPS_DEVICE_POLYSET_POINTS + 11) { /* Just in case... */
+		LONG l;
+
+		if (CheckWinError(pDevQueryCaps(hScreenDC, i, 1, &l)))
+		    break;
+		EXTEND(SP, j + 2);
+		ST(j) = sv_newmortal();
+		sv_setiv(ST(j++), i);
+		ST(j) = sv_newmortal();
+		sv_setiv(ST(j++), l);
+		i++;
+	    }	    
+	}
 	if (!items && CheckWinError(pDevCloseDC(hScreenDC)))
 	    Perl_warn_nocontext("DevCloseDC() failed: %s", os2error(Perl_rc));
 	if (rc1)
 	    Perl_rc = rc1, croak_with_os2error("DevQueryCaps() failed");
-	EXTEND(SP,2*(CAPS_DEVICE_POLYSET_POINTS - CAPS_FAMILY + 1));
-	while (i < CAPS_DEVICE_POLYSET_POINTS - CAPS_FAMILY + 1) {
-	    ST(j) = sv_newmortal();
-	    sv_setpv(ST(j++), dc_fields[i]);
-	    ST(j) = sv_newmortal();
-	    sv_setiv(ST(j++), si[i]);
-	    i++;
-	}
+	XSRETURN(j);
     }
-    XSRETURN(2 * (CAPS_DEVICE_POLYSET_POINTS - CAPS_FAMILY + 1));
 }
 
 LONG (*pWinQuerySysValue) (HWND hwndDesktop, LONG iSysValue);
@@ -3077,7 +3126,7 @@ XS(XS_OS2_SysValues_set)
 	if (CheckWinError(pWinSetSysValue(hwnd, which, val)))
 	    croak_with_os2error("SysValues_set()");
     }
-    XSRETURN_EMPTY;
+    XSRETURN_YES;
 }
 
 #define QSV_MAX_WARP3				QSV_MAX_COMP_LENGTH
@@ -3132,7 +3181,7 @@ XS(XS_OS2_SysInfo)
 					 (PVOID)si,
 					 sizeof(si))))
 	    croak_with_os2error("DosQuerySysInfo() failed");
-	while (last++ <= C_ARRAY_LENGTH(si)) {
+	while (++last <= C_ARRAY_LENGTH(si)) {
 	    if (CheckOSError(DosQuerySysInfo(last, last, /* One entry only */
 					     (PVOID)(si+last-1),
 					     sizeof(*si)))) {
@@ -3141,13 +3190,16 @@ XS(XS_OS2_SysInfo)
 		break;
 	    }
 	}
-	last--;
+	last--;			/* Count of successfully processed offsets */
 	EXTEND(SP,2*last);
 	while (i < last) {
 	    ST(j) = sv_newmortal();
-	    sv_setpv(ST(j++), si_fields[i]);
+	    if (i < C_ARRAY_LENGTH(si_fields))
+		sv_setpv(ST(j++),  si_fields[i]);
+	    else
+		sv_setiv(ST(j++),  i + 1);
 	    ST(j) = sv_newmortal();
-	    sv_setiv(ST(j++), si[i]);
+	    sv_setuv(ST(j++), si[i]);
 	    i++;
 	}
 	XSRETURN(2 * last);
@@ -3219,7 +3271,7 @@ XS(XS_OS2_Beep)
 	if (CheckOSError(DosBeep(freq, ms)))
 	    croak_with_os2error("SysValues_set()");
     }
-    XSRETURN_EMPTY;
+    XSRETURN_YES;
 }
 
 
@@ -3919,7 +3971,7 @@ XS(XS_OS2_mytype_set)
     else
 	Perl_croak(aTHX_ "Usage: OS2::mytype_set(type)");
     my_type_set(type);
-    XSRETURN_EMPTY;
+    XSRETURN_YES;
 }
 
 
@@ -3990,6 +4042,459 @@ XS(XS_OS2_incrMaxFHandles)		/* DosSetRel
     XSRETURN(1);
 }
 
+/* wait>0: force wait, wait<0: force nowait;
+   if restore, save/restore flags; otherwise flags are in oflags.
+
+   Returns 1 if connected, 0 if not (due to nowait); croaks on error. */
+static ULONG
+connectNPipe(ULONG hpipe, int wait, ULONG restore, ULONG oflags)
+{
+    ULONG ret = ERROR_INTERRUPT, rc, flags;
+
+    if (restore && wait)
+	os2cp_croak(DosQueryNPHState(hpipe, &oflags), "DosQueryNPHState()");
+    /* DosSetNPHState fails if more bits than NP_NOWAIT|NP_READMODE_MESSAGE */
+    oflags &= (NP_NOWAIT | NP_READMODE_MESSAGE);
+    flags = (oflags & ~NP_NOWAIT) | (wait > 0 ? NP_WAIT : NP_NOWAIT);
+    /* We know (o)flags unless wait == 0 && restore */
+    if (wait && (flags != oflags))
+	os2cp_croak(DosSetNPHState(hpipe, flags), "DosSetNPHState()");
+    while (ret == ERROR_INTERRUPT)
+	ret = DosConnectNPipe(hpipe);
+    (void)CheckOSError(ret);
+    if (restore && wait && (flags != oflags))
+	os2cp_croak(DosSetNPHState(hpipe, oflags), "DosSetNPHState() back");
+    /* We know flags unless wait == 0 && restore */
+    if ( ((wait || restore) ? (flags & NP_NOWAIT) : 1)
+	 && (ret == ERROR_PIPE_NOT_CONNECTED) )
+	return 0;			/* normal return value */
+    if (ret == NO_ERROR)
+	return 1;
+    croak_with_os2error("DosConnectNPipe()");
+}
+
+/* With a lot of manual editing:
+NO_OUTPUT ULONG
+DosCreateNPipe(PCSZ pszName, OUTLIST HPIPE hpipe, ULONG ulOpenMode, int connect = 1, int count = 1, ULONG ulInbufLength = 8192, ULONG ulOutbufLength = ulInbufLength, ULONG ulPipeMode = count | NP_NOWAIT | NP_TYPE_BYTE | NP_READMODE_BYTE, ULONG ulTimeout = 0)
+   PREINIT:
+	ULONG rc;
+   C_ARGS:
+	pszName, &hpipe, ulOpenMode, ulPipeMode, ulInbufLength, ulOutbufLength, ulTimeout
+   POSTCALL:
+	if (CheckOSError(RETVAL))
+	    croak_with_os2error("OS2::mkpipe() error");
+*/
+XS(XS_OS2_pipe); /* prototype to pass -Wmissing-prototypes */
+XS(XS_OS2_pipe)
+{
+    dXSARGS;
+    if (items < 2 || items > 8)
+	Perl_croak(aTHX_ "Usage: OS2::pipe(pszName, ulOpenMode, connect= 1, count= 1, ulInbufLength= 8192, ulOutbufLength= ulInbufLength, ulPipeMode= count | NP_NOWAIT | NP_TYPE_BYTE | NP_READMODE_BYTE, ulTimeout= 0)");
+    {
+	ULONG	RETVAL;
+	PCSZ	pszName = ( SvOK(ST(0)) ? (PCSZ)SvPV(ST(0),PL_na) : NULL );
+	HPIPE	hpipe;
+	SV	*OpenMode = ST(1);
+	ULONG	ulOpenMode;
+	int	connect = 0, count, message_r = 0, message = 0, b = 0;
+	ULONG	ulInbufLength,	ulOutbufLength,	ulPipeMode, ulTimeout, rc;
+	STRLEN	len;
+	char	*s, buf[10], *s1, *perltype = Nullch;
+	PerlIO	*perlio;
+	double	timeout;
+
+	if (!pszName || !*pszName)
+	    Perl_croak(aTHX_ "OS2::pipe(): empty pipe name");
+	s = SvPV(OpenMode, len);
+	if (len == 4 && strEQ(s, "wait")) {	/* DosWaitNPipe() */
+	    ULONG ms = 0xFFFFFFFF, ret = ERROR_INTERRUPT; /* Indefinite */
+
+	    if (items == 3) {
+		timeout = (double)SvNV(ST(2));
+		ms = timeout * 1000;
+		if (timeout < 0)
+		    ms = 0xFFFFFFFF; /* Indefinite */
+		else if (timeout && !ms)
+		    ms = 1;
+	    } else if (items > 3)
+		Perl_croak(aTHX_ "OS2::pipe(): too many arguments for wait-for-connect: %ld", (long)items);
+
+	    while (ret == ERROR_INTERRUPT)
+		ret = DosWaitNPipe(pszName, ms);	/* XXXX Update ms? */
+	    os2cp_croak(ret, "DosWaitNPipe()");
+	    XSRETURN_YES;
+	}
+	if (len == 4 && strEQ(s, "call")) {	/* DosCallNPipe() */
+	    ULONG ms = 0xFFFFFFFF, got; /* Indefinite */
+	    STRLEN l;
+	    char *s;
+	    char buf[8192];
+	    STRLEN ll = sizeof(buf);
+	    char *b = buf;
+
+	    if (items < 3 || items > 5)
+		Perl_croak(aTHX_ "usage: OS2::pipe(pszName, 'call', write [, timeout= 0xFFFFFFFF, buffsize = 8192])");
+	    s = SvPV(ST(2), l);
+	    if (items >= 4) {
+		timeout = (double)SvNV(ST(3));
+		ms = timeout * 1000;
+		if (timeout < 0)
+		    ms = 0xFFFFFFFF; /* Indefinite */
+		else if (timeout && !ms)
+		    ms = 1;
+	    }
+	    if (items >= 5) {
+		STRLEN lll = SvUV(ST(4));
+		SV *sv = NEWSV(914, lll);
+
+		sv_2mortal(sv);
+		ll = lll;
+		b = SvPVX(sv);
+	    }	    
+
+	    os2cp_croak(DosCallNPipe(pszName, s, l, b, ll, &got, ms),
+			"DosCallNPipe()");
+	    XSRETURN_PVN(b, got);
+	}
+	s1 = buf;
+	if (len && len <= 3 && !(*s >= '0' && *s <= '9')) {
+	    int r, w, R, W;
+
+	    r = strchr(s, 'r') != 0;
+	    w = strchr(s, 'w') != 0;
+	    R = strchr(s, 'R') != 0;
+	    W = strchr(s, 'W') != 0;
+	    b = strchr(s, 'b') != 0;
+	    if (r + w + R + W + b != len || (r && R) || (w && W))
+		Perl_croak(aTHX_ "OS2::pipe(): unknown OpenMode argument: `%s'", s);
+	    if ((r || R) && (w || W))
+		ulOpenMode = NP_INHERIT | NP_NOWRITEBEHIND | NP_ACCESS_DUPLEX;
+	    else if (r || R)
+		ulOpenMode = NP_INHERIT | NP_NOWRITEBEHIND | NP_ACCESS_INBOUND;
+	    else
+		ulOpenMode = NP_INHERIT | NP_NOWRITEBEHIND | NP_ACCESS_OUTBOUND;
+	    if (R)
+		message = message_r = 1;
+	    if (W)
+		message = 1;
+	    else if (w && R)
+		Perl_croak(aTHX_ "OS2::pipe(): can't have message read mode for non-message pipes");
+	} else
+	    ulOpenMode = (ULONG)SvUV(OpenMode);	/* ST(1) */
+
+	if ( (ulOpenMode & 0x3) == NP_ACCESS_DUPLEX
+	     || (ulOpenMode & 0x3) == NP_ACCESS_INBOUND )
+	    *s1++ = 'r';
+	if ( (ulOpenMode & 0x3) == NP_ACCESS_DUPLEX )
+	    *s1++ = '+';
+	if ( (ulOpenMode & 0x3) == NP_ACCESS_OUTBOUND )
+	    *s1++ = 'w';
+	if (b)
+	    *s1++ = 'b';
+	*s1 = 0;
+	if ( (ulOpenMode & 0x3) == NP_ACCESS_DUPLEX )
+	    perltype = "+<&";
+	else if ( (ulOpenMode & 0x3) == NP_ACCESS_OUTBOUND )
+	    perltype = ">&";
+	else
+	    perltype = "<&";
+
+	if (items < 3)
+	    connect = -1;			/* no wait */
+	else if (SvTRUE(ST(2))) {
+	    s = SvPV(ST(2), len);
+	    if (len == 6 && strEQ(s, "nowait"))
+		connect = -1;			/* no wait */
+	    else if (len == 4 && strEQ(s, "wait"))
+		connect = 1;			/* wait */
+	    else
+		Perl_croak(aTHX_ "OS2::pipe(): unknown connect argument: `%s'", s);
+	}
+
+	if (items < 4)
+	    count = 1;
+	else
+	    count = (int)SvIV(ST(3));
+
+	if (items < 5)
+	    ulInbufLength = 8192;
+	else
+	    ulInbufLength = (ULONG)SvUV(ST(4));
+
+	if (items < 6)
+	    ulOutbufLength = ulInbufLength;
+	else
+	    ulOutbufLength = (ULONG)SvUV(ST(5));
+
+	if (count < -1 || count == 0 || count >= 255)
+	    Perl_croak(aTHX_ "OS2::pipe(): count should be -1 or between 1 and 254: %ld", (long)count);
+	if (count < 0 )
+	    count = 255;		/* Unlimited */
+
+	ulPipeMode = count;
+	if (items < 7)
+	    ulPipeMode |= (NP_WAIT 
+			   | (message ? NP_TYPE_MESSAGE : NP_TYPE_BYTE)
+			   | (message_r ? NP_READMODE_MESSAGE : NP_READMODE_BYTE));
+	else
+	    ulPipeMode |= (ULONG)SvUV(ST(6));
+
+	if (items < 8)
+	    timeout = 0;
+	else
+	    timeout = (double)SvNV(ST(7));
+	ulTimeout = timeout * 1000;
+	if (timeout < 0)
+	    ulTimeout = 0xFFFFFFFF; /* Indefinite */
+	else if (timeout && !ulTimeout)
+	    ulTimeout = 1;
+
+	RETVAL = DosCreateNPipe(pszName, &hpipe, ulOpenMode, ulPipeMode, ulInbufLength, ulOutbufLength, ulTimeout);
+	if (CheckOSError(RETVAL))
+	    croak_with_os2error("OS2::pipe(): DosCreateNPipe() error");
+
+	if (connect)
+	    connectNPipe(hpipe, connect, 1, 0);	/* XXXX wait, retval */
+	hpipe = __imphandle(hpipe);
+
+	perlio = PerlIO_fdopen(hpipe, buf);
+	ST(0) = sv_newmortal();
+	{
+	    GV *gv = newGVgen("OS2::pipe");
+	    if ( do_open(gv, perltype, strlen(perltype), FALSE, 0, 0, perlio) )
+		sv_setsv(ST(0), sv_bless(newRV((SV*)gv), gv_stashpv("IO::Handle",1)));
+	    else
+		ST(0) = &PL_sv_undef;
+	}
+    }
+    XSRETURN(1);
+}
+
+XS(XS_OS2_pipeCntl); /* prototype to pass -Wmissing-prototypes */
+XS(XS_OS2_pipeCntl)
+{
+    dXSARGS;
+    if (items < 2 || items > 3)
+	Perl_croak(aTHX_ "Usage: OS2::pipeCntl(pipe, op [, wait])");
+    {
+	ULONG	rc;
+	PerlIO *perlio = IoIFP(sv_2io(ST(0)));
+	IV	fn = PerlIO_fileno(perlio);
+	HPIPE	hpipe = (HPIPE)fn;
+	STRLEN	len;
+	char	*s = SvPV(ST(1), len);
+	int	wait = 0, disconnect = 0, connect = 0, message = -1, query = 0;
+	int	peek = 0, state = 0, info = 0;
+
+	if (fn < 0)
+	    Perl_croak(aTHX_ "OS2::pipeCntl(): not a pipe");	
+	if (items == 3)
+	    wait = (SvTRUE(ST(2)) ? 1 : -1);
+
+	switch (len) {
+	case 4:
+	    if (strEQ(s, "byte"))
+		message = 0;
+	    else if (strEQ(s, "peek"))
+		peek = 1;
+	    else if (strEQ(s, "info"))
+		info = 1;
+	    else
+		goto unknown;
+	    break;
+	case 5:
+	    if (strEQ(s, "reset"))
+		disconnect = connect = 1;
+	    else if (strEQ(s, "state"))
+		query = 1;
+	    else
+		goto unknown;
+	    break;
+	case 7:
+	    if (strEQ(s, "connect"))
+		connect = 1;
+	    else if (strEQ(s, "message"))
+		message = 1;
+	    else
+		goto unknown;
+	    break;
+	case 9:
+	    if (!strEQ(s, "readstate"))
+		goto unknown;
+	    state = 1;
+	    break;
+	case 10:
+	    if (!strEQ(s, "disconnect"))
+		goto unknown;
+	    disconnect = 1;
+	    break;
+	default:
+	  unknown:
+	    Perl_croak(aTHX_ "OS2::pipeCntl(): unknown argument: `%s'", s);
+	    break;
+	}
+
+	if (items == 3 && !connect)
+	    Perl_croak(aTHX_ "OS2::pipeCntl(): no wait argument for `%s'", s);
+
+	XSprePUSH;		/* Do not need arguments any more */
+	if (disconnect) {
+	    os2cp_croak(DosDisConnectNPipe(hpipe), "OS2::pipeCntl(): DosDisConnectNPipe()");
+	    PerlIO_clearerr(perlio);
+	}
+	if (connect) {
+	    if (!connectNPipe(hpipe, wait , 1, 0))
+		XSRETURN_IV(-1);
+	}
+	if (query) {
+	    ULONG flags;
+
+	    os2cp_croak(DosQueryNPHState(hpipe, &flags), "DosQueryNPHState()");
+	    XSRETURN_UV(flags);
+	}
+	if (peek || state || info) {
+	    ULONG BytesRead, PipeState;
+	    AVAILDATA BytesAvail;
+
+	    os2cp_croak( DosPeekNPipe(hpipe, NULL, 0, &BytesRead, &BytesAvail,
+				      &PipeState), "DosPeekNPipe() for state");
+	    if (state) {
+		EXTEND(SP, 3);
+		PUSHs(newSVuv(PipeState));
+		/*   Bytes (available/in-message) */
+		PUSHs(newSViv(BytesAvail.cbpipe));
+		PUSHs(newSViv(BytesAvail.cbmessage));
+		XSRETURN(3);
+	    } else if (info) {
+		/* L S S C C C/Z*
+		   ID of the (remote) computer
+		   buffers (out/in)
+		   instances (max/actual)
+		 */
+		struct pipe_info_t {
+		    ULONG id;			/* char id[4]; */
+		    PIPEINFO pInfo;
+		    char buf[512];
+		} b;
+		int size;
+
+		os2cp_croak( DosQueryNPipeInfo(hpipe, 1, &b.pInfo, sizeof(b) - STRUCT_OFFSET(struct pipe_info_t, pInfo)),
+			     "DosQueryNPipeInfo(1)");
+		os2cp_croak( DosQueryNPipeInfo(hpipe, 2, &b.id, sizeof(b.id)),
+			     "DosQueryNPipeInfo(2)");
+		size = b.pInfo.cbName;
+		/* Trailing 0 is included in cbName - undocumented; so
+		   one should always extract with Z* */
+		if (size)		/* name length 254 or less */
+		    size--;
+		else
+		    size = strlen(b.pInfo.szName);
+		EXTEND(SP, 6);
+		PUSHs(newSVpvn(b.pInfo.szName, size));
+		PUSHs(newSVuv(b.id));
+		PUSHs(newSViv(b.pInfo.cbOut));
+		PUSHs(newSViv(b.pInfo.cbIn));
+		PUSHs(newSViv(b.pInfo.cbMaxInst));
+		PUSHs(newSViv(b.pInfo.cbCurInst));
+		XSRETURN(6);
+	    } else if (BytesAvail.cbpipe == 0) {
+		XSRETURN_NO;
+	    } else {
+		SV *tmp = NEWSV(914, BytesAvail.cbpipe);
+		char *s = SvPVX(tmp);
+
+		sv_2mortal(tmp);
+		os2cp_croak( DosPeekNPipe(hpipe, s, BytesAvail.cbpipe, &BytesRead,
+					  &BytesAvail, &PipeState), "DosPeekNPipe()");
+		SvCUR_set(tmp, BytesRead);
+		*SvEND(tmp) = 0;
+		SvPOK_on(tmp);
+		XSprePUSH; PUSHs(tmp);
+		XSRETURN(1);
+	    }
+	}
+	if (message > -1) {
+	    ULONG oflags, flags;
+
+	    os2cp_croak(DosQueryNPHState(hpipe, &oflags), "DosQueryNPHState()");
+	    /* DosSetNPHState fails if more bits than NP_NOWAIT|NP_READMODE_MESSAGE */
+	    oflags &= (NP_NOWAIT | NP_READMODE_MESSAGE);
+	    flags = (oflags & NP_NOWAIT)
+		| (message ? NP_READMODE_MESSAGE : NP_READMODE_BYTE);
+	    if (flags != oflags)
+		os2cp_croak(DosSetNPHState(hpipe, flags), "DosSetNPHState()");
+	}
+    }
+    XSRETURN_YES;
+}
+
+/*
+NO_OUTPUT ULONG
+DosOpen(PCSZ pszFileName, OUTLIST HFILE hFile, OUTLIST ULONG ulAction, ULONG ulOpenFlags, ULONG ulOpenMode = OPEN_ACTION_OPEN_IF_EXISTS | OPEN_ACTION_FAIL_IF_NEW, ULONG ulAttribute = FILE_NORMAL, ULONG ulFileSize = 0, PEAOP2 pEABuf = NULL);
+   PREINIT:
+	ULONG rc;
+   C_ARGS:
+	pszFileName, &hFile, &ulAction, ulFileSize, ulAttribute, ulOpenFlags, ulOpenMode, pEABuf
+   POSTCALL:
+	if (CheckOSError(RETVAL))
+	    croak_with_os2error("OS2::open() error");
+*/
+XS(XS_OS2_open); /* prototype to pass -Wmissing-prototypes */
+XS(XS_OS2_open)
+{
+    dXSARGS;
+    if (items < 2 || items > 6)
+	Perl_croak(aTHX_ "Usage: OS2::open(pszFileName, ulOpenMode, ulOpenFlags= OPEN_ACTION_OPEN_IF_EXISTS | OPEN_ACTION_FAIL_IF_NEW, ulAttribute= FILE_NORMAL, ulFileSize= 0, pEABuf= NULL)");
+    {
+#line 39 "pipe.xs"
+	ULONG rc;
+#line 113 "pipe.c"
+	ULONG	RETVAL;
+	PCSZ	pszFileName = ( SvOK(ST(0)) ? (PCSZ)SvPV(ST(0),PL_na) : NULL );
+	HFILE	hFile;
+	ULONG	ulAction;
+	ULONG	ulOpenMode = (ULONG)SvUV(ST(1));
+	ULONG	ulOpenFlags;
+	ULONG	ulAttribute;
+	ULONG	ulFileSize;
+	PEAOP2	pEABuf;
+
+	if (items < 3)
+	    ulOpenFlags = OPEN_ACTION_OPEN_IF_EXISTS | OPEN_ACTION_FAIL_IF_NEW;
+	else {
+	    ulOpenFlags = (ULONG)SvUV(ST(2));
+	}
+
+	if (items < 4)
+	    ulAttribute = FILE_NORMAL;
+	else {
+	    ulAttribute = (ULONG)SvUV(ST(3));
+	}
+
+	if (items < 5)
+	    ulFileSize = 0;
+	else {
+	    ulFileSize = (ULONG)SvUV(ST(4));
+	}
+
+	if (items < 6)
+	    pEABuf = NULL;
+	else {
+	    pEABuf = (PEAOP2)SvUV(ST(5));
+	}
+
+	RETVAL = DosOpen(pszFileName, &hFile, &ulAction, ulFileSize, ulAttribute, ulOpenFlags, ulOpenMode, pEABuf);
+	if (CheckOSError(RETVAL))
+	    croak_with_os2error("OS2::open() error");
+	XSprePUSH;	EXTEND(SP,2);
+	PUSHs(sv_newmortal());
+	sv_setuv(ST(0), (UV)hFile);
+	PUSHs(sv_newmortal());
+	sv_setuv(ST(1), (UV)ulAction);
+    }
+    XSRETURN(2);
+}
+
 int
 Xs_OS2_init(pTHX)
 {
@@ -4041,6 +4546,9 @@ Xs_OS2_init(pTHX)
         newXSproto("OS2::SysValues", XS_OS2_SysValues, file, ";$$");
         newXSproto("OS2::SysValues_set", XS_OS2_SysValues_set, file, "$$;$");
         newXSproto("OS2::Beep", XS_OS2_Beep, file, ";$$");
+        newXSproto("OS2::pipe", XS_OS2_pipe, file, "$$;$$$$$$");
+        newXSproto("OS2::pipeCntl", XS_OS2_pipeCntl, file, "$$;$");
+        newXSproto("OS2::open", XS_OS2_open, file, "$$;$$$$");
 	gv = gv_fetchpv("OS2::is_aout", TRUE, SVt_PV);
 	GvMULTI_on(gv);
 #ifdef PERL_IS_AOUT
diff -pru perl-5.8.7-min-patched/os2/os2_pipe.t perl-5.8.7-patched/os2/os2_pipe.t
--- ./os2/os2_pipe.t.orig	Tue Dec 12 22:20:58 2006
+++ ./os2/os2_pipe.t	Wed Dec 13 03:25:18 2006
@@ -0,0 +1,201 @@
+#!/usr/bin/perl -w
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Test::More tests => 80;
+use strict;
+use IO::Handle;
+use Fcntl;
+
+my $pname = "/pipe/perl_pipe_test$$";
+
+ok !eval {OS2::pipe $pname, 'wait'}, 'wait for non-existing pipe fails';
+is 0 + $^E, 3, 'correct error code';
+ok my $server_pipe = OS2::pipe($pname, 'rw'), 'create pipe, no connect';
+ok((my $fd = fileno $server_pipe) >= 0, 'has a fileno');
+is +(OS2::pipeCntl($server_pipe, 'readstate'))[0], 2, 'is listening';
+is OS2::pipeCntl($server_pipe, 'state') & 0xFF, 1, 'max count=1';
+
+ok 0 > OS2::pipeCntl($server_pipe, 'connect', !'wait'), 'connect nowait';
+
+ok open(my $fh, '+<', $pname), 'open client end';
+#ok sysopen($fh, $pname, O_RDWR), 'sysopen client end' . $^E;
+#my ($fd1, $action) = OS2::open $pname, 0x2042 or warn $^E; # ERROR,SHARE,RDWR
+is +(OS2::pipeCntl($server_pipe, 'readstate'))[0], 3, 'is connected';
+ok 0 < OS2::pipeCntl($server_pipe, 'connect', !'wait'), 'connect nowait';
+ok OS2::pipeCntl($server_pipe, 'connect', 'wait'), 'connect wait';
+is $server_pipe->autoflush, 0, 'autoflush server'; # Returns the old value
+is $fh->autoflush, 0, 'autoflush';	# Returns the old value
+ok syswrite($server_pipe, "some string\n"), 'server write';
+is scalar <$fh>, "some string\n", 'client read';
+ok syswrite($fh, "another string\n"), 'client write';
+
+is OS2::pipeCntl($server_pipe, 'peek'), "another string\n", 'peeking is fine';
+my ($st, $bytesAvail, $bytesInMess) = OS2::pipeCntl($server_pipe, 'readstate');
+my ($name, $remoteID, $outBuffer, $inBuffer, $maxInstance, $countInstance)
+  = OS2::pipeCntl($server_pipe, 'info');
+is $bytesAvail, length("another string\n"), 'count bytes';
+is $remoteID, 0, 'not remote';
+is $maxInstance, 1, 'max count is 1';
+is $countInstance, 1, 'count is 1';
+#is $len, length($pname) + 1, 'length of name is 1 more than the actual';
+(my $tmp = $pname) =~ s,/,\\,g;
+is lc $name, lc $tmp, 'name is correct (up to case)';
+
+# If do print() instead of syswrite(), this gets "some string\n" instead!!!
+is scalar <$server_pipe>, "another string\n", 'server read';
+
+ok !open(my $fh1, '+<', $pname), 'open client end fails';
+
+# No new child present, return -1
+ok 0 > OS2::pipeCntl($server_pipe, 'reset', !'wait'), 'server reset, no wait';
+ok eof($fh), 'client EOF';
+ok(($fh->clearerr, 1), 'client clear EOF');	# XXXX Returns void
+
+$!=0; $^E = 0;
+ok close $fh, 'close client';
+#diag $!;
+#diag $^E;
+is fileno $fh, undef, 'was actually closed...';
+
+ok open($fh, '+<', $pname), 'open client end';
+
+is $fh->autoflush, 1, 'autoflush';	# Returns the old value
+ok syswrite($server_pipe, "some string\n"), 'server write';
+is scalar <$fh>, "some string\n", 'client read';
+ok syswrite($fh, "another string\n"), 'client write';
+
+# If do print() instead of syswrite(), this gets "some string\n" instead!!!
+is scalar <$server_pipe>, "another string\n", 'server read';
+
+ok syswrite($server_pipe, "some string\n"), 'server write';
+ok syswrite($fh, "another string\n"), 'client write';
+is scalar <$fh>, "some string\n", 'client read';
+
+# If do print() instead of syswrite(), this gets "some string\n" instead!!!
+is scalar <$server_pipe>, "another string\n", 'server read';
+
+ok syswrite($server_pipe, "some string\n"), 'server write';
+ok syswrite($fh, "another string\n"), 'client write';
+
+ok((sysread $fh, my $in, 2000), 'client sysread');
+is $in, "some string\n", 'client sysread correct';
+
+# If do print() instead of syswrite(), this gets "some string\n" instead!!!
+ok((sysread $server_pipe, $in, 2000), 'server sysread');
+is $in, "another string\n", 'server sysread correct';
+
+ok !open($fh1, '+<', $pname), 'open client end fails';
+
+# XXXX Not needed???
+#ok(($fh->clearerr, 1), 'client clear EOF');	# XXXX Returns void
+
+ok close $fh, 'close client';
+ok eof $server_pipe, 'server EOF';	# Creates an error condition
+
+my $pid = system 4|0x40000, $^X, '-wle', <<'EOS', $pname; # SESSION|INDEPENDENT
+  my $success;
+  END {sleep($success ? 1 : 10);}
+  my $mess = '';
+  $SIG{TERM} = sub {die "kid1 error: Got SIGTERM\nmess=`$mess'"};
+  my $pn = shift;
+  my $fh;
+  eval {
+    $mess .= "Pipe open fails\n" unless open $fh, '+<', $pn;
+    my $t = time;		### TIMESTAMP0
+    warn "kid1: Wait for pipe...\n";
+    $mess .= "Pipe became available\n" if OS2::pipe $pn, 'wait';
+    my $t1 = time() - $t;	### TIMESTAMP1
+    $mess .= "Unexpected delay $t1\n" unless $t1 >= 1 and $t1 <= 3;
+    warn "kid1: sleep 4...\n";
+    sleep 4;
+    $mess .= "Pipe open\n" if open $fh, '+<', $pn;
+    binmode $fh;
+    1;				### TIMESTAMP2
+  } or warn $@;
+  warn "kid1: pipe opened...\n";
+  select $fh; $| = 1;
+  my $c = syswrite $fh, $mess or warn "print: $!";
+  warn "kid1: Wrote $c bytes\n";
+  warn $mess;
+  close $fh or die "kid1 error: close: $!";
+  $success = 1;
+EOS
+
+ok $pid > 0, 'kid pid';
+
+### TIMESTAMP0
+sleep 2;
+my $t = time;
+### TIMESTAMP1
+# New child present; will clear error condition...
+ok 0 < OS2::pipeCntl($server_pipe, 'reset', 'wait'), 'server reset, wait';
+### TIMESTAMP2
+my $t1 = time() - $t;
+ok $t1 <= 6 && $t1 >= 2, 'correct delay';
+
+sleep 2;
+
+ok binmode($server_pipe), 'binmode';
+ok !eof $server_pipe, 'server: no EOF';
+my @in = <$server_pipe>;
+my @exp = ( "Pipe open fails\n", "Pipe became available\n", "Pipe open\n");
+
+is "@in", "@exp", 'expected data';
+
+# Can't switch to message mode if created in byte mode...
+ok close $server_pipe, 'server close';
+ok $server_pipe = OS2::pipe($pname, 'RW'), 'create pipe in message mode';
+ok OS2::pipeCntl($server_pipe, 'byte'),    'can switch to byte mode';
+ok OS2::pipeCntl($server_pipe, 'message'), 'can switch to message mode';
+
+$pid = system 4|0x40000, $^X, '-wle', <<'EOS', $pname, $$; # SESSION|INDEPENDENT
+  END {sleep 2}
+  my ($name, $ppid) = (shift, shift);
+  $name =~ s,/,\\,g;
+  $name = uc $name;
+  warn "kid2: OS2::pipe $name, 'call', ...\n";
+  my $got = OS2::pipe $name, 'call', "Is your pid $ppid?\n";
+  my $ok = $got eq 'Yes';
+  warn "kid2: got `$got'\n";
+  OS2::pipe $name, 'call', $ok ? "fine\n" : "bad\n";
+EOS
+
+ok $pid, 'kid started';
+sleep 2;			# XXX How to syncronize with kid???
+$in = scalar <$server_pipe>;
+my $ok1 = ($in || '') eq "Is your pid $$?\n";
+is $in, "Is your pid $$?\n", 'call in';
+ok syswrite($server_pipe, $ok1 ? 'Yes' : 'No' ), 'server write';
+
+ok 0 < OS2::pipeCntl($server_pipe, 'reset', 'wait'), 'server reset, wait';
+$in = scalar <$server_pipe>;
+is $in, "fine\n", 'call in';
+ok syswrite($server_pipe, 'ending' ), 'server write';
+
+ok close $server_pipe, 'server close';
+
+ok $server_pipe = OS2::pipe($pname, 'W'), 'create pipe in message write mode';
+ok !eval {OS2::pipeCntl($server_pipe, 'readstate'); 1}, 'readstate fails, as expected';
+ok close $server_pipe, 'server close';
+
+ok $server_pipe = OS2::pipe($pname, 'w'), 'create pipe in byte write mode';
+ok !eval {OS2::pipeCntl($server_pipe, 'readstate'); 1}, 'readstate fails, as expected';
+ok close $server_pipe, 'server close';
+
+ok $server_pipe = OS2::pipe($pname, 'r'), 'create pipe in byte read mode';
+is +(OS2::pipeCntl($server_pipe, 'readstate'))[0], 2, 'is listening';
+ok close $server_pipe, 'server close';
+
+ok $server_pipe = OS2::pipe($pname, 'r', 0), 'create-no-connect pipe in byte read mode';
+is +(OS2::pipeCntl($server_pipe, 'readstate'))[0], 1, 'is disconnected';
+ok close $server_pipe, 'server close';
+
+ok $server_pipe = OS2::pipe($pname, 'R'), 'create pipe in message read mode';
+is +(OS2::pipeCntl($server_pipe, 'readstate'))[0], 2, 'is listening';
+ok close $server_pipe, 'server close';
+
+#is waitpid($pid, 0), $pid, 'kid ended';
+#is $?, 0, 'kid exitcode';
diff -pru perl-5.8.7-min-patched/os2/os2ish.h perl-5.8.7-patched/os2/os2ish.h
--- perl-5.8.7-min-patched/os2/os2ish.h	Thu Jan  1 13:50:16 2004
+++ perl-5.8.7-patched/os2/os2ish.h	Mon Nov 27 20:59:10 2006
@@ -309,7 +309,10 @@ void *sys_alloc(int size);
 #define TMPPATH1 "plXXXXXX"
 extern const char *tmppath;
 PerlIO *my_syspopen(pTHX_ char *cmd, char *mode);
-/* Cannot prototype with I32 at this point. */
+#ifdef PERL_CORE
+/* Cannot prototype with I32, SV at this point (used in x2p too). */
+PerlIO *my_syspopen4(pTHX_ char *cmd, char *mode, I32 cnt, SV** args);
+#endif
 int my_syspclose(PerlIO *f);
 FILE *my_tmpfile (void);
 char *my_tmpnam (char *);
--- ./os2/Makefile.SHs-pre	Tue Nov  4 14:59:26 2003
+++ ./os2/Makefile.SHs	Sat Nov  8 13:24:58 2003
@@ -222,6 +222,10 @@ $(AOUT_DYNALOADER_OBJ) : $(DYNALOADER_OB
 $(DYNALOADER_OBJ) : $(DYNALOADER)
 	@sh -c true
 
+# Quick hack to construct directories necessary for /*/% stuff:
+
+$(aout_static_ext) : $(static_ext) $(dynamic_ext)
+
 $(AOUT_LIBPERL) : $(aout_obj) perl$(AOUT_OBJ_EXT)
 	rm -f $@
 	$(AOUT_AR) rcu $@ perl$(AOUT_OBJ_EXT) $(aout_obj)
diff -pru perl-5.8.7-min-patched/os2/OS2/REXX/DLL/Changes perl-5.8.7-patched/os2/OS2/REXX/DLL/Changes
--- perl-5.8.7-min-patched/os2/OS2/REXX/DLL/Changes	Thu Jan  1 09:53:42 2004
+++ perl-5.8.7-patched/os2/OS2/REXX/DLL/Changes	Mon Nov 27 20:59:10 2006
@@ -2,3 +2,5 @@
 	Split out of OS2::REXX
 0.02:
 	New methods libPath_find(), has_f32(), handle() and fullname().
+1.03:
+	New flag 0x8 for "return all" for libPath_find
diff -pru perl-5.8.7-min-patched/os2/OS2/REXX/DLL/DLL.pm perl-5.8.7-patched/os2/OS2/REXX/DLL/DLL.pm
--- perl-5.8.7-min-patched/os2/OS2/REXX/DLL/DLL.pm	Thu Jan  1 09:53:42 2004
+++ perl-5.8.7-patched/os2/OS2/REXX/DLL/DLL.pm	Mon Nov 27 20:59:10 2006
@@ -1,6 +1,6 @@
 package OS2::DLL;
 
-our $VERSION = '1.02';
+our $VERSION = '1.03';
 
 use Carp;
 use XSLoader;
@@ -64,10 +64,11 @@ sub libPath_find {
   push @path, split /;/, OS2::extLibpath	if $flags & 0x1;	# BEGIN
   push @path, split /;/, OS2::libPath		if $flags & 0x2;
   push @path, split /;/, OS2::extLibpath(1)	if $flags & 0x4;	# END
-  s,(?![/\\])$,/, for @path;
-  s,\\,/,g for @path;
+  s,(?![/\\])$,/,  for @path;
+  s,\\,/,g	   for @path;
   $name .= ".dll" unless $name =~ /\.[^\\\/]*$/;
   $_ .= $name for @path;
+  return grep -f $_, @path if $flags & 0x8;
   -f $_ and return $_ for @path;
   return;
 }
diff -pru perl-5.8.7-min-patched/os2/OS2/Process/Process.pm perl-5.8.7-patched/os2/OS2/Process/Process.pm
--- perl-5.8.7-min-patched/os2/OS2/Process/Process.pm	Thu Sep 11 14:25:38 2003
+++ perl-5.8.7-patched/os2/OS2/Process/Process.pm	Mon Nov 27 20:59:10 2006
@@ -60,6 +60,9 @@ our @EXPORT = qw(
 	T_VIRTDRV
 	T_PROTDLL
 	T_32BIT
+
+	os2constant
+
 	ppid
 	ppidOf
 	sidOf
@@ -137,16 +140,22 @@ our @EXPORT = qw(
         WindowPtr
         WindowULong
         WindowUShort
+	WindowStyle
         SetWindowBits
         SetWindowPtr
         SetWindowULong
         SetWindowUShort
+        WindowBits_set
+        WindowPtr_set
+        WindowULong_set
+        WindowUShort_set
 	TopLevel
 	FocusWindow_set_keep_Zorder
 
 	ActiveDesktopPathname
 	InvalidateRect
-	CreateFrameControl
+	CreateFrameControls
+
 	ClipbrdFmtInfo
 	ClipbrdOwner
 	ClipbrdViewer
@@ -158,6 +167,8 @@ our @EXPORT = qw(
 	ClipbrdViewer_set
 	EnumClipbrdFmts
 	EmptyClipbrd
+	ClipbrdFmtNames
+	ClipbrdFmtAtoms
 	AddAtom
 	FindAtom
 	DeleteAtom
@@ -171,11 +182,15 @@ our @EXPORT = qw(
 	_ClipbrdData_set
 	ClipbrdText
 	ClipbrdText_set
+	ClipbrdText_2byte
+	ClipbrdTextUCS2le
+	MemoryRegionSize
 
 	_MessageBox
 	MessageBox
 	_MessageBox2
 	MessageBox2
+	get_pointer
 	LoadPointer
 	SysPointer
 	Alarm
@@ -183,6 +198,7 @@ our @EXPORT = qw(
 
 	get_title
 	set_title
+	io_term
 );
 our @EXPORT_OK = qw(
 	ResetWinError
@@ -216,11 +232,18 @@ sub AUTOLOAD {
     goto &$AUTOLOAD;
 }
 
-sub const_import {
+sub os2constant {
   require OS2::Process::Const;
   my $sym = shift;
   my ($err, $val) = OS2::Process::Const::constant($sym);
   die $err if $err;
+  $val;
+}
+
+sub const_import {
+  require OS2::Process::Const;
+  my $sym = shift;
+  my $val = os2constant($sym);
   my $p = caller(1);
 
   # no strict;
@@ -412,21 +435,78 @@ sub FocusWindow_set_keep_Zorder ($) {
   EnableWindowUpdate($t, 1);
 }
 
-sub ClipbrdText (@) {
-  my $morph = OS2::localMorphPM->new(0);
-  OpenClipbrd();
-  my $txt = unpack 'p', pack 'L', ClipbrdData @_;
+sub WindowStyle ($) {
+  WindowULong(shift,-2);	# QWL_STYLE
+}
+
+sub OS2::localClipbrd::new {
+  my ($c) = shift;
+  my $morph = [];
+  push @$morph, OS2::localMorphPM->new(0) unless shift;
+  &OpenClipbrd;
+  # print STDERR ">>>>>\n";
+  bless $morph, $c
+}
+sub OS2::localClipbrd::DESTROY {
+  # print STDERR "<<<<<\n";
   CloseClipbrd();
-  $txt;
 }
 
-sub ClipbrdText_set ($;$) {
+sub OS2::localFlashWindow::new ($$) {
+  my ($c, $w) = (shift, shift);
   my $morph = OS2::localMorphPM->new(0);
-  OpenClipbrd();
+  FlashWindow($w, 1);
+  # print STDERR ">>>>>\n";
+  bless [$w, $morph], $c
+}
+sub OS2::localFlashWindow::DESTROY {
+  # print STDERR "<<<<<\n";
+  FlashWindow(shift->[0], 0);
+}
+
+# Good for \0-terminated text (not "text/unicode" and other Firefox stuff)
+sub ClipbrdText (@) {
+  my $h = OS2::localClipbrd->new;
+  my $data = ClipbrdData @_;
+  return unless $data;
+  my $lim = MemoryRegionSize($data);
+  $lim = StrLen($data, $lim);			# Look for 1-byte 0
+  return unpack "P$lim", pack 'L', $data;
+}
+
+sub ClipbrdText_2byte (@) {
+  my $h = OS2::localClipbrd->new;
+  my $data = ClipbrdData @_;
+  return unless $data;
+  my $lim = MemoryRegionSize($data);
+  $lim = StrLen($data, $lim, 2);		# Look for 2-byte 0
+  return unpack "P$lim", pack 'L', $data;
+}
+
+sub ClipbrdTextUCS2le (@) {
+  my $txt = ClipbrdText_2byte @_;		# little-endian shorts
+  #require Unicode::String;
+  pack "U*", unpack "v*", $txt;
+}
+
+sub ClipbrdText_set ($;@) {
+  my $h = OS2::localClipbrd->new;
   EmptyClipbrd();				# It may contain other types
   my ($txt, $no_convert_nl) = (shift, shift);
   ClipbrdData_set($txt, !$no_convert_nl, @_);
-  CloseClipbrd();
+}
+
+sub ClipbrdFmtAtoms {
+  my $h = OS2::localClipbrd->new('nomorph');
+  my $fmt = 0;
+  my @formats;
+  push @formats, $fmt while eval {$fmt = EnumClipbrdFmts $fmt};
+  die $@ if $@ and $^E == 0x1001 and $fmt = 0;	# Croaks on empty list?
+  @formats;
+}
+
+sub ClipbrdFmtNames {
+  map AtomName($_), ClipbrdFmtAtoms(@_);
 }
 
 sub MessageBox ($;$$$$$) {
@@ -467,7 +547,7 @@ sub process_MB2_INFO ($;$$$) {
   my $buttons = shift;
   die "Buttons array should consist of pairs" if @$buttons % 2;
 
-  push @_, 0 unless @_;		# Icon id (pointer)
+  push @_, 0 unless @_;		# Icon id; non-0 ignored without MB_CUSTOMICON
   # Box flags (MB_MOVABLE and MB_INFORMATION or MB_CUSTOMICON)
   push @_, ($_[0] ? 0x4080 : 0x4030) unless @_ > 1;
   push @_, 0 unless @_ > 2;	# Notify window
@@ -492,20 +572,63 @@ sub process_MB2_INFO ($;$$$) {
 sub MessageBox2 ($;$$$$$) {
   my $morph = OS2::localMorphPM->new(0);
   die "MessageBox needs text" unless @_;
-  push @_ , [[Dismiss => 0x1000], # Name, retval (BS_PUSHBUTTON|BS_DEFAULT)
-	     #0,		# get_pointer(11),	# SPTR_ICONINFORMATION
-	     #0x4030,		# MB_MOVEABLE | MB_INFORMATION
+  push @_ , [[Dismiss => 0x1000], # Name, retval (style BS_PUSHBUTTON|BS_DEFAULT)
+	     #0,		# e.g., get_pointer(11),# SPTR_ICONINFORMATION
+	     #0x4030,		# = MB_MOVEABLE | MB_INFORMATION
 	     #0,		# Notify window; was 1==HWND_DESKTOP
 	    ] if @_ == 1;
-  push @_ , ($0 eq '-e' ? "Perl one-liner's message" : "$0's message") if @_ == 2;
+  push @_ , ($0 eq '-e' ? "Perl one-liner" : $0). "'s message" if @_ == 2;
   $_[1] = &process_MB2_INFO(@{$_[1]}) if ref($_[1]) eq 'ARRAY';
   &_MessageBox2;
 }
 
+my %mbH_default = (
+  text => 'Something happened',
+  title => ($0 eq '-e' ? "Perl one-liner" : $0). "'s message",
+  parent => 1,			# HWND_DESKTOP
+  owner => 0,
+  helpID => 0,
+  buttons => ['Dismiss' => 0x1000],
+  default_button => 1,
+#  icon => 0x30,		# MB_INFORMATION
+#  iconID => 0,			# XXX???
+  flags => 0,			# XXX???
+  notifyWindow => 0,		# XXX???
+);
+
+sub MessageBoxH {
+  die "MessageBoxH: even number of arguments expected" if @_ % 2;
+  my %a = (%mbH_default, @_);
+  die "MessageBoxH: even number of elts of button array expected"
+    if @{$a{buttons}} % 2;
+  if (defined $a{iconID}) {
+    $a{flags} |= 0x80;		# MB_CUSTOMICON
+  } else {
+    $a{icon} = 0x30 unless defined $a{icon};
+    $a{iconID} = 0;
+    $a{flags} |= $a{icon};
+  }
+  # Mark default_button as MessageBox2() expects it:
+  $a{buttons}[2*$a{default_button}] = [$a{buttons}[2*$a{default_button}]];
+
+  my $use_2 = 'ARRAY' eq ref $a{buttons};
+  return
+    MessageBox2 $a{text}, [@a{qw(buttons iconID flags notifyWindow)}],
+      $a{parent}, $a{owner}, $a{helpID}
+	if $use_2;
+  die "MessageBoxH: unexpected format of argument 'buttons'";
+}
+
 # backward compatibility
 *set_title = \&Title_set;
 *get_title = \&Title;
 
+# New (logical) names
+*WindowBits_set = \&SetWindowBits;
+*WindowPtr_set = \&SetWindowPtr;
+*WindowULong_set = \&SetWindowULong;
+*WindowUShort_set = \&SetWindowUShort;
+
 # adapter; display; cbMemory; Configuration; VDHVersion; Flags; HWBufferSize;
 # FullSaveSize; PartSaveSize; EMAdaptersOFF; EMDisplaysOFF;
 sub vioConfig (;$$) {
@@ -573,6 +696,138 @@ sub kbdhStatus_set {
   _kbdStatus_set($o,$h);
 }
 
+#sub DeleteAtom		{ !WinDeleteAtom(@_) }
+sub DeleteAtom		{ !_DeleteAtom(@_) }
+sub DestroyAtomTable    { !_DestroyAtomTable(@_) }
+
+# XXXX This is a wrong order: we start keyreader, then screenwriter; so it is
+# the writer who gets signals.
+
+# XXXX Do we ever get a message "screenwriter killed"???  If reader HUPs us...
+# Large buffer works at least for read from pipes; should we binmode???
+sub __term_mirror_screen {   # Read from fd=$in and write to the console
+  local $SIG{TERM} = $SIG{HUP} = $SIG{BREAK} = $SIG{INT} = # die() can stop END
+    sub { my $s = shift; warn "screenwriter killed ($s)...\n";};
+  my $in = shift;
+  open IN, "<&=$in" or die "open <&=$in: $!";
+  # Attempt to redirect to STDERR/OUT is not very useful, but try this anyway...
+  open OUT, '>', '/dev/con' or open OUT, '>&STDERR' or open OUT, '>&STDOUT'
+	and select OUT or die "Can't open /dev/con or STDERR/STDOUT for write";
+  $| = 1; local $SIG{TERM} = sub { die "screenwriter exits...\n"};
+  binmode IN; binmode OUT;
+  eval { print $_ while sysread IN, $_, 1<<16; };	# print to OUT...
+  warn $@ if $@;
+  warn "Screenwriter can't read any more ($!, $^E), terminating...\n";
+}
+
+# Does not automatically ends when the parent exits if related => 0
+# copy from fd=$in to screen ; same for $out; or $in may be a named pipe
+sub __term_mirror {
+  my $pid;
+  ### If related => 1, we get TERM when our parent exits...
+  local $SIG{TERM} = sub { my $s = shift;
+			   die "keyreader exits in a few secs ($s)...\n" };
+  my ($in, $out) = (shift, shift);
+  if (defined $out and length $out) {	# Allow '' for ease of @ARGV
+    open OUT, ">&=$out" or die "Cannot open &=$out for write: $!";
+    fcntl(OUT, 4, 1);		# F_SETFD, NOINHERIT
+    open IN, "<&=$in" or die "Cannot open &=$in for read/ioctl: $!";
+    fcntl(IN,  4, 0);		# F_SETFD, INHERIT
+  } else {
+    warn "Unexpected i/o pipe name: `$in'" unless $in =~ m,^[\\/]pipe[\\/],i;
+    OS2::pipe $in, 'wait';
+    open OUT, '+<', $in or die "Can't open `$in' for r/w: $!";
+    fcntl(OUT,  4, 0);		# F_SETFD, INHERIT
+    $in = fileno OUT;
+    undef $out;
+  }
+  my %opt = @_;
+  Title_set $opt{title}				if exists $opt{title};
+  &scrsize_set(split /,/, $opt{scrsize})	if exists $opt{scrsize};
+
+  my @i = map +('-I', $_), @INC;	# Propagate @INC
+
+  # Careful unless PERL_SIGNALS=unsafe: SIGCHLD does not work...
+  $SIG{CHLD} = sub {wait; die "Keyreader follows screenwriter...\n"}
+	unless defined $out;
+
+  $pid = system 1, $^X, @i, '-MOS2::Process',
+	 '-we', 'END {sleep 2} OS2::Process::__term_mirror_screen shift', $in;
+  close IN if defined $out;
+  $pid > 0 or die "Cannot start a grandkid";
+
+  open STDIN, '</dev/con' or warn "reopen stdin: $!";
+  select OUT;    $| = 1;  binmode OUT;	# need binmode: sysread() may be bin
+  $SIG{PIPE} = sub { die "writing to a closed pipe" };
+  $SIG{HUP} = $SIG{BREAK} = $SIG{INT} = $SIG{TERM};
+  # Workaround: EMX v61 won't return pid on SESSION|UNRELATED after fork()...
+  syswrite OUT, pack 'L', $$ or die "syswrite failed: $!" if $opt{writepid};
+  # Turn Nodelay on kbd.  Pipe is automatically nodelay...
+  if ($opt{read_by_key}) {
+    if (eval {require Term::ReadKey; 1}) {
+      Term::ReadKey::ReadMode(4);
+    } else { warn "can't load Term::ReadKey; input by lines..." }
+  }
+  print while sysread STDIN, $_, 1<<($opt{smallbuffer} ? 0 : 16); # to OUT
+}
+
+my $c = 0;
+sub io_term {	# arguments as hash: read_by_key/title/scrsize/related/writepid
+  # read_by_key disables echo too...
+  local $\  = '';
+  my ($sysf, $in1, $out1, $in2, $out2, $f1, $f2, $fd) = 4;	# P_SESSION
+  my %opt = @_;
+
+  if ($opt{related}) {
+    pipe $in1, $out1 or die "pipe(): $!";
+    pipe $in2, $out2 or do { close($in1), close($out1), die "pipe(): $!" };
+    $f1 = fileno $in1; $f2 = fileno $out2;
+    fcntl($in2, 4, 1); fcntl($out1, 4, 1);		# F_SETFD, NOINHERIT
+    fcntl($in1, 4, 0); fcntl($out2, 4, 0);		# F_SETFD, INHERIT
+  } else {
+    $f1 = "/pipe/perlmodule/OS2/Process/$$-" . $c++;
+    $out1 = OS2::pipe $f1, 'rw' or die "OS2::pipe(): $^E";
+    #open $out1, "+<&=$fd" or die "dup($fd): $!, $^E";
+    fcntl($out1, 4, 1);		# F_SETFD, NOINHERIT
+    #$in2 = $out1;
+    $f2 = '';
+    $sysf |= 0x40000;		# P_UNRELATED
+    $opt{writepid} = 1, unless exists $opt{writepid};
+  }
+
+  # system P_SESSION will fail if there is another process
+  # in the same session with a "related" asynchronous child session.
+  my @i = map +('-I', $_), @INC;	# Propagate @INC
+  my $krun = <<'EOS';
+     END {sleep($sleep || 5)}
+     use OS2::Process; $sleep = 1;
+     OS2::Process::__term_mirror(@ARGV);
+EOS
+  my $kpid;
+  if ($opt{related}) {
+    $kpid = system $sysf, $^X, @i, '-we', $krun, $f1, $f2, %opt;
+  } else {
+    local $ENV{PERL_SIGNALS} = 'unsafe';
+    $kpid = system $sysf, $^X, @i, '-we', $krun, $f1, $f2, %opt;
+  }
+  close $in1 or warn if defined $in1;
+  close $out2 or warn if defined $out2;
+  # EMX BUG with $kpid == 0 after fork()
+  do { close($in2), ($out1 != $in2 and close($out1)),
+       die "system $sysf, $^X: kid=$kpid, \$!=`$!', \$^E=`$^E'" }
+     unless $kpid > 0 or $kpid == 0 and $opt{writepid};
+  # Can't read or write until the kid opens the pipes
+  OS2::pipeCntl $out1, 'connect', 'wait' unless length $f2;
+  # Without duping: write after read (via termio) on the same fd dups input
+  open $in2, '<&', $out1 or die "dup($out1): $^E" unless $opt{related};
+  if ($opt{writepid}) {
+    my $c = length pack 'L', 0;
+    my $c1 = sysread $in2, (my $pid), $c;
+    $c1 == $c or die "unexpected length read: $c1 vs $c";
+    $kpid = unpack 'L', $pid;
+  }
+  return ($in2, $out1, $kpid);
+}
 
 # Autoload methods go after __END__, and are processed by the autosplit program.
 
@@ -1059,6 +1314,28 @@ name returned is in the form "#nnnnn", w
 of up to five digits that corresponds to the value of the WC_* class name
 constant.
 
+=item WindowStyle($hwnd)
+
+Returns the "window style" flags for window handle $hwnd.
+
+=item WindowULong($hwnd, $id), WindowPtr($hwnd, $id), WindowUShort($hwnd, $id)
+
+Return data associated to window handle $hwnd.  $id should be one of
+C<QWL_*>, C<QWP_PFNWP>, C<QWS_*> constants, or a byte offset referencing
+a region (of length 4, 4, 2 correspondingly) fully inside C<0..cbWindowData-1>.
+Here C<cbWindowData> is the count of extra user-specified bytes reserved
+for the given class of windows.
+
+=item WindowULong_set($hwnd, $id, $value), WindowPtr_set, WindowUShort_set
+
+Similar to WindowULong(), WindowPtr(), WindowUShort(), but for assigning the
+value $value.
+
+=item WindowBits_set($hwnd, $id, $value, $mask)
+
+Similar to WindowULong_set(), but will change only the bits which are
+set in $mask.
+
 =item FocusWindow()
 
 returns the handle of the focus window.  Optional argument for specifying
@@ -1304,72 +1581,512 @@ This function is normally not needed.  N
 
 gets the path of the directory which corresponds to Desktop.
 
+=item 	InvalidateRect
+
+=item	CreateFrameControls
+
+=back
+
+=head2 Control of the PM clipboard
+
+=over
+
 =item ClipbrdText()
 
 gets the content of the clipboard.  An optional argument is the format
-of the data in the clipboard (defaults to C<CF_TEXT>).
+of the data in the clipboard (defaults to C<CF_TEXT>).  May croak with error
+C<PMERR_INVALID_HWND> if no data of given $fmt is present.
 
 Note that the usual convention is to have clipboard data with
-C<"\r\n"> as line separators.
+C<"\r\n"> as line separators.  This function will only work with clipboard
+data types which are delimited by C<"\0"> byte (not included in the result).
 
-=item ClipbrdText_set($txt)
+=item ClipbrdText_2byte
 
-sets the text content of the clipboard.  Unless the optional argument
-is TRUE, will convert newlines to C<"\r\n">.  Another optional
-argument is the format of the data in the clipboard (defaults to
-C<CF_TEXT>).
+Same as ClipbrdText(), but will only work with clipboard
+data types which are collection of C C<shorts> delimited by C<0> short
+(not included in the result).
 
-=item 	InvalidateRect
+=item ClipbrdTextUCS2le
+
+Same as ClipbrdText_2byte(), but will assume that the shorts represent
+an Unicode string in I<UCS-2le> format (little-endian 2-byte representation
+of Unicode), and will provide the result in Perl internal C<utf8> format
+(one short of input represents one Perl character).
+
+Note that Firefox etc. export their selection in unicode types of this format.
+
+=item ClipbrdText_set($txt, [$no_convert_nl, [$fmt, [$fmtinfo, [$hab] ] ] ] )
+
+sets the text content of the clipboard after removing old contents.  Unless the
+optional argument  $no_convert_nl is TRUE, will convert newlines to C<"\r\n">.  Another optional
+argument $fmt is the format of the data in the clipboard (should be an
+atom, defaults to C<CF_TEXT>).  Other arguments are as for C<ClipbrdData_set>.
+Croaks on failure.
+
+=item	ClipbrdFmtInfo( [$fmt, [ $hab ] ])
+
+returns the $fmtInfo flags set by the application which filled the
+format $fmt of the clipboard.  $fmt defaults to C<CF_TEXT>.
+
+=item	ClipbrdOwner( [ $hab ] )
+
+Returns window handle of the current clipboard owner.
+
+=item	ClipbrdViewer( [ $hab ] )
+
+Returns window handle of the current clipboard viewer.
+
+=item	ClipbrdData( [$fmt, [ $hab ] ])
 
-=item	CreateFrameControl
+Returns a handle to clipboard data of the given format as an integer.
+Format defaults to C<CF_TEXT> (in this case the handle is a memory address).
 
-=item	ClipbrdFmtInfo
+Clipboard should be opened before calling this function.  May croak with error
+C<PMERR_INVALID_HWND> if no data of given $fmt is present.
 
-=item	ClipbrdOwner
+The result should not be used after clipboard is closed.  Hence a return handle 
+of type C<CLI_POINTER> may need to be converted to a string and stored for
+future usage.  Use MemoryRegionSize() to get a high estimate on the length
+of region addressed by this pointer; the actual length inside this region
+should be obtained by knowing particular format of data.  E.g., it may be
+0-byte terminated for string types, or 0-short terminated for wide-char string
+types.
 
-=item	ClipbrdViewer
+=item	OpenClipbrd( [ $hab ] )
 
-=item	ClipbrdData
+claim read access to the clipboard.  May need a message queue to operate.
+May block until other processes finish dealing with clipboard.
 
-=item	OpenClipbrd
+=item	CloseClipbrd( [ $hab ] )
 
-=item	CloseClipbrd
+Allow other processes access to clipboard.
+Clipboard should be opened before calling this function.
 
-=item	ClipbrdData_set
+=item	ClipbrdData_set($data, [$convert_nl, [$fmt, [$fmtInfo, [ $hab] ] ] ] )
 
-=item	ClipbrdOwner_set
+Sets the clipboard data of format given by atom $fmt.  Format defaults to
+CF_TEXT.
 
-=item	ClipbrdViewer_set
+$fmtInfo should declare what type of handle $data is; it should be either
+C<CFI_POINTER>, or C<CFI_HANDLE> (possibly qualified by C<CFI_OWNERFREE>
+and C<CFI_OWNERDRAW> flags).  It defaults to C<CFI_HANDLE> for $fmt being
+standard bitmap, metafile, and palette (undocumented???) formats;
+otherwise defaults to C<CFI_POINTER>.  If format is C<CFI_POINTER>, $data
+should contain the string to copy to clipboard; otherwise it should be an
+integer handle.
 
-=item	EnumClipbrdFmts
+If $convert_nl is TRUE (the default), C<"\n"> in $data are converted to
+C<"\r\n"> pairs if $fmt is C<CFI_POINTER> (as is the convention for text
+format of the clipboard) unless they are already in such a pair.
 
-=item	EmptyClipbrd
+=item	_ClipbrdData_set($data, [$fmt, [$fmtInfo, [ $hab] ] ] )
 
-=item	AddAtom
+Sets the clipboard data of format given by atom $fmt.  Format defaults to
+CF_TEXT.  $data should be an address (in givable unnamed shared memory which
+should not be accessed or manipulated after this call) or a handle in a form
+of an integer.
 
-=item	FindAtom
+$fmtInfo has the same semantic as for ClipbrdData_set().
 
-=item	DeleteAtom
+=item	ClipbrdOwner_set( $hwnd, [ $hab ] )
 
-=item	AtomUsage
+Sets window handle of the current clipboard owner (window which gets messages
+when content of clipboard is retrieved).
 
-=item	AtomName
+=item	ClipbrdViewer_set( $hwnd, [ $hab ] )
 
-=item	AtomLength
+Sets window handle of the current clipboard owner (window which gets messages
+when content of clipboard is changed).
 
-=item	SystemAtomTable
+=item	ClipbrdFmtNames()
 
-=item	CreateAtomTable
+Returns list of names of formats currently available in the clipboard.
 
-=item	DestroyAtomTable
+=item	ClipbrdFmtAtoms()
 
-Low-level methods to access clipboard and the atom table(s).
+Returns list of atoms of formats currently available in the clipboard.
+
+=item	EnumClipbrdFmts($fmt [, $hab])
+
+Low-level access to the list of formats currently available in the clipboard.
+Returns the atom for the format of clipboard after $fmt.  If $fmt is 0, returns
+the first format of clipboard.  Returns 0 if $fmt is the last format.  Example:
+
+  {
+    my $h = OS2::localClipbrd->new('nomorph');
+    my $fmt = 0;
+    push @formats, AtomName $fmt
+      while $fmt = EnumClipbrdFmts $fmt;
+  }
+
+Clipboard should be opened before calling this function.  May croak if
+no format is present.
+
+=item	EmptyClipbrd( [ $hab ] )
+
+Remove all the data handles in the clipboard.  croak()s on failure.
+Clipboard should be opened before calling this function.
+
+Recommended before assigning a value to clipboard to remove extraneous
+formats of data from clipboard.
+
+=item ($size, $flags) = MemoryRegionSize($addr, [$size_lim, [ $interrupt ]])
+
+$addr should be a memory address (encoded as integer).  This call finds
+the largest continuous region of memory belonging to the same memory object
+as $addr, and having the same memory flags as $addr. $flags is the value of
+the memory flag of $addr (see docs of DosQueryMem(3) for details).  If
+optional argumetn $size_lim is given, the search is restricted to the region
+this many bytes long (after $addr).
+
+($addr and $size are rounded so that all the memory pages containing
+the region are inspected.)  Optional argument $interrupt (defaults to 1)
+specifies whether region scan should be interruptable by signals.
 
 =back
 
-=head1 OS2::localMorphPM class
+Use class C<OS2::localClipbrd> to ensure that clipboard is closed even if
+the code in the block made a non-local exit.
+
+See L<"OS2::localMorphPM and OS2::localClipbrd classes">.
+
+=head2 Control of the PM atom tables
+
+Low-level methods to access the atom table(s).  $atomtable defaults to 
+the SystemAtomTable().
+
+=over
+
+=item	AddAtom($name, [$atomtable])
+
+Returns the atom; increments the use count unless $name is a name of an
+integer atom.
+
+=item	FindAtom($name, [$atomtable])
+
+Returns the atom if it exists, 0 otherwise (actually, croaks).
+
+=item	DeleteAtom($name, [$atomtable])
 
-This class morphs the process to PM for the duration of the given scope.
+Decrements the use count unless $name is a name of an integer atom.
+When count goes to 0, association of the name to an integer is removed.
+(Version with prepended underscore returns 0 on success.)
+
+=item	AtomName($atom, [$atomtable])
+
+Returns the name of the atom.  Integer atoms have names of format C<"#ddddd">
+of variable length up to 7 chars.
+
+=item	AtomLength($atom, [$atomtable])
+
+Returns the length of the name of the atom.  Return of 0 means that no
+such atom exists (but usually croaks in such a case).
+
+Integer atoms always return length 6.
+
+=item	AtomUsage($name, [$atomtable])
+
+Returns the usage count of the atom.
+
+=item	SystemAtomTable()
+
+Returns central atom table accessible to any process.
+
+=item	CreateAtomTable( [ $initial, [ $buckets ] ] )
+
+Returns new per-process atom table.  See docs for WinCreateAtomTable(3).
+
+=item	DestroyAtomTable($atomtable)
+
+Dispose of the table. (Version with prepended underscore returns 0 on success.)
+
+
+=back
+
+=head2 Alerting the user
+
+=over
+
+=item Alarm([$type])
+
+Audible alarm of type $type (defaults to C<WA_ERROR=2>).  Other useful
+values are C<WA_WARNING=0>, C<WA_NOTE=1>.  (What is C<WA_CDEFALARMS=3>???)
+
+The duration and frequency of the alarms can be changed by the 
+OS2::SysValues_set(). The alarm frequency is defined to be in the range 0x0025
+through 0x7FFF. The alarm is not generated if system value SV_ALARM is set
+to FALSE. The alarms are dependent on the device capability.
+
+=item FlashWindow($hwnd, $doFlash)
+
+Starts/stops (depending on $doFlash being TRUE/FALSE) flashing the window
+$hwnd's borders and titlebar.  First 5 flashes are accompanied by alarm beeps.
+
+Example (for VIO applications):
+
+  { my $morph = OS2::localMorphPM->new(0);
+    print STDERR "Press ENTER!\n";
+    FlashWindow(process_hwnd, 1);
+    <>;
+    FlashWindow(process_hwnd, 0);
+  }
+
+Since flashing window persists even when application ends, it is very
+important to protect the switching off flashing from non-local exits.  Use
+the class C<OS2::localFlashWindow> for this.  Creating the object of this
+class starts flashing the window until the object is destroyed.  The above
+example becomes:
+
+  print STDERR "Press ENTER!\n";
+  { my $flash = OS2::localFlashWindow->new( process_hwnd );
+    <>;
+  }
+
+B<Notes from IBM docs:> Flashing a window brings the user's attention to a
+window that is not the active window, where some important message or dialog
+must be seen by the user. 
+
+Note:  It should be used only for important messages, for example, where some
+component of the system is failing and requires immediate attention to avoid
+damage. 
+
+=item MessageBox($text, [ $title, [$flags, ...] ])
+
+Shows a simple messagebox with (optional) icon, message $text, and one or
+more buttons to dismiss the box.  Returns the indicator of which action was
+taken by the user.  If optional argument $title is not given,
+the title is constructed from the application name.  The optional argument
+$flags describes the appearance of the box; the default is to have B<Cancel>
+button, I<INFO>-style icon, and a border for moving.  Flags should be
+a combination of
+
+ Buttons on the box: or Button Group
+     MB_OK                 OK
+     MB_OKCANCEL           both OK and CANCEL
+     MB_CANCEL             CANCEL
+     MB_ENTER              ENTER
+     MB_ENTERCANCEL        both ENTER and CANCEL
+     MB_RETRYCANCEL        both RETRY and CANCEL
+     MB_ABORTRETRYIGNORE   ABORT, RETRY, and IGNORE
+     MB_YESNO              both YES and NO
+     MB_YESNOCANCEL        YES, NO, and CANCEL
+
+ Color or Icon 
+     MB_ICONHAND           a small red circle with a red line across it. 
+     MB_ERROR              a small red circle with a red line across it. 
+     MB_ICONASTERISK       an information (i) icon. 
+     MB_INFORMATION        an information (i) icon. 
+     MB_ICONEXCLAMATION    an exclamation point (!) icon. 
+     MB_WARNING            an exclamation point (!) icon. 
+     MB_ICONQUESTION       a question mark (?) icon. 
+     MB_QUERY              a question mark (?) icon. 
+     MB_NOICON             No icon.
+
+ Default action (i.e., focussed button; default is MB_DEFBUTTON1)
+     MB_DEFBUTTON1         The first button is the default selection.
+     MB_DEFBUTTON2         The second button is the default selection. 
+     MB_DEFBUTTON3         The third button is the default selection. 
+
+ Modality indicator 
+     MB_APPLMODAL                  Message box is application modal (default).
+     MB_SYSTEMMODAL                Message box is system modal. 
+
+ Mobility indicator 
+     MB_MOVEABLE                   Message box is moveable. 
+
+With C<MB_MOVEABLE> the message box is displayed with a title bar and a
+system menu, which shows only the Move, Close, and Task Manager choices, 
+which can be selected either by use of the pointing device or by
+accelerator keys.  If the user selects Close, the message box is removed
+and the usResponse is set to C<MBID_CANCEL>, whether or not a cancel button 
+existed within the message box. 
+
+C<Esc> key dismisses the dialogue only if C<CANCEL> button is present; the
+return value is C<MBID_CANCEL>.
+
+With C<MB_APPLMODAL> the owner of the dialogue is disabled; therefore, do not
+specify the owner as the parent if this option is used.
+
+Additionally, the following flag is possible, but probably not very useful:
+  
+ Help button 
+     MB_HELP             a HELP button appears, which sends a WM_HELP
+				 message is sent to the window procedure of the
+				 message box. 
+
+Other optional arguments: $parent window, $owner_window, $helpID (used with
+C<WM_HELP> message if C<MB_HELP> style is given).
+
+The return value is one of
+
+  MBID_ENTER           ENTER was selected 
+  MBID_OK              OK was selected 
+  MBID_CANCEL          CANCEL was selected 
+  MBID_ABORT           ABORT was selected 
+  MBID_RETRY           RETRY was selected 
+  MBID_IGNORE          IGNORE was selected 
+  MBID_YES             YES was selected 
+  MBID_NO              NO was selected 
+
+  0		           Function not successful; an error occurred. 
+
+B<BUGS???> keyboard transversal by pressing C<TAB> key does not work.
+Do not appear in window list, so may be hard to find if covered by other
+windows.
+
+=item _MessageBox($text, [ $title, [$flags, ...] ])
+
+Similar to MessageBox(), but the default $title does not depend on the name
+of the script.
+
+=item MessageBox2($text, [ $buttons_Icon, [$title, ...] ])
+
+Similar to MessageBox(), but allows more flexible choice of button texts
+and the icon. $buttons_Icon is a reference to an array with information about
+buttons and the icon to use; the semantic of this array is the same as
+for argument list of process_MB2_INFO().  The default value will show
+one button B<Dismiss> which will return C<0x1000>.
+
+Other optional arguments are the same as for MessageBox().
+
+B<NOTE.> Remark about C<MBID_CANCEL> in presence of C<MB_MOVABLE> is
+equally applicable to MessageBox() and MessageBox2().
+
+Example:
+
+  print MessageBox2
+    'Foo prints 100, Bar 101, Baz 102',
+    [['~Foo' => 100, 'B~ar' => 101, ['Ba~z'] => 102]],
+    'Choose a number to print';
+
+will show a messagebox with
+
+=over 20
+
+=item Title
+
+B<Choose a number to print>,
+
+=item Text
+
+B<Foo prints 100, Bar 101, Baz 102>
+
+=item Icon
+
+INFORMATION ICON
+
+=item Buttons
+
+B<Foo>, B<Bar>, B<Baz>
+
+=item Default button
+
+B<Baz>
+
+=item accelerator keys
+
+B<F>, B<a>, and B<z>
+
+=item return values
+
+100, 101, and 102 correspondingly,
+
+=back
+
+Using
+
+  print MessageBox2
+    'Foo prints 100, Bar 101, Baz 102',
+    [['~Foo' => 100, 'B~ar' => 101, ['Ba~z'] => 102], 'SP#22'],
+    'Choose a number to print';
+
+will show the 22nd system icon as the dialog icon (small folder icon).
+
+=item _MessageBox2($text, $buttons_Icon_struct, [$title, ...])
+
+low-level workhorse to implement MessageBox2().  Differs by the dafault
+$title, and that $buttons_Icon_struct is required, and is a string with
+low-level C struct.
+
+=item process_MB2_INFO($buttons, [$iconID, [$flags, [$notifyWindow]]])
+
+low-level workhorse to implement MessageBox2(); calculates the second
+argument of _MessageBox2().  $buttons is a reference
+to array of button descriptions.  $iconID is either an ID of icon for
+the message box, or a string of the form C<"SP#number">; in the latter case
+the number's system icon is chosen; this field is ignored unless
+$flags contains C<MB_CUSTOMICON> flag.  $flags has the same meaning as mobility,
+modality, and icon flags for MessageBox() with addition of extra flags
+
+     MB_CUSTOMICON         Use a custom icon specified in hIcon. 
+     MB_NONMODAL           Message box is nonmodal
+
+$flags defaults to C<MB_INFORMATION> or C<MB_CUSTOMICON> (depending on whether
+$iconID is non-0), combined with MB_MOVABLE.
+
+Each button's description takes two elements of the description array,
+appearance description, and the return value of MessageBox2() if this
+button is selected.  The appearance description is either an array reference
+of the form C<[$button_Text, $button_Style]>, or the same without
+$button_Style (then style is C<BS_DEFAULT>, making this button the default)
+or just $button_Text (with "normal" style).  E.g., the list
+
+  Foo => 100, Bar => 101, [Baz] => 102
+
+will show three buttons B<Foo>, B<Bar>, B<Baz> with B<Baz> being the default
+button; pressing buttons return 100, 101, or 102 correspondingly.
+
+In particular, exactly one button should have C<BS_DEFAULT> style (e.g.,
+given as C<[$button_Name]>); otherwise the message box will not have keyboard
+focus!  (The only exception is the case of one button; then C<[$button_Name]>
+can be replaced (for convenience) with plain C<$button_Name>.)
+
+If text of the button contains character C<~>, the following character becomes
+the keyboard accelerator for this button.  One can also get the handle
+of system icons directly, so C<'SP#22'> can be replaced by
+C<OS2::Process::get_pointer(22)>; see also C<SPTR_*> constants.
+
+B<NOTE> With C<MB_NONMODAL> the program continues after displaying the
+nonmodal message box.  The message box remains visible until the owner window
+destroys it. Two notification messages, WM_MSGBOXINIT and WM_MSGBOXDISMISS,
+are used to support this non-modality. 
+
+=item LoadPointer($id, [$module, [$hwnd]])
+
+Loads a handle for the pointer $id from the resources of the module
+$module on desktop $hwnd.  If $module is 0 (default), loads from the main
+executable; otherwise from a DLL with the handle $module.
+
+The pointer is owned by the process, and is destroyed by
+DestroyPointer() call, or when the process terminates.
+
+=item SysPointer($id, [$copy, [$hwnd]])
+
+Gets a handle for (a copy of) the system pointer $id (the value should
+be one of C<SPTR_*> constants).  A copy is made if $copy is TRUE (the
+default).  $hwnd defaults to C<HWND_DESKTOP>.
+
+=item get_pointer($id, [$copy, [$hwnd]])
+
+Gets (and caches) a copy of the system pointer.
+
+=back
+
+=head2 Constants used by OS/2 APIs
+
+Function C<os2constant($name)> returns the value of the constant; to
+decrease the memory usage of this package, only the constants used by
+APIs called by Perl functions in this package are made available.
+
+For direct access, see also the L<"EXPORTS"> section; the latter way
+may also provide some performance advantages, since the value of the
+constant is cached.
+
+=head1 OS2::localMorphPM, OS2::localFlashWindow, and OS2::localClipbrd classes
+
+The class C<OS2::localMorphPM> morphs the process to PM for the duration of
+the given scope.
 
   {
     my $h = OS2::localMorphPM->new(0);
@@ -1379,6 +2096,23 @@ This class morphs the process to PM for 
 The argument has the same meaning as one to OS2::MorphPM().  Calls can
 nest with internal ones being NOPs.
 
+Likewise, C<OS2::localClipbrd> class opens the clipboard for the duration
+of the current scope; if TRUE optional argument is given, it would not
+morph the application into PM:
+
+  {
+    my $handle = OS2::localClipbrd->new(1);	# Do not morph into PM
+    # Do something with clipboard here...
+  }
+
+C<OS2::localFlashWindow> behaves similarly; see
+L<"FlashWindow($hwnd,$doFlash)">.
+
+=head1 EXAMPLES
+
+The test suite for this module contains an almost comprehensive collection
+of examples of using the API of this module.
+
 =head1 TODO
 
 Add tests for:
@@ -1397,7 +2131,6 @@ Add tests for:
 	QueryWindow
 	EnumDlgItem
         WindowPtr
-        WindowULong
         WindowUShort
         SetWindowBits
         SetWindowPtr
@@ -1408,12 +2141,18 @@ Add tests for:
 	scrsize
 	scrsize_set
 
-Document and test: Query/SetWindowULong/Short/Ptr, SetWindowBits.
-InvalidateRect, CreateFrameControl, ClipbrdFmtInfo ClipbrdOwner
-ClipbrdViewer ClipbrdData OpenClipbrd CloseClipbrd ClipbrdData_set
-ClipbrdOwner_set ClipbrdViewer_set EnumClipbrdFmts EmptyClipbrd
-AddAtom FindAtom DeleteAtom AtomUsage AtomName AtomLength
-SystemAtomTable CreateAtomTable DestroyAtomTable
+Document: InvalidateRect,
+CreateFrameControls, kbdChar, kbdhChar,
+kbdStatus, _kbdStatus_set, kbdhStatus, kbdhStatus_set,
+vioConfig, viohConfig, vioMode, viohMode, viohMode_set, _vioMode_set,
+_vioState, _vioState_set, vioFont, vioFont_set
+
+Test: SetWindowULong/Short/Ptr, SetWindowBits. InvalidateRect,
+CreateFrameControls, ClipbrdOwner_set, ClipbrdViewer_set, _ClipbrdData_set,
+Alarm, FlashWindow, _MessageBox, MessageBox, _MessageBox2, MessageBox2,
+LoadPointer, SysPointer, kbdChar, kbdhChar, kbdStatus, _kbdStatus_set,
+kbdhStatus,  kbdhStatus_set, vioConfig, viohConfig, vioMode, viohMode,
+viohMode_set, _vioMode_set, _vioState, _vioState_set, vioFont, vioFont_set
 
 Implement SOMETHINGFROMMR.
 
diff -pru perl-5.8.7-min-patched/os2/OS2/Process/Process.xs perl-5.8.7-patched/os2/OS2/Process/Process.xs
--- perl-5.8.7-min-patched/os2/OS2/Process/Process.xs	Thu Sep 11 14:25:38 2003
+++ perl-5.8.7-patched/os2/OS2/Process/Process.xs	Mon Nov 27 20:59:10 2006
@@ -315,8 +315,6 @@ DeclWinFunc_CACHE(BOOL, CreateFrameContr
 DeclWinFunc_CACHE(BOOL, OpenClipbrd, (HAB hab), (hab));
 DeclWinFunc_CACHE(BOOL, EmptyClipbrd, (HAB hab), (hab));
 DeclWinFunc_CACHE(BOOL, CloseClipbrd, (HAB hab), (hab));
-DeclWinFunc_CACHE(HWND, QueryClipbrdViewer, (HAB hab), (hab));
-DeclWinFunc_CACHE(HWND, QueryClipbrdOwner, (HAB hab), (hab));
 DeclWinFunc_CACHE(BOOL, QueryClipbrdFmtInfo, (HAB hab, ULONG fmt, PULONG prgfFmtInfo), (hab, fmt, prgfFmtInfo));
 DeclWinFunc_CACHE(ULONG, QueryClipbrdData, (HAB hab, ULONG fmt), (hab, fmt));
 DeclWinFunc_CACHE(HWND, SetClipbrdViewer, (HAB hab, HWND hwnd), (hab, hwnd));
@@ -324,10 +322,6 @@ DeclWinFunc_CACHE(HWND, SetClipbrdOwner,
 DeclWinFunc_CACHE(ULONG, EnumClipbrdFmts, (HAB hab, ULONG fmt), (hab, fmt));
 DeclWinFunc_CACHE(ATOM, AddAtom, (HATOMTBL hAtomTbl, PCSZ pszAtomName),
 		  (hAtomTbl, pszAtomName));
-DeclWinFunc_CACHE(ATOM, FindAtom, (HATOMTBL hAtomTbl, PCSZ pszAtomName),
-		  (hAtomTbl, pszAtomName));
-DeclWinFunc_CACHE(ATOM, DeleteAtom, (HATOMTBL hAtomTbl, PCSZ pszAtomName),
-		  (hAtomTbl, pszAtomName));
 DeclWinFunc_CACHE(ULONG, QueryAtomUsage, (HATOMTBL hAtomTbl, ATOM atom),
 		  (hAtomTbl, atom));
 DeclWinFunc_CACHE(ULONG, QueryAtomLength, (HATOMTBL hAtomTbl, ATOM atom),
@@ -338,7 +332,6 @@ DeclWinFunc_CACHE(ULONG, QueryAtomName,
 DeclWinFunc_CACHE(HATOMTBL, QuerySystemAtomTable, (VOID), ());
 DeclWinFunc_CACHE(HATOMTBL, CreateAtomTable, (ULONG initial, ULONG buckets),
 		  (initial, buckets));
-DeclWinFunc_CACHE(HATOMTBL, DestroyAtomTable, (HATOMTBL hAtomTbl), (hAtomTbl));
 DeclWinFunc_CACHE(ULONG, MessageBox, (HWND hwndParent, HWND hwndOwner, PCSZ pszText, PCSZ pszCaption, ULONG idWindow, ULONG flStyle), (hwndParent, hwndOwner, pszText, pszCaption, idWindow, flStyle));
 DeclWinFunc_CACHE(ULONG, MessageBox2,
 		  (HWND hwndParent, HWND hwndOwner, PCSZ pszText,
@@ -353,6 +346,13 @@ DeclWinFunc_CACHE(HPOINTER, QuerySysPoin
 DeclWinFunc_CACHE(BOOL, Alarm, (HWND hwndDesktop, ULONG rgfType), (hwndDesktop, rgfType));
 DeclWinFunc_CACHE(BOOL, FlashWindow, (HWND hwndFrame, BOOL fFlash), (hwndFrame, fFlash));
 
+#if 0		/* Need to have the entry points described in the parent */
+DeclWinFunc_CACHE(BOOL, QueryClassInfo, (HAB hab, char* pszClassName, PCLASSINFO pClassInfo), (hab, pszClassName, pClassInfo));
+
+#define _QueryClassInfo(hab, pszClassName, pClassInfo)	\
+	QueryClassInfo(hab, pszClassName, (PCLASSINFO)pClassInfo)
+
+#endif
 
 /* These functions do not croak on error */
 DeclWinFunc_CACHE_survive(BOOL, SetClipbrdData,
@@ -378,6 +378,16 @@ DeclWinFunc_CACHE_resetError(HWND, GetNe
 DeclWinFunc_CACHE_resetError(BOOL, IsWindowEnabled, (HWND hwnd), (hwnd))
 DeclWinFunc_CACHE_resetError(BOOL, IsWindowVisible, (HWND hwnd), (hwnd))
 DeclWinFunc_CACHE_resetError(BOOL, IsWindowShowing, (HWND hwnd), (hwnd))
+DeclWinFunc_CACHE_resetError(ATOM, FindAtom, (HATOMTBL hAtomTbl, PCSZ pszAtomName),
+			     (hAtomTbl, pszAtomName));
+DeclWinFunc_CACHE_resetError(ATOM, DeleteAtom, (HATOMTBL hAtomTbl, ATOM atom),
+			     (hAtomTbl, atom));
+DeclWinFunc_CACHE_resetError(HATOMTBL, DestroyAtomTable, (HATOMTBL hAtomTbl), (hAtomTbl));
+DeclWinFunc_CACHE_resetError(HWND, QueryClipbrdViewer, (HAB hab), (hab));
+DeclWinFunc_CACHE_resetError(HWND, QueryClipbrdOwner, (HAB hab), (hab));
+
+#define _DeleteAtom		DeleteAtom
+#define _DestroyAtomTable	DestroyAtomTable
 
 /* No die()ing on error */
 DeclWinFunc_CACHE_survive(BOOL, IsWindow, (HAB hab, HWND hwnd), (hab, hwnd))
@@ -521,15 +531,22 @@ myWinQueryActiveDesktopPathname()
 SV *
 myWinQueryAtomName(ATOM atom, HATOMTBL hAtomTbl)
 {
-    ULONG len = QueryAtomLength(hAtomTbl, atom);
+  ULONG len = QueryAtomLength(hAtomTbl, atom);
+
+  if (len) {			/* Probably always so... */
     SV *sv = newSVpvn("",0);
     STRLEN n_a;
 
     SvGROW(sv, len + 1);
-    QueryAtomName(hAtomTbl, atom, SvPV(sv, n_a), len);
-    SvCUR_set(sv, len);
-    *SvEND(sv) = 0;
-    return sv;
+    len = QueryAtomName(hAtomTbl, atom, SvPV(sv, n_a), len + 1);
+    if (len) {			/* Probably always so... */
+      SvCUR_set(sv, len);
+      *SvEND(sv) = 0;
+      return sv;
+    }
+    SvREFCNT_dec(sv);
+  }
+  return &PL_sv_undef;
 }
 
 #define myWinQueryClipbrdFmtInfo	QueryClipbrdFmtInfo
@@ -539,26 +556,28 @@ void
 ClipbrdData_set(SV *sv, int convert_nl, unsigned long fmt, unsigned long rgfFmtInfo, HAB hab)
 {
     STRLEN len;
-    char *buf = SvPV_force(sv, len);
-    char *pByte = 0, *s = buf, c;
-    ULONG nls = 0, rc;
-
-    if (convert_nl) {
+    char *buf;
+    char *pByte = 0, *s, c;
+    ULONG nls = 0, rc, handle;
+
+    if (rgfFmtInfo & CFI_POINTER) {
+      s = buf = SvPV_force(sv, len);
+      if (convert_nl) {
 	while ((c = *s++)) {
 	    if (c == '\r' && *s == '\n')
 		s++;
 	    else if (c == '\n')
 		nls++;
 	}
-    }
+      }
 
-    if (CheckOSError(DosAllocSharedMem((PPVOID)&pByte, 0, len + nls + 1,
+      if (CheckOSError(DosAllocSharedMem((PPVOID)&pByte, 0, len + nls + 1,
 				       PAG_WRITE | PAG_COMMIT | OBJ_GIVEABLE | OBJ_GETTABLE)))
 	croak_with_os2error("ClipbrdData_set: DosAllocSharedMem error");
 
-    if (!nls)
+      if (!nls)
 	memcpy(pByte, buf, len + 1);
-    else {
+      else {
 	char *t = pByte, *e = buf + len;
 
 	while (buf < e) {
@@ -566,14 +585,56 @@ ClipbrdData_set(SV *sv, int convert_nl, 
 	    if (c == '\n' && (t == pByte + 1 || t[-2] != '\r'))
 		t[-1] = '\r', *t++ = '\n';
 	}
+      }
+      handle = (ULONG)pByte;
+    } else {
+      handle = (ULONG)SvUV(sv);
     }
 
-    if (!SetClipbrdData(hab, (ULONG)pByte, fmt, rgfFmtInfo)) {
-	DosFreeMem((PPVOID)&pByte);
+    if (!SetClipbrdData(hab, handle, fmt, rgfFmtInfo)) {
+	if (fmt & CFI_POINTER)
+	    DosFreeMem((PPVOID)&pByte);
 	croak_with_os2error("ClipbrdData_set: WinSetClipbrdData error");
     }
 }
 
+ULONG
+QueryMemoryRegionSize(ULONG addr, ULONG *flagp, ULONG len, I32 interrupt)
+{
+    ULONG l, f;				/* Modifiable copy */
+    ULONG rc;
+
+    do {
+	l = len;
+	rc = DosQueryMem((void *)addr, &l, &f);
+    } while ( interrupt ? 0 : rc == ERROR_INTERRUPT );
+
+    /* We assume this is not about addr */
+/*
+    if (rc == ERROR_INVALID_ADDRESS)
+	return 0xFFFFFFFF;
+*/
+    os2cp_croak(rc,"QueryMemoryRegionSize");
+    if (flagp)
+	*flagp = f;
+    return l;
+}
+
+static ULONG
+default_fmtInfo(ULONG fmt)
+{
+   switch (fmt) {
+     case CF_PALETTE:	/* Actually, fmtInfo not documented for palette... */
+     case CF_BITMAP:
+     case CF_METAFILE:
+     case CF_DSPBITMAP:
+     case CF_DSPMETAFILE:
+	return CFI_HANDLE;
+     default:
+	return CFI_POINTER;
+   }
+}
+
 #if 0
 
 ULONG
@@ -1295,6 +1356,55 @@ sidOf(int pid)
   return sid;
 }
 
+STRLEN
+StrLen(ULONG addr, ULONG lim, I32 unitsize)
+{
+    switch (unitsize) {
+      case 1:
+	{
+	    char *s = (char *)addr;
+	    char *s1 = s, *e = (char *)(addr + lim);
+
+	    while (s < e && *s)
+		s++;
+	    return s - s1;
+	}
+	break;
+      case 2:
+	{
+	    short *s = (short *)addr;
+	    short *s1 = s, *e = (short *)(addr + lim);
+
+	    while (s < e && *s)
+		s++;
+	    return (char*)s - (char*)s1;
+	}
+	break;
+      case 4:
+	{
+	    int *s = (int *)addr;
+	    int *s1 = s, *e = (int *)(addr + lim);
+
+	    while (s < e && *s)
+		s++;
+	    return (char*)s - (char*)s1;
+	}
+	break;
+      case 8:
+	{
+	    long long *s = (long long *)addr;
+	    long long *s1 = s, *e = (long long *)(addr + lim);
+
+	    while (s < e && *s)
+		s++;
+	    return (char*)s - (char*)s1;
+	}
+	break;
+      default:
+	croak("StrLen: unknown unitsize %d", (int)unitsize);
+    }
+}
+
 #define ulMPFROMSHORT(i)		((unsigned long)MPFROMSHORT(i))
 #define ulMPVOID()			((unsigned long)MPVOID)
 #define ulMPFROMCHAR(i)			((unsigned long)MPFROMCHAR(i))
@@ -1367,6 +1477,8 @@ swentries_list()
 
 void
 ResetWinError()
+   POSTCALL:
+	XSRETURN_YES;
 
 int
 WindowText_set(HWND hwndFrame, char *title)
@@ -1503,6 +1615,8 @@ _kbdStatus(int handle = 0)
 
 void
 _kbdStatus_set(SV *sv, int handle = 0)
+   POSTCALL:
+	XSRETURN_YES;
 
 SV*
 _vioConfig(int which = 0, int handle = 0)
@@ -1512,38 +1626,51 @@ _vioMode()
 
 void
 _vioMode_set(SV *buffer)
+   POSTCALL:
+	XSRETURN_YES;
 
 SV*
 _vioState(int what, int first = -1, int count = -1)
 
 void
 _vioState_set(SV *buffer)
+   POSTCALL:
+	XSRETURN_YES;
 
 SV*
 vioFont( int type = 0, OUTLIST int w, OUTLIST int h)
 
 void
 vioFont_set(SV *buffer, int cellwidth, int cellheight, int type = 0)
+   POSTCALL:
+	XSRETURN_YES;
 
 NO_OUTPUT bool
-_ClipbrdData_set(unsigned long ulData, unsigned long fmt = CF_TEXT, unsigned long rgfFmtInfo = ((fmt == CF_TEXT || fmt == CF_DSPTEXT) ? CFI_POINTER : CFI_HANDLE), HAB hab = perl_hab_GET())
+_ClipbrdData_set(unsigned long ulData, unsigned long fmt = CF_TEXT, unsigned long rgfFmtInfo = default_fmtInfo(fmt), HAB hab = perl_hab_GET())
     PROTOTYPE: DISABLE
     C_ARGS: hab, ulData, fmt, rgfFmtInfo
     POSTCALL:
 	if (CheckWinError(RETVAL))
 	    croak_with_os2error("_ClipbrdData_set() error");
+	XSRETURN_YES;
 
 void
-ClipbrdData_set(SV *text, int convert_nl = 1, unsigned long fmt = CF_TEXT, unsigned long rgfFmtInfo = ((fmt == CF_TEXT || fmt == CF_DSPTEXT) ? CFI_POINTER : CFI_HANDLE), HAB hab = perl_hab_GET())
+ClipbrdData_set(SV *text, int convert_nl = 1, unsigned long fmt = CF_TEXT, unsigned long rgfFmtInfo = default_fmtInfo(fmt), HAB hab = perl_hab_GET())
     PROTOTYPE: DISABLE
+    POSTCALL:
+	XSRETURN_YES;
 
 void
 ClipbrdOwner_set(HWND hwnd, HAB hab = perl_hab_GET())
     C_ARGS: hab, hwnd
+    POSTCALL:
+	XSRETURN_YES;
 
 void
 ClipbrdViewer_set(HWND hwnd, HAB hab = perl_hab_GET())
     C_ARGS: hab, hwnd
+    POSTCALL:
+	XSRETURN_YES;
 
 unsigned long
 EnumClipbrdFmts(unsigned long fmt = 0, HAB hab = perl_hab_GET())
@@ -1558,15 +1685,31 @@ FindAtom(char *pszAtomName, HATOMTBL hAt
     C_ARGS: hAtomTbl, pszAtomName
 
 unsigned long
-DeleteAtom(char *pszAtomName, HATOMTBL hAtomTbl = QuerySystemAtomTable())
-    C_ARGS: hAtomTbl, pszAtomName
+_DeleteAtom(ATOM atom, HATOMTBL hAtomTbl = QuerySystemAtomTable())
+    PROTOTYPE: DISABLE
+    C_ARGS: hAtomTbl, atom
+
+#if 0
+
+unsigned long
+WinDeleteAtom(ATOM atom, HATOMTBL hAtomTbl = QuerySystemAtomTable())
+    C_ARGS: hAtomTbl, atom
+
+#endif
 
 void
 Alarm(unsigned long rgfType = WA_ERROR, HWND hwndDesktop = HWND_DESKTOP)
     C_ARGS: hwndDesktop, rgfType
+    POSTCALL:
+	XSRETURN_YES;
 
 void
 FlashWindow(HWND hwndFrame, bool fFlash)
+    POSTCALL:
+	XSRETURN_YES;
+
+STRLEN
+StrLen(ULONG addr, ULONG lim, I32 unitsize = 1)
 
 MODULE = OS2::Process		PACKAGE = OS2::Process	PREFIX = myQuery
 
@@ -1604,6 +1747,9 @@ QueryClipbrdData(unsigned long fmt = CF_
     C_ARGS: hab, fmt
     PROTOTYPE: DISABLE
 
+ULONG
+QueryMemoryRegionSize(ULONG addr, OUTLIST ULONG flagp, ULONG len = 0xFFFFFFFF - addr, I32 interrupt = 1)
+
 unsigned long
 QueryClipbrdViewer(HAB hab = perl_hab_GET())
 
@@ -1612,9 +1758,13 @@ QueryClipbrdOwner(HAB hab = perl_hab_GET
 
 void
 CloseClipbrd(HAB hab = perl_hab_GET())
+    POSTCALL:
+	XSRETURN_YES;
 
 void
 EmptyClipbrd(HAB hab = perl_hab_GET())
+   POSTCALL:
+	XSRETURN_YES;
 
 bool
 OpenClipbrd(HAB hab = perl_hab_GET())
@@ -1626,6 +1776,9 @@ QueryAtomUsage(ATOM atom, HATOMTBL hAtom
 unsigned long
 QueryAtomLength(ATOM atom, HATOMTBL hAtomTbl = QuerySystemAtomTable())
     C_ARGS: hAtomTbl, atom
+   POSTCALL:
+	if (!RETVAL)
+	    XSRETURN_EMPTY;
 
 unsigned long
 QuerySystemAtomTable()
@@ -1638,7 +1791,8 @@ unsigned long
 CreateAtomTable(unsigned long initial = 0, unsigned long buckets = 0)
 
 unsigned long
-DestroyAtomTable(HATOMTBL hAtomTbl)
+_DestroyAtomTable(HATOMTBL hAtomTbl)
+    PROTOTYPE: DISABLE
 
 
 MODULE = OS2::Process		PACKAGE = OS2::Process	PREFIX = myWinQuery
@@ -1673,20 +1827,20 @@ myWinSwitchToProgram(HSWITCH hsw = switc
 #if 0
 
 unsigned long
-myWinMessageBox(unsigned long pszText, char* pszCaption = "Perl script error", unsigned long flStyle = MB_CANCEL | MB_ICONHAND, HWND hwndParent = HWND_DESKTOP, HWND hwndOwner = HWND_DESKTOP, unsigned long idWindow = 0)
+myWinMessageBox(unsigned long pszText, char* pszCaption = "Perl script message", unsigned long flStyle = MB_CANCEL | MB_ICONHAND, HWND hwndParent = HWND_DESKTOP, HWND hwndOwner = HWND_DESKTOP, unsigned long idWindow = 0)
     C_ARGS: hwndParent, hwndOwner, pszText, pszCaption, idWindow, flStyle
 
 #endif
 
 unsigned long
-_MessageBox(char* pszText, char* pszCaption = "Perl script error", unsigned long flStyle = MB_CANCEL | MB_INFORMATION | MB_MOVEABLE, HWND hwndParent = HWND_DESKTOP, HWND hwndOwner = NULLHANDLE, unsigned long idWindow = 0)
+_MessageBox(char* pszText, char* pszCaption = "Perl script message", unsigned long flStyle = MB_CANCEL | MB_INFORMATION | MB_MOVEABLE, HWND hwndParent = HWND_DESKTOP, HWND hwndOwner = NULLHANDLE, unsigned long idWindow = 0)
     C_ARGS: hwndParent, hwndOwner, pszText, pszCaption, idWindow, flStyle
     POSTCALL:
 	if (RETVAL == MBID_ERROR)
 	    RETVAL = 0;
 
 unsigned long
-_MessageBox2(char *pszText, char* pmb2info, char *pszCaption, HWND hwndParent = HWND_DESKTOP, HWND hwndOwner = NULLHANDLE, unsigned long idWindow = 0)
+_MessageBox2(char *pszText, char* pmb2info, char *pszCaption = "Perl script message", HWND hwndParent = HWND_DESKTOP, HWND hwndOwner = NULLHANDLE, unsigned long idWindow = 0)
     C_ARGS: hwndParent, hwndOwner, pszText, pszCaption, idWindow, (PMB2INFO)pmb2info
     POSTCALL:
 	if (RETVAL == MBID_ERROR)
diff -pru perl-5.8.7-min-patched/os2/OS2/Process/t/os2_atoms.t perl-5.8.7-patched/os2/OS2/Process/t/os2_atoms.t
--- perl-5.8.7-min-patched/os2/OS2/Process/t/os2_atoms.t	Mon Nov 27 21:04:06 2006
+++ perl-5.8.7-patched/os2/OS2/Process/t/os2_atoms.t	Mon Nov 27 20:59:10 2006
@@ -0,0 +1,88 @@
+#! /usr/bin/perl -w
+
+use strict;
+use Test::More tests => 48;
+BEGIN {use_ok 'OS2::Process'}
+
+ok(SystemAtomTable(), 'SystemAtomTable succeeds');
+my $tbl = CreateAtomTable;
+
+ok($tbl, 'CreateAtomTable succeeds');
+
+is(AtomLength(133, $tbl), 6, 'AtomLength of unknown atom is 6');
+is(AtomLength(1, $tbl),   6, 'AtomLength of unknown atom is 6');
+ok(!defined eval {AtomLength(100000, $tbl); 1}, 'AtomLength of invalid atom croaks');
+# diag($@);
+
+is(AtomUsage(134, $tbl), 65535, 'AtomUsage of unknown atom is 65535');
+is(AtomUsage(1, $tbl),   65535, 'AtomUsage of unknown atom is 65535');
+ok(!defined eval {AtomUsage(100000, $tbl); 1}, 'AtomUsage of invalid atom croaks');
+# diag($@);
+
+is(AtomName(134, $tbl), '#134', 'AtomName of unknown atom is #number');
+is(AtomName(2, $tbl),     '#2', 'AtomName of unknown atom is #number');
+ok(!defined eval {AtomName(100000, $tbl); 1}, 'AtomName of invalid atom croaks');
+# diag($@);
+
+is(FindAtom('#134', $tbl), 134, 'Name of unknown atom per #number');
+is(FindAtom('#2', $tbl),     2, 'Name of unknown atom per #number');
+ok(!defined eval {FindAtom('#90000', $tbl); 1}, 'Finding invalid numeric atom croaks');
+# diag($@);
+ok(!defined eval {FindAtom('2#', $tbl); 1}, 'Finding invalid atom croaks');
+# diag($@);
+ok(!defined eval {FindAtom('texxt/unnknnown', $tbl); 1}, 'Finding invalid atom croaks');
+# diag($@);
+
+is(DeleteAtom(125000, $tbl), '', 'Deleting invalid atom returns FALSE');
+is(DeleteAtom(10000,  $tbl), 1, 'Deleting unknown atom returns 1');
+ok(!defined eval {DeleteAtom(0, $tbl); 1}, 'Deleting zero atom croaks');
+# diag($@);
+
+is(AddAtom('#134', $tbl), 134, 'Add unknown atom per #number');
+is(AddAtom('#2', $tbl),     2, 'Add unknown atom per #number');
+ok(!defined eval {AddAtom('#80000', $tbl); 1}, 'Add invalid numeric atom croaks');
+# diag($@);
+
+my $a1 = AddAtom("perltest//pp$$", $tbl);
+ok($a1, 'Add unknown atom per string');
+my $a2 = AddAtom("perltest//p$$", $tbl);
+ok($a2, 'Add another unknown atom per string');
+is(AddAtom("perltest//p$$", $tbl), $a2, 'Add same unknown atom per string');
+isnt($a1, $a2, 'Different strings result in different atoms');
+ok($a1 > 0, 'Atom positive');
+ok($a2 > 0, 'Another atom positive');
+ok($a1 < 0x10000, 'Atom small');
+ok($a2 < 0x10000, 'Another atom small');
+
+is(AtomLength($a1, $tbl), length "perltest//pp$$", 'AtomLength of known atom');
+is(AtomLength($a2, $tbl), length "perltest//p$$", 'AtomLength of another known atom');
+
+is(AtomUsage($a1, $tbl), 1, 'AtomUsage of known atom');
+is(AtomUsage($a2, $tbl), 2, 'AtomUsage of another known atom');
+
+is(AtomName($a1, $tbl), "perltest//pp$$", 'AtomName of known atom');
+is(AtomName($a2, $tbl), "perltest//p$$", 'AtomName of another known atom');
+
+is(FindAtom("perltest//pp$$", $tbl), $a1, 'Name of known atom');
+is(FindAtom("perltest//p$$", $tbl),  $a2, 'Name of known atom');
+
+#$^E = 0;
+ok(DeleteAtom($a1, $tbl), 'DeleteAtom of known atom');
+#diag("err=$^E");
+#$^E = 0;
+ok(DeleteAtom($a2, $tbl), 'DeleteAtom of another known atom');
+#diag("err=$^E");
+
+ok(!defined eval {AtomUsage($a1, $tbl); 1}, 'AtomUsage of deleted known atom croaks');
+# diag($@);
+is(AtomUsage($a2, $tbl), 1, 'AtomUsage of another known atom');
+
+ok(!defined eval {AtomName($a1, $tbl); 1}, 'AtomName of deleted known atom croaks');
+# diag($@);
+is(AtomName($a2, $tbl), "perltest//p$$", 'AtomName of undeleted another known atom');
+
+ok(!defined eval {FindAtom("perltest//pp$$", $tbl); 1}, 'Finding known deleted atom croaks');
+# diag($@);
+is(FindAtom("perltest//p$$", $tbl),  $a2, 'Finding known undeleted atom');
+
+ok(DestroyAtomTable($tbl), 'DestroyAtomTable succeeds');
diff -pru perl-5.8.7-min-patched/os2/OS2/Process/t/os2_clipboard.t perl-5.8.7-patched/os2/OS2/Process/t/os2_clipboard.t
--- perl-5.8.7-min-patched/os2/OS2/Process/t/os2_clipboard.t	Mon Nov 27 21:04:06 2006
+++ perl-5.8.7-patched/os2/OS2/Process/t/os2_clipboard.t	Mon Nov 27 20:59:10 2006
@@ -0,0 +1,211 @@
+#! /usr/bin/perl -w
+
+use strict;
+use Test::More tests => 87;
+BEGIN {use_ok 'OS2::Process', qw(:DEFAULT CFI_POINTER CF_TEXT)}
+
+# Initialize
+my $raw = "Just a random\nselection";
+(my $cr = $raw) =~ s/\n/\r\n/g;
+ok(ClipbrdText_set($raw), 'ClipbrdText_set');
+
+my ($v, $p, @f);
+is(ClipbrdText, $cr, "ClipbrdText it back");
+is(ClipbrdOwner, 0, "ClipbrdOwner is not defined");
+$v = ClipbrdViewer;
+ok((!$v || IsWindow $v), "ClipbrdViewer is not defined or a valid window");
+
+{
+  my $h = OS2::localClipbrd->new;
+  $p = ClipbrdData;
+
+  @f = MemoryRegionSize($p, 0x4000);		# 4 pages, 16K, limit
+  is(scalar @f, 2, 'MemoryRegionSize(16K) returns 2 values');
+  # diag(sprintf '%#x, %#x, %#x, %#x', @f, $f[0]+$p, $p);
+  is($f[0], 4096, 'MemoryRegionSize claims 1 page is available');
+  ok($f[1] & 0x1, 'MemoryRegionSize claims page readable');# PAG_READ=1 0x12013
+
+  my @f1 = MemoryRegionSize($p, 0x100000);		# 16 blocks, 1M, limit
+  is(scalar @f1, 2, 'MemoryRegionSize(1M) returns 2 values');
+  is($f1[0], $f[0], 'MemoryRegionSize returns same length');
+  is($f1[1], $f[1], 'MemoryRegionSize returns same flags');
+
+  @f1 = MemoryRegionSize($p);
+  is(scalar @f1, 2, 'MemoryRegionSize(no-limit) returns 2 values');
+  is($f1[0], $f[0], 'MemoryRegionSize returns same length');
+  is($f1[1], $f[1], 'MemoryRegionSize returns same flags');
+}
+
+ok($p, 'ClipbrdData');
+
+is(ClipbrdFmtInfo, CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
+
+# CF_TEXT is 1
+ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(not CF_TEXT) croaks");
+like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
+
+@f = ClipbrdFmtAtoms;
+is(scalar @f, 1, "Only one format available");
+is($f[0], CF_TEXT, "format is CF_TEXT");
+
+@f = ClipbrdFmtNames;
+is(scalar @f, 1, "Only one format available");
+is($f[0], '#1', "format is CF_TEXT='#1'");
+
+{
+  my $h = OS2::localClipbrd->new;
+  ok(EmptyClipbrd, 'EmptyClipbrd');
+}
+
+@f = ClipbrdFmtNames;
+is(scalar @f, 0, "No format available");
+
+undef $p; undef $v;
+eval {
+  my $h = OS2::localClipbrd->new;
+  $p = ClipbrdData;
+  $v = 1;
+};
+
+ok(! defined $p, 'ClipbrdData croaked');
+like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
+
+ok(! defined eval {ClipbrdText}, "ClipbrdText croaks");
+like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
+
+# CF_TEXT is 1
+ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(not CF_TEXT) croaks");
+like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
+
+is(ClipbrdOwner, 0, "ClipbrdOwner is not defined");
+
+$v = ClipbrdViewer;
+ok((!$v || IsWindow $v), "ClipbrdViewer is not defined or a valid window");
+
+is(ClipbrdFmtInfo, 0, 'ClipbrdFmtInfo is 0');
+
+@f = ClipbrdFmtAtoms;
+is(scalar @f, 0, "No formats available");
+
+{
+  my $h = OS2::localClipbrd->new;
+  ok(EmptyClipbrd, 'EmptyClipbrd when clipboard is empty succeeds');
+}
+
+ok(ClipbrdText_set($raw, 1), 'ClipbrdText_set() raw');
+is(ClipbrdText, $raw, "ClipbrdText it back");
+
+{
+  my $h = OS2::localClipbrd->new;
+  ok(EmptyClipbrd, 'EmptyClipbrd again');
+}
+
+my $ar = AddAtom 'perltest/unknown_raw';
+ok($ar, 'Atom added');
+my $ar1 = AddAtom 'perltest/unknown_raw1';
+ok($ar1, 'Atom added');
+my $a = AddAtom 'perltest/unknown';
+ok($a, 'Atom added');
+my $a1 = AddAtom 'perltest/unknown1';
+ok($a1, 'Atom added');
+
+{
+  my $h = OS2::localClipbrd->new;
+  ok(ClipbrdData_set($raw), 	     'ClipbrdData_set()');
+  ok(ClipbrdData_set($raw, 0, $ar1), 'ClipbrdData_set(perltest/unknown_raw1)');
+  ok(ClipbrdData_set($cr,  0, $ar),  'ClipbrdData_set(perltest/unknown_raw)');
+  ok(ClipbrdData_set($raw, 1, $a1),  'ClipbrdData_set(perltest/unknown1)');
+  ok(ClipbrdData_set($cr,  1, $a),   'ClipbrdData_set(perltest/unknown)');
+  # Results should be the same, except ($raw, 0) one...
+}
+
+is(ClipbrdText, $cr,	    "ClipbrdText CF_TEXT back");
+is(ClipbrdText($ar1), $raw, "ClipbrdText perltest/unknown_raw1 back");
+is(ClipbrdText($ar), $cr,   "ClipbrdText perltest/unknown_raw back");
+is(ClipbrdText($a1), $cr,   "ClipbrdText perltest/unknown1 back");
+is(ClipbrdText($a), $cr,    "ClipbrdText perltest/unknown back");
+
+is(ClipbrdFmtInfo,	 CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
+is(ClipbrdFmtInfo($ar1), CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
+is(ClipbrdFmtInfo($ar),  CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
+is(ClipbrdFmtInfo($a1),  CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
+is(ClipbrdFmtInfo($a),   CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
+
+# CF_TEXT is 1
+ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(1+CF_TEXT) croaks");
+like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
+
+my $names = join ',', sort '#1', qw(perltest/unknown perltest/unknown1
+				    perltest/unknown_raw perltest/unknown_raw1);
+@f = ClipbrdFmtAtoms;
+is(scalar @f, 5, "5 formats available");
+is((join ',', sort map AtomName($_), @f), $names, "formats are $names");
+
+@f = ClipbrdFmtNames;
+is(scalar @f, 5, "Only one format available");
+is((join ',', sort @f), $names, "formats are $names");
+
+{
+  my $h = OS2::localClipbrd->new;
+  ok(EmptyClipbrd, 'EmptyClipbrd');
+}
+
+@f = ClipbrdFmtNames;
+is(scalar @f, 0, "No formats available");
+
+{
+  my $h = OS2::localClipbrd->new;
+  ok(ClipbrdText_set($cr,  1, $ar),  'ClipbrdText_set(perltest/unknown_raw)');
+};
+
+#diag(join ' ', ClipbrdFmtNames);
+
+is(ClipbrdText($ar), $cr,   "ClipbrdText perltest/unknown_raw back");
+is(ClipbrdFmtInfo($ar),  CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
+
+ok(!defined eval {ClipbrdText(CF_TEXT); 1}, "ClipbrdText(CF_TEXT) croaks");
+like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
+# CF_TEXT is 1
+ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(1+CF_TEXT) croaks");
+like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
+
+@f = ClipbrdFmtNames;
+is(scalar @f, 1, "1 format available");
+is($f[0], 'perltest/unknown_raw', "format is perltest/unknown_raw");
+
+@f = ClipbrdFmtAtoms;
+is(scalar @f, 1, "1 format available");
+is($f[0], $ar, "format is perltest/unknown_raw");
+
+{
+  my $h = OS2::localClipbrd->new;
+  ok(EmptyClipbrd, 'EmptyClipbrd');
+}
+
+undef $p; undef $v;
+eval {
+  my $h = OS2::localClipbrd->new;
+  $p = ClipbrdData;
+  $v = 1;
+};
+
+ok(! defined $p, 'ClipbrdData croaked');
+like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
+
+ok(! defined eval {ClipbrdText}, "ClipbrdText croaks");
+like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
+
+# CF_TEXT is 1
+ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(not CF_TEXT) croaks");
+like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
+
+is(ClipbrdOwner, 0, "ClipbrdOwner is not defined");
+
+$v = ClipbrdViewer;
+ok((!$v || IsWindow $v), "ClipbrdViewer is not defined or a valid window");
+
+is(ClipbrdFmtInfo, 0, 'ClipbrdFmtInfo is 0');
+
+@f = ClipbrdFmtAtoms;
+is(scalar @f, 0, "No formats available");
+
diff -pru perl-5.8.7-min-patched/os2/OS2/Process/t/os2_process.t perl-5.8.7-patched/os2/OS2/Process/t/os2_process.t
--- perl-5.8.7-min-patched/os2/OS2/Process/t/os2_process.t	Wed Sep 17 00:14:46 2003
+++ perl-5.8.7-patched/os2/OS2/Process/t/os2_process.t	Mon Nov 27 20:59:10 2006
@@ -24,7 +24,7 @@ BEGIN {			# Remap I/O to the parent's wi
 }
 
 use strict;
-use Test::More tests => 232;
+use Test::More tests => 235;
 use OS2::Process;
 
 sub SWP_flags ($) {
@@ -218,18 +218,28 @@ is($fhwnd, $ahwnd, 'the focus window = t
 ok hWindowPos_set({behind => 3}, $k_hwnd),	# HWND_TOP
   'put kid to the front';
 
-is((hWindowPos $k_hwnd)->{behind}, 3, 'kis is at front');
+# After Alt-Tab a WS_TOPMOST, WS_DISABLED window of class 'AltTabWindow' exists
+my $top = (hWindowPos $k_hwnd)->{behind};
+ok(($top == 3 or WindowStyle($top) & 0x200000),	# HWND_TOP, WS_TOPMOST
+   'kid is at front');
+# is((hWindowPos $k_hwnd)->{behind}, 3, 'kid is at front');
 
-my ($enum_handle, $first_zorder);
+my ($enum_handle, $first_zorder, $first_non_TOPMOST);
 { my $force_PM = OS2::localMorphPM->new(0);
   ok $force_PM, 'morphed to PM locally again';
   $enum_handle = BeginEnumWindows 1;		# HWND_DESKTOP
   ok $enum_handle, 'start enumeration';
-  $first_zorder = GetNextWindow $enum_handle;
+  $first_non_TOPMOST = $first_zorder = GetNextWindow $enum_handle;
   ok $first_zorder, 'GetNextWindow works';
+  my $f = WindowStyle $first_non_TOPMOST;
+  ok $f, 'WindowStyle works';
+  $f = WindowStyle($first_non_TOPMOST = GetNextWindow $enum_handle)
+    while $f & 0x200000;				# WS_TOPMOST
+  ok($first_non_TOPMOST, 'There is non-TOPMOST window');
+  ok(!(WindowStyle($first_non_TOPMOST) & 0x200000), 'Indeed non-TOPMOST');
   ok EndEnumWindows($enum_handle), 'end enumeration';
 }
-is ($first_zorder, $k_hwnd, 'kid is the first in z-order enumeration');
+is ($first_non_TOPMOST, $k_hwnd, 'kid is the first in z-order enumeration');
 
 ok hWindowPos_set({behind => 4}, $k_hwnd),	# HWND_BOTTOM
   'put kid to the back';
@@ -262,7 +272,9 @@ is $list[-2], $k_hwnd, 'kid is the last 
 ok hWindowPos_set({behind => 3}, $k_hwnd),	# HWND_TOP
   'put kid to the front again';
 
-is((hWindowPos $k_hwnd)->{behind}, 3, 'kis is at front again');
+$top = (hWindowPos $k_hwnd)->{behind};
+ok(($top == 3 or WindowStyle($top) & 0x200000),	# WS_TOPMOST
+   'kid is at front again');
 sleep 5 if $interactive_wait;
 
 ok IsWindow($k_hwnd), 'IsWindow works';
