/* Terminate normally with a result code. */
Handle finishc(TaskData *taskData, Handle h)
{
int i = get_C_int(taskData, DEREFWORDHANDLE(h));
// Cause the other threads to exit.
processes->Exit(i);
// Exit this thread
processes->ThreadExit(taskData); // Doesn't return.
// Push a dummy result to keep lint happy
return taskData->saveVec.push(TAGGED(0));
}
Handle Real_strc(TaskData *mdTaskData, Handle hDigits, Handle hMode, Handle arg)
{
double dx = real_arg(arg);
int decpt, sign;
int mode = get_C_int(mdTaskData, DEREFWORDHANDLE(hMode));
int digits = get_C_int(mdTaskData, DEREFWORDHANDLE(hDigits));
/* Compute the shortest string which gives the required value. */
/* */
char *chars = poly_dtoa(dx, mode, digits, &decpt, &sign, NULL);
/* We have to be careful in case an allocation causes a
garbage collection. */
PolyWord pStr = C_string_to_Poly(mdTaskData, chars);
poly_freedtoa(chars);
Handle ppStr = mdTaskData->saveVec.push(pStr);
/* Allocate a triple for the results. */
PolyObject *result = alloc(mdTaskData, 3);
result->Set(0, DEREFWORDHANDLE(ppStr));
result->Set(1, TAGGED(decpt));
result->Set(2, TAGGED(sign));
return mdTaskData->saveVec.push(result);
}
/* Functions added for Standard Basis Library are all indirected through here. */
Handle Real_dispatchc(TaskData *mdTaskData, Handle args, Handle code)
{
unsigned c = get_C_unsigned(mdTaskData, DEREFWORDHANDLE(code));
switch (c)
{
case 0: /* tan */ return real_result(mdTaskData, tan(real_arg(args)));
case 1: /* asin */
{
double x = real_arg(args);
if (x < -1.0 || x > 1.0)
return real_result(mdTaskData, notANumber);
else return real_result(mdTaskData, asin(x));
}
case 2: /* acos */
{
double x = real_arg(args);
if (x < -1.0 || x > 1.0)
return real_result(mdTaskData, notANumber);
else return real_result(mdTaskData, acos(x));
}
case 3: /* atan2 */ return real_result(mdTaskData, atan2(real_arg1(args), real_arg2(args)));
case 4: /* pow */ return powerOf(mdTaskData, args);
case 5: /* log10 */
{
double x = real_arg(args);
/* Make sure the result conforms to the definition. */
if (x < 0.0)
return real_result(mdTaskData, notANumber); /* Nan. */
else if (x == 0.0) /* x may be +0.0 or -0.0 */
return real_result(mdTaskData, negInf); /* -infinity. */
else return real_result(mdTaskData, log10(x));
}
case 6: /* sinh */ return real_result(mdTaskData, sinh(real_arg(args)));
case 7: /* cosh */ return real_result(mdTaskData, cosh(real_arg(args)));
case 8: /* tanh */ return real_result(mdTaskData, tanh(real_arg(args)));
case 9: /* setroundingmode */
setrounding(mdTaskData, args);
return mdTaskData->saveVec.push(TAGGED(0)); /* Unit */
case 10: /* getroundingmode */
return mdTaskData->saveVec.push(TAGGED(getrounding(mdTaskData)));
/* Floating point representation queries. */
#ifdef _DBL_RADIX
case 11: /* Value of radix */ return mdTaskData->saveVec.push(TAGGED(_DBL_RADIX));
#else
case 11: /* Value of radix */ return mdTaskData->saveVec.push(TAGGED(FLT_RADIX));
#endif
case 12: /* Value of precision */ return mdTaskData->saveVec.push(TAGGED(DBL_MANT_DIG));
case 13: /* Maximum number */ return real_result(mdTaskData, DBL_MAX);
/* float.h describes DBL_MIN as the minimum positive number.
In fact this is the minimum NORMALISED number. The smallest
number which can be represented is DBL_MIN*2**(-DBL_MANT_DIG) */
case 14: /* Minimum normalised number. */
return real_result(mdTaskData, DBL_MIN);
case 15: /* Is finite */ /* No longer used - implemented in ML. */
return mdTaskData->saveVec.push(finite(real_arg(args)) ? TAGGED(1) : TAGGED(0));
case 16: /* Is Nan */ /* No longer used - implemented in ML. */
return mdTaskData->saveVec.push(isnan(real_arg(args)) ? TAGGED(1) : TAGGED(0));
case 17: /* Get sign bit. There may be better ways to find this. */
return mdTaskData->saveVec.push(copysign(1.0, real_arg(args)) < 0.0 ? TAGGED(1) : TAGGED(0));
case 18: /* Copy sign. */
return real_result(mdTaskData, copysign(real_arg1(args), real_arg2(args)));
case 19: /* Return largest integral value (as a real) <= x. */
return real_result(mdTaskData, floor(real_arg(args)));
case 20: /* Return smallest integral value (as a real) >= x */
return real_result(mdTaskData, ceil(real_arg(args)));
case 21:
{ /* Truncate towards zero */
double dx = real_arg(args);
if (dx >= 0.0) return real_result(mdTaskData, floor(dx));
else return real_result(mdTaskData, ceil(dx));
}
case 22: /* Round to nearest integral value. */
{
double dx = real_arg(args);
double drem = fmod(dx, 2.0);
if (drem == 0.5 || drem == -1.5)
/* If the value was exactly positive even + 0.5 or
negative odd -0.5 round it down, otherwise round it up. */
return real_result(mdTaskData, ceil(dx-0.5));
else return real_result(mdTaskData, floor(dx+0.5));
}
case 23: /* Compute ldexp */
{
int exp = get_C_int(mdTaskData, DEREFHANDLE(args)->Get(1));
return real_result(mdTaskData, ldexp(real_arg1(args), exp));
}
case 24: /* Get mantissa. */
{
int exp;
return real_result(mdTaskData, frexp(real_arg(args), &exp));
}
case 25: /* Get exponent. */
{
int exp;
(void)frexp(real_arg(args), &exp);
return mdTaskData->saveVec.push(TAGGED(exp));
}
case 26: /* Return the mantissa from a Nan as a real number. */
// I think this is no longer used.
{
union db r_arg_x, r_arg_y;
/* We want to simply replace the exponent by the exponent
value for 0.5<=x<1.
I think there may be a more portable way of doing this. */
r_arg_x.dble = posInf; /* Positive infinity. */
r_arg_y.dble = 0.5;
/* Use the infinity value as a mask, removing any bits set
and replace by the exponent from 0.5. */
byte *barg = DEREFBYTEHANDLE(args);
for(unsigned i = 0; i < DBLE; i++)
{
r_arg_x.bytes[i] = (barg[i] & ~r_arg_x.bytes[i]) | r_arg_y.bytes[i];
}
return real_result(mdTaskData, r_arg_x.dble);
}
case 27: /* Construct a Nan from a given mantissa. */
// I think this is no longer used.
{
union db r_arg;
r_arg.dble = posInf; /* Positive infinity. */
/* OR in the exponent. */
byte *barg = DEREFBYTEHANDLE(args);
for(unsigned i = 0; i < DBLE; i++)
{
r_arg.bytes[i] = r_arg.bytes[i] | barg[i];
}
return real_result(mdTaskData, r_arg.dble);
}
case 28: /* Return the number of bytes for a real. */
return mdTaskData->saveVec.push(TAGGED(sizeof(double)));
default:
{
char msg[100];
sprintf(msg, "Unknown real arithmetic function: %d", c);
raise_exception_string(mdTaskData, EXC_Fail, msg);
return 0;
}
}
}
Handle process_env_dispatch_c(TaskData *mdTaskData, Handle args, Handle code)
{
unsigned c = get_C_unsigned(mdTaskData, DEREFWORDHANDLE(code));
switch (c)
{
case 0: /* Return the program name. */
return SAVE(C_string_to_Poly(mdTaskData, userOptions.programName));
case 1: /* Return the argument list. */
return convert_string_list(mdTaskData, userOptions.user_arg_count, userOptions.user_arg_strings);
case 14: /* Return a string from the environment. */
{
TempString buff(args->Word());
if (buff == 0) raise_syscall(mdTaskData, "Insufficient memory", ENOMEM);
TCHAR *res = _tgetenv(buff);
if (res == NULL) raise_syscall(mdTaskData, "Not Found", 0);
else return SAVE(C_string_to_Poly(mdTaskData, res));
}
case 21: // Return the whole environment. Only available in Posix.ProcEnv.
{
/* Count the environment strings */
int env_count = 0;
while (environ[env_count] != NULL) env_count++;
return convert_string_list(mdTaskData, env_count, environ);
}
case 15: /* Return the success value. */
return Make_arbitrary_precision(mdTaskData, EXIT_SUCCESS);
case 16: /* Return a failure value. */
return Make_arbitrary_precision(mdTaskData, EXIT_FAILURE);
case 17: /* Run command. */
{
TempString buff(args->Word());
if (buff == 0) raise_syscall(mdTaskData, "Insufficient memory", ENOMEM);
int res = -1;
#if (defined(_WIN32) && ! defined(__CYGWIN__))
// Windows.
TCHAR *argv[4];
argv[0] = _tgetenv(_T("COMSPEC")); // Default CLI.
if (argv[0] == 0) argv[0] = (TCHAR*)_T("cmd.exe"); // Win NT etc.
argv[1] = (TCHAR*)_T("/c");
argv[2] = buff;
argv[3] = NULL;
// If _P_NOWAIT is given the result is the process handle.
// spawnvp does any necessary path searching if argv[0]
// does not contain a full path.
intptr_t pid = _tspawnvp(_P_NOWAIT, argv[0], argv);
if (pid == -1)
raise_syscall(mdTaskData, "Function system failed", errno);
#else
// Cygwin and Unix
char *argv[4];
argv[0] = (char*)"sh";
argv[1] = (char*)"-c";
argv[2] = buff;
argv[3] = NULL;
#if (defined(__CYGWIN__))
CygwinSpawnRequest request(argv);
processes->MakeRootRequest(mdTaskData, &request);
int pid = request.pid;
if (pid < 0)
raise_syscall(mdTaskData, "Function system failed", errno);
#else
// We need to break this down so that we can unblock signals in the
// child process.
// The Unix "system" function seems to set SIGINT and SIGQUIT to
// SIG_IGN in the parent so that the wait will not be interrupted.
// That may make sense in a single-threaded application but is
// that right here?
int pid = vfork();
if (pid == -1)
raise_syscall(mdTaskData, "Function system failed", errno);
else if (pid == 0)
{ // In child
sigset_t sigset;
sigemptyset(&sigset);
sigprocmask(SIG_SETMASK, &sigset, 0);
// Reset other signals?
execve("/bin/sh", argv, environ);
_exit(1);
}
#endif
#endif
while (true)
{
try
{
// Test to see if the child has returned.
#if (defined(_WIN32) && ! defined(__CYGWIN__))
switch (WaitForSingleObject((HANDLE)pid, 0))
{
case WAIT_OBJECT_0:
{
DWORD result;
BOOL fResult = GetExitCodeProcess((HANDLE)pid, &result);
if (! fResult)
raise_syscall(mdTaskData, "Function system failed", -(int)GetLastError());
CloseHandle((HANDLE)pid);
return Make_arbitrary_precision(mdTaskData, result);
}
case WAIT_FAILED:
raise_syscall(mdTaskData, "Function system failed", -(int)GetLastError());
}
// Wait for the process to exit or for the timeout
WaitHandle waiter((HANDLE)pid);
processes->ThreadPauseForIO(mdTaskData, &waiter);
#else
int wRes = waitpid(pid, &res, WNOHANG);
if (wRes > 0)
break;
else if (wRes < 0)
{
raise_syscall(mdTaskData, "Function system failed", errno);
}
// In Unix the best we can do is wait. This may be interrupted
// by SIGCHLD depending on where signals are processed.
// One possibility is for the main thread to somehow wake-up
// the thread when it processes a SIGCHLD.
processes->ThreadPause(mdTaskData);
#endif
}
catch (...)
{
// Either IOException or KillException.
// We're abandoning the wait. This will leave
// a zombie in Unix.
#if (defined(_WIN32) && ! defined(__CYGWIN__))
CloseHandle((HANDLE)pid);
#endif
throw;
}
}
return Make_arbitrary_precision(mdTaskData, res);
}
case 18: /* Register function to run at exit. */
{
PLocker locker(&atExitLock);
if (! exiting)
{
PolyObject *cell = alloc(mdTaskData, 2);
cell->Set(0, at_exit_list);
cell->Set(1, DEREFWORD(args));
at_exit_list = cell;
}
return Make_arbitrary_precision(mdTaskData, 0);
}
case 19: /* Return the next function in the atExit list and set the
"exiting" flag to true. */
{
PLocker locker(&atExitLock);
Handle res;
exiting = true; /* Ignore further calls to atExit. */
if (at_exit_list == TAGGED(0))
raise_syscall(mdTaskData, "List is empty", 0);
PolyObject *cell = at_exit_list.AsObjPtr();
res = SAVE(cell->Get(1));
at_exit_list = cell->Get(0);
return res;
}
case 20: /* Terminate without running the atExit list or flushing buffers. */
{
/* I don't like terminating without some sort of clean up
but we'll do it this way for the moment. */
int i = get_C_int(mdTaskData, DEREFWORDHANDLE(args));
_exit(i);
}
/************ Error codes **************/
case 2: /* Get the name of a numeric error message. */
{
char buff[40];
int e = get_C_int(mdTaskData, DEREFWORDHANDLE(args));
Handle res;
/* First look to see if we have the name in
the error table. They should generally all be
there. */
const char *errorMsg = stringFromErrorCode(e);
if (errorMsg != NULL)
return SAVE(C_string_to_Poly(mdTaskData, errorMsg));
/* We get here if there's an error which isn't in the table. */
#if (defined(_WIN32) && ! defined(__CYGWIN__))
/* In the Windows version we may have both errno values
and also GetLastError values. We convert the latter into
negative values before returning them. */
if (e < 0)
{
sprintf(buff, "WINERROR%0d", -e);
res = SAVE(C_string_to_Poly(mdTaskData, buff));
return res;
}
else
#endif
{
sprintf(buff, "ERROR%0d", e);
res = SAVE(C_string_to_Poly(mdTaskData, buff));
}
return res;
}
case 3: /* Get the explanatory message for an error. */
{
return errorMsg(mdTaskData, get_C_int(mdTaskData, DEREFWORDHANDLE(args)));
}
case 4: /* Try to convert an error string to an error number. */
{
char buff[40];
/* Get the string. */
Poly_string_to_C(DEREFWORD(args), buff, sizeof(buff));
/* Look the string up in the table. */
int err = 0;
if (errorCodeFromString(buff, &err))
return Make_arbitrary_precision(mdTaskData, err);
/* If we don't find it then it may have been a constructed
error name. */
if (strncmp(buff, "ERROR", 5) == 0)
{
int i = atoi(buff+5);
if (i > 0) return Make_arbitrary_precision(mdTaskData, i);
}
#if (defined(_WIN32) && ! defined(__CYGWIN__))
if (strncmp(buff, "WINERROR", 8) == 0)
{
int i = atoi(buff+8);
if (i > 0) return Make_arbitrary_precision(mdTaskData, -i);
}
#endif
return Make_arbitrary_precision(mdTaskData, 0);
}
/************ Directory/file paths **************/
case 5: /* Return the string representing the current arc. */
return SAVE(C_string_to_Poly(mdTaskData, "."));
case 6: /* Return the string representing the parent arc. */
/* I don't know that this exists in MacOS. */
return SAVE(C_string_to_Poly(mdTaskData, ".."));
case 7: /* Return the string representing the directory separator. */
return SAVE(C_string_to_Poly(mdTaskData, DEFAULTSEPARATOR));
case 8: /* Test the character to see if it matches a separator. */
{
int e = get_C_int(mdTaskData, DEREFWORDHANDLE(args));
if (ISPATHSEPARATOR(e))
return Make_arbitrary_precision(mdTaskData, 1);
else return Make_arbitrary_precision(mdTaskData, 0);
}
case 9: /* Are names case-sensitive? */
#if (defined(_WIN32) && ! defined(__CYGWIN__))
/* Windows - no. */
return Make_arbitrary_precision(mdTaskData, 0);
#else
/* Unix - yes. */
return Make_arbitrary_precision(mdTaskData, 1);
#endif
// These are no longer used. The code is handled entirely in ML.
case 10: /* Are empty arcs redundant? */
/* Unix and Windows - yes. */
return Make_arbitrary_precision(mdTaskData, 1);
case 11: /* Match the volume name part of a path. */
{
const TCHAR *volName = NULL;
int isAbs = 0;
int toRemove = 0;
PolyWord path = DEREFHANDLE(args);
/* This examines the start of a string and determines
how much of it represents the volume name and returns
the number of characters to remove, the volume name
and whether it is absolute.
One would assume that if there is a volume name then it
is absolute but there is a peculiar form in Windows/DOS
(e.g. A:b\c) which means the file b\c relative to the
currently selected directory on the volume A.
*/
#if (defined(_WIN32) && ! defined(__CYGWIN__))
TempString buff(path);
if (buff == 0) raise_syscall(mdTaskData, "Insufficient memory", ENOMEM);
size_t length = _tcslen(buff);
if (length >= 2 && buff[1] == ':')
{ /* Volume name? */
if (length >= 3 && ISPATHSEPARATOR(buff[2]))
{
/* Absolute path. */
toRemove = 3; isAbs = 1;
}
else { toRemove = 2; isAbs = 0; }
volName = buff; buff[2] = '\0';
}
else if (length > 3 &&
ISPATHSEPARATOR(buff[0]) &&
ISPATHSEPARATOR(buff[1]) &&
! ISPATHSEPARATOR(buff[2]))
{ /* UNC name? */
int i;
/* Skip the server name. */
for (i = 3; buff[i] != 0 && !ISPATHSEPARATOR(buff[i]); i++);
if (ISPATHSEPARATOR(buff[i]))
{
i++;
/* Skip the share name. */
for (; buff[i] != 0 && !ISPATHSEPARATOR(buff[i]); i++);
toRemove = i;
if (buff[i] != 0) toRemove++;
isAbs = 1;
volName = buff;
buff[i] = '\0';
}
}
else if (ISPATHSEPARATOR(buff[0]))
/* \a\b strictly speaking is relative to the
current drive. It's much easier to treat it
as absolute. */
{ toRemove = 1; isAbs = 1; volName = _T(""); }
#else
/* Unix - much simpler. */
char toTest = 0;
if (IS_INT(path)) toTest = UNTAGGED(path);
else {
PolyStringObject * ps = (PolyStringObject *)path.AsObjPtr();
if (ps->length > 1) toTest = ps->chars[0];
}
if (ISPATHSEPARATOR(toTest))
{ toRemove = 1; isAbs = 1; volName = ""; }
#endif
/* Construct the result. */
{
Handle sVol = SAVE(C_string_to_Poly(mdTaskData, volName));
Handle sRes = ALLOC(3);
DEREFWORDHANDLE(sRes)->Set(0, TAGGED(toRemove));
DEREFHANDLE(sRes)->Set(1, DEREFWORDHANDLE(sVol));
DEREFWORDHANDLE(sRes)->Set(2, TAGGED(isAbs));
return sRes;
}
}
case 12: /* Construct a name from a volume and whether it is
absolute. */
{
unsigned isAbs = get_C_unsigned(mdTaskData, DEREFHANDLE(args)->Get(1));
PolyWord volName = DEREFHANDLE(args)->Get(0);
/* In Unix the volume name will always be empty. */
if (isAbs == 0)
return SAVE(volName);
/* N.B. The arguments to strconcatc are in reverse. */
else return strconcatc(mdTaskData,
SAVE(C_string_to_Poly(mdTaskData, DEFAULTSEPARATOR)),
SAVE(volName));
}
case 13: /* Is the string a valid file name? */
{
PolyWord volName = DEREFWORD(args);
// First check for NULL. This is not allowed in either Unix or Windows.
if (IS_INT(volName))
{
if (volName == TAGGED(0))
return Make_arbitrary_precision(mdTaskData, 0);
}
else
{
PolyStringObject * volume = (PolyStringObject *)(volName.AsObjPtr());
for (POLYUNSIGNED i = 0; i < volume->length; i++)
{
if (volume->chars[i] == '\0')
return Make_arbitrary_precision(mdTaskData, 0);
}
}
#if (defined(_WIN32) && ! defined(__CYGWIN__))
// We need to look for certain invalid characters but only after
// we've converted it to Unicode if necessary.
TempString name(volName);
for (const TCHAR *p = name; *p != 0; p++)
{
switch (*p)
{
case '<': case '>': case ':': case '"':
case '\\': case '|': case '?': case '*': case '\0':
#if (0)
// This currently breaks the build.
case '/':
#endif
return Make_arbitrary_precision(mdTaskData, 0);
}
if (*p >= 0 && *p <= 31) return Make_arbitrary_precision(mdTaskData, 0);
}
// Should we check for special names such as aux, con, prn ??
return Make_arbitrary_precision(mdTaskData, 1);
#else
// That's all we need for Unix.
// TODO: Check for /. It's invalid in a file name arc.
return Make_arbitrary_precision(mdTaskData, 1);
#endif
}
// A group of calls have now been moved to poly_specific.
// This entry is returned for backwards compatibility.
case 100: case 101: case 102: case 103: case 104: case 105:
return poly_dispatch_c(mdTaskData, args, code);
default:
{
char msg[100];
sprintf(msg, "Unknown environment function: %d", c);
raise_exception_string(mdTaskData, EXC_Fail, msg);
return 0;
}
}
}
Handle OS_spec_dispatch_c(TaskData *taskData, Handle args, Handle code)
{
int c = get_C_int(taskData, DEREFWORD(code));
switch (c)
{
case 0: /* Return our OS type. Not in any structure. */
return Make_arbitrary_precision(taskData, 1); /* 1 for Windows. */
/* Windows-specific functions. */
case 1000: /* execute */
return execute(taskData, args);
case 1001: /* Get input stream as text. */
return openProcessHandle(taskData, args, TRUE, TRUE);
case 1002: /* Get output stream as text. */
return openProcessHandle(taskData, args, FALSE, TRUE);
case 1003: /* Get input stream as binary. */
return openProcessHandle(taskData, args, TRUE, FALSE);
case 1004: /* Get output stream as binary. */
return openProcessHandle(taskData, args, FALSE, FALSE);
case 1005: /* Get result of process. */
{
PHANDLETAB hnd = get_handle(DEREFWORD(args), HE_PROCESS);
if (hnd == 0)
raise_syscall(taskData, "Process is closed", EINVAL);
// Close the streams. Either of them may have been
// passed to the stream package.
if (hnd->entry.process.hInput != INVALID_HANDLE_VALUE)
CloseHandle(hnd->entry.process.hInput);
hnd->entry.process.hInput = INVALID_HANDLE_VALUE;
if (hnd->entry.process.hEvent)
CloseHandle(hnd->entry.process.hEvent);
hnd->entry.process.hEvent = NULL;
if (hnd->entry.process.readToken)
{
PIOSTRUCT strm =
get_stream(hnd->entry.process.readToken);
if (strm != NULL) close_stream(strm);
}
hnd->entry.process.readToken = 0;
if (hnd->entry.process.hOutput != INVALID_HANDLE_VALUE)
CloseHandle(hnd->entry.process.hOutput);
hnd->entry.process.hOutput = INVALID_HANDLE_VALUE;
if (hnd->entry.process.writeToken)
{
PIOSTRUCT strm =
get_stream(hnd->entry.process.writeToken);
if (strm != NULL) close_stream(strm);
}
hnd->entry.process.writeToken = 0;
// See if it's finished.
while (true) {
DWORD dwResult;
if (GetExitCodeProcess(hnd->entry.process.hProcess, &dwResult) == 0)
raise_syscall(taskData, "GetExitCodeProcess failed",
-(int)GetLastError());
if (dwResult != STILL_ACTIVE) {
/* Finished - return the result. */
/* Note: we haven't closed the handle because we might want to ask
for the result again. We only close it when we've garbage-collected
the token. Doing this runs the risk of running out of handles.
Maybe change it and remember the result in ML. */
return Make_unsigned(taskData, dwResult);
}
// Block and try again.
WaitHandle waiter(hnd->entry.process.hProcess);
processes->ThreadPauseForIO(taskData, &waiter);
}
}
case 1006: /* Return a constant. */
{
unsigned i = get_C_unsigned(taskData, DEREFWORD(args));
if (i >= sizeof(winConstVec)/sizeof(winConstVec[0]))
raise_syscall(taskData, "Invalid index", 0);
return Make_unsigned(taskData, winConstVec[i]);
}
/* Registry functions. */
case 1007: // Open a key within one of the roots.
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
// This should only ever happen as a result of a fault in
// the Windows structure.
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return openRegistryKey(taskData, args, hkPredefinedKeyTab[keyIndex]);
}
case 1008: // Open a subkey of an opened key.
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return openRegistryKey(taskData, args, hnd->entry.hKey);
}
case 1009: // Create a subkey within one of the roots.
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
// This should only ever happen as a result of a fault in
// the Windows structure.
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return createRegistryKey(taskData, args, hkPredefinedKeyTab[keyIndex]);
}
case 1010: // Create a subkey within an opened key.
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return createRegistryKey(taskData, args, hnd->entry.hKey);
}
case 1011: // Close a registry handle.
{
PHANDLETAB hnd = get_handle(DEREFWORD(args), HE_REGISTRY);
if (hnd != 0) close_handle(hnd);
return Make_arbitrary_precision(taskData, 0);
}
case 1012: // Get a value
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
// This should only ever happen as a result of a fault in
// the Windows structure.
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return queryRegistryKey(taskData, args, hkPredefinedKeyTab[keyIndex]);
}
case 1013: // Get a value
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return queryRegistryKey(taskData, args, hnd->entry.hKey);
}
case 1014: // Delete a subkey
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
// This should only ever happen as a result of a fault in
// the Windows structure.
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return deleteRegistryKey(taskData, args, hkPredefinedKeyTab[keyIndex]);
}
case 1015: // Delete a subkey
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return deleteRegistryKey(taskData, args, hnd->entry.hKey);
}
case 1016: // Set a value
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
// This should only ever happen as a result of a fault in
// the Windows structure.
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return setRegistryKey(taskData, args, hkPredefinedKeyTab[keyIndex]);
}
case 1017: // Set a value
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return setRegistryKey(taskData, args, hnd->entry.hKey);
}
case 1018: // Enumerate a key in the predefined keys
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return enumerateRegistry(taskData, args, hkPredefinedKeyTab[keyIndex], TRUE);
}
case 1019: // Enumerate a key in an opened key
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return enumerateRegistry(taskData, args, hnd->entry.hKey, TRUE);
}
case 1020: // Enumerate a value in the predefined keys
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return enumerateRegistry(taskData, args, hkPredefinedKeyTab[keyIndex], FALSE);
}
case 1021: // Enumerate a value in an opened key
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return enumerateRegistry(taskData, args, hnd->entry.hKey, FALSE);
}
case 1022: // Delete a value
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
// This should only ever happen as a result of a fault in
// the Windows structure.
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return deleteRegistryValue(taskData, args, hkPredefinedKeyTab[keyIndex]);
}
case 1023: // Delete a value
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return deleteRegistryValue(taskData, args, hnd->entry.hKey);
}
case 1030: // Convert UTC time values to local time. -- No longer used??
{
FILETIME ftUTC, ftLocal;
/* Get the file time. */
get_C_pair(taskData, DEREFWORDHANDLE(args),
&ftUTC.dwHighDateTime, &ftUTC.dwLowDateTime);
if (! FileTimeToLocalFileTime(&ftUTC, &ftLocal))
raise_syscall(taskData, "FileTimeToLocalFileTime failed",
-(int)GetLastError());
return Make_arb_from_pair(taskData, ftLocal.dwHighDateTime,
ftLocal.dwLowDateTime);
}
case 1031: // Convert local time values to UTC. -- No longer used??
{
FILETIME ftUTC, ftLocal;
/* Get the file time. */
get_C_pair(taskData, DEREFWORDHANDLE(args),
&ftLocal.dwHighDateTime, &ftLocal.dwLowDateTime);
if (! LocalFileTimeToFileTime(&ftLocal, &ftUTC))
raise_syscall(taskData, "LocalFileTimeToFileTime failed",
-(int)GetLastError());
return Make_arb_from_pair(taskData, ftUTC.dwHighDateTime,
ftUTC.dwLowDateTime);
}
case 1032: // Get volume information.
{
char rootName[MAX_PATH], volName[MAX_PATH], sysName[MAX_PATH];
DWORD dwVolSerial, dwMaxComponentLen, dwFlags;
Handle volHandle, sysHandle, serialHandle, maxCompHandle;
Handle resultHandle;
POLYUNSIGNED length = Poly_string_to_C(DEREFWORD(args), rootName, MAX_PATH);
if (length > MAX_PATH)
raise_syscall(taskData, "Root name too long", ENAMETOOLONG);
if (!GetVolumeInformation(rootName, volName, MAX_PATH,
&dwVolSerial, &dwMaxComponentLen, &dwFlags,
sysName, MAX_PATH))
raise_syscall(taskData, "GetVolumeInformation failed",
-(int)GetLastError());
volHandle = SAVE(C_string_to_Poly(taskData, volName));
sysHandle = SAVE(C_string_to_Poly(taskData, sysName));
serialHandle = Make_unsigned(taskData, dwVolSerial);
maxCompHandle = Make_unsigned(taskData, dwMaxComponentLen);
resultHandle = alloc_and_save(taskData, 4);
DEREFHANDLE(resultHandle)->Set(0, DEREFWORDHANDLE(volHandle));
DEREFHANDLE(resultHandle)->Set(1, DEREFWORDHANDLE(sysHandle));
DEREFHANDLE(resultHandle)->Set(2, DEREFWORDHANDLE(serialHandle));
DEREFHANDLE(resultHandle)->Set(3, DEREFWORDHANDLE(maxCompHandle));
return resultHandle;
}
case 1033:
{
char fileName[MAX_PATH], execName[MAX_PATH];
POLYUNSIGNED length = Poly_string_to_C(DEREFWORD(args), fileName, MAX_PATH);
HINSTANCE hInst;
if (length > MAX_PATH)
raise_syscall(taskData, "File name too long", ENAMETOOLONG);
hInst = FindExecutable(fileName, NULL, execName);
if ((POLYUNSIGNED)hInst <= 32)
{
raise_syscall(taskData, "FindExecutable failed", -(int)(POLYUNSIGNED)hInst);
}
return SAVE(C_string_to_Poly(taskData, execName));
}
case 1034: // Open a document
{
SHELLEXECUTEINFO shellEx;
memset(&shellEx, 0, sizeof(shellEx));
shellEx.cbSize = sizeof(shellEx);
shellEx.lpVerb = _T("open");
shellEx.lpFile = Poly_string_to_T_alloc(DEREFWORD(args));
shellEx.hwnd = hMainWindow;
shellEx.nShow = SW_SHOWNORMAL;
BOOL fRes = ShellExecuteEx(&shellEx);
free((void*)shellEx.lpFile);
if (! fRes)
raise_syscall(taskData, "ShellExecuteEx failed", 0-GetLastError());
return Make_arbitrary_precision(taskData, 0);
}
case 1035: // Launch an application.
{
SHELLEXECUTEINFO shellEx;
memset(&shellEx, 0, sizeof(shellEx));
shellEx.cbSize = sizeof(shellEx);
shellEx.lpVerb = _T("open");
shellEx.lpFile = Poly_string_to_T_alloc(args->WordP()->Get(0));
shellEx.lpParameters = Poly_string_to_T_alloc(args->WordP()->Get(1));
shellEx.nShow = SW_SHOWNORMAL;
BOOL fRes = ShellExecuteEx(&shellEx);
free((void*)shellEx.lpFile);
free((void*)shellEx.lpParameters);
if (! fRes)
raise_syscall(taskData, "ShellExecuteEx failed", 0-GetLastError());
return Make_arbitrary_precision(taskData, 0);
}
case 1036: // Does the process have its own console?
return Make_arbitrary_precision(taskData, hMainWindow != NULL ? 1: 0);
case 1037: // Simple execute.
return simpleExecute(taskData, args);
// DDE
case 1038: // Start DDE dialogue.
{
Handle handToken;
PHANDLETAB pTab;
HCONV hcDDEConv;
char *serviceName = Poly_string_to_C_alloc(args->WordP()->Get(0));
char *topicName = Poly_string_to_C_alloc(args->WordP()->Get(1));
/* Send a request to the main thread to do the work. */
hcDDEConv = StartDDEConversation(serviceName, topicName);
free(serviceName); free(topicName);
if (hcDDEConv == 0) raise_syscall(taskData, "DdeConnect failed", 0);
// Create an entry to return the conversation.
handToken = make_handle_entry(taskData);
pTab = &handleTable[STREAMID(handToken)];
pTab->entryType = HE_DDECONVERSATION;
pTab->entry.hcDDEConv = hcDDEConv;
return handToken;
}
case 1039: // Send DDE execute request.
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_DDECONVERSATION);
LRESULT res;
char *command;
if (hnd == NULL)
{
raise_syscall(taskData, "DDE Conversation is closed", 0);
}
command = Poly_string_to_C_alloc(args->WordP()->Get(1));
/* Send a request to the main thread to do the work. */
res = ExecuteDDE(command, hnd->entry.hcDDEConv);
free(command);
if (res == -1) raise_syscall(taskData, "DdeClientTransaction failed", 0);
else return Make_arbitrary_precision(taskData, res);
}
case 1040: // Close a DDE conversation.
{
PHANDLETAB hnd = get_handle(args->Word(), HE_DDECONVERSATION);
if (hnd != 0) close_handle(hnd);
return Make_arbitrary_precision(taskData, 0);
}
// Configuration functions.
case 1050: // Get version data
{
OSVERSIONINFO osver;
Handle resVal, major, minor, build, platform, version;
osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
if (! GetVersionEx(&osver))
raise_syscall(taskData, "GetVersionEx failed", -(int)GetLastError());
major = Make_unsigned(taskData, osver.dwMajorVersion);
minor = Make_unsigned(taskData, osver.dwMinorVersion);
build = Make_unsigned(taskData, osver.dwBuildNumber);
platform = Make_unsigned(taskData, osver.dwPlatformId);
version = SAVE(C_string_to_Poly(taskData, osver.szCSDVersion));
resVal = alloc_and_save(taskData, 5);
DEREFHANDLE(resVal)->Set(0, DEREFWORDHANDLE(major));
DEREFHANDLE(resVal)->Set(1, DEREFWORDHANDLE(minor));
DEREFHANDLE(resVal)->Set(2, DEREFWORDHANDLE(build));
DEREFHANDLE(resVal)->Set(3, DEREFWORDHANDLE(platform));
DEREFHANDLE(resVal)->Set(4, DEREFWORDHANDLE(version));
return resVal;
}
case 1051: // Get windows directory
{
char path[MAX_PATH+1];
if (GetWindowsDirectory(path, sizeof(path)/sizeof(char)) == 0)
raise_syscall(taskData, "GetWindowsDirectory failed", -(int)GetLastError());
return SAVE(C_string_to_Poly(taskData, path));
}
case 1052: // Get system directory
{
char path[MAX_PATH+1];
if (GetSystemDirectory(path, sizeof(path)/sizeof(char)) == 0)
raise_syscall(taskData, "GetSystemDirectory failed", -(int)GetLastError());
return SAVE(C_string_to_Poly(taskData, path));
}
case 1053: // Get computer name
{
char name[MAX_COMPUTERNAME_LENGTH +1];
DWORD dwSize = MAX_COMPUTERNAME_LENGTH +1;
if (GetComputerName(name, &dwSize) == 0)
raise_syscall(taskData, "GetComputerName failed", -(int)GetLastError());
return SAVE(C_string_to_Poly(taskData, name));
}
case 1054: // Get user name
{
char name[UNLEN +1];
DWORD dwSize = UNLEN +1;
if (GetUserName(name, &dwSize) == 0)
raise_syscall(taskData, "GetUserName failed", -(int)GetLastError());
return SAVE(C_string_to_Poly(taskData, name));
}
case 1100: // Get the error result from the last call.
// This is saved when we make a call to a foreign function.
{
return(SAVE(TAGGED(taskData->lastError)));
}
case 1101: // Wait for a message.
{
while (1)
{
HWND hwnd = (HWND)get_C_long(taskData, DEREFWORDHANDLE(args)->Get(0)); /* Handles are treated as SIGNED. */
UINT wMsgFilterMin = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(1));
UINT wMsgFilterMax = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(2));
MSG msg;
processes->ThreadReleaseMLMemory(taskData);
// N.B. PeekMessage may directly call the window proc resulting in a
// callback to ML. For this to work a callback must not overwrite "args".
BOOL result = PeekMessage(&msg, hwnd, wMsgFilterMin, wMsgFilterMax, PM_NOREMOVE);
processes->ThreadUseMLMemory(taskData);
if (result) return Make_arbitrary_precision(taskData, 0);
// Pause until a message arrives.
processes->ThreadPause(taskData);
}
}
// case 1102: // Return the address of the window callback function.
case 1103: // Return the application instance.
return Make_unsigned(taskData, (POLYUNSIGNED)hApplicationInstance);
case 1104: // Return the main window handle
return Make_unsigned(taskData, (POLYUNSIGNED)hMainWindow);
// case 1105: // Set the callback function
default:
{
char msg[100];
sprintf(msg, "Unknown windows-specific function: %d", c);
raise_exception_string(taskData, EXC_Fail, msg);
return 0;
}
}
}
Handle timing_dispatch_c(TaskData *taskData, Handle args, Handle code)
{
unsigned c = get_C_unsigned(taskData, DEREFWORDHANDLE(code));
switch (c)
{
case 0: /* Get ticks per microsecond. */
return Make_arbitrary_precision(taskData, TICKS_PER_MICROSECOND);
case 1: /* Return time since the time base. */
{
#if (defined(_WIN32) && ! defined(__CYGWIN__))
FILETIME ft;
GetSystemTimeAsFileTime(&ft);
return Make_arb_from_Filetime(taskData, ft);
#else
struct timeval tv;
if (gettimeofday(&tv, NULL) != 0)
raise_syscall(taskData, "gettimeofday failed", errno);
return Make_arb_from_pair_scaled(taskData, tv.tv_sec, tv.tv_usec, 1000000);
#endif
}
case 2: /* Return the base year. This is the year which corresponds to
zero in the timing sequence. */
#if (defined(_WIN32) && ! defined(__CYGWIN__))
return Make_arbitrary_precision(taskData, 1601);
#else
return Make_arbitrary_precision(taskData, 1970);
#endif
case 3: /* In both Windows and Unix the time base is 1st of January
in the base year. This function is provided just in case
we are running on a system with a different base. It
returns the number of seconds after 1st January of the
base year that corresponds to zero of the time base. */
return Make_arbitrary_precision(taskData, 0);
case 4: /* Return the time offset which applied/will apply at the
specified time (in seconds). */
{
int localoff = 0;
time_t theTime;
int day = 0;
#if (defined(HAVE_GMTIME_R) || defined(HAVE_LOCALTIME_R))
struct tm result;
#endif
#if (defined(_WIN32) && ! defined(__CYGWIN__))
/* Although the offset is in seconds it is since 1601. */
FILETIME ftSeconds; // Not really a file-time because it's a number of seconds.
getFileTimeFromArb(taskData, args, &ftSeconds); /* May raise exception. */
ULARGE_INTEGER liTime;
liTime.HighPart = ftSeconds.dwHighDateTime;
liTime.LowPart = ftSeconds.dwLowDateTime;
theTime = (long)(liTime.QuadPart - SECSSINCE1601);
#else
theTime = get_C_long(taskData, DEREFWORDHANDLE(args)); /* May raise exception. */
#endif
{
#ifdef HAVE_GMTIME_R
struct tm *loctime = gmtime_r(&theTime, &result);
#else
PLocker lock(&timeLock);
struct tm *loctime = gmtime(&theTime);
#endif
if (loctime == NULL) raise_exception0(taskData, EXC_size);
localoff = (loctime->tm_hour*60 + loctime->tm_min)*60 + loctime->tm_sec;
day = loctime->tm_yday;
}
{
#ifdef HAVE_LOCALTIME_R
struct tm *loctime = localtime_r(&theTime, &result);
#else
PLocker lock(&timeLock);
struct tm *loctime = localtime(&theTime);
#endif
if (loctime == NULL) raise_exception0(taskData, EXC_size);
localoff -= (loctime->tm_hour*60 + loctime->tm_min)*60 + loctime->tm_sec;
if (loctime->tm_yday != day)
{
// Different day - have to correct it. We can assume that there
// is at most one day to correct.
if (day == loctime->tm_yday+1 || (day == 0 && loctime->tm_yday >= 364))
localoff += 24*60*60;
else localoff -= 24*60*60;
}
}
return Make_arbitrary_precision(taskData, localoff);
}
case 5: /* Find out if Summer Time (daylight saving) was/will be in effect. */
{
time_t theTime;
#if (defined(_WIN32) && ! defined(__CYGWIN__))
FILETIME ftSeconds; // Not really a file-time because it's a number of seconds.
getFileTimeFromArb(taskData, args, &ftSeconds); /* May raise exception. */
ULARGE_INTEGER liTime;
liTime.HighPart = ftSeconds.dwHighDateTime;
liTime.LowPart = ftSeconds.dwLowDateTime;
theTime = (long)(liTime.QuadPart - SECSSINCE1601);
#else
theTime = get_C_long(taskData, DEREFWORDHANDLE(args)); /* May raise exception. */
#endif
int isDst = 0;
#ifdef HAVE_LOCALTIME_R
struct tm result;
struct tm *loctime = localtime_r(&theTime, &result);
isDst = loctime->tm_isdst;
#else
{
PLocker lock(&timeLock);
struct tm *loctime = localtime(&theTime);
if (loctime == NULL) raise_exception0(taskData, EXC_size);
isDst = loctime->tm_isdst;
}
#endif
return Make_arbitrary_precision(taskData, isDst);
}
case 6: /* Call strftime. It would be possible to do much of this in
ML except that it requires the current locale. */
{
struct tm time;
char *format, buff[2048];
Handle resString;
/* Get the format string. */
format = Poly_string_to_C_alloc(DEREFHANDLE(args)->Get(0));
/* Copy the time information. */
time.tm_year = get_C_int(taskData, DEREFHANDLE(args)->Get(1)) - 1900;
time.tm_mon = get_C_int(taskData, DEREFHANDLE(args)->Get(2));
time.tm_mday = get_C_int(taskData, DEREFHANDLE(args)->Get(3));
time.tm_hour = get_C_int(taskData, DEREFHANDLE(args)->Get(4));
time.tm_min = get_C_int(taskData, DEREFHANDLE(args)->Get(5));
time.tm_sec = get_C_int(taskData, DEREFHANDLE(args)->Get(6));
time.tm_wday = get_C_int(taskData, DEREFHANDLE(args)->Get(7));
time.tm_yday = get_C_int(taskData, DEREFHANDLE(args)->Get(8));
time.tm_isdst = get_C_int(taskData, DEREFHANDLE(args)->Get(9));
#if (defined(_WIN32) && ! defined(__CYGWIN__))
_tzset(); /* Make sure we set the current locale. */
#else
setlocale(LC_TIME, "");
#endif
/* It would be better to dynamically allocate the string rather
than use a fixed size but Unix unlike Windows does not distinguish
between an error in the input and the buffer being too small. */
if (strftime(buff, sizeof(buff), format, &time) <= 0)
{
/* Error */
free(format);
raise_exception0(taskData, EXC_size);
}
resString = taskData->saveVec.push(C_string_to_Poly(taskData, buff));
free(format);
return resString;
}
case 7: /* Return User CPU time since the start. */
{
#if (defined(_WIN32) && ! defined(__CYGWIN__))
FILETIME ut, ct, et, kt;
if (! GetProcessTimes(GetCurrentProcess(), &ct, &et, &kt, &ut))
raise_syscall(taskData, "GetProcessTimes failed", 0-GetLastError());
return Make_arb_from_Filetime(taskData, ut);
#else
struct rusage rusage;
if (getrusage(RUSAGE_SELF, &rusage) != 0)
raise_syscall(taskData, "getrusage failed", errno);
return Make_arb_from_pair_scaled(taskData, rusage.ru_utime.tv_sec,
rusage.ru_utime.tv_usec, 1000000);
#endif
}
case 8: /* Return System CPU time since the start. */
{
#if (defined(_WIN32) && ! defined(__CYGWIN__))
FILETIME ct, et, kt, ut;
if (! GetProcessTimes(GetCurrentProcess(), &ct, &et, &kt, &ut))
raise_syscall(taskData, "GetProcessTimes failed", 0-GetLastError());
return Make_arb_from_Filetime(taskData, kt);
#else
struct rusage rusage;
if (getrusage(RUSAGE_SELF, &rusage) != 0)
raise_syscall(taskData, "getrusage failed", errno);
return Make_arb_from_pair_scaled(taskData, rusage.ru_stime.tv_sec,
rusage.ru_stime.tv_usec, 1000000);
#endif
}
case 9: /* Return GC time since the start. */
return gHeapSizeParameters.getGCUtime(taskData);
case 10: /* Return real time since the start. */
{
#if (defined(_WIN32) && ! defined(__CYGWIN__))
FILETIME ft;
GetSystemTimeAsFileTime(&ft);
subFiletimes(&ft, &startTime);
return Make_arb_from_Filetime(taskData, ft);
#else
struct timeval tv;
if (gettimeofday(&tv, NULL) != 0)
raise_syscall(taskData, "gettimeofday failed", errno);
subTimevals(&tv, &startTime);
return Make_arb_from_pair_scaled(taskData, tv.tv_sec, tv.tv_usec, 1000000);
#endif
}
/* These next two are used only in the Posix structure. */
case 11: /* Return User CPU time used by child processes. */
{
#if (defined(_WIN32) && ! defined(__CYGWIN__))
return Make_arbitrary_precision(taskData, 0);
#else
struct rusage rusage;
if (getrusage(RUSAGE_CHILDREN, &rusage) != 0)
raise_syscall(taskData, "getrusage failed", errno);
return Make_arb_from_pair_scaled(taskData, rusage.ru_utime.tv_sec,
rusage.ru_utime.tv_usec, 1000000);
#endif
}
case 12: /* Return System CPU time used by child processes. */
{
#if (defined(_WIN32) && ! defined(__CYGWIN__))
return Make_arbitrary_precision(taskData, 0);
#else
struct rusage rusage;
if (getrusage(RUSAGE_CHILDREN, &rusage) != 0)
raise_syscall(taskData, "getrusage failed", errno);
return Make_arb_from_pair_scaled(taskData, rusage.ru_stime.tv_sec,
rusage.ru_stime.tv_usec, 1000000);
#endif
}
case 13: /* Return GC system time since the start. */
return gHeapSizeParameters.getGCStime(taskData);
default:
{
char msg[100];
sprintf(msg, "Unknown timing function: %d", c);
raise_exception_string(taskData, EXC_Fail, msg);
return 0;
}
}
}
