示例#1
0
文件: reals.cpp 项目: glguida/polyml
static void setrounding(TaskData *mdTaskData, Handle args)
{
    switch (get_C_long(mdTaskData, DEREFWORDHANDLE(args)))
    {
    case POLY_ROUND_TONEAREST: _controlfp(_RC_NEAR, _MCW_RC); break; // Choose nearest
    case POLY_ROUND_DOWNWARD: _controlfp(_RC_DOWN, _MCW_RC); break; // Towards negative infinity
    case POLY_ROUND_UPWARD: _controlfp(_RC_UP, _MCW_RC); break; // Towards positive infinity
    case POLY_ROUND_TOZERO: _controlfp(_RC_CHOP, _MCW_RC); break; // Truncate towards zero
    }
}
示例#2
0
文件: reals.cpp 项目: glguida/polyml
static void setrounding(TaskData *taskData, Handle args)
{
    switch (get_C_long(taskData, DEREFWORDHANDLE(args)))
    {
    case POLY_ROUND_TONEAREST: __asm__("mtfsfi 7,0"); break; /* Choose nearest */
    case POLY_ROUND_DOWNWARD: __asm__("mtfsfi 7,3"); break; /* Towards negative infinity */
    case POLY_ROUND_UPWARD: __asm__("mtfsfi 7,2"); break; /* Towards positive infinity */
    case POLY_ROUND_TOZERO: __asm__("mtfsfi 7,1"); break; /* Truncate towards zero */
    }
}
示例#3
0
文件: reals.cpp 项目: glguida/polyml
static void setrounding(TaskData *taskData, Handle args)
{
    switch (get_C_long(taskData, DEREFWORDHANDLE(args)))
    {
    case POLY_ROUND_TONEAREST: fpsetround(FP_RN); break; /* Choose nearest */
    case POLY_ROUND_DOWNWARD: fpsetround(FP_RM); break; /* Towards negative infinity */
    case POLY_ROUND_UPWARD: fpsetround(FP_RP); break; /* Towards positive infinity */
    case POLY_ROUND_TOZERO: fpsetround(FP_RZ); break; /* Truncate towards zero */
    }
}
示例#4
0
文件: reals.cpp 项目: glguida/polyml
static void setrounding(TaskData *taskData, Handle args)
{
    switch (get_C_long(taskData, DEREFWORDHANDLE(args)))
    {
    case POLY_ROUND_TONEAREST: fesetround(FE_TONEAREST); break; // Choose nearest
    case POLY_ROUND_DOWNWARD: fesetround(FE_DOWNWARD); break; // Towards negative infinity
    case POLY_ROUND_UPWARD: fesetround(FE_UPWARD); break; // Towards positive infinity
    case POLY_ROUND_TOZERO: fesetround(FE_TOWARDZERO); break; // Truncate towards zero
    }
}
示例#5
0
文件: reals.cpp 项目: glguida/polyml
static void setrounding(TaskData *taskData, Handle args)
{
    fpu_control_t ctrl;
    _FPU_GETCW(ctrl);
    ctrl &= ~_FPU_RC_ZERO; /* Mask off any existing rounding. */
    switch (get_C_long(taskData, DEREFWORDHANDLE(args)))
    {
    case POLY_ROUND_TONEAREST: ctrl |= _FPU_RC_NEAREST;
    case POLY_ROUND_DOWNWARD: ctrl |= _FPU_RC_DOWN;
    case POLY_ROUND_UPWARD: ctrl |= _FPU_RC_UP;
    case POLY_ROUND_TOZERO: ctrl |= _FPU_RC_ZERO;
    }
    _FPU_SETCW(ctrl);
}
示例#6
0
Handle OS_spec_dispatch_c(TaskData *taskData, Handle args, Handle code)
{
    unsigned c = get_C_unsigned(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_arbitrary_precision(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_arbitrary_precision(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. */
            getFileTimeFromArb(taskData, DEREFWORDHANDLE(args), &ftUTC);
            if (! FileTimeToLocalFileTime(&ftUTC, &ftLocal))
                raise_syscall(taskData, "FileTimeToLocalFileTime failed",
                        -(int)GetLastError());
            return Make_arb_from_Filetime(taskData, ftLocal);
        }

    case 1031: // Convert local time values to UTC. -- No longer used??
        {
            FILETIME ftUTC, ftLocal;
            /* Get the file time. */
            getFileTimeFromArb(taskData, DEREFWORDHANDLE(args), &ftLocal);
            if (! LocalFileTimeToFileTime(&ftLocal, &ftUTC))
                raise_syscall(taskData, "LocalFileTimeToFileTime failed",
                        -(int)GetLastError());
            return Make_arb_from_Filetime(taskData, ftUTC);
        }

    case 1032: // Get volume information.
        {
            TCHAR 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_arbitrary_precision(taskData, dwVolSerial);
            maxCompHandle = Make_arbitrary_precision(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:
        {
            TCHAR 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;
            TCHAR *serviceName = Poly_string_to_T_alloc(args->WordP()->Get(0));
            TCHAR *topicName = Poly_string_to_T_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;
            ZeroMemory(&osver, sizeof(OSVERSIONINFO));
            osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
            // GetVersionEx is deprecated in Windows 8.1
            if (! GetVersionEx(&osver))
                raise_syscall(taskData, "GetVersionEx failed", -(int)GetLastError());
            Handle major = Make_arbitrary_precision(taskData, osver.dwMajorVersion);
            Handle minor = Make_arbitrary_precision(taskData, osver.dwMinorVersion);
            Handle build = Make_arbitrary_precision(taskData, osver.dwBuildNumber);
            Handle platform = Make_arbitrary_precision(taskData, osver.dwPlatformId);
            Handle version = SAVE(C_string_to_Poly(taskData, osver.szCSDVersion));
            Handle 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
        {
            TCHAR path[MAX_PATH+1];
            if (GetWindowsDirectory(path, sizeof(path)/sizeof(TCHAR)) == 0)
                raise_syscall(taskData, "GetWindowsDirectory failed", -(int)GetLastError());
            return SAVE(C_string_to_Poly(taskData, path));
        }

    case 1052: // Get system directory
        {
            TCHAR path[MAX_PATH+1];
            if (GetSystemDirectory(path, sizeof(path)/sizeof(TCHAR)) == 0)
                raise_syscall(taskData, "GetSystemDirectory failed", -(int)GetLastError());
            return SAVE(C_string_to_Poly(taskData, path));
        }

    case 1053: // Get computer name
        {
            TCHAR 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
        {
            TCHAR 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_arbitrary_precision(taskData, (POLYUNSIGNED)hApplicationInstance);

    case 1104: // Return the main window handle
        return Make_arbitrary_precision(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;
        }
    }
}
示例#7
0
文件: timing.cpp 项目: jrtc27/polyml
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;
        }
    }
}