home *** CD-ROM | disk | FTP | other *** search
/ Aminet 15 / Aminet 15 - Nov 1996.iso / Aminet / dev / lang / perl_src.lha / fsf / perl / os2 / os2.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-03-25  |  8.2 KB  |  385 lines

  1. #define INCL_DOS
  2. #define INCL_NOPM
  3. #define INCL_DOSFILEMGR
  4. #ifndef NO_SYS_ALLOC 
  5. #  define INCL_DOSMEMMGR
  6. #  define INCL_DOSERRORS
  7. #endif /* ! defined NO_SYS_ALLOC */
  8. #include <os2.h>
  9.  
  10. /*
  11.  * Various Unix compatibility functions for OS/2
  12.  */
  13.  
  14. #include <stdio.h>
  15. #include <errno.h>
  16. #include <limits.h>
  17. #include <process.h>
  18.  
  19. #include "EXTERN.h"
  20. #include "perl.h"
  21.  
  22. /*****************************************************************************/
  23. /* priorities */
  24.  
  25. int setpriority(int which, int pid, int val)
  26. {
  27.   return DosSetPriority((pid < 0) ? PRTYS_PROCESSTREE : PRTYS_PROCESS,
  28.             val >> 8, val & 0xFF, abs(pid));
  29. }
  30.  
  31. int getpriority(int which /* ignored */, int pid)
  32. {
  33.   TIB *tib;
  34.   PIB *pib;
  35.   DosGetInfoBlocks(&tib, &pib);
  36.   return tib->tib_ptib2->tib2_ulpri;
  37. }
  38.  
  39. /*****************************************************************************/
  40. /* spawn */
  41.  
  42. static int
  43. result(int flag, int pid)
  44. {
  45.     int r, status;
  46.     Signal_t (*ihand)();     /* place to save signal during system() */
  47.     Signal_t (*qhand)();     /* place to save signal during system() */
  48.  
  49.     if (pid < 0 || flag != 0) 
  50.         return pid;
  51.  
  52.     ihand = signal(SIGINT, SIG_IGN);
  53.     qhand = signal(SIGQUIT, SIG_IGN);
  54.     do {
  55.         r = wait4pid(pid, &status, 0);
  56.     } while (r == -1 && errno == EINTR);
  57.     signal(SIGINT, ihand);
  58.     signal(SIGQUIT, qhand);
  59.  
  60.     statusvalue = (U16)status;
  61.     if (r < 0)
  62.         return -1;
  63.     return status & 0xFFFF;
  64. }
  65.  
  66. int
  67. do_aspawn(really,mark,sp)
  68. SV *really;
  69. register SV **mark;
  70. register SV **sp;
  71. {
  72.     register char **a;
  73.     char *tmps;
  74.     int rc;
  75.     int flag = P_WAIT, trueflag;
  76.  
  77.     if (sp > mark) {
  78.     New(401,Argv, sp - mark + 1, char*);
  79.     a = Argv;
  80.  
  81.     if (mark < sp && SvIOKp(*(mark+1))) {
  82.         ++mark;
  83.         flag = SvIVx(*mark);
  84.     }
  85.  
  86.     while (++mark <= sp) {
  87.         if (*mark)
  88.         *a++ = SvPVx(*mark, na);
  89.         else
  90.         *a++ = "";
  91.     }
  92.     *a = Nullch;
  93.  
  94.     trueflag = flag;
  95.     if (flag == P_WAIT)
  96.         flag = P_NOWAIT;
  97.  
  98.     if (*Argv[0] != '/' && *Argv[0] != '\\') /* will swawnvp use PATH? */
  99.         TAINT_ENV();    /* testing IFS here is overkill, probably */
  100.     if (really && *(tmps = SvPV(really, na)))
  101.         rc = result(trueflag, spawnvp(flag,tmps,Argv));
  102.     else
  103.         rc = result(trueflag, spawnvp(flag,Argv[0],Argv));
  104.  
  105.     if (rc < 0 && dowarn)
  106.         warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno));
  107.     if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
  108.     } else
  109.         rc = -1;
  110.     do_execfree();
  111.     return rc;
  112. }
  113.  
  114. int
  115. do_spawn(cmd)
  116. char *cmd;
  117. {
  118.     register char **a;
  119.     register char *s;
  120.     char flags[10];
  121.     char *shell, *copt;
  122.     int rc;
  123.  
  124. #ifdef TRYSHELL
  125.     if ((shell = getenv("EMXSHELL")) != NULL)
  126.         copt = "-c";
  127.     else if ((shell = getenv("SHELL")) != NULL)
  128.         copt = "-c";
  129.     else if ((shell = getenv("COMSPEC")) != NULL)
  130.         copt = "/C";
  131.     else
  132.         shell = "cmd.exe";
  133. #else
  134.     /* Consensus on perl5-porters is that it is _very_ important to
  135.        have a shell which will not change between computers with the
  136.        same architecture, to avoid "action on a distance". 
  137.        And to have simple build, this shell should be sh. */
  138.     shell = "sh.exe";
  139.     copt = "-c";
  140. #endif 
  141.  
  142.     while (*cmd && isSPACE(*cmd))
  143.     cmd++;
  144.  
  145.     /* save an extra exec if possible */
  146.     /* see if there are shell metacharacters in it */
  147.  
  148.     if (*cmd == '.' && isSPACE(cmd[1]))
  149.     goto doshell;
  150.  
  151.     if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
  152.     goto doshell;
  153.  
  154.     for (s = cmd; *s && isALPHA(*s); s++) ;    /* catch VAR=val gizmo */
  155.     if (*s == '=')
  156.     goto doshell;
  157.  
  158.     for (s = cmd; *s; s++) {
  159.     if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
  160.         if (*s == '\n' && !s[1]) {
  161.         *s = '\0';
  162.         break;
  163.         }
  164.       doshell:
  165.         rc = result(P_WAIT,
  166.               spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0));
  167.         if (rc < 0 && dowarn)
  168.         warn("Can't spawn \"%s\": %s", shell, Strerror(errno));
  169.         if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
  170.         return rc;
  171.     }
  172.     }
  173.  
  174.     New(402,Argv, (s - cmd) / 2 + 2, char*);
  175.     Cmd = savepvn(cmd, s-cmd);
  176.     a = Argv;
  177.     for (s = Cmd; *s;) {
  178.     while (*s && isSPACE(*s)) s++;
  179.     if (*s)
  180.         *(a++) = s;
  181.     while (*s && !isSPACE(*s)) s++;
  182.     if (*s)
  183.         *s++ = '\0';
  184.     }
  185.     *a = Nullch;
  186.     if (Argv[0]) {
  187.     rc = result(P_WAIT, spawnvp(P_NOWAIT,Argv[0],Argv));
  188.     if (rc < 0 && dowarn)
  189.         warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno));
  190.     if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
  191.     } else
  192.         rc = -1;
  193.     do_execfree();
  194.     return rc;
  195. }
  196.  
  197. FILE *
  198. my_popen(cmd,mode)
  199. char    *cmd;
  200. char    *mode;
  201. {
  202.     char *shell = getenv("EMXSHELL");
  203.     FILE *res;
  204.     
  205.     my_setenv("EMXSHELL", "sh.exe");
  206.     res = popen(cmd, mode);
  207.     my_setenv("EMXSHELL", shell);
  208.     return res;
  209. }
  210.  
  211. /*****************************************************************************/
  212.  
  213. #ifndef HAS_FORK
  214. int
  215. fork(void)
  216. {
  217.     die(no_func, "Unsupported function fork");
  218.     errno = EINVAL;
  219.     return -1;
  220. }
  221. #endif
  222.  
  223. /*****************************************************************************/
  224. /* not implemented in EMX 0.9a */
  225.  
  226. void *    ctermid(x)    { return 0; }
  227.  
  228. #ifdef MYTTYNAME /* was not in emx0.9a */
  229. void *    ttyname(x)    { return 0; }
  230. #endif
  231.  
  232. void *    gethostent()    { return 0; }
  233. void *    getnetent()    { return 0; }
  234. void *    getprotoent()    { return 0; }
  235. void *    getservent()    { return 0; }
  236. void    sethostent(x)    {}
  237. void    setnetent(x)    {}
  238. void    setprotoent(x)    {}
  239. void    setservent(x)    {}
  240. void    endhostent(x)    {}
  241. void    endnetent(x)    {}
  242. void    endprotoent(x)    {}
  243. void    endservent(x)    {}
  244.  
  245. /*****************************************************************************/
  246. /* stat() hack for char/block device */
  247.  
  248. #if OS2_STAT_HACK
  249.  
  250.     /* First attempt used DosQueryFSAttach which crashed the system when
  251.        used with 5.001. Now just look for /dev/. */
  252.  
  253. int
  254. os2_stat(char *name, struct stat *st)
  255. {
  256.     static int ino = SHRT_MAX;
  257.  
  258.     if (stricmp(name, "/dev/con") != 0
  259.      && stricmp(name, "/dev/tty") != 0)
  260.     return stat(name, st);
  261.  
  262.     memset(st, 0, sizeof *st);
  263.     st->st_mode = S_IFCHR|0666;
  264.     st->st_ino = (ino-- & 0x7FFF);
  265.     st->st_nlink = 1;
  266.     return 0;
  267. }
  268.  
  269. #endif
  270.  
  271. #ifndef NO_SYS_ALLOC
  272.  
  273. static char *oldchunk;
  274. static long oldsize;
  275.  
  276. #define _32_K (1<<15)
  277. #define _64_K (1<<16)
  278.  
  279. /* The real problem is that DosAllocMem will grant memory on 64K-chunks
  280.  * boundaries only. Note that addressable space for application memory
  281.  * is around 240M, thus we will run out of addressable space if we
  282.  * allocate around 14M worth of 4K segments.
  283.  * Thus we allocate memory in 64K chunks, and abandon the rest of the old
  284.  * chunk if the new is bigger than that rest. Also, we just allocate
  285.  * whatever is requested if the size is bigger that 32K. With this strategy
  286.  * we cannot lose more than 1/2 of addressable space. */
  287.  
  288. void *
  289. sbrk(int size)
  290. {
  291.     char *got;
  292.     APIRET rc;
  293.     int small, reqsize;
  294.  
  295.     if (!size) return 0;
  296.     else if (size <= oldsize) {
  297.     got = oldchunk;
  298.     oldchunk += size;
  299.     oldsize -= size;
  300.     return (void *)got;
  301.     } else if (size >= _32_K) {
  302.     small = 0;
  303.     } else {
  304.     reqsize = size;
  305.     size = _64_K;
  306.     small = 1;
  307.     }
  308.     rc = DosAllocMem((void **)&got, size, PAG_COMMIT | PAG_WRITE);
  309.     if (rc == ERROR_NOT_ENOUGH_MEMORY) {
  310.     return (void *) -1;
  311.     } else if ( rc ) die("Got an error from DosAllocMem: %li", (long)rc);
  312.     if (small) {
  313.     /* Chunk is small, register the rest for future allocs. */
  314.     oldchunk = got + reqsize;
  315.     oldsize = size - reqsize;
  316.     }
  317.     return (void *)got;
  318. }
  319. #endif /* ! defined NO_SYS_ALLOC */
  320.  
  321. /* tmp path */
  322.  
  323. char *tmppath = TMPPATH1;
  324.  
  325. void
  326. settmppath()
  327. {
  328.     char *p = getenv("TMP"), *tpath;
  329.     int len;
  330.  
  331.     if (!p) p = getenv("TEMP");
  332.     if (!p) return;
  333.     len = strlen(p);
  334.     tpath = (char *)malloc(len + strlen(TMPPATH1) + 2);
  335.     strcpy(tpath, p);
  336.     tpath[len] = '/';
  337.     strcpy(tpath + len + 1, TMPPATH1);
  338.     tmppath = tpath;
  339. }
  340.  
  341. #include "XSUB.h"
  342.  
  343. XS(XS_File__Copy_syscopy)
  344. {
  345.     dXSARGS;
  346.     if (items < 2 || items > 3)
  347.     croak("Usage: File::Copy::syscopy(src,dst,flag=0)");
  348.     {
  349.     char *    src = (char *)SvPV(ST(0),na);
  350.     char *    dst = (char *)SvPV(ST(1),na);
  351.     U32    flag;
  352.     int    RETVAL, rc;
  353.  
  354.     if (items < 3)
  355.         flag = 0;
  356.     else {
  357.         flag = (unsigned long)SvIV(ST(2));
  358.     }
  359.  
  360.     errno = DosCopy(src, dst, flag);
  361.     RETVAL = !errno;
  362.     ST(0) = sv_newmortal();
  363.     sv_setiv(ST(0), (IV)RETVAL);
  364.     }
  365.     XSRETURN(1);
  366. }
  367.  
  368. OS2_Perl_data_t OS2_Perl_data;
  369.  
  370. int
  371. Xs_OS2_init()
  372. {
  373.     char *file = __FILE__;
  374.     {
  375.         newXS("File::Copy::syscopy", XS_File__Copy_syscopy, file);
  376.     }
  377. }
  378.  
  379. void
  380. Perl_OS2_init()
  381. {
  382.     settmppath();
  383.     OS2_Perl_data.xs_init = &Xs_OS2_init;
  384. }
  385.