X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=os2%2Fos2.c;h=9448fdc717b32a5b95a5a5e55e2e82feb4dd2b23;hb=2c09a866c8998f757d628460ed585e1cb8011792;hp=776031d17b764afd6a7a2c5d436d5c5576d73351;hpb=1933e12cd0d32c774bd7f483285802de52dc8cbc;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/os2/os2.c b/os2/os2.c
index 776031d..9448fdc 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -360,7 +360,7 @@ pthread_startit(void *arg1)
 	    Renew(thread_join_data, thread_join_count, thread_join_t);
 	    Zero(thread_join_data + oc, thread_join_count - oc, thread_join_t);
 	} else {
-	    Newz(1323, thread_join_data, thread_join_count, thread_join_t);
+	    Newxz(thread_join_data, thread_join_count, thread_join_t);
 	}
     }
     if (thread_join_data[tid].state != pthreads_st_none) {
@@ -490,7 +490,7 @@ os2_cond_wait(perl_cond *c, perl_mutex *m)
     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))
@@ -789,7 +789,7 @@ get_sysinfo(ULONG pid, ULONG flags)
 		return 0;
         }
     }
-    New(1322, pbuffer, buf_len, char);
+    Newx(pbuffer, buf_len, char);
     /* QSS_PROCESS | QSS_MODULE | QSS_SEMAPHORES | QSS_SHARED */
     rc = QuerySysState(flags, pid, pbuffer, buf_len);
     while (rc == ERROR_BUFFER_OVERFLOW) {
@@ -998,7 +998,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag)
 	if (flag == P_WAIT)
 		flag = P_NOWAIT;
 	if (really && !*(real_name = SvPV(really, n_a)))
-	    really = Nullsv;
+	    really = NULL;
 
       retry:
 	if (strEQ(PL_Argv[0],"/bin/sh")) 
@@ -1265,7 +1265,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag)
 				/* XXXX This is good only until we refuse
 				        quoted arguments... */
 				PL_Argv[0] = inicmd;
-				PL_Argv[1] = Nullch;
+				PL_Argv[1] = NULL;
 			    }
 			} else if (!buf[0] && inicmd) { /* No file */
 			    /* Start with the original cmdline. */
@@ -1273,7 +1273,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag)
 			            quoted arguments... */
 
 			    PL_Argv[0] = inicmd;
-			    PL_Argv[1] = Nullch;
+			    PL_Argv[1] = NULL;
 			    nargs = 2;	/* shell -c */
 			} 
 
@@ -1374,7 +1374,7 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag)
     if (strnEQ(cmd,"/bin/sh",7) && isSPACE(cmd[7])) {
 	STRLEN l = strlen(PL_sh_path);
 	
-	New(1302, news, strlen(cmd) - 7 + l + 1, char);
+	Newx(news, strlen(cmd) - 7 + l + 1, char);
 	strcpy(news, PL_sh_path);
 	strcpy(news + l, cmd + 7);
 	cmd = news;
@@ -1447,7 +1447,7 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag)
     }
 
     /* cmd="a" may lead to "sh", "-c", "\"$@\"", "a", "a.cmd", NULL */
-    New(1303,PL_Argv, (s - cmd + 11) / 2, char*);
+    Newx(PL_Argv, (s - cmd + 11) / 2, char*);
     PL_Cmd = savepvn(cmd, s-cmd);
     a = PL_Argv;
     for (s = PL_Cmd; *s;) {
@@ -1458,7 +1458,7 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag)
 	if (*s)
 	    *s++ = '\0';
     }
-    *a = Nullch;
+    *a = NULL;
     if (PL_Argv[0])
 	rc = do_spawn_ve(aTHX_ NULL, flag, execf, cmd, mergestderr);
     else
@@ -1469,42 +1469,47 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag)
     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) {
-	New(1301,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;
+	*a = NULL;
 
 	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 SV **vmark, register SV **vsp, int execin
 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
@@ -1538,7 +1543,7 @@ do_spawn_nowait(pTHX_ char *cmd)
 }
 
 bool
-Perl_do_exec(pTHX_ char *cmd)
+Perl_do_exec(pTHX_ const char *cmd)
 {
     do_spawn3(aTHX_ cmd, EXECF_EXEC, 0);
     return FALSE;
@@ -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];
@@ -1568,7 +1573,7 @@ my_syspopen(pTHX_ char *cmd, char *mode)
 	taint_proper("Insecure %s%s", "EXEC");
     }
     if (pipe(p) < 0)
-	return Nullfp;
+	return NULL;
     /* Now we need to spawn the child. */
     if (p[this] == (*mode == 'r')) {	/* if fh 0/1 was initially closed. */
 	int new = dup(p[this]);
@@ -1587,7 +1592,7 @@ my_syspopen(pTHX_ char *cmd, char *mode)
 	  closepipes:
 	    close(p[0]);
 	    close(p[1]);
-	    return Nullfp;
+	    return NULL;
 	}
     } else
 	fh_fl = fcntl(*mode == 'r', F_GETFD);
@@ -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_ NULL, 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 */
@@ -1612,7 +1620,7 @@ my_syspopen(pTHX_ char *cmd, char *mode)
 	close(p[that]);
     if (pid == -1) {
 	close(p[this]);
-	return Nullfp;
+	return NULL;
     }
     if (p[that] < p[this]) {		/* Make fh as small as possible */
 	dup2(p[this], p[that]);
@@ -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
@@ -1862,13 +1879,13 @@ XS(XS_OS2_replaceModule)
 	Perl_croak(aTHX_ "Usage: OS2::replaceModule(target [, source [, backup]])");
     {
 	char *	target = (char *)SvPV_nolen(ST(0));
-	char *	source = (items < 2) ? Nullch : (char *)SvPV_nolen(ST(1));
-	char *	backup = (items < 3) ? Nullch : (char *)SvPV_nolen(ST(2));
+	char *	source = (items < 2) ? NULL : (char *)SvPV_nolen(ST(1));
+	char *	backup = (items < 3) ? NULL : (char *)SvPV_nolen(ST(2));
 
 	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])));
@@ -2053,7 +2072,7 @@ os2error(int rc)
 	dTHX;
 	ULONG len;
 	char *s;
-	int number = SvTRUE(get_sv("OS2::nsyserror", TRUE));
+	int number = SvTRUE(get_sv("OS2::nsyserror", GV_ADD));
 
         if (!(_emx_env & 0x200)) return ""; /* Nop if not OS/2. */
 	if (rc == 0)
@@ -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 ? "=" : ""));
@@ -2125,7 +2159,7 @@ dllname2buffer(pTHX_ char *buf, STRLEN l)
 {
     char *o;
     STRLEN ll;
-    SV *dll = Nullsv;
+    SV *dll = NULL;
 
     dll = module_name(mod_name_full);
     o = SvPV(dll, ll);
@@ -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)		/* DosSetRelMaxFH */
     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_nolen(ST(0)) : 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 = NULL;
+	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);
+		mPUSHu(PipeState);
+		/*   Bytes (available/in-message) */
+		mPUSHi(BytesAvail.cbpipe);
+		mPUSHi(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);
+		mPUSHp(b.pInfo.szName, size);
+		mPUSHu(b.id);
+		mPUSHi(b.pInfo.cbOut);
+		mPUSHi(b.pInfo.cbIn);
+		mPUSHi(b.pInfo.cbMaxInst);
+		mPUSHi(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_nolen(ST(0)) : 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
@@ -4377,7 +4885,7 @@ check_emx_runtime(char **env, EXCEPTIONREGISTRATIONRECORD *preg)
 	    c++;
 	    e = e + strlen(e) + 1;
 	}
-	New(1307, env, c + 1, char*);
+	Newx(env, c + 1, char*);
 	ep = env;
 	e = pib->pib_pchenv;
 	while (c--) {
@@ -4436,10 +4944,10 @@ Perl_OS2_init3(char **env, void **preg, int flags)
     if (perl_sh_installed) {
 	int l = strlen(perl_sh_installed);
 
-	New(1304, PL_sh_path, l + 1, char);
+	Newx(PL_sh_path, l + 1, char);
 	memcpy(PL_sh_path, perl_sh_installed, l + 1);
     } else if ( (shell = getenv("PERL_SH_DRIVE")) ) {
-	New(1304, PL_sh_path, strlen(SH_PATH) + 1, char);
+	Newx(PL_sh_path, strlen(SH_PATH) + 1, char);
 	strcpy(PL_sh_path, SH_PATH);
 	PL_sh_path[0] = shell[0];
     } else if ( (shell = getenv("PERL_SH_DIR")) ) {
@@ -4447,7 +4955,7 @@ Perl_OS2_init3(char **env, void **preg, int flags)
 
 	while (l && (shell[l-1] == '/' || shell[l-1] == '\\'))
 	    l--;
-	New(1304, PL_sh_path, l + 8, char);
+	Newx(PL_sh_path, l + 8, char);
 	strncpy(PL_sh_path, shell, l);
 	strcpy(PL_sh_path + l, "/sh.exe");
 	for (i = 0; i < l; i++) {
@@ -4567,7 +5075,7 @@ my_rmdir (__const__ char *s)
 
     if (s[l-1] == '/' || s[l-1] == '\\') {	/* EMX mkdir fails... */
 	if (l >= sizeof b)
-	    New(1305, buf, l + 1, char);
+	    Newx(buf, l + 1, char);
 	strcpy(buf,s);
 	while (l > 1 && (s[l-1] == '/' || s[l-1] == '\\'))
 	    l--;
@@ -4592,7 +5100,7 @@ my_mkdir (__const__ char *s, long perm)
 
     if (s[l-1] == '/' || s[l-1] == '\\') {	/* EMX mkdir fails... */
 	if (l >= sizeof b)
-	    New(1305, buf, l + 1, char);
+	    Newx(buf, l + 1, char);
 	strcpy(buf,s);
 	while (l > 1 && (s[l-1] == '/' || s[l-1] == '\\'))
 	    l--;