os2_cond_wait(perl_cond *c, perl_mutex *m)
{
int rc;
- if ((rc = DosResetEventSem(*c,&na)) && (rc != ERROR_ALREADY_RESET))
+ if ((rc = DosResetEventSem(*c,&PL_na)) && (rc != ERROR_ALREADY_RESET))
croak("panic: COND_WAIT-reset: rc=%i", rc);
if (m) MUTEX_UNLOCK(m);
if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT))
/*****************************************************************************/
/* spawn */
-typedef void (*Sigfunc) _((int));
+
+/* There is no big sense to make it thread-specific, since signals
+ are delivered to thread 1 only. XXXX Maybe make it into an array? */
+static int spawn_pid;
+static int spawn_killed;
+
+static Signal_t
+spawn_sighandler(int sig)
+{
+ /* Some programs do not arrange for the keyboard signals to be
+ delivered to them. We need to deliver the signal manually. */
+ /* We may get a signal only if
+ a) kid does not receive keyboard signal: deliver it;
+ b) kid already died, and we get a signal. We may only hope
+ that the pid number was not reused.
+ */
+
+ if (spawn_killed)
+ sig = SIGKILL; /* Try harder. */
+ kill(spawn_pid, sig);
+ spawn_killed = 1;
+}
static int
result(int flag, int pid)
return pid;
#ifdef __EMX__
- ihand = rsignal(SIGINT, SIG_IGN);
- qhand = rsignal(SIGQUIT, SIG_IGN);
+ spawn_pid = pid;
+ spawn_killed = 0;
+ ihand = rsignal(SIGINT, &spawn_sighandler);
+ qhand = rsignal(SIGQUIT, &spawn_sighandler);
do {
r = wait4pid(pid, &status, 0);
} while (r == -1 && errno == EINTR);
rsignal(SIGINT, ihand);
rsignal(SIGQUIT, qhand);
- statusvalue = (U16)status;
+ PL_statusvalue = (U16)status;
if (r < 0)
return -1;
return status & 0xFFFF;
ihand = rsignal(SIGINT, SIG_IGN);
r = DosWaitChild(DCWA_PROCESS, DCWW_WAIT, &res, &rpid, pid);
rsignal(SIGINT, ihand);
- statusvalue = res.codeResult << 8 | res.codeTerminate;
+ PL_statusvalue = res.codeResult << 8 | res.codeTerminate;
if (r)
return -1;
- return statusvalue;
+ return PL_statusvalue;
#endif
}
#define EXECF_TRUEEXEC 2
#define EXECF_SPAWN_NOWAIT 3
+/* const char* const ptypes[] = { "FS", "DOS", "VIO", "PM", "DETACH" }; */
+
+static int
+my_type()
+{
+ int rc;
+ TIB *tib;
+ PIB *pib;
+
+ if (!(_emx_env & 0x200)) return 1; /* not OS/2. */
+ if (CheckOSError(DosGetInfoBlocks(&tib, &pib)))
+ return -1;
+
+ return (pib->pib_ultype);
+}
+
+static ULONG
+file_type(char *path)
+{
+ int rc;
+ ULONG apptype;
+
+ if (!(_emx_env & 0x200))
+ croak("file_type not implemented on DOS"); /* not OS/2. */
+ if (CheckOSError(DosQueryAppType(path, &apptype))) {
+ switch (rc) {
+ case ERROR_FILE_NOT_FOUND:
+ case ERROR_PATH_NOT_FOUND:
+ return -1;
+ case ERROR_ACCESS_DENIED: /* Directory with this name found? */
+ return -3;
+ default: /* Found, but not an
+ executable, or some other
+ read error. */
+ return -2;
+ }
+ }
+ return apptype;
+}
+
+static ULONG os2_mytype;
+
/* Spawn/exec a program, revert to shell if needed. */
-/* global Argv[] contains arguments. */
+/* global PL_Argv[] contains arguments. */
int
-do_spawn_ve(really, flag, execf)
+do_spawn_ve(really, flag, execf, inicmd)
SV *really;
U32 flag;
U32 execf;
+char *inicmd;
{
dTHR;
int trueflag = flag;
- int rc, secondtry = 0, err;
+ int rc, pass = 1;
char *tmps;
- char buf[256], *s = 0;
+ char buf[256], *s = 0, scrbuf[280];
char *args[4];
static char * fargs[4]
= { "/bin/sh", "-c", "\"$@\"", "spawn-via-shell", };
char **argsp = fargs;
char nargs = 4;
+ int force_shell;
if (flag == P_WAIT)
flag = P_NOWAIT;
retry:
- if (strEQ(Argv[0],"/bin/sh"))
- Argv[0] = sh_path;
+ if (strEQ(PL_Argv[0],"/bin/sh"))
+ PL_Argv[0] = PL_sh_path;
- if (Argv[0][0] != '/' && Argv[0][0] != '\\'
- && !(Argv[0][0] && Argv[0][1] == ':'
- && (Argv[0][2] == '/' || Argv[0][2] != '\\'))
- ) /* will swawnvp use PATH? */
+ if (PL_Argv[0][0] != '/' && PL_Argv[0][0] != '\\'
+ && !(PL_Argv[0][0] && PL_Argv[0][1] == ':'
+ && (PL_Argv[0][2] == '/' || PL_Argv[0][2] != '\\'))
+ ) /* will spawnvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
/* We should check PERL_SH* and PERLLIB_* as well? */
- if (!really || !*(tmps = SvPV(really, na)))
- tmps = Argv[0];
+ if (!really || !*(tmps = SvPV(really, PL_na)))
+ tmps = PL_Argv[0];
+
+ reread:
+ force_shell = 0;
+ if (_emx_env & 0x200) { /* OS/2. */
+ int type = file_type(tmps);
+ type_again:
+ if (type == -1) { /* Not found */
+ errno = ENOENT;
+ rc = -1;
+ goto do_script;
+ }
+ else if (type == -2) { /* Not an EXE */
+ errno = ENOEXEC;
+ rc = -1;
+ goto do_script;
+ }
+ else if (type == -3) { /* Is a directory? */
+ /* Special-case this */
+ char tbuf[512];
+ int l = strlen(tmps);
+
+ if (l + 5 <= sizeof tbuf) {
+ strcpy(tbuf, tmps);
+ strcpy(tbuf + l, ".exe");
+ type = file_type(tbuf);
+ if (type >= -3)
+ goto type_again;
+ }
+
+ errno = ENOEXEC;
+ rc = -1;
+ goto do_script;
+ }
+ switch (type & 7) {
+ /* Ignore WINDOWCOMPAT and FAPI, start them the same type we are. */
+ case FAPPTYP_WINDOWAPI:
+ {
+ if (os2_mytype != 3) { /* not PM */
+ if (flag == P_NOWAIT)
+ flag = P_PM;
+ else if ((flag & 7) != P_PM && (flag & 7) != P_SESSION)
+ warn("Starting PM process with flag=%d, mytype=%d",
+ flag, os2_mytype);
+ }
+ }
+ break;
+ case FAPPTYP_NOTWINDOWCOMPAT:
+ {
+ if (os2_mytype != 0) { /* not full screen */
+ if (flag == P_NOWAIT)
+ flag = P_SESSION;
+ else if ((flag & 7) != P_SESSION)
+ warn("Starting Full Screen process with flag=%d, mytype=%d",
+ flag, os2_mytype);
+ }
+ }
+ break;
+ case FAPPTYP_NOTSPEC:
+ /* Let the shell handle this... */
+ force_shell = 1;
+ goto doshell_args;
+ break;
+ }
+ }
+
#if 0
- rc = result(trueflag, spawnvp(flag,tmps,Argv));
+ rc = result(trueflag, spawnvp(flag,tmps,PL_Argv));
#else
if (execf == EXECF_TRUEEXEC)
- rc = execvp(tmps,Argv);
+ rc = execvp(tmps,PL_Argv);
else if (execf == EXECF_EXEC)
- rc = spawnvp(trueflag | P_OVERLAY,tmps,Argv);
+ rc = spawnvp(trueflag | P_OVERLAY,tmps,PL_Argv);
else if (execf == EXECF_SPAWN_NOWAIT)
- rc = spawnvp(trueflag | P_NOWAIT,tmps,Argv);
+ rc = spawnvp(flag,tmps,PL_Argv);
else /* EXECF_SPAWN */
rc = result(trueflag,
- spawnvp(trueflag | P_NOWAIT,tmps,Argv));
+ spawnvp(flag,tmps,PL_Argv));
#endif
- if (rc < 0 && secondtry == 0
- && (tmps == Argv[0])) { /* Cannot transfer `really' via shell. */
- err = errno;
- if (err == ENOENT) { /* No such file. */
- /* One reason may be that EMX added .exe. We suppose
- that .exe-less files are automatically shellable.
- It might have also been .cmd file without
- extension. */
- char *no_dir;
- (no_dir = strrchr(Argv[0], '/'))
- || (no_dir = strrchr(Argv[0], '\\'))
- || (no_dir = Argv[0]);
- if (!strchr(no_dir, '.')) {
- struct stat buffer;
- if (stat(Argv[0], &buffer) != -1) { /* File exists. */
- /* Maybe we need to specify the full name here? */
- goto doshell;
- } else {
- /* Try adding script extensions to the file name */
- char *scr;
- if ((scr = find_script(Argv[0], TRUE, NULL, 0))) {
- FILE *file = fopen(scr, "r");
- char *s = 0, *s1;
-
- Argv[0] = scr;
- if (!file)
- goto panic_file;
- if (!fgets(buf, sizeof buf, file)) {
- fclose(file);
- goto panic_file;
- }
- if (fclose(file) != 0) { /* Failure */
- panic_file:
- warn("Error reading \"%s\": %s",
- scr, Strerror(errno));
- goto doshell;
- }
- if (buf[0] == '#') {
- if (buf[1] == '!')
- s = buf + 2;
- } else if (buf[0] == 'e') {
- if (strnEQ(buf, "extproc", 7)
- && isSPACE(buf[7]))
- s = buf + 8;
- } else if (buf[0] == 'E') {
- if (strnEQ(buf, "EXTPROC", 7)
- && isSPACE(buf[7]))
- s = buf + 8;
- }
- if (!s)
- goto doshell;
- s1 = s;
- nargs = 0;
- argsp = args;
- while (1) {
- while (isSPACE(*s))
- s++;
- if (*s == 0)
- break;
- if (nargs == 4) {
- nargs = -1;
- break;
+ if (rc < 0 && pass == 1
+ && (tmps == PL_Argv[0])) { /* Cannot transfer `really' via shell. */
+ do_script:
+ {
+ int err = errno;
+
+ if (err == ENOENT || err == ENOEXEC) {
+ /* No such file, or is a script. */
+ /* Try adding script extensions to the file name, and
+ search on PATH. */
+ char *scr = find_script(PL_Argv[0], TRUE, NULL, 0);
+ int l = strlen(scr);
+
+ if (l >= sizeof scrbuf) {
+ Safefree(scr);
+ longbuf:
+ croak("Size of scriptname too big: %d", l);
+ }
+ strcpy(scrbuf, scr);
+ Safefree(scr);
+ scr = scrbuf;
+
+ if (scr) {
+ FILE *file = fopen(scr, "r");
+ char *s = 0, *s1;
+
+ PL_Argv[0] = scr;
+ if (!file)
+ goto panic_file;
+ if (!fgets(buf, sizeof buf, file)) { /* Empty... */
+
+ buf[0] = 0;
+ fclose(file);
+ /* Special case: maybe from -Zexe build, so
+ there is an executable around (contrary to
+ documentation, DosQueryAppType sometimes (?)
+ does not append ".exe", so we could have
+ reached this place). */
+ if (l + 5 < sizeof scrbuf) {
+ strcpy(scrbuf + l, ".exe");
+ if (PerlLIO_stat(scrbuf,&PL_statbuf) >= 0
+ && !S_ISDIR(PL_statbuf.st_mode)) {
+ /* Found */
+ tmps = scr;
+ pass++;
+ goto reread;
+ } else
+ scrbuf[l] = 0;
+ } else
+ goto longbuf;
+ }
+ if (fclose(file) != 0) { /* Failure */
+ panic_file:
+ warn("Error reading \"%s\": %s",
+ scr, Strerror(errno));
+ buf[0] = 0; /* Not #! */
+ goto doshell_args;
+ }
+ if (buf[0] == '#') {
+ if (buf[1] == '!')
+ s = buf + 2;
+ } else if (buf[0] == 'e') {
+ if (strnEQ(buf, "extproc", 7)
+ && isSPACE(buf[7]))
+ s = buf + 8;
+ } else if (buf[0] == 'E') {
+ if (strnEQ(buf, "EXTPROC", 7)
+ && isSPACE(buf[7]))
+ s = buf + 8;
+ }
+ if (!s) {
+ buf[0] = 0; /* Not #! */
+ goto doshell_args;
+ }
+
+ s1 = s;
+ nargs = 0;
+ argsp = args;
+ while (1) {
+ /* Do better than pdksh: allow a few args,
+ strip trailing whitespace. */
+ while (isSPACE(*s))
+ s++;
+ if (*s == 0)
+ break;
+ if (nargs == 4) {
+ nargs = -1;
+ break;
+ }
+ args[nargs++] = s;
+ while (*s && !isSPACE(*s))
+ s++;
+ if (*s == 0)
+ break;
+ *s++ = 0;
+ }
+ if (nargs == -1) {
+ warn("Too many args on %.*s line of \"%s\"",
+ s1 - buf, buf, scr);
+ nargs = 4;
+ argsp = fargs;
+ }
+ doshell_args:
+ {
+ char **a = PL_Argv;
+ char *exec_args[2];
+
+ if (force_shell
+ || (!buf[0] && file)) { /* File without magic */
+ /* In fact we tried all what pdksh would
+ try. There is no point in calling
+ pdksh, we may just emulate its logic. */
+ char *shell = getenv("EXECSHELL");
+ char *shell_opt = NULL;
+
+ if (!shell) {
+ char *s;
+
+ shell_opt = "/c";
+ shell = getenv("OS2_SHELL");
+ if (inicmd) { /* No spaces at start! */
+ s = inicmd;
+ while (*s && !isSPACE(*s)) {
+ if (*s++ = '/') {
+ inicmd = NULL; /* Cannot use */
+ break;
+ }
+ }
+ }
+ if (!inicmd) {
+ s = PL_Argv[0];
+ while (*s) {
+ /* Dosish shells will choke on slashes
+ in paths, fortunately, this is
+ important for zeroth arg only. */
+ if (*s == '/')
+ *s = '\\';
+ s++;
+ }
}
- args[nargs++] = s;
- while (*s && !isSPACE(*s))
- s++;
- if (*s == 0)
- break;
- *s++ = 0;
}
- if (nargs == -1) {
- warn("Too many args on %.*s line of \"%s\"",
- s1 - buf, buf, scr);
- nargs = 4;
- argsp = fargs;
+ /* If EXECSHELL is set, we do not set */
+
+ if (!shell)
+ shell = ((_emx_env & 0x200)
+ ? "c:/os2/cmd.exe"
+ : "c:/command.com");
+ nargs = shell_opt ? 2 : 1; /* shell file args */
+ exec_args[0] = shell;
+ exec_args[1] = shell_opt;
+ argsp = exec_args;
+ if (nargs == 2 && inicmd) {
+ /* Use the original cmd line */
+ /* XXXX This is good only until we refuse
+ quoted arguments... */
+ PL_Argv[0] = inicmd;
+ PL_Argv[1] = Nullch;
}
- goto doshell;
+ } else if (!buf[0] && inicmd) { /* No file */
+ /* Start with the original cmdline. */
+ /* XXXX This is good only until we refuse
+ quoted arguments... */
+
+ PL_Argv[0] = inicmd;
+ PL_Argv[1] = Nullch;
+ nargs = 2; /* shell -c */
+ }
+
+ while (a[1]) /* Get to the end */
+ a++;
+ a++; /* Copy finil NULL too */
+ while (a >= PL_Argv) {
+ *(a + nargs) = *a; /* PL_Argv was preallocated to be
+ long enough. */
+ a--;
}
+ while (nargs-- >= 0)
+ PL_Argv[nargs] = argsp[nargs];
+ /* Enable pathless exec if #! (as pdksh). */
+ pass = (buf[0] == '#' ? 2 : 3);
+ goto retry;
}
}
- /* Restore errno */
+ /* Not found: restore errno */
errno = err;
- } else if (err == ENOEXEC) { /* Need to send to shell. */
- doshell:
- {
- char **a = Argv;
-
- while (a[1]) /* Get to the end */
- a++;
- while (a >= Argv) {
- *(a + nargs) = *a; /* Argv was preallocated to be
- long enough. */
- a--;
- }
- while (nargs-- >= 0)
- Argv[nargs] = argsp[nargs];
- secondtry = 1;
+ }
+ }
+ } else if (rc < 0 && pass == 2 && errno == ENOENT) { /* File not found */
+ char *no_dir = strrchr(PL_Argv[0], '/');
+
+ /* Do as pdksh port does: if not found with /, try without
+ path. */
+ if (no_dir) {
+ PL_Argv[0] = no_dir + 1;
+ pass++;
goto retry;
- }
}
}
- if (rc < 0 && dowarn)
+ if (rc < 0 && PL_dowarn)
warn("Can't %s \"%s\": %s\n",
((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
? "spawn" : "exec"),
- Argv[0], Strerror(err));
+ PL_Argv[0], Strerror(errno));
if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT)
&& ((trueflag & 0xFF) == P_WAIT))
rc = 255 << 8; /* Emulate the fork(). */
return rc;
}
+/* Array spawn. */
int
do_aspawn(really,mark,sp)
SV *really;
int flag = P_WAIT, trueflag, err, secondtry = 0;
if (sp > mark) {
- New(1301,Argv, sp - mark + 3, char*);
- a = Argv;
+ New(1301,PL_Argv, sp - mark + 3, char*);
+ a = PL_Argv;
if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
++mark;
while (++mark <= sp) {
if (*mark)
- *a++ = SvPVx(*mark, na);
+ *a++ = SvPVx(*mark, PL_na);
else
*a++ = "";
}
*a = Nullch;
- rc = do_spawn_ve(really, flag, EXECF_SPAWN);
+ rc = do_spawn_ve(really, flag, EXECF_SPAWN, NULL);
} else
rc = -1;
do_execfree();
register char *s;
char flags[10];
char *shell, *copt, *news = NULL;
- int rc, added_shell = 0, err, seenspace = 0;
+ int rc, err, seenspace = 0;
char fullcmd[MAXNAMLEN + 1];
#ifdef TRYSHELL
have a shell which will not change between computers with the
same architecture, to avoid "action on a distance".
And to have simple build, this shell should be sh. */
- shell = sh_path;
+ shell = PL_sh_path;
copt = "-c";
#endif
cmd++;
if (strnEQ(cmd,"/bin/sh",7) && isSPACE(cmd[7])) {
- STRLEN l = strlen(sh_path);
+ STRLEN l = strlen(PL_sh_path);
New(1302, news, strlen(cmd) - 7 + l + 1, char);
- strcpy(news, sh_path);
+ strcpy(news, PL_sh_path);
strcpy(news + l, cmd + 7);
cmd = news;
- added_shell = 1;
}
/* save an extra exec if possible */
should be smart enough to start itself gloriously. */
doshell:
if (execf == EXECF_TRUEEXEC)
- return execl(shell,shell,copt,cmd,(char*)0);
+ rc = execl(shell,shell,copt,cmd,(char*)0);
else if (execf == EXECF_EXEC)
- return spawnl(P_OVERLAY,shell,shell,copt,cmd,(char*)0);
+ rc = spawnl(P_OVERLAY,shell,shell,copt,cmd,(char*)0);
else if (execf == EXECF_SPAWN_NOWAIT)
- return spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0);
- /* In the ak code internal P_NOWAIT is P_WAIT ??? */
- rc = result(P_WAIT,
- spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0));
- if (rc < 0 && dowarn)
- warn("Can't %s \"%s\": %s",
- (execf == EXECF_SPAWN ? "spawn" : "exec"),
- shell, Strerror(errno));
- if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
- if (news) Safefree(news);
+ rc = spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0);
+ else {
+ /* In the ak code internal P_NOWAIT is P_WAIT ??? */
+ rc = result(P_WAIT,
+ spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0));
+ if (rc < 0 && PL_dowarn)
+ warn("Can't %s \"%s\": %s",
+ (execf == EXECF_SPAWN ? "spawn" : "exec"),
+ shell, Strerror(errno));
+ if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
+ }
+ if (news)
+ Safefree(news);
return rc;
} else if (*s == ' ' || *s == '\t') {
seenspace = 1;
}
/* cmd="a" may lead to "sh", "-c", "\"$@\"", "a", "a.cmd", NULL */
- New(1303,Argv, (s - cmd + 11) / 2, char*);
- Cmd = savepvn(cmd, s-cmd);
- a = Argv;
- for (s = Cmd; *s;) {
+ New(1303,PL_Argv, (s - cmd + 11) / 2, char*);
+ PL_Cmd = savepvn(cmd, s-cmd);
+ a = PL_Argv;
+ for (s = PL_Cmd; *s;) {
while (*s && isSPACE(*s)) s++;
if (*s)
*(a++) = s;
*s++ = '\0';
}
*a = Nullch;
- if (Argv[0])
- rc = do_spawn_ve(NULL, 0, execf);
+ if (PL_Argv[0])
+ rc = do_spawn_ve(NULL, 0, execf, cmd);
else
rc = -1;
- if (news) Safefree(news);
+ if (news)
+ Safefree(news);
do_execfree();
return rc;
}
do_exec(cmd)
char *cmd;
{
- return do_spawn2(cmd, EXECF_EXEC);
+ do_spawn2(cmd, EXECF_EXEC);
+ return FALSE;
}
bool
/* `this' is what we use in the parent, `that' in the child. */
this = (*mode == 'w');
that = !this;
- if (tainting) {
+ if (PL_tainting) {
taint_env();
taint_proper("Insecure %s%s", "EXEC");
}
close(p[this]);
p[this] = p[that];
}
- sv = *av_fetch(fdpid,p[this],TRUE);
+ sv = *av_fetch(PL_fdpid,p[this],TRUE);
(void)SvUPGRADE(sv,SVt_IV);
SvIVX(sv) = pid;
- forkprocess = pid;
+ PL_forkprocess = pid;
return PerlIO_fdopen(p[this], mode);
#else /* USE_POPEN */
# else
char *shell = getenv("EMXSHELL");
- my_setenv("EMXSHELL", sh_path);
+ my_setenv("EMXSHELL", PL_sh_path);
res = popen(cmd, mode);
my_setenv("EMXSHELL", shell);
# endif
- sv = *av_fetch(fdpid, PerlIO_fileno(res), TRUE);
+ sv = *av_fetch(PL_fdpid, PerlIO_fileno(res), TRUE);
(void)SvUPGRADE(sv,SVt_IV);
SvIVX(sv) = -1; /* A cooky. */
return res;
if (items < 2 || items > 3)
croak("Usage: File::Copy::syscopy(src,dst,flag=0)");
{
- char * src = (char *)SvPV(ST(0),na);
- char * dst = (char *)SvPV(ST(1),na);
+ char * src = (char *)SvPV(ST(0),PL_na);
+ char * dst = (char *)SvPV(ST(1),PL_na);
U32 flag;
int RETVAL, rc;
XSRETURN(1);
}
+#include "patchlevel.h"
+
char *
mod2fname(sv)
SV *sv;
if (avlen < 0)
croak("Empty array reference given to mod2fname");
- s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), na);
+ s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), PL_na);
strncpy(fname, s, 8);
len = strlen(s);
if (len < 6) pos = len;
}
avlen --;
while (avlen >= 0) {
- s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), na);
+ s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), PL_na);
while (*s) {
sum = 33 * sum + *(s++); /* 7 is primitive mod 13. */
}
#ifdef USE_THREADS
sum++; /* Avoid conflict of DLLs in memory. */
#endif
+ sum += PATCHLEVEL * 200 + SUBVERSION * 2; /* */
fname[pos] = 'A' + (sum % 26);
fname[pos + 1] = 'A' + (sum / 26 % 26);
fname[pos + 2] = '\0';
sprintf(buf, "OS/2 system error code %d=0x%x", rc, rc);
else
buf[len] = '\0';
+ if (len > 0 && buf[len - 1] == '\n')
+ buf[len - 1] = '\0';
+ if (len > 1 && buf[len - 2] == '\r')
+ buf[len - 2] = '\0';
+ if (len > 2 && buf[len - 3] == '.')
+ buf[len - 3] = '\0';
return buf;
}
if (items != 1)
croak("Usage: Cwd::sys_chdir(path)");
{
- char * path = (char *)SvPV(ST(0),na);
+ char * path = (char *)SvPV(ST(0),PL_na);
bool RETVAL;
RETVAL = sys_chdir(path);
if (items != 1)
croak("Usage: Cwd::change_drive(d)");
{
- char d = (char)*SvPV(ST(0),na);
+ char d = (char)*SvPV(ST(0),PL_na);
bool RETVAL;
RETVAL = change_drive(d);
if (items != 1)
croak("Usage: Cwd::sys_is_absolute(path)");
{
- char * path = (char *)SvPV(ST(0),na);
+ char * path = (char *)SvPV(ST(0),PL_na);
bool RETVAL;
RETVAL = sys_is_absolute(path);
if (items != 1)
croak("Usage: Cwd::sys_is_rooted(path)");
{
- char * path = (char *)SvPV(ST(0),na);
+ char * path = (char *)SvPV(ST(0),PL_na);
bool RETVAL;
RETVAL = sys_is_rooted(path);
if (items != 1)
croak("Usage: Cwd::sys_is_relative(path)");
{
- char * path = (char *)SvPV(ST(0),na);
+ char * path = (char *)SvPV(ST(0),PL_na);
bool RETVAL;
RETVAL = sys_is_relative(path);
if (items < 1 || items > 2)
croak("Usage: Cwd::sys_abspath(path, dir = NULL)");
{
- char * path = (char *)SvPV(ST(0),na);
+ char * path = (char *)SvPV(ST(0),PL_na);
char * dir;
char p[MAXPATHLEN];
char * RETVAL;
if (items < 2)
dir = NULL;
else {
- dir = (char *)SvPV(ST(1),na);
+ dir = (char *)SvPV(ST(1),PL_na);
}
if (path[0] == '.' && (path[1] == '/' || path[1] == '\\')) {
path += 2;
if (items < 1 || items > 2)
croak("Usage: Cwd::extLibpath_set(s, type = 0)");
{
- char * s = (char *)SvPV(ST(0),na);
+ char * s = (char *)SvPV(ST(0),PL_na);
bool type;
U32 rc;
bool RETVAL;
environ = env;
}
if ( (shell = getenv("PERL_SH_DRIVE")) ) {
- New(1304, sh_path, strlen(SH_PATH) + 1, char);
- strcpy(sh_path, SH_PATH);
- sh_path[0] = shell[0];
+ New(1304, 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")) ) {
int l = strlen(shell), i;
if (shell[l-1] == '/' || shell[l-1] == '\\') {
l--;
}
- New(1304, sh_path, l + 8, char);
- strncpy(sh_path, shell, l);
- strcpy(sh_path + l, "/sh.exe");
+ New(1304, 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++) {
- if (sh_path[i] == '\\') sh_path[i] = '/';
+ if (PL_sh_path[i] == '\\') PL_sh_path[i] = '/';
}
}
MUTEX_INIT(&start_thread_mutex);
+ os2_mytype = my_type(); /* Do it before morphing. Needed? */
}
#undef tmpnam
https://perl5.git.perl.org / perl5.git / blobdiff