#include <process.h>
#include <fcntl.h>
+#define PERLIO_NOT_STDIO 0
+
#include "EXTERN.h"
#include "perl.h"
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() */
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;
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);
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 (?)
} 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));
int
do_spawn3(pTHX_ char *cmd, int execf, int flag)
{
- dTHR;
register char **a;
register char *s;
char flags[10];
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;
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;
}
bool
os2exec(pTHX_ char *cmd)
{
- dTHR;
return do_spawn3(aTHX_ cmd, EXECF_TRUEEXEC, 0);
}
#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; }
((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); }
char *
os2_execname(pTHX)
{
- dTHR;
char buf[300], *p;
if (_execname(buf, sizeof buf) != 0)
{
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);
}