perl

 view release on metacpan or  search on metacpan

os2/os2.c  view on Meta::CPAN

        ((PFN*)&PMWIN_entries)[i - ORD_WinInitialize] = loadByOrdinal(i, 1);
}

/*****************************************************/
/* socket forwarders without linking with tcpip DLLs */

DeclFuncByORD(struct hostent *,  gethostent,  ORD_GETHOSTENT,  (void), ())
DeclFuncByORD(struct netent  *,  getnetent,   ORD_GETNETENT,   (void), ())
DeclFuncByORD(struct protoent *, getprotoent, ORD_GETPROTOENT, (void), ())
DeclFuncByORD(struct servent *,  getservent,  ORD_GETSERVENT,  (void), ())

DeclVoidFuncByORD(sethostent,  ORD_SETHOSTENT,  (int x), (x))
DeclVoidFuncByORD(setnetent,   ORD_SETNETENT,   (int x), (x))
DeclVoidFuncByORD(setprotoent, ORD_SETPROTOENT, (int x), (x))
DeclVoidFuncByORD(setservent,  ORD_SETSERVENT,  (int x), (x))

DeclVoidFuncByORD(endhostent,  ORD_ENDHOSTENT,  (void), ())
DeclVoidFuncByORD(endnetent,   ORD_ENDNETENT,   (void), ())
DeclVoidFuncByORD(endprotoent, ORD_ENDPROTOENT, (void), ())
DeclVoidFuncByORD(endservent,  ORD_ENDSERVENT,  (void), ())

/* priorities */
static const signed char priors[] = {0, 1, 3, 2}; /* Last two interchanged,
                                                     self inverse. */
#define QSS_INI_BUFFER 1024

ULONG (*pDosVerifyPidTid) (PID pid, TID tid);

PQTOPLEVEL
get_sysinfo(ULONG pid, ULONG flags)
{
    char *pbuffer;
    ULONG rc, buf_len = QSS_INI_BUFFER;
    PQTOPLEVEL psi;

    if (pid) {
        if (!pidtid_lookup) {
            pidtid_lookup = 1;
            *(PFN*)&pDosVerifyPidTid = loadByOrdinal(ORD_DosVerifyPidTid, 0);
        }
        if (pDosVerifyPidTid) {	/* Warp3 or later */
            /* Up to some fixpak QuerySysState() kills the system if a non-existent
               pid is used. */
            if (CheckOSError(pDosVerifyPidTid(pid, 1)))
                return 0;
        }
    }
    Newx(pbuffer, buf_len, char);
    /* QSS_PROCESS | QSS_MODULE | QSS_SEMAPHORES | QSS_SHARED */
    rc = QuerySysState(flags, pid, pbuffer, buf_len);
    while (rc == ERROR_BUFFER_OVERFLOW) {
        Renew(pbuffer, buf_len *= 2, char);
        rc = QuerySysState(flags, pid, pbuffer, buf_len);
    }
    if (rc) {
        FillOSError(rc);
        Safefree(pbuffer);
        return 0;
    }
    psi = (PQTOPLEVEL)pbuffer;
    if (psi && pid && psi->procdata && pid != psi->procdata->pid) {
      Safefree(psi);
      Perl_croak_nocontext("panic: wrong pid in sysinfo");
    }
    return psi;
}

#define PRIO_ERR 0x1111

static ULONG
sys_prio(pid)
{
  ULONG prio;
  PQTOPLEVEL psi;

  if (!pid)
      return PRIO_ERR;
  psi = get_sysinfo(pid, QSS_PROCESS);
  if (!psi)
      return PRIO_ERR;
  prio = psi->procdata->threads->priority;
  Safefree(psi);
  return prio;
}

int 
setpriority(int which, int pid, int val)
{
  ULONG rc, prio = sys_prio(pid);

  if (!(_emx_env & 0x200)) return 0; /* Nop if not OS/2. */
  if (priors[(32 - val) >> 5] + 1 == (prio >> 8)) {
      /* Do not change class. */
      return CheckOSError(DosSetPriority((pid < 0) 
                                         ? PRTYS_PROCESSTREE : PRTYS_PROCESS,
                                         0, 
                                         (32 - val) % 32 - (prio & 0xFF), 
                                         abs(pid)))
      ? -1 : 0;
  } else /* if ((32 - val) % 32 == (prio & 0xFF)) */ {
      /* Documentation claims one can change both class and basevalue,
       * but I find it wrong. */
      /* Change class, but since delta == 0 denotes absolute 0, correct. */
      if (CheckOSError(DosSetPriority((pid < 0) 
                                      ? PRTYS_PROCESSTREE : PRTYS_PROCESS,
                                      priors[(32 - val) >> 5] + 1, 
                                      0, 
                                      abs(pid)))) 
          return -1;
      if ( ((32 - val) % 32) == 0 ) return 0;
      return CheckOSError(DosSetPriority((pid < 0) 
                                         ? PRTYS_PROCESSTREE : PRTYS_PROCESS,
                                         0, 
                                         (32 - val) % 32, 
                                         abs(pid)))
          ? -1 : 0;
  } 
}

int 
getpriority(int which /* ignored */, int pid)
{
  ULONG ret;

  if (!(_emx_env & 0x200)) return 0; /* Nop if not OS/2. */
  ret = sys_prio(pid);
  if (ret == PRIO_ERR) {
      return -1;
  }
  return (1 - priors[((ret >> 8) - 1)])*32 - (ret & 0xFF);
}

/*****************************************************************************/
/* spawn */



static Signal_t
spawn_sighandler(int sig)
{
    /* Some programs do not arrange for the keyboard signals to be



( run in 0.937 second using v1.01-cache-2.11-cpan-39bf76dae61 )