perl
view release on metacpan or search on metacpan
((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 )