-/* $RCSfile: os2.c,v $$Revision: 4.0.1.2 $$Date: 92/06/08 14:32:30 $
- *
- * (C) Copyright 1989, 1990 Diomidis Spinellis.
- *
- * You may distribute under the terms of either the GNU General Public
- * License or the Artistic License, as specified in the README file.
- *
- * $Log: os2.c,v $
- * Revision 4.0.1.2 92/06/08 14:32:30 lwall
- * patch20: new OS/2 support
- *
- * Revision 4.0.1.1 91/06/07 11:23:06 lwall
- * patch4: new copyright notice
- *
- * Revision 4.0 91/03/20 01:36:21 lwall
- * 4.0 baseline.
- *
- * Revision 3.0.1.2 90/11/10 01:42:38 lwall
- * patch38: more msdos/os2 upgrades
- *
- * Revision 3.0.1.1 90/10/15 17:49:55 lwall
- * patch29: Initial revision
- *
- * Revision 3.0.1.1 90/03/27 16:10:41 lwall
- * patch16: MSDOS support
- *
- * Revision 1.1 90/03/18 20:32:01 dds
- * Initial revision
- *
- */
-
#define INCL_DOS
#define INCL_NOPM
+#define INCL_DOSFILEMGR
+#ifndef NO_SYS_ALLOC
+# define INCL_DOSMEMMGR
+# define INCL_DOSERRORS
+#endif /* ! defined NO_SYS_ALLOC */
#include <os2.h>
/*
#include <stdio.h>
#include <errno.h>
+#include <limits.h>
#include <process.h>
#include "EXTERN.h"
#include "perl.h"
+/*****************************************************************************/
+/* priorities */
-/* dummies */
+int setpriority(int which, int pid, int val)
+{
+ return DosSetPriority((pid < 0) ? PRTYS_PROCESSTREE : PRTYS_PROCESS,
+ val >> 8, val & 0xFF, abs(pid));
+}
-int ioctl(int handle, unsigned int function, char *data)
-{ return -1; }
+int getpriority(int which /* ignored */, int pid)
+{
+ TIB *tib;
+ PIB *pib;
+ DosGetInfoBlocks(&tib, &pib);
+ return tib->tib_ptib2->tib2_ulpri;
+}
-int userinit()
-{ return -1; }
+/*****************************************************************************/
+/* spawn */
-int syscall()
-{ return -1; }
+static int
+result(int flag, int pid)
+{
+ int r, status;
+ Signal_t (*ihand)(); /* place to save signal during system() */
+ Signal_t (*qhand)(); /* place to save signal during system() */
+
+ if (pid < 0 || flag != 0)
+ return pid;
+
+ ihand = signal(SIGINT, SIG_IGN);
+ qhand = signal(SIGQUIT, SIG_IGN);
+ do {
+ r = wait4pid(pid, &status, 0);
+ } while (r == -1 && errno == EINTR);
+ signal(SIGINT, ihand);
+ signal(SIGQUIT, qhand);
+
+ statusvalue = (U16)status;
+ if (r < 0)
+ return -1;
+ return status & 0xFFFF;
+}
+int
+do_aspawn(really,mark,sp)
+SV *really;
+register SV **mark;
+register SV **sp;
+{
+ register char **a;
+ char *tmps;
+ int rc;
+ int flag = P_WAIT, trueflag;
-/* extended chdir() */
+ if (sp > mark) {
+ New(401,Argv, sp - mark + 1, char*);
+ a = Argv;
-int chdir(char *path)
-{
- if ( path[0] != 0 && path[1] == ':' )
- if ( DosSelectDisk(toupper(path[0]) - '@') )
- return -1;
+ if (mark < sp && SvIOKp(*(mark+1))) {
+ ++mark;
+ flag = SvIVx(*mark);
+ }
- return DosChDir(path, 0L);
-}
+ while (++mark <= sp) {
+ if (*mark)
+ *a++ = SvPVx(*mark, na);
+ else
+ *a++ = "";
+ }
+ *a = Nullch;
+ trueflag = flag;
+ if (flag == P_WAIT)
+ flag = P_NOWAIT;
-/* priorities */
+ if (*Argv[0] != '/' && *Argv[0] != '\\') /* will swawnvp use PATH? */
+ TAINT_ENV(); /* testing IFS here is overkill, probably */
+ if (really && *(tmps = SvPV(really, na)))
+ rc = result(trueflag, spawnvp(flag,tmps,Argv));
+ else
+ rc = result(trueflag, spawnvp(flag,Argv[0],Argv));
+
+ if (rc < 0 && dowarn)
+ warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno));
+ if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
+ } else
+ rc = -1;
+ do_execfree();
+ return rc;
+}
-int setpriority(int class, int pid, int val)
+int
+do_spawn(cmd)
+char *cmd;
{
- int flag = 0;
+ register char **a;
+ register char *s;
+ char flags[10];
+ char *shell, *copt;
+ int rc;
+
+#ifdef TRYSHELL
+ if ((shell = getenv("EMXSHELL")) != NULL)
+ copt = "-c";
+ else if ((shell = getenv("SHELL")) != NULL)
+ copt = "-c";
+ else if ((shell = getenv("COMSPEC")) != NULL)
+ copt = "/C";
+ else
+ shell = "cmd.exe";
+#else
+ /* Consensus on perl5-porters is that it is _very_ important to
+ 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.exe";
+ copt = "-c";
+#endif
- if ( pid < 0 )
- {
- flag++;
- pid = -pid;
- }
+ while (*cmd && isSPACE(*cmd))
+ cmd++;
- return DosSetPrty(flag ? PRTYS_PROCESSTREE : PRTYS_PROCESS, class, val, pid);
-}
+ /* save an extra exec if possible */
+ /* see if there are shell metacharacters in it */
-int getpriority(int which /* ignored */, int pid)
-{
- USHORT val;
+ if (*cmd == '.' && isSPACE(cmd[1]))
+ goto doshell;
- if ( DosGetPrty(PRTYS_PROCESS, &val, pid) )
- return -1;
- else
- return val;
-}
+ if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
+ goto doshell;
+ for (s = cmd; *s && isALPHA(*s); s++) ; /* catch VAR=val gizmo */
+ if (*s == '=')
+ goto doshell;
-/* get parent process id */
+ for (s = cmd; *s; s++) {
+ if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
+ if (*s == '\n' && !s[1]) {
+ *s = '\0';
+ break;
+ }
+ doshell:
+ rc = result(P_WAIT,
+ spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0));
+ if (rc < 0 && dowarn)
+ warn("Can't spawn \"%s\": %s", shell, Strerror(errno));
+ if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
+ return rc;
+ }
+ }
-int getppid(void)
-{
- PIDINFO pi;
+ New(402,Argv, (s - cmd) / 2 + 2, char*);
+ Cmd = savepvn(cmd, s-cmd);
+ a = Argv;
+ for (s = Cmd; *s;) {
+ while (*s && isSPACE(*s)) s++;
+ if (*s)
+ *(a++) = s;
+ while (*s && !isSPACE(*s)) s++;
+ if (*s)
+ *s++ = '\0';
+ }
+ *a = Nullch;
+ if (Argv[0]) {
+ rc = result(P_WAIT, spawnvp(P_NOWAIT,Argv[0],Argv));
+ if (rc < 0 && dowarn)
+ warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno));
+ if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
+ } else
+ rc = -1;
+ do_execfree();
+ return rc;
+}
- DosGetPID(&pi);
- return pi.pidParent;
+FILE *
+my_popen(cmd,mode)
+char *cmd;
+char *mode;
+{
+ char *shell = getenv("EMXSHELL");
+ FILE *res;
+
+ my_setenv("EMXSHELL", "sh.exe");
+ res = popen(cmd, mode);
+ my_setenv("EMXSHELL", shell);
+ return res;
}
+/*****************************************************************************/
-/* wait for specific pid */
-int wait4pid(int pid, int *status, int flags)
+#ifndef HAS_FORK
+int
+fork(void)
{
- RESULTCODES res;
- int endpid, rc;
- if ( DosCwait(DCWA_PROCESS, flags ? DCWW_NOWAIT : DCWW_WAIT,
- &res, &endpid, pid) )
+ die(no_func, "Unsupported function fork");
+ errno = EINVAL;
return -1;
- *status = res.codeResult;
- return endpid;
}
-/* kill */
-
-int kill(int pid, int sig)
-{
- int flag = 0;
-
- if ( pid < 0 )
- {
- flag++;
- pid = -pid;
- }
+#endif
- switch ( sig & 3 )
- {
+/*****************************************************************************/
+/* not implemented in EMX 0.9a */
- case 0:
- DosKillProcess(flag ? DKP_PROCESSTREE : DKP_PROCESS, pid);
- break;
+void * ctermid(x) { return 0; }
- case 1: /* FLAG A */
- DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_A, 0);
- break;
+#ifdef MYTTYNAME /* was not in emx0.9a */
+void * ttyname(x) { return 0; }
+#endif
- case 2: /* FLAG B */
- DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_B, 0);
- break;
+void * gethostent() { return 0; }
+void * getnetent() { return 0; }
+void * getprotoent() { return 0; }
+void * getservent() { return 0; }
+void sethostent(x) {}
+void setnetent(x) {}
+void setprotoent(x) {}
+void setservent(x) {}
+void endhostent(x) {}
+void endnetent(x) {}
+void endprotoent(x) {}
+void endservent(x) {}
- case 3: /* FLAG C */
- DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_C, 0);
- break;
+/*****************************************************************************/
+/* stat() hack for char/block device */
- }
-}
+#if OS2_STAT_HACK
+ /* First attempt used DosQueryFSAttach which crashed the system when
+ used with 5.001. Now just look for /dev/. */
-/* Sleep function. */
-void
-sleep(unsigned len)
+int
+os2_stat(char *name, struct stat *st)
{
- DosSleep(len * 1000L);
-}
+ static int ino = SHRT_MAX;
-/* Just pretend that everyone is a superuser */
+ if (stricmp(name, "/dev/con") != 0
+ && stricmp(name, "/dev/tty") != 0)
+ return stat(name, st);
-int setuid()
-{ return 0; }
+ memset(st, 0, sizeof *st);
+ st->st_mode = S_IFCHR|0666;
+ st->st_ino = (ino-- & 0x7FFF);
+ st->st_nlink = 1;
+ return 0;
+}
-int setgid()
-{ return 0; }
+#endif
-int getuid(void)
-{ return 0; }
+#ifndef NO_SYS_ALLOC
-int geteuid(void)
-{ return 0; }
+static char *oldchunk;
+static long oldsize;
-int getgid(void)
-{ return 0; }
+#define _32_K (1<<15)
+#define _64_K (1<<16)
-int getegid(void)
-{ return 0; }
+/* The real problem is that DosAllocMem will grant memory on 64K-chunks
+ * boundaries only. Note that addressable space for application memory
+ * is around 240M, thus we will run out of addressable space if we
+ * allocate around 14M worth of 4K segments.
+ * Thus we allocate memory in 64K chunks, and abandon the rest of the old
+ * chunk if the new is bigger than that rest. Also, we just allocate
+ * whatever is requested if the size is bigger that 32K. With this strategy
+ * we cannot lose more than 1/2 of addressable space. */
-/*
- * The following code is based on the do_exec and do_aexec functions
- * in file doio.c
- */
-int
-do_aspawn(really,arglast)
-STR *really;
-int *arglast;
+void *
+sbrk(int size)
{
- register STR **st = stack->ary_array;
- register int sp = arglast[1];
- register int items = arglast[2] - sp;
- register char **a;
- char **argv;
- char *tmps;
- int status;
-
- if (items) {
- New(1101,argv, items+1, char*);
- a = argv;
- for (st += ++sp; items > 0; items--,st++) {
- if (*st)
- *a++ = str_get(*st);
- else
- *a++ = "";
- }
- *a = Nullch;
- if (really && *(tmps = str_get(really)))
- status = spawnvp(P_WAIT,tmps,argv);
- else
- status = spawnvp(P_WAIT,argv[0],argv);
- Safefree(argv);
+ char *got;
+ APIRET rc;
+ int small, reqsize;
+
+ if (!size) return 0;
+ else if (size <= oldsize) {
+ got = oldchunk;
+ oldchunk += size;
+ oldsize -= size;
+ return (void *)got;
+ } else if (size >= _32_K) {
+ small = 0;
+ } else {
+ reqsize = size;
+ size = _64_K;
+ small = 1;
+ }
+ rc = DosAllocMem((void **)&got, size, PAG_COMMIT | PAG_WRITE);
+ if (rc == ERROR_NOT_ENOUGH_MEMORY) {
+ return (void *) -1;
+ } else if ( rc ) die("Got an error from DosAllocMem: %li", (long)rc);
+ if (small) {
+ /* Chunk is small, register the rest for future allocs. */
+ oldchunk = got + reqsize;
+ oldsize = size - reqsize;
}
- return status;
+ return (void *)got;
}
+#endif /* ! defined NO_SYS_ALLOC */
-char *getenv(char *name);
+/* tmp path */
-int
-do_spawn(cmd)
-char *cmd;
+char *tmppath = TMPPATH1;
+
+void
+settmppath()
{
- register char **a;
- register char *s;
- char **argv;
- char flags[10];
- int status;
- char *shell, *cmd2;
+ char *p = getenv("TMP"), *tpath;
+ int len;
+
+ if (!p) p = getenv("TEMP");
+ if (!p) return;
+ len = strlen(p);
+ tpath = (char *)malloc(len + strlen(TMPPATH1) + 2);
+ strcpy(tpath, p);
+ tpath[len] = '/';
+ strcpy(tpath + len + 1, TMPPATH1);
+ tmppath = tpath;
+}
- /* save an extra exec if possible */
- if ((shell = getenv("COMSPEC")) == 0)
- shell = "C:\\OS2\\CMD.EXE";
+#include "XSUB.h"
- /* see if there are shell metacharacters in it */
- if (strchr(cmd, '>') || strchr(cmd, '<') || strchr(cmd, '|')
- || strchr(cmd, '&') || strchr(cmd, '^'))
- doshell:
- return spawnl(P_WAIT,shell,shell,"/C",cmd,(char*)0);
+XS(XS_File__Copy_syscopy)
+{
+ dXSARGS;
+ 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);
+ U32 flag;
+ int RETVAL, rc;
+
+ if (items < 3)
+ flag = 0;
+ else {
+ flag = (unsigned long)SvIV(ST(2));
+ }
- New(1102,argv, strlen(cmd) / 2 + 2, char*);
+ errno = DosCopy(src, dst, flag);
+ RETVAL = !errno;
+ ST(0) = sv_newmortal();
+ sv_setiv(ST(0), (IV)RETVAL);
+ }
+ XSRETURN(1);
+}
- New(1103,cmd2, strlen(cmd) + 1, char);
- strcpy(cmd2, cmd);
- a = argv;
- for (s = cmd2; *s;) {
- while (*s && isspace(*s)) s++;
- if (*s)
- *(a++) = s;
- while (*s && !isspace(*s)) s++;
- if (*s)
- *s++ = '\0';
+OS2_Perl_data_t OS2_Perl_data;
+
+int
+Xs_OS2_init()
+{
+ char *file = __FILE__;
+ {
+ newXS("File::Copy::syscopy", XS_File__Copy_syscopy, file);
}
- *a = Nullch;
- if (argv[0])
- if ((status = spawnvp(P_WAIT,argv[0],argv)) == -1) {
- Safefree(argv);
- Safefree(cmd2);
- goto doshell;
- }
- Safefree(cmd2);
- Safefree(argv);
- return status;
}
-usage(char *myname)
+void
+Perl_OS2_init()
{
-#ifdef MSDOS
- printf("\nUsage: %s [-acdnpPsSvw] [-0[octal]] [-Dnumber] [-i[extension]] [-Idirectory]"
-#else
- printf("\nUsage: %s [-acdnpPsSuUvw] [-Dnumber] [-i[extension]] [-Idirectory]"
-#endif
- "\n [-e \"command\"] [-x[directory]] [filename] [arguments]\n", myname);
-
- printf("\n -a autosplit mode with -n or -p"
- "\n -c syntaxcheck only"
- "\n -d run scripts under debugger"
- "\n -n assume 'while (<>) { ...script... }' loop arround your script"
- "\n -p assume loop like -n but print line also like sed"
- "\n -P run script through C preprocessor befor compilation"
- "\n -s enable some switch parsing for switches after script name"
- "\n -S look for the script using PATH environment variable");
-#ifndef MSDOS
- printf("\n -u dump core after compiling the script"
- "\n -U allow unsafe operations");
-#endif
- printf("\n -v print version number and patchlevel of perl"
- "\n -w turn warnings on for compilation of your script\n"
- "\n -0[octal] specify record separator (0, if no argument)"
- "\n -Dnumber set debugging flags (argument is a bit mask)"
- "\n -i[extension] edit <> files in place (make backup if extension supplied)"
- "\n -Idirectory specify include directory in conjunction with -P"
- "\n -e command one line of script, multiple -e options are allowed"
- "\n [filename] can be ommitted, when -e is used"
- "\n -x[directory] strip off text before #!perl line and perhaps cd to directory\n");
+ settmppath();
+ OS2_Perl_data.xs_init = &Xs_OS2_init;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff