X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=os2%2Fos2.c;h=7fe8113588728ae3ec58a55cce7eaf6844e53bda;hb=dc5c060f96a5de06c9e1797503c70e8155e23e3e;hp=45e1d2fb65a9e75e111e93772de671b77bc49c6e;hpb=23da6c43783f76b0a8ab328bffdf5056143cc812;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/os2/os2.c b/os2/os2.c
index 45e1d2f..7fe8113 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -21,6 +21,8 @@
 #include <process.h>
 #include <fcntl.h>
 
+#define PERLIO_NOT_STDIO 0
+
 #include "EXTERN.h"
 #include "perl.h"
 
@@ -375,7 +377,6 @@ spawn_sighandler(int sig)
 static int
 result(pTHX_ int flag, int pid)
 {
-        dTHR;
 	int r, status;
 	Signal_t (*ihand)();     /* place to save signal during system() */
 	Signal_t (*qhand)();     /* place to save signal during system() */
@@ -467,7 +468,6 @@ static ULONG os2_mytype;
 int
 do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag)
 {
-    dTHR;
 	int trueflag = flag;
 	int rc, pass = 1;
 	char *tmps;
@@ -605,8 +605,9 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag)
 		char *scr = find_script(PL_Argv[0], TRUE, NULL, 0);
 
 		if (scr) {
-		    FILE *file;
-		    char *s = 0, *s1;
+		    PerlIO *file;
+                    SSize_t rd;
+		    char *s = 0, *s1, *s2;
 		    int l;
 
                     l = strlen(scr);
@@ -622,14 +623,18 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag)
                     Safefree(scr);
                     scr = scrbuf;
 
-		    file = fopen(scr, "r");
+		    file = PerlIO_open(scr, "r");
 		    PL_Argv[0] = scr;
 		    if (!file)
 			goto panic_file;
-		    if (!fgets(buf, sizeof buf, file)) { /* Empty... */
 
+		    rd = PerlIO_read(file, buf, sizeof buf-1);
+		    buf[rd]='\0';
+		    if ((s2 = strchr(buf, '\n')) != NULL) *++s2 = '\0';
+
+		    if (!rd) { /* Empty... */
 			buf[0] = 0;
-			fclose(file);
+			PerlIO_close(file);
 			/* Special case: maybe from -Zexe build, so
 			   there is an executable around (contrary to
 			   documentation, DosQueryAppType sometimes (?)
@@ -648,7 +653,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag)
 			} else
 			    goto longbuf;
 		    }
-		    if (fclose(file) != 0) { /* Failure */
+		    if (PerlIO_close(file) != 0) { /* Failure */
 		      panic_file:
 			Perl_warner(aTHX_ WARN_EXEC, "Error reading \"%s\": %s", 
 			     scr, Strerror(errno));
@@ -818,7 +823,6 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag)
 int
 do_spawn3(pTHX_ char *cmd, int execf, int flag)
 {
-    dTHR;
     register char **a;
     register char *s;
     char flags[10];
@@ -946,7 +950,6 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag)
 int
 os2_do_aspawn(pTHX_ SV *really, register SV **mark, register SV **sp)
 {
-    dTHR;
     register char **a;
     int rc;
     int flag = P_WAIT, flag_set = 0;
@@ -984,21 +987,18 @@ os2_do_aspawn(pTHX_ SV *really, register SV **mark, register SV **sp)
 int
 os2_do_spawn(pTHX_ char *cmd)
 {
-    dTHR;
     return do_spawn3(aTHX_ cmd, EXECF_SPAWN, 0);
 }
 
 int
 do_spawn_nowait(pTHX_ char *cmd)
 {
-    dTHR;
     return do_spawn3(aTHX_ cmd, EXECF_SPAWN_NOWAIT,0);
 }
 
 bool
 Perl_do_exec(pTHX_ char *cmd)
 {
-    dTHR;
     do_spawn3(aTHX_ cmd, EXECF_EXEC, 0);
     return FALSE;
 }
@@ -1006,7 +1006,6 @@ Perl_do_exec(pTHX_ char *cmd)
 bool
 os2exec(pTHX_ char *cmd)
 {
-    dTHR;
     return do_spawn3(aTHX_ cmd, EXECF_TRUEEXEC, 0);
 }
 
@@ -1123,9 +1122,9 @@ fork(void)
 #endif
 
 /*******************************************************************/
-/* not implemented in EMX 0.9a */
+/* not implemented in EMX 0.9d */
 
-void *	ctermid(x)	{ return 0; }
+char *	ctermid(char *s)	{ return 0; }
 
 #ifdef MYTTYNAME /* was not in emx0.9a */
 void *	ttyname(x)	{ return 0; }
@@ -1163,10 +1162,13 @@ tcp1(char *name, int arg)
 	((void (*)(int)) fcn) (arg);
 }
 
+#ifndef HAS_GETHOSTENT		/* Older versions of EMX did not have it... */
 void *	gethostent()	{ return tcp0("GETHOSTENT");  }
 void *	getnetent()	{ return tcp0("GETNETENT");   }
 void *	getprotoent()	{ return tcp0("GETPROTOENT"); }
 void *	getservent()	{ return tcp0("GETSERVENT");  }
+#endif
+
 void	sethostent(x)	{ tcp1("SETHOSTENT",  x); }
 void	setnetent(x)	{ tcp1("SETNETENT",   x); }
 void	setprotoent(x)	{ tcp1("SETPROTOENT", x); }
@@ -1367,7 +1369,6 @@ os2error(int rc)
 char *
 os2_execname(pTHX)
 {
-  dTHR;
   char buf[300], *p;
 
   if (_execname(buf, sizeof buf) != 0)
@@ -1718,17 +1719,20 @@ XS(XS_OS2_Process_Messages)
     {
 	bool  force = SvOK(ST(0));
 	unsigned long   cnt;
-	I32 *cntp = NULL;
 
 	if (items == 2) {
+	    I32 cntr;
 	    SV *sv = ST(1);
 	    int fake = SvIV(sv);	/* Force SvIVX */
 	    
 	    if (!SvIOK(sv))
 		Perl_croak_nocontext("Can't upgrade count to IV");
-	    cntp = &SvIVX(sv);
-	}
-	cnt =  Perl_Process_Messages(force, cntp);
+	    cntr = SvIVX(sv);
+	    cnt =  Perl_Process_Messages(force, &cntr);
+	    SvIVX(sv) = cntr;
+	} else {
+	    cnt =  Perl_Process_Messages(force, NULL);
+        }
 	ST(0) = sv_newmortal();
 	sv_setiv(ST(0), cnt);
     }