diff --git a/libpolymain/polystub.c b/libpolymain/polystub.c index a460a876..9920c729 100644 --- a/libpolymain/polystub.c +++ b/libpolymain/polystub.c @@ -1,46 +1,46 @@ /* Title: polystub.c - Copyright (c) 2006, 2015 David C.J. Matthews + Copyright (c) 2006, 2015, 2019 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ // This is the start-up function for Poly/ML. It simply picks up the // pointer to the exported data and calls the main program. #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #include "../polyexports.h" -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) int WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int nCmdShow) { return PolyWinMain(hInstance, hPrevInstance, lpCmdLine, nCmdShow, &poly_exports); } #else int main(int argc, char *argv[]) { return polymain(argc, argv, &poly_exports); } #endif diff --git a/libpolyml/diagnostics.cpp b/libpolyml/diagnostics.cpp index 48044d7d..e10856f2 100644 --- a/libpolyml/diagnostics.cpp +++ b/libpolyml/diagnostics.cpp @@ -1,205 +1,205 @@ /* Title: Diagnostics Copyright (c) 2011, 2015, 2018, 2019 David C.J. Matthews Copyright (c) 2000 Cambridge University Technical Services Limited This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_STDARG_H #include #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_SIGNAL_H #include #endif #ifdef HAVE_WINDOWS_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #include "winstartup.h" #include "winguiconsole.h" #endif -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #include #endif #include "errors.h" #include "noreturn.h" #include "globals.h" #include "diagnostics.h" #include "mpoly.h" extern FILE *polyStdout; unsigned debugOptions = 0; // Debugging options requested on command line. void Exit(const char *msg, ...) { va_list vl; fprintf(polyStdout, "\n"); va_start(vl, msg); vfprintf(polyStdout, msg, vl); va_end(vl); fprintf(polyStdout, "\n"); fflush(polyStdout); -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) if (useConsole) { MessageBox(hMainWindow, _T("Poly/ML has exited"), _T("Poly/ML"), MB_OK); } #endif exit(1); } // Error condition. This should really be replaced either with ASSERTs // or exceptions. void Crash(const char *msg, ...) { va_list vl; fprintf(polyStdout, "\n"); va_start(vl, msg); vfprintf(polyStdout, msg, vl); va_end(vl); fprintf(polyStdout, "\n"); fflush(polyStdout); -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) if (useConsole) { MessageBox(hMainWindow, _T("Poly/ML has exited"), _T("Poly/ML"), MB_OK); } #else { sigset_t set; sigemptyset(&set); sigprocmask(SIG_SETMASK,&set,NULL); } #endif ASSERT(0); // Force a core dump abort(); exit(1); } void ExitWithError(const char *msg, int err) { fputs("\n", polyStdout); fputs(msg, polyStdout); const char *errorMsg = stringFromErrorCode(err); if (errorMsg != NULL) puts(errorMsg); fputs("\n", polyStdout); fflush(polyStdout); -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) if (useConsole) { MessageBox(hMainWindow, _T("Poly/ML has exited"), _T("Poly/ML"), MB_OK); } #endif exit(1); } -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) // Default is to log with OutputDebugString static FILE *logStream = NULL; #else // Default is to log to stdout static FILE *logStream = stdout; #endif void SetLogFile(const TCHAR *fileName) { #if (defined(_WIN32) && defined(UNICODE)) FILE *stream = _wfopen(fileName, L"w"); if (stream == NULL) fprintf(polyStdout, "Unable to open debug file %S\n", fileName); else logStream = stream; #else FILE *stream = fopen(fileName, "w"); if (stream == NULL) fprintf(polyStdout, "Unable to open debug file %s\n", fileName); else logStream = stream; #endif } // For the moment log to stdout void Log(const char *msg, ...) { va_list vl; va_start(vl, msg); if (logStream) vfprintf(logStream, msg, vl); -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) char buff[1024]; if (_vsnprintf(buff, sizeof(buff), msg, vl) > 0) ::OutputDebugStringA(buff); #endif va_end(vl); if (logStream) fflush(logStream); } // Log the size of a space as a comprehensible number void LogSize(uintptr_t wordSize) { uintptr_t size = wordSize * sizeof(PolyWord); if (size < 10*1024) Log("%zu", size); else { double s = (double)size; if (s < 1024000.0) Log("%1.2fK", s / 1024.0); else if (s < 1000.0 * 1024.0 * 1024.0) Log("%1.2fM", s / (1024.0 * 1024.0)); else Log("%1.2fG", s / (1024.0 * 1024.0 * 1024.0)); } } diff --git a/libpolyml/errors.cpp b/libpolyml/errors.cpp index 6301ab96..0ef8d7a1 100644 --- a/libpolyml/errors.cpp +++ b/libpolyml/errors.cpp @@ -1,1334 +1,1334 @@ /* Title: Error Messages. - Copyright (c) 2012, 2017 David C. J. Matthews + Copyright (c) 2012, 2017, 2019 David C. J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #include #endif #ifdef HAVE_WINDOWS_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_STRING_H #include #endif #include "errors.h" static struct { int errorNum; const char* errorString; } errortable[] = { -#if(!defined(_WIN32) || defined(__CYGWIN__)) +#if (!defined(_WIN32)) #ifdef EPERM { EPERM, "EPERM" }, #endif #ifdef ENOENT { ENOENT, "ENOENT" }, #endif #ifdef ESRCH { ESRCH, "ESRCH" }, #endif #ifdef EINTR { EINTR, "EINTR"}, #endif #ifdef EIO { EIO, "EIO"}, #endif #ifdef ENXIO { ENXIO, "ENXIO"}, #endif #ifdef E2BIG { E2BIG, "E2BIG"}, #endif #ifdef ENOEXEC { ENOEXEC, "ENOEXEC"}, #endif #ifdef EBADF { EBADF, "EBADF"}, #endif #ifdef ECHILD { ECHILD, "ECHILD"}, #endif #ifdef EAGAIN { EAGAIN, "EAGAIN"}, #endif #ifdef EDEADLK { EDEADLK, "EDEADLK"}, #endif #ifdef ENOMEM { ENOMEM, "ENOMEM"}, #endif #ifdef EACCES { EACCES, "EACCES"}, #endif #ifdef EFAULT { EFAULT, "EFAULT"}, #endif #ifdef ENOTBLK { ENOTBLK, "ENOTBLK"}, #endif #ifdef EBUSY { EBUSY, "EBUSY"}, #endif #ifdef EEXIST { EEXIST, "EEXIST"}, #endif #ifdef EXDEV { EXDEV, "EXDEV"}, #endif #ifdef ENODEV { ENODEV, "ENODEV"}, #endif #ifdef ENOTDIR { ENOTDIR, "ENOTDIR"}, #endif #ifdef EISDIR { EISDIR, "EISDIR"}, #endif #ifdef EINVAL { EINVAL, "EINVAL"}, #endif #ifdef ENFILE { ENFILE, "ENFILE"}, #endif #ifdef EMFILE { EMFILE, "EMFILE"}, #endif #ifdef ENOTTY { ENOTTY, "ENOTTY"}, #endif #ifdef ETXTBSY { ETXTBSY, "ETXTBSY"}, #endif #ifdef EFBIG { EFBIG, "EFBIG"}, #endif #ifdef ENOSPC { ENOSPC, "ENOSPC"}, #endif #ifdef ESPIPE { ESPIPE, "ESPIPE"}, #endif #ifdef EROFS { EROFS, "EROFS"}, #endif #ifdef EMLINK { EMLINK, "EMLINK"}, #endif #ifdef EPIPE { EPIPE, "EPIPE"}, #endif #ifdef EDOM { EDOM, "EDOM"}, #endif #ifdef ERANGE { ERANGE, "ERANGE"}, #endif #ifdef ENOMSG { ENOMSG, "ENOMSG"}, #endif #ifdef EUCLEAN { EUCLEAN, "EUCLEAN"}, #endif #ifdef EWOULDBLOCK { EWOULDBLOCK, "EWOULDBLOCK"}, #endif #ifdef EIDRM { EIDRM, "EIDRM"}, #endif #ifdef EINPROGRESS { EINPROGRESS, "EINPROGRESS"}, #endif #ifdef ECHRNG { ECHRNG, "ECHRNG"}, #endif #ifdef EALREADY { EALREADY, "EALREADY"}, #endif #ifdef EL2NSYNC { EL2NSYNC, "EL2NSYNC"}, #endif #ifdef ENAMETOOLONG { ENAMETOOLONG, "ENAMETOOLONG"}, #endif #ifdef ENOTSOCK { ENOTSOCK, "ENOTSOCK"}, #endif #ifdef EL3HLT { EL3HLT, "EL3HLT"}, #endif #ifdef ENOLCK { ENOLCK, "ENOLCK"}, #endif #ifdef EDESTADDRREQ { EDESTADDRREQ, "EDESTADDRREQ"}, #endif #ifdef EL3RST { EL3RST, "EL3RST"}, #endif #ifdef ENOSYS { ENOSYS, "ENOSYS"}, #endif #ifdef EMSGSIZE { EMSGSIZE, "EMSGSIZE"}, #endif #ifdef ELNRNG { ELNRNG, "ELNRNG"}, #endif #ifdef ENOTEMPTY { ENOTEMPTY, "ENOTEMPTY"}, #endif #ifdef EPROTOTYPE { EPROTOTYPE, "EPROTOTYPE"}, #endif #ifdef EUNATCH { EUNATCH, "EUNATCH"}, #endif #ifdef EILSEQ { EILSEQ, "EILSEQ"}, #endif #ifdef ENOPROTOOPT { ENOPROTOOPT, "ENOPROTOOPT"}, #endif #ifdef ENOCSI { ENOCSI, "ENOCSI"}, #endif #ifdef EPROTONOSUPPORT { EPROTONOSUPPORT, "EPROTONOSUPPORT"}, #endif #ifdef EL2HLT { EL2HLT, "EL2HLT"}, #endif #ifdef ESOCKTNOSUPPORT { ESOCKTNOSUPPORT, "ESOCKTNOSUPPORT"}, #endif #ifdef EOPNOTSUPP { EOPNOTSUPP, "EOPNOTSUPP"}, #endif #ifdef ENOTREADY { ENOTREADY, "ENOTREADY"}, #endif #ifdef EPFNOSUPPORT { EPFNOSUPPORT, "EPFNOSUPPORT"}, #endif #ifdef EWRPROTECT { EWRPROTECT, "EWRPROTECT"}, #endif #ifdef EAFNOSUPPORT { EAFNOSUPPORT, "EAFNOSUPPORT"}, #endif #ifdef EFORMAT { EFORMAT, "EFORMAT"}, #endif #ifdef EADDRINUSE { EADDRINUSE, "EADDRINUSE"}, #endif #ifdef EADDRNOTAVAIL { EADDRNOTAVAIL, "EADDRNOTAVAIL"}, #endif #ifdef ENOCONNECT { ENOCONNECT, "ENOCONNECT"}, #endif #ifdef ENETDOWN { ENETDOWN, "ENETDOWN"}, #endif #ifdef ESTALE { ESTALE, "ESTALE"}, #endif #ifdef ENETUNREACH { ENETUNREACH, "ENETUNREACH"}, #endif #ifdef EDIST { EDIST, "EDIST"}, #endif #ifdef ENETRESET { ENETRESET, "ENETRESET"}, #endif #ifdef ECONNABORTED { ECONNABORTED, "ECONNABORTED"}, #endif #ifdef ECONNRESET { ECONNRESET, "ECONNRESET"}, #endif #ifdef ENOBUFS { ENOBUFS, "ENOBUFS"}, #endif #ifdef EISCONN { EISCONN, "EISCONN"}, #endif #ifdef ENOTCONN { ENOTCONN, "ENOTCONN"}, #endif #ifdef ESHUTDOWN { ESHUTDOWN, "ESHUTDOWN"}, #endif #ifdef ETOOMANYREFS { ETOOMANYREFS, "ETOOMANYREFS"}, #endif #ifdef ETIMEDOUT { ETIMEDOUT, "ETIMEDOUT"}, #endif #ifdef ECONNREFUSED { ECONNREFUSED, "ECONNREFUSED"}, #endif #ifdef ELOOP { ELOOP, "ELOOP"}, #endif #ifdef EHOSTDOWN { EHOSTDOWN, "EHOSTDOWN"}, #endif #ifdef EHOSTUNREACH { EHOSTUNREACH, "EHOSTUNREACH"}, #endif #ifdef EPROCLIM { EPROCLIM, "EPROCLIM"}, #endif #ifdef EUSERS { EUSERS, "EUSERS"}, #endif #ifdef EDQUOT { EDQUOT, "EDQUOT"}, #endif #ifdef EREMOTE { EREMOTE, "EREMOTE"}, #endif #ifdef ENOSTR { ENOSTR, "ENOSTR"}, #endif #ifdef EBADRPC { EBADRPC, "EBADRPC"}, #endif #ifdef ETIME { ETIME, "ETIME"}, #endif #ifdef ERPCMISMATCH { ERPCMISMATCH, "ERPCMISMATCH"}, #endif #ifdef ENOSR { ENOSR, "ENOSR"}, #endif #ifdef EPROGUNAVAIL { EPROGUNAVAIL, "EPROGUNAVAIL"}, #endif #ifdef EPROGMISMATCH { EPROGMISMATCH, "EPROGMISMATCH"}, #endif #ifdef EBADMSG { EBADMSG, "EBADMSG"}, #endif #ifdef EPROCUNAVAIL { EPROCUNAVAIL, "EPROCUNAVAIL"}, #endif #ifdef EFTYPE { EFTYPE, "EFTYPE"}, #endif #ifdef ENONET { ENONET, "ENONET"}, #endif #ifdef EAUTH { EAUTH, "EAUTH"}, #endif #ifdef ERESTART { ERESTART, "ERESTART"}, #endif #ifdef ERREMOTE { ERREMOTE, "ERREMOTE"}, #endif #ifdef ENEEDAUTH { ENEEDAUTH, "ENEEDAUTH"}, #endif #ifdef ENOLINK { ENOLINK, "ENOLINK"}, #endif #ifdef EADV { EADV, "EADV"}, #endif #ifdef ESRMNT { ESRMNT, "ESRMNT"}, #endif #ifdef ECOMM { ECOMM, "ECOMM"}, #endif #ifdef EPROTO { EPROTO, "EPROTO"}, #endif #ifdef EMULTIHOP { EMULTIHOP, "EMULTIHOP"}, #endif #ifdef EDOTDOT { EDOTDOT, "EDOTDOT"}, #endif #ifdef EREMCHG { EREMCHG, "EREMCHG"}, #endif #ifdef EMEDIA { EMEDIA, "EMEDIA"}, #endif #ifdef ESOFT { ESOFT, "ESOFT"}, #endif #ifdef ENOATTR { ENOATTR, "ENOATTR"}, #endif #ifdef ESAD { ESAD, "ESAD"}, #endif #ifdef ENOTRUST { ENOTRUST, "ENOTRUST"}, #endif #ifdef ECANCELED { ECANCELED, "ECANCELED"}, #endif #ifdef ENODATA { ENODATA, "ENODATA"}, #endif #ifdef EBADE { EBADE, "EBADE"}, #endif #ifdef EBADR { EBADR, "EBADR"}, #endif #ifdef EXFULL { EXFULL, "EXFULL"}, #endif #ifdef ENOANO { ENOANO, "ENOANO"}, #endif #ifdef EBADRQC { EBADRQC, "EBADRQC"}, #endif #ifdef EBADSLT { EBADSLT, "EBADSLT"}, #endif #ifdef EDEADLOCK { EDEADLOCK, "EDEADLOCK"}, #endif #ifdef EBFONT { EBFONT, "EBFONT"}, #endif #ifdef EBFONT { EBFONT, "EBFONT"}, #endif #ifdef ENOPKG { ENOPKG, "ENOPKG"}, #endif #ifdef ELBIN { ELBIN, "ELBIN"}, #endif #ifdef ENOTUNIQ { ENOTUNIQ, "ENOTUNIQ"}, #endif #ifdef EBADFD { EBADFD, "EBADFD"}, #endif #ifdef ELIBACC { ELIBACC, "ELIBACC"}, #endif #ifdef ELIBBAD { ELIBBAD, "ELIBBAD"}, #endif #ifdef ELIBSCN { ELIBSCN, "ELIBSCN"}, #endif #ifdef ELIBMAX { ELIBMAX, "ELIBMAX"}, #endif #ifdef ESTRPIPE { ESTRPIPE, "ESTRPIPE"}, #endif #ifdef ELIBEXEC { ELIBEXEC, "ELIBEXEC"}, #endif #ifdef ENMFILE { ENMFILE, "ENMFILE"}, #endif #ifdef ENOTNAM { ENOTNAM, "ENOTNAM"}, #endif #ifdef ENAVAIL { ENAVAIL, "ENAVAIL"}, #endif #ifdef EISNAM { EISNAM, "EISNAM"}, #endif #ifdef EREMOTEIO { EREMOTEIO, "EREMOTEIO"}, #endif #ifdef ENOMEDIUM { ENOMEDIUM, "ENOMEDIUM"}, #endif #ifdef EMEDIUMTYPE { EMEDIUMTYPE, "EMEDIUMTYPE"}, #endif #ifdef ENOKEY { ENOKEY, "ENOKEY"}, #endif #ifdef EKEYEXPIRED { EKEYEXPIRED, "EKEYEXPIRED"}, #endif #ifdef EKEYREVOKED { EKEYREVOKED, "EKEYREVOKED"}, #endif #ifdef EKEYREJECTED { EKEYREJECTED, "EKEYREJECTED"}, #endif #ifdef EOWNERDEAD { EOWNERDEAD, "EOWNERDEAD"}, #endif #ifdef ENOTRECOVERABLE { ENOTRECOVERABLE, "ENOTRECOVERABLE"}, #endif #ifdef ENOTSUP { ENOTSUP, "ENOTSUP"}, #endif #ifdef ENOMEDIUM { ENOMEDIUM, "ENOMEDIUM"}, #endif #ifdef ENOSHARE { ENOSHARE, "ENOSHARE"}, #endif #ifdef ECASECLASH { ECASECLASH, "ECASECLASH"}, #endif #ifdef EOVERFLOW { EOVERFLOW, "EOVERFLOW"}, #endif #else { ERROR_INVALID_FUNCTION, "ERROR_INVALID_FUNCTION" }, { ERROR_FILE_NOT_FOUND, "ERROR_FILE_NOT_FOUND" }, { ERROR_PATH_NOT_FOUND, "ERROR_PATH_NOT_FOUND" }, { ERROR_TOO_MANY_OPEN_FILES, "ERROR_TOO_MANY_OPEN_FILES" }, { ERROR_ACCESS_DENIED, "ERROR_ACCESS_DENIED" }, { ERROR_INVALID_HANDLE, "ERROR_INVALID_HANDLE" }, { ERROR_ARENA_TRASHED, "ERROR_ARENA_TRASHED" }, { ERROR_NOT_ENOUGH_MEMORY, "ERROR_NOT_ENOUGH_MEMORY" }, { ERROR_INVALID_BLOCK, "ERROR_INVALID_BLOCK" }, { ERROR_BAD_ENVIRONMENT, "ERROR_BAD_ENVIRONMENT" }, { ERROR_BAD_FORMAT, "ERROR_BAD_FORMAT" }, { ERROR_INVALID_ACCESS, "ERROR_INVALID_ACCESS" }, { ERROR_INVALID_DATA, "ERROR_INVALID_DATA" }, { ERROR_OUTOFMEMORY, "ERROR_OUTOFMEMORY" }, { ERROR_INVALID_DRIVE, "ERROR_INVALID_DRIVE" }, { ERROR_CURRENT_DIRECTORY, "ERROR_CURRENT_DIRECTORY" }, { ERROR_NOT_SAME_DEVICE, "ERROR_NOT_SAME_DEVICE" }, { ERROR_NO_MORE_FILES, "ERROR_NO_MORE_FILES" }, { ERROR_WRITE_PROTECT, "ERROR_WRITE_PROTECT" }, { ERROR_BAD_UNIT, "ERROR_BAD_UNIT" }, { ERROR_NOT_READY, "ERROR_NOT_READY" }, { ERROR_BAD_COMMAND, "ERROR_BAD_COMMAND" }, { ERROR_CRC, "ERROR_CRC" }, { ERROR_BAD_LENGTH, "ERROR_BAD_LENGTH" }, { ERROR_SEEK, "ERROR_SEEK" }, { ERROR_NOT_DOS_DISK, "ERROR_NOT_DOS_DISK" }, { ERROR_SECTOR_NOT_FOUND, "ERROR_SECTOR_NOT_FOUND" }, { ERROR_OUT_OF_PAPER, "ERROR_OUT_OF_PAPER" }, { ERROR_WRITE_FAULT, "ERROR_WRITE_FAULT" }, { ERROR_READ_FAULT, "ERROR_READ_FAULT" }, { ERROR_GEN_FAILURE, "ERROR_GEN_FAILURE" }, { ERROR_SHARING_VIOLATION, "ERROR_SHARING_VIOLATION" }, { ERROR_LOCK_VIOLATION, "ERROR_LOCK_VIOLATION" }, { ERROR_WRONG_DISK, "ERROR_WRONG_DISK" }, { ERROR_SHARING_BUFFER_EXCEEDED, "ERROR_SHARING_BUFFER_EXCEEDED" }, { ERROR_HANDLE_EOF, "ERROR_HANDLE_EOF" }, { ERROR_HANDLE_DISK_FULL, "ERROR_HANDLE_DISK_FULL" }, { ERROR_NOT_SUPPORTED, "ERROR_NOT_SUPPORTED" }, { ERROR_REM_NOT_LIST, "ERROR_REM_NOT_LIST" }, { ERROR_DUP_NAME, "ERROR_DUP_NAME" }, { ERROR_BAD_NETPATH, "ERROR_BAD_NETPATH" }, { ERROR_NETWORK_BUSY, "ERROR_NETWORK_BUSY" }, { ERROR_DEV_NOT_EXIST, "ERROR_DEV_NOT_EXIST" }, { ERROR_TOO_MANY_CMDS, "ERROR_TOO_MANY_CMDS" }, { ERROR_ADAP_HDW_ERR, "ERROR_ADAP_HDW_ERR" }, { ERROR_BAD_NET_RESP, "ERROR_BAD_NET_RESP" }, { ERROR_UNEXP_NET_ERR, "ERROR_UNEXP_NET_ERR" }, { ERROR_BAD_REM_ADAP, "ERROR_BAD_REM_ADAP" }, { ERROR_PRINTQ_FULL, "ERROR_PRINTQ_FULL" }, { ERROR_NO_SPOOL_SPACE, "ERROR_NO_SPOOL_SPACE" }, { ERROR_PRINT_CANCELLED, "ERROR_PRINT_CANCELLED" }, { ERROR_NETNAME_DELETED, "ERROR_NETNAME_DELETED" }, { ERROR_NETWORK_ACCESS_DENIED, "ERROR_NETWORK_ACCESS_DENIED" }, { ERROR_BAD_DEV_TYPE, "ERROR_BAD_DEV_TYPE" }, { ERROR_BAD_NET_NAME, "ERROR_BAD_NET_NAME" }, { ERROR_TOO_MANY_NAMES, "ERROR_TOO_MANY_NAMES" }, { ERROR_TOO_MANY_SESS, "ERROR_TOO_MANY_SESS" }, { ERROR_SHARING_PAUSED, "ERROR_SHARING_PAUSED" }, { ERROR_REQ_NOT_ACCEP, "ERROR_REQ_NOT_ACCEP" }, { ERROR_REDIR_PAUSED, "ERROR_REDIR_PAUSED" }, { ERROR_FILE_EXISTS, "ERROR_FILE_EXISTS" }, { ERROR_CANNOT_MAKE, "ERROR_CANNOT_MAKE" }, { ERROR_FAIL_I24, "ERROR_FAIL_I24" }, { ERROR_OUT_OF_STRUCTURES, "ERROR_OUT_OF_STRUCTURES" }, { ERROR_ALREADY_ASSIGNED, "ERROR_ALREADY_ASSIGNED" }, { ERROR_INVALID_PASSWORD, "ERROR_INVALID_PASSWORD" }, { ERROR_INVALID_PARAMETER, "ERROR_INVALID_PARAMETER" }, { ERROR_NET_WRITE_FAULT, "ERROR_NET_WRITE_FAULT" }, { ERROR_NO_PROC_SLOTS, "ERROR_NO_PROC_SLOTS" }, { ERROR_TOO_MANY_SEMAPHORES, "ERROR_TOO_MANY_SEMAPHORES" }, { ERROR_EXCL_SEM_ALREADY_OWNED, "ERROR_EXCL_SEM_ALREADY_OWNED" }, { ERROR_SEM_IS_SET, "ERROR_SEM_IS_SET" }, { ERROR_TOO_MANY_SEM_REQUESTS, "ERROR_TOO_MANY_SEM_REQUESTS" }, { ERROR_INVALID_AT_INTERRUPT_TIME, "ERROR_INVALID_AT_INTERRUPT_TIME" }, { ERROR_SEM_OWNER_DIED, "ERROR_SEM_OWNER_DIED" }, { ERROR_SEM_USER_LIMIT, "ERROR_SEM_USER_LIMIT" }, { ERROR_DISK_CHANGE, "ERROR_DISK_CHANGE" }, { ERROR_DRIVE_LOCKED, "ERROR_DRIVE_LOCKED" }, { ERROR_BROKEN_PIPE, "ERROR_BROKEN_PIPE" }, { ERROR_OPEN_FAILED, "ERROR_OPEN_FAILED" }, { ERROR_BUFFER_OVERFLOW, "ERROR_BUFFER_OVERFLOW" }, { ERROR_DISK_FULL, "ERROR_DISK_FULL" }, { ERROR_NO_MORE_SEARCH_HANDLES, "ERROR_NO_MORE_SEARCH_HANDLES" }, { ERROR_INVALID_TARGET_HANDLE, "ERROR_INVALID_TARGET_HANDLE" }, { ERROR_INVALID_CATEGORY, "ERROR_INVALID_CATEGORY" }, { ERROR_INVALID_VERIFY_SWITCH, "ERROR_INVALID_VERIFY_SWITCH" }, { ERROR_BAD_DRIVER_LEVEL, "ERROR_BAD_DRIVER_LEVEL" }, { ERROR_CALL_NOT_IMPLEMENTED, "ERROR_CALL_NOT_IMPLEMENTED" }, { ERROR_SEM_TIMEOUT, "ERROR_SEM_TIMEOUT" }, { ERROR_INSUFFICIENT_BUFFER, "ERROR_INSUFFICIENT_BUFFER" }, { ERROR_INVALID_NAME, "ERROR_INVALID_NAME" }, { ERROR_INVALID_LEVEL, "ERROR_INVALID_LEVEL" }, { ERROR_NO_VOLUME_LABEL, "ERROR_NO_VOLUME_LABEL" }, { ERROR_MOD_NOT_FOUND, "ERROR_MOD_NOT_FOUND" }, { ERROR_PROC_NOT_FOUND, "ERROR_PROC_NOT_FOUND" }, { ERROR_WAIT_NO_CHILDREN, "ERROR_WAIT_NO_CHILDREN" }, { ERROR_CHILD_NOT_COMPLETE, "ERROR_CHILD_NOT_COMPLETE" }, { ERROR_DIRECT_ACCESS_HANDLE, "ERROR_DIRECT_ACCESS_HANDLE" }, { ERROR_NEGATIVE_SEEK, "ERROR_NEGATIVE_SEEK" }, { ERROR_SEEK_ON_DEVICE, "ERROR_SEEK_ON_DEVICE" }, { ERROR_IS_JOIN_TARGET, "ERROR_IS_JOIN_TARGET" }, { ERROR_IS_JOINED, "ERROR_IS_JOINED" }, { ERROR_IS_SUBSTED, "ERROR_IS_SUBSTED" }, { ERROR_NOT_JOINED, "ERROR_NOT_JOINED" }, { ERROR_NOT_SUBSTED, "ERROR_NOT_SUBSTED" }, { ERROR_JOIN_TO_JOIN, "ERROR_JOIN_TO_JOIN" }, { ERROR_SUBST_TO_SUBST, "ERROR_SUBST_TO_SUBST" }, { ERROR_JOIN_TO_SUBST, "ERROR_JOIN_TO_SUBST" }, { ERROR_SUBST_TO_JOIN, "ERROR_SUBST_TO_JOIN" }, { ERROR_BUSY_DRIVE, "ERROR_BUSY_DRIVE" }, { ERROR_SAME_DRIVE, "ERROR_SAME_DRIVE" }, { ERROR_DIR_NOT_ROOT, "ERROR_DIR_NOT_ROOT" }, { ERROR_DIR_NOT_EMPTY, "ERROR_DIR_NOT_EMPTY" }, { ERROR_IS_SUBST_PATH, "ERROR_IS_SUBST_PATH" }, { ERROR_IS_JOIN_PATH, "ERROR_IS_JOIN_PATH" }, { ERROR_PATH_BUSY, "ERROR_PATH_BUSY" }, { ERROR_IS_SUBST_TARGET, "ERROR_IS_SUBST_TARGET" }, { ERROR_SYSTEM_TRACE, "ERROR_SYSTEM_TRACE" }, { ERROR_INVALID_EVENT_COUNT, "ERROR_INVALID_EVENT_COUNT" }, { ERROR_TOO_MANY_MUXWAITERS, "ERROR_TOO_MANY_MUXWAITERS" }, { ERROR_INVALID_LIST_FORMAT, "ERROR_INVALID_LIST_FORMAT" }, { ERROR_LABEL_TOO_LONG, "ERROR_LABEL_TOO_LONG" }, { ERROR_TOO_MANY_TCBS, "ERROR_TOO_MANY_TCBS" }, { ERROR_SIGNAL_REFUSED, "ERROR_SIGNAL_REFUSED" }, { ERROR_DISCARDED, "ERROR_DISCARDED" }, { ERROR_NOT_LOCKED, "ERROR_NOT_LOCKED" }, { ERROR_BAD_THREADID_ADDR, "ERROR_BAD_THREADID_ADDR" }, { ERROR_BAD_ARGUMENTS, "ERROR_BAD_ARGUMENTS" }, { ERROR_BAD_PATHNAME, "ERROR_BAD_PATHNAME" }, { ERROR_SIGNAL_PENDING, "ERROR_SIGNAL_PENDING" }, { ERROR_MAX_THRDS_REACHED, "ERROR_MAX_THRDS_REACHED" }, { ERROR_LOCK_FAILED, "ERROR_LOCK_FAILED" }, { ERROR_BUSY, "ERROR_BUSY" }, { ERROR_CANCEL_VIOLATION, "ERROR_CANCEL_VIOLATION" }, { ERROR_ATOMIC_LOCKS_NOT_SUPPORTED, "ERROR_ATOMIC_LOCKS_NOT_SUPPORTED" }, { ERROR_INVALID_SEGMENT_NUMBER, "ERROR_INVALID_SEGMENT_NUMBER" }, { ERROR_INVALID_ORDINAL, "ERROR_INVALID_ORDINAL" }, { ERROR_ALREADY_EXISTS, "ERROR_ALREADY_EXISTS" }, { ERROR_INVALID_FLAG_NUMBER, "ERROR_INVALID_FLAG_NUMBER" }, { ERROR_SEM_NOT_FOUND, "ERROR_SEM_NOT_FOUND" }, { ERROR_INVALID_STARTING_CODESEG, "ERROR_INVALID_STARTING_CODESEG" }, { ERROR_INVALID_STACKSEG, "ERROR_INVALID_STACKSEG" }, { ERROR_INVALID_MODULETYPE, "ERROR_INVALID_MODULETYPE" }, { ERROR_INVALID_EXE_SIGNATURE, "ERROR_INVALID_EXE_SIGNATURE" }, { ERROR_EXE_MARKED_INVALID, "ERROR_EXE_MARKED_INVALID" }, { ERROR_BAD_EXE_FORMAT, "ERROR_BAD_EXE_FORMAT" }, { ERROR_ITERATED_DATA_EXCEEDS_64k, "ERROR_ITERATED_DATA_EXCEEDS_64k" }, { ERROR_INVALID_MINALLOCSIZE, "ERROR_INVALID_MINALLOCSIZE" }, { ERROR_DYNLINK_FROM_INVALID_RING, "ERROR_DYNLINK_FROM_INVALID_RING" }, { ERROR_IOPL_NOT_ENABLED, "ERROR_IOPL_NOT_ENABLED" }, { ERROR_INVALID_SEGDPL, "ERROR_INVALID_SEGDPL" }, { ERROR_AUTODATASEG_EXCEEDS_64k, "ERROR_AUTODATASEG_EXCEEDS_64k" }, { ERROR_RING2SEG_MUST_BE_MOVABLE, "ERROR_RING2SEG_MUST_BE_MOVABLE" }, { ERROR_RELOC_CHAIN_XEEDS_SEGLIM, "ERROR_RELOC_CHAIN_XEEDS_SEGLIM" }, { ERROR_INFLOOP_IN_RELOC_CHAIN, "ERROR_INFLOOP_IN_RELOC_CHAIN" }, { ERROR_ENVVAR_NOT_FOUND, "ERROR_ENVVAR_NOT_FOUND" }, { ERROR_NO_SIGNAL_SENT, "ERROR_NO_SIGNAL_SENT" }, { ERROR_FILENAME_EXCED_RANGE, "ERROR_FILENAME_EXCED_RANGE" }, { ERROR_RING2_STACK_IN_USE, "ERROR_RING2_STACK_IN_USE" }, { ERROR_META_EXPANSION_TOO_LONG, "ERROR_META_EXPANSION_TOO_LONG" }, { ERROR_INVALID_SIGNAL_NUMBER, "ERROR_INVALID_SIGNAL_NUMBER" }, { ERROR_THREAD_1_INACTIVE, "ERROR_THREAD_1_INACTIVE" }, { ERROR_LOCKED, "ERROR_LOCKED" }, { ERROR_TOO_MANY_MODULES, "ERROR_TOO_MANY_MODULES" }, { ERROR_NESTING_NOT_ALLOWED, "ERROR_NESTING_NOT_ALLOWED" }, #ifdef ERROR_EXE_MACHINE_TYPE_MISMATCH { ERROR_EXE_MACHINE_TYPE_MISMATCH, "ERROR_EXE_MACHINE_TYPE_MISMATCH" }, #endif { ERROR_BAD_PIPE, "ERROR_BAD_PIPE" }, { ERROR_PIPE_BUSY, "ERROR_PIPE_BUSY" }, { ERROR_NO_DATA, "ERROR_NO_DATA" }, { ERROR_PIPE_NOT_CONNECTED, "ERROR_PIPE_NOT_CONNECTED" }, { ERROR_MORE_DATA, "ERROR_MORE_DATA" }, { ERROR_VC_DISCONNECTED, "ERROR_VC_DISCONNECTED" }, { ERROR_INVALID_EA_NAME, "ERROR_INVALID_EA_NAME" }, { ERROR_EA_LIST_INCONSISTENT, "ERROR_EA_LIST_INCONSISTENT" }, { ERROR_NO_MORE_ITEMS, "ERROR_NO_MORE_ITEMS" }, { ERROR_CANNOT_COPY, "ERROR_CANNOT_COPY" }, { ERROR_DIRECTORY, "ERROR_DIRECTORY" }, { ERROR_EAS_DIDNT_FIT, "ERROR_EAS_DIDNT_FIT" }, { ERROR_EA_FILE_CORRUPT, "ERROR_EA_FILE_CORRUPT" }, { ERROR_EA_TABLE_FULL, "ERROR_EA_TABLE_FULL" }, { ERROR_INVALID_EA_HANDLE, "ERROR_INVALID_EA_HANDLE" }, { ERROR_EAS_NOT_SUPPORTED, "ERROR_EAS_NOT_SUPPORTED" }, { ERROR_NOT_OWNER, "ERROR_NOT_OWNER" }, { ERROR_TOO_MANY_POSTS, "ERROR_TOO_MANY_POSTS" }, { ERROR_PARTIAL_COPY, "ERROR_PARTIAL_COPY" }, { ERROR_MR_MID_NOT_FOUND, "ERROR_MR_MID_NOT_FOUND" }, { ERROR_INVALID_ADDRESS, "ERROR_INVALID_ADDRESS" }, { ERROR_ARITHMETIC_OVERFLOW, "ERROR_ARITHMETIC_OVERFLOW" }, { ERROR_PIPE_CONNECTED, "ERROR_PIPE_CONNECTED" }, { ERROR_PIPE_LISTENING, "ERROR_PIPE_LISTENING" }, { ERROR_EA_ACCESS_DENIED, "ERROR_EA_ACCESS_DENIED" }, { ERROR_OPERATION_ABORTED, "ERROR_OPERATION_ABORTED" }, { ERROR_IO_INCOMPLETE, "ERROR_IO_INCOMPLETE" }, { ERROR_IO_PENDING, "ERROR_IO_PENDING" }, { ERROR_NOACCESS, "ERROR_NOACCESS" }, { ERROR_SWAPERROR, "ERROR_SWAPERROR" }, { ERROR_STACK_OVERFLOW, "ERROR_STACK_OVERFLOW" }, { ERROR_INVALID_MESSAGE, "ERROR_INVALID_MESSAGE" }, { ERROR_CAN_NOT_COMPLETE, "ERROR_CAN_NOT_COMPLETE" }, { ERROR_INVALID_FLAGS, "ERROR_INVALID_FLAGS" }, { ERROR_UNRECOGNIZED_VOLUME, "ERROR_UNRECOGNIZED_VOLUME" }, { ERROR_FILE_INVALID, "ERROR_FILE_INVALID" }, { ERROR_FULLSCREEN_MODE, "ERROR_FULLSCREEN_MODE" }, { ERROR_NO_TOKEN, "ERROR_NO_TOKEN" }, { ERROR_BADDB, "ERROR_BADDB" }, { ERROR_BADKEY, "ERROR_BADKEY" }, { ERROR_CANTOPEN, "ERROR_CANTOPEN" }, { ERROR_CANTREAD, "ERROR_CANTREAD" }, { ERROR_CANTWRITE, "ERROR_CANTWRITE" }, { ERROR_REGISTRY_RECOVERED, "ERROR_REGISTRY_RECOVERED" }, { ERROR_REGISTRY_CORRUPT, "ERROR_REGISTRY_CORRUPT" }, { ERROR_REGISTRY_IO_FAILED, "ERROR_REGISTRY_IO_FAILED" }, { ERROR_NOT_REGISTRY_FILE, "ERROR_NOT_REGISTRY_FILE" }, { ERROR_KEY_DELETED, "ERROR_KEY_DELETED" }, { ERROR_NO_LOG_SPACE, "ERROR_NO_LOG_SPACE" }, { ERROR_KEY_HAS_CHILDREN, "ERROR_KEY_HAS_CHILDREN" }, { ERROR_CHILD_MUST_BE_VOLATILE, "ERROR_CHILD_MUST_BE_VOLATILE" }, { ERROR_NOTIFY_ENUM_DIR, "ERROR_NOTIFY_ENUM_DIR" }, { ERROR_DEPENDENT_SERVICES_RUNNING, "ERROR_DEPENDENT_SERVICES_RUNNING" }, { ERROR_INVALID_SERVICE_CONTROL, "ERROR_INVALID_SERVICE_CONTROL" }, { ERROR_SERVICE_REQUEST_TIMEOUT, "ERROR_SERVICE_REQUEST_TIMEOUT" }, { ERROR_SERVICE_NO_THREAD, "ERROR_SERVICE_NO_THREAD" }, { ERROR_SERVICE_DATABASE_LOCKED, "ERROR_SERVICE_DATABASE_LOCKED" }, { ERROR_SERVICE_ALREADY_RUNNING, "ERROR_SERVICE_ALREADY_RUNNING" }, { ERROR_INVALID_SERVICE_ACCOUNT, "ERROR_INVALID_SERVICE_ACCOUNT" }, { ERROR_SERVICE_DISABLED, "ERROR_SERVICE_DISABLED" }, { ERROR_CIRCULAR_DEPENDENCY, "ERROR_CIRCULAR_DEPENDENCY" }, { ERROR_SERVICE_DOES_NOT_EXIST, "ERROR_SERVICE_DOES_NOT_EXIST" }, { ERROR_SERVICE_CANNOT_ACCEPT_CTRL, "ERROR_SERVICE_CANNOT_ACCEPT_CTRL" }, { ERROR_SERVICE_NOT_ACTIVE, "ERROR_SERVICE_NOT_ACTIVE" }, { ERROR_FAILED_SERVICE_CONTROLLER_CONNECT, "ERROR_FAILED_SERVICE_CONTROLLER_CONNECT" }, { ERROR_EXCEPTION_IN_SERVICE, "ERROR_EXCEPTION_IN_SERVICE" }, { ERROR_DATABASE_DOES_NOT_EXIST, "ERROR_DATABASE_DOES_NOT_EXIST" }, { ERROR_SERVICE_SPECIFIC_ERROR, "ERROR_SERVICE_SPECIFIC_ERROR" }, { ERROR_PROCESS_ABORTED, "ERROR_PROCESS_ABORTED" }, { ERROR_SERVICE_DEPENDENCY_FAIL, "ERROR_SERVICE_DEPENDENCY_FAIL" }, { ERROR_SERVICE_LOGON_FAILED, "ERROR_SERVICE_LOGON_FAILED" }, { ERROR_SERVICE_START_HANG, "ERROR_SERVICE_START_HANG" }, { ERROR_INVALID_SERVICE_LOCK, "ERROR_INVALID_SERVICE_LOCK" }, { ERROR_SERVICE_MARKED_FOR_DELETE, "ERROR_SERVICE_MARKED_FOR_DELETE" }, { ERROR_SERVICE_EXISTS, "ERROR_SERVICE_EXISTS" }, { ERROR_ALREADY_RUNNING_LKG, "ERROR_ALREADY_RUNNING_LKG" }, { ERROR_SERVICE_DEPENDENCY_DELETED, "ERROR_SERVICE_DEPENDENCY_DELETED" }, { ERROR_BOOT_ALREADY_ACCEPTED, "ERROR_BOOT_ALREADY_ACCEPTED" }, { ERROR_SERVICE_NEVER_STARTED, "ERROR_SERVICE_NEVER_STARTED" }, { ERROR_DUPLICATE_SERVICE_NAME, "ERROR_DUPLICATE_SERVICE_NAME" }, #ifdef ERROR_DIFFERENT_SERVICE_ACCOUNT { ERROR_DIFFERENT_SERVICE_ACCOUNT, "ERROR_DIFFERENT_SERVICE_ACCOUNT" }, #endif { ERROR_END_OF_MEDIA, "ERROR_END_OF_MEDIA" }, { ERROR_FILEMARK_DETECTED, "ERROR_FILEMARK_DETECTED" }, { ERROR_BEGINNING_OF_MEDIA, "ERROR_BEGINNING_OF_MEDIA" }, { ERROR_SETMARK_DETECTED, "ERROR_SETMARK_DETECTED" }, { ERROR_NO_DATA_DETECTED, "ERROR_NO_DATA_DETECTED" }, { ERROR_PARTITION_FAILURE, "ERROR_PARTITION_FAILURE" }, { ERROR_INVALID_BLOCK_LENGTH, "ERROR_INVALID_BLOCK_LENGTH" }, { ERROR_DEVICE_NOT_PARTITIONED, "ERROR_DEVICE_NOT_PARTITIONED" }, { ERROR_UNABLE_TO_LOCK_MEDIA, "ERROR_UNABLE_TO_LOCK_MEDIA" }, { ERROR_UNABLE_TO_UNLOAD_MEDIA, "ERROR_UNABLE_TO_UNLOAD_MEDIA" }, { ERROR_MEDIA_CHANGED, "ERROR_MEDIA_CHANGED" }, { ERROR_BUS_RESET, "ERROR_BUS_RESET" }, { ERROR_NO_MEDIA_IN_DRIVE, "ERROR_NO_MEDIA_IN_DRIVE" }, { ERROR_NO_UNICODE_TRANSLATION, "ERROR_NO_UNICODE_TRANSLATION" }, { ERROR_DLL_INIT_FAILED, "ERROR_DLL_INIT_FAILED" }, { ERROR_SHUTDOWN_IN_PROGRESS, "ERROR_SHUTDOWN_IN_PROGRESS" }, { ERROR_NO_SHUTDOWN_IN_PROGRESS, "ERROR_NO_SHUTDOWN_IN_PROGRESS" }, { ERROR_IO_DEVICE, "ERROR_IO_DEVICE" }, { ERROR_SERIAL_NO_DEVICE, "ERROR_SERIAL_NO_DEVICE" }, { ERROR_IRQ_BUSY, "ERROR_IRQ_BUSY" }, { ERROR_MORE_WRITES, "ERROR_MORE_WRITES" }, { ERROR_COUNTER_TIMEOUT, "ERROR_COUNTER_TIMEOUT" }, { ERROR_FLOPPY_ID_MARK_NOT_FOUND, "ERROR_FLOPPY_ID_MARK_NOT_FOUND" }, { ERROR_FLOPPY_WRONG_CYLINDER, "ERROR_FLOPPY_WRONG_CYLINDER" }, { ERROR_FLOPPY_UNKNOWN_ERROR, "ERROR_FLOPPY_UNKNOWN_ERROR" }, { ERROR_FLOPPY_BAD_REGISTERS, "ERROR_FLOPPY_BAD_REGISTERS" }, { ERROR_DISK_RECALIBRATE_FAILED, "ERROR_DISK_RECALIBRATE_FAILED" }, { ERROR_DISK_OPERATION_FAILED, "ERROR_DISK_OPERATION_FAILED" }, { ERROR_DISK_RESET_FAILED, "ERROR_DISK_RESET_FAILED" }, { ERROR_EOM_OVERFLOW, "ERROR_EOM_OVERFLOW" }, { ERROR_NOT_ENOUGH_SERVER_MEMORY, "ERROR_NOT_ENOUGH_SERVER_MEMORY" }, { ERROR_POSSIBLE_DEADLOCK, "ERROR_POSSIBLE_DEADLOCK" }, { ERROR_MAPPED_ALIGNMENT, "ERROR_MAPPED_ALIGNMENT" }, { ERROR_SET_POWER_STATE_VETOED, "ERROR_SET_POWER_STATE_VETOED" }, { ERROR_SET_POWER_STATE_FAILED, "ERROR_SET_POWER_STATE_FAILED" }, #ifdef ERROR_TOO_MANY_LINKS { ERROR_TOO_MANY_LINKS, "ERROR_TOO_MANY_LINKS" }, #endif { ERROR_OLD_WIN_VERSION, "ERROR_OLD_WIN_VERSION" }, { ERROR_APP_WRONG_OS, "ERROR_APP_WRONG_OS" }, { ERROR_SINGLE_INSTANCE_APP, "ERROR_SINGLE_INSTANCE_APP" }, { ERROR_RMODE_APP, "ERROR_RMODE_APP" }, { ERROR_INVALID_DLL, "ERROR_INVALID_DLL" }, { ERROR_NO_ASSOCIATION, "ERROR_NO_ASSOCIATION" }, { ERROR_DDE_FAIL, "ERROR_DDE_FAIL" }, { ERROR_DLL_NOT_FOUND, "ERROR_DLL_NOT_FOUND" }, { ERROR_BAD_USERNAME, "ERROR_BAD_USERNAME" }, { ERROR_NOT_CONNECTED, "ERROR_NOT_CONNECTED" }, { ERROR_OPEN_FILES, "ERROR_OPEN_FILES" }, { ERROR_ACTIVE_CONNECTIONS, "ERROR_ACTIVE_CONNECTIONS" }, { ERROR_DEVICE_IN_USE, "ERROR_DEVICE_IN_USE" }, { ERROR_BAD_DEVICE, "ERROR_BAD_DEVICE" }, { ERROR_CONNECTION_UNAVAIL, "ERROR_CONNECTION_UNAVAIL" }, { ERROR_DEVICE_ALREADY_REMEMBERED, "ERROR_DEVICE_ALREADY_REMEMBERED" }, { ERROR_NO_NET_OR_BAD_PATH, "ERROR_NO_NET_OR_BAD_PATH" }, { ERROR_BAD_PROVIDER, "ERROR_BAD_PROVIDER" }, { ERROR_CANNOT_OPEN_PROFILE, "ERROR_CANNOT_OPEN_PROFILE" }, { ERROR_BAD_PROFILE, "ERROR_BAD_PROFILE" }, { ERROR_NOT_CONTAINER, "ERROR_NOT_CONTAINER" }, { ERROR_EXTENDED_ERROR, "ERROR_EXTENDED_ERROR" }, { ERROR_INVALID_GROUPNAME, "ERROR_INVALID_GROUPNAME" }, { ERROR_INVALID_COMPUTERNAME, "ERROR_INVALID_COMPUTERNAME" }, { ERROR_INVALID_EVENTNAME, "ERROR_INVALID_EVENTNAME" }, { ERROR_INVALID_DOMAINNAME, "ERROR_INVALID_DOMAINNAME" }, { ERROR_INVALID_SERVICENAME, "ERROR_INVALID_SERVICENAME" }, { ERROR_INVALID_NETNAME, "ERROR_INVALID_NETNAME" }, { ERROR_INVALID_SHARENAME, "ERROR_INVALID_SHARENAME" }, { ERROR_INVALID_PASSWORDNAME, "ERROR_INVALID_PASSWORDNAME" }, { ERROR_INVALID_MESSAGENAME, "ERROR_INVALID_MESSAGENAME" }, { ERROR_INVALID_MESSAGEDEST, "ERROR_INVALID_MESSAGEDEST" }, { ERROR_SESSION_CREDENTIAL_CONFLICT, "ERROR_SESSION_CREDENTIAL_CONFLICT" }, { ERROR_REMOTE_SESSION_LIMIT_EXCEEDED, "ERROR_REMOTE_SESSION_LIMIT_EXCEEDED" }, { ERROR_DUP_DOMAINNAME, "ERROR_DUP_DOMAINNAME" }, { ERROR_NO_NETWORK, "ERROR_NO_NETWORK" }, { ERROR_CANCELLED, "ERROR_CANCELLED" }, { ERROR_USER_MAPPED_FILE, "ERROR_USER_MAPPED_FILE" }, { ERROR_CONNECTION_REFUSED, "ERROR_CONNECTION_REFUSED" }, { ERROR_GRACEFUL_DISCONNECT, "ERROR_GRACEFUL_DISCONNECT" }, { ERROR_ADDRESS_ALREADY_ASSOCIATED, "ERROR_ADDRESS_ALREADY_ASSOCIATED" }, { ERROR_ADDRESS_NOT_ASSOCIATED, "ERROR_ADDRESS_NOT_ASSOCIATED" }, { ERROR_CONNECTION_INVALID, "ERROR_CONNECTION_INVALID" }, { ERROR_CONNECTION_ACTIVE, "ERROR_CONNECTION_ACTIVE" }, { ERROR_NETWORK_UNREACHABLE, "ERROR_NETWORK_UNREACHABLE" }, { ERROR_HOST_UNREACHABLE, "ERROR_HOST_UNREACHABLE" }, { ERROR_PROTOCOL_UNREACHABLE, "ERROR_PROTOCOL_UNREACHABLE" }, { ERROR_PORT_UNREACHABLE, "ERROR_PORT_UNREACHABLE" }, { ERROR_REQUEST_ABORTED, "ERROR_REQUEST_ABORTED" }, { ERROR_CONNECTION_ABORTED, "ERROR_CONNECTION_ABORTED" }, { ERROR_RETRY, "ERROR_RETRY" }, { ERROR_CONNECTION_COUNT_LIMIT, "ERROR_CONNECTION_COUNT_LIMIT" }, { ERROR_LOGIN_TIME_RESTRICTION, "ERROR_LOGIN_TIME_RESTRICTION" }, { ERROR_LOGIN_WKSTA_RESTRICTION, "ERROR_LOGIN_WKSTA_RESTRICTION" }, { ERROR_INCORRECT_ADDRESS, "ERROR_INCORRECT_ADDRESS" }, { ERROR_ALREADY_REGISTERED, "ERROR_ALREADY_REGISTERED" }, { ERROR_SERVICE_NOT_FOUND, "ERROR_SERVICE_NOT_FOUND" }, { ERROR_NOT_AUTHENTICATED, "ERROR_NOT_AUTHENTICATED" }, { ERROR_NOT_LOGGED_ON, "ERROR_NOT_LOGGED_ON" }, { ERROR_CONTINUE, "ERROR_CONTINUE" }, { ERROR_ALREADY_INITIALIZED, "ERROR_ALREADY_INITIALIZED" }, { ERROR_NO_MORE_DEVICES, "ERROR_NO_MORE_DEVICES" }, { ERROR_NOT_ALL_ASSIGNED, "ERROR_NOT_ALL_ASSIGNED" }, { ERROR_SOME_NOT_MAPPED, "ERROR_SOME_NOT_MAPPED" }, { ERROR_NO_QUOTAS_FOR_ACCOUNT, "ERROR_NO_QUOTAS_FOR_ACCOUNT" }, { ERROR_LOCAL_USER_SESSION_KEY, "ERROR_LOCAL_USER_SESSION_KEY" }, { ERROR_NULL_LM_PASSWORD, "ERROR_NULL_LM_PASSWORD" }, { ERROR_UNKNOWN_REVISION, "ERROR_UNKNOWN_REVISION" }, { ERROR_REVISION_MISMATCH, "ERROR_REVISION_MISMATCH" }, { ERROR_INVALID_OWNER, "ERROR_INVALID_OWNER" }, { ERROR_INVALID_PRIMARY_GROUP, "ERROR_INVALID_PRIMARY_GROUP" }, { ERROR_NO_IMPERSONATION_TOKEN, "ERROR_NO_IMPERSONATION_TOKEN" }, { ERROR_CANT_DISABLE_MANDATORY, "ERROR_CANT_DISABLE_MANDATORY" }, { ERROR_NO_LOGON_SERVERS, "ERROR_NO_LOGON_SERVERS" }, { ERROR_NO_SUCH_LOGON_SESSION, "ERROR_NO_SUCH_LOGON_SESSION" }, { ERROR_NO_SUCH_PRIVILEGE, "ERROR_NO_SUCH_PRIVILEGE" }, { ERROR_PRIVILEGE_NOT_HELD, "ERROR_PRIVILEGE_NOT_HELD" }, { ERROR_INVALID_ACCOUNT_NAME, "ERROR_INVALID_ACCOUNT_NAME" }, { ERROR_USER_EXISTS, "ERROR_USER_EXISTS" }, { ERROR_NO_SUCH_USER, "ERROR_NO_SUCH_USER" }, { ERROR_GROUP_EXISTS, "ERROR_GROUP_EXISTS" }, { ERROR_NO_SUCH_GROUP, "ERROR_NO_SUCH_GROUP" }, { ERROR_MEMBER_IN_GROUP, "ERROR_MEMBER_IN_GROUP" }, { ERROR_MEMBER_NOT_IN_GROUP, "ERROR_MEMBER_NOT_IN_GROUP" }, { ERROR_LAST_ADMIN, "ERROR_LAST_ADMIN" }, { ERROR_WRONG_PASSWORD, "ERROR_WRONG_PASSWORD" }, { ERROR_ILL_FORMED_PASSWORD, "ERROR_ILL_FORMED_PASSWORD" }, { ERROR_PASSWORD_RESTRICTION, "ERROR_PASSWORD_RESTRICTION" }, { ERROR_LOGON_FAILURE, "ERROR_LOGON_FAILURE" }, { ERROR_ACCOUNT_RESTRICTION, "ERROR_ACCOUNT_RESTRICTION" }, { ERROR_INVALID_LOGON_HOURS, "ERROR_INVALID_LOGON_HOURS" }, { ERROR_INVALID_WORKSTATION, "ERROR_INVALID_WORKSTATION" }, { ERROR_PASSWORD_EXPIRED, "ERROR_PASSWORD_EXPIRED" }, { ERROR_ACCOUNT_DISABLED, "ERROR_ACCOUNT_DISABLED" }, { ERROR_NONE_MAPPED, "ERROR_NONE_MAPPED" }, { ERROR_TOO_MANY_LUIDS_REQUESTED, "ERROR_TOO_MANY_LUIDS_REQUESTED" }, { ERROR_LUIDS_EXHAUSTED, "ERROR_LUIDS_EXHAUSTED" }, { ERROR_INVALID_SUB_AUTHORITY, "ERROR_INVALID_SUB_AUTHORITY" }, { ERROR_INVALID_ACL, "ERROR_INVALID_ACL" }, { ERROR_INVALID_SID, "ERROR_INVALID_SID" }, { ERROR_INVALID_SECURITY_DESCR, "ERROR_INVALID_SECURITY_DESCR" }, { ERROR_BAD_INHERITANCE_ACL, "ERROR_BAD_INHERITANCE_ACL" }, { ERROR_SERVER_DISABLED, "ERROR_SERVER_DISABLED" }, { ERROR_SERVER_NOT_DISABLED, "ERROR_SERVER_NOT_DISABLED" }, { ERROR_INVALID_ID_AUTHORITY, "ERROR_INVALID_ID_AUTHORITY" }, { ERROR_ALLOTTED_SPACE_EXCEEDED, "ERROR_ALLOTTED_SPACE_EXCEEDED" }, { ERROR_INVALID_GROUP_ATTRIBUTES, "ERROR_INVALID_GROUP_ATTRIBUTES" }, { ERROR_BAD_IMPERSONATION_LEVEL, "ERROR_BAD_IMPERSONATION_LEVEL" }, { ERROR_CANT_OPEN_ANONYMOUS, "ERROR_CANT_OPEN_ANONYMOUS" }, { ERROR_BAD_VALIDATION_CLASS, "ERROR_BAD_VALIDATION_CLASS" }, { ERROR_BAD_TOKEN_TYPE, "ERROR_BAD_TOKEN_TYPE" }, { ERROR_NO_SECURITY_ON_OBJECT, "ERROR_NO_SECURITY_ON_OBJECT" }, { ERROR_CANT_ACCESS_DOMAIN_INFO, "ERROR_CANT_ACCESS_DOMAIN_INFO" }, { ERROR_INVALID_SERVER_STATE, "ERROR_INVALID_SERVER_STATE" }, { ERROR_INVALID_DOMAIN_STATE, "ERROR_INVALID_DOMAIN_STATE" }, { ERROR_INVALID_DOMAIN_ROLE, "ERROR_INVALID_DOMAIN_ROLE" }, { ERROR_NO_SUCH_DOMAIN, "ERROR_NO_SUCH_DOMAIN" }, { ERROR_DOMAIN_EXISTS, "ERROR_DOMAIN_EXISTS" }, { ERROR_DOMAIN_LIMIT_EXCEEDED, "ERROR_DOMAIN_LIMIT_EXCEEDED" }, { ERROR_INTERNAL_DB_CORRUPTION, "ERROR_INTERNAL_DB_CORRUPTION" }, { ERROR_INTERNAL_ERROR, "ERROR_INTERNAL_ERROR" }, { ERROR_GENERIC_NOT_MAPPED, "ERROR_GENERIC_NOT_MAPPED" }, { ERROR_BAD_DESCRIPTOR_FORMAT, "ERROR_BAD_DESCRIPTOR_FORMAT" }, { ERROR_NOT_LOGON_PROCESS, "ERROR_NOT_LOGON_PROCESS" }, { ERROR_LOGON_SESSION_EXISTS, "ERROR_LOGON_SESSION_EXISTS" }, { ERROR_NO_SUCH_PACKAGE, "ERROR_NO_SUCH_PACKAGE" }, { ERROR_BAD_LOGON_SESSION_STATE, "ERROR_BAD_LOGON_SESSION_STATE" }, { ERROR_LOGON_SESSION_COLLISION, "ERROR_LOGON_SESSION_COLLISION" }, { ERROR_INVALID_LOGON_TYPE, "ERROR_INVALID_LOGON_TYPE" }, { ERROR_CANNOT_IMPERSONATE, "ERROR_CANNOT_IMPERSONATE" }, { ERROR_RXACT_INVALID_STATE, "ERROR_RXACT_INVALID_STATE" }, { ERROR_RXACT_COMMIT_FAILURE, "ERROR_RXACT_COMMIT_FAILURE" }, { ERROR_SPECIAL_ACCOUNT, "ERROR_SPECIAL_ACCOUNT" }, { ERROR_SPECIAL_GROUP, "ERROR_SPECIAL_GROUP" }, { ERROR_SPECIAL_USER, "ERROR_SPECIAL_USER" }, { ERROR_MEMBERS_PRIMARY_GROUP, "ERROR_MEMBERS_PRIMARY_GROUP" }, { ERROR_TOKEN_ALREADY_IN_USE, "ERROR_TOKEN_ALREADY_IN_USE" }, { ERROR_NO_SUCH_ALIAS, "ERROR_NO_SUCH_ALIAS" }, { ERROR_MEMBER_NOT_IN_ALIAS, "ERROR_MEMBER_NOT_IN_ALIAS" }, { ERROR_MEMBER_IN_ALIAS, "ERROR_MEMBER_IN_ALIAS" }, { ERROR_ALIAS_EXISTS, "ERROR_ALIAS_EXISTS" }, { ERROR_LOGON_NOT_GRANTED, "ERROR_LOGON_NOT_GRANTED" }, { ERROR_TOO_MANY_SECRETS, "ERROR_TOO_MANY_SECRETS" }, { ERROR_SECRET_TOO_LONG, "ERROR_SECRET_TOO_LONG" }, { ERROR_INTERNAL_DB_ERROR, "ERROR_INTERNAL_DB_ERROR" }, { ERROR_TOO_MANY_CONTEXT_IDS, "ERROR_TOO_MANY_CONTEXT_IDS" }, { ERROR_LOGON_TYPE_NOT_GRANTED, "ERROR_LOGON_TYPE_NOT_GRANTED" }, { ERROR_NT_CROSS_ENCRYPTION_REQUIRED, "ERROR_NT_CROSS_ENCRYPTION_REQUIRED" }, { ERROR_NO_SUCH_MEMBER, "ERROR_NO_SUCH_MEMBER" }, { ERROR_INVALID_MEMBER, "ERROR_INVALID_MEMBER" }, { ERROR_TOO_MANY_SIDS, "ERROR_TOO_MANY_SIDS" }, { ERROR_LM_CROSS_ENCRYPTION_REQUIRED, "ERROR_LM_CROSS_ENCRYPTION_REQUIRED" }, { ERROR_NO_INHERITANCE, "ERROR_NO_INHERITANCE" }, { ERROR_FILE_CORRUPT, "ERROR_FILE_CORRUPT" }, { ERROR_DISK_CORRUPT, "ERROR_DISK_CORRUPT" }, { ERROR_NO_USER_SESSION_KEY, "ERROR_NO_USER_SESSION_KEY" }, #ifdef ERROR_LICENSE_QUOTA_EXCEEDED { ERROR_LICENSE_QUOTA_EXCEEDED, "ERROR_LICENSE_QUOTA_EXCEEDED" }, #endif { ERROR_INVALID_WINDOW_HANDLE, "ERROR_INVALID_WINDOW_HANDLE" }, { ERROR_INVALID_MENU_HANDLE, "ERROR_INVALID_MENU_HANDLE" }, { ERROR_INVALID_CURSOR_HANDLE, "ERROR_INVALID_CURSOR_HANDLE" }, { ERROR_INVALID_ACCEL_HANDLE, "ERROR_INVALID_ACCEL_HANDLE" }, { ERROR_INVALID_HOOK_HANDLE, "ERROR_INVALID_HOOK_HANDLE" }, { ERROR_INVALID_DWP_HANDLE, "ERROR_INVALID_DWP_HANDLE" }, { ERROR_TLW_WITH_WSCHILD, "ERROR_TLW_WITH_WSCHILD" }, { ERROR_CANNOT_FIND_WND_CLASS, "ERROR_CANNOT_FIND_WND_CLASS" }, { ERROR_WINDOW_OF_OTHER_THREAD, "ERROR_WINDOW_OF_OTHER_THREAD" }, { ERROR_HOTKEY_ALREADY_REGISTERED, "ERROR_HOTKEY_ALREADY_REGISTERED" }, { ERROR_CLASS_ALREADY_EXISTS, "ERROR_CLASS_ALREADY_EXISTS" }, { ERROR_CLASS_DOES_NOT_EXIST, "ERROR_CLASS_DOES_NOT_EXIST" }, { ERROR_CLASS_HAS_WINDOWS, "ERROR_CLASS_HAS_WINDOWS" }, { ERROR_INVALID_INDEX, "ERROR_INVALID_INDEX" }, { ERROR_INVALID_ICON_HANDLE, "ERROR_INVALID_ICON_HANDLE" }, { ERROR_PRIVATE_DIALOG_INDEX, "ERROR_PRIVATE_DIALOG_INDEX" }, { ERROR_LISTBOX_ID_NOT_FOUND, "ERROR_LISTBOX_ID_NOT_FOUND" }, { ERROR_NO_WILDCARD_CHARACTERS, "ERROR_NO_WILDCARD_CHARACTERS" }, { ERROR_CLIPBOARD_NOT_OPEN, "ERROR_CLIPBOARD_NOT_OPEN" }, { ERROR_HOTKEY_NOT_REGISTERED, "ERROR_HOTKEY_NOT_REGISTERED" }, { ERROR_WINDOW_NOT_DIALOG, "ERROR_WINDOW_NOT_DIALOG" }, { ERROR_CONTROL_ID_NOT_FOUND, "ERROR_CONTROL_ID_NOT_FOUND" }, { ERROR_INVALID_COMBOBOX_MESSAGE, "ERROR_INVALID_COMBOBOX_MESSAGE" }, { ERROR_WINDOW_NOT_COMBOBOX, "ERROR_WINDOW_NOT_COMBOBOX" }, { ERROR_INVALID_EDIT_HEIGHT, "ERROR_INVALID_EDIT_HEIGHT" }, { ERROR_DC_NOT_FOUND, "ERROR_DC_NOT_FOUND" }, { ERROR_INVALID_HOOK_FILTER, "ERROR_INVALID_HOOK_FILTER" }, { ERROR_INVALID_FILTER_PROC, "ERROR_INVALID_FILTER_PROC" }, { ERROR_HOOK_NEEDS_HMOD, "ERROR_HOOK_NEEDS_HMOD" }, { ERROR_GLOBAL_ONLY_HOOK, "ERROR_GLOBAL_ONLY_HOOK" }, { ERROR_JOURNAL_HOOK_SET, "ERROR_JOURNAL_HOOK_SET" }, { ERROR_HOOK_NOT_INSTALLED, "ERROR_HOOK_NOT_INSTALLED" }, { ERROR_INVALID_LB_MESSAGE, "ERROR_INVALID_LB_MESSAGE" }, { ERROR_SETCOUNT_ON_BAD_LB, "ERROR_SETCOUNT_ON_BAD_LB" }, { ERROR_LB_WITHOUT_TABSTOPS, "ERROR_LB_WITHOUT_TABSTOPS" }, { ERROR_DESTROY_OBJECT_OF_OTHER_THREAD, "ERROR_DESTROY_OBJECT_OF_OTHER_THREAD" }, { ERROR_CHILD_WINDOW_MENU, "ERROR_CHILD_WINDOW_MENU" }, { ERROR_NO_SYSTEM_MENU, "ERROR_NO_SYSTEM_MENU" }, { ERROR_INVALID_MSGBOX_STYLE, "ERROR_INVALID_MSGBOX_STYLE" }, { ERROR_INVALID_SPI_VALUE, "ERROR_INVALID_SPI_VALUE" }, { ERROR_SCREEN_ALREADY_LOCKED, "ERROR_SCREEN_ALREADY_LOCKED" }, { ERROR_HWNDS_HAVE_DIFF_PARENT, "ERROR_HWNDS_HAVE_DIFF_PARENT" }, { ERROR_NOT_CHILD_WINDOW, "ERROR_NOT_CHILD_WINDOW" }, { ERROR_INVALID_GW_COMMAND, "ERROR_INVALID_GW_COMMAND" }, { ERROR_INVALID_THREAD_ID, "ERROR_INVALID_THREAD_ID" }, { ERROR_NON_MDICHILD_WINDOW, "ERROR_NON_MDICHILD_WINDOW" }, { ERROR_POPUP_ALREADY_ACTIVE, "ERROR_POPUP_ALREADY_ACTIVE" }, { ERROR_NO_SCROLLBARS, "ERROR_NO_SCROLLBARS" }, { ERROR_INVALID_SCROLLBAR_RANGE, "ERROR_INVALID_SCROLLBAR_RANGE" }, { ERROR_INVALID_SHOWWIN_COMMAND, "ERROR_INVALID_SHOWWIN_COMMAND" }, #ifdef ERROR_NO_SYSTEM_RESOURCES { ERROR_NO_SYSTEM_RESOURCES, "ERROR_NO_SYSTEM_RESOURCES" }, #endif #ifdef ERROR_NONPAGED_SYSTEM_RESOURCES { ERROR_NONPAGED_SYSTEM_RESOURCES, "ERROR_NONPAGED_SYSTEM_RESOURCES" }, #endif #ifdef ERROR_PAGED_SYSTEM_RESOURCES { ERROR_PAGED_SYSTEM_RESOURCES, "ERROR_PAGED_SYSTEM_RESOURCES" }, #endif #ifdef ERROR_WORKING_SET_QUOTA { ERROR_WORKING_SET_QUOTA, "ERROR_WORKING_SET_QUOTA" }, #endif #ifdef ERROR_PAGEFILE_QUOTA { ERROR_PAGEFILE_QUOTA, "ERROR_PAGEFILE_QUOTA" }, #endif #ifdef ERROR_COMMITMENT_LIMIT { ERROR_COMMITMENT_LIMIT, "ERROR_COMMITMENT_LIMIT" }, #endif #ifdef ERROR_MENU_ITEM_NOT_FOUND { ERROR_MENU_ITEM_NOT_FOUND, "ERROR_MENU_ITEM_NOT_FOUND" }, #endif #ifdef ERROR_INVALID_KEYBOARD_HANDLE { ERROR_INVALID_KEYBOARD_HANDLE, "ERROR_INVALID_KEYBOARD_HANDLE" }, #endif #ifdef ERROR_HOOK_TYPE_NOT_ALLOWED { ERROR_HOOK_TYPE_NOT_ALLOWED, "ERROR_HOOK_TYPE_NOT_ALLOWED" }, #endif #ifdef ERROR_REQUIRES_INTERACTIVE_WINDOWSTATION { ERROR_REQUIRES_INTERACTIVE_WINDOWSTATION, "ERROR_REQUIRES_INTERACTIVE_WINDOWSTATION" }, #endif #ifdef ERROR_TIMEOUT { ERROR_TIMEOUT, "ERROR_TIMEOUT" }, #endif { ERROR_EVENTLOG_FILE_CORRUPT, "ERROR_EVENTLOG_FILE_CORRUPT" }, { ERROR_EVENTLOG_CANT_START, "ERROR_EVENTLOG_CANT_START" }, { ERROR_LOG_FILE_FULL, "ERROR_LOG_FILE_FULL" }, { ERROR_EVENTLOG_FILE_CHANGED, "ERROR_EVENTLOG_FILE_CHANGED" }, { RPC_S_INVALID_STRING_BINDING, "RPC_S_INVALID_STRING_BINDING" }, { RPC_S_WRONG_KIND_OF_BINDING, "RPC_S_WRONG_KIND_OF_BINDING" }, { RPC_S_INVALID_BINDING, "RPC_S_INVALID_BINDING" }, { RPC_S_PROTSEQ_NOT_SUPPORTED, "RPC_S_PROTSEQ_NOT_SUPPORTED" }, { RPC_S_INVALID_RPC_PROTSEQ, "RPC_S_INVALID_RPC_PROTSEQ" }, { RPC_S_INVALID_STRING_UUID, "RPC_S_INVALID_STRING_UUID" }, { RPC_S_INVALID_ENDPOINT_FORMAT, "RPC_S_INVALID_ENDPOINT_FORMAT" }, { RPC_S_INVALID_NET_ADDR, "RPC_S_INVALID_NET_ADDR" }, { RPC_S_NO_ENDPOINT_FOUND, "RPC_S_NO_ENDPOINT_FOUND" }, { RPC_S_INVALID_TIMEOUT, "RPC_S_INVALID_TIMEOUT" }, { RPC_S_OBJECT_NOT_FOUND, "RPC_S_OBJECT_NOT_FOUND" }, { RPC_S_ALREADY_REGISTERED, "RPC_S_ALREADY_REGISTERED" }, { RPC_S_TYPE_ALREADY_REGISTERED, "RPC_S_TYPE_ALREADY_REGISTERED" }, { RPC_S_ALREADY_LISTENING, "RPC_S_ALREADY_LISTENING" }, { RPC_S_NO_PROTSEQS_REGISTERED, "RPC_S_NO_PROTSEQS_REGISTERED" }, { RPC_S_NOT_LISTENING, "RPC_S_NOT_LISTENING" }, { RPC_S_UNKNOWN_MGR_TYPE, "RPC_S_UNKNOWN_MGR_TYPE" }, { RPC_S_UNKNOWN_IF, "RPC_S_UNKNOWN_IF" }, { RPC_S_NO_BINDINGS, "RPC_S_NO_BINDINGS" }, { RPC_S_NO_PROTSEQS, "RPC_S_NO_PROTSEQS" }, { RPC_S_CANT_CREATE_ENDPOINT, "RPC_S_CANT_CREATE_ENDPOINT" }, { RPC_S_OUT_OF_RESOURCES, "RPC_S_OUT_OF_RESOURCES" }, { RPC_S_SERVER_UNAVAILABLE, "RPC_S_SERVER_UNAVAILABLE" }, { RPC_S_SERVER_TOO_BUSY, "RPC_S_SERVER_TOO_BUSY" }, { RPC_S_INVALID_NETWORK_OPTIONS, "RPC_S_INVALID_NETWORK_OPTIONS" }, { RPC_S_NO_CALL_ACTIVE, "RPC_S_NO_CALL_ACTIVE" }, { RPC_S_CALL_FAILED, "RPC_S_CALL_FAILED" }, { RPC_S_CALL_FAILED_DNE, "RPC_S_CALL_FAILED_DNE" }, { RPC_S_PROTOCOL_ERROR, "RPC_S_PROTOCOL_ERROR" }, { RPC_S_UNSUPPORTED_TRANS_SYN, "RPC_S_UNSUPPORTED_TRANS_SYN" }, { RPC_S_UNSUPPORTED_TYPE, "RPC_S_UNSUPPORTED_TYPE" }, { RPC_S_INVALID_TAG, "RPC_S_INVALID_TAG" }, { RPC_S_INVALID_BOUND, "RPC_S_INVALID_BOUND" }, { RPC_S_NO_ENTRY_NAME, "RPC_S_NO_ENTRY_NAME" }, { RPC_S_INVALID_NAME_SYNTAX, "RPC_S_INVALID_NAME_SYNTAX" }, { RPC_S_UNSUPPORTED_NAME_SYNTAX, "RPC_S_UNSUPPORTED_NAME_SYNTAX" }, { RPC_S_UUID_NO_ADDRESS, "RPC_S_UUID_NO_ADDRESS" }, { RPC_S_DUPLICATE_ENDPOINT, "RPC_S_DUPLICATE_ENDPOINT" }, { RPC_S_UNKNOWN_AUTHN_TYPE, "RPC_S_UNKNOWN_AUTHN_TYPE" }, { RPC_S_MAX_CALLS_TOO_SMALL, "RPC_S_MAX_CALLS_TOO_SMALL" }, { RPC_S_STRING_TOO_LONG, "RPC_S_STRING_TOO_LONG" }, { RPC_S_PROTSEQ_NOT_FOUND, "RPC_S_PROTSEQ_NOT_FOUND" }, { RPC_S_PROCNUM_OUT_OF_RANGE, "RPC_S_PROCNUM_OUT_OF_RANGE" }, { RPC_S_BINDING_HAS_NO_AUTH, "RPC_S_BINDING_HAS_NO_AUTH" }, { RPC_S_UNKNOWN_AUTHN_SERVICE, "RPC_S_UNKNOWN_AUTHN_SERVICE" }, { RPC_S_UNKNOWN_AUTHN_LEVEL, "RPC_S_UNKNOWN_AUTHN_LEVEL" }, { RPC_S_INVALID_AUTH_IDENTITY, "RPC_S_INVALID_AUTH_IDENTITY" }, { RPC_S_UNKNOWN_AUTHZ_SERVICE, "RPC_S_UNKNOWN_AUTHZ_SERVICE" }, { EPT_S_INVALID_ENTRY, "EPT_S_INVALID_ENTRY" }, { EPT_S_CANT_PERFORM_OP, "EPT_S_CANT_PERFORM_OP" }, { EPT_S_NOT_REGISTERED, "EPT_S_NOT_REGISTERED" }, { RPC_S_NOTHING_TO_EXPORT, "RPC_S_NOTHING_TO_EXPORT" }, { RPC_S_INCOMPLETE_NAME, "RPC_S_INCOMPLETE_NAME" }, { RPC_S_INVALID_VERS_OPTION, "RPC_S_INVALID_VERS_OPTION" }, { RPC_S_NO_MORE_MEMBERS, "RPC_S_NO_MORE_MEMBERS" }, { RPC_S_NOT_ALL_OBJS_UNEXPORTED, "RPC_S_NOT_ALL_OBJS_UNEXPORTED" }, { RPC_S_INTERFACE_NOT_FOUND, "RPC_S_INTERFACE_NOT_FOUND" }, { RPC_S_ENTRY_ALREADY_EXISTS, "RPC_S_ENTRY_ALREADY_EXISTS" }, { RPC_S_ENTRY_NOT_FOUND, "RPC_S_ENTRY_NOT_FOUND" }, { RPC_S_NAME_SERVICE_UNAVAILABLE, "RPC_S_NAME_SERVICE_UNAVAILABLE" }, { RPC_S_INVALID_NAF_ID, "RPC_S_INVALID_NAF_ID" }, { RPC_S_CANNOT_SUPPORT, "RPC_S_CANNOT_SUPPORT" }, { RPC_S_NO_CONTEXT_AVAILABLE, "RPC_S_NO_CONTEXT_AVAILABLE" }, { RPC_S_INTERNAL_ERROR, "RPC_S_INTERNAL_ERROR" }, { RPC_S_ZERO_DIVIDE, "RPC_S_ZERO_DIVIDE" }, { RPC_S_ADDRESS_ERROR, "RPC_S_ADDRESS_ERROR" }, { RPC_S_FP_DIV_ZERO, "RPC_S_FP_DIV_ZERO" }, { RPC_S_FP_UNDERFLOW, "RPC_S_FP_UNDERFLOW" }, { RPC_S_FP_OVERFLOW, "RPC_S_FP_OVERFLOW" }, { RPC_X_NO_MORE_ENTRIES, "RPC_X_NO_MORE_ENTRIES" }, { RPC_X_SS_CHAR_TRANS_OPEN_FAIL, "RPC_X_SS_CHAR_TRANS_OPEN_FAIL" }, { RPC_X_SS_CHAR_TRANS_SHORT_FILE, "RPC_X_SS_CHAR_TRANS_SHORT_FILE" }, { RPC_X_SS_IN_NULL_CONTEXT, "RPC_X_SS_IN_NULL_CONTEXT" }, { RPC_X_SS_CONTEXT_DAMAGED, "RPC_X_SS_CONTEXT_DAMAGED" }, { RPC_X_SS_HANDLES_MISMATCH, "RPC_X_SS_HANDLES_MISMATCH" }, { RPC_X_SS_CANNOT_GET_CALL_HANDLE, "RPC_X_SS_CANNOT_GET_CALL_HANDLE" }, { RPC_X_NULL_REF_POINTER, "RPC_X_NULL_REF_POINTER" }, { RPC_X_ENUM_VALUE_OUT_OF_RANGE, "RPC_X_ENUM_VALUE_OUT_OF_RANGE" }, { RPC_X_BYTE_COUNT_TOO_SMALL, "RPC_X_BYTE_COUNT_TOO_SMALL" }, { RPC_X_BAD_STUB_DATA, "RPC_X_BAD_STUB_DATA" }, { ERROR_INVALID_USER_BUFFER, "ERROR_INVALID_USER_BUFFER" }, { ERROR_UNRECOGNIZED_MEDIA, "ERROR_UNRECOGNIZED_MEDIA" }, { ERROR_NO_TRUST_LSA_SECRET, "ERROR_NO_TRUST_LSA_SECRET" }, { ERROR_NO_TRUST_SAM_ACCOUNT, "ERROR_NO_TRUST_SAM_ACCOUNT" }, { ERROR_TRUSTED_DOMAIN_FAILURE, "ERROR_TRUSTED_DOMAIN_FAILURE" }, { ERROR_TRUSTED_RELATIONSHIP_FAILURE, "ERROR_TRUSTED_RELATIONSHIP_FAILURE" }, { ERROR_TRUST_FAILURE, "ERROR_TRUST_FAILURE" }, { RPC_S_CALL_IN_PROGRESS, "RPC_S_CALL_IN_PROGRESS" }, { ERROR_NETLOGON_NOT_STARTED, "ERROR_NETLOGON_NOT_STARTED" }, { ERROR_ACCOUNT_EXPIRED, "ERROR_ACCOUNT_EXPIRED" }, { ERROR_REDIRECTOR_HAS_OPEN_HANDLES, "ERROR_REDIRECTOR_HAS_OPEN_HANDLES" }, { ERROR_PRINTER_DRIVER_ALREADY_INSTALLED, "ERROR_PRINTER_DRIVER_ALREADY_INSTALLED" }, { ERROR_UNKNOWN_PORT, "ERROR_UNKNOWN_PORT" }, { ERROR_UNKNOWN_PRINTER_DRIVER, "ERROR_UNKNOWN_PRINTER_DRIVER" }, { ERROR_UNKNOWN_PRINTPROCESSOR, "ERROR_UNKNOWN_PRINTPROCESSOR" }, { ERROR_INVALID_SEPARATOR_FILE, "ERROR_INVALID_SEPARATOR_FILE" }, { ERROR_INVALID_PRIORITY, "ERROR_INVALID_PRIORITY" }, { ERROR_INVALID_PRINTER_NAME, "ERROR_INVALID_PRINTER_NAME" }, { ERROR_PRINTER_ALREADY_EXISTS, "ERROR_PRINTER_ALREADY_EXISTS" }, { ERROR_INVALID_PRINTER_COMMAND, "ERROR_INVALID_PRINTER_COMMAND" }, { ERROR_INVALID_DATATYPE, "ERROR_INVALID_DATATYPE" }, { ERROR_INVALID_ENVIRONMENT, "ERROR_INVALID_ENVIRONMENT" }, { RPC_S_NO_MORE_BINDINGS, "RPC_S_NO_MORE_BINDINGS" }, { ERROR_NOLOGON_INTERDOMAIN_TRUST_ACCOUNT, "ERROR_NOLOGON_INTERDOMAIN_TRUST_ACCOUNT" }, { ERROR_NOLOGON_WORKSTATION_TRUST_ACCOUNT, "ERROR_NOLOGON_WORKSTATION_TRUST_ACCOUNT" }, { ERROR_NOLOGON_SERVER_TRUST_ACCOUNT, "ERROR_NOLOGON_SERVER_TRUST_ACCOUNT" }, { ERROR_DOMAIN_TRUST_INCONSISTENT, "ERROR_DOMAIN_TRUST_INCONSISTENT" }, { ERROR_SERVER_HAS_OPEN_HANDLES, "ERROR_SERVER_HAS_OPEN_HANDLES" }, { ERROR_RESOURCE_DATA_NOT_FOUND, "ERROR_RESOURCE_DATA_NOT_FOUND" }, { ERROR_RESOURCE_TYPE_NOT_FOUND, "ERROR_RESOURCE_TYPE_NOT_FOUND" }, { ERROR_RESOURCE_NAME_NOT_FOUND, "ERROR_RESOURCE_NAME_NOT_FOUND" }, { ERROR_RESOURCE_LANG_NOT_FOUND, "ERROR_RESOURCE_LANG_NOT_FOUND" }, { ERROR_NOT_ENOUGH_QUOTA, "ERROR_NOT_ENOUGH_QUOTA" }, { RPC_S_NO_INTERFACES, "RPC_S_NO_INTERFACES" }, { RPC_S_CALL_CANCELLED, "RPC_S_CALL_CANCELLED" }, { RPC_S_BINDING_INCOMPLETE, "RPC_S_BINDING_INCOMPLETE" }, { RPC_S_COMM_FAILURE, "RPC_S_COMM_FAILURE" }, { RPC_S_UNSUPPORTED_AUTHN_LEVEL, "RPC_S_UNSUPPORTED_AUTHN_LEVEL" }, { RPC_S_NO_PRINC_NAME, "RPC_S_NO_PRINC_NAME" }, { RPC_S_NOT_RPC_ERROR, "RPC_S_NOT_RPC_ERROR" }, { RPC_S_UUID_LOCAL_ONLY, "RPC_S_UUID_LOCAL_ONLY" }, { RPC_S_SEC_PKG_ERROR, "RPC_S_SEC_PKG_ERROR" }, { RPC_S_NOT_CANCELLED, "RPC_S_NOT_CANCELLED" }, { RPC_X_INVALID_ES_ACTION, "RPC_X_INVALID_ES_ACTION" }, { RPC_X_WRONG_ES_VERSION, "RPC_X_WRONG_ES_VERSION" }, { RPC_X_WRONG_STUB_VERSION, "RPC_X_WRONG_STUB_VERSION" }, #ifdef RPC_X_INVALID_PIPE_OBJECT { RPC_X_INVALID_PIPE_OBJECT, "RPC_X_INVALID_PIPE_OBJECT" }, #endif #ifdef RPC_X_INVALID_PIPE_OPERATION { RPC_X_INVALID_PIPE_OPERATION, "RPC_X_INVALID_PIPE_OPERATION" }, #endif #ifdef RPC_X_WRONG_PIPE_VERSION { RPC_X_WRONG_PIPE_VERSION, "RPC_X_WRONG_PIPE_VERSION" }, #endif { RPC_S_GROUP_MEMBER_NOT_FOUND, "RPC_S_GROUP_MEMBER_NOT_FOUND" }, { EPT_S_CANT_CREATE, "EPT_S_CANT_CREATE" }, { RPC_S_INVALID_OBJECT, "RPC_S_INVALID_OBJECT" }, { ERROR_INVALID_TIME, "ERROR_INVALID_TIME" }, { ERROR_INVALID_FORM_NAME, "ERROR_INVALID_FORM_NAME" }, { ERROR_INVALID_FORM_SIZE, "ERROR_INVALID_FORM_SIZE" }, { ERROR_ALREADY_WAITING, "ERROR_ALREADY_WAITING" }, { ERROR_PRINTER_DELETED, "ERROR_PRINTER_DELETED" }, { ERROR_INVALID_PRINTER_STATE, "ERROR_INVALID_PRINTER_STATE" }, { ERROR_PASSWORD_MUST_CHANGE, "ERROR_PASSWORD_MUST_CHANGE" }, { ERROR_DOMAIN_CONTROLLER_NOT_FOUND, "ERROR_DOMAIN_CONTROLLER_NOT_FOUND" }, { ERROR_ACCOUNT_LOCKED_OUT, "ERROR_ACCOUNT_LOCKED_OUT" }, #ifdef OR_INVALID_OXID { OR_INVALID_OXID, "OR_INVALID_OXID" }, #endif #ifdef OR_INVALID_OID { OR_INVALID_OID, "OR_INVALID_OID" }, #endif #ifdef OR_INVALID_SET { OR_INVALID_SET, "OR_INVALID_SET" }, #endif #ifdef RPC_S_SEND_INCOMPLETE { RPC_S_SEND_INCOMPLETE, "RPC_S_SEND_INCOMPLETE" }, #endif { ERROR_NO_BROWSER_SERVERS_FOUND, "ERROR_NO_BROWSER_SERVERS_FOUND" }, { ERROR_INVALID_PIXEL_FORMAT, "ERROR_INVALID_PIXEL_FORMAT" }, { ERROR_BAD_DRIVER, "ERROR_BAD_DRIVER" }, { ERROR_INVALID_WINDOW_STYLE, "ERROR_INVALID_WINDOW_STYLE" }, { ERROR_METAFILE_NOT_SUPPORTED, "ERROR_METAFILE_NOT_SUPPORTED" }, { ERROR_TRANSFORM_NOT_SUPPORTED, "ERROR_TRANSFORM_NOT_SUPPORTED" }, { ERROR_CLIPPING_NOT_SUPPORTED, "ERROR_CLIPPING_NOT_SUPPORTED" }, { ERROR_UNKNOWN_PRINT_MONITOR, "ERROR_UNKNOWN_PRINT_MONITOR" }, { ERROR_PRINTER_DRIVER_IN_USE, "ERROR_PRINTER_DRIVER_IN_USE" }, { ERROR_SPOOL_FILE_NOT_FOUND, "ERROR_SPOOL_FILE_NOT_FOUND" }, { ERROR_SPL_NO_STARTDOC, "ERROR_SPL_NO_STARTDOC" }, { ERROR_SPL_NO_ADDJOB, "ERROR_SPL_NO_ADDJOB" }, { ERROR_PRINT_PROCESSOR_ALREADY_INSTALLED, "ERROR_PRINT_PROCESSOR_ALREADY_INSTALLED" }, { ERROR_PRINT_MONITOR_ALREADY_INSTALLED, "ERROR_PRINT_MONITOR_ALREADY_INSTALLED" }, #ifdef ERROR_INVALID_PRINT_MONITOR { ERROR_INVALID_PRINT_MONITOR, "ERROR_INVALID_PRINT_MONITOR" }, #endif #ifdef ERROR_PRINT_MONITOR_IN_USE { ERROR_PRINT_MONITOR_IN_USE, "ERROR_PRINT_MONITOR_IN_USE" }, #endif #ifdef ERROR_PRINTER_HAS_JOBS_QUEUED { ERROR_PRINTER_HAS_JOBS_QUEUED, "ERROR_PRINTER_HAS_JOBS_QUEUED" }, #endif #ifdef ERROR_SUCCESS_REBOOT_REQUIRED { ERROR_SUCCESS_REBOOT_REQUIRED, "ERROR_SUCCESS_REBOOT_REQUIRED" }, #endif #ifdef ERROR_SUCCESS_RESTART_REQUIRED { ERROR_SUCCESS_RESTART_REQUIRED, "ERROR_SUCCESS_RESTART_REQUIRED" }, #endif { ERROR_WINS_INTERNAL, "ERROR_WINS_INTERNAL" }, { ERROR_CAN_NOT_DEL_LOCAL_WINS, "ERROR_CAN_NOT_DEL_LOCAL_WINS" }, { ERROR_STATIC_INIT, "ERROR_STATIC_INIT" }, { ERROR_INC_BACKUP, "ERROR_INC_BACKUP" }, { ERROR_FULL_BACKUP, "ERROR_FULL_BACKUP" }, { ERROR_REC_NON_EXISTENT, "ERROR_REC_NON_EXISTENT" }, { ERROR_RPL_NOT_ALLOWED, "ERROR_RPL_NOT_ALLOWED" }, { WSAEINTR, "WSAEINTR" }, { WSAEBADF, "WSAEBADF" }, { WSAEACCES, "WSAEACCES" }, { WSAEFAULT, "WSAEFAULT" }, { WSAEINVAL, "WSAEINVAL" }, { WSAEMFILE, "WSAEMFILE" }, { WSAEWOULDBLOCK, "WSAEWOULDBLOCK" }, { WSAEINPROGRESS, "WSAEINPROGRESS" }, { WSAEALREADY, "WSAEALREADY" }, { WSAENOTSOCK, "WSAENOTSOCK" }, { WSAEDESTADDRREQ, "WSAEDESTADDRREQ" }, { WSAEMSGSIZE, "WSAEMSGSIZE" }, { WSAEPROTOTYPE, "WSAEPROTOTYPE" }, { WSAENOPROTOOPT, "WSAENOPROTOOPT" }, { WSAEPROTONOSUPPORT, "WSAEPROTONOSUPPORT" }, { WSAESOCKTNOSUPPORT, "WSAESOCKTNOSUPPORT" }, { WSAEOPNOTSUPP, "WSAEOPNOTSUPP" }, { WSAEPFNOSUPPORT, "WSAEPFNOSUPPORT" }, { WSAEAFNOSUPPORT, "WSAEAFNOSUPPORT" }, { WSAEADDRINUSE, "WSAEADDRINUSE" }, { WSAEADDRNOTAVAIL, "WSAEADDRNOTAVAIL" }, { WSAENETDOWN, "WSAENETDOWN" }, { WSAENETUNREACH, "WSAENETUNREACH" }, { WSAENETRESET, "WSAENETRESET" }, { WSAECONNABORTED, "WSAECONNABORTED" }, { WSAECONNRESET, "WSAECONNRESET" }, { WSAENOBUFS, "WSAENOBUFS" }, { WSAEISCONN, "WSAEISCONN" }, { WSAENOTCONN, "WSAENOTCONN" }, { WSAESHUTDOWN, "WSAESHUTDOWN" }, { WSAETOOMANYREFS, "WSAETOOMANYREFS" }, { WSAETIMEDOUT, "WSAETIMEDOUT" }, { WSAECONNREFUSED, "WSAECONNREFUSED" }, { WSAELOOP, "WSAELOOP" }, { WSAENAMETOOLONG, "WSAENAMETOOLONG" }, { WSAEHOSTDOWN, "WSAEHOSTDOWN" }, { WSAEHOSTUNREACH, "WSAEHOSTUNREACH" }, { WSAENOTEMPTY, "WSAENOTEMPTY" }, { WSAEPROCLIM, "WSAEPROCLIM" }, { WSAEUSERS, "WSAEUSERS" }, { WSAEDQUOT, "WSAEDQUOT" }, { WSAESTALE, "WSAESTALE" }, { WSAEREMOTE, "WSAEREMOTE" }, { WSAEDISCON, "WSAEDISCON" }, { WSASYSNOTREADY, "WSASYSNOTREADY" }, { WSAVERNOTSUPPORTED, "WSAVERNOTSUPPORTED" }, { WSANOTINITIALISED, "WSANOTINITIALISED" }, { WSAHOST_NOT_FOUND, "WSAHOST_NOT_FOUND" }, { WSATRY_AGAIN, "WSATRY_AGAIN" }, { WSANO_RECOVERY, "WSANO_RECOVERY" }, { WSANO_DATA, "WSANO_DATA" }, #endif }; const char *stringFromErrorCode(int err) { for (unsigned i = 0; i < sizeof(errortable)/sizeof(errortable[0]); i++) { if (errortable[i].errorNum == err) { return errortable[i].errorString; } } return 0; } bool errorCodeFromString(const char *text, int *err) { for (unsigned i = 0; i < sizeof(errortable)/sizeof(errortable[0]); i++) { if (strcmp(text, errortable[i].errorString) == 0) { *err = errortable[i].errorNum; return true; } } return false; } diff --git a/libpolyml/exporter.cpp b/libpolyml/exporter.cpp index 65a3e714..3753ba99 100644 --- a/libpolyml/exporter.cpp +++ b/libpolyml/exporter.cpp @@ -1,913 +1,913 @@ /* Title: exporter.cpp - Export a function as an object or C file Copyright (c) 2006-7, 2015, 2016-19 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_SYS_PARAM_H #include #endif #ifdef HAVE_STDLIB_H #include #endif -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #include #else #define _T(x) x #define _tcslen strlen #define _tcscmp strcmp #define _tcscat strcat #endif #include "exporter.h" #include "save_vec.h" #include "polystring.h" #include "run_time.h" #include "osmem.h" #include "scanaddrs.h" #include "gc.h" #include "machine_dep.h" #include "diagnostics.h" #include "memmgr.h" #include "processes.h" // For IO_SPACING #include "sys.h" // For EXC_Fail #include "rtsentry.h" #include "pexport.h" #ifdef HAVE_PECOFF #include "pecoffexport.h" #elif defined(HAVE_ELF_H) || defined(HAVE_ELF_ABI_H) #include "elfexport.h" #elif defined(HAVE_MACH_O_RELOC_H) #include "machoexport.h" #endif -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #define NOMEMORY ERROR_NOT_ENOUGH_MEMORY #define ERRORNUMBER _doserrno #else #define NOMEMORY ENOMEM #define ERRORNUMBER errno #endif extern "C" { POLYEXTERNALSYMBOL POLYUNSIGNED PolyExport(PolyObject *threadId, PolyWord fileName, PolyWord root); POLYEXTERNALSYMBOL POLYUNSIGNED PolyExportPortable(PolyObject *threadId, PolyWord fileName, PolyWord root); } /* To export the function and everything reachable from it we need to copy all the objects into a new area. We leave tombstones in the original objects by overwriting the length word. That prevents us from copying an object twice and breaks loops. Once we've copied the objects we then have to go back over the memory and turn the tombstones back into length words. */ GraveYard::~GraveYard() { free(graves); } // Used to calculate the space required for the ordinary mutables // and the no-overwrite mutables. They are interspersed in local space. class MutSizes : public ScanAddress { public: MutSizes() : mutSize(0), noOverSize(0) {} virtual PolyObject *ScanObjectAddress(PolyObject *base) { return base; }// No Actually used virtual void ScanAddressesInObject(PolyObject *base, POLYUNSIGNED lengthWord) { const POLYUNSIGNED words = OBJ_OBJECT_LENGTH(lengthWord) + 1; // Include length word if (OBJ_IS_NO_OVERWRITE(lengthWord)) noOverSize += words; else mutSize += words; } POLYUNSIGNED mutSize, noOverSize; }; CopyScan::CopyScan(unsigned h/*=0*/): hierarchy(h) { defaultImmSize = defaultMutSize = defaultCodeSize = defaultNoOverSize = 0; tombs = 0; graveYard = 0; } void CopyScan::initialise(bool isExport/*=true*/) { ASSERT(gMem.eSpaces.size() == 0); // Set the space sizes to a proportion of the space currently in use. // Computing these sizes is not obvious because CopyScan is used both // for export and for saved states. For saved states in particular we // want to use a smaller size because they are retained after we save // the state and if we have many child saved states it's important not // to waste memory. if (hierarchy == 0) { graveYard = new GraveYard[gMem.pSpaces.size()]; if (graveYard == 0) { if (debugOptions & DEBUG_SAVING) Log("SAVE: Unable to allocate graveyard, size: %lu.\n", gMem.pSpaces.size()); throw MemoryException(); } } for (std::vector::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) { PermanentMemSpace *space = *i; if (space->hierarchy >= hierarchy) { // Include this if we're exporting (hierarchy=0) or if we're saving a state // and will include this in the new state. size_t size = (space->top-space->bottom)/4; if (space->noOverwrite) defaultNoOverSize += size; else if (space->isMutable) defaultMutSize += size; else if (space->isCode) defaultCodeSize += size; else defaultImmSize += size; if (space->hierarchy == 0 && ! space->isMutable) { // We need a separate area for the tombstones because this is read-only graveYard[tombs].graves = (PolyWord*)calloc(space->spaceSize(), sizeof(PolyWord)); if (graveYard[tombs].graves == 0) { if (debugOptions & DEBUG_SAVING) Log("SAVE: Unable to allocate graveyard for permanent space, size: %lu.\n", space->spaceSize() * sizeof(PolyWord)); throw MemoryException(); } if (debugOptions & DEBUG_SAVING) Log("SAVE: Allocated graveyard for permanent space, %p size: %lu.\n", graveYard[tombs].graves, space->spaceSize() * sizeof(PolyWord)); graveYard[tombs].startAddr = space->bottom; graveYard[tombs].endAddr = space->top; tombs++; } } } for (std::vector::iterator i = gMem.lSpaces.begin(); i < gMem.lSpaces.end(); i++) { LocalMemSpace *space = *i; uintptr_t size = space->allocatedSpace(); // It looks as though the mutable size generally gets // overestimated while the immutable size is correct. if (space->isMutable) { MutSizes sizeMut; sizeMut.ScanAddressesInRegion(space->bottom, space->lowerAllocPtr); sizeMut.ScanAddressesInRegion(space->upperAllocPtr, space->top); defaultNoOverSize += sizeMut.noOverSize / 4; defaultMutSize += sizeMut.mutSize / 4; } else defaultImmSize += size/2; } for (std::vector::iterator i = gMem.cSpaces.begin(); i < gMem.cSpaces.end(); i++) { CodeSpace *space = *i; uintptr_t size = space->spaceSize(); defaultCodeSize += size/2; } if (isExport) { // Minimum 1M words. if (defaultMutSize < 1024*1024) defaultMutSize = 1024*1024; if (defaultImmSize < 1024*1024) defaultImmSize = 1024*1024; if (defaultCodeSize < 1024*1024) defaultCodeSize = 1024*1024; #ifdef MACOSX // Limit the segment size for Mac OS X. The linker has a limit of 2^24 relocations // in a segment so this is a crude way of ensuring the limit isn't exceeded. // It's unlikely to be exceeded by the code itself. // Actually, from trial-and-error, the limit seems to be around 6M. if (defaultMutSize > 6 * 1024 * 1024) defaultMutSize = 6 * 1024 * 1024; if (defaultImmSize > 6 * 1024 * 1024) defaultImmSize = 6 * 1024 * 1024; #endif if (defaultNoOverSize < 4096) defaultNoOverSize = 4096; // Except for the no-overwrite area } else { // Much smaller minimum sizes for saved states. if (defaultMutSize < 1024) defaultMutSize = 1024; if (defaultImmSize < 4096) defaultImmSize = 4096; if (defaultCodeSize < 4096) defaultCodeSize = 4096; if (defaultNoOverSize < 4096) defaultNoOverSize = 4096; // Set maximum sizes as well. We may have insufficient contiguous space for // very large areas. if (defaultMutSize > 1024 * 1024) defaultMutSize = 1024 * 1024; if (defaultImmSize > 1024 * 1024) defaultImmSize = 1024 * 1024; if (defaultCodeSize > 1024 * 1024) defaultCodeSize = 1024 * 1024; if (defaultNoOverSize > 1024 * 1024) defaultNoOverSize = 1024 * 1024; } if (debugOptions & DEBUG_SAVING) Log("SAVE: Copyscan default sizes: Immutable: %" POLYUFMT ", Mutable: %" POLYUFMT ", Code: %" POLYUFMT ", No-overwrite %" POLYUFMT ".\n", defaultImmSize, defaultMutSize, defaultCodeSize, defaultNoOverSize); } CopyScan::~CopyScan() { gMem.DeleteExportSpaces(); if (graveYard) delete[](graveYard); } // This function is called for each address in an object // once it has been copied to its new location. We copy first // then scan to update the addresses. POLYUNSIGNED CopyScan::ScanAddressAt(PolyWord *pt) { PolyWord val = *pt; // Ignore integers. if (IS_INT(val) || val == PolyWord::FromUnsigned(0)) return 0; PolyObject *obj = val.AsObjPtr(); POLYUNSIGNED l = ScanAddress(&obj); *pt = obj; return l; } // This function is called for each address in an object // once it has been copied to its new location. We copy first // then scan to update the addresses. POLYUNSIGNED CopyScan::ScanAddress(PolyObject **pt) { PolyObject *obj = *pt; MemSpace *space = gMem.SpaceForAddress((PolyWord*)obj - 1); ASSERT(space != 0); // We may sometimes get addresses that have already been updated // to point to the new area. e.g. (only?) in the case of constants // that have been updated in ScanConstantsWithinCode. if (space->spaceType == ST_EXPORT) return 0; // If this is at a lower level than the hierarchy we are saving // then leave it untouched. if (space->spaceType == ST_PERMANENT) { PermanentMemSpace *pmSpace = (PermanentMemSpace*)space; if (pmSpace->hierarchy < hierarchy) return 0; } // Have we already scanned this? if (obj->ContainsForwardingPtr()) { // Update the address to the new value. #ifdef POLYML32IN64 PolyObject *newAddr; if (space->isCode) newAddr = (PolyObject*)(globalCodeBase + ((obj->LengthWord() & ~_OBJ_TOMBSTONE_BIT) << 1)); else newAddr = obj->GetForwardingPtr(); #else PolyObject *newAddr = obj->GetForwardingPtr(); #endif *pt = newAddr; return 0; // No need to scan it again. } else if (space->spaceType == ST_PERMANENT) { // See if we have this in the grave-yard. for (unsigned i = 0; i < tombs; i++) { GraveYard *g = &graveYard[i]; if ((PolyWord*)obj >= g->startAddr && (PolyWord*)obj < g->endAddr) { PolyWord *tombAddr = g->graves + ((PolyWord*)obj - g->startAddr); PolyObject *tombObject = (PolyObject*)tombAddr; if (tombObject->ContainsForwardingPtr()) { #ifdef POLYML32IN64 PolyObject *newAddr; if (space->isCode) newAddr = (PolyObject*)(globalCodeBase + ((tombObject->LengthWord() & ~_OBJ_TOMBSTONE_BIT) << 1)); else newAddr = tombObject->GetForwardingPtr(); #else PolyObject *newAddr = tombObject->GetForwardingPtr(); #endif *pt = newAddr; return 0; } break; // No need to look further } } } // No, we need to copy it. ASSERT(space->spaceType == ST_LOCAL || space->spaceType == ST_PERMANENT || space->spaceType == ST_CODE); POLYUNSIGNED lengthWord = obj->LengthWord(); POLYUNSIGNED words = OBJ_OBJECT_LENGTH(lengthWord); PolyObject *newObj = 0; bool isMutableObj = obj->IsMutable(); bool isNoOverwrite = false; bool isByteObj = false; bool isCodeObj = false; if (isMutableObj) { isNoOverwrite = obj->IsNoOverwriteObject(); isByteObj = obj->IsByteObject(); } else isCodeObj = obj->IsCodeObject(); // Allocate a new address for the object. for (std::vector::iterator i = gMem.eSpaces.begin(); i < gMem.eSpaces.end(); i++) { PermanentMemSpace *space = *i; if (isMutableObj == space->isMutable && isNoOverwrite == space->noOverwrite && isByteObj == space->byteOnly && isCodeObj == space->isCode) { ASSERT(space->topPointer <= space->top && space->topPointer >= space->bottom); size_t spaceLeft = space->top - space->topPointer; if (spaceLeft > words) { newObj = (PolyObject*)(space->topPointer + 1); space->topPointer += words + 1; #ifdef POLYML32IN64 // Maintain the odd-word alignment of topPointer if ((words & 1) == 0 && space->topPointer < space->top) { *space->topPointer = PolyWord::FromUnsigned(0); space->topPointer++; } #endif break; } } } if (newObj == 0) { // Didn't find room in the existing spaces. Create a new space. uintptr_t spaceWords; if (isMutableObj) { if (isNoOverwrite) spaceWords = defaultNoOverSize; else spaceWords = defaultMutSize; } else { if (isCodeObj) spaceWords = defaultCodeSize; else spaceWords = defaultImmSize; } if (spaceWords <= words) spaceWords = words + 1; // Make sure there's space for this object. PermanentMemSpace *space = gMem.NewExportSpace(spaceWords, isMutableObj, isNoOverwrite, isCodeObj); if (isByteObj) space->byteOnly = true; if (space == 0) { if (debugOptions & DEBUG_SAVING) Log("SAVE: Unable to allocate export space, size: %lu.\n", spaceWords); // Unable to allocate this. throw MemoryException(); } newObj = (PolyObject*)(space->topPointer + 1); space->topPointer += words + 1; #ifdef POLYML32IN64 // Maintain the odd-word alignment of topPointer if ((words & 1) == 0 && space->topPointer < space->top) { *space->topPointer = PolyWord::FromUnsigned(0); space->topPointer++; } #endif ASSERT(space->topPointer <= space->top && space->topPointer >= space->bottom); } newObj->SetLengthWord(lengthWord); // copy length word memcpy(newObj, obj, words * sizeof(PolyWord)); if (space->spaceType == ST_PERMANENT && !space->isMutable && ((PermanentMemSpace*)space)->hierarchy == 0) { // The immutable permanent areas are read-only. unsigned m; for (m = 0; m < tombs; m++) { GraveYard *g = &graveYard[m]; if ((PolyWord*)obj >= g->startAddr && (PolyWord*)obj < g->endAddr) { PolyWord *tombAddr = g->graves + ((PolyWord*)obj - g->startAddr); PolyObject *tombObject = (PolyObject*)tombAddr; #ifdef POLYML32IN64 if (isCodeObj) { POLYUNSIGNED ll = (POLYUNSIGNED)(((PolyWord*)newObj - globalCodeBase) >> 1 | _OBJ_TOMBSTONE_BIT); tombObject->SetLengthWord(ll); } else tombObject->SetForwardingPtr(newObj); #else tombObject->SetForwardingPtr(newObj); #endif break; // No need to look further } } ASSERT(m < tombs); // Should be there. } #ifdef POLYML32IN64 // If this is a code address we can't use the usual forwarding pointer format. // Instead we have to compute the offset relative to the base of the code. else if (isCodeObj) { POLYUNSIGNED ll = (POLYUNSIGNED)(((PolyWord*)newObj-globalCodeBase) >> 1 | _OBJ_TOMBSTONE_BIT); obj->SetLengthWord(ll); } #endif else obj->SetForwardingPtr(newObj); // Put forwarding pointer in old object. if (OBJ_IS_CODE_OBJECT(lengthWord)) { // We don't need to worry about flushing the instruction cache // since we're not going to execute this code here. // We do have to update any relative addresses within the code // to take account of its new position. We have to do that now // even though ScanAddressesInObject will do it again because this // is the only point where we have both the old and the new addresses. machineDependent->ScanConstantsWithinCode(newObj, obj, words, this); } *pt = newObj; // Update it to the newly copied object. return lengthWord; // This new object needs to be scanned. } // The address of code in the code area. We treat this as a normal heap cell. // We will probably need to copy this and to process addresses within it. POLYUNSIGNED CopyScan::ScanCodeAddressAt(PolyObject **pt) { POLYUNSIGNED lengthWord = ScanAddress(pt); if (lengthWord) ScanAddressesInObject(*pt, lengthWord); return 0; } PolyObject *CopyScan::ScanObjectAddress(PolyObject *base) { PolyWord val = base; // Scan this as an address. POLYUNSIGNED lengthWord = CopyScan::ScanAddressAt(&val); if (lengthWord) ScanAddressesInObject(val.AsObjPtr(), lengthWord); return val.AsObjPtr(); } #define MAX_EXTENSION 4 // The longest extension we may need to add is ".obj" // Convert the forwarding pointers in a region back into length words. // Generally if this object has a forwarding pointer that's // because we've moved it into the export region. We can, // though, get multiple levels of forwarding if there is an object // that has been shifted up by a garbage collection, leaving a forwarding // pointer and then that object has been moved to the export region. // We mustn't turn locally forwarded values back into ordinary objects // because they could contain addresses that are no longer valid. static POLYUNSIGNED GetObjLength(PolyObject *obj) { if (obj->ContainsForwardingPtr()) { PolyObject *forwardedTo; #ifdef POLYML32IN64 { MemSpace *space = gMem.SpaceForAddress((PolyWord*)obj - 1); if (space->isCode) forwardedTo = (PolyObject*)(globalCodeBase + ((obj->LengthWord() & ~_OBJ_TOMBSTONE_BIT) << 1)); else forwardedTo = obj->GetForwardingPtr(); } #else forwardedTo = obj->GetForwardingPtr(); #endif POLYUNSIGNED length = GetObjLength(forwardedTo); MemSpace *space = gMem.SpaceForAddress((PolyWord*)forwardedTo-1); if (space->spaceType == ST_EXPORT) obj->SetLengthWord(length); return length; } else { ASSERT(obj->ContainsNormalLengthWord()); return obj->LengthWord(); } } static void FixForwarding(PolyWord *pt, size_t space) { while (space) { pt++; PolyObject *obj = (PolyObject*)pt; #ifdef POLYML32IN64 if ((uintptr_t)obj & 4) { // Skip filler words needed to align to an even word space--; continue; // We've added 1 to pt so just loop. } #endif size_t length = OBJ_OBJECT_LENGTH(GetObjLength(obj)); pt += length; ASSERT(space > length); space -= length+1; } } class ExportRequest: public MainThreadRequest { public: ExportRequest(Handle root, Exporter *exp): MainThreadRequest(MTP_EXPORTING), exportRoot(root), exporter(exp) {} virtual void Perform() { exporter->RunExport(exportRoot->WordP()); } Handle exportRoot; Exporter *exporter; }; static void exporter(TaskData *taskData, Handle fileName, Handle root, const TCHAR *extension, Exporter *exports) { size_t extLen = _tcslen(extension); TempString fileNameBuff(Poly_string_to_T_alloc(fileName->Word(), extLen)); if (fileNameBuff == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); size_t length = _tcslen(fileNameBuff); // Does it already have the extension? If not add it on. if (length < extLen || _tcscmp(fileNameBuff + length - extLen, extension) != 0) _tcscat(fileNameBuff, extension); #if (defined(_WIN32) && defined(UNICODE)) exports->exportFile = _wfopen(fileNameBuff, L"wb"); #else exports->exportFile = fopen(fileNameBuff, "wb"); #endif if (exports->exportFile == NULL) raise_syscall(taskData, "Cannot open export file", ERRORNUMBER); // Request a full GC to reduce the size of fix-ups. FullGC(taskData); // Request the main thread to do the export. ExportRequest request(root, exports); processes->MakeRootRequest(taskData, &request); if (exports->errorMessage) raise_fail(taskData, exports->errorMessage); } // This is called by the initial thread to actually do the export. void Exporter::RunExport(PolyObject *rootFunction) { Exporter *exports = this; PolyObject *copiedRoot = 0; CopyScan copyScan(hierarchy); try { copyScan.initialise(); // Copy the root and everything reachable from it into the temporary area. copiedRoot = copyScan.ScanObjectAddress(rootFunction); } catch (MemoryException &) { // If we ran out of memory. copiedRoot = 0; } // Fix the forwarding pointers. for (std::vector::iterator i = gMem.lSpaces.begin(); i < gMem.lSpaces.end(); i++) { LocalMemSpace *space = *i; // Local areas only have objects from the allocation pointer to the top. FixForwarding(space->bottom, space->lowerAllocPtr - space->bottom); FixForwarding(space->upperAllocPtr, space->top - space->upperAllocPtr); } for (std::vector::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) { MemSpace *space = *i; // Permanent areas are filled with objects from the bottom. FixForwarding(space->bottom, space->top - space->bottom); } for (std::vector::iterator i = gMem.cSpaces.begin(); i < gMem.cSpaces.end(); i++) { MemSpace *space = *i; // Code areas are filled with objects from the bottom. FixForwarding(space->bottom, space->top - space->bottom); } // Reraise the exception after cleaning up the forwarding pointers. if (copiedRoot == 0) { exports->errorMessage = "Insufficient Memory"; return; } // Copy the areas into the export object. size_t tableEntries = gMem.eSpaces.size(); unsigned memEntry = 0; if (hierarchy != 0) tableEntries += gMem.pSpaces.size(); exports->memTable = new memoryTableEntry[tableEntries]; // If we're constructing a module we need to include the global spaces. if (hierarchy != 0) { // Permanent spaces from the executable. for (std::vector::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) { PermanentMemSpace *space = *i; if (space->hierarchy < hierarchy) { memoryTableEntry *entry = &exports->memTable[memEntry++]; entry->mtOriginalAddr = entry->mtCurrentAddr = space->bottom; entry->mtLength = (space->topPointer-space->bottom)*sizeof(PolyWord); entry->mtIndex = space->index; entry->mtFlags = 0; if (space->isMutable) entry->mtFlags |= MTF_WRITEABLE; if (space->isCode) entry->mtFlags |= MTF_EXECUTABLE; } } newAreas = memEntry; } for (std::vector::iterator i = gMem.eSpaces.begin(); i < gMem.eSpaces.end(); i++) { memoryTableEntry *entry = &exports->memTable[memEntry++]; PermanentMemSpace *space = *i; entry->mtOriginalAddr = entry->mtCurrentAddr = space->bottom; entry->mtLength = (space->topPointer-space->bottom)*sizeof(PolyWord); entry->mtIndex = hierarchy == 0 ? memEntry-1 : space->index; entry->mtFlags = 0; if (space->isMutable) { entry->mtFlags = MTF_WRITEABLE; if (space->noOverwrite) entry->mtFlags |= MTF_NO_OVERWRITE; } if (space->isCode) entry->mtFlags |= MTF_EXECUTABLE; if (space->byteOnly) entry->mtFlags |= MTF_BYTES; } ASSERT(memEntry == tableEntries); exports->memTableEntries = memEntry; exports->rootFunction = copiedRoot; try { // This can raise MemoryException at least in PExport::exportStore. exports->exportStore(); } catch (MemoryException &) { exports->errorMessage = "Insufficient Memory"; } } // Functions called via the RTS call. Handle exportNative(TaskData *taskData, Handle args) { #ifdef HAVE_PECOFF // Windows including Cygwin -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) const TCHAR *extension = _T(".obj"); // Windows #else const char *extension = ".o"; // Cygwin #endif PECOFFExport exports; exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), taskData->saveVec.push(args->WordP()->Get(1)), extension, &exports); #elif defined(HAVE_ELF_H) || defined(HAVE_ELF_ABI_H) // Most Unix including Linux, FreeBSD and Solaris. const char *extension = ".o"; ELFExport exports; exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), taskData->saveVec.push(args->WordP()->Get(1)), extension, &exports); #elif defined(HAVE_MACH_O_RELOC_H) // Mac OS-X const char *extension = ".o"; MachoExport exports; exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), taskData->saveVec.push(args->WordP()->Get(1)), extension, &exports); #else raise_exception_string (taskData, EXC_Fail, "Native export not available for this platform"); #endif return taskData->saveVec.push(TAGGED(0)); } Handle exportPortable(TaskData *taskData, Handle args) { PExport exports; exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), taskData->saveVec.push(args->WordP()->Get(1)), _T(".txt"), &exports); return taskData->saveVec.push(TAGGED(0)); } POLYUNSIGNED PolyExport(PolyObject *threadId, PolyWord fileName, PolyWord root) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedName = taskData->saveVec.push(fileName); Handle pushedRoot = taskData->saveVec.push(root); try { #ifdef HAVE_PECOFF // Windows including Cygwin -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) const TCHAR *extension = _T(".obj"); // Windows #else const char *extension = ".o"; // Cygwin #endif PECOFFExport exports; exporter(taskData, pushedName, pushedRoot, extension, &exports); #elif defined(HAVE_ELF_H) || defined(HAVE_ELF_ABI_H) // Most Unix including Linux, FreeBSD and Solaris. const char *extension = ".o"; ELFExport exports; exporter(taskData, pushedName, pushedRoot, extension, &exports); #elif defined(HAVE_MACH_O_RELOC_H) // Mac OS-X const char *extension = ".o"; MachoExport exports; exporter(taskData, pushedName, pushedRoot, extension, &exports); #else raise_exception_string (taskData, EXC_Fail, "Native export not available for this platform"); #endif } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); // Returns unit } POLYUNSIGNED PolyExportPortable(PolyObject *threadId, PolyWord fileName, PolyWord root) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedName = taskData->saveVec.push(fileName); Handle pushedRoot = taskData->saveVec.push(root); try { PExport exports; exporter(taskData, pushedName, pushedRoot, _T(".txt"), &exports); } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); // Returns unit } // Helper functions for exporting. We need to produce relocation information // and this code is common to every method. Exporter::Exporter(unsigned int h): exportFile(NULL), errorMessage(0), hierarchy(h), memTable(0), newAreas(0) { } Exporter::~Exporter() { delete[](memTable); if (exportFile) fclose(exportFile); } void Exporter::relocateValue(PolyWord *pt) { #ifndef POLYML32IN64 PolyWord q = *pt; if (IS_INT(q) || q == PolyWord::FromUnsigned(0)) {} else createRelocation(pt); #endif } // Check through the areas to see where the address is. It must be // in one of them. unsigned Exporter::findArea(void *p) { for (unsigned i = 0; i < memTableEntries; i++) { if (p > memTable[i].mtOriginalAddr && p <= (char*)memTable[i].mtOriginalAddr + memTable[i].mtLength) return i; } { ASSERT(0); } return 0; } void Exporter::relocateObject(PolyObject *p) { if (p->IsByteObject()) { if (p->IsMutable() && p->IsWeakRefObject()) { // Weak mutable byte refs are used for external references and // also in the FFI for non-persistent values. bool isFuncPtr = true; const char *entryName = getEntryPointName(p, &isFuncPtr); if (entryName != 0) addExternalReference(p, entryName, isFuncPtr); // Clear the first word of the data. ASSERT(p->Length() >= sizeof(uintptr_t)/sizeof(PolyWord)); *(uintptr_t*)p = 0; } } else if (p->IsCodeObject()) { POLYUNSIGNED constCount; PolyWord *cp; ASSERT(! p->IsMutable() ); p->GetConstSegmentForCode(cp, constCount); /* Now the constants. */ for (POLYUNSIGNED i = 0; i < constCount; i++) relocateValue(&(cp[i])); } else if (p->IsClosureObject()) { #ifndef POLYML32IN64 ASSERT(0); #endif // This should only be used in 32-in-64 where we don't use relocations. } else /* Ordinary objects, essentially tuples. */ { POLYUNSIGNED length = p->Length(); for (POLYUNSIGNED i = 0; i < length; i++) relocateValue(p->Offset(i)); } } ExportStringTable::ExportStringTable(): strings(0), stringSize(0), stringAvailable(0) { } ExportStringTable::~ExportStringTable() { free(strings); } // Add a string to the string table, growing it if necessary. unsigned long ExportStringTable::makeEntry(const char *str) { unsigned len = (unsigned)strlen(str); unsigned long entry = stringSize; if (stringSize + len + 1 > stringAvailable) { stringAvailable = stringAvailable+stringAvailable/2; if (stringAvailable < stringSize + len + 1) stringAvailable = stringSize + len + 1 + 500; strings = (char*)realloc(strings, stringAvailable); if (strings == 0) { if (debugOptions & DEBUG_SAVING) Log("SAVE: Unable to realloc string table, size: %lu.\n", stringAvailable); throw MemoryException(); } } strcpy(strings + stringSize, str); stringSize += len + 1; return entry; } struct _entrypts exporterEPT[] = { { "PolyExport", (polyRTSFunction)&PolyExport}, { "PolyExportPortable", (polyRTSFunction)&PolyExportPortable}, { NULL, NULL} // End of list. }; diff --git a/libpolyml/gctaskfarm.cpp b/libpolyml/gctaskfarm.cpp index bb9c5715..fc98d743 100644 --- a/libpolyml/gctaskfarm.cpp +++ b/libpolyml/gctaskfarm.cpp @@ -1,279 +1,273 @@ /* Title: Task farm for Multi-Threaded Garbage Collector - Copyright (c) 2010 David C. J. Matthews + Copyright (c) 2010, 2019 David C. J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_MALLOC_H #include #endif #ifdef HAVE_SYS_TIME_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif #include "gctaskfarm.h" #include "diagnostics.h" #include "timing.h" static GCTaskId gTask; GCTaskId *globalTask = &gTask; GCTaskFarm::GCTaskFarm(): workLock("GC task farm work") { queueSize = queueIn = queuedItems = 0; workQueue = 0; terminate = false; threadCount = activeThreadCount = 0; -#if (defined(HAVE_PTHREAD_H) || defined(HAVE_WINDOWS_H)) threadHandles = 0; -#endif } GCTaskFarm::~GCTaskFarm() { Terminate(); free(workQueue); -#if (defined(HAVE_PTHREAD_H) || defined(HAVE_WINDOWS_H)) free(threadHandles); -#endif } bool GCTaskFarm::Initialise(unsigned thrdCount, unsigned qSize) { terminate = false; if (!waitForWork.Init(0, thrdCount)) return false; workQueue = (queue_entry*)calloc(qSize, sizeof(queue_entry)); if (workQueue == 0) return false; -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_PTHREAD_H)) +#if (!defined(_WIN32)) queueSize = qSize; threadHandles = (pthread_t*)calloc(thrdCount, sizeof(pthread_t)); if (threadHandles == 0) return false; -#elif defined(HAVE_WINDOWS_H) +#else queueSize = qSize; threadHandles = (HANDLE*)calloc(thrdCount, sizeof(HANDLE)); if (threadHandles == 0) return false; -#else - queueSize = 0; #endif // Create the worker threads. for (unsigned i = 0; i < thrdCount; i++) { // Fork a thread -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_PTHREAD_H)) +#if (!defined(_WIN32)) // Create a thread that isn't joinable since we don't want to wait // for it to finish. pthread_t pthreadId; bool isError = pthread_create(&pthreadId, NULL, WorkerThreadFunction, this) != 0; if (isError) break; threadHandles[threadCount++] = pthreadId; -#elif defined(HAVE_WINDOWS_H) +#else DWORD dwThrdId; // Have to provide this although we don't use it. HANDLE threadHandle = CreateThread(NULL, 0, WorkerThreadFunction, this, 0, &dwThrdId); if (threadHandle == NULL) break; threadHandles[threadCount++] = threadHandle; #endif } return true; } void GCTaskFarm::Terminate() { terminate = true; // Increment the semaphore by the number of threads to release them all. for (unsigned i = 0; i < threadCount; i++) waitForWork.Signal(); // Wait for the threads to terminate. -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_PTHREAD_H)) +#if (!defined(_WIN32)) for (unsigned j = 0; j < threadCount; j++) pthread_join(threadHandles[j], NULL); -#elif defined(HAVE_WINDOWS_H) +#else if (threadCount != 0) WaitForMultipleObjects(threadCount, threadHandles, TRUE, 10000); #endif } // Add work to the queue. Returns true if it succeeds. bool GCTaskFarm::AddWork(gctask work, void *arg1, void *arg2) { bool wantSignal = false; { PLocker l(&workLock); - if (queuedItems == queueSize) return false; // Queue is full + if (queuedItems == queueSize) + return false; // Queue is full workQueue[queueIn].task = work; workQueue[queueIn].arg1 = arg1; workQueue[queueIn].arg2 = arg2; queueIn++; if (queueIn == queueSize) queueIn = 0; queuedItems++; wantSignal = queuedItems <= threadCount; } if (wantSignal) waitForWork.Signal(); return true; } // Schedule this as a task or run it immediately if the queue is full. void GCTaskFarm::AddWorkOrRunNow(gctask work, void *arg1, void *arg2) { if (! AddWork(work, arg1, arg2)) (*work)(globalTask, arg1, arg2); } void GCTaskFarm::ThreadFunction() { GCTaskId myTaskId; -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) DWORD startActive = GetTickCount(); #else struct timeval startTime; gettimeofday(&startTime, NULL); #endif workLock.Lock(); activeThreadCount++; while (! terminate) { // Invariant: We have the lock and the activeThreadCount includes this thread. // Find some work. if (queuedItems > 0) { // There is work unsigned outPos; if (queuedItems > queueIn) outPos = queueIn+queueSize-queuedItems; else outPos = queueIn-queuedItems; gctask work = workQueue[outPos].task; void *arg1 = workQueue[outPos].arg1; void *arg2 = workQueue[outPos].arg2; workQueue[outPos].task = 0; queuedItems--; ASSERT(work != 0); workLock.Unlock(); (*work)(&myTaskId, arg1, arg2); workLock.Lock(); } else { activeThreadCount--; // We're no longer active // If there is no work and we're the last active thread signal the // main thread that the queue is empty bool wantSignal = activeThreadCount == 0; if (wantSignal) waitForCompletion.Signal(); // Now release the lock. In our Windows partial implementation of // condition vars we assume that signalling is done with the lock // still held. workLock.Unlock(); if (debugOptions & DEBUG_GCTASKS) { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) Log("GCTask: Thread %p blocking after %u milliseconds\n", &myTaskId, GetTickCount() - startActive); #else struct timeval endTime; gettimeofday(&endTime, NULL); subTimevals(&endTime, &startTime); Log("GCTask: Thread %p blocking after %0.4f seconds\n", &myTaskId, (float)endTime.tv_sec + (float)endTime.tv_usec / 1.0E6); #endif } if (terminate) return; // Block until there's work. waitForWork.Wait(); // We've been woken up if (debugOptions & DEBUG_GCTASKS) { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) startActive = GetTickCount(); #else gettimeofday(&startTime, NULL); #endif Log("GCTask: Thread %p resuming\n", &myTaskId); } workLock.Lock(); activeThreadCount++; } } activeThreadCount--; workLock.Unlock(); } -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_PTHREAD_H)) +#if (!defined(_WIN32)) void *GCTaskFarm::WorkerThreadFunction(void *parameter) { GCTaskFarm *t = (GCTaskFarm *)parameter; t->ThreadFunction(); return 0; } -#elif defined(HAVE_WINDOWS_H) +#else DWORD WINAPI GCTaskFarm::WorkerThreadFunction(void *parameter) { GCTaskFarm *t = (GCTaskFarm *)parameter; t->ThreadFunction(); return 0; } #endif // Wait until the queue is empty. void GCTaskFarm::WaitForCompletion(void) { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) DWORD startWait; if (debugOptions & DEBUG_GCTASKS) startWait = GetTickCount(); #else struct timeval startWait; if (debugOptions & DEBUG_GCTASKS) gettimeofday(&startWait, NULL); #endif workLock.Lock(); while (activeThreadCount > 0 || queuedItems > 0) waitForCompletion.Wait(&workLock); workLock.Unlock(); if (debugOptions & DEBUG_GCTASKS) { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) Log("GCTask: Threads completed after %u milliseconds\n", GetTickCount()-startWait); #else struct timeval endWait; gettimeofday(&endWait, NULL); subTimevals(&endWait, &startWait); Log("GCTask: Threads completed after %0.4f seconds\n", (float)endWait.tv_sec + (float)endWait.tv_usec / 1.0E6); #endif } } diff --git a/libpolyml/gctaskfarm.h b/libpolyml/gctaskfarm.h index 473e4d6c..6d596ac4 100644 --- a/libpolyml/gctaskfarm.h +++ b/libpolyml/gctaskfarm.h @@ -1,90 +1,90 @@ /* Title: Task farm for Multi-Threaded Garbage Collector - Copyright (c) 2010-12 David C. J. Matthews + Copyright (c) 2010-12, 2019 David C. J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef GCTASKFARM_H_INCLUDED #define GCTASKFARM_H_INCLUDED #include "locking.h" // An empty class just used as an ID. class GCTaskId { }; extern GCTaskId *globalTask; // The ID used when a function is run immediately // Function for action. The usual C++ approach would be to use an // object pointer but that requires lots of small objects to be created // and deleted. typedef void (*gctask)(GCTaskId*, void*, void*); typedef struct { gctask task; void *arg1; void *arg2; } queue_entry; class GCTaskFarm { public: GCTaskFarm(); ~GCTaskFarm(); bool Initialise(unsigned threadCount, unsigned queueSize); bool AddWork(gctask task, void *arg1, void *arg2); void AddWorkOrRunNow(gctask task, void *arg1, void *arg2); void WaitForCompletion(void); void Terminate(void); // See if the queue is draining. Used as a hint as to whether // it's worth sparking off some new work. bool Draining(void) const { return queuedItems == 0; } unsigned ThreadCount(void) const { return threadCount; } private: // The semaphore is zero if there is no work or some value up to // the number of threads if there is work. PSemaphore waitForWork; // The lock protects the queue and the item count. PLock workLock; // The condition variable is signalled when the queue is empty. // This can only be waited for by a single thread because it's not a proper // implementation of a condition variable in Windows. PCondVar waitForCompletion; unsigned queueSize, queueIn, queuedItems; queue_entry *workQueue; // Array of unit->unit functions. bool terminate; // Set to true to kill all workers. unsigned threadCount; // Count of workers. unsigned activeThreadCount; // Count of workers doing work. void ThreadFunction(void); -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_PTHREAD_H)) +#if (!defined(_WIN32)) static void *WorkerThreadFunction(void *parameter); pthread_t *threadHandles; -#elif defined(HAVE_WINDOWS_H) +#else static DWORD WINAPI WorkerThreadFunction(void *parameter); HANDLE *threadHandles; #endif }; #endif diff --git a/libpolyml/globals.h b/libpolyml/globals.h index 4c05c19f..c323a731 100644 --- a/libpolyml/globals.h +++ b/libpolyml/globals.h @@ -1,415 +1,415 @@ /* Title: Globals for the system. Author: Dave Matthews, Cambridge University Computer Laboratory - Copyright David C. J. Matthews 2017-18 + Copyright David C. J. Matthews 2017-19 Copyright (c) 2000-7 Cambridge University Technical Services Limited Further work copyright David C.J. Matthews 2006-18 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef _GLOBALS_H #define _GLOBALS_H /* Poly words, pointers and cells (objects). The garbage collector needs to be able to distinguish different uses of a memory word. We need to be able find which words are pointers to other objects and which are simple integers. The simple distinction is between integers, which are tagged by having the bottom bit set, and Addresses which are word aligned (bottom 2 bits zero on a 32 bit machine, bottom 3 bits on a 64 bit machine, bottom bit in 32-in-64). Addresses always point to the start of cells. The preceding word of a cell is the length word. This contains the length of the cell in words in the low-order 3 (7 in native 64-bits) bytes and a flag byte in the top byte. The flags give information about the type of the object. The length word is also used by the garbage collector and other object processors. */ #if HAVE_STDINT_H # include #endif #if HAVE_INTTYPES_H # ifndef __STDC_FORMAT_MACROS # define __STDC_FORMAT_MACROS # endif # include #elif (defined(_MSC_VER) && (_MSC_VER >= 1900)) // In VS 2015 and later we need to use # include #endif #ifdef HAVE_STDDEF_H # include #endif #define POLY_TAGSHIFT 1 -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) # include #endif #ifdef POLYML32IN64 typedef int32_t POLYSIGNED; typedef uint32_t POLYUNSIGNED; #define SIZEOF_POLYWORD 4 #else typedef intptr_t POLYSIGNED; typedef uintptr_t POLYUNSIGNED; #define SIZEOF_POLYWORD SIZEOF_VOIDP #endif // libpolyml uses printf-style I/O instead of C++ standard IOstreams, // so we need specifier to format POLYUNSIGNED/POLYSIGNED values. #ifdef POLYML32IN64 #if (defined(PRIu32)) # define POLYUFMT PRIu32 # define POLYSFMT PRId32 #elif (defined(_MSC_VER)) # define POLYUFMT "lu" # define POLYSFMT "ld" #else # define POLYUFMT "u" # define POLYSFMT "d" #endif #elif (defined(PRIuPTR)) # define POLYUFMT PRIuPTR # define POLYSFMT PRIdPTR #elif (defined(_MSC_VER) && (SIZEOF_POLYWORD == 8)) # define POLYUFMT "llu" # define POLYSFMT "lld" #else # define POLYUFMT "lu" // as before. Cross your fingers. # define POLYSFMT "ld" // idem. #endif // We can use the C99 %zu in most cases except MingW since it uses // the old msvcrt and that only supports C89. -#if (defined(_WIN32) && ! defined(__CYGWIN__) && (! defined(_MSC_VER) || _MSC_VER < 1800)) +#if (defined(_WIN32) && (! defined(_MSC_VER) || _MSC_VER < 1800)) # if (SIZEOF_VOIDP == 8) # define PRI_SIZET PRIu64 # else # define PRI_SIZET PRIu32 # endif #else # define PRI_SIZET "zu" #endif typedef unsigned char byte; class PolyObject; typedef PolyObject *POLYOBJPTR; #ifdef POLYML32IN64 class PolyWord; extern PolyWord *globalHeapBase, *globalCodeBase; typedef uint32_t POLYOBJECTPTR; // This is an index into globalHeapBase // If a 64-bit value if in the range of the object pointers. inline bool IsHeapAddress(void *addr) { return (uintptr_t)addr <= 0xffffffff; } #else typedef POLYOBJPTR POLYOBJECTPTR; inline bool IsHeapAddress(void *) { return true; } #endif typedef byte *POLYCODEPTR; class PolyWord { public: // Initialise to TAGGED(0). This is very rarely used. PolyWord() { contents.unsignedInt = 1; } // Integers need to be tagged. static PolyWord TaggedInt(POLYSIGNED s) { return PolyWord((s << POLY_TAGSHIFT) | (POLYSIGNED)0x01); } static PolyWord TaggedUnsigned(POLYUNSIGNED u) { return PolyWord((u << POLY_TAGSHIFT) | 0x01); } static PolyWord FromStackAddr(PolyWord *sp) { return PolyWord(sp); } static PolyWord FromCodePtr(POLYCODEPTR p) { return PolyWord(p); } // Tests for the various cases. bool IsTagged(void) const { return (contents.unsignedInt & 1) != 0; } #ifndef POLYML32IN64 // In native 32-bit and 64-bit addresses are on word boundaries bool IsDataPtr(void) const { return (contents.unsignedInt & (sizeof(PolyWord) - 1)) == 0; } #else // In 32-in-64 addresses are anything that isn't tagged. bool IsDataPtr(void) const { return (contents.unsignedInt & 1) == 0; } #ifdef POLYML32IN64DEBUG static POLYOBJECTPTR AddressToObjectPtr(void *address); #else static POLYOBJECTPTR AddressToObjectPtr(void *address) { return (POLYOBJECTPTR)((PolyWord*)address - globalHeapBase); } #endif #endif // Extract the various cases. POLYSIGNED UnTagged(void) const { return contents.signedInt >> POLY_TAGSHIFT; } POLYUNSIGNED UnTaggedUnsigned(void) const { return contents.unsignedInt >> POLY_TAGSHIFT; } #ifdef POLYML32IN64 PolyWord(POLYOBJPTR p) { contents.objectPtr = AddressToObjectPtr(p); } PolyWord *AsStackAddr(PolyWord *base = globalHeapBase) const { return base + contents.objectPtr; } POLYOBJPTR AsObjPtr(PolyWord *base = globalHeapBase) const { return (POLYOBJPTR)AsStackAddr(base); } #else // An object pointer can become a word directly. PolyWord(POLYOBJPTR p) { contents.objectPtr = p; } POLYOBJPTR AsObjPtr(PolyWord *base = 0) const { return contents.objectPtr; } PolyWord *AsStackAddr(PolyWord *base=0) const { return (PolyWord *)contents.objectPtr; } #endif POLYCODEPTR AsCodePtr(void) const { return (POLYCODEPTR)AsObjPtr(); } void *AsAddress(void)const { return AsCodePtr(); } // There are a few cases where we need to store and extract untagged values static PolyWord FromUnsigned(POLYUNSIGNED u) { return PolyWord(u); } static PolyWord FromSigned(POLYSIGNED s) { return PolyWord(s); } POLYUNSIGNED AsUnsigned(void) const { return contents.unsignedInt; } POLYSIGNED AsSigned(void) const { return contents.signedInt; } protected: PolyWord(POLYSIGNED s) { contents.signedInt = s; } PolyWord(POLYUNSIGNED u) { contents.unsignedInt = u; } public: bool operator == (PolyWord b) const { return contents.unsignedInt == b.contents.unsignedInt; } bool operator != (PolyWord b) const { return contents.unsignedInt != b.contents.unsignedInt; } protected: #ifdef POLYML32IN64 PolyWord(PolyWord *sp) { contents.objectPtr = AddressToObjectPtr(sp); } PolyWord(POLYCODEPTR p) { contents.objectPtr = AddressToObjectPtr(p); } #else PolyWord(PolyWord *sp) { contents.objectPtr = (PolyObject*)sp; } PolyWord(POLYCODEPTR p) { contents.objectPtr = (PolyObject*)p; } #endif union { POLYSIGNED signedInt; // A tagged integer - lowest bit set POLYUNSIGNED unsignedInt; // A tagged integer - lowest bit set POLYOBJECTPTR objectPtr; // Object pointer - lowest bit clear. } contents; }; //typedef PolyWord POLYWORD; inline bool OBJ_IS_AN_INTEGER(const PolyWord & a) { return a.IsTagged(); } inline bool OBJ_IS_DATAPTR(const PolyWord & a) { return a.IsDataPtr(); } // The maximum tagged signed number is one less than 0x80 shifted into the top byte then shifted down // by the tag shift. #define MAXTAGGED (((POLYSIGNED)0x80 << (POLYSIGNED)(8*(sizeof(PolyWord)-1) -POLY_TAGSHIFT)) -1) inline PolyWord TAGGED(POLYSIGNED a) { return PolyWord::TaggedInt(a); } inline POLYSIGNED UNTAGGED(PolyWord a) { return a.UnTagged(); } inline POLYUNSIGNED UNTAGGED_UNSIGNED(PolyWord a) { return a.UnTaggedUnsigned(); } #define IS_INT(x) ((x).IsTagged()) /* length word flags */ #define OBJ_PRIVATE_FLAGS_SHIFT (8 * (sizeof(PolyWord) - 1)) #define _TOP_BYTE(x) ((POLYUNSIGNED)(x) << OBJ_PRIVATE_FLAGS_SHIFT) // Bottom two bits define the content format. // Zero bits mean ordinary word object containing addresses or tagged integers. #define F_BYTE_OBJ 0x01 /* byte object (contains no pointers) */ #define F_CODE_OBJ 0x02 /* code object (mixed bytes and words) */ #define F_CLOSURE_OBJ 0x03 /* closure (32-in-64 only). First word is code addr. */ #define F_GC_MARK 0x04 // Used during the GC marking phase #define F_NO_OVERWRITE 0x08 /* don't overwrite when loading - mutables only. */ // This bit is overloaded and has different meanings depending on what other bits are set. // For byte objects it is the sign bit for arbitrary precision ints. // For other data it indicates either that the object is a profile block or contains // information for allocation profiling. #define F_NEGATIVE_BIT 0x10 // Sign bit for arbitrary precision ints (byte segs only) #define F_PROFILE_BIT 0x10 // Object has a profile pointer (word segs only) #define F_WEAK_BIT 0x20 /* object contains weak references to option values. */ // The Weak bit is only used on mutables. The data sharing (sharedata.cpp) uses this with // immutables to indicate that the length field is being used to store the "depth". #define F_MUTABLE_BIT 0x40 /* object is mutable */ #define F_TOMBSTONE_BIT 0x80 // Object is a forwarding pointer #define F_PRIVATE_FLAGS_MASK 0xFF // Shifted bits #define _OBJ_BYTE_OBJ _TOP_BYTE(F_BYTE_OBJ) /* byte object (contains no pointers) */ #define _OBJ_CODE_OBJ _TOP_BYTE(F_CODE_OBJ) /* code object (mixed bytes and words) */ #define _OBJ_CLOSURE_OBJ _TOP_BYTE(F_CLOSURE_OBJ) // closure (32-in-64 only). First word is code addr. #define _OBJ_GC_MARK _TOP_BYTE(F_GC_MARK) // Mark bit #define _OBJ_NO_OVERWRITE _TOP_BYTE(F_NO_OVERWRITE) /* don't overwrite when loading - mutables only. */ #define _OBJ_NEGATIVE_BIT _TOP_BYTE(F_NEGATIVE_BIT) /* sign bit for arbitrary precision ints */ #define _OBJ_PROFILE_BIT _TOP_BYTE(F_PROFILE_BIT) /* sign bit for arbitrary precision ints */ #define _OBJ_WEAK_BIT _TOP_BYTE(F_WEAK_BIT) #define _OBJ_MUTABLE_BIT _TOP_BYTE(F_MUTABLE_BIT) /* object is mutable */ #define _OBJ_TOMBSTONE_BIT _TOP_BYTE(F_TOMBSTONE_BIT) // object is a tombstone. #define _OBJ_PRIVATE_FLAGS_MASK _TOP_BYTE(F_PRIVATE_FLAGS_MASK) #define _OBJ_PRIVATE_LENGTH_MASK ((-1) ^ _OBJ_PRIVATE_FLAGS_MASK) #define MAX_OBJECT_SIZE _OBJ_PRIVATE_LENGTH_MASK // inline bool OBJ_IS_LENGTH(POLYUNSIGNED L) { return ((L & _OBJ_TOMBSTONE_BIT) == 0); } /* these should only be applied to proper length words */ /* discards GC flag, mutable bit and weak bit. */ inline byte GetTypeBits(POLYUNSIGNED L) { return (byte)(L >> OBJ_PRIVATE_FLAGS_SHIFT) & 0x03; } inline POLYUNSIGNED OBJ_OBJECT_LENGTH(POLYUNSIGNED L) { return L & _OBJ_PRIVATE_LENGTH_MASK; } inline bool OBJ_IS_BYTE_OBJECT(POLYUNSIGNED L) { return (GetTypeBits(L) == F_BYTE_OBJ); } inline bool OBJ_IS_CODE_OBJECT(POLYUNSIGNED L) { return (GetTypeBits(L) == F_CODE_OBJ); } inline bool OBJ_IS_CLOSURE_OBJECT(POLYUNSIGNED L) { return (GetTypeBits(L) == F_CLOSURE_OBJ); } inline bool OBJ_IS_NO_OVERWRITE(POLYUNSIGNED L) { return ((L & _OBJ_NO_OVERWRITE) != 0); } inline bool OBJ_IS_NEGATIVE(POLYUNSIGNED L) { return ((L & _OBJ_NEGATIVE_BIT) != 0); } inline bool OBJ_HAS_PROFILE(POLYUNSIGNED L) { return ((L & _OBJ_PROFILE_BIT) != 0); } inline bool OBJ_IS_MUTABLE_OBJECT(POLYUNSIGNED L) { return ((L & _OBJ_MUTABLE_BIT) != 0); } inline bool OBJ_IS_WEAKREF_OBJECT(POLYUNSIGNED L) { return ((L & _OBJ_WEAK_BIT) != 0); } /* Don't need to worry about whether shift is signed, because OBJ_PRIVATE_USER_FLAGS_MASK removes the sign bit. We don't want the GC bit (which should be 0) anyway. */ #define OBJ_PRIVATE_USER_FLAGS_MASK _TOP_BYTE(0x7F) #define OBJ_IS_WORD_OBJECT(L) (GetTypeBits(L) == 0) /* case 2 - forwarding pointer */ inline bool OBJ_IS_POINTER(POLYUNSIGNED L) { return (L & _OBJ_TOMBSTONE_BIT) != 0; } #ifdef POLYML32IN64 inline PolyObject *OBJ_GET_POINTER(POLYUNSIGNED L) { return (PolyObject*)(globalHeapBase + ((L & ~_OBJ_TOMBSTONE_BIT) << 1)); } inline POLYUNSIGNED OBJ_SET_POINTER(PolyObject *pt) { return PolyWord::AddressToObjectPtr(pt) >> 1 | _OBJ_TOMBSTONE_BIT; } #else inline PolyObject *OBJ_GET_POINTER(POLYUNSIGNED L) { return (PolyObject*)(( L & ~_OBJ_TOMBSTONE_BIT) <<2); } inline POLYUNSIGNED OBJ_SET_POINTER(PolyObject *pt) { return ((POLYUNSIGNED)pt >> 2) | _OBJ_TOMBSTONE_BIT; } #endif // An object i.e. a piece of allocated memory in the heap. In the simplest case this is a // tuple, a list cons cell, a string or a ref. Every object has a length word in the word before // where its address points. The top byte of this contains flags. class PolyObject { public: byte *AsBytePtr(void)const { return (byte*)this; } PolyWord *AsWordPtr(void)const { return (PolyWord*)this; } POLYUNSIGNED LengthWord(void)const { return ((PolyWord*)this)[-1].AsUnsigned(); } POLYUNSIGNED Length(void)const { return OBJ_OBJECT_LENGTH(LengthWord()); } // Get and set a word PolyWord Get(POLYUNSIGNED i) const { return ((PolyWord*)this)[i]; } void Set(POLYUNSIGNED i, PolyWord v) { ((PolyWord*)this)[i] = v; } PolyWord *Offset(POLYUNSIGNED i) const { return ((PolyWord*)this)+i; } // Create a length word from a length and the flags in the top byte. void SetLengthWord(POLYUNSIGNED l, byte f) { ((POLYUNSIGNED*)this)[-1] = l | ((POLYUNSIGNED)f << OBJ_PRIVATE_FLAGS_SHIFT); } void SetLengthWord(POLYUNSIGNED l) { ((PolyWord*)this)[-1] = PolyWord::FromUnsigned(l); } bool IsByteObject(void) const { return OBJ_IS_BYTE_OBJECT(LengthWord()); } bool IsCodeObject(void) const { return OBJ_IS_CODE_OBJECT(LengthWord()); } bool IsClosureObject(void) const { return OBJ_IS_CLOSURE_OBJECT(LengthWord()); } bool IsWordObject(void) const { return OBJ_IS_WORD_OBJECT(LengthWord()); } bool IsMutable(void) const { return OBJ_IS_MUTABLE_OBJECT(LengthWord()); } bool IsWeakRefObject(void) const { return OBJ_IS_WEAKREF_OBJECT(LengthWord()); } bool IsNoOverwriteObject(void) const { return OBJ_IS_NO_OVERWRITE(LengthWord()); } bool ContainsForwardingPtr(void) const { return OBJ_IS_POINTER(LengthWord()); } PolyObject *GetForwardingPtr(void) const { return OBJ_GET_POINTER(LengthWord()); } void SetForwardingPtr(PolyObject *newp) { ((PolyWord*)this)[-1] = PolyWord::FromUnsigned(OBJ_SET_POINTER(newp)); } bool ContainsNormalLengthWord(void) const { return OBJ_IS_LENGTH(LengthWord()); } // Find the start of the constant section for a piece of code. // The first of these is really only needed because we may have objects whose length // words have been overwritten. void GetConstSegmentForCode(POLYUNSIGNED obj_length, PolyWord * &cp, POLYUNSIGNED &count) const { PolyWord *last_word = Offset(obj_length - 1); // Last word in the code count = last_word->AsUnsigned(); // This is the number of consts cp = last_word - count; } void GetConstSegmentForCode(PolyWord * &cp, POLYUNSIGNED &count) const { GetConstSegmentForCode(Length(), cp, count); } PolyWord *ConstPtrForCode(void) const { PolyWord *cp; POLYUNSIGNED count; GetConstSegmentForCode(cp, count); return cp; } // Follow a chain of forwarding pointers PolyObject *FollowForwardingChain(void) { if (ContainsForwardingPtr()) return GetForwardingPtr()->FollowForwardingChain(); else return this; } }; /* There was a problem with version 2.95 on Sparc/Solaris at least. The PolyObject class has no members so classes derived from it e.g. ML_Cons_Cell should begin at the beginning of the object. Later versions of GCC get this right. */ #if defined(__GNUC__) && (__GNUC__ <= 2) #error Poly/ML requires GCC version 3 or newer #endif inline POLYUNSIGNED GetLengthWord(PolyWord p) { return p.AsObjPtr()->LengthWord(); } // Get the length of an object. inline POLYUNSIGNED OBJECT_LENGTH(PolyWord p) { return OBJ_OBJECT_LENGTH(GetLengthWord(p)); } // A list cell. This can be passed to or returned from certain RTS functions. class ML_Cons_Cell: public PolyObject { public: PolyWord h; PolyWord t; #define ListNull (TAGGED(0)) static bool IsNull(PolyWord p) { return p == ListNull; } }; /* An exception packet. This contains an identifier (either a tagged integer for RTS exceptions or the address of a mutable for those created within ML), a string name for printing and an exception argument value. */ class PolyException: public PolyObject { public: PolyWord ex_id; /* Exc identifier */ PolyWord ex_name;/* Exc name */ PolyWord arg; /* Exc arguments */ PolyWord ex_location; // Location of "raise". Always zero for RTS exceptions. }; typedef PolyException poly_exn; /* Macro to round a number of bytes up to a number of words. */ #define WORDS(s) ((s+sizeof(PolyWord)-1)/sizeof(PolyWord)) /********************************************************************** * * Representation of option type. * **********************************************************************/ #define NONE_VALUE (TAGGED(0)) /* SOME x is represented by a single word cell containing x. */ #if (defined(_WIN32)) /* Windows doesn't include 0x in %p format. */ #define ZERO_X "0x" #else #define ZERO_X "" #endif #endif diff --git a/libpolyml/heapsizing.cpp b/libpolyml/heapsizing.cpp index eb5e6fe6..5b7f0474 100644 --- a/libpolyml/heapsizing.cpp +++ b/libpolyml/heapsizing.cpp @@ -1,991 +1,991 @@ /* Title: heapsizing.cpp - parameters to adjust heap size Copyright (c) Copyright David C.J. Matthews 2012, 2015, 2017 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ /* This module is intended to deal with heap sizing based on measurements of the time taken in the GC compared with the application code. Currently it is very basic. This also provides GC timing information to the ML code as well as statistics and debugging. */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_WINDOWS_H #include #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_UNISTD_H #include // For sysconf #endif #ifdef HAVE_SYS_TYPES_H #include #endif #ifdef HAVE_SYS_SYSCTL_H #include #endif #ifdef HAVE_FLOAT_H #include #endif #ifdef HAVE_MATH_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif #include "globals.h" #include "arb.h" #include "diagnostics.h" #include "rts_module.h" #include "timing.h" #include "heapsizing.h" #include "statistics.h" #include "memmgr.h" // The one and only parameter object HeapSizeParameters gHeapSizeParameters; #ifdef HAVE_WINDOWS_H // There's no (documented) way to get the per-process hard page // count in Windows. Cygwin uses GetProcessMemoryInfo to return the // value in ru_majflt but this is actually incorrect because it returns // the soft page count not the hard page count. We previously used the // undocumented NtQuerySystemInformation call. static long GetPaging(long) { return 0; } #else inline long GetPaging(long rusagePage) { return rusagePage; } #endif HeapSizeParameters::HeapSizeParameters() { startPF = GetPaging(0); fullGCNextTime = false; performSharingPass = false; lastAllocationSucceeded = true; allocationFailedBeforeLastMajorGC = false; minHeapSize = 0; maxHeapSize = 0; // Unlimited lastFreeSpace = 0; pagingLimitSize = 0; highWaterMark = 0; sharingWordsRecovered = 0; cumulativeSharingSaving = 0; // Initial values until we've actually done a sharing pass. sharingRecoveryRate = 0.5; // The structure sharing recovers half the heap. sharingCostFactor = 2; // It doubles the cost } // These macros were originally in globals.h and used more generally. // Since only K_to_words is used now this can be greatly simplified. #define BITSPERWORD (sizeof(PolyWord)*8) #define ROUNDUP_UNITS(m,n) (((m) + (n) - 1) / (n)) #define ROUNDUP(m,n) (ROUNDUP_UNITS(m,n) * (n)) #define K_to_words(k) ROUNDUP((k) * (1024 / sizeof(PolyWord)),BITSPERWORD) // Returns physical memory size in bytes static size_t GetPhysicalMemorySize(void); // These are the maximum values for the number of words. #if (SIZEOF_VOIDP == 4) # define MAXIMUMADDRESS 0x3fffffff /* 4Gbytes as words */ #elif defined(POLYML32IN64) # define MAXIMUMADDRESS 0xffffffff /* 16Gbytes as words */ #else # define MAXIMUMADDRESS 0x1fffffffffffffff #endif // Set the initial size based on any parameters specified on the command line. // Any of these can be zero indicating they should default. void HeapSizeParameters::SetHeapParameters(uintptr_t minsize, uintptr_t maxsize, uintptr_t initialsize, unsigned percent) { minHeapSize = K_to_words(minsize); // If these overflow assume the result will be zero maxHeapSize = K_to_words(maxsize); uintptr_t initialSize = K_to_words(initialsize); uintptr_t memsize = GetPhysicalMemorySize() / sizeof(PolyWord); // If no maximum is given default it to 80% of the physical memory. // This allows some space for the OS and other things. // We now check maxsize so it should never exceed the maximum. if (maxHeapSize == 0 || maxHeapSize > MAXIMUMADDRESS) { if (memsize != 0) maxHeapSize = memsize - memsize / 5; else maxHeapSize = MAXIMUMADDRESS; // But if this must not be smaller than the minimum size. if (maxHeapSize < minHeapSize) maxHeapSize = minHeapSize; if (maxHeapSize < initialSize) maxHeapSize = initialSize; } // The default minimum is zero; in practice the live data size. // The default initial size is the minimum if that has been provided, // otherwise 8M words. There are applications that only require a small // heap and if we set the heap large to begin with we'll never do a // full GC and reduce it. if (initialSize == 0) { if (minHeapSize != 0) initialSize = minHeapSize; else initialSize = 8 * gMem.DefaultSpaceSize(); // But not more than the maximum if (initialSize > maxHeapSize) initialSize = maxHeapSize; } // Together with the constraints on user settings that ensures this holds. ASSERT(initialSize >= minHeapSize && initialSize <= maxHeapSize); // Initially we divide the space equally between the major and // minor heaps. That means that there will definitely be space // for the first minor GC to copy its data. This division can be // changed later on. gMem.SetSpaceForHeap(initialSize); gMem.SetSpaceBeforeMinorGC(initialSize/2); lastFreeSpace = initialSize; highWaterMark = initialSize; if (percent == 0) userGCRatio = 1.0 / 9.0; // Default to 10% GC to 90% application else userGCRatio = (float)percent / (float)(100 - percent); predictedRatio = lastMajorGCRatio = userGCRatio; if (debugOptions & DEBUG_HEAPSIZE) { Log("Heap: Initial settings: Initial heap "); LogSize(initialSize); Log(" minimum "); LogSize(minHeapSize); Log(" maximum "); LogSize(maxHeapSize); Log(" target ratio %f\n", userGCRatio); } } void HeapSizeParameters::SetReservation(uintptr_t rsize) { gMem.SetReservation(K_to_words(rsize)); } // Called in the minor GC if a GC thread needs to grow the heap. // Returns zero if the heap cannot be grown. "space" is the space required for the // object (and length field) in case this is larger than the default size. LocalMemSpace *HeapSizeParameters::AddSpaceInMinorGC(uintptr_t space, bool isMutable) { // See how much space is allocated to the major heap. uintptr_t spaceAllocated = gMem.CurrentHeapSize() - gMem.CurrentAllocSpace(); // The new segment is either the default size or as large as // necessary for the object. uintptr_t spaceSize = gMem.DefaultSpaceSize(); #ifdef POLYML32IN64 // When we allocate a space in NewLocalSpace we take one word to ensure // the that the first length word is on an odd-word boundary. // We need to add one here to ensure there is sufficient space to do that. // See AllocHeapSpace space++; #endif if (space > spaceSize) spaceSize = space; // We allow for extension if the total heap size after extending it // plus one allocation area of the default size would not be more // than the allowed heap size. if (spaceAllocated + spaceSize + gMem.DefaultSpaceSize() <= gMem.SpaceForHeap()) { LocalMemSpace *sp = gMem.NewLocalSpace(spaceSize, isMutable); // Return the space or zero if it failed // If this is the first time the allocation failed report it. if (sp == 0 && (debugOptions & DEBUG_HEAPSIZE) && lastAllocationSucceeded) { Log("Heap: Allocation of new heap segment size "); LogSize(spaceSize); Log(" failed. Limit reached?\n"); } lastAllocationSucceeded = sp != 0; return sp; } return 0; // Insufficient space } // Called in the major GC before the copy phase if the heap is more than // 90% full. This should improve the efficiency of copying. LocalMemSpace *HeapSizeParameters::AddSpaceBeforeCopyPhase(bool isMutable) { LocalMemSpace *sp = gMem.NewLocalSpace(gMem.DefaultSpaceSize(), isMutable); if (sp == 0 && (debugOptions & DEBUG_HEAPSIZE) && lastAllocationSucceeded) Log("Heap: Allocation of new heap segment failed. Limit reached?\n"); lastAllocationSucceeded = sp != 0; return sp; } // The steepness of the curve. #define PAGINGCOSTSTEEPNESS 20.0 // The additional cost at the boundary #define PAGINGCOSTFACTOR 3.0 // The number of pages at the boundary #define PAGINGCOUNTFACTOR 1000.0 // Called at the end of collection. This is where we should do the // fine adjustment of the heap size to minimise the GC time. // Growing the heap is just a matter of adjusting the limits. We // don't actually need to allocate the space here. // See also adjustHeapSizeAfterMinorGC for adjustments after a minor GC. void HeapSizeParameters::AdjustSizeAfterMajorGC(uintptr_t wordsRequired) { // Cumulative times since the last major GC TIMEDATA gc, nonGc; gc.add(majorGCSystemCPU); gc.add(majorGCUserCPU); nonGc.add(majorNonGCSystemCPU); nonGc.add(majorNonGCUserCPU); if (highWaterMark < heapSizeAtStart) highWaterMark = heapSizeAtStart; uintptr_t heapSpace = gMem.SpaceForHeap() < highWaterMark ? gMem.SpaceForHeap() : highWaterMark; currentSpaceUsed = wordsRequired; for (std::vector::iterator i = gMem.lSpaces.begin(); i < gMem.lSpaces.end(); i++) { currentSpaceUsed += (*i)->allocatedSpace(); } // N.B. Normally currentSpaceUsed will be less than the size of the heap // except if wordsRequired is very large. // The times for all the minor GCs up to this. The cost of this (major) GC // is actually in minorGCUserCPU/minorGCSystemCPU. TIMEDATA minorGC; minorGC.add(gc); minorGC.sub(minorGCUserCPU); minorGC.sub(minorGCSystemCPU); if (performSharingPass) { // We ran the sharing pass last time: calculate the actual recovery rate. uintptr_t originalSpaceUsed = currentSpaceUsed + sharingWordsRecovered; sharingRecoveryRate = (double)sharingWordsRecovered / (double)originalSpaceUsed; if (debugOptions & DEBUG_HEAPSIZE) Log("Heap: Sharing recovery rate was %0.3f and cost %0.3f seconds (%0.3f%% of total).\n", sharingRecoveryRate, sharingCPU.toSeconds(), sharingCPU.toSeconds() / gc.toSeconds()); // The cost factor is the ratio of the cost of sharing to the cost without. sharingCostFactor = sharingCPU.toSeconds() / (gc.toSeconds() - sharingCPU.toSeconds()); // Subtract the sharing cost from the GC cost because the initial estimate is // the cost without running the sharing pass. gc.sub(sharingCPU); } if (gc.toSeconds() != 0.0 && nonGc.toSeconds() != 0.0) lastMajorGCRatio = gc.toSeconds() / nonGc.toSeconds(); if (debugOptions & DEBUG_HEAPSIZE) { uintptr_t currentFreeSpace = currentSpaceUsed < heapSpace ? 0: heapSpace - currentSpaceUsed; Log("Heap: GC cpu time %2.3f non-gc time %2.3f ratio %0.3f for free space ", gc.toSeconds(), nonGc.toSeconds(), lastMajorGCRatio); LogSize((lastFreeSpace + currentFreeSpace)/2); Log("\n"); Log("Heap: GC real time %2.3f non-gc time %2.3f ratio %0.3f\n", majorGCReal.toSeconds(), majorNonGCReal.toSeconds(), majorGCReal.toSeconds()/majorNonGCReal.toSeconds()); Log("Heap: Total of minor GCs %2.3f, %2.3f of total\n", minorGC.toSeconds(), minorGC.toSeconds() / gc.toSeconds()); } // Calculate the paging threshold. if (pagingLimitSize != 0 || majorGCPageFaults != 0) { if (majorGCPageFaults == 0) majorGCPageFaults = 1; // Less than one // Some paging detected. The expression here is the inverse of the one used to // compute the paging contribution in the cost function. double scaleFactor = 1.0 + log((double)majorGCPageFaults / PAGINGCOUNTFACTOR) / PAGINGCOSTSTEEPNESS; ASSERT(scaleFactor > 0.0); POLYUNSIGNED newLimit = (POLYUNSIGNED)((double)heapSpace / scaleFactor); if (pagingLimitSize == 0) pagingLimitSize = newLimit; else pagingLimitSize = (newLimit + pagingLimitSize) / 2; } if (allocationFailedBeforeLastMajorGC) { // If the last allocation failed then we may well have reached the // maximum available memory. Set the paging limit to be the current // heap size. We want to avoid hitting the limit because typically // that happens when we try to extend the major heap in a minor GC // resulting in the minor GC failing and a major GC starting. if (pagingLimitSize == 0 || heapSizeAtStart < pagingLimitSize) pagingLimitSize = heapSizeAtStart; } if (pagingLimitSize != 0 && (debugOptions & DEBUG_HEAPSIZE)) { Log("Heap: Paging threshold adjusted to "); LogSize(pagingLimitSize); Log(" with %ld page faults\n", majorGCPageFaults); } // Calculate the new heap size and the predicted cost. uintptr_t newHeapSize; double cost; bool atTarget = getCostAndSize(newHeapSize, cost, false); // If we have been unable to allocate any more memory we may already // be at the limit. if (allocationFailedBeforeLastMajorGC && newHeapSize > heapSizeAtStart) { cost = costFunction(heapSizeAtStart, false, true); atTarget = false; } if (atTarget) { // We are at the target level. We don't want to attempt sharing. performSharingPass = false; cumulativeSharingSaving = 0; } else { uintptr_t newHeapSizeWithSharing; double costWithSharing; // Get the cost and heap size if sharing was enabled. If we are at the // limit, though, we need to work using the size we can achieve. if (! allocationFailedBeforeLastMajorGC) (void)getCostAndSize(newHeapSizeWithSharing, costWithSharing, true); else { newHeapSizeWithSharing = heapSizeAtStart; costWithSharing = costFunction(heapSizeAtStart, true, true); } // Run the sharing pass if that would give a lower cost. // Subtract the cumulative saving that would have been made if the // sharing had been run before. This is an estimate and depends on the // extent to which a reduction in the heap earlier would be carried through // to later GCs. cumulativeSharingSaving = cumulativeSharingSaving * ((double)currentSpaceUsed / (double)heapSpace); if (debugOptions & DEBUG_HEAPSIZE) Log("Heap: Cumulative sharing saving %0.2f\n", cumulativeSharingSaving); if (costWithSharing - cumulativeSharingSaving < cost) { // Run the sharing pass next time. performSharingPass = true; cumulativeSharingSaving = 0; } else { // Don't run the sharing pass next time performSharingPass = false; // Running a sharing pass reduces the heap for subsequent // runs. Add this into the cost. double freeSharingCost = costFunction(newHeapSizeWithSharing, true, false); if (freeSharingCost < cost && freeSharingCost > userGCRatio) { if (debugOptions & DEBUG_HEAPSIZE) Log("Heap: Previous sharing would have saved %0.2f\n", cost - freeSharingCost); cumulativeSharingSaving += cost - freeSharingCost; } } } if (debugOptions & DEBUG_HEAPSIZE) { if (performSharingPass) Log("Heap: Next full GC will enable the sharing pass\n"); Log("Heap: Resizing from "); LogSize(gMem.SpaceForHeap()); Log(" to "); LogSize(newHeapSize); Log(". Estimated ratio %2.2f\n", cost); } // Set the sizes. gMem.SetSpaceForHeap(newHeapSize); // Set the minor space size. It can potentially use the whole of the // rest of the available heap but there could be a problem if that exceeds // the available memory and causes paging. We need to raise the limit carefully. // Also, if we use the whole of the heap we may not then be able to allocate // new areas in the major heap without going over the limit. Restrict it to // half of the available heap. uintptr_t nextLimit = highWaterMark + highWaterMark / 32; if (nextLimit > newHeapSize) nextLimit = newHeapSize; // gMem.CurrentHeapSize() is the live space size. if (gMem.CurrentHeapSize() > nextLimit) gMem.SetSpaceBeforeMinorGC(0); // Run out of space else gMem.SetSpaceBeforeMinorGC((nextLimit-gMem.CurrentHeapSize())/2); lastFreeSpace = newHeapSize - currentSpaceUsed; predictedRatio = cost; } // Called after a minor GC. Currently does nothing. // See also adjustHeapSize for adjustments after a major GC. bool HeapSizeParameters::AdjustSizeAfterMinorGC(uintptr_t spaceAfterGC, uintptr_t spaceBeforeGC) { uintptr_t spaceCopiedOut = spaceAfterGC-spaceBeforeGC; TIMEDATA gc, total; minorGCsSinceMajor++; // The major costs are cumulative so we use those gc.add(majorGCSystemCPU); gc.add(majorGCUserCPU); total.add(gc); total.add(majorNonGCSystemCPU); total.add(majorNonGCUserCPU); float g = gc.toSeconds() / total.toSeconds(); if (debugOptions & DEBUG_HEAPSIZE) { Log("Heap: Space before "); LogSize(spaceBeforeGC); Log(", space after "); LogSize(spaceAfterGC); Log("\n"); Log("Heap: Minor resizing factors g = %f, recent pf = %ld, cumulative pf = %ld\n", g, minorGCPageFaults, majorGCPageFaults); } if (highWaterMark < gMem.CurrentHeapSize()) highWaterMark = gMem.CurrentHeapSize(); uintptr_t nextLimit = highWaterMark + highWaterMark / 32; if (nextLimit > gMem.SpaceForHeap()) nextLimit = gMem.SpaceForHeap(); // Set the space available for the allocation area to be the difference between the // total heap size and the allowed heap size together with as much space as we copied // on this GC. That allows for the next minor GC to copy the same amount without // extending the heap. If the next minor GC adds more than this the heap will be // extended and a corresponding amount deducted so that the heap shrinks again. uintptr_t currHeap = gMem.CurrentHeapSize(); uintptr_t currAlloc = gMem.CurrentAllocSpace(); uintptr_t nonAlloc = currHeap - currAlloc + spaceCopiedOut; // TODO: If we have limited the space to the high water mark + 1/32 but that is less // than we really need we should increase it further. uintptr_t allowedAlloc = nonAlloc >= nextLimit ? 0 : nextLimit - nonAlloc; // Normally the allocation area will be empty but if we've failed to copy // everything out, especially a big object, it may not be. uintptr_t allocatedInAlloc = gMem.AllocatedInAlloc(); // If we hit the limit at the last major GC we have to be much more careful. // If the minor GC cannot allocate a major GC space when it needs it the minor // GC will fail immediately and a major GC will be started. It's better to // risk doing more minor GCs than we need by making the allocation area smaller // rather than run out of space. if (allocationFailedBeforeLastMajorGC) allowedAlloc = allowedAlloc / 2; if (gMem.CurrentAllocSpace() - allocatedInAlloc != allowedAlloc) { if (debugOptions & DEBUG_HEAPSIZE) { Log("Heap: Adjusting space for allocation area from "); LogSize(gMem.SpaceBeforeMinorGC()); Log(" to "); LogSize(allowedAlloc); Log("\n"); } gMem.SetSpaceBeforeMinorGC(allowedAlloc); if (allowedAlloc < gMem.DefaultSpaceSize() * 2 || minorGCPageFaults > 100) return false; // Trigger full GC immediately. } // Trigger a full GC if the live data is very large or if we have exceeeded // the target ratio over several GCs (this smooths out small variations). if ((minorGCsSinceMajor > 4 && g > predictedRatio*0.8) || majorGCPageFaults > 100) fullGCNextTime = true; return true; } // Estimate the GC cost for a given heap size. The result is the ratio of // GC time to application time. // This is really guesswork. double HeapSizeParameters::costFunction(uintptr_t heapSize, bool withSharing, bool withSharingCost) { uintptr_t heapSpace = gMem.SpaceForHeap() < highWaterMark ? gMem.SpaceForHeap() : highWaterMark; uintptr_t currentFreeSpace = heapSpace < currentSpaceUsed ? 0: heapSpace - currentSpaceUsed; uintptr_t averageFree = (lastFreeSpace + currentFreeSpace) / 2; uintptr_t spaceUsed = currentSpaceUsed; // N.B. currentSpaceUsed includes the new space we want if (heapSize <= currentSpaceUsed) return 1.0E6; // If we run the sharing pass the live space will be smaller. if (withSharing) spaceUsed -= (POLYUNSIGNED)((double)currentSpaceUsed * sharingRecoveryRate); uintptr_t estimatedFree = heapSize - spaceUsed; // The cost scales as the inverse of the amount of free space. double result = lastMajorGCRatio * (double)averageFree / (double)estimatedFree; // If we run the sharing pass the GC cost will increase. if (withSharing && withSharingCost) result += result*sharingCostFactor; // The paging contribution depends on the page limit double pagingCost = 0.0; if (pagingLimitSize != 0) { double factor = ((double)heapSize - (double)pagingLimitSize) / (double)pagingLimitSize * PAGINGCOSTSTEEPNESS; pagingCost = PAGINGCOSTFACTOR * exp(factor); result += pagingCost; } if (debugOptions & DEBUG_HEAPSIZE) { Log("Heap: Cost for heap of size "); LogSize(heapSize); Log(" is %2.2f with paging contributing %2.2f with%s sharing pass.\n", result, pagingCost, withSharing ? "" : "out"); } return result; } // Calculate the size for the minimum cost. Returns true if this is bounded by // the user GC ratio and false if we minimised the cost // TODO: This could definitely be improved although it's not likely to contribute much to // the overall cost of a GC. bool HeapSizeParameters::getCostAndSize(uintptr_t &heapSize, double &cost, bool withSharing) { bool isBounded = false; uintptr_t heapSpace = gMem.SpaceForHeap() < highWaterMark ? gMem.SpaceForHeap() : highWaterMark; // Calculate a new heap size. We allow a maximum doubling or halving of size. // It's probably more important to limit the increase in case we hit paging. uintptr_t sizeMax = heapSpace * 2; if (sizeMax > maxHeapSize) sizeMax = maxHeapSize; uintptr_t sizeMin = heapSpace / 2; if (sizeMin < minHeapSize) sizeMin = minHeapSize; // We mustn't reduce the heap size too far. If the application does a lot // of work with few allocations and particularly if it calls PolyML.fullGC // explicitly we could attempt to shrink the heap below the current live data size. // Add 3*space size here. We require 2* after a minor GC. Add 1 for rounding. uintptr_t minForAllocation = gMem.CurrentHeapSize() + gMem.DefaultSpaceSize() * 3; if (minForAllocation > maxHeapSize) minForAllocation = maxHeapSize; if (sizeMin < minForAllocation) sizeMin = minForAllocation; double costMin = costFunction(sizeMin, withSharing, true); if (costMin <= userGCRatio) // If the cost of the minimum is below or at the target we // use that and don't need to look further. isBounded = true; else { double costMax = costFunction(sizeMax, withSharing, true); while (sizeMax > sizeMin + gMem.DefaultSpaceSize()) { uintptr_t sizeNext = (sizeMin + sizeMax) / 2; double cost = costFunction(sizeNext, withSharing, true); if (cost < userGCRatio) isBounded = true; if (cost < userGCRatio || (costMax > costMin && costMax > userGCRatio)) { sizeMax = sizeNext; costMax = cost; } else { sizeMin = sizeNext; costMin = cost; } ASSERT(costMin >= userGCRatio); } } ASSERT(sizeMin >= minHeapSize && sizeMin <= maxHeapSize); // If we are bounded by the user GC ratio we actually return the size and cost // that is slightly above the user ratio. heapSize = sizeMin; cost = costMin; return isBounded; } bool HeapSizeParameters::RunMajorGCImmediately() { if (fullGCNextTime) { fullGCNextTime = false; return true; } return false; } static bool GetLastStats(TIMEDATA &userTime, TIMEDATA &systemTime, TIMEDATA &realTime, long &pageCount) { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) FILETIME kt, ut; FILETIME ct, et; // Unused FILETIME rt; GetProcessTimes(GetCurrentProcess(), &ct, &et, &kt, &ut); GetSystemTimeAsFileTime(&rt); userTime = ut; systemTime = kt; realTime = rt; pageCount = GetPaging(0); #else struct rusage rusage; if (getrusage(RUSAGE_SELF, &rusage) != 0) return false; userTime = rusage.ru_utime; systemTime = rusage.ru_stime; struct timeval tv; if (gettimeofday(&tv, NULL) != 0) return false; realTime = tv; pageCount = GetPaging(rusage.ru_majflt); #endif return true; } void HeapSizeParameters::RecordAtStartOfMajorGC() { heapSizeAtStart = gMem.CurrentHeapSize(); allocationFailedBeforeLastMajorGC = !lastAllocationSucceeded; } // This function is called at the beginning and end of garbage // collection to record the time used. // This also reports the GC time if GC debugging is enabled. void HeapSizeParameters::RecordGCTime(gcTime isEnd, const char *stage) { switch (isEnd) { case GCTimeStart: { // Start of GC TIMEDATA userTime, systemTime, realTime; long pageCount; if (! GetLastStats(userTime, systemTime, realTime, pageCount)) break; lastUsageU = userTime; lastUsageS = systemTime; lastRTime = realTime; userTime.sub(startUsageU); // Times since the start systemTime.sub(startUsageS); realTime.sub(startRTime); if (debugOptions & DEBUG_GC) Log("GC: Non-GC time: CPU user: %0.3f system: %0.3f real: %0.3f page faults: %ld\n", userTime.toSeconds(), systemTime.toSeconds(), realTime.toSeconds(), pageCount - startPF); minorNonGCUserCPU.add(userTime); majorNonGCUserCPU.add(userTime); minorNonGCSystemCPU.add(systemTime); majorNonGCSystemCPU.add(systemTime); minorNonGCReal.add(realTime); majorNonGCReal.add(realTime); startUsageU = lastUsageU; startUsageS = lastUsageS; startRTime = lastRTime; // Page faults in the application are included minorGCPageFaults += pageCount - startPF; majorGCPageFaults += pageCount - startPF; startPF = pageCount; break; } case GCTimeIntermediate: // Report intermediate GC time for debugging if (debugOptions & DEBUG_GC) { TIMEDATA userTime, systemTime, realTime; long pageCount; if (! GetLastStats(userTime, systemTime, realTime, pageCount)) break; TIMEDATA nextU = userTime, nextS = systemTime, nextR = realTime; userTime.sub(lastUsageU); systemTime.sub(lastUsageS); realTime.sub(lastRTime); Log("GC: (%s) CPU user: %0.3f system: %0.3f real: %0.3f speed up %0.1f\n", stage, userTime.toSeconds(), systemTime.toSeconds(), realTime.toSeconds(), realTime.toSeconds() == 0.0 ? 0.0 : (userTime.toSeconds() + systemTime.toSeconds()) / realTime.toSeconds()); lastUsageU = nextU; lastUsageS = nextS; lastRTime = nextR; } break; case GCTimeEnd: // End of GC. { TIMEDATA userTime, systemTime, realTime; long pageCount; if (! GetLastStats(userTime, systemTime, realTime, pageCount)) break; lastUsageU = userTime; lastUsageS = systemTime; lastRTime = realTime; userTime.sub(startUsageU); // Times since the start systemTime.sub(startUsageS); realTime.sub(startRTime); totalGCUserCPU.add(userTime); totalGCSystemCPU.add(systemTime); totalGCReal.add(realTime); if (debugOptions & DEBUG_GC) { Log("GC: CPU user: %0.3f system: %0.3f real: %0.3f speed up %0.1f page faults %ld\n", userTime.toSeconds(), systemTime.toSeconds(), realTime.toSeconds(), realTime.toSeconds() == 0.0 ? 0.0 : (userTime.toSeconds() + systemTime.toSeconds()) / realTime.toSeconds(), pageCount - startPF); } minorGCUserCPU.add(userTime); majorGCUserCPU.add(userTime); minorGCSystemCPU.add(systemTime); majorGCSystemCPU.add(systemTime); minorGCReal.add(realTime); majorGCReal.add(realTime); startUsageU = lastUsageU; startUsageS = lastUsageS; startRTime = lastRTime; minorGCPageFaults += pageCount - startPF; majorGCPageFaults += pageCount - startPF; startPF = pageCount; globalStats.copyGCTimes(totalGCUserCPU, totalGCSystemCPU, totalGCReal); } break; } } // Record the recovery rate and cost after running the GC sharing pass. // TODO: We should probably average these because if we've run a full // sharing pass and then a full GC after the recovery rate will be zero. void HeapSizeParameters::RecordSharingData(POLYUNSIGNED recovery) { sharingWordsRecovered = recovery; TIMEDATA userTime, systemTime, realTime; long pageCount; if (! GetLastStats(userTime, systemTime, realTime, pageCount)) return; userTime.sub(startUsageU); // Times since the start systemTime.sub(startUsageS); sharingCPU = userTime; sharingCPU.add(systemTime); } Handle HeapSizeParameters::getGCUtime(TaskData *taskData) const { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) return Make_arb_from_Filetime(taskData, totalGCUserCPU); #else return Make_arb_from_pair_scaled(taskData, ((struct timeval)totalGCUserCPU).tv_sec, ((struct timeval)totalGCUserCPU).tv_usec, 1000000); #endif } Handle HeapSizeParameters::getGCStime(TaskData *taskData) const { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) return Make_arb_from_Filetime(taskData, totalGCSystemCPU); #else return Make_arb_from_pair_scaled(taskData, ((struct timeval)totalGCSystemCPU).tv_sec, ((struct timeval)totalGCSystemCPU).tv_usec, 1000000); #endif } void HeapSizeParameters::Init() { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) // Record an initial time of day to use as the basis of real timing FILETIME s; GetSystemTimeAsFileTime(&s); #else struct timeval s; gettimeofday(&s, NULL); #endif startTime = s; // Overall start time startRTime = startTime; // Start of this non-gc phase resetMajorTimingData(); -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) startPF = GetPaging(0); #else startPF = GetPaging(0); #endif } void HeapSizeParameters::Final() { // Print the overall statistics if (debugOptions & (DEBUG_GC|DEBUG_HEAPSIZE)) { TIMEDATA userTime, systemTime, realTime; -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) FILETIME kt, ut; FILETIME ct, et; // Unused FILETIME rt; GetProcessTimes(GetCurrentProcess(), &ct, &et, &kt, &ut); GetSystemTimeAsFileTime(&rt); userTime.add(ut); systemTime.add(kt); realTime.add(rt); #else struct rusage rusage; struct timeval tv; if (getrusage(RUSAGE_SELF, &rusage) != 0 || gettimeofday(&tv, NULL) != 0) return; userTime.add(rusage.ru_utime); systemTime.add(rusage.ru_stime); realTime.add(tv); #endif realTime.sub(startTime); userTime.sub(totalGCUserCPU); systemTime.sub(totalGCSystemCPU); realTime.sub(totalGCReal); if (debugOptions & DEBUG_GC) { Log("GC (Total): Non-GC time: CPU user: %0.3f system: %0.3f real: %0.3f\n", userTime.toSeconds(), systemTime.toSeconds(), realTime.toSeconds()); Log("GC (Total): GC time: CPU user: %0.3f system: %0.3f real: %0.3f\n", totalGCUserCPU.toSeconds(), totalGCSystemCPU.toSeconds(), totalGCReal.toSeconds()); } if (debugOptions & DEBUG_HEAPSIZE) { TIMEDATA gc, nonGc; gc.add(totalGCUserCPU); gc.add(totalGCSystemCPU); nonGc.add(userTime); nonGc.add(systemTime); Log("Heap: Total CPU GC time %0.3fsecs, Non-GC %0.3fsecs, ratio %0.3f\n", gc.toSeconds(), nonGc.toSeconds(), gc.toSeconds() / nonGc.toSeconds()); } } } void HeapSizeParameters::resetMinorTimingData(void) { minorNonGCUserCPU.fromSeconds(0); minorNonGCSystemCPU.fromSeconds(0); minorNonGCReal.fromSeconds(0); minorGCUserCPU.fromSeconds(0); minorGCSystemCPU.fromSeconds(0); minorGCReal.fromSeconds(0); minorGCPageFaults = 0; } void HeapSizeParameters::resetMajorTimingData(void) { resetMinorTimingData(); majorNonGCUserCPU.fromSeconds(0); majorNonGCSystemCPU.fromSeconds(0); majorNonGCReal.fromSeconds(0); majorGCUserCPU.fromSeconds(0); majorGCSystemCPU.fromSeconds(0); majorGCReal.fromSeconds(0); majorGCPageFaults = 0; minorGCsSinceMajor = 0; } class HeapSizing: public RtsModule { public: virtual void Init(void); virtual void Stop(void); }; // Declare this. It will be automatically added to the table. static HeapSizing heapSizeModule; void HeapSizing::Init(void) { gHeapSizeParameters.Init(); } void HeapSizing::Stop() { gHeapSizeParameters.Final(); } static size_t GetPhysicalMemorySize(void) { size_t maxMem = (size_t)0-1; // Maximum unsigned value. -#if defined(HAVE_WINDOWS_H) +#if defined(HAVE_WINDOWS_H) // Windows including Cygwin { MEMORYSTATUSEX memStatEx; memset(&memStatEx, 0, sizeof(memStatEx)); memStatEx.dwLength = sizeof(memStatEx); if (! GlobalMemoryStatusEx(&memStatEx)) memStatEx.ullTotalPhys = 0; // Clobber any rubbish since it says it failed. if (memStatEx.ullTotalPhys) // If it's non-zero assume it succeeded { DWORDLONG dwlMax = maxMem; if (memStatEx.ullTotalPhys > dwlMax) return maxMem; else return (size_t)memStatEx.ullTotalPhys; } } #endif #if defined(_SC_PHYS_PAGES) && defined(_SC_PAGESIZE) { // Linux and Solaris. This gives a silly value in Cygwin. long physPages = sysconf(_SC_PHYS_PAGES); long physPagesize = sysconf(_SC_PAGESIZE); if (physPages != -1 && physPagesize != -1) { unsigned long maxPages = maxMem / physPagesize; if ((unsigned long)physPages > maxPages) return maxMem; else // We've checked it won't overflow. return physPages*physPagesize; } } #endif #if defined(HAVE_SYSCTL) && defined(CTL_HW) // FreeBSD and Mac OS X. It seems HW_MEMSIZE has been added to // Max OS X to return a 64-bit value. #ifdef HW_MEMSIZE { static int mib[2] = { CTL_HW, HW_MEMSIZE }; uint64_t physMem = 0; size_t len = sizeof(physMem); if (sysctl(mib, 2, &physMem, &len, NULL, 0) == 0 && len == sizeof(physMem)) { if (physMem > (uint64_t)maxMem) return maxMem; else return (POLYUNSIGNED)physMem; } } #endif #ifdef HW_PHYSMEM // If HW_MEMSIZE isn't there or the call failed try this. { static int mib[2] = { CTL_HW, HW_PHYSMEM }; unsigned int physMem = 0; size_t len = sizeof(physMem); if (sysctl(mib, 2, &physMem, &len, NULL, 0) == 0 && len == sizeof(physMem)) { if (physMem > maxMem) return maxMem; else return physMem; } } #endif #endif return 0; // Unable to determine } diff --git a/libpolyml/io_internal.h b/libpolyml/io_internal.h index d7633062..dae40e71 100644 --- a/libpolyml/io_internal.h +++ b/libpolyml/io_internal.h @@ -1,211 +1,211 @@ /* Title: Data structures shared between basioio.c and network.c. - Copyright (c) 2000, 2016, 2018 David C. J. Matthews + Copyright (c) 2000, 2016, 2018-19 David C. J. Matthews Portions of this code are derived from the original stream io package copyright CUTS 1983-2000. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef IO_INTERNAL_H #define IO_INTERNAL_H // Bits to define tests and results in poll. // These are the values passed to and from ML. #define POLL_BIT_IN 1 #define POLL_BIT_OUT 2 #define POLL_BIT_PRI 4 // Return values from fileKind #define FILEKIND_FILE 0 #define FILEKIND_DIR 1 #define FILEKIND_LINK 2 #define FILEKIND_TTY 3 #define FILEKIND_PIPE 4 #define FILEKIND_SKT 5 #define FILEKIND_DEV 6 #define FILEKIND_UNKNOWN 7 #define FILEKIND_ERROR (-1) -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #include #include "locking.h" // For PLock // Unlike Unix where select and poll can be used on both sockets and other // streams, in Windows there is no single way of testing different sorts of // streams. class WinStreamBase { public: virtual ~WinStreamBase() {} // Quieten some warnings virtual int pollTest() { // Return the valid options for this descriptor return 0; } virtual int poll(TaskData *taskData, int test) { // Return the values set return 0; } // These are not currently used but could be used to poll // multiple sockets or streams. virtual SOCKET getSocket() { return INVALID_SOCKET; } virtual HANDLE getHandle() { return INVALID_HANDLE_VALUE; } }; typedef enum { OPENREAD, OPENWRITE, OPENAPPEND } openMode; // Abstract Windows stream class WinStream : public WinStreamBase { public: virtual void closeEntry(TaskData *taskData) = 0; virtual void waitUntilAvailable(TaskData *taskData); virtual void waitUntilOutputPossible(TaskData *taskData); virtual size_t readStream(TaskData *taskData, byte *base, size_t length) { unimplemented(taskData); return 0; } virtual uint64_t getPos(TaskData *taskData) { unimplemented(taskData); return 0; } virtual void setPos(TaskData *taskData, uint64_t pos) { unimplemented(taskData); } virtual uint64_t fileSize(TaskData *taskData) { unimplemented(taskData); return 0; } virtual size_t writeStream(TaskData *taskData, byte *base, size_t length) { unimplemented(taskData); return 0; } virtual int fileKind() = 0; static int fileTypeOfHandle(HANDLE hStream); // In general this class does not support polling. // We return true for both of these so we will block. virtual bool isAvailable(TaskData *taskData) { return true; // No general way to test this } virtual bool canOutput(TaskData *taskData) { // There doesn't seem to be a way to do this in Windows. return true; } protected: void unimplemented(TaskData *taskData); }; // Windows stream input using overlapped IO and the Windows calls. class WinInOutStream : public WinStream { public: WinInOutStream(); ~WinInOutStream(); virtual void closeEntry(TaskData *taskData); virtual void openFile(TaskData * taskData, TCHAR *name, openMode mode, bool text); virtual size_t readStream(TaskData *taskData, byte *base, size_t length); virtual bool isAvailable(TaskData *taskData); virtual void waitUntilAvailable(TaskData *taskData); virtual uint64_t getPos(TaskData *taskData); virtual void setPos(TaskData *taskData, uint64_t pos); virtual uint64_t fileSize(TaskData *taskData); virtual bool canOutput(TaskData *taskData); virtual void waitUntilOutputPossible(TaskData *taskData); virtual size_t writeStream(TaskData *taskData, byte *base, size_t length); // Open on a handle. This returns an error result rather than raising an exception virtual bool openHandle(HANDLE hndl, openMode mode, bool isText); virtual int fileKind() { return WinStream::fileTypeOfHandle(hStream); } virtual int pollTest() { // We can poll this to test for input. return isRead ? POLL_BIT_IN : POLL_BIT_OUT; } virtual int poll(TaskData *taskData, int test); virtual HANDLE getHandle() { return hEvent; } protected: bool beginReading(); void flushOut(TaskData *taskData); uint64_t getOverlappedPos() { return ((uint64_t)(overlap.OffsetHigh) << 32) + overlap.Offset; } void setOverlappedPos(uint64_t newPos) { overlap.Offset = (DWORD)newPos; overlap.OffsetHigh = (DWORD)(newPos >> 32); } protected: bool isRead; bool isText; // Remove CRs? byte *buffer; unsigned buffSize, currentInBuffer, currentPtr; bool endOfStream; HANDLE hStream; HANDLE hEvent; OVERLAPPED overlap; PLock lock; }; // Create a new pipe. extern void newPipeName(TCHAR *name); #else extern Handle wrapFileDescriptor(TaskData *taskData, int fd); // Get a file descriptor and raise an exception if it is closed. extern int getStreamFileDescriptor(TaskData *taskData, PolyWord strm); extern int getStreamFileDescriptorWithoutCheck(PolyWord strm); #endif // This is used in both basicio and unix-specific #if defined(HAVE_STRUCT_STAT_ST_ATIM) # define STAT_SECS(stat,kind) (stat)->st_##kind##tim.tv_sec # define STAT_USECS(stat,kind) (((stat)->st_##kind##tim.tv_nsec + 500) / 1000) #elif defined(HAVE_STRUCT_STAT_ST_ATIMENSEC) # define STAT_SECS(stat,kind) (stat)->st_##kind##time # define STAT_USECS(stat,kind) (((stat)->st_##kind##timensec + 500) / 1000) #elif defined(HAVE_STRUCT_STAT_ST_ATIMESPEC) # define STAT_SECS(stat,kind) (stat)->st_##kind##timespec.tv_sec # define STAT_USECS(stat,kind) (((stat)->st_##kind##timespec.tv_nsec + 500) / 1000) #elif defined(HAVE_STRUCT_STAT_ST_ATIME_N) # define STAT_SECS(stat,kind) (stat)->st_##kind##time # define STAT_USECS(stat,kind) (((stat)->st_##kind##time_n + 500) / 1000) #elif defined(HAVE_STRUCT_STAT_ST_UATIME) # define STAT_SECS(stat,kind) (stat)->st_##kind##time # define STAT_USECS(stat,kind) (stat)->st_u##kind##time #else # define STAT_SECS(stat,kind) (stat)->st_##kind##time # define STAT_USECS(stat,kind) 0 #endif #endif diff --git a/libpolyml/locking.cpp b/libpolyml/locking.cpp index 7386cacf..d064e7bc 100644 --- a/libpolyml/locking.cpp +++ b/libpolyml/locking.cpp @@ -1,329 +1,312 @@ /* Title: Mutex and Condition Variable library. - Copyright (c) 2007, 2012, 2015 David C. J. Matthews + Copyright (c) 2007, 2012, 2015, 2019 David C. J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_PTHREAD_H)) -#define HAVE_PTHREAD 1 +#if (!defined(_WIN32)) +// Configure requires pthread unless this is native Windows. #include -#elif (defined(HAVE_WINDOWS_H)) +#else #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_SYS_TIME_H #include #endif #ifdef HAVE_TIME_H #include #endif -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_SEMAPHORE_H)) +#if (defined(HAVE_SEMAPHORE_H) && !defined(_WIN32)) // Don't include semaphore.h on Mingw. It's provided but doesn't compile. #include #endif #ifdef HAVE_SYS_TYPES_H #include #endif #ifdef HAVE_SYS_STAT_H #include #endif #ifdef HAVE_FCNTL_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_STDIO_H #include #endif #include "locking.h" #include "diagnostics.h" // Report contended locks after this many attempts #define LOCK_REPORT_COUNT 50 PLock::PLock(const char *n): lockName(n), lockCount(0) { -#ifdef HAVE_PTHREAD +#if (!defined(_WIN32)) pthread_mutex_init(&lock, 0); -#elif defined(HAVE_WINDOWS_H) +#else InitializeCriticalSection(&lock); #endif } PLock::~PLock() { -#ifdef HAVE_PTHREAD +#if (!defined(_WIN32)) pthread_mutex_destroy(&lock); -#elif defined(HAVE_WINDOWS_H) +#else DeleteCriticalSection(&lock); #endif } void PLock::Lock(void) { -#if (defined(HAVE_PTHREAD) || defined(HAVE_WINDOWS_H)) if (debugOptions & DEBUG_CONTENTION) { // Report a heavily contended lock. if (Trylock()) return; if (++lockCount > LOCK_REPORT_COUNT) { if (lockName != 0) Log("Lock: contention on lock: %s\n", lockName); else Log("Lock: contention on lock at %p\n", &lock); lockCount = 0; } // Drop through to a normal lock } -#endif -#ifdef HAVE_PTHREAD +#if (!defined(_WIN32)) pthread_mutex_lock(&lock); -#elif defined(HAVE_WINDOWS_H) +#else EnterCriticalSection(&lock); #endif - // If we don't support threads this does nothing. } void PLock::Unlock(void) { -#ifdef HAVE_PTHREAD +#if (!defined(_WIN32)) pthread_mutex_unlock(&lock); -#elif defined(HAVE_WINDOWS_H) +#else LeaveCriticalSection(&lock); #endif } bool PLock::Trylock(void) { -#ifdef HAVE_PTHREAD +#if (!defined(_WIN32)) // Since we use normal mutexes this returns EBUSY if the // current thread owns the mutex. return pthread_mutex_trylock(&lock) != EBUSY; -#elif defined(HAVE_WINDOWS_H) +#else // This is not implemented properly in Windows. There is // TryEnterCriticalSection in Win NT and later but that // returns TRUE if the current thread owns the mutex. return TryEnterCriticalSection(&lock) == TRUE; -#else - return true; // Single-threaded. #endif } PCondVar::PCondVar() { -#ifdef HAVE_PTHREAD +#if (!defined(_WIN32)) pthread_cond_init(&cond, NULL); -#elif defined(HAVE_WINDOWS_H) +#else InitializeConditionVariable(&cond); #endif } PCondVar::~PCondVar() { -#ifdef HAVE_PTHREAD +#if (!defined(_WIN32)) pthread_cond_destroy(&cond); #endif } // Wait indefinitely. Drops the lock and reaquires it. void PCondVar::Wait(PLock *pLock) { -#ifdef HAVE_PTHREAD +#if (!defined(_WIN32)) pthread_cond_wait(&cond, &pLock->lock); -#elif defined(HAVE_WINDOWS_H) +#else SleepConditionVariableCS(&cond, &pLock->lock, INFINITE); #endif } // Wait until a specified absolute time. Drops the lock and reaquires it. -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) // Windows with Windows-style times void PCondVar::WaitUntil(PLock *pLock, const FILETIME *time) { FILETIME now; GetSystemTimeAsFileTime(&now); LARGE_INTEGER liNow, liTime; liNow.HighPart = now.dwHighDateTime; liNow.LowPart = now.dwLowDateTime; liTime.HighPart = time->dwHighDateTime; liTime.LowPart = time->dwLowDateTime; if (liNow.QuadPart >= liTime.QuadPart) // Already past the time return; DWORD toWait = (DWORD)((liTime.QuadPart - liNow.QuadPart) / (LONGLONG)10000); (void)WaitFor(pLock, toWait); } #else // Unix-style times void PCondVar::WaitUntil(PLock *pLock, const timespec *time) { -#ifdef HAVE_PTHREAD pthread_cond_timedwait(&cond, &pLock->lock, time); -#elif defined(HAVE_WINDOWS_H) - // This must be Cygwin but compiled with --without-threads - struct timeval tv; - if (gettimeofday(&tv, NULL) != 0) - return; - if (tv.tv_sec > time->tv_sec || (tv.tv_sec == time->tv_sec && tv.tv_usec >= time->tv_nsec/1000)) - return; // Already past the time - WaitFor(pLock, (time->tv_sec - tv.tv_sec) * 1000 + time->tv_nsec/1000000 - tv.tv_usec/1000); -#endif } #endif // Wait for a number of milliseconds. Used within the RTS. Drops the lock and reaquires it. // Returns true if the return was because the condition variable had been signalled. // Returns false if the timeout expired or there was an error. bool PCondVar::WaitFor(PLock *pLock, unsigned milliseconds) { -#ifdef HAVE_PTHREAD +#if (!defined(_WIN32)) struct timespec waitTime; struct timeval tv; if (gettimeofday(&tv, NULL) != 0) return false; waitTime.tv_sec = tv.tv_sec + milliseconds / 1000; waitTime.tv_nsec = (tv.tv_usec + (milliseconds % 1000) * 1000) * 1000; if (waitTime.tv_nsec >= 1000*1000*1000) { waitTime.tv_nsec -= 1000*1000*1000; waitTime.tv_sec += 1; } return pthread_cond_timedwait(&cond, &pLock->lock, &waitTime) == 0; -#elif defined(HAVE_WINDOWS_H) +#else // SleepConditionVariableCS returns zero on error or timeout. return SleepConditionVariableCS(&cond, &pLock->lock, milliseconds) != 0; -#else - return true; // Single-threaded. Return immediately. #endif } // Wake up all the waiting threads. void PCondVar::Signal(void) { -#ifdef HAVE_PTHREAD +#if (!defined(_WIN32)) pthread_cond_broadcast(&cond); -#elif defined(HAVE_WINDOWS_H) +#else WakeAllConditionVariable(&cond); #endif } // Initialise a semphore. Tries to create an unnamed semaphore if // it can but tries a named semaphore if it can't. Mac OS X only // supports named semaphores. // The semaphore is initialised with a count of zero. PSemaphore::PSemaphore() { -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_SEMAPHORE_H)) +#if (!defined(_WIN32)) sema = 0; isLocal = true; -#elif defined(HAVE_WINDOWS_H) +#else sema = NULL; #endif } PSemaphore::~PSemaphore() { -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_SEMAPHORE_H)) +#if (!defined(_WIN32)) if (sema && isLocal) sem_destroy(sema); else if (sema && !isLocal) sem_close(sema); -#elif defined(HAVE_WINDOWS_H) +#else if (sema != NULL) CloseHandle(sema); #endif } bool PSemaphore::Init(unsigned init, unsigned max) { -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_SEMAPHORE_H)) +#if (!defined(_WIN32)) isLocal = true; if (sem_init(&localSema, 0, init) == 0) { sema = &localSema; return true; } #if (defined(__CYGWIN__)) // Cygwin doesn't define sem_unlink but that doesn't matter // since sem_init works. sema = 0; return false; #else isLocal = false; char semname[30]; static int count=0; sprintf(semname, "poly%0d-%0d", (int)getpid(), count++); sema = sem_open(semname, O_CREAT|O_EXCL, 00666, init); if (sema == (sem_t*)SEM_FAILED) { sema = 0; return false; } sem_unlink(semname); return true; #endif -#elif defined(HAVE_WINDOWS_H) +#else sema = CreateSemaphore(NULL, init, max, NULL); return sema != NULL; #endif } bool PSemaphore::Wait(void) { -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_SEMAPHORE_H)) +#if (!defined(_WIN32)) // Wait until the semaphore is signalled. A Unix signal may interrupt // it so we need to retry in that case. while (sem_wait(sema) == -1) { if (errno != EINTR) return false; } return true; -#elif defined(HAVE_WINDOWS_H) +#else return WaitForSingleObject(sema, INFINITE) == WAIT_OBJECT_0; #endif } void PSemaphore::Signal(void) { -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_SEMAPHORE_H)) +#if (!defined(_WIN32)) sem_post(sema); -#elif defined(HAVE_WINDOWS_H) +#else ReleaseSemaphore(sema, 1, NULL); #endif } diff --git a/libpolyml/locking.h b/libpolyml/locking.h index 94616485..74f20cbc 100644 --- a/libpolyml/locking.h +++ b/libpolyml/locking.h @@ -1,123 +1,123 @@ /* Title: Mutex and Condition Variable library. - Copyright (c) 2007, 2012 David C. J. Matthews + Copyright (c) 2007, 2012, 2019 David C. J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef LOCKING_H_DEFINED #define LOCKING_H_DEFINED #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_WINDOWS_H #include #endif -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_SEMAPHORE_H)) +#if (defined(HAVE_SEMAPHORE_H) && !defined(_WIN32)) // Don't include semaphore.h on Mingw. It's provided but doesn't compile. #include #endif -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_PTHREAD_H)) -// Don't include pthread if this is native Windows and not Cygwin +#if (!defined(_WIN32)) +// Don't include pthread if this is native Windows. #include #endif // Simple Mutex. class PLock { public: PLock(const char *n = 0); ~PLock(); void Lock(void); // Lock the mutex void Unlock(void); // Unlock the mutex bool Trylock(void); // Try to lock the mutex - returns true if succeeded private: -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_PTHREAD_H)) +#if (!defined(_WIN32)) pthread_mutex_t lock; -#elif defined(HAVE_WINDOWS_H) +#else CRITICAL_SECTION lock; #endif // Debugging info. const char *lockName; unsigned lockCount; friend class PCondVar; }; // Lock a mutex and automatically unlock it in the destructor. // This can be used in a function to lock a mutex and unlock it // when the function either returns normally or raises an exception. class PLocker { public: PLocker(PLock *lock): m_lock(lock) { m_lock->Lock(); } ~PLocker() { m_lock->Unlock(); } private: PLock *m_lock; }; // Simple condition variable. N.B. The Windows code does not // support multiple threads blocking on this condition variable. class PCondVar { public: PCondVar(); ~PCondVar(); void Wait(PLock *pLock); // Wait indefinitely. Drops the lock and reaquires it. // Wait for a signal or until the time. The argument is an absolute time // represented as a struct timespec in Unix and a FILETIME in Windows. -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) void WaitUntil(PLock *pLock, const FILETIME *timeArg); #else void WaitUntil(PLock *pLock, const timespec *timeArg); #endif // Wait for a time. This is used internally in the RTS. bool WaitFor(PLock *pLock, unsigned milliseconds); // N.B. Signal MUST be called only with the lock held. void Signal(void); // Wake up the waiting thread. private: -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_PTHREAD_H)) +#if (!defined(_WIN32)) pthread_cond_t cond; -#elif defined(HAVE_WINDOWS_H) +#else CONDITION_VARIABLE cond; #endif }; // Semaphore. Wrapper for Posix semaphore or Windows semaphore. class PSemaphore { public: PSemaphore(); ~PSemaphore(); bool Init(unsigned init, unsigned max); bool Wait(void); void Signal(void); private: -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_SEMAPHORE_H)) +#if (!defined(_WIN32)) sem_t localSema, *sema; bool isLocal; -#elif defined(HAVE_WINDOWS_H) +#else HANDLE sema; #endif }; #endif diff --git a/libpolyml/mpoly.cpp b/libpolyml/mpoly.cpp index 1e73852a..39014543 100644 --- a/libpolyml/mpoly.cpp +++ b/libpolyml/mpoly.cpp @@ -1,506 +1,506 @@ /* Title: Main program Copyright (c) 2000 Cambridge University Technical Services Limited Further development copyright David C.J. Matthews 2001-12, 2015, 2017-19 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_STDARG_H #include #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) 0 #endif -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #include #else #define _T(x) x #define _tcslen strlen #define _tcstol strtol #define _tcsncmp strncmp #define _tcschr strchr #endif #include "globals.h" #include "sys.h" #include "gc.h" #include "heapsizing.h" #include "run_time.h" #include "machine_dep.h" #include "version.h" #include "diagnostics.h" #include "processes.h" #include "mpoly.h" #include "scanaddrs.h" #include "save_vec.h" #include "../polyexports.h" #include "memmgr.h" #include "pexport.h" #include "polystring.h" #include "statistics.h" #include "noreturn.h" #include "savestate.h" -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #include "winstartup.h" #include "winguiconsole.h" static const TCHAR *lpszServiceName = 0; // DDE service name #endif FILE *polyStdout, *polyStderr; // Redirected in the Windows GUI NORETURNFN(static void Usage(const char *message, ...)); struct _userOptions userOptions; time_t exportTimeStamp; enum { OPT_HEAPMIN, OPT_HEAPMAX, OPT_HEAPINIT, OPT_GCPERCENT, OPT_RESERVE, OPT_GCTHREADS, OPT_DEBUGOPTS, OPT_DEBUGFILE, OPT_DDESERVICE, OPT_CODEPAGE, OPT_REMOTESTATS }; static struct __argtab { const TCHAR *argName; const char *argHelp; unsigned argKey; } argTable[] = { { _T("-H"), "Initial heap size (MB)", OPT_HEAPINIT }, { _T("--minheap"), "Minimum heap size (MB)", OPT_HEAPMIN }, { _T("--maxheap"), "Maximum heap size (MB)", OPT_HEAPMAX }, { _T("--gcpercent"), "Target percentage time in GC (1-99)", OPT_GCPERCENT }, { _T("--stackspace"), "Space to reserve for thread stacks and C++ heap(MB)", OPT_RESERVE }, { _T("--gcthreads"), "Number of threads to use for garbage collection", OPT_GCTHREADS }, { _T("--debug"), "Debug options: checkmem, gc, x", OPT_DEBUGOPTS }, { _T("--logfile"), "Logging file (default is to log to stdout)", OPT_DEBUGFILE }, -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #ifdef UNICODE { _T("--codepage"), "Code-page to use for file-names etc in Windows", OPT_CODEPAGE }, #endif { _T("-pServiceName"), "DDE service name for remote interrupt in Windows", OPT_DDESERVICE } #else { _T("--exportstats"), "Enable another process to read the statistics", OPT_REMOTESTATS } #endif }; static struct __debugOpts { const TCHAR *optName; const char *optHelp; unsigned optKey; } debugOptTable[] = { { _T("checkmem"), "Perform additional debugging checks on memory", DEBUG_CHECK_OBJECTS }, { _T("gc"), "Log summary garbage-collector information", DEBUG_GC }, { _T("gcenhanced"), "Log enhanced garbage-collector information", DEBUG_GC_ENHANCED }, { _T("gcdetail"), "Log detailed garbage-collector information", DEBUG_GC_DETAIL }, { _T("memmgr"), "Memory manager information", DEBUG_MEMMGR }, { _T("threads"), "Thread related information", DEBUG_THREADS }, { _T("gctasks"), "Log multi-thread GC information", DEBUG_GCTASKS }, { _T("heapsize"), "Log heap resizing data", DEBUG_HEAPSIZE }, { _T("x"), "Log X-windows information", DEBUG_X}, { _T("sharing"), "Information from PolyML.shareCommonData", DEBUG_SHARING}, { _T("locks"), "Information about contended locks", DEBUG_CONTENTION}, { _T("rts"), "General run-time system calls", DEBUG_RTSCALLS}, { _T("saving"), "Saving and loading state; exporting", DEBUG_SAVING } }; // Parse a parameter that is meant to be a size. Returns the value as a number // of kilobytes. POLYUNSIGNED parseSize(const TCHAR *p, const TCHAR *arg) { POLYUNSIGNED result = 0; if (*p < '0' || *p > '9') // There must be at least one digit Usage("Incomplete %s option\n", arg); while (true) { result = result*10 + *p++ - '0'; if (*p == 0) { // The default is megabytes result *= 1024; break; } if (*p == 'G' || *p == 'g') { result *= 1024 * 1024; p++; break; } if (*p == 'M' || *p == 'm') { result *= 1024; p++; break; } if (*p == 'K' || *p == 'k') { p++; break; } if (*p < '0' || *p > '9') break; } if (*p != 0) Usage("Malformed %s option\n", arg); // The sizes must not exceed the possible heap size. #ifdef POLYML32IN64 if (result > 16 * 1024 * 1024) Usage("Value of %s option must not exceeed 16Gbytes\n", arg); #elif (SIZEOF_VOIDP == 4) if (result > 4 * 1024 * 1024) Usage("Value of %s option must not exceeed 4Gbytes\n", arg); #else // For completion only! if (result > (POLYUNSIGNED)8 * 1024 * 1024 * 1024 * 1024 * 1024) Usage("Value of %s option must not exceeed 8Ebytes\n", arg); #endif return result; } /* In the Windows version this is called from WinMain in Console.c */ int polymain(int argc, TCHAR **argv, exportDescription *exports) { POLYUNSIGNED minsize=0, maxsize=0, initsize=0; unsigned gcpercent=0; /* Get arguments. */ memset(&userOptions, 0, sizeof(userOptions)); /* Reset it */ userOptions.gcthreads = 0; // Default multi-threaded if (polyStdout == 0) polyStdout = stdout; if (polyStderr == 0) polyStderr = stderr; // Get the program name for CommandLine.name. This is allowed to be a full path or // just the last component so we return whatever the system provides. if (argc > 0) userOptions.programName = argv[0]; else userOptions.programName = _T(""); // Set it to a valid empty string TCHAR *importFileName = 0; debugOptions = 0; userOptions.user_arg_count = 0; userOptions.user_arg_strings = (TCHAR**)malloc(argc * sizeof(TCHAR*)); // Enough room for all of them // Process the argument list removing those recognised by the RTS and adding the // remainder to the user argument list. for (int i = 1; i < argc; i++) { if (argv[i][0] == '-') { bool argUsed = false; for (unsigned j = 0; j < sizeof(argTable)/sizeof(argTable[0]); j++) { size_t argl = _tcslen(argTable[j].argName); if (_tcsncmp(argv[i], argTable[j].argName, argl) == 0) { const TCHAR *p = 0; TCHAR *endp = 0; if (argTable[j].argKey != OPT_REMOTESTATS) { if (_tcslen(argv[i]) == argl) { // If it has used all the argument pick the next i++; p = argv[i]; } else { p = argv[i]+argl; if (*p == '=') p++; // Skip an equals sign } if (i >= argc) Usage("Incomplete %s option\n", argTable[j].argName); } switch (argTable[j].argKey) { case OPT_HEAPMIN: minsize = parseSize(p, argTable[j].argName); break; case OPT_HEAPMAX: maxsize = parseSize(p, argTable[j].argName); break; case OPT_HEAPINIT: initsize = parseSize(p, argTable[j].argName); break; case OPT_GCPERCENT: gcpercent = _tcstol(p, &endp, 10); if (*endp != '\0') Usage("Malformed %s option\n", argTable[j].argName); if (gcpercent < 1 || gcpercent > 99) { Usage("%s argument must be between 1 and 99\n", argTable[j].argName); gcpercent = 0; } break; case OPT_RESERVE: { POLYUNSIGNED reserve = parseSize(p, argTable[j].argName); if (reserve != 0) gHeapSizeParameters.SetReservation(reserve); break; } case OPT_GCTHREADS: userOptions.gcthreads = _tcstol(p, &endp, 10); if (*endp != '\0') Usage("Incomplete %s option\n", argTable[j].argName); break; case OPT_DEBUGOPTS: while (*p != '\0') { // Debug options are separated by commas bool optFound = false; const TCHAR *q = _tcschr(p, ','); if (q == NULL) q = p+_tcslen(p); for (unsigned k = 0; k < sizeof(debugOptTable)/sizeof(debugOptTable[0]); k++) { if (_tcslen(debugOptTable[k].optName) == (size_t)(q-p) && _tcsncmp(p, debugOptTable[k].optName, q-p) == 0) { debugOptions |= debugOptTable[k].optKey; optFound = true; } } if (! optFound) Usage("Unknown argument to --debug\n"); if (*q == ',') p = q+1; else p = q; } if (debugOptions & DEBUG_GC_DETAIL) debugOptions |= DEBUG_GC_ENHANCED; if (debugOptions & DEBUG_GC_ENHANCED) debugOptions |= DEBUG_GC; break; case OPT_DEBUGFILE: SetLogFile(p); break; -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) case OPT_DDESERVICE: // Set the name for the DDE service. This allows the caller to specify the // service name to be used to send Interrupt "signals". lpszServiceName = p; break; #if (defined(UNICODE)) case OPT_CODEPAGE: if (! setWindowsCodePage(p)) Usage("Unknown argument to --codepage. Use code page number or CP_ACP, CP_UTF8.\n"); break; #endif #endif case OPT_REMOTESTATS: // If set we export the statistics on Unix. globalStats.exportStats = true; break; } argUsed = true; break; } } if (! argUsed) // Add it to the user args. userOptions.user_arg_strings[userOptions.user_arg_count++] = argv[i]; } else if (exports == 0 && importFileName == 0) importFileName = argv[i]; else userOptions.user_arg_strings[userOptions.user_arg_count++] = argv[i]; } if (!gMem.Initialise()) Usage("Unable to initialise memory allocator\n"); if (exports == 0 && importFileName == 0) Usage("Missing import file name\n"); // If the maximum is provided it must be not less than the minimum. if (maxsize != 0 && maxsize < minsize) Usage("Minimum heap size must not be more than maximum size\n"); // The initial size must be not more than the maximum if (maxsize != 0 && maxsize < initsize) Usage("Initial heap size must not be more than maximum size\n"); // The initial size must be not less than the minimum if (initsize != 0 && initsize < minsize) Usage("Initial heap size must not be less than minimum size\n"); if (userOptions.gcthreads == 0) { // If the gcthreads option is missing or zero the default is to try to // use as many threads as there are physical processors. The result may // be zero in which case we use the number of processors. Because memory // bandwidth is a limiting factor we want to avoid muliple GC threads on // hyperthreaded "processors". userOptions.gcthreads = NumberOfPhysicalProcessors(); if (userOptions.gcthreads == 0) userOptions.gcthreads = NumberOfProcessors(); } // Set the heap size if it has been provided otherwise use the default. gHeapSizeParameters.SetHeapParameters(minsize, maxsize, initsize, gcpercent); -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) SetupDDEHandler(lpszServiceName); // Windows: Start the DDE handler now we processed any service name. #endif // Initialise the run-time system before creating the heap. InitModules(); CreateHeap(); PolyObject *rootFunction = 0; if (exports != 0) rootFunction = InitHeaderFromExport(exports); else { if (importFileName != 0) rootFunction = ImportPortable(importFileName); if (rootFunction == 0) exit(1); } StartModules(); // Set up the initial process to run the root function. processes->BeginRootThread(rootFunction); finish(0); /*NOTREACHED*/ return 0; /* just to keep lint happy */ } void Uninitialise(void) // Close down everything and free all resources. Stop any threads or timers. { StopModules(); } void finish (int n) { // Make sure we don't get any interrupts once the destructors are // applied to globals or statics. Uninitialise(); -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) ExitThread(n); #else exit (n); #endif } // Print a message and exit if an argument is malformed. void Usage(const char *message, ...) { va_list vl; fprintf(polyStdout, "\n"); va_start(vl, message); vfprintf(polyStdout, message, vl); va_end(vl); for (unsigned j = 0; j < sizeof(argTable)/sizeof(argTable[0]); j++) { #if (defined(_WIN32) && defined(UNICODE)) fprintf(polyStdout, "%S <%s>\n", argTable[j].argName, argTable[j].argHelp); #else fprintf(polyStdout, "%s <%s>\n", argTable[j].argName, argTable[j].argHelp); #endif } fprintf(polyStdout, "Debug options:\n"); for (unsigned k = 0; k < sizeof(debugOptTable)/sizeof(debugOptTable[0]); k++) { #if (defined(_WIN32) && defined(UNICODE)) fprintf(polyStdout, "%S <%s>\n", debugOptTable[k].optName, debugOptTable[k].optHelp); #else fprintf(polyStdout, "%s <%s>\n", debugOptTable[k].optName, debugOptTable[k].optHelp); #endif } fflush(polyStdout); -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) if (useConsole) { MessageBox(hMainWindow, _T("Poly/ML has exited"), _T("Poly/ML"), MB_OK); } #endif exit (1); } // Return a string containing the argument names. Can be printed out in response // to a --help argument. It is up to the ML application to do that since it may well // want to produce information about any arguments it chooses to process. char *RTSArgHelp(void) { static char buff[2000]; char *p = buff; for (unsigned j = 0; j < sizeof(argTable)/sizeof(argTable[0]); j++) { #if (defined(_WIN32) && defined(UNICODE)) int spaces = sprintf(p, "%S <%s>\n", argTable[j].argName, argTable[j].argHelp); #else int spaces = sprintf(p, "%s <%s>\n", argTable[j].argName, argTable[j].argHelp); #endif p += spaces; } { int spaces = sprintf(p, "Debug options:\n"); p += spaces; } for (unsigned k = 0; k < sizeof(debugOptTable)/sizeof(debugOptTable[0]); k++) { #if (defined(_WIN32) && defined(UNICODE)) int spaces = sprintf(p, "%S <%s>\n", debugOptTable[k].optName, debugOptTable[k].optHelp); #else int spaces = sprintf(p, "%s <%s>\n", debugOptTable[k].optName, debugOptTable[k].optHelp); #endif p += spaces; } ASSERT((unsigned)(p - buff) < (unsigned)sizeof(buff)); return buff; } diff --git a/libpolyml/mpoly.h b/libpolyml/mpoly.h index f025bf7d..6b04cc64 100644 --- a/libpolyml/mpoly.h +++ b/libpolyml/mpoly.h @@ -1,62 +1,62 @@ /* Title: exports signature for mpoly.c Copyright (c) 2000-7 Cambridge University Technical Services Limited - Further development copyright David C.J. Matthews 2001-12, 2015 + Further development copyright David C.J. Matthews 2001-12, 2015, 2019 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef _MPOLY_H_DEFINED #define _MPOLY_H_DEFINED #ifdef HAVE_TCHAR_H #include #else typedef char TCHAR; #endif #include "noreturn.h" #include "../polyexports.h" extern struct _userOptions { unsigned user_arg_count; TCHAR **user_arg_strings; const TCHAR *programName; unsigned gcthreads; // Number of threads to use for gc } userOptions; class PolyWord; NORETURNFN(extern void finish(int n)); extern char *RTSArgHelp(void); extern time_t exportTimeStamp; -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) extern int polymain(int argc, TCHAR **argv, exportDescription *exports); #endif #ifdef HAVE_STDIO_H #include #endif // Outout streams. These are the same as stdOut and stdErr in Unix but // may be redirected in Windows. extern FILE *polyStdout, *polyStderr; #endif /* _MPOLY_H_DEFINED */ diff --git a/libpolyml/network.cpp b/libpolyml/network.cpp index b2448e2c..a6ff02f1 100644 --- a/libpolyml/network.cpp +++ b/libpolyml/network.cpp @@ -1,1797 +1,1797 @@ /* Title: Network functions. - Copyright (c) 2000-7, 2016, 2018 David C. J. Matthews + Copyright (c) 2000-7, 2016, 2018, 2019 David C. J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) 0 #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_SYS_PARAM_H #include #endif #ifdef HAVE_SYS_TIME_H #include #endif #ifdef HAVE_NETDB_H #include #endif #ifdef HAVE_SYS_SOCKET_H #include #endif #ifdef HAVE_NETINET_IN_H #include #endif #ifdef HAVE_NETINET_TCP_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_SYS_IOCTL_H #include #endif #ifdef HAVE_SYS_UN_H #include #endif #ifdef HAVE_SYS_FILIO_H #include #endif #ifdef HAVE_SYS_SOCKIO_H #include #endif #ifdef HAVE_SYS_SELECT_H #include #endif #ifndef HAVE_SOCKLEN_T typedef int socklen_t; #endif -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) // Temporarily define this to suppress warnings for gethostname and gethostbyaddr #define _WINSOCK_DEPRECATED_NO_WARNINGS 1 #include #else typedef int SOCKET; #endif #ifdef HAVE_WINDOWS_H #include #endif #include #ifdef max #undef max #endif #include #include "globals.h" #include "gc.h" #include "arb.h" #include "run_time.h" #include "mpoly.h" #include "processes.h" #include "network.h" #include "io_internal.h" #include "sys.h" #include "polystring.h" #include "save_vec.h" #include "rts_module.h" #include "machine_dep.h" #include "errors.h" #include "rtsentry.h" #include "timing.h" extern "C" { POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGeneral(PolyObject *threadId, PolyWord code, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetServByName(PolyObject *threadId, PolyWord servName); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetServByNameAndProtocol(PolyObject *threadId, PolyWord servName, PolyWord protName); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetServByPort(PolyObject *threadId, PolyWord portNo); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetServByPortAndProtocol(PolyObject *threadId, PolyWord portNo, PolyWord protName); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetProtByName(PolyObject *threadId, PolyWord protocolName); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetProtByNo(PolyObject *threadId, PolyWord protoNo); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetHostName(PolyObject *threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetHostByName(PolyObject *threadId, PolyWord hostName); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetHostByAddr(PolyObject *threadId, PolyWord hostAddr); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkCloseSocket(PolyObject *threadId, PolyWord arg); } #define SAVE(x) taskData->saveVec.push(x) #define ALLOC(n) alloc_and_save(taskData, n) #define SIZEOF(x) (sizeof(x)/sizeof(PolyWord)) -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) static int winsock_init = 0; /* Check that it has been initialised. */ #else #define INVALID_SOCKET (-1) #define SOCKET_ERROR (-1) #endif #ifndef HAVE_SOCKLEN_T typedef int socklen_t; // This must be int for Windows at least #endif #ifndef SHUT_RD #define SHUT_RD 0 #endif #ifndef SHUT_WR #define SHUT_WR 1 #endif #ifndef SHUT_RDWR #define SHUT_RDWR 2 #endif /* Address families. Although this table is in ascending numerical order of address family nothing depends on that. The only requirement is that "INET" => AF_INET must always be present and "UNIX" => AF_UNIX must be present on Unix. Other entries are entirely optional and are for amusement only. */ struct af_tab_struct { const char *af_name; int af_num; } af_table[] = { #ifdef AF_UNIX { "UNIX", AF_UNIX }, /* This is nearly always there. */ #endif #ifdef AF_LOCAL { "LOCAL", AF_LOCAL }, #endif { "INET", AF_INET }, /* This one should always be there. */ #ifdef AF_IMPLINK { "IMPLINK", AF_IMPLINK }, #endif #ifdef AF_PUP { "PUP", AF_PUP }, #endif #ifdef AF_CHAOS { "CHAOS", AF_CHAOS }, #endif #ifdef AF_IPX { "IPX", AF_IPX }, #endif #ifdef AF_NS { "NS", AF_NS }, #endif #ifdef AF_ISO { "ISO", AF_ISO }, #endif #ifdef AF_OSI { "OSI", AF_OSI }, #endif #ifdef AF_ECMA { "ECMA", AF_ECMA }, #endif #ifdef AF_DATAKIT { "DATAKIT", AF_DATAKIT }, #endif #ifdef AF_CCITT { "CCITT", AF_CCITT }, #endif #ifdef AF_SNA { "SNA", AF_SNA }, #endif #ifdef AF_DECnet { "DECnet", AF_DECnet }, #endif #ifdef AF_DLI { "DLI", AF_DLI }, #endif #ifdef AF_LAT { "LAT", AF_LAT }, #endif #ifdef AF_HYLINK { "HYLINK", AF_HYLINK }, #endif #ifdef AF_APPLETALK { "APPLETALK", AF_APPLETALK }, #endif #ifdef AF_NETBIOS { "NETBIOS", AF_NETBIOS }, #endif #ifdef AF_ROUTE { "ROUTE", AF_ROUTE }, #endif #ifdef AF_VOICEVIEW { "VOICEVIEW", AF_VOICEVIEW }, #endif #ifdef AF_FIREFOX { "FIREFOX", AF_FIREFOX }, #endif #ifdef AF_BAN { "BAN", AF_BAN }, #endif #ifdef AF_LINK { "LINK", AF_LINK }, #endif #ifdef AF_COIP { "COIP", AF_COIP }, #endif #ifdef AF_CNT { "CNT", AF_CNT }, #endif #ifdef AF_SIP { "SIP", AF_SIP }, #endif #ifdef AF_ISDN { "ISDN", AF_ISDN }, #endif #ifdef AF_E164 { "E164", AF_E164 }, #endif #ifdef AF_INET6 { "INET6", AF_INET6 }, #endif #ifdef AF_NATM { "NATM", AF_NATM }, #endif #ifdef AF_ATM { "ATM", AF_ATM }, #endif #ifdef AF_NETGRAPH { "NETGRAPH", AF_NETGRAPH }, #endif }; /* Socket types. Only STREAM and DGRAM are required. */ struct sk_tab_struct { const char *sk_name; int sk_num; } sk_table[] = { { "STREAM", SOCK_STREAM }, { "DGRAM", SOCK_DGRAM }, { "RAW", SOCK_RAW }, { "RDM", SOCK_RDM }, { "SEQPACKET", SOCK_SEQPACKET } }; static Handle makeHostEntry(TaskData *taskData, struct hostent *host); static Handle makeProtoEntry(TaskData *taskData, struct protoent *proto); static Handle mkAftab(TaskData *taskData, void*, char *p); static Handle mkSktab(TaskData *taskData, void*, char *p); static Handle setSocketOption(TaskData *taskData, Handle args, int level, int opt); static Handle getSocketOption(TaskData *taskData, Handle args, int level, int opt); static Handle getSocketInt(TaskData *taskData, Handle args, int level, int opt); static Handle selectCall(TaskData *taskData, Handle args, int blockType); -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #define GETERROR (WSAGetLastError()) #define TOOMANYFILES WSAEMFILE #define NOMEMORY WSA_NOT_ENOUGH_MEMORY #define STREAMCLOSED WSA_INVALID_HANDLE #define WOULDBLOCK WSAEWOULDBLOCK #define INPROGRESS WSAEINPROGRESS #define CALLINTERRUPTED WSAEINTR #undef EBADF #undef EMFILE #undef EAGAIN #undef EINTR #undef EWOULDBLOCK #undef ENOMEM #else #define GETERROR (errno) #define TOOMANYFILES EMFILE #define NOMEMORY ENOMEM #define STREAMCLOSED EBADF #define ERRORNUMBER errno #define FILEDOESNOTEXIST ENOENT #define WOULDBLOCK EWOULDBLOCK #define INPROGRESS EINPROGRESS #define CALLINTERRUPTED EINTR #endif // Wait until "select" returns. In Windows this is used only for networking. class WaitSelect: public Waiter { public: WaitSelect(unsigned maxMillisecs=(unsigned)-1); virtual void Wait(unsigned maxMillisecs); void SetRead(SOCKET fd) { FD_SET(fd, &readSet); } void SetWrite(SOCKET fd) { FD_SET(fd, &writeSet); } void SetExcept(SOCKET fd) { FD_SET(fd, &exceptSet); } bool IsSetRead(SOCKET fd) { return FD_ISSET(fd, &readSet) != 0; } bool IsSetWrite(SOCKET fd) { return FD_ISSET(fd, &writeSet) != 0; } bool IsSetExcept(SOCKET fd) { return FD_ISSET(fd, &exceptSet) != 0; } // Save the result of the select call and any associated error int SelectResult(void) { return selectResult; } int SelectError(void) { return errorResult; } private: fd_set readSet, writeSet, exceptSet; int selectResult; int errorResult; unsigned maxTime; }; WaitSelect::WaitSelect(unsigned maxMillisecs) { FD_ZERO(&readSet); FD_ZERO(&writeSet); FD_ZERO(&exceptSet); selectResult = 0; errorResult = 0; maxTime = maxMillisecs; } void WaitSelect::Wait(unsigned maxMillisecs) { if (maxTime < maxMillisecs) maxMillisecs = maxTime; struct timeval toWait = { 0, 0 }; toWait.tv_sec = maxMillisecs / 1000; toWait.tv_usec = (maxMillisecs % 1000) * 1000; selectResult = select(FD_SETSIZE, &readSet, &writeSet, &exceptSet, &toWait); if (selectResult < 0) errorResult = GETERROR; } class WaitNet: public WaitSelect { public: WaitNet(SOCKET sock, bool isOOB = false); }; // Use "select" in both Windows and Unix. In Windows that means we // don't watch hWakeupEvent but that's only a hint. WaitNet::WaitNet(SOCKET sock, bool isOOB) { if (isOOB) SetExcept(sock); else SetRead(sock); } // Wait for a socket to be free to write. class WaitNetSend: public WaitSelect { public: WaitNetSend(SOCKET sock) { SetWrite(sock); } }; -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) class WinSocket : public WinStreamBase { public: WinSocket(SOCKET skt) : socket(skt) {} virtual SOCKET getSocket() { return socket; } virtual int pollTest() { // We can poll for any of these. return POLL_BIT_IN | POLL_BIT_OUT | POLL_BIT_PRI; } virtual int poll(TaskData *taskData, int test); public: SOCKET socket; }; // Poll without blocking. int WinSocket::poll(TaskData *taskData, int bits) { int result = 0; if (bits & POLL_BIT_PRI) { u_long atMark = 0; if (ioctlsocket(socket, SIOCATMARK, &atMark) != 0) raise_syscall(taskData, "ioctlsocket failed", GETERROR); if (atMark) { result |= POLL_BIT_PRI; } } if (bits & (POLL_BIT_IN | POLL_BIT_OUT)) { FD_SET readFds, writeFds; TIMEVAL poll = { 0, 0 }; FD_ZERO(&readFds); FD_ZERO(&writeFds); if (bits & POLL_BIT_IN) FD_SET(socket, &readFds); if (bits & POLL_BIT_OUT) FD_SET(socket, &writeFds); int selRes = select(FD_SETSIZE, &readFds, &writeFds, NULL, &poll); if (selRes < 0) raise_syscall(taskData, "select failed", GETERROR); else if (selRes > 0) { // N.B. select only tells us about out-of-band data if SO_OOBINLINE is FALSE. */ if (FD_ISSET(socket, &readFds)) result |= POLL_BIT_IN; if (FD_ISSET(socket, &writeFds)) result |= POLL_BIT_OUT; } } return result; } static SOCKET getStreamSocket(TaskData *taskData, PolyWord strm) { WinSocket *winskt = *(WinSocket**)(strm.AsObjPtr()); if (winskt == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); return winskt->getSocket(); } static Handle wrapStreamSocket(TaskData *taskData, SOCKET skt) { try { WinSocket *winskt = new WinSocket(skt); return MakeVolatileWord(taskData, winskt); } catch (std::bad_alloc&) { raise_syscall(taskData, "Insufficient memory", NOMEMORY); } } #else static SOCKET getStreamSocket(TaskData *taskData, PolyWord strm) { return getStreamFileDescriptor(taskData, strm); } static Handle wrapStreamSocket(TaskData *taskData, SOCKET skt) { return wrapFileDescriptor(taskData, skt); } #endif static Handle Net_dispatch_c(TaskData *taskData, Handle args, Handle code) { unsigned c = get_C_unsigned(taskData, code->Word()); Handle hSave = taskData->saveVec.mark(); TryAgain: // Used for various retries. // N.B. If we call ThreadPause etc we may GC. We MUST reload any handles so for // safety we always come back here. switch (c) { case 11: { /* Return a list of known address families. */ return makeList(taskData, sizeof(af_table)/sizeof(af_table[0]), (char*)af_table, sizeof(af_table[0]), 0, mkAftab); } case 12: { /* Return a list of known socket types. */ return makeList(taskData, sizeof(sk_table)/sizeof(sk_table[0]), (char*)sk_table, sizeof(sk_table[0]), 0, mkSktab); } case 13: /* Return the "any" internet address. */ return Make_arbitrary_precision(taskData, INADDR_ANY); case 14: /* Create a socket */ { int af = get_C_int(taskData, DEREFHANDLE(args)->Get(0)); int type = get_C_int(taskData, DEREFHANDLE(args)->Get(1)); int proto = get_C_int(taskData, DEREFHANDLE(args)->Get(2)); SOCKET skt = socket(af, type, proto); if (skt == INVALID_SOCKET) { switch (GETERROR) { case CALLINTERRUPTED: taskData->saveVec.reset(hSave); goto TryAgain; default: raise_syscall(taskData, "socket failed", GETERROR); } } /* Set the socket to non-blocking mode. */ -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) unsigned long onOff = 1; if (ioctlsocket(skt, FIONBIO, &onOff) != 0) #else int onOff = 1; if (ioctl(skt, FIONBIO, &onOff) < 0) #endif { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) closesocket(skt); #else close(skt); #endif raise_syscall(taskData, "ioctl failed", GETERROR); } return wrapStreamSocket(taskData, skt); } case 15: /* Set TCP No-delay option. */ return setSocketOption(taskData, args, IPPROTO_TCP, TCP_NODELAY); case 16: /* Get TCP No-delay option. */ return getSocketOption(taskData, args, IPPROTO_TCP, TCP_NODELAY); case 17: /* Set Debug option. */ return setSocketOption(taskData, args, SOL_SOCKET, SO_DEBUG); case 18: /* Get Debug option. */ return getSocketOption(taskData, args, SOL_SOCKET, SO_DEBUG); case 19: /* Set REUSEADDR option. */ return setSocketOption(taskData, args, SOL_SOCKET, SO_REUSEADDR); case 20: /* Get REUSEADDR option. */ return getSocketOption(taskData, args, SOL_SOCKET, SO_REUSEADDR); case 21: /* Set KEEPALIVE option. */ return setSocketOption(taskData, args, SOL_SOCKET, SO_KEEPALIVE); case 22: /* Get KEEPALIVE option. */ return getSocketOption(taskData, args, SOL_SOCKET, SO_KEEPALIVE); case 23: /* Set DONTROUTE option. */ return setSocketOption(taskData, args, SOL_SOCKET, SO_DONTROUTE); case 24: /* Get DONTROUTE option. */ return getSocketOption(taskData, args, SOL_SOCKET, SO_DONTROUTE); case 25: /* Set BROADCAST option. */ return setSocketOption(taskData, args, SOL_SOCKET, SO_BROADCAST); case 26: /* Get BROADCAST option. */ return getSocketOption(taskData, args, SOL_SOCKET, SO_BROADCAST); case 27: /* Set OOBINLINE option. */ return setSocketOption(taskData, args, SOL_SOCKET, SO_OOBINLINE); case 28: /* Get OOBINLINE option. */ return getSocketOption(taskData, args, SOL_SOCKET, SO_OOBINLINE); case 29: /* Set SNDBUF size. */ return setSocketOption(taskData, args, SOL_SOCKET, SO_SNDBUF); case 30: /* Get SNDBUF size. */ return getSocketInt(taskData, args, SOL_SOCKET, SO_SNDBUF); case 31: /* Set RCVBUF size. */ return setSocketOption(taskData, args, SOL_SOCKET, SO_RCVBUF); case 32: /* Get RCVBUF size. */ return getSocketInt(taskData, args, SOL_SOCKET, SO_RCVBUF); case 33: /* Get socket type e.g. SOCK_STREAM. */ return getSocketInt(taskData, args, SOL_SOCKET, SO_TYPE); case 34: /* Get error status and clear it. */ return getSocketOption(taskData, args, SOL_SOCKET, SO_ERROR); case 35: /* Set Linger time. */ { struct linger linger; SOCKET skt = getStreamSocket(taskData, DEREFHANDLE(args)->Get(0)); int lTime = get_C_int(taskData, DEREFHANDLE(args)->Get(1)); /* We pass in a negative value to turn the option off, zero or positive to turn it on. */ if (lTime < 0) { linger.l_onoff = 0; linger.l_linger = 0; } else { linger.l_onoff = 1; linger.l_linger = lTime; } if (setsockopt(skt, SOL_SOCKET, SO_LINGER, (char*)&linger, sizeof(linger)) != 0) raise_syscall(taskData, "setsockopt failed", GETERROR); return Make_arbitrary_precision(taskData, 0); } case 36: /* Get Linger time. */ { struct linger linger; SOCKET skt = getStreamSocket(taskData, args->Word()); socklen_t size = sizeof(linger); int lTime = 0; if (getsockopt(skt, SOL_SOCKET, SO_LINGER, (char*)&linger, &size) != 0) raise_syscall(taskData, "getsockopt failed", GETERROR); /* If the option is off return a negative. */ if (linger.l_onoff == 0) lTime = -1; else lTime = linger.l_linger; return Make_arbitrary_precision(taskData, lTime); } case 37: /* Get peer name. */ { SOCKET skt = getStreamSocket(taskData, args->Word()); struct sockaddr sockA; socklen_t size = sizeof(sockA); if (getpeername(skt, &sockA, &size) != 0) raise_syscall(taskData, "getpeername failed", GETERROR); /* Addresses are treated as strings. */ return(SAVE(C_string_to_Poly(taskData, (char*)&sockA, size))); } case 38: /* Get socket name. */ { SOCKET skt = getStreamSocket(taskData, args->Word()); struct sockaddr sockA; socklen_t size = sizeof(sockA); if (getsockname(skt, &sockA, &size) != 0) raise_syscall(taskData, "getsockname failed", GETERROR); return(SAVE(C_string_to_Poly(taskData, (char*)&sockA, size))); } case 39: /* Return the address family from an address. */ { PolyStringObject *psAddr = (PolyStringObject *)args->WordP(); struct sockaddr *psock = (struct sockaddr *)&psAddr->chars; return Make_arbitrary_precision(taskData, psock->sa_family); } case 40: /* Create a socket address from a port number and internet address. */ { struct sockaddr_in sockaddr; memset(&sockaddr, 0, sizeof(sockaddr)); sockaddr.sin_family = AF_INET; sockaddr.sin_port = htons(get_C_ushort(taskData, DEREFHANDLE(args)->Get(0))); sockaddr.sin_addr.s_addr = htonl(get_C_unsigned(taskData, DEREFHANDLE(args)->Get(1))); return(SAVE(C_string_to_Poly(taskData, (char*)&sockaddr, sizeof(sockaddr)))); } case 41: /* Return port number from an internet socket address. Assumes that we've already checked the address family. */ { PolyStringObject *psAddr = (PolyStringObject *)args->WordP(); struct sockaddr_in *psock = (struct sockaddr_in *)&psAddr->chars; return Make_arbitrary_precision(taskData, ntohs(psock->sin_port)); } case 42: /* Return internet address from an internet socket address. Assumes that we've already checked the address family. */ { PolyStringObject * psAddr = (PolyStringObject *)args->WordP(); struct sockaddr_in *psock = (struct sockaddr_in *)&psAddr->chars; return Make_arbitrary_precision(taskData, ntohl(psock->sin_addr.s_addr)); } /* 43 - Set non-blocking mode. Now removed. */ case 44: /* Find number of bytes available. */ { SOCKET skt = getStreamSocket(taskData, args->Word()); -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) unsigned long readable; if (ioctlsocket(skt, FIONREAD, &readable) != 0) raise_syscall(taskData, "ioctlsocket failed", GETERROR); #else int readable; if (ioctl(skt, FIONREAD, &readable) < 0) raise_syscall(taskData, "ioctl failed", GETERROR); #endif return Make_arbitrary_precision(taskData, readable); } case 45: /* Find out if we are at the mark. */ { SOCKET skt = getStreamSocket(taskData, args->Word()); -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) unsigned long atMark; if (ioctlsocket(skt, SIOCATMARK, &atMark) != 0) raise_syscall(taskData, "ioctlsocket failed", GETERROR); #else int atMark; if (ioctl(skt, SIOCATMARK, &atMark) < 0) raise_syscall(taskData, "ioctl failed", GETERROR); #endif return Make_arbitrary_precision(taskData, atMark == 0 ? 0 : 1); } case 46: /* Accept a connection. */ // We should check for interrupts even if we're not going to block. processes->TestAnyEvents(taskData); case 58: /* Non-blocking accept. */ { SOCKET sock = getStreamSocket(taskData, args->Word()); struct sockaddr resultAddr; Handle addrHandle, pair; socklen_t addrLen = sizeof(resultAddr); SOCKET result = accept(sock, &resultAddr, &addrLen); if (result == INVALID_SOCKET) { switch (GETERROR) { case CALLINTERRUPTED: taskData->saveVec.reset(hSave); goto TryAgain; /* Have to retry if we got EINTR. */ case WOULDBLOCK: #if (WOULDBLOCK != INPROGRESS) case INPROGRESS: #endif /* If the socket is in non-blocking mode we pass this back to the caller. If it is blocking we suspend this process and try again later. */ if (c == 46 /* blocking version. */) { WaitNet waiter(sock); processes->ThreadPauseForIO(taskData, &waiter); taskData->saveVec.reset(hSave); goto TryAgain; } /* else drop through. */ default: raise_syscall(taskData, "accept failed", GETERROR); } } addrHandle = SAVE(C_string_to_Poly(taskData, (char*)&resultAddr, addrLen)); // Return a pair of the new socket and the address. Handle resSkt = wrapStreamSocket(taskData, result); pair = ALLOC(2); DEREFHANDLE(pair)->Set(0, resSkt->Word()); DEREFHANDLE(pair)->Set(1, addrHandle->Word()); return pair; } case 47: /* Bind an address to a socket. */ { SOCKET skt = getStreamSocket(taskData, DEREFHANDLE(args)->Get(0)); PolyStringObject * psAddr = (PolyStringObject *)args->WordP()->Get(1).AsObjPtr(); struct sockaddr *psock = (struct sockaddr *)&psAddr->chars; if (bind(skt, psock, (int)psAddr->length) != 0) raise_syscall(taskData, "bind failed", GETERROR); return Make_arbitrary_precision(taskData, 0); } case 48: /* Connect to an address. */ // We should check for interrupts even if we're not going to block. processes->TestAnyEvents(taskData); case 59: /* Non-blocking connect. */ { SOCKET sock = getStreamSocket(taskData, DEREFHANDLE(args)->Get(0)); PolyStringObject * psAddr = (PolyStringObject *)args->WordP()->Get(1).AsObjPtr(); struct sockaddr *psock = (struct sockaddr *)&psAddr->chars; /* In Windows, and possibly also in Unix, if we have received a previous EWOULDBLOCK we have to use "select" to tell us whether the connection actually succeeded. */ while (1) { int res = connect(sock, psock, (int)psAddr->length); if (res == 0) return Make_arbitrary_precision(taskData, 0); /* OK */ /* It isn't clear that EINTR can ever occur with connect, but just to be safe, we retry. */ int err = GETERROR; if ((err == WOULDBLOCK || err == INPROGRESS) && c == 48 /*blocking version*/) break; // It's in progress and we need to wait for completion else if (err != CALLINTERRUPTED) raise_syscall(taskData, "connect failed", err); /* else try again. */ } while (1) { /* In Windows failure is indicated by the bit being set in the exception set rather than the write set. */ WaitSelect waiter; waiter.SetWrite(sock); waiter.SetExcept(sock); processes->ThreadPauseForIO(taskData, &waiter); if (waiter.SelectResult() < 0) { int err = waiter.SelectError(); if (err != CALLINTERRUPTED) raise_syscall(taskData, "select failed", err); /* else continue */ } else if (waiter.SelectResult() != 0) /* Definite result. */ { int result = 0; socklen_t len = sizeof(result); if (getsockopt(sock, SOL_SOCKET, SO_ERROR, (char*)&result, &len) != 0) raise_syscall(taskData, "connect failed", GETERROR); else if (result != 0) raise_syscall(taskData, "connect failed", result); return Make_arbitrary_precision(taskData, 0); /* Success. */ } } } case 49: /* Put socket into listening mode. */ { SOCKET sock = getStreamSocket(taskData, DEREFHANDLE(args)->Get(0)); int backlog = get_C_int(taskData, DEREFHANDLE(args)->Get(1)); if (listen(sock, backlog) != 0) raise_syscall(taskData, "listen failed", GETERROR); return Make_arbitrary_precision(taskData, 0); } case 50: /* Shutdown the socket. */ { SOCKET sock = getStreamSocket(taskData, DEREFHANDLE(args)->Get(0)); int mode = 0; switch (get_C_ulong(taskData, DEREFHANDLE(args)->Get(1))) { case 1: mode = SHUT_RD; break; case 2: mode = SHUT_WR; break; case 3: mode = SHUT_RDWR; } if (shutdown(sock, mode) != 0) raise_syscall(taskData, "shutdown failed", GETERROR); return Make_arbitrary_precision(taskData, 0); } case 51: /* Send data on a socket. */ // We should check for interrupts even if we're not going to block. processes->TestAnyEvents(taskData); case 60: /* Non-blocking send. */ { SOCKET sock = getStreamSocket(taskData, DEREFHANDLE(args)->Get(0)); PolyWord pBase = DEREFHANDLE(args)->Get(1); char ch, *base; POLYUNSIGNED offset = getPolyUnsigned(taskData, DEREFHANDLE(args)->Get(2)); -#if(defined(_WIN32) && ! defined(_CYGWIN)) +#if(defined(_WIN32)) int length = get_C_int(taskData, DEREFHANDLE(args)->Get(3)); #else ssize_t length = getPolyUnsigned(taskData, DEREFHANDLE(args)->Get(3)); #endif unsigned int dontRoute = get_C_unsigned(taskData, DEREFHANDLE(args)->Get(4)); unsigned int outOfBand = get_C_unsigned(taskData, DEREFHANDLE(args)->Get(5)); int flags = 0; if (dontRoute != 0) flags |= MSG_DONTROUTE; if (outOfBand != 0) flags |= MSG_OOB; if (IS_INT(pBase)) { /* Handle the special case where we are sending a single byte vector and the "address" is the tagged byte itself. */ ch = (char)UNTAGGED(pBase); base = &ch; offset = 0; length = 1; } else base = (char*)pBase.AsObjPtr()->AsBytePtr(); while (1) { int err; -#if(defined(_WIN32) && ! defined(_CYGWIN)) +#if(defined(_WIN32)) int sent; #else ssize_t sent; #endif sent = send(sock, base+offset, length, flags); /* It isn't clear that EINTR can ever occur with send but just to be safe we deal with that case and retry the send. */ if (sent != SOCKET_ERROR) /* OK. */ return Make_arbitrary_precision(taskData, sent); err = GETERROR; if ((err == WOULDBLOCK || err == INPROGRESS) && c == 51 /* blocking */) { WaitNetSend waiter(sock); processes->ThreadPauseForIO(taskData, &waiter); // It is NOT safe to just loop here. We may have GCed. taskData->saveVec.reset(hSave); goto TryAgain; } else if (err != CALLINTERRUPTED) raise_syscall(taskData, "send failed", err); /* else try again */ } } case 52: /* Send data on a socket to a given address. */ // We should check for interrupts even if we're not going to block. processes->TestAnyEvents(taskData); case 61: /* Non-blocking send. */ { SOCKET sock = getStreamSocket(taskData, DEREFHANDLE(args)->Get(0)); PolyStringObject * psAddr = (PolyStringObject *)args->WordP()->Get(1).AsObjPtr(); PolyWord pBase = DEREFHANDLE(args)->Get(2); char ch, *base; POLYUNSIGNED offset = getPolyUnsigned(taskData, DEREFHANDLE(args)->Get(3)); -#if(defined(_WIN32) && ! defined(_CYGWIN)) +#if(defined(_WIN32)) int length = get_C_int(taskData, DEREFHANDLE(args)->Get(4)); #else size_t length = getPolyUnsigned(taskData, DEREFHANDLE(args)->Get(4)); #endif unsigned int dontRoute = get_C_unsigned(taskData, DEREFHANDLE(args)->Get(5)); unsigned int outOfBand = get_C_unsigned(taskData, DEREFHANDLE(args)->Get(6)); int flags = 0; if (dontRoute != 0) flags |= MSG_DONTROUTE; if (outOfBand != 0) flags |= MSG_OOB; if (IS_INT(pBase)) { /* Handle the special case where we are sending a single byte vector and the "address" is the tagged byte itself. */ ch = (char)UNTAGGED(pBase); base = &ch; offset = 0; length = 1; } else base = (char*)pBase.AsObjPtr()->AsBytePtr(); while (1) { int err; -#if(defined(_WIN32) && ! defined(_CYGWIN)) +#if(defined(_WIN32)) int sent; #else ssize_t sent; #endif sent = sendto(sock, base+offset, length, flags, (struct sockaddr *)psAddr->chars, (int)psAddr->length); /* It isn't clear that EINTR can ever occur with send but just to be safe we deal with that case and retry the send. */ if (sent != SOCKET_ERROR) /* OK. */ return Make_arbitrary_precision(taskData, sent); err = GETERROR; if ((err == WOULDBLOCK || err == INPROGRESS) && c == 52 /* blocking */) { WaitNetSend waiter(sock); processes->ThreadPauseForIO(taskData, &waiter); // It is NOT safe to just loop here. We may have GCed. taskData->saveVec.reset(hSave); goto TryAgain; } else if (err != CALLINTERRUPTED) raise_syscall(taskData, "sendto failed", err); /* else try again */ } } case 53: /* Receive data into an array. */ // We should check for interrupts even if we're not going to block. processes->TestAnyEvents(taskData); case 62: /* Non-blocking receive. */ { SOCKET sock = getStreamSocket(taskData, DEREFHANDLE(args)->Get(0)); char *base = (char*)DEREFHANDLE(args)->Get(1).AsObjPtr()->AsBytePtr(); POLYUNSIGNED offset = getPolyUnsigned(taskData, DEREFHANDLE(args)->Get(2)); -#if(defined(_WIN32) && ! defined(_CYGWIN)) +#if(defined(_WIN32)) int length = get_C_int(taskData, DEREFHANDLE(args)->Get(3)); #else size_t length = getPolyUnsigned(taskData, DEREFHANDLE(args)->Get(3)); #endif unsigned int peek = get_C_unsigned(taskData, DEREFHANDLE(args)->Get(4)); unsigned int outOfBand = get_C_unsigned(taskData, DEREFHANDLE(args)->Get(5)); int flags = 0; if (peek != 0) flags |= MSG_PEEK; if (outOfBand != 0) flags |= MSG_OOB; while (1) { int err; -#if(defined(_WIN32) && ! defined(_CYGWIN)) +#if(defined(_WIN32)) int recvd; #else ssize_t recvd; #endif recvd = recv(sock, base+offset, length, flags); err = GETERROR; if (recvd != SOCKET_ERROR) { /* OK. */ /* It appears that recv may return the length of the message if that is longer than the buffer. */ if (recvd > (int)length) recvd = length; return Make_arbitrary_precision(taskData, recvd); } if ((err == WOULDBLOCK || err == INPROGRESS) && c == 53 /* blocking */) { /* Block until something arrives. */ WaitNet waiter(sock, outOfBand != 0); processes->ThreadPauseForIO(taskData, &waiter); // It is NOT safe to just loop here. We may have GCed. taskData->saveVec.reset(hSave); goto TryAgain; } else if (err != CALLINTERRUPTED) raise_syscall(taskData, "recv failed", err); /* else try again */ } } case 54: /* Receive data into an array and return the sender's address along with the length. In Windows this can only be used with datagrams. */ // We should check for interrupts even if we're not going to block. processes->TestAnyEvents(taskData); case 63: /* Non-blocking receive. */ { SOCKET sock = getStreamSocket(taskData, DEREFHANDLE(args)->Get(0)); char *base = (char*)DEREFHANDLE(args)->Get(1).AsObjPtr()->AsBytePtr(); POLYUNSIGNED offset = getPolyUnsigned(taskData, DEREFHANDLE(args)->Get(2)); -#if(defined(_WIN32) && ! defined(_CYGWIN)) +#if(defined(_WIN32)) int length = get_C_int(taskData, DEREFHANDLE(args)->Get(3)); #else size_t length = getPolyUnsigned(taskData, DEREFHANDLE(args)->Get(3)); #endif unsigned int peek = get_C_unsigned(taskData, DEREFHANDLE(args)->Get(4)); unsigned int outOfBand = get_C_unsigned(taskData, DEREFHANDLE(args)->Get(5)); int flags = 0; socklen_t addrLen; struct sockaddr resultAddr; if (peek != 0) flags |= MSG_PEEK; if (outOfBand != 0) flags |= MSG_OOB; while (1) { int err; -#if(defined(_WIN32) && ! defined(_CYGWIN)) +#if(defined(_WIN32)) int recvd; #else ssize_t recvd; #endif recvd = recvfrom(sock, base+offset, length, flags, &resultAddr, &addrLen); err = GETERROR; if (recvd != SOCKET_ERROR) { /* OK. */ Handle addrHandle, lengthHandle, pair; if (recvd > (int)length) recvd = length; lengthHandle = Make_arbitrary_precision(taskData, recvd); addrHandle = SAVE(C_string_to_Poly(taskData, (char*)&resultAddr, addrLen)); pair = ALLOC(2); DEREFHANDLE(pair)->Set(0, lengthHandle->Word()); DEREFHANDLE(pair)->Set(1, addrHandle->Word()); return pair; } if ((err == WOULDBLOCK || err == INPROGRESS) && c == 54 /* blocking */) { WaitNet waiter(sock, outOfBand != 0); processes->ThreadPauseForIO(taskData, &waiter); // It is NOT safe to just loop here. We may have GCed. taskData->saveVec.reset(hSave); goto TryAgain; } else if (err != CALLINTERRUPTED) raise_syscall(taskData, "recvfrom failed", err); /* else try again */ } } case 55: /* Create a socket pair. */ -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) /* Not implemented. */ raise_syscall(taskData, "socketpair not implemented", WSAEAFNOSUPPORT); #else { Handle pair; int af = get_C_long(taskData, DEREFHANDLE(args)->Get(0)); int type = get_C_long(taskData, DEREFHANDLE(args)->Get(1)); int proto = get_C_long(taskData, DEREFHANDLE(args)->Get(2)); int onOff = 1; SOCKET skt[2]; if (socketpair(af, type, proto, skt) != 0) { switch (GETERROR) { case CALLINTERRUPTED: taskData->saveVec.reset(hSave); goto TryAgain; default: raise_syscall(taskData, "socketpair failed", GETERROR); } } /* Set the sockets to non-blocking mode. */ if (ioctl(skt[0], FIONBIO, &onOff) < 0 || ioctl(skt[1], FIONBIO, &onOff) < 0) { close(skt[0]); close(skt[1]); raise_syscall(taskData, "ioctl failed", GETERROR); } Handle str_token1 = wrapStreamSocket(taskData, skt[0]); Handle str_token2 = wrapStreamSocket(taskData, skt[1]); /* Return the two streams as a pair. */ pair = ALLOC(2); DEREFHANDLE(pair)->Set(0, DEREFWORD(str_token1)); DEREFHANDLE(pair)->Set(1, DEREFWORD(str_token2)); return pair; } #endif case 56: /* Create a Unix socket address from a string. */ -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) /* Not implemented. */ raise_syscall(taskData, "Unix addresses not implemented", WSAEAFNOSUPPORT); #else { struct sockaddr_un addr; memset(&addr, 0, sizeof(addr)); addr.sun_family = AF_UNIX; #ifdef HAVE_STRUCT_SOCKADDR_UN_SUN_LEN addr.sun_len = sizeof(addr); // Used in FreeBSD only. #endif POLYUNSIGNED length = Poly_string_to_C(DEREFWORD(args), addr.sun_path, sizeof(addr.sun_path)); if (length > (int)sizeof(addr.sun_path)) raise_syscall(taskData, "Address too long", ENAMETOOLONG); return SAVE(C_string_to_Poly(taskData, (char*)&addr, sizeof(addr))); } #endif case 57: /* Get the file name from a Unix socket address. */ -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) /* Not implemented. */ raise_syscall(taskData, "Unix addresses not implemented", WSAEAFNOSUPPORT); #else { PolyStringObject * psAddr = (PolyStringObject *)args->WordP(); struct sockaddr_un *psock = (struct sockaddr_un *)&psAddr->chars; return SAVE(C_string_to_Poly(taskData, psock->sun_path)); } #endif case 64: /* Blocking select call. Infinite timeout. */ return selectCall(taskData, args, 1); case 65: /* Polling select call. Zero timeout. */ return selectCall(taskData, args, 2); case 66: /* Select call with non-zero timeout. */ return selectCall(taskData, args, 0); default: { char msg[100]; sprintf(msg, "Unknown net function: %d", c); raise_exception_string(taskData, EXC_Fail, msg); return 0; } } } static Handle mkAddr(TaskData *taskData, void *arg, char *p) { int j; struct hostent *host = (struct hostent *)arg; unsigned long addr = 0; /* Addresses are in network order so this is fairly easy. In practice they will be 4 byte entries so we could just use ntohl. */ for (j = 0; j < host->h_length; j++) addr = (addr << 8) | ((*(char**)p)[j] & 255); return Make_arbitrary_precision(taskData, addr); } /* Convert a host entry into a tuple for ML. */ static Handle makeHostEntry(TaskData *taskData, struct hostent *host) { /* We need to do all this in the right order. We cannot construct the result tuple until all the values are ready. We have to save each entry on the save stack just in case of a garbage collection. */ int i; char **p; Handle aliases, name, addrType, result; Handle addrList = SAVE(ListNull); /* Canonical name. */ name = SAVE(C_string_to_Poly(taskData, host->h_name)); /* Aliases. */ for (i=0, p = host->h_aliases; *p != NULL; p++, i++); aliases = convert_string_list(taskData, i, host->h_aliases); /* Address type. */ addrType = Make_arbitrary_precision(taskData, host->h_addrtype); /* Addresses. */ /* Count them first and then work from the end back. */ for (i=0, p = host->h_addr_list; *p != NULL; p++, i++); addrList = makeList(taskData, i, (char*)host->h_addr_list, sizeof(char*), host, mkAddr); /* Make the result structure. */ result = ALLOC(4); DEREFHANDLE(result)->Set(0, name->Word()); DEREFHANDLE(result)->Set(1, aliases->Word()); DEREFHANDLE(result)->Set(2, addrType->Word()); DEREFHANDLE(result)->Set(3, addrList->Word()); return result; } static Handle makeProtoEntry(TaskData *taskData, struct protoent *proto) { int i; char **p; Handle aliases, name, protocol, result; /* Canonical name. */ name = SAVE(C_string_to_Poly(taskData, proto->p_name)); /* Aliases. */ for (i=0, p = proto->p_aliases; *p != NULL; p++, i++); aliases = convert_string_list(taskData, i, proto->p_aliases); /* Protocol number. */ protocol = Make_arbitrary_precision(taskData, proto->p_proto); /* Make the result structure. */ result = ALLOC(3); DEREFHANDLE(result)->Set(0, name->Word()); DEREFHANDLE(result)->Set(1, aliases->Word()); DEREFHANDLE(result)->Set(2, protocol->Word()); return result; } static Handle makeServEntry(TaskData *taskData, struct servent *serv) { int i; char **p; Handle aliases, name, protocol, result, port; /* Canonical name. */ name = SAVE(C_string_to_Poly(taskData, serv->s_name)); /* Aliases. */ for (i=0, p = serv->s_aliases; *p != NULL; p++, i++); aliases = convert_string_list(taskData, i, serv->s_aliases); /* Port number. */ port = Make_arbitrary_precision(taskData, ntohs(serv->s_port)); /* Protocol name. */ protocol = SAVE(C_string_to_Poly(taskData, serv->s_proto)); /* Make the result structure. */ result = ALLOC(4); DEREFHANDLE(result)->Set(0, name->Word()); DEREFHANDLE(result)->Set(1, aliases->Word()); DEREFHANDLE(result)->Set(2, port->Word()); DEREFHANDLE(result)->Set(3, protocol->Word()); return result; } static Handle mkAftab(TaskData *taskData, void *arg, char *p) { struct af_tab_struct *af = (struct af_tab_struct *)p; Handle result, name, num; /* Construct a pair of the string and the number. */ name = SAVE(C_string_to_Poly(taskData, af->af_name)); num = Make_arbitrary_precision(taskData, af->af_num); result = ALLOC(2); DEREFHANDLE(result)->Set(0, name->Word()); DEREFHANDLE(result)->Set(1, num->Word()); return result; } static Handle mkSktab(TaskData *taskData, void *arg, char *p) { struct sk_tab_struct *sk = (struct sk_tab_struct *)p; Handle result, name, num; /* Construct a pair of the string and the number. */ name = SAVE(C_string_to_Poly(taskData, sk->sk_name)); num = Make_arbitrary_precision(taskData, sk->sk_num); result = ALLOC(2); DEREFHANDLE(result)->Set(0, name->Word()); DEREFHANDLE(result)->Set(1, num->Word()); return result; } /* This sets an option and can also be used to set an integer. */ static Handle setSocketOption(TaskData *taskData, Handle args, int level, int opt) { SOCKET sock = getStreamSocket(taskData, DEREFHANDLE(args)->Get(0)); int onOff = get_C_int(taskData, DEREFHANDLE(args)->Get(1)); if (setsockopt(sock, level, opt, (char*)&onOff, sizeof(int)) != 0) raise_syscall(taskData, "setsockopt failed", GETERROR); return Make_arbitrary_precision(taskData, 0); } /* Get a socket option as a boolean */ static Handle getSocketOption(TaskData *taskData, Handle args, int level, int opt) { SOCKET sock = getStreamSocket(taskData, args->Word()); int onOff = 0; socklen_t size = sizeof(int); if (getsockopt(sock, level, opt, (char*)&onOff, &size) != 0) raise_syscall(taskData, "getsockopt failed", GETERROR); return Make_arbitrary_precision(taskData, onOff == 0 ? 0 : 1); } /* Get a socket option as an integer */ static Handle getSocketInt(TaskData *taskData, Handle args, int level, int opt) { SOCKET sock = getStreamSocket(taskData, args->Word()); int optVal = 0; socklen_t size = sizeof(int); if (getsockopt(sock, level, opt, (char*)&optVal, &size) != 0) raise_syscall(taskData, "getsockopt failed", GETERROR); return Make_arbitrary_precision(taskData, optVal); } // Helper function for selectCall. Creates the result vector of active sockets. static bool testBit(int offset, SOCKET fd, WaitSelect *pSelect) { switch (offset) { case 0: return pSelect->IsSetRead(fd); case 1: return pSelect->IsSetWrite(fd); case 2: return pSelect->IsSetExcept(fd); default: return false; } } static Handle getSelectResult(TaskData *taskData, Handle args, int offset, WaitSelect *pSelect) { /* Construct the result vectors. */ PolyObject *inVec = DEREFHANDLE(args)->Get(offset).AsObjPtr(); POLYUNSIGNED nVec = inVec->Length(); int nRes = 0; POLYUNSIGNED i; for (i = 0; i < nVec; i++) { SOCKET sock = getStreamSocket(taskData, inVec->Get(i)); if (testBit(offset, sock, pSelect)) nRes++; } if (nRes == 0) return ALLOC(0); /* None - return empty vector. */ else { Handle result = ALLOC(nRes); inVec = DEREFHANDLE(args)->Get(offset).AsObjPtr(); /* It could have moved as a result of a gc. */ nRes = 0; for (i = 0; i < nVec; i++) { SOCKET sock = getStreamSocket(taskData, inVec->Get(i)); if (testBit(offset, sock, pSelect)) DEREFWORDHANDLE(result)->Set(nRes++, inVec->Get(i)); } return result; } } /* Wrapper for "select" call. The arguments are arrays of socket ids. These arrays are updated so that "active" sockets are left unchanged and inactive sockets are set to minus one. */ static Handle selectCall(TaskData *taskData, Handle args, int blockType) { Handle hSave = taskData->saveVec.mark(); while (1) // Until we time-out or get a result. { POLYUNSIGNED i, nVec; Handle rdResult, wrResult, exResult, result; unsigned maxMillisecs = 1000; // Set the time to the maximum i.e. block switch (blockType) { case 0: /* Check the timeout. */ { /* The time argument is an absolute time. */ -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) FILETIME ftTime, ftNow; /* Get the file time. */ getFileTimeFromArb(taskData, taskData->saveVec.push(DEREFHANDLE(args)->Get(3)), &ftTime); GetSystemTimeAsFileTime(&ftNow); /* If the timeout time is earlier than the current time we must return, otherwise we block. */ if (CompareFileTime(&ftTime, &ftNow) <= 0) maxMillisecs = 0; else { subFiletimes(&ftTime, &ftNow); if (ftTime.dwHighDateTime > 0 || ftTime.dwLowDateTime > 10000000) maxMillisecs = 1000; // No more than 1 second else maxMillisecs = ftTime.dwLowDateTime / 10000; } #else /* Unix */ struct timeval tvTime, tvNow; /* We have a value in microseconds. We need to split it into seconds and microseconds. */ Handle hTime = SAVE(DEREFWORDHANDLE(args)->Get(3)); Handle hMillion = Make_arbitrary_precision(taskData, 1000000); tvTime.tv_sec = get_C_ulong(taskData, DEREFWORD(div_longc(taskData, hMillion, hTime))); tvTime.tv_usec = get_C_ulong(taskData, DEREFWORD(rem_longc(taskData, hMillion, hTime))); /* If the timeout time is earlier than the current time we must return, otherwise we block. */ if (gettimeofday(&tvNow, NULL) != 0) raise_syscall(taskData, "gettimeofday failed", errno); if (tvNow.tv_sec > tvTime.tv_sec || (tvNow.tv_sec == tvTime.tv_sec && tvNow.tv_usec >= tvTime.tv_usec)) maxMillisecs = 0; else { subTimevals(&tvTime, &tvNow); if (tvTime.tv_sec >= 1) maxMillisecs = 1000; // Don't overflow if it's very long else maxMillisecs = tvTime.tv_usec / 1000; } #endif break; } case 1: // Block until one of the descriptors is ready. maxMillisecs = 1000; // Max 1 second break; case 2: // Just a simple poll maxMillisecs = 0; break; } WaitSelect waitSelect(maxMillisecs); /* Set up the bitmaps for the select call from the arrays. */ PolyObject *readVec = DEREFHANDLE(args)->Get(0).AsObjPtr(); PolyObject *writeVec = DEREFHANDLE(args)->Get(1).AsObjPtr(); PolyObject *excVec = DEREFHANDLE(args)->Get(2).AsObjPtr(); nVec = readVec->Length(); for (i = 0; i < nVec; i++) waitSelect.SetRead(getStreamSocket(taskData, readVec->Get(i))); nVec = writeVec->Length(); for (i = 0; i < nVec; i++) waitSelect.SetWrite(getStreamSocket(taskData, writeVec->Get(i))); nVec = excVec->Length(); for (i = 0; i < nVec; i++) waitSelect.SetExcept(getStreamSocket(taskData, excVec->Get(i))); // Do the select. This may return immediately if the maximum time-out is short. processes->ThreadPauseForIO(taskData, &waitSelect); if (waitSelect.SelectResult() < 0) raise_syscall(taskData, "select failed", waitSelect.SelectError()); else if (waitSelect.SelectResult() > 0 || maxMillisecs == 0) { // There was a result or the time expired or it was just a poll. // Construct the result vectors. rdResult = getSelectResult(taskData, args, 0, &waitSelect); wrResult = getSelectResult(taskData, args, 1, &waitSelect); exResult = getSelectResult(taskData, args, 2, &waitSelect); result = ALLOC(3); DEREFHANDLE(result)->Set(0, rdResult->Word()); DEREFHANDLE(result)->Set(1, wrResult->Word()); DEREFHANDLE(result)->Set(2, exResult->Word()); return result; } // else try again. taskData->saveVec.reset(hSave); } } // General interface to networking. Ideally the various cases will be made into // separate functions. POLYUNSIGNED PolyNetworkGeneral(PolyObject *threadId, PolyWord code, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedCode = taskData->saveVec.push(code); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { result = Net_dispatch_c(taskData, pushedArg, pushedCode); } catch (KillException &) { processes->ThreadExit(taskData); // May test for kill } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } POLYUNSIGNED PolyNetworkGetServByName(PolyObject *threadId, PolyWord serviceName) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); /* Get service given service name only. */ TempCString servName(Poly_string_to_C_alloc(serviceName)); struct servent *serv = getservbyname (servName, NULL); // If this fails the ML function returns NONE Handle result = serv == NULL ? 0 : makeServEntry(taskData, serv); taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } POLYUNSIGNED PolyNetworkGetServByNameAndProtocol(PolyObject *threadId, PolyWord serviceName, PolyWord protName) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); /* Get service given service name and protocol name. */ TempCString servName(Poly_string_to_C_alloc(serviceName)); TempCString protoName(Poly_string_to_C_alloc(protName)); struct servent *serv = getservbyname (servName, protoName); Handle result = serv == NULL ? 0 : makeServEntry(taskData, serv); taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } POLYUNSIGNED PolyNetworkGetServByPort(PolyObject *threadId, PolyWord portNo) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); /* Get service given port number only. */ long port = htons(get_C_ushort(taskData, portNo)); struct servent *serv = getservbyport(port, NULL); Handle result = serv == NULL ? 0 : makeServEntry(taskData, serv); taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } POLYUNSIGNED PolyNetworkGetServByPortAndProtocol(PolyObject *threadId, PolyWord portNo, PolyWord protName) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); /* Get service given port number and protocol name. */ long port = htons(get_C_ushort(taskData, portNo)); TempCString protoName(Poly_string_to_C_alloc(protName)); struct servent *serv = getservbyport (port, protoName); Handle result = serv == NULL ? 0 : makeServEntry(taskData, serv); taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } POLYUNSIGNED PolyNetworkGetProtByName(PolyObject *threadId, PolyWord protocolName) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); /* Look up protocol entry. */ TempCString protoName(Poly_string_to_C_alloc(protocolName)); struct protoent *proto = getprotobyname(protoName); // If this fails the ML function returns NONE Handle result = proto == NULL ? 0 : makeProtoEntry(taskData, proto); taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } POLYUNSIGNED PolyNetworkGetProtByNo(PolyObject *threadId, PolyWord protoNo) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); /* Look up protocol entry. */ int pNum = get_C_int(taskData, protoNo); struct protoent *proto = getprotobynumber(pNum); Handle result = proto == NULL ? 0 : makeProtoEntry(taskData, proto); taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } POLYUNSIGNED PolyNetworkGetHostName(PolyObject *threadId) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { /* Get the current host name. */ size_t size = 4096; TempCString hostName((char *)malloc(size)); if (hostName == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); int err; while ((err = gethostname(hostName, size)) != 0 && GETERROR == ENAMETOOLONG) { if (size > std::numeric_limits::max() / 2) raise_fail(taskData, "gethostname needs too large a buffer"); size *= 2; char *new_buf = (char *)realloc(hostName, size); if (new_buf == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); hostName = new_buf; } if (err != 0) raise_syscall(taskData, "gethostname failed", GETERROR); result = SAVE(C_string_to_Poly(taskData, hostName)); } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } POLYUNSIGNED PolyNetworkGetHostByName(PolyObject *threadId, PolyWord hName) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); /* Look up a host name. */ TempCString hostName(Poly_string_to_C_alloc(hName)); struct hostent *host = gethostbyname(hostName); // If this fails the ML function returns NONE Handle result = host == NULL ? 0 : makeHostEntry(taskData, host); taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } POLYUNSIGNED PolyNetworkGetHostByAddr(PolyObject *threadId, PolyWord hostAddr) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); /* Look up entry by address. */ unsigned long addr = htonl(get_C_unsigned(taskData, hostAddr)); /* Look up a host name given an address. */ struct hostent *host = gethostbyaddr((char*)&addr, sizeof(addr), AF_INET); Handle result = host == NULL ? 0 : makeHostEntry(taskData, host); taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } POLYUNSIGNED PolyNetworkCloseSocket(PolyObject *threadId, PolyWord strm) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; Handle pushedStream = taskData->saveVec.push(strm); try { // This is defined to raise an exception if the socket has already been closed -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) WinSocket *winskt = *(WinSocket**)(pushedStream->WordP()); if (winskt != 0) { if (closesocket(winskt->getSocket()) != 0) raise_syscall(taskData, "Error during close", GETERROR); } else raise_syscall(taskData, "Socket is closed", WSAEBADF); *(WinSocket **)(pushedStream->WordP()) = 0; // Mark as closed #else int descr = getStreamFileDescriptorWithoutCheck(pushedStream->Word()); if (descr >= 0) { if (close(descr) != 0) raise_syscall(taskData, "Error during close", GETERROR); } else raise_syscall(taskData, "Socket is closed", EBADF); *(int*)(pushedStream->WordP()) = 0; // Mark as closed #endif result = Make_fixed_precision(taskData, 0); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } struct _entrypts networkingEPT[] = { { "PolyNetworkGeneral", (polyRTSFunction)&PolyNetworkGeneral}, { "PolyNetworkGetServByName", (polyRTSFunction)&PolyNetworkGetServByName}, { "PolyNetworkGetServByNameAndProtocol", (polyRTSFunction)&PolyNetworkGetServByNameAndProtocol}, { "PolyNetworkGetServByPort", (polyRTSFunction)&PolyNetworkGetServByPort}, { "PolyNetworkGetServByPortAndProtocol", (polyRTSFunction)&PolyNetworkGetServByPortAndProtocol}, { "PolyNetworkGetProtByName", (polyRTSFunction)&PolyNetworkGetProtByName}, { "PolyNetworkGetProtByNo", (polyRTSFunction)&PolyNetworkGetProtByNo}, { "PolyNetworkGetHostName", (polyRTSFunction)&PolyNetworkGetHostName}, { "PolyNetworkGetHostByName", (polyRTSFunction)&PolyNetworkGetHostByName}, { "PolyNetworkGetHostByAddr", (polyRTSFunction)&PolyNetworkGetHostByAddr}, { "PolyNetworkCloseSocket", (polyRTSFunction)&PolyNetworkCloseSocket }, { NULL, NULL} // End of list. }; class Networking: public RtsModule { public: virtual void Init(void); virtual void Stop(void); }; // Declare this. It will be automatically added to the table. static Networking networkingModule; void Networking::Init(void) { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #define WINSOCK_MAJOR_VERSION 2 #define WINSOCK_MINOR_VERSION 2 WSADATA wsaData; WORD wVersion = MAKEWORD(WINSOCK_MINOR_VERSION, WINSOCK_MAJOR_VERSION); /* Initialise the system and check that the version it supplied is the one we requested. */ if(WSAStartup(wVersion, &wsaData) == 0) { if (wsaData.wVersion == wVersion) winsock_init = 1; else WSACleanup(); } #endif } void Networking::Stop(void) { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) if (winsock_init) WSACleanup(); winsock_init = 0; #endif } diff --git a/libpolyml/polyffi.cpp b/libpolyml/polyffi.cpp index 3dc9cc7c..2ffb7e8d 100644 --- a/libpolyml/polyffi.cpp +++ b/libpolyml/polyffi.cpp @@ -1,686 +1,686 @@ /* Title: New Foreign Function Interface Copyright (c) 2015, 2018, 2019 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #if (defined(_WIN32) || (defined(HAVE_DLOPEN))) #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_DLFCN_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) 0 #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_MALLOC_H #include #endif #ifdef HAVE_STRING_H #include #endif #include "globals.h" // TODO: Do we need this?? // We need to include globals.h before in mingw64 otherwise // it messes up POLYUFMT/POLYSFMT. #include #include #include "arb.h" #include "save_vec.h" #include "polyffi.h" #include "run_time.h" #include "sys.h" #include "processes.h" #include "polystring.h" -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #include #include "winstartup.h" /* For hApplicationInstance. */ #endif #include "scanaddrs.h" #include "diagnostics.h" #include "reals.h" #include "rts_module.h" #include "rtsentry.h" static Handle poly_ffi (TaskData *taskData, Handle args, Handle code); extern "C" { POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFIGeneral(PolyObject *threadId, PolyWord code, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolySizeFloat(); POLYEXTERNALSYMBOL POLYUNSIGNED PolySizeDouble(); POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFIGetError(PolyWord addr); POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFISetError(PolyWord err); POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFICreateExtFn(PolyObject *threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFICreateExtData(PolyObject *threadId, PolyWord arg); } static struct _abiTable { const char *abiName; ffi_abi abiCode; } abiTable[] = { // Unfortunately the ABI entries are enums rather than #defines so we // can't test individual entries. #ifdef X86_WIN32 {"sysv", FFI_SYSV}, {"stdcall", FFI_STDCALL}, {"thiscall", FFI_THISCALL}, {"fastcall", FFI_FASTCALL}, {"ms_cdecl", FFI_MS_CDECL}, #elif defined(X86_WIN64) {"win64", FFI_WIN64}, #elif defined(X86_ANY) {"unix64", FFI_UNIX64}, #endif { "default", FFI_DEFAULT_ABI} }; // Table of constants returned by call 51 static int constantTable[] = { FFI_DEFAULT_ABI, // Default ABI FFI_TYPE_VOID, // Type codes FFI_TYPE_INT, FFI_TYPE_FLOAT, FFI_TYPE_DOUBLE, FFI_TYPE_UINT8, FFI_TYPE_SINT8, FFI_TYPE_UINT16, FFI_TYPE_SINT16, FFI_TYPE_UINT32, FFI_TYPE_SINT32, FFI_TYPE_UINT64, FFI_TYPE_SINT64, FFI_TYPE_STRUCT, FFI_TYPE_POINTER, FFI_SIZEOF_ARG // Minimum size for result space }; // Table of predefined ffi types static ffi_type *ffiTypeTable[] = { &ffi_type_void, &ffi_type_uint8, &ffi_type_sint8, &ffi_type_uint16, &ffi_type_sint16, &ffi_type_uint32, &ffi_type_sint32, &ffi_type_uint64, &ffi_type_sint64, &ffi_type_float, &ffi_type_double, &ffi_type_pointer, &ffi_type_uchar, // These are all aliases for the above &ffi_type_schar, &ffi_type_ushort, &ffi_type_sshort, &ffi_type_uint, &ffi_type_sint, &ffi_type_ulong, &ffi_type_slong }; // Callback entry table static struct _cbStructEntry { PolyWord mlFunction; // The ML function to call void *closureSpace; // Space allocated for the closure void *resultFunction; // Executable address for the function. Needed to free. } *callbackTable; static unsigned callBackEntries = 0; static PLock callbackTableLock; // Mutex to protect table. static Handle mkAbitab(TaskData *taskData, void*, char *p); static void callbackEntryPt(ffi_cif *cif, void *ret, void* args[], void *data); static Handle toSysWord(TaskData *taskData, void *p) { return Make_sysword(taskData, (uintptr_t)p); } Handle poly_ffi(TaskData *taskData, Handle args, Handle code) { unsigned c = get_C_unsigned(taskData, code->Word()); switch (c) { case 0: // malloc { POLYUNSIGNED size = getPolyUnsigned(taskData, args->Word()); return toSysWord(taskData, malloc(size)); } case 1: // free { void *mem = *(void**)(args->WordP()); free(mem); return taskData->saveVec.push(TAGGED(0)); } case 2: // Load library { TempString libName(args->Word()); -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) HINSTANCE lib = LoadLibrary(libName); if (lib == NULL) { char buf[256]; #if (defined(UNICODE)) _snprintf(buf, sizeof(buf), "Loading <%S> failed. Error %lu", (LPCTSTR)libName, GetLastError()); #else _snprintf(buf, sizeof(buf), "Loading <%s> failed. Error %lu", (const char*)libName, GetLastError()); #endif buf[sizeof(buf)-1] = 0; // Terminate just in case raise_exception_string(taskData, EXC_foreign, buf); } #else void *lib = dlopen(libName, RTLD_LAZY); if (lib == NULL) { char buf[256]; snprintf(buf, sizeof(buf), "Loading <%s> failed: %s", (const char *)libName, dlerror()); buf[sizeof(buf)-1] = 0; // Terminate just in case raise_exception_string(taskData, EXC_foreign, buf); } #endif return toSysWord(taskData, lib); } case 3: // Load address of executable. { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) HINSTANCE lib = hApplicationInstance; #else void *lib = dlopen(NULL, RTLD_LAZY); if (lib == NULL) { char buf[256]; snprintf(buf, sizeof(buf), "Loading address of executable failed: %s", dlerror()); buf[sizeof(buf)-1] = 0; // Terminate just in case raise_exception_string(taskData, EXC_foreign, buf); } #endif return toSysWord(taskData, lib); } case 4: // Unload library - Is this actually going to be used? { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) HMODULE hMod = *(HMODULE*)(args->WordP()); if (! FreeLibrary(hMod)) raise_syscall(taskData, "FreeLibrary failed", GetLastError()); #else void *lib = *(void**)(args->WordP()); if (dlclose(lib) != 0) { char buf[256]; snprintf(buf, sizeof(buf), "dlclose failed: %s", dlerror()); buf[sizeof(buf)-1] = 0; // Terminate just in case raise_exception_string(taskData, EXC_foreign, buf); } #endif return taskData->saveVec.push(TAGGED(0)); } case 5: // Load the address of a symbol from a library. { TempCString symName(args->WordP()->Get(1)); -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) HMODULE hMod = *(HMODULE*)(args->WordP()->Get(0).AsAddress()); void *sym = (void*)GetProcAddress(hMod, symName); if (sym == NULL) { char buf[256]; _snprintf(buf, sizeof(buf), "Loading symbol <%s> failed. Error %lu", (LPCSTR)symName, GetLastError()); buf[sizeof(buf)-1] = 0; // Terminate just in case raise_exception_string(taskData, EXC_foreign, buf); } #else void *lib = *(void**)(args->WordP()->Get(0).AsAddress()); void *sym = dlsym(lib, symName); if (sym == NULL) { char buf[256]; snprintf(buf, sizeof(buf), "load_sym <%s> : %s", (const char *)symName, dlerror()); buf[sizeof(buf)-1] = 0; // Terminate just in case raise_exception_string(taskData, EXC_foreign, buf); } #endif return toSysWord(taskData, sym); } // Libffi functions case 50: // Return a list of available ABIs return makeList(taskData, sizeof(abiTable)/sizeof(abiTable[0]), (char*)abiTable, sizeof(abiTable[0]), 0, mkAbitab); case 51: // A constant from the table { unsigned index = get_C_unsigned(taskData, args->Word()); if (index >= sizeof(constantTable) / sizeof(constantTable[0])) raise_exception_string(taskData, EXC_foreign, "Index out of range"); return Make_arbitrary_precision(taskData, constantTable[index]); } case 52: // Return an FFI type { unsigned index = get_C_unsigned(taskData, args->Word()); if (index >= sizeof(ffiTypeTable) / sizeof(ffiTypeTable[0])) raise_exception_string(taskData, EXC_foreign, "Index out of range"); return toSysWord(taskData, ffiTypeTable[index]); } case 53: // Extract fields from ffi type. { ffi_type *ffit = *(ffi_type**)(args->WordP()); Handle sizeHandle = Make_arbitrary_precision(taskData, ffit->size); Handle alignHandle = Make_arbitrary_precision(taskData, ffit->alignment); Handle typeHandle = Make_arbitrary_precision(taskData, ffit->type); Handle elemHandle = toSysWord(taskData, ffit->elements); Handle resHandle = alloc_and_save(taskData, 4); resHandle->WordP()->Set(0, sizeHandle->Word()); resHandle->WordP()->Set(1, alignHandle->Word()); resHandle->WordP()->Set(2, typeHandle->Word()); resHandle->WordP()->Set(3, elemHandle->Word()); return resHandle; } case 54: // Construct an ffi type. { // This is probably only used to create structs. size_t size = getPolyUnsigned(taskData, args->WordP()->Get(0)); unsigned short align = get_C_ushort(taskData, args->WordP()->Get(1)); unsigned short type = get_C_ushort(taskData, args->WordP()->Get(2)); unsigned nElems = 0; for (PolyWord p = args->WordP()->Get(3); !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t) nElems++; size_t space = sizeof(ffi_type); // If we need the elements add space for the elements plus // one extra for the zero terminator. if (nElems != 0) space += (nElems+1) * sizeof(ffi_type *); ffi_type *result = (ffi_type*)calloc(1, space); // Raise an exception rather than returning zero. if (result == 0) raise_syscall(taskData, "Insufficient memory", ENOMEM); ffi_type **elem = 0; if (nElems != 0) elem = (ffi_type **)(result+1); result->size = size; result->alignment = align; result->type = type; result->elements = elem; if (elem != 0) { for (PolyWord p = args->WordP()->Get(3); !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t) { PolyWord e = ((ML_Cons_Cell*)p.AsObjPtr())->h; *elem++ = *(ffi_type**)(e.AsAddress()); } *elem = 0; } return toSysWord(taskData, result); } case 55: // Create a CIF. This contains all the types and some extra information. // The result is in allocated memory followed immediately by the argument type vector. { ffi_abi abi = (ffi_abi)get_C_ushort(taskData, args->WordP()->Get(0)); ffi_type *rtype = *(ffi_type **)args->WordP()->Get(1).AsAddress(); unsigned nArgs = 0; for (PolyWord p = args->WordP()->Get(2); !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t) nArgs++; // Allocate space for the cif followed by the argument type vector size_t space = sizeof(ffi_cif) + nArgs * sizeof(ffi_type*); ffi_cif *cif = (ffi_cif *)malloc(space); if (cif == 0) raise_syscall(taskData, "Insufficient memory", ENOMEM); ffi_type **atypes = (ffi_type **)(cif+1); // Copy the arguments types. ffi_type **at = atypes; for (PolyWord p = args->WordP()->Get(2); !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t) { PolyWord e = ((ML_Cons_Cell*)p.AsObjPtr())->h; *at++ = *(ffi_type**)(e.AsAddress()); } ffi_status status = ffi_prep_cif(cif, abi, nArgs, rtype, atypes); if (status == FFI_BAD_TYPEDEF) raise_exception_string(taskData, EXC_foreign, "Bad typedef in ffi_prep_cif"); else if (status == FFI_BAD_ABI) raise_exception_string(taskData, EXC_foreign, "Bad ABI in ffi_prep_cif"); else if (status != FFI_OK) raise_exception_string(taskData, EXC_foreign, "Error in ffi_prep_cif"); return toSysWord(taskData, cif); } case 56: // Call a function. { ffi_cif *cif = *(ffi_cif **)args->WordP()->Get(0).AsAddress(); void *f = *(void**)args->WordP()->Get(1).AsAddress(); void *res = *(void**)args->WordP()->Get(2).AsAddress(); void **arg = *(void***)args->WordP()->Get(3).AsAddress(); // We release the ML memory across the call so a GC can occur // even if this thread is blocked in the C code. processes->ThreadReleaseMLMemory(taskData); ffi_call(cif, FFI_FN(f), res, arg); // Do we need to save the value of errno/GetLastError here? processes->ThreadUseMLMemory(taskData); return taskData->saveVec.push(TAGGED(0)); } case 57: // Create a callback. { #ifdef INTERPRETED raise_exception_string(taskData, EXC_foreign, "Callbacks are not implemented in the byte code interpreter"); #endif Handle mlFunction = taskData->saveVec.push(args->WordP()->Get(0)); ffi_cif *cif = *(ffi_cif **)args->WordP()->Get(1).AsAddress(); void *resultFunction; // Allocate the memory. resultFunction is set to the executable address in or related to // the memory. ffi_closure *closure = (ffi_closure *)ffi_closure_alloc(sizeof(ffi_closure), &resultFunction); if (closure == 0) raise_exception_string(taskData, EXC_foreign, "Callbacks not implemented or insufficient memory"); PLocker pLocker(&callbackTableLock); // Find a free entry in the table if there is one. unsigned entryNo = 0; while (entryNo < callBackEntries && callbackTable[entryNo].closureSpace != 0) entryNo++; if (entryNo == callBackEntries) { // Need to grow the table. struct _cbStructEntry *newTable = (struct _cbStructEntry*)realloc(callbackTable, (callBackEntries+1)*sizeof(struct _cbStructEntry)); if (newTable == 0) raise_exception_string(taskData, EXC_foreign, "Unable to allocate memory for callback table"); callbackTable = newTable; callBackEntries++; } callbackTable[entryNo].mlFunction = mlFunction->Word(); callbackTable[entryNo].closureSpace = closure; callbackTable[entryNo].resultFunction = resultFunction; if (ffi_prep_closure_loc(closure, cif, callbackEntryPt, (void*)((uintptr_t)entryNo), resultFunction) != FFI_OK) raise_exception_string(taskData, EXC_foreign,"libffi error: ffi_prep_closure_loc failed"); return toSysWord(taskData, resultFunction); } case 58: // Free an existing callback. { // The address returned from call 57 above is the executable address that can // be passed as a callback function. The writable memory address returned // as the result of ffi_closure_alloc may or may not be the same. To be safe // we need to search the table. void *resFun = *(void**)args->Word().AsAddress(); PLocker pLocker(&callbackTableLock); for (unsigned i = 0; i < callBackEntries; i++) { if (callbackTable[i].resultFunction == resFun) { ffi_closure_free(callbackTable[i].closureSpace); callbackTable[i].closureSpace = 0; callbackTable[i].resultFunction = 0; callbackTable[i].mlFunction = TAGGED(0); // Release the ML function return taskData->saveVec.push(TAGGED(0)); } } raise_exception_string(taskData, EXC_foreign, "Invalid callback entry"); } default: { char msg[100]; sprintf(msg, "Unknown ffi function: %d", c); raise_exception_string(taskData, EXC_foreign, msg); return 0; } } } // Construct an entry in the ABI table. static Handle mkAbitab(TaskData *taskData, void *arg, char *p) { struct _abiTable *ab = (struct _abiTable *)p; // Construct a pair of the string and the code Handle name = taskData->saveVec.push(C_string_to_Poly(taskData, ab->abiName)); Handle code = Make_arbitrary_precision(taskData, ab->abiCode); Handle result = alloc_and_save(taskData, 2); result->WordP()->Set(0, name->Word()); result->WordP()->Set(1, code->Word()); return result; } // This is the C function that will get control when any callback is made. The "data" // argument is the index of the entry in the callback table.. static void callbackEntryPt(ffi_cif *cif, void *ret, void* args[], void *data) { uintptr_t cbIndex = (uintptr_t)data; ASSERT(cbIndex < callBackEntries); // We should get the task data for the thread that is running this code. // If this thread has been created by the foreign code we will have to // create a new one here. TaskData *taskData = processes->GetTaskDataForThread(); if (taskData == 0) { try { taskData = processes->CreateNewTaskData(0, 0, 0, TAGGED(0)); } catch (std::bad_alloc &) { ::Exit("Unable to create thread data - insufficient memory"); } catch (MemoryException &) { ::Exit("Unable to create thread data - insufficient memory"); } } else processes->ThreadUseMLMemory(taskData); // We may get multiple calls to call-backs and we mustn't risk // overflowing the save-vec. Handle mark = taskData->saveVec.mark(); // In the future we might want to call C functions without some of the // overhead that comes with an RTS call which may allocate in ML // memory. If we do that we also have to ensure that callbacks // don't allocate, so this code would have to change. Handle mlEntryHandle; { // Get the ML function. Lock to avoid another thread moving // callbackTable under our feet. PLocker pLocker(&callbackTableLock); struct _cbStructEntry *cbEntry = &callbackTable[cbIndex]; mlEntryHandle = taskData->saveVec.push(cbEntry->mlFunction); } // Create a pair of the arg vector and the result pointer. Handle argHandle = toSysWord(taskData, args); Handle resHandle = toSysWord(taskData, ret); // Result must go in here. Handle pairHandle = alloc_and_save(taskData, 2); pairHandle->WordP()->Set(0, argHandle->Word()); pairHandle->WordP()->Set(1, resHandle->Word()); taskData->EnterCallbackFunction(mlEntryHandle, pairHandle); taskData->saveVec.reset(mark); // Release ML memory now we're going back to C. processes->ThreadReleaseMLMemory(taskData); } class PolyFFI: public RtsModule { public: virtual void GarbageCollect(ScanAddress *process); }; // Declare this. It will be automatically added to the table. static PolyFFI polyFFIModule; // We need to scan the callback table. void PolyFFI::GarbageCollect(ScanAddress *process) { for (unsigned i = 0; i < callBackEntries; i++) process->ScanRuntimeWord(&callbackTable[i].mlFunction); } #else // The foreign function interface isn't available. #include "polyffi.h" #include "run_time.h" #include "sys.h" Handle poly_ffi(TaskData *taskData, Handle args, Handle code) { raise_exception_string(taskData, EXC_foreign, "The foreign function interface is not available on this platform"); } #endif // General interface to IO. Ideally the various cases will be made into // separate functions. POLYUNSIGNED PolyFFIGeneral(PolyObject *threadId, PolyWord code, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedCode = taskData->saveVec.push(code); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { result = poly_ffi(taskData, pushedArg, pushedCode); } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // These functions are needed in the compiler POLYUNSIGNED PolySizeFloat() { return TAGGED((POLYSIGNED)ffi_type_float.size).AsUnsigned(); } POLYUNSIGNED PolySizeDouble() { return TAGGED((POLYSIGNED)ffi_type_double.size).AsUnsigned(); } // Get either errno or GetLastError POLYUNSIGNED PolyFFIGetError(PolyWord addr) { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) addr.AsObjPtr()->Set(0, PolyWord::FromUnsigned(GetLastError())); #else addr.AsObjPtr()->Set(0, PolyWord::FromUnsigned((POLYUNSIGNED)errno)); #endif return 0; } // The argument is a SysWord.word value i.e. the address of a byte cell. POLYUNSIGNED PolyFFISetError(PolyWord err) { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) SetLastError((DWORD)(err.AsObjPtr()->Get(0).AsUnsigned())); #else errno = err.AsObjPtr()->Get(0).AsSigned(); #endif return 0; } // Create an external function reference. The value returned has space for // an address followed by the name of the external symbol. Because the // address comes at the beginning it can be used in the same way as the // SysWord value returned by the get-symbol call from a library. POLYUNSIGNED PolyFFICreateExtFn(PolyObject *threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { result = creatEntryPointObject(taskData, pushedArg, true); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Create an external reference to data. On a small number of platforms // different forms of relocation are needed for data and for functions. POLYUNSIGNED PolyFFICreateExtData(PolyObject *threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { result = creatEntryPointObject(taskData, pushedArg, false); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } struct _entrypts polyFFIEPT[] = { { "PolyFFIGeneral", (polyRTSFunction)&PolyFFIGeneral}, { "PolySizeFloat", (polyRTSFunction)&PolySizeFloat}, { "PolySizeDouble", (polyRTSFunction)&PolySizeDouble}, { "PolyFFIGetError", (polyRTSFunction)&PolyFFIGetError}, { "PolyFFISetError", (polyRTSFunction)&PolyFFISetError}, { "PolyFFICreateExtFn", (polyRTSFunction)&PolyFFICreateExtFn}, { "PolyFFICreateExtData", (polyRTSFunction)&PolyFFICreateExtData }, { NULL, NULL} // End of list. }; diff --git a/libpolyml/process_env.cpp b/libpolyml/process_env.cpp index 3969a6bd..57cb77a3 100644 --- a/libpolyml/process_env.cpp +++ b/libpolyml/process_env.cpp @@ -1,763 +1,763 @@ /* Title: Process environment. Copyright (c) 2000-8, 2016-17 David C. J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_SYS_PARAM_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_SYS_WAIT_H #include #endif #if (defined(__CYGWIN__) || defined(_WIN32)) #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) 0 #endif // Include this next before errors.h since in WinCE at least the winsock errors are defined there. -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #include #include #define NOMEMORY ERROR_NOT_ENOUGH_MEMORY #undef ENOMEM #else typedef char TCHAR; #define _tgetenv getenv #define NOMEMORY ENOMEM #endif #include "globals.h" #include "sys.h" #include "run_time.h" #include "process_env.h" #include "arb.h" #include "mpoly.h" #include "gc.h" #include "scanaddrs.h" #include "polystring.h" #include "save_vec.h" #include "process_env.h" #include "rts_module.h" #include "machine_dep.h" #include "processes.h" #include "locking.h" #include "errors.h" #include "rtsentry.h" #include "version.h" extern "C" { POLYEXTERNALSYMBOL void PolyFinish(PolyObject *threadId, PolyWord arg); POLYEXTERNALSYMBOL void PolyTerminate(PolyObject *threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyProcessEnvGeneral(PolyObject *threadId, PolyWord code, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyProcessEnvErrorName(PolyObject *threadId, PolyWord syserr); POLYEXTERNALSYMBOL POLYUNSIGNED PolyProcessEnvErrorMessage(PolyObject *threadId, PolyWord syserr); POLYEXTERNALSYMBOL POLYUNSIGNED PolyProcessEnvErrorFromString(PolyObject *threadId, PolyWord string); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetMaxAllocationSize(); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetMaxStringSize(); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetPolyVersionNumber(); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetFunctionName(PolyObject *threadId, PolyWord fnAddr); } #define SAVE(x) mdTaskData->saveVec.push(x) #define ALLOC(n) alloc_and_save(mdTaskData, n) -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #define ISPATHSEPARATOR(c) ((c) == '\\' || (c) == '/') #define DEFAULTSEPARATOR "\\" #else #define ISPATHSEPARATOR(c) ((c) == '/') #define DEFAULTSEPARATOR "/" #endif #ifdef _MSC_VER // Don't tell me about ISO C++ changes. #pragma warning(disable:4996) #endif // "environ" is declared in the headers on some systems but not all. // Oddly, declaring it within process_env_dispatch_c causes problems // on mingw where "environ" is actually a function. #if __APPLE__ // On Mac OS X there may be problems accessing environ directly. #include #define environ (*_NSGetEnviron()) #else extern char **environ; #endif /* Functions registered with atExit are added to this list. */ static PolyWord at_exit_list = TAGGED(0); /* Once "exit" is called this flag is set and no further calls to atExit are allowed. */ static bool exiting = false; static PLock atExitLock; // Thread lock for above. #ifdef __CYGWIN__ // Cygwin requires spawnvp to avoid the significant overhead of vfork // but it doesn't seem to be thread-safe. Run it on the main thread // to be sure. class CygwinSpawnRequest: public MainThreadRequest { public: CygwinSpawnRequest(char **argv): MainThreadRequest(MTP_CYGWINSPAWN), spawnArgv(argv) {} virtual void Perform(); char **spawnArgv; int pid; }; void CygwinSpawnRequest::Perform() { pid = spawnvp(_P_NOWAIT, "/bin/sh", spawnArgv); } #endif static Handle process_env_dispatch_c(TaskData *mdTaskData, Handle args, Handle code) { unsigned c = get_C_unsigned(mdTaskData, DEREFWORD(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", NOMEMORY); 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_fixed_precision(mdTaskData, EXIT_SUCCESS); case 16: /* Return a failure value. */ return Make_fixed_precision(mdTaskData, EXIT_FAILURE); case 17: /* Run command. */ { TempString buff(args->Word()); if (buff == 0) raise_syscall(mdTaskData, "Insufficient memory", NOMEMORY); int res = -1; -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) // 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? execv("/bin/sh", argv); _exit(1); } #endif #endif while (true) { try { // Test to see if the child has returned. -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) 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", GetLastError()); CloseHandle((HANDLE)pid); return Make_fixed_precision(mdTaskData, result); } case WAIT_FAILED: raise_syscall(mdTaskData, "Function system failed", 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__)) +#if (defined(_WIN32)) CloseHandle((HANDLE)pid); #endif throw; } } return Make_fixed_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, args->Word()); at_exit_list = cell; } return Make_fixed_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, args->Word()); _exit(i); } /************ Error codes **************/ /************ 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, args->Word()); if (ISPATHSEPARATOR(e)) return Make_fixed_precision(mdTaskData, 1); else return Make_fixed_precision(mdTaskData, 0); } case 9: /* Are names case-sensitive? */ -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) /* Windows - no. */ return Make_fixed_precision(mdTaskData, 0); #else /* Unix - yes. */ return Make_fixed_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_fixed_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 = args->Word(); /* 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__)) +#if (defined(_WIN32)) TempString buff(path); if (buff == 0) raise_syscall(mdTaskData, "Insufficient memory", NOMEMORY); 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, sVol->Word()); 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_fixed_precision(mdTaskData, 0); } else { PolyStringObject * volume = (PolyStringObject *)(volName.AsObjPtr()); for (POLYUNSIGNED i = 0; i < volume->length; i++) { if (volume->chars[i] == '\0') return Make_fixed_precision(mdTaskData, 0); } } -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) // 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_fixed_precision(mdTaskData, 0); } if (*p >= 0 && *p <= 31) return Make_fixed_precision(mdTaskData, 0); } // Should we check for special names such as aux, con, prn ?? return Make_fixed_precision(mdTaskData, 1); #else // That's all we need for Unix. // TODO: Check for /. It's invalid in a file name arc. return Make_fixed_precision(mdTaskData, 1); #endif } case 104: return Make_arbitrary_precision(mdTaskData, POLY_version_number); case 105: /* Get the name of the function. */ { PolyObject *pt = DEREFWORDHANDLE(args); if (pt->IsCodeObject()) /* Should now be a code object. */ { /* Compiled code. This is the first constant in the constant area. */ PolyWord *codePt = pt->ConstPtrForCode(); PolyWord name = codePt[0]; /* May be zero indicating an anonymous segment - return null string. */ if (name == PolyWord::FromUnsigned(0)) return SAVE(C_string_to_Poly(mdTaskData, "")); else return SAVE(name); } else raise_syscall(mdTaskData, "Not a code pointer", 0); } default: { char msg[100]; sprintf(msg, "Unknown environment function: %d", c); raise_exception_string(mdTaskData, EXC_Fail, msg); return 0; } } } // General interface to process-env. Ideally the various cases will be made into // separate functions. POLYUNSIGNED PolyProcessEnvGeneral(PolyObject *threadId, PolyWord code, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedCode = taskData->saveVec.push(code); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { result = process_env_dispatch_c(taskData, pushedArg, pushedCode); } catch (KillException &) { processes->ThreadExit(taskData); // May test for kill } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Terminate normally with a result code. void PolyFinish(PolyObject *threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); int i = get_C_int(taskData, arg); // Cause the other threads to exit and set the result code. processes->RequestProcessExit(i); // Exit this thread processes->ThreadExit(taskData); // Doesn't return. } // Terminate without running the atExit list or flushing buffers void PolyTerminate(PolyObject *threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); int i = get_C_int(taskData, arg); _exit(i); // Doesn't return. } // Get the name of a numeric error message. POLYUNSIGNED PolyProcessEnvErrorName(PolyObject *threadId, PolyWord syserr) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { int e = (int)syserr.AsObjPtr()->Get(0).AsSigned(); // 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) result = taskData->saveVec.push(C_string_to_Poly(taskData, errorMsg)); else { // If it isn't in the table. char buff[40]; sprintf(buff, "ERROR%0d", e); result = taskData->saveVec.push(C_string_to_Poly(taskData, buff)); } } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } /* Get the explanatory message for an error. */ POLYUNSIGNED PolyProcessEnvErrorMessage(PolyObject *threadId, PolyWord syserr) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = errorMsg(taskData, (int)syserr.AsObjPtr()->Get(0).AsSigned()); } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Try to convert an error string to an error number. POLYUNSIGNED PolyProcessEnvErrorFromString(PolyObject *threadId, PolyWord string) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { char buff[40]; // Get the string. Poly_string_to_C(string, buff, sizeof(buff)); // Look the string up in the table. int err = 0; if (errorCodeFromString(buff, &err)) result = Make_sysword(taskData, err); else if (strncmp(buff, "ERROR", 5) == 0) // If we don't find it then it may have been a constructed error name. result = Make_sysword(taskData, atoi(buff+5)); else result = Make_sysword(taskData, 0); // Return 0w0 if it isn't there. } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Return the maximum size of a cell that can be allocated on the heap. POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetMaxAllocationSize() { return TAGGED(MAX_OBJECT_SIZE).AsUnsigned(); } // Return the maximum string size (in bytes). // It is the maximum number of bytes in a segment less one word for the length field. POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetMaxStringSize() { return TAGGED((MAX_OBJECT_SIZE) * sizeof(PolyWord) - sizeof(PolyWord)).AsUnsigned(); } POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetPolyVersionNumber() { return TAGGED(POLY_version_number).AsUnsigned(); } // Return the function name associated with a piece of compiled code. POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetFunctionName(PolyObject *threadId, PolyWord fnAddr) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { if (fnAddr.IsTagged()) raise_fail(taskData, "Not a code pointer"); PolyObject *pt = fnAddr.AsObjPtr(); // In 32-in-64 this may be a closure and the first word is the absolute address of the code. if (pt->IsClosureObject()) { // It may not be set yet. pt = *(PolyObject**)pt; if (((uintptr_t)pt & 1) == 1) raise_fail(taskData, "Not a code pointer"); } if (pt->IsCodeObject()) /* Should now be a code object. */ { /* Compiled code. This is the first constant in the constant area. */ PolyWord *codePt = pt->ConstPtrForCode(); PolyWord name = codePt[0]; /* May be zero indicating an anonymous segment - return null string. */ if (name == PolyWord::FromUnsigned(0)) result = taskData->saveVec.push(C_string_to_Poly(taskData, "")); else result = taskData->saveVec.push(name); } else raise_fail(taskData, "Not a code pointer"); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } struct _entrypts processEnvEPT[] = { { "PolyFinish", (polyRTSFunction)&PolyFinish}, { "PolyTerminate", (polyRTSFunction)&PolyTerminate}, { "PolyProcessEnvGeneral", (polyRTSFunction)&PolyProcessEnvGeneral}, { "PolyProcessEnvErrorName", (polyRTSFunction)&PolyProcessEnvErrorName}, { "PolyProcessEnvErrorMessage", (polyRTSFunction)&PolyProcessEnvErrorMessage}, { "PolyProcessEnvErrorFromString", (polyRTSFunction)&PolyProcessEnvErrorFromString}, { "PolyGetMaxAllocationSize", (polyRTSFunction)&PolyGetMaxAllocationSize }, { "PolyGetMaxStringSize", (polyRTSFunction)&PolyGetMaxStringSize }, { "PolyGetPolyVersionNumber", (polyRTSFunction)&PolyGetPolyVersionNumber }, { "PolyGetFunctionName", (polyRTSFunction)&PolyGetFunctionName }, { NULL, NULL} // End of list. }; class ProcessEnvModule: public RtsModule { public: void GarbageCollect(ScanAddress *process); }; // Declare this. It will be automatically added to the table. static ProcessEnvModule processModule; void ProcessEnvModule::GarbageCollect(ScanAddress *process) /* Ensures that all the objects are retained and their addresses updated. */ { if (at_exit_list.IsDataPtr()) { PolyObject *obj = at_exit_list.AsObjPtr(); process->ScanRuntimeAddress(&obj, ScanAddress::STRENGTH_STRONG); at_exit_list = obj; } } diff --git a/libpolyml/processes.cpp b/libpolyml/processes.cpp index 2102e01a..145f7f97 100644 --- a/libpolyml/processes.cpp +++ b/libpolyml/processes.cpp @@ -1,2250 +1,2250 @@ /* Title: Thread functions Author: David C.J. Matthews Copyright (c) 2007,2008,2013-15, 2017, 2019 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_LIMITS_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif #ifdef HAVE_PROCESS_H #include #endif #ifdef HAVE_SYS_TYPES_H #include #endif #ifdef HAVE_SYS_STAT_H #include #endif #ifdef HAVE_SYS_TIME_H #include #endif #ifdef HAVE_UNISTD_H #include // Want unistd for _SC_NPROCESSORS_ONLN at least #endif #ifdef HAVE_SYS_SELECT_H #include #endif #ifdef HAVE_WINDOWS_H #include #endif -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_LIBPTHREAD) && defined(HAVE_PTHREAD_H)) +#if (!defined(_WIN32)) #define HAVE_PTHREAD 1 #include #endif #ifdef HAVE_SYS_SYSCTL_H // Used determine number of processors in Mac OS X. #include #endif -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #include #endif #include #include /************************************************************************ * * Include runtime headers * ************************************************************************/ #include "globals.h" #include "gc.h" #include "mpoly.h" #include "arb.h" #include "machine_dep.h" #include "diagnostics.h" #include "processes.h" #include "run_time.h" #include "sys.h" #include "sighandler.h" #include "scanaddrs.h" #include "save_vec.h" #include "rts_module.h" #include "noreturn.h" #include "memmgr.h" #include "locking.h" #include "profiling.h" #include "sharedata.h" #include "exporter.h" #include "statistics.h" #include "rtsentry.h" extern "C" { POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadGeneral(PolyObject *threadId, PolyWord code, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadKillSelf(PolyObject *threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadMutexBlock(PolyObject *threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadMutexUnlock(PolyObject *threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadCondVarWait(PolyObject *threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadCondVarWaitUntil(PolyObject *threadId, PolyWord lockArg, PolyWord timeArg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadCondVarWake(PolyWord targetThread); POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadForkThread(PolyObject *threadId, PolyWord function, PolyWord attrs, PolyWord stack); POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadIsActive(PolyWord targetThread); POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadInterruptThread(PolyWord targetThread); POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadKillThread(PolyWord targetThread); POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadBroadcastInterrupt(PolyObject *threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadTestInterrupt(PolyObject *threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadNumProcessors(); POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadNumPhysicalProcessors(); POLYEXTERNALSYMBOL POLYUNSIGNED PolyThreadMaxStackSize(PolyObject *threadId, PolyWord newSize); } #define SAVE(x) taskData->saveVec.push(x) #define SIZEOF(x) (sizeof(x)/sizeof(PolyWord)) // These values are stored in the second word of thread id object as // a tagged integer. They may be set and read by the thread in the ML // code. #define PFLAG_BROADCAST 1 // If set, accepts a broadcast // How to handle interrrupts #define PFLAG_IGNORE 0 // Ignore interrupts completely #define PFLAG_SYNCH 2 // Handle synchronously #define PFLAG_ASYNCH 4 // Handle asynchronously #define PFLAG_ASYNCH_ONCE 6 // First handle asynchronously then switch to synch. #define PFLAG_INTMASK 6 // Mask of the above bits struct _entrypts processesEPT[] = { { "PolyThreadGeneral", (polyRTSFunction)&PolyThreadGeneral}, { "PolyThreadKillSelf", (polyRTSFunction)&PolyThreadKillSelf}, { "PolyThreadMutexBlock", (polyRTSFunction)&PolyThreadMutexBlock}, { "PolyThreadMutexUnlock", (polyRTSFunction)&PolyThreadMutexUnlock}, { "PolyThreadCondVarWait", (polyRTSFunction)&PolyThreadCondVarWait}, { "PolyThreadCondVarWaitUntil", (polyRTSFunction)&PolyThreadCondVarWaitUntil}, { "PolyThreadCondVarWake", (polyRTSFunction)&PolyThreadCondVarWake}, { "PolyThreadForkThread", (polyRTSFunction)&PolyThreadForkThread}, { "PolyThreadIsActive", (polyRTSFunction)&PolyThreadIsActive}, { "PolyThreadInterruptThread", (polyRTSFunction)&PolyThreadInterruptThread}, { "PolyThreadKillThread", (polyRTSFunction)&PolyThreadKillThread}, { "PolyThreadBroadcastInterrupt", (polyRTSFunction)&PolyThreadBroadcastInterrupt}, { "PolyThreadTestInterrupt", (polyRTSFunction)&PolyThreadTestInterrupt}, { "PolyThreadNumProcessors", (polyRTSFunction)&PolyThreadNumProcessors}, { "PolyThreadNumPhysicalProcessors",(polyRTSFunction)&PolyThreadNumPhysicalProcessors}, { "PolyThreadMaxStackSize", (polyRTSFunction)&PolyThreadMaxStackSize}, { NULL, NULL} // End of list. }; class Processes: public ProcessExternal, public RtsModule { public: Processes(); virtual void Init(void); virtual void Stop(void); void GarbageCollect(ScanAddress *process); public: void BroadcastInterrupt(void); void BeginRootThread(PolyObject *rootFunction); void RequestProcessExit(int n); // Request all ML threads to exit and set the process result code. // Called when a thread has completed - doesn't return. virtual NORETURNFN(void ThreadExit(TaskData *taskData)); // Called when a thread may block. Returns some time later when perhaps // the input is available. virtual void ThreadPauseForIO(TaskData *taskData, Waiter *pWait); // Return the task data for the current thread. virtual TaskData *GetTaskDataForThread(void); // Create a new task data object for the current thread. virtual TaskData *CreateNewTaskData(Handle threadId, Handle threadFunction, Handle args, PolyWord flags); // ForkFromRTS. Creates a new thread from within the RTS. virtual bool ForkFromRTS(TaskData *taskData, Handle proc, Handle arg); // Create a new thread. The "args" argument is only used for threads // created in the RTS by the signal handler. Handle ForkThread(TaskData *taskData, Handle threadFunction, Handle args, PolyWord flags, PolyWord stacksize); // Process general RTS requests from ML. Handle ThreadDispatch(TaskData *taskData, Handle args, Handle code); virtual void ThreadUseMLMemory(TaskData *taskData); virtual void ThreadReleaseMLMemory(TaskData *taskData); virtual poly_exn* GetInterrupt(void) { return interrupt_exn; } // If the schedule lock is already held we need to use these functions. void ThreadUseMLMemoryWithSchedLock(TaskData *taskData); void ThreadReleaseMLMemoryWithSchedLock(TaskData *taskData); // Requests from the threads for actions that need to be performed by // the root thread. Make the request and wait until it has completed. virtual void MakeRootRequest(TaskData *taskData, MainThreadRequest *request); // Deal with any interrupt or kill requests. virtual bool ProcessAsynchRequests(TaskData *taskData); // Process an interrupt request synchronously. virtual void TestSynchronousRequests(TaskData *taskData); // Process any events, synchronous or asynchronous. virtual void TestAnyEvents(TaskData *taskData); // Set a thread to be interrupted or killed. Wakes up the // thread if necessary. MUST be called with schedLock held. void MakeRequest(TaskData *p, ThreadRequests request); // Profiling control. virtual void StartProfiling(void); virtual void StopProfiling(void); #ifdef HAVE_WINDOWS_H // Windows: Called every millisecond while profiling is on. void ProfileInterrupt(void); #else // Unix: Start a profile timer for a thread. void StartProfilingTimer(void); #endif // Memory allocation. Tries to allocate space. If the allocation succeeds it // may update the allocation values in the taskData object. If the heap is exhausted // it may set this thread (or other threads) to raise an exception. PolyWord *FindAllocationSpace(TaskData *taskData, POLYUNSIGNED words, bool alwaysInSeg); // Get the task data value from the task reference. // The task data reference is a volatile ref containing the // address of the C++ task data. // N.B. This is updated when the thread exits and the TaskData object // is deleted. TaskData *TaskForIdentifier(PolyObject *taskId) { return *(TaskData**)(((ThreadObject*)taskId)->threadRef.AsObjPtr()); } // Signal handling support. The ML signal handler thread blocks until it is // woken up by the signal detection thread. virtual bool WaitForSignal(TaskData *taskData, PLock *sigLock); virtual void SignalArrived(void); virtual void SetSingleThreaded(void) { singleThreaded = true; } // Operations on mutexes void MutexBlock(TaskData *taskData, Handle hMutex); void MutexUnlock(TaskData *taskData, Handle hMutex); // Operations on condition variables. void WaitInfinite(TaskData *taskData, Handle hMutex); void WaitUntilTime(TaskData *taskData, Handle hMutex, Handle hTime); bool WakeThread(PolyObject *targetThread); // Generally, the system runs with multiple threads. After a // fork, though, there is only one thread. bool singleThreaded; // Each thread has an entry in this vector. std::vector taskArray; /* schedLock: This lock must be held when making scheduling decisions. It must also be held before adding items to taskArray, removing them or scanning the vector. It must also be held before deleting a TaskData object or using it in a thread other than the "owner" */ PLock schedLock; #ifdef HAVE_PTHREAD pthread_key_t tlsId; #elif defined(HAVE_WINDOWS_H) DWORD tlsId; #endif // We make an exception packet for Interrupt and store it here. // This exception can be raised if we run out of store so we need to // make sure we have the packet before we do. poly_exn *interrupt_exn; /* initialThreadWait: The initial thread waits on this for wake-ups from the ML threads requesting actions such as GC or close-down. */ PCondVar initialThreadWait; // A requesting thread sets this to indicate the request. This value // is only reset once the request has been satisfied. MainThreadRequest *threadRequest; PCondVar mlThreadWait; // All the threads block on here until the request has completed. int exitResult; bool exitRequest; -#ifdef HAVE_WINDOWS_H +#ifdef HAVE_WINDOWS_H /* Windows including Cygwin */ // Used in profiling HANDLE hStopEvent; /* Signalled to stop all threads. */ HANDLE profilingHd; HANDLE mainThreadHandle; // Handle for main thread LONGLONG lastCPUTime; // CPU used by main thread. #endif TaskData *sigTask; // Pointer to current signal task. }; // Global process data. static Processes processesModule; ProcessExternal *processes = &processesModule; Processes::Processes(): singleThreaded(false), schedLock("Scheduler"), interrupt_exn(0), threadRequest(0), exitResult(0), exitRequest(false), sigTask(0) { #ifdef HAVE_WINDOWS_H hStopEvent = NULL; profilingHd = NULL; lastCPUTime = 0; mainThreadHandle = NULL; #endif } enum _mainThreadPhase mainThreadPhase = MTP_USER_CODE; // Get the attribute flags. static POLYUNSIGNED ThreadAttrs(TaskData *taskData) { return UNTAGGED_UNSIGNED(taskData->threadObject->flags); } // General interface to thread. Ideally the various cases will be made into // separate functions. POLYUNSIGNED PolyThreadGeneral(PolyObject *threadId, PolyWord code, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedCode = taskData->saveVec.push(code); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { result = processesModule.ThreadDispatch(taskData, pushedArg, pushedCode); } catch (KillException &) { processes->ThreadExit(taskData); // TestSynchronousRequests may test for kill } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } POLYUNSIGNED PolyThreadMutexBlock(PolyObject *threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); if (profileMode == kProfileMutexContention) taskData->addProfileCount(1); try { processesModule.MutexBlock(taskData, pushedArg); } catch (KillException &) { processes->ThreadExit(taskData); // TestSynchronousRequests may test for kill } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } POLYUNSIGNED PolyThreadMutexUnlock(PolyObject *threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); try { processesModule.MutexUnlock(taskData, pushedArg); } catch (KillException &) { processes->ThreadExit(taskData); // TestSynchronousRequests may test for kill } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } /* A mutex was locked i.e. the count was ~1 or less. We will have set it to ~1. This code blocks if the count is still ~1. It does actually return if another thread tries to lock the mutex and hasn't yet set the value to ~1 but that doesn't matter since whenever we return we simply try to get the lock again. */ void Processes::MutexBlock(TaskData *taskData, Handle hMutex) { schedLock.Lock(); // We have to check the value again with schedLock held rather than // simply waiting because otherwise the unlocking thread could have // set the variable back to 1 (unlocked) and signalled any waiters // before we actually got to wait. if (UNTAGGED(DEREFHANDLE(hMutex)->Get(0)) < 0) { // Set this so we can see what we're blocked on. taskData->blockMutex = DEREFHANDLE(hMutex); // Now release the ML memory. A GC can start. ThreadReleaseMLMemoryWithSchedLock(taskData); // Wait until we're woken up. We mustn't block if we have been // interrupted, and are processing interrupts asynchronously, or // we've been killed. switch (taskData->requests) { case kRequestKill: // We've been killed. Handle this later. break; case kRequestInterrupt: { // We've been interrupted. POLYUNSIGNED attrs = ThreadAttrs(taskData) & PFLAG_INTMASK; if (attrs == PFLAG_ASYNCH || attrs == PFLAG_ASYNCH_ONCE) break; // If we're ignoring interrupts or handling them synchronously // we don't do anything here. } case kRequestNone: globalStats.incCount(PSC_THREADS_WAIT_MUTEX); taskData->threadLock.Wait(&schedLock); globalStats.decCount(PSC_THREADS_WAIT_MUTEX); } taskData->blockMutex = 0; // No longer blocked. ThreadUseMLMemoryWithSchedLock(taskData); } // Return and try and get the lock again. schedLock.Unlock(); // Test to see if we have been interrupted and if this thread // processes interrupts asynchronously we should raise an exception // immediately. Perhaps we do that whenever we exit from the RTS. } /* Unlock a mutex. Called after incrementing the count and discovering that at least one other thread has tried to lock it. We may need to wake up threads that are blocked. */ void Processes::MutexUnlock(TaskData *taskData, Handle hMutex) { // The caller has already set the variable to 1 (unlocked). // We need to acquire schedLock so that we can // be sure that any thread that is trying to lock sees either // the updated value (and so doesn't wait) or has successfully // waited on its threadLock (and so will be woken up). schedLock.Lock(); // Unlock any waiters. for (std::vector::iterator i = taskArray.begin(); i != taskArray.end(); i++) { TaskData *p = *i; // If the thread is blocked on this mutex we can signal the thread. if (p && p->blockMutex == DEREFHANDLE(hMutex)) p->threadLock.Signal(); } schedLock.Unlock(); } POLYUNSIGNED PolyThreadCondVarWait(PolyObject *threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); try { processesModule.WaitInfinite(taskData, pushedArg); } catch (KillException &) { processes->ThreadExit(taskData); // TestSynchronousRequests may test for kill } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } POLYUNSIGNED PolyThreadCondVarWaitUntil(PolyObject *threadId, PolyWord lockArg, PolyWord timeArg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedLockArg = taskData->saveVec.push(lockArg); Handle pushedTimeArg = taskData->saveVec.push(timeArg); try { processesModule.WaitUntilTime(taskData, pushedLockArg, pushedTimeArg); } catch (KillException &) { processes->ThreadExit(taskData); // TestSynchronousRequests may test for kill } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } // Atomically drop a mutex and wait for a wake up. // It WILL NOT RAISE AN EXCEPTION unless it is set to handle exceptions // asynchronously (which it shouldn't do if the ML caller code is correct). // It may return as a result of any of the following: // an explicit wake up. // an interrupt, either direct or broadcast // a trap i.e. a request to handle an asynchronous event. void Processes::WaitInfinite(TaskData *taskData, Handle hMutex) { schedLock.Lock(); // Atomically release the mutex. This is atomic because we hold schedLock // so no other thread can call signal or broadcast. Handle decrResult = taskData->AtomicIncrement(hMutex); if (UNTAGGED(decrResult->Word()) != 1) { taskData->AtomicReset(hMutex); // The mutex was locked so we have to release any waiters. // Unlock any waiters. for (std::vector::iterator i = taskArray.begin(); i != taskArray.end(); i++) { TaskData *p = *i; // If the thread is blocked on this mutex we can signal the thread. if (p && p->blockMutex == DEREFHANDLE(hMutex)) p->threadLock.Signal(); } } // Wait until we're woken up. Don't block if we have been interrupted // or killed. if (taskData->requests == kRequestNone) { // Now release the ML memory. A GC can start. ThreadReleaseMLMemoryWithSchedLock(taskData); globalStats.incCount(PSC_THREADS_WAIT_CONDVAR); taskData->threadLock.Wait(&schedLock); globalStats.decCount(PSC_THREADS_WAIT_CONDVAR); // We want to use the memory again. ThreadUseMLMemoryWithSchedLock(taskData); } schedLock.Unlock(); } // Atomically drop a mutex and wait for a wake up or a time to wake up void Processes::WaitUntilTime(TaskData *taskData, Handle hMutex, Handle hWakeTime) { // Convert the time into the correct format for WaitUntil before acquiring // schedLock. div_longc could do a GC which requires schedLock. -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) // On Windows it is the number of 100ns units since the epoch FILETIME tWake; getFileTimeFromArb(taskData, hWakeTime, &tWake); #else // Unix style times. struct timespec tWake; // On Unix we represent times as a number of microseconds. Handle hMillion = Make_arbitrary_precision(taskData, 1000000); tWake.tv_sec = get_C_ulong(taskData, DEREFWORD(div_longc(taskData, hMillion, hWakeTime))); tWake.tv_nsec = 1000*get_C_ulong(taskData, DEREFWORD(rem_longc(taskData, hMillion, hWakeTime))); #endif schedLock.Lock(); // Atomically release the mutex. This is atomic because we hold schedLock // so no other thread can call signal or broadcast. Handle decrResult = taskData->AtomicIncrement(hMutex); if (UNTAGGED(decrResult->Word()) != 1) { taskData->AtomicReset(hMutex); // The mutex was locked so we have to release any waiters. // Unlock any waiters. for (std::vector::iterator i = taskArray.begin(); i != taskArray.end(); i++) { TaskData *p = *i; // If the thread is blocked on this mutex we can signal the thread. if (p && p->blockMutex == DEREFHANDLE(hMutex)) p->threadLock.Signal(); } } // Wait until we're woken up. Don't block if we have been interrupted // or killed. if (taskData->requests == kRequestNone) { // Now release the ML memory. A GC can start. ThreadReleaseMLMemoryWithSchedLock(taskData); globalStats.incCount(PSC_THREADS_WAIT_CONDVAR); (void)taskData->threadLock.WaitUntil(&schedLock, &tWake); globalStats.decCount(PSC_THREADS_WAIT_CONDVAR); // We want to use the memory again. ThreadUseMLMemoryWithSchedLock(taskData); } schedLock.Unlock(); } bool Processes::WakeThread(PolyObject *targetThread) { bool result = false; // Default to failed. // Acquire the schedLock first. This ensures that this is // atomic with respect to waiting. schedLock.Lock(); TaskData *p = TaskForIdentifier(targetThread); if (p && p->threadObject == targetThread) { POLYUNSIGNED attrs = ThreadAttrs(p) & PFLAG_INTMASK; if (p->requests == kRequestNone || (p->requests == kRequestInterrupt && attrs == PFLAG_IGNORE)) { p->threadLock.Signal(); result = true; } } schedLock.Unlock(); return result; } POLYUNSIGNED PolyThreadCondVarWake(PolyWord targetThread) { if (processesModule.WakeThread(targetThread.AsObjPtr())) return TAGGED(1).AsUnsigned(); else return TAGGED(0).AsUnsigned(); } // Test if a thread is active. POLYUNSIGNED PolyThreadIsActive(PolyWord targetThread) { // There's a race here: the thread may be exiting but since we're not doing // anything with the TaskData object we don't need a lock. TaskData *p = processesModule.TaskForIdentifier(targetThread.AsObjPtr()); if (p != 0) return TAGGED(1).AsUnsigned(); else return TAGGED(0).AsUnsigned(); } // Send an interrupt to a specific thread POLYUNSIGNED PolyThreadInterruptThread(PolyWord targetThread) { // Must lock here because the thread may be exiting. processesModule.schedLock.Lock(); TaskData *p = processesModule.TaskForIdentifier(targetThread.AsObjPtr()); if (p) processesModule.MakeRequest(p, kRequestInterrupt); processesModule.schedLock.Unlock(); // If the thread cannot be identified return false. // The caller can then raise an exception if (p == 0) return TAGGED(0).AsUnsigned(); else return TAGGED(1).AsUnsigned(); } // Kill a specific thread POLYUNSIGNED PolyThreadKillThread(PolyWord targetThread) { processesModule.schedLock.Lock(); TaskData *p = processesModule.TaskForIdentifier(targetThread.AsObjPtr()); if (p) processesModule.MakeRequest(p, kRequestKill); processesModule.schedLock.Unlock(); // If the thread cannot be identified return false. // The caller can then raise an exception if (p == 0) return TAGGED(0).AsUnsigned(); else return TAGGED(1).AsUnsigned(); } POLYUNSIGNED PolyThreadBroadcastInterrupt(PolyObject * /*threadId*/) { processesModule.BroadcastInterrupt(); return TAGGED(0).AsUnsigned(); } POLYUNSIGNED PolyThreadTestInterrupt(PolyObject *threadId) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); try { processesModule.TestSynchronousRequests(taskData); // Also process any asynchronous requests that may be pending. // These will be handled "soon" but if we have just switched from deferring // interrupts this guarantees that any deferred interrupts will be handled now. if (processesModule.ProcessAsynchRequests(taskData)) throw IOException(); } catch (KillException &) { processes->ThreadExit(taskData); // TestSynchronousRequests may test for kill } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } // Return the number of processors. // Returns 1 if there is any problem. POLYUNSIGNED PolyThreadNumProcessors(void) { return TAGGED(NumberOfProcessors()).AsUnsigned(); } // Return the number of physical processors. // Returns 0 if there is any problem. POLYUNSIGNED PolyThreadNumPhysicalProcessors(void) { return TAGGED(NumberOfPhysicalProcessors()).AsUnsigned(); } // Set the maximum stack size. POLYUNSIGNED PolyThreadMaxStackSize(PolyObject *threadId, PolyWord newSize) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); try { taskData->threadObject->mlStackSize = newSize; if (newSize != TAGGED(0)) { uintptr_t current = taskData->currentStackSpace(); // Current size in words uintptr_t newWords = getPolyUnsigned(taskData, newSize); if (current > newWords) raise_exception0(taskData, EXC_interrupt); } } catch (KillException &) { processes->ThreadExit(taskData); // TestSynchronousRequests may test for kill } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } // Old dispatch function. This is only required because the pre-built compiler // may use some of these e.g. fork. Handle Processes::ThreadDispatch(TaskData *taskData, Handle args, Handle code) { unsigned c = get_C_unsigned(taskData, code->Word()); TaskData *ptaskData = taskData; switch (c) { case 1: MutexBlock(taskData, args); return SAVE(TAGGED(0)); case 2: MutexUnlock(taskData, args); return SAVE(TAGGED(0)); case 7: // Fork a new thread. The arguments are the function to run and the attributes. return ForkThread(ptaskData, SAVE(args->WordP()->Get(0)), (Handle)0, args->WordP()->Get(1), // For backwards compatibility we check the length here args->WordP()->Length() <= 2 ? TAGGED(0) : args->WordP()->Get(2)); case 10: // Broadcast an interrupt to all threads that are interested. BroadcastInterrupt(); return SAVE(TAGGED(0)); default: { char msg[100]; sprintf(msg, "Unknown thread function: %u", c); raise_fail(taskData, msg); return 0; } } } // Fill unused allocation space with a dummy object to preserve the invariant // that memory is always valid. void TaskData::FillUnusedSpace(void) { if (allocPointer > allocLimit) gMem.FillUnusedSpace(allocLimit, allocPointer-allocLimit); } TaskData::TaskData(): allocPointer(0), allocLimit(0), allocSize(MIN_HEAP_SIZE), allocCount(0), stack(0), threadObject(0), signalStack(0), foreignStack(TAGGED(0)), inML(false), requests(kRequestNone), blockMutex(0), inMLHeap(false), runningProfileTimer(false) { #ifdef HAVE_WINDOWS_H lastCPUTime = 0; #endif #ifdef HAVE_WINDOWS_H threadHandle = 0; #endif threadExited = false; } TaskData::~TaskData() { if (signalStack) free(signalStack); if (stack) gMem.DeleteStackSpace(stack); #ifdef HAVE_WINDOWS_H if (threadHandle) CloseHandle(threadHandle); #endif } // Broadcast an interrupt to all relevant threads. void Processes::BroadcastInterrupt(void) { // If a thread is set to accept broadcast interrupts set it to // "interrupted". schedLock.Lock(); for (std::vector::iterator i = taskArray.begin(); i != taskArray.end(); i++) { TaskData *p = *i; if (p) { POLYUNSIGNED attrs = ThreadAttrs(p); if (attrs & PFLAG_BROADCAST) MakeRequest(p, kRequestInterrupt); } } schedLock.Unlock(); } // Set the asynchronous request variable for the thread. Must be called // with the schedLock held. Tries to wake the thread up if possible. void Processes::MakeRequest(TaskData *p, ThreadRequests request) { // We don't override a request to kill by an interrupt request. if (p->requests < request) { p->requests = request; p->InterruptCode(); p->threadLock.Signal(); // Set the value in the ML object as well so the ML code can see it p->threadObject->requestCopy = TAGGED(request); } } void Processes::ThreadExit(TaskData *taskData) { if (debugOptions & DEBUG_THREADS) Log("THREAD: Thread %p exiting\n", taskData); #ifdef HAVE_PTHREAD // Block any profile interrupt from now on. We're deleting the ML stack for this thread. sigset_t block_sigs; sigemptyset(&block_sigs); sigaddset(&block_sigs, SIGVTALRM); pthread_sigmask(SIG_BLOCK, &block_sigs, NULL); // Remove the thread-specific data since it's no // longer valid. pthread_setspecific(tlsId, 0); #endif if (singleThreaded) finish(0); schedLock.Lock(); ThreadReleaseMLMemoryWithSchedLock(taskData); // Allow a GC if it was waiting for us. taskData->threadExited = true; initialThreadWait.Signal(); // Tell it we've finished. schedLock.Unlock(); #ifdef HAVE_PTHREAD pthread_exit(0); #elif defined(HAVE_WINDOWS_H) ExitThread(0); #endif } // These two functions are used for calls from outside where // the lock has not yet been acquired. void Processes::ThreadUseMLMemory(TaskData *taskData) { // Trying to acquire the lock here may block if a GC is in progress schedLock.Lock(); ThreadUseMLMemoryWithSchedLock(taskData); schedLock.Unlock(); } void Processes::ThreadReleaseMLMemory(TaskData *taskData) { schedLock.Lock(); ThreadReleaseMLMemoryWithSchedLock(taskData); schedLock.Unlock(); } // Called when a thread wants to resume using the ML heap. That could // be after a wait for some reason or after executing some foreign code. // Since there could be a GC in progress already at this point we may either // be blocked waiting to acquire schedLock or we may need to wait until // we are woken up at the end of the GC. void Processes::ThreadUseMLMemoryWithSchedLock(TaskData *taskData) { TaskData *ptaskData = taskData; // If there is a request outstanding we have to wait for it to // complete. We notify the root thread and wait for it. while (threadRequest != 0) { initialThreadWait.Signal(); // Wait for the GC to happen mlThreadWait.Wait(&schedLock); } ASSERT(! ptaskData->inMLHeap); ptaskData->inMLHeap = true; } // Called to indicate that the thread has temporarily finished with the // ML memory either because it is going to wait for something or because // it is going to run foreign code. If there is an outstanding GC request // that can proceed. void Processes::ThreadReleaseMLMemoryWithSchedLock(TaskData *taskData) { TaskData *ptaskData = taskData; ASSERT(ptaskData->inMLHeap); ptaskData->inMLHeap = false; // Put a dummy object in any unused space. This maintains the // invariant that the allocated area is filled with valid objects. ptaskData->FillUnusedSpace(); // if (threadRequest != 0) initialThreadWait.Signal(); } // Make a request to the root thread. void Processes::MakeRootRequest(TaskData *taskData, MainThreadRequest *request) { if (singleThreaded) { mainThreadPhase = request->mtp; ThreadReleaseMLMemoryWithSchedLock(taskData); // Primarily to call FillUnusedSpace request->Perform(); ThreadUseMLMemoryWithSchedLock(taskData); mainThreadPhase = MTP_USER_CODE; } else { PLocker locker(&schedLock); // Wait for any other requests. while (threadRequest != 0) { // Deal with any pending requests. ThreadReleaseMLMemoryWithSchedLock(taskData); ThreadUseMLMemoryWithSchedLock(taskData); // Drops schedLock while waiting. } // Now the other requests have been dealt with (and we have schedLock). request->completed = false; threadRequest = request; // Wait for it to complete. while (! request->completed) { ThreadReleaseMLMemoryWithSchedLock(taskData); ThreadUseMLMemoryWithSchedLock(taskData); // Drops schedLock while waiting. } } } // Find space for an object. Returns a pointer to the start. "words" must include // the length word and the result points at where the length word will go. PolyWord *Processes::FindAllocationSpace(TaskData *taskData, POLYUNSIGNED words, bool alwaysInSeg) { bool triedInterrupt = false; #ifdef POLYML32IN64 if (words & 1) words++; // Must always be an even number of words. #endif while (1) { // After a GC allocPointer and allocLimit are zero and when allocating the // heap segment we request a minimum of zero words. if (taskData->allocPointer != 0 && taskData->allocPointer >= taskData->allocLimit + words) { // There's space in the current segment, taskData->allocPointer -= words; #ifdef POLYML32IN64 // Zero the last word. If we've rounded up an odd number the caller won't set it. if (words != 0) taskData->allocPointer[words-1] = PolyWord::FromUnsigned(0); ASSERT((uintptr_t)taskData->allocPointer & 4); // Must be odd-word aligned #endif return taskData->allocPointer; } else // Insufficient space in this area. { if (words > taskData->allocSize && ! alwaysInSeg) { // If the object we want is larger than the heap segment size // we allocate it separately rather than in the segment. PolyWord *foundSpace = gMem.AllocHeapSpace(words); if (foundSpace) return foundSpace; } else { // Fill in any unused space in the existing segment taskData->FillUnusedSpace(); // Get another heap segment with enough space for this object. uintptr_t requestSpace = taskData->allocSize+words; uintptr_t spaceSize = requestSpace; // Get the space and update spaceSize with the actual size. PolyWord *space = gMem.AllocHeapSpace(words, spaceSize); if (space) { // Double the allocation size for the next time if // we succeeded in allocating the whole space. taskData->allocCount++; if (spaceSize == requestSpace) taskData->allocSize = taskData->allocSize*2; taskData->allocLimit = space; taskData->allocPointer = space+spaceSize; // Actually allocate the object taskData->allocPointer -= words; #ifdef POLYML32IN64 ASSERT((uintptr_t)taskData->allocPointer & 4); // Must be odd-word aligned #endif return taskData->allocPointer; } } // It's possible that another thread has requested a GC in which case // we will have memory when that happens. We don't want to start // another GC. if (! singleThreaded) { PLocker locker(&schedLock); if (threadRequest != 0) { ThreadReleaseMLMemoryWithSchedLock(taskData); ThreadUseMLMemoryWithSchedLock(taskData); continue; // Try again } } // Try garbage-collecting. If this failed return 0. if (! QuickGC(taskData, words)) { extern FILE *polyStderr; if (! triedInterrupt) { triedInterrupt = true; fprintf(polyStderr,"Run out of store - interrupting threads\n"); if (debugOptions & DEBUG_THREADS) Log("THREAD: Run out of store, interrupting threads\n"); BroadcastInterrupt(); try { if (ProcessAsynchRequests(taskData)) return 0; // Has been interrupted. } catch(KillException &) { // The thread may have been killed. ThreadExit(taskData); } // Not interrupted: pause this thread to allow for other // interrupted threads to free something. #if defined(_WIN32) Sleep(5000); #else sleep(5); #endif // Try again. } else { // That didn't work. Exit. fprintf(polyStderr,"Failed to recover - exiting\n"); RequestProcessExit(1); // Begins the shutdown process ThreadExit(taskData); // And terminate this thread. } } // Try again. There should be space now. } } } #ifdef _MSC_VER // Don't tell me that exitThread has a non-void type. #pragma warning(disable:4646) #endif Handle exitThread(TaskData *taskData) /* A call to this is put on the stack of a new thread so when the thread function returns the thread goes away. */ { processesModule.ThreadExit(taskData); } // Terminate the current thread. Never returns. POLYUNSIGNED PolyThreadKillSelf(PolyObject *threadId) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); // Possibly not needed since we never return processesModule.ThreadExit(taskData); return 0; } /* Called when a thread is about to block, usually because of IO. If this is interruptable (currently only used for Posix functions) the process will be set to raise an exception if any signal is handled. It may also raise an exception if another thread has called broadcastInterrupt. */ void Processes::ThreadPauseForIO(TaskData *taskData, Waiter *pWait) { TestAnyEvents(taskData); // Consider this a blocking call that may raise Interrupt ThreadReleaseMLMemory(taskData); globalStats.incCount(PSC_THREADS_WAIT_IO); pWait->Wait(1000); // Wait up to a second globalStats.decCount(PSC_THREADS_WAIT_IO); ThreadUseMLMemory(taskData); TestAnyEvents(taskData); // Check if we've been interrupted. } // Default waiter: simply wait for the time. In Unix it may be woken // up by a signal. void Waiter::Wait(unsigned maxMillisecs) { // Since this is used only when we can't monitor the source directly // we set this to 10ms so that we're not waiting too long. if (maxMillisecs > 10) maxMillisecs = 10; -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) Sleep(maxMillisecs); #else // Unix fd_set read_fds, write_fds, except_fds; struct timeval toWait = { 0, 0 }; toWait.tv_sec = maxMillisecs / 1000; toWait.tv_usec = (maxMillisecs % 1000) * 1000; FD_ZERO(&read_fds); FD_ZERO(&write_fds); FD_ZERO(&except_fds); select(FD_SETSIZE, &read_fds, &write_fds, &except_fds, &toWait); #endif } static Waiter defWait; Waiter *Waiter::defaultWaiter = &defWait; -#ifdef HAVE_WINDOWS_H +#ifdef _WIN32 // Wait for the specified handle to be signalled. void WaitHandle::Wait(unsigned maxMillisecs) { // Wait until we get input or we're woken up. if (m_Handle == NULL) Sleep(maxMillisecs); else WaitForSingleObject(m_Handle, maxMillisecs); } -#endif -#if (!defined(_WIN32) || defined(__CYGWIN__)) +#else + // Unix and Cygwin: Wait for a file descriptor on input. void WaitInputFD::Wait(unsigned maxMillisecs) { fd_set read_fds, write_fds, except_fds; struct timeval toWait = { 0, 0 }; toWait.tv_sec = maxMillisecs / 1000; toWait.tv_usec = (maxMillisecs % 1000) * 1000; FD_ZERO(&read_fds); if (m_waitFD >= 0) FD_SET(m_waitFD, &read_fds); FD_ZERO(&write_fds); FD_ZERO(&except_fds); select(FD_SETSIZE, &read_fds, &write_fds, &except_fds, &toWait); } #endif // Get the task data for the current thread. This is held in // thread-local storage. Normally this is passed in taskData but // in a few cases this isn't available. TaskData *Processes::GetTaskDataForThread(void) { #ifdef HAVE_PTHREAD return (TaskData *)pthread_getspecific(tlsId); #elif defined(HAVE_WINDOWS_H) return (TaskData *)TlsGetValue(tlsId); #else // If there's no threading. return taskArray[0]; #endif } // Called to create a task data object in the current thread. // This is currently only used if a thread created in foreign code calls // a callback. TaskData *Processes::CreateNewTaskData(Handle threadId, Handle threadFunction, Handle args, PolyWord flags) { TaskData *taskData = machineDependent->CreateTaskData(); #if defined(HAVE_WINDOWS_H) HANDLE thisProcess = GetCurrentProcess(); DuplicateHandle(thisProcess, GetCurrentThread(), thisProcess, &(taskData->threadHandle), THREAD_ALL_ACCESS, FALSE, 0); #endif unsigned thrdIndex; { PLocker lock(&schedLock); // See if there's a spare entry in the array. for (thrdIndex = 0; thrdIndex < taskArray.size() && taskArray[thrdIndex] != 0; thrdIndex++); if (thrdIndex == taskArray.size()) // Need to expand the array { try { taskArray.push_back(taskData); } catch (std::bad_alloc&) { delete(taskData); throw MemoryException(); } } else { taskArray[thrdIndex] = taskData; } } taskData->stack = gMem.NewStackSpace(machineDependent->InitialStackSize()); if (taskData->stack == 0) { delete(taskData); throw MemoryException(); } // TODO: Check that there isn't a problem if we try to allocate // memory here and result in a GC. taskData->InitStackFrame(taskData, threadFunction, args); ThreadUseMLMemory(taskData); // If the forking thread has created an ML thread object use that // otherwise create a new one in the current context. if (threadId != 0) taskData->threadObject = (ThreadObject*)threadId->WordP(); else { // Make a thread reference to point to this taskData object. Handle threadRef = MakeVolatileWord(taskData, taskData); // Make a thread object. Since it's in the thread table it can't be garbage collected. taskData->threadObject = (ThreadObject*)alloc(taskData, sizeof(ThreadObject)/sizeof(PolyWord), F_MUTABLE_BIT); taskData->threadObject->threadRef = threadRef->Word(); taskData->threadObject->flags = flags != TAGGED(0) ? TAGGED(PFLAG_SYNCH): flags; taskData->threadObject->threadLocal = TAGGED(0); // Empty thread-local store taskData->threadObject->requestCopy = TAGGED(0); // Cleared interrupt state taskData->threadObject->mlStackSize = TAGGED(0); // Unlimited stack size for (unsigned i = 0; i < sizeof(taskData->threadObject->debuggerSlots)/sizeof(PolyWord); i++) taskData->threadObject->debuggerSlots[i] = TAGGED(0); } #ifdef HAVE_PTHREAD initThreadSignals(taskData); pthread_setspecific(tlsId, taskData); #elif defined(HAVE_WINDOWS_H) TlsSetValue(tlsId, taskData); #endif globalStats.incCount(PSC_THREADS); return taskData; } // This function is run when a new thread has been forked. The // parameter is the taskData value for the new thread. This function // is also called directly for the main thread. #ifdef HAVE_PTHREAD static void *NewThreadFunction(void *parameter) { TaskData *taskData = (TaskData *)parameter; #ifdef HAVE_WINDOWS_H // Cygwin: Get the Windows thread handle in case it's needed for profiling. HANDLE thisProcess = GetCurrentProcess(); DuplicateHandle(thisProcess, GetCurrentThread(), thisProcess, &(taskData->threadHandle), THREAD_ALL_ACCESS, FALSE, 0); #endif initThreadSignals(taskData); pthread_setspecific(processesModule.tlsId, taskData); taskData->saveVec.init(); // Remove initial data globalStats.incCount(PSC_THREADS); processes->ThreadUseMLMemory(taskData); try { (void)taskData->EnterPolyCode(); // Will normally (always?) call ExitThread. } catch (KillException &) { processesModule.ThreadExit(taskData); } return 0; } #elif defined(HAVE_WINDOWS_H) static DWORD WINAPI NewThreadFunction(void *parameter) { TaskData *taskData = (TaskData *)parameter; TlsSetValue(processesModule.tlsId, taskData); taskData->saveVec.init(); // Removal initial data globalStats.incCount(PSC_THREADS); processes->ThreadUseMLMemory(taskData); try { (void)taskData->EnterPolyCode(); } catch (KillException &) { processesModule.ThreadExit(taskData); } return 0; } #else static void NewThreadFunction(void *parameter) { TaskData *taskData = (TaskData *)parameter; initThreadSignals(taskData); taskData->saveVec.init(); // Removal initial data globalStats.incCount(PSC_THREADS); processes->ThreadUseMLMemory(taskData); try { (void)taskData->EnterPolyCode(); } catch (KillException &) { processesModule.ThreadExit(taskData); } } #endif // Sets up the initial thread from the root function. This is run on // the initial thread of the process so it will work if we don't // have pthreads. // When multithreading this thread also deals with all garbage-collection // and similar operations and the ML threads send it requests to deal with // that. These require all the threads to pause until the operation is complete // since they affect all memory but they are also sometimes highly recursive. // On Mac OS X and on Linux if the stack limit is set to unlimited only the // initial thread has a large stack and newly created threads have smaller // stacks. We need to make sure that any significant stack usage occurs only // on the inital thread. void Processes::BeginRootThread(PolyObject *rootFunction) { int exitLoopCount = 100; // Maximum 100 * 400 ms. if (taskArray.size() < 1) { try { taskArray.push_back(0); } catch (std::bad_alloc&) { ::Exit("Unable to create the initial thread - insufficient memory"); } } try { // We can't use ForkThread because we don't have a taskData object before we start TaskData *taskData = machineDependent->CreateTaskData(); Handle threadRef = MakeVolatileWord(taskData, taskData); taskData->threadObject = (ThreadObject*)alloc(taskData, sizeof(ThreadObject) / sizeof(PolyWord), F_MUTABLE_BIT); taskData->threadObject->threadRef = threadRef->Word(); // The initial thread is set to accept broadcast interrupt requests // and handle them synchronously. This is for backwards compatibility. taskData->threadObject->flags = TAGGED(PFLAG_BROADCAST|PFLAG_ASYNCH); // Flags taskData->threadObject->threadLocal = TAGGED(0); // Empty thread-local store taskData->threadObject->requestCopy = TAGGED(0); // Cleared interrupt state taskData->threadObject->mlStackSize = TAGGED(0); // Unlimited stack size for (unsigned i = 0; i < sizeof(taskData->threadObject->debuggerSlots)/sizeof(PolyWord); i++) taskData->threadObject->debuggerSlots[i] = TAGGED(0); #if defined(HAVE_WINDOWS_H) taskData->threadHandle = mainThreadHandle; #endif taskArray[0] = taskData; taskData->stack = gMem.NewStackSpace(machineDependent->InitialStackSize()); if (taskData->stack == 0) ::Exit("Unable to create the initial thread - insufficient memory"); taskData->InitStackFrame(taskData, taskData->saveVec.push(rootFunction), (Handle)0); // Create a packet for the Interrupt exception once so that we don't have to // allocate when we need to raise it. // We can only do this once the taskData object has been created. if (interrupt_exn == 0) interrupt_exn = makeExceptionPacket(taskData, EXC_interrupt); if (singleThreaded) { // If we don't have threading enter the code as if this were a new thread. // This will call finish so will never return. NewThreadFunction(taskData); } schedLock.Lock(); int errorCode = 0; #ifdef HAVE_PTHREAD if (pthread_create(&taskData->threadId, NULL, NewThreadFunction, taskData) != 0) errorCode = errno; #elif defined(HAVE_WINDOWS_H) taskData->threadHandle = CreateThread(NULL, 0, NewThreadFunction, taskData, 0, NULL); if (taskData->threadHandle == NULL) errorCode = GetLastError(); #endif if (errorCode != 0) { // Thread creation failed. taskArray[0] = 0; delete(taskData); ExitWithError("Unable to create initial thread:", errorCode); } if (debugOptions & DEBUG_THREADS) Log("THREAD: Forked initial root thread %p\n", taskData); } catch (std::bad_alloc &) { ::Exit("Unable to create the initial thread - insufficient memory"); } // Wait until the threads terminate or make a request. // We only release schedLock while waiting. while (1) { // Look at the threads to see if they are running. bool allStopped = true; bool noUserThreads = true; bool signalThreadRunning = false; for (std::vector::iterator i = taskArray.begin(); i != taskArray.end(); i++) { TaskData *p = *i; if (p) { if (p == sigTask) signalThreadRunning = true; else if (! p->threadExited) noUserThreads = false; if (p->inMLHeap) { allStopped = false; // It must be running - interrupt it if we are waiting. if (threadRequest != 0) p->InterruptCode(); } else if (p->threadExited) // Has the thread terminated? { // Wait for it to actually stop then delete the task data. #ifdef HAVE_PTHREAD pthread_join(p->threadId, NULL); #elif defined(HAVE_WINDOWS_H) WaitForSingleObject(p->threadHandle, INFINITE); #endif // The thread ref is no longer valid. *(TaskData**)(p->threadObject->threadRef.AsObjPtr()) = 0; delete(p); // Delete the task Data *i = 0; globalStats.decCount(PSC_THREADS); } } } if (noUserThreads) { // If all threads apart from the signal thread have exited then // we can finish but we must make sure that the signal thread has // exited before we finally finish and deallocate the memory. if (signalThreadRunning) exitRequest = true; else break; // Really no threads. } if (allStopped && threadRequest != 0) { mainThreadPhase = threadRequest->mtp; gMem.ProtectImmutable(false); // GC, sharing and export may all write to the immutable area threadRequest->Perform(); gMem.ProtectImmutable(true); mainThreadPhase = MTP_USER_CODE; threadRequest->completed = true; threadRequest = 0; // Allow a new request. mlThreadWait.Signal(); } // Have we had a request to stop? This may have happened while in the GC. if (exitRequest) { // Set this to kill the threads. for (std::vector::iterator i = taskArray.begin(); i != taskArray.end(); i++) { TaskData *taskData = *i; if (taskData && taskData->requests != kRequestKill) MakeRequest(taskData, kRequestKill); } // Leave exitRequest set so that if we're in the process of // creating a new thread we will request it to stop when the // taskData object has been added to the table. } // Now release schedLock and wait for a thread // to wake us up or for the timer to expire to update the statistics. if (! initialThreadWait.WaitFor(&schedLock, 400)) { // We didn't receive a request in the last 400ms if (exitRequest) { if (--exitLoopCount < 0) { // The loop count has expired and there is at least one thread that hasn't exited. // Assume we've deadlocked. #if defined(HAVE_WINDOWS_H) ExitProcess(1); #else _exit(1); // Something is stuck. Get out without calling destructors. #endif } } } // Update the periodic stats. // Calculate the free memory. We have to be careful here because although // we have the schedLock we don't have any lock that prevents a thread // from allocating a new segment. Since these statistics are only // very rough it doesn't matter if there's a glitch. // One possibility would be see if the value of // gMem.GetFreeAllocSpace() has changed from what it was at the // start and recalculate if it has. // We also count the number of threads in ML code. Taking the // lock in EnterPolyCode on every RTS call turned out to be // expensive. uintptr_t freeSpace = 0; unsigned threadsInML = 0; for (std::vector::iterator j = taskArray.begin(); j != taskArray.end(); j++) { TaskData *taskData = *j; if (taskData) { // This gets the values last time it was in the RTS. PolyWord *limit = taskData->allocLimit, *ptr = taskData->allocPointer; if (limit < ptr && (uintptr_t)(ptr-limit) < taskData->allocSize) freeSpace += ptr-limit; if (taskData->inML) threadsInML++; } } // Add the space in the allocation areas after calculating the sizes for the // threads in case a thread has allocated some more. freeSpace += gMem.GetFreeAllocSpace(); globalStats.updatePeriodicStats(freeSpace, threadsInML); } schedLock.Unlock(); finish(exitResult); // Close everything down and exit. } // Create a new thread. Returns the ML thread identifier object if it succeeds. // May raise an exception. Handle Processes::ForkThread(TaskData *taskData, Handle threadFunction, Handle args, PolyWord flags, PolyWord stacksize) { if (singleThreaded) raise_exception_string(taskData, EXC_thread, "Threads not available"); try { // Create a taskData object for the new thread TaskData *newTaskData = machineDependent->CreateTaskData(); // We allocate the thread object in the PARENT's space Handle threadRef = MakeVolatileWord(taskData, newTaskData); Handle threadId = alloc_and_save(taskData, sizeof(ThreadObject) / sizeof(PolyWord), F_MUTABLE_BIT); newTaskData->threadObject = (ThreadObject*)DEREFHANDLE(threadId); newTaskData->threadObject->threadRef = threadRef->Word(); newTaskData->threadObject->flags = flags; // Flags newTaskData->threadObject->threadLocal = TAGGED(0); // Empty thread-local store newTaskData->threadObject->requestCopy = TAGGED(0); // Cleared interrupt state newTaskData->threadObject->mlStackSize = stacksize; for (unsigned i = 0; i < sizeof(newTaskData->threadObject->debuggerSlots)/sizeof(PolyWord); i++) newTaskData->threadObject->debuggerSlots[i] = TAGGED(0); unsigned thrdIndex; schedLock.Lock(); // Before forking a new thread check to see whether we have been asked // to exit. Processes::Exit sets the current set of threads to exit but won't // see a new thread. if (taskData->requests == kRequestKill) { schedLock.Unlock(); // Raise an exception although the thread may exit before we get there. raise_exception_string(taskData, EXC_thread, "Thread is exiting"); } // See if there's a spare entry in the array. for (thrdIndex = 0; thrdIndex < taskArray.size() && taskArray[thrdIndex] != 0; thrdIndex++); if (thrdIndex == taskArray.size()) // Need to expand the array { try { taskArray.push_back(newTaskData); } catch (std::bad_alloc&) { delete(newTaskData); schedLock.Unlock(); raise_exception_string(taskData, EXC_thread, "Too many threads"); } } else { taskArray[thrdIndex] = newTaskData; } schedLock.Unlock(); newTaskData->stack = gMem.NewStackSpace(machineDependent->InitialStackSize()); if (newTaskData->stack == 0) { delete(newTaskData); raise_exception_string(taskData, EXC_thread, "Unable to allocate thread stack"); } // Allocate anything needed for the new stack in the parent's heap. // The child still has inMLHeap set so mustn't GC. newTaskData->InitStackFrame(taskData, threadFunction, args); // Now actually fork the thread. bool success = false; schedLock.Lock(); #ifdef HAVE_PTHREAD success = pthread_create(&newTaskData->threadId, NULL, NewThreadFunction, newTaskData) == 0; #elif defined(HAVE_WINDOWS_H) newTaskData->threadHandle = CreateThread(NULL, 0, NewThreadFunction, newTaskData, 0, NULL); success = newTaskData->threadHandle != NULL; #endif if (success) { schedLock.Unlock(); if (debugOptions & DEBUG_THREADS) Log("THREAD: Forking new thread %p from thread %p\n", newTaskData, taskData); return threadId; } // Thread creation failed. taskArray[thrdIndex] = 0; delete(newTaskData); schedLock.Unlock(); if (debugOptions & DEBUG_THREADS) Log("THREAD: Fork from thread %p failed\n", taskData); raise_exception_string(taskData, EXC_thread, "Thread creation failed"); } catch (std::bad_alloc &) { raise_exception_string(taskData, EXC_thread, "Insufficient memory"); } } // ForkFromRTS. Creates a new thread from within the RTS. This is currently used // only to run a signal function. bool Processes::ForkFromRTS(TaskData *taskData, Handle proc, Handle arg) { try { (void)ForkThread(taskData, proc, arg, TAGGED(PFLAG_SYNCH), TAGGED(0)); return true; } catch (IOException &) { // If it failed return false; } } POLYUNSIGNED PolyThreadForkThread(PolyObject *threadId, PolyWord function, PolyWord attrs, PolyWord stack) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedFunction = taskData->saveVec.push(function); Handle result = 0; try { result = processesModule.ForkThread(taskData, pushedFunction, (Handle)0, attrs, stack); } catch (KillException &) { processes->ThreadExit(taskData); // TestSynchronousRequests may test for kill } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Deal with any interrupt or kill requests. bool Processes::ProcessAsynchRequests(TaskData *taskData) { bool wasInterrupted = false; TaskData *ptaskData = taskData; schedLock.Lock(); switch (ptaskData->requests) { case kRequestNone: schedLock.Unlock(); break; case kRequestInterrupt: { // Handle asynchronous interrupts only. // We've been interrupted. POLYUNSIGNED attrs = ThreadAttrs(ptaskData); POLYUNSIGNED intBits = attrs & PFLAG_INTMASK; if (intBits == PFLAG_ASYNCH || intBits == PFLAG_ASYNCH_ONCE) { if (intBits == PFLAG_ASYNCH_ONCE) { // Set this so from now on it's synchronous. // This word is only ever set by the thread itself so // we don't need to synchronise. attrs = (attrs & (~PFLAG_INTMASK)) | PFLAG_SYNCH; ptaskData->threadObject->flags = TAGGED(attrs); } ptaskData->requests = kRequestNone; // Clear this ptaskData->threadObject->requestCopy = TAGGED(0); // And in the ML copy schedLock.Unlock(); // Don't actually throw the exception here. taskData->SetException(interrupt_exn); wasInterrupted = true; } else schedLock.Unlock(); } break; case kRequestKill: // The thread has been asked to stop. schedLock.Unlock(); throw KillException(); // Doesn't return. } #ifndef HAVE_WINDOWS_H // Start the profile timer if needed. if (profileMode == kProfileTime) { if (! ptaskData->runningProfileTimer) { ptaskData->runningProfileTimer = true; StartProfilingTimer(); } } else ptaskData->runningProfileTimer = false; // The timer will be stopped next time it goes off. #endif return wasInterrupted; } // If this thread is processing interrupts synchronously and has been // interrupted clear the interrupt and raise the exception. This is // called from IO routines which may block. void Processes::TestSynchronousRequests(TaskData *taskData) { TaskData *ptaskData = taskData; schedLock.Lock(); switch (ptaskData->requests) { case kRequestNone: schedLock.Unlock(); break; case kRequestInterrupt: { // Handle synchronous interrupts only. // We've been interrupted. POLYUNSIGNED attrs = ThreadAttrs(ptaskData); POLYUNSIGNED intBits = attrs & PFLAG_INTMASK; if (intBits == PFLAG_SYNCH) { ptaskData->requests = kRequestNone; // Clear this ptaskData->threadObject->requestCopy = TAGGED(0); schedLock.Unlock(); taskData->SetException(interrupt_exn); throw IOException(); } else schedLock.Unlock(); } break; case kRequestKill: // The thread has been asked to stop. schedLock.Unlock(); throw KillException(); // Doesn't return. } } // Check for asynchronous or synchronous events void Processes::TestAnyEvents(TaskData *taskData) { TestSynchronousRequests(taskData); if (ProcessAsynchRequests(taskData)) throw IOException(); } // Request that the process should exit. // This will usually be called from an ML thread as a result of // a call to OS.Process.exit but on Windows it can be called from the GUI thread. void Processes::RequestProcessExit(int n) { if (singleThreaded) finish(n); exitResult = n; exitRequest = true; PLocker lock(&schedLock); // Lock so we know the main thread is waiting initialThreadWait.Signal(); // Wake it if it's sleeping. } /******************************************************************************/ /* */ /* catchVTALRM - handler for alarm-clock signal */ /* */ /******************************************************************************/ #if !defined(HAVE_WINDOWS_H) // N.B. This may be called either by an ML thread or by the main thread. // On the main thread taskData will be null. static void catchVTALRM(SIG_HANDLER_ARGS(sig, context)) { ASSERT(sig == SIGVTALRM); if (profileMode != kProfileTime) { // We stop the timer for this thread on the next signal after we end profile static struct itimerval stoptime = {{0, 0}, {0, 0}}; /* Stop the timer */ setitimer(ITIMER_VIRTUAL, & stoptime, NULL); } else { TaskData *taskData = processes->GetTaskDataForThread(); handleProfileTrap(taskData, (SIGNALCONTEXT*)context); } } #else /* Windows including Cygwin */ // This runs as a separate thread. Every millisecond it checks the CPU time used // by each ML thread and increments the count for each thread that has used a // millisecond of CPU time. static bool testCPUtime(HANDLE hThread, LONGLONG &lastCPUTime) { FILETIME cTime, eTime, kTime, uTime; // Try to get the thread CPU time if possible. This isn't supported // in Windows 95/98 so if it fails we just include this thread anyway. if (GetThreadTimes(hThread, &cTime, &eTime, &kTime, &uTime)) { LONGLONG totalTime = 0; LARGE_INTEGER li; li.LowPart = kTime.dwLowDateTime; li.HighPart = kTime.dwHighDateTime; totalTime += li.QuadPart; li.LowPart = uTime.dwLowDateTime; li.HighPart = uTime.dwHighDateTime; totalTime += li.QuadPart; if (totalTime - lastCPUTime >= 10000) { lastCPUTime = totalTime; return true; } return false; } else return true; // Failed to get thread time, maybe Win95. } void Processes::ProfileInterrupt(void) { // Wait for millisecond or until the stop event is signalled. while (WaitForSingleObject(hStopEvent, 1) == WAIT_TIMEOUT) { // We need to hold schedLock to examine the taskArray but // that is held during garbage collection. if (schedLock.Trylock()) { for (std::vector::iterator i = taskArray.begin(); i != taskArray.end(); i++) { TaskData *p = *i; if (p && p->threadHandle) { if (testCPUtime(p->threadHandle, p->lastCPUTime)) { CONTEXT context; SuspendThread(p->threadHandle); context.ContextFlags = CONTEXT_CONTROL; /* Get Eip and Esp */ if (GetThreadContext(p->threadHandle, &context)) { handleProfileTrap(p, &context); } ResumeThread(p->threadHandle); } } } schedLock.Unlock(); } // Check the CPU time used by the main thread. This is used for GC // so we need to check that as well. if (testCPUtime(mainThreadHandle, lastCPUTime)) handleProfileTrap(NULL, NULL); } } DWORD WINAPI ProfilingTimer(LPVOID parm) { processesModule.ProfileInterrupt(); return 0; } #endif // Profiling control. Called by the root thread. void Processes::StartProfiling(void) { #ifdef HAVE_WINDOWS_H DWORD threadId; extern FILE *polyStdout; if (profilingHd) return; ResetEvent(hStopEvent); profilingHd = CreateThread(NULL, 0, ProfilingTimer, NULL, 0, &threadId); if (profilingHd == NULL) fputs("Creating ProfilingTimer thread failed.\n", polyStdout); /* Give this a higher than normal priority so it pre-empts the main thread. Without this it will tend only to be run when the main thread blocks for some reason. */ SetThreadPriority(profilingHd, THREAD_PRIORITY_ABOVE_NORMAL); #else // In Linux, at least, we need to run a timer in each thread. // We request each to enter the RTS so that it will start the timer. // Since this is being run by the main thread while all the ML threads // are paused this may not actually be necessary. for (std::vector::iterator i = taskArray.begin(); i != taskArray.end(); i++) { TaskData *taskData = *i; if (taskData) { taskData->InterruptCode(); } } StartProfilingTimer(); // Start the timer in the root thread. #endif } void Processes::StopProfiling(void) { #ifdef HAVE_WINDOWS_H if (hStopEvent) SetEvent(hStopEvent); // Wait for the thread to stop if (profilingHd) WaitForSingleObject(profilingHd, 10000); CloseHandle(profilingHd); profilingHd = NULL; #endif } // Called by the ML signal handling thread. It blocks until a signal // arrives. There should only be a single thread waiting here. bool Processes::WaitForSignal(TaskData *taskData, PLock *sigLock) { TaskData *ptaskData = taskData; // We need to hold the signal lock until we have acquired schedLock. schedLock.Lock(); sigLock->Unlock(); if (sigTask != 0) { schedLock.Unlock(); return false; } sigTask = ptaskData; if (ptaskData->requests == kRequestNone) { // Now release the ML memory. A GC can start. ThreadReleaseMLMemoryWithSchedLock(ptaskData); globalStats.incCount(PSC_THREADS_WAIT_SIGNAL); ptaskData->threadLock.Wait(&schedLock); globalStats.decCount(PSC_THREADS_WAIT_SIGNAL); // We want to use the memory again. ThreadUseMLMemoryWithSchedLock(ptaskData); } sigTask = 0; schedLock.Unlock(); return true; } // Called by the signal detection thread to wake up the signal handler // thread. Must be called AFTER releasing sigLock. void Processes::SignalArrived(void) { PLocker locker(&schedLock); if (sigTask) sigTask->threadLock.Signal(); } #ifdef HAVE_PTHREAD // This is called when the thread exits in foreign code and // ThreadExit has not been called. static void threaddata_destructor(void *p) { TaskData *pt = (TaskData *)p; pt->threadExited = true; // This doesn't actually wake the main thread and relies on the // regular check to release the task data. } #endif void Processes::Init(void) { #ifdef HAVE_PTHREAD pthread_key_create(&tlsId, threaddata_destructor); #elif defined(HAVE_WINDOWS_H) tlsId = TlsAlloc(); #else singleThreaded = true; #endif #if defined(HAVE_WINDOWS_H) /* Windows including Cygwin. */ // Create stop event for time profiling. hStopEvent = CreateEvent(NULL, TRUE, FALSE, NULL); // Get the thread handle for this thread. HANDLE thisProcess = GetCurrentProcess(); DuplicateHandle(thisProcess, GetCurrentThread(), thisProcess, &mainThreadHandle, THREAD_ALL_ACCESS, FALSE, 0); #else // Set up a signal handler. This will be the same for all threads. markSignalInuse(SIGVTALRM); setSignalHandler(SIGVTALRM, catchVTALRM); #endif } #ifndef HAVE_WINDOWS_H // On Linux, at least, each thread needs to run this. void Processes::StartProfilingTimer(void) { // set virtual timer to go off every millisecond struct itimerval starttime; starttime.it_interval.tv_sec = starttime.it_value.tv_sec = 0; starttime.it_interval.tv_usec = starttime.it_value.tv_usec = 1000; setitimer(ITIMER_VIRTUAL,&starttime,NULL); } #endif void Processes::Stop(void) { #ifdef HAVE_PTHREAD pthread_key_delete(tlsId); #elif defined(HAVE_WINDOWS_H) TlsFree(tlsId); #endif #if defined(HAVE_WINDOWS_H) /* Stop the timer and profiling threads. */ if (hStopEvent) SetEvent(hStopEvent); if (profilingHd) { WaitForSingleObject(profilingHd, 10000); CloseHandle(profilingHd); profilingHd = NULL; } if (hStopEvent) CloseHandle(hStopEvent); hStopEvent = NULL; if (mainThreadHandle) CloseHandle(mainThreadHandle); mainThreadHandle = NULL; #else profileMode = kProfileOff; // Make sure the timer is not running struct itimerval stoptime; memset(&stoptime, 0, sizeof(stoptime)); setitimer(ITIMER_VIRTUAL, &stoptime, NULL); #endif } void Processes::GarbageCollect(ScanAddress *process) /* Ensures that all the objects are retained and their addresses updated. */ { /* The interrupt exn */ if (interrupt_exn != 0) { PolyObject *p = interrupt_exn; process->ScanRuntimeAddress(&p, ScanAddress::STRENGTH_STRONG); interrupt_exn = (PolyException*)p; } for (std::vector::iterator i = taskArray.begin(); i != taskArray.end(); i++) { if (*i) (*i)->GarbageCollect(process); } } void TaskData::GarbageCollect(ScanAddress *process) { saveVec.gcScan(process); if (threadObject != 0) { PolyObject *p = threadObject; process->ScanRuntimeAddress(&p, ScanAddress::STRENGTH_STRONG); threadObject = (ThreadObject*)p; } if (blockMutex != 0) process->ScanRuntimeAddress(&blockMutex, ScanAddress::STRENGTH_STRONG); // The allocation spaces are no longer valid. allocPointer = 0; allocLimit = 0; // Divide the allocation size by four. If we have made a single allocation // since the last GC the size will have been doubled after the allocation. // On average for each thread, apart from the one that ran out of space // and requested the GC, half of the space will be unused so reducing by // four should give a good estimate for next time. if (allocCount != 0) { // Do this only once for each GC. allocCount = 0; allocSize = allocSize/4; if (allocSize < MIN_HEAP_SIZE) allocSize = MIN_HEAP_SIZE; } process->ScanRuntimeWord(&foreignStack); } // Return the number of processors. extern unsigned NumberOfProcessors(void) { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) SYSTEM_INFO info; memset(&info, 0, sizeof(info)); GetSystemInfo(&info); if (info.dwNumberOfProcessors == 0) // Just in case info.dwNumberOfProcessors = 1; return info.dwNumberOfProcessors; #elif(defined(_SC_NPROCESSORS_ONLN)) long res = sysconf(_SC_NPROCESSORS_ONLN); if (res <= 0) res = 1; return res; #elif(defined(HAVE_SYSCTL) && defined(CTL_HW) && defined(HW_NCPU)) static int mib[2] = { CTL_HW, HW_NCPU }; int nCPU = 1; size_t len = sizeof(nCPU); if (sysctl(mib, 2, &nCPU, &len, NULL, 0) == 0 && len == sizeof(nCPU)) return nCPU; else return 1; #else // Can't determine. return 1; #endif } // Return the number of physical processors. If hyperthreading is // enabled this returns less than NumberOfProcessors. Returns zero if // it cannot be determined. // This can be used in Cygwin as well as native Windows. #if (defined(HAVE_SYSTEM_LOGICAL_PROCESSOR_INFORMATION)) typedef BOOL (WINAPI *GETP)(SYSTEM_LOGICAL_PROCESSOR_INFORMATION*, PDWORD); // Windows - use GetLogicalProcessorInformation if it's available. static unsigned WinNumPhysicalProcessors(void) { GETP getProcInfo = (GETP) GetProcAddress(GetModuleHandle(_T("kernel32")), "GetLogicalProcessorInformation"); if (getProcInfo == 0) return 0; // It's there - use it. SYSTEM_LOGICAL_PROCESSOR_INFORMATION *buff = 0; DWORD space = 0; while (getProcInfo(buff, &space) == FALSE) { if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) { free(buff); return 0; } free(buff); buff = (PSYSTEM_LOGICAL_PROCESSOR_INFORMATION)malloc(space); if (buff == 0) return 0; } // Calculate the number of full entries in case it's truncated. unsigned nItems = space / sizeof(SYSTEM_LOGICAL_PROCESSOR_INFORMATION); unsigned numProcs = 0; for (unsigned i = 0; i < nItems; i++) { if (buff[i].Relationship == RelationProcessorCore) numProcs++; } free(buff); return numProcs; } #endif // Read and parse /proc/cpuinfo static unsigned LinuxNumPhysicalProcessors(void) { // Find out the total. This should be the maximum. unsigned nProcs = NumberOfProcessors(); // If there's only one we don't need to check further. if (nProcs <= 1) return nProcs; long *cpus = (long*)calloc(nProcs, sizeof(long)); if (cpus == 0) return 0; FILE *cpuInfo = fopen("/proc/cpuinfo", "r"); if (cpuInfo == NULL) { free(cpus); return 0; } char line[40]; unsigned count = 0; while (fgets(line, sizeof(line), cpuInfo) != NULL) { if (strncmp(line, "core id\t\t:", 10) == 0) { long n = strtol(line+10, NULL, 10); unsigned i = 0; // Skip this id if we've seen it already while (i < count && cpus[i] != n) i++; if (i == count) cpus[count++] = n; } if (strchr(line, '\n') == 0) { int ch; do { ch = getc(cpuInfo); } while (ch != '\n' && ch != EOF); } } fclose(cpuInfo); free(cpus); return count; } extern unsigned NumberOfPhysicalProcessors(void) { unsigned numProcs = 0; #if (defined(HAVE_SYSTEM_LOGICAL_PROCESSOR_INFORMATION)) numProcs = WinNumPhysicalProcessors(); if (numProcs != 0) return numProcs; #endif #if (defined(HAVE_SYSCTLBYNAME) && defined(HAVE_SYS_SYSCTL_H)) // Mac OS X int nCores; size_t len = sizeof(nCores); if (sysctlbyname("hw.physicalcpu", &nCores, &len, NULL, 0) == 0) return (unsigned)nCores; #endif numProcs = LinuxNumPhysicalProcessors(); if (numProcs != 0) return numProcs; // Any other cases? return numProcs; } diff --git a/libpolyml/processes.h b/libpolyml/processes.h index bdc7533c..c71a1cfa 100644 --- a/libpolyml/processes.h +++ b/libpolyml/processes.h @@ -1,362 +1,362 @@ /* Title: Lightweight process library Author: David C.J. Matthews Copyright (c) 2007-8, 2012, 2015, 2017, 2019 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef _PROCESSES_H_ #define _PROCESSES_H_ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #include "globals.h" #include "rts_module.h" #include "save_vec.h" #include "noreturn.h" #include "locking.h" class SaveVecEntry; typedef SaveVecEntry *Handle; class StackSpace; class PolyWord; class ScanAddress; class MDTaskData; class Exporter; class StackObject; #ifdef HAVE_WINDOWS_H typedef void *HANDLE; #endif #ifdef HAVE_SIGNAL_H #include #endif #ifdef HAVE_UCONTEXT_H #include #endif #ifdef HAVE_PTHREAD_H #include #endif // SIGNALCONTEXT is the argument type that is passed to GetPCandSPFromContext // to get the actual PC and SP in a profiling trap. #if defined(HAVE_WINDOWS_H) // First because it's used in both native Windows and Cygwin. #include #define SIGNALCONTEXT CONTEXT // This is the thread context. #elif defined(HAVE_UCONTEXT_T) #define SIGNALCONTEXT ucontext_t #elif defined(HAVE_STRUCT_SIGCONTEXT) #define SIGNALCONTEXT struct sigcontext #else #define SIGNALCONTEXT void #endif #define MIN_HEAP_SIZE 4096 // Minimum and initial heap segment size (words) // This is the ML "thread identifier" object. The fields // are read and set by the ML code. class ThreadObject: public PolyObject { public: PolyWord threadRef; // Weak ref containing the address of the thread data. Not used by ML PolyWord flags; // Tagged integer containing flags indicating how interrupts // are handled. Set by ML but only by the thread itself PolyWord threadLocal; // Head of a list of thread-local store items. // Handled entirely by ML but only by the thread. PolyWord requestCopy; // A tagged integer copy of the "requests" field. // This is provided so that ML can easily test if there // is an interrupt pending. PolyWord mlStackSize; // A tagged integer with the maximum ML stack size in bytes PolyWord debuggerSlots[4]; // These are used by the debugger. }; // Other threads may make requests to a thread. typedef enum { kRequestNone = 0, // Increasing severity kRequestInterrupt = 1, kRequestKill = 2 } ThreadRequests; // Per-thread data. This is subclassed for each architecture. class TaskData { public: TaskData(); virtual ~TaskData(); void FillUnusedSpace(void); virtual void GarbageCollect(ScanAddress *process); virtual Handle EnterPolyCode() = 0; // Start running ML virtual void InterruptCode() = 0; virtual bool AddTimeProfileCount(SIGNALCONTEXT *context) = 0; // Initialise the stack for a new thread. The parent task object is passed in because any // allocation that needs to be made must be made in the parent. virtual void InitStackFrame(TaskData *parentTask, Handle proc, Handle arg) = 0; virtual void SetException(poly_exn *exc) = 0; // If a foreign function calls back to ML we need to set up the call to the // ML callback function. virtual Handle EnterCallbackFunction(Handle func, Handle args) = 0; // The scheduler needs versions of atomic increment and atomic reset that // work in exactly the same way as the code-generated versions (if any). // Atomic decrement isn't needed since it only ever releases a mutex. virtual Handle AtomicIncrement(Handle mutexp) = 0; // Reset a mutex to one. This needs to be atomic with respect to the // atomic increment and decrement instructions. virtual void AtomicReset(Handle mutexp) = 0; virtual void CopyStackFrame(StackObject *old_stack, uintptr_t old_length, StackObject *new_stack, uintptr_t new_length) = 0; virtual uintptr_t currentStackSpace(void) const = 0; // Add a count to the local function if we are using store profiling. virtual void addProfileCount(POLYUNSIGNED words) = 0; // Functions called before and after an RTS call. virtual void PreRTSCall(void) { inML = false; } virtual void PostRTSCall(void) { inML = true; } SaveVec saveVec; PolyWord *allocPointer; // Allocation pointer - decremented towards... PolyWord *allocLimit; // ... lower limit of allocation uintptr_t allocSize; // The preferred heap segment size unsigned allocCount; // The number of allocations since the last GC StackSpace *stack; ThreadObject *threadObject; // Pointer to the thread object. int lastError; // Last error from foreign code. void *signalStack; // Stack to handle interrupts (Unix only) PolyWord foreignStack; // Stack of saved data used in call_sym_and_convert bool inML; // True when this is in ML, false in the RTS // Get a TaskData pointer given the ML taskId. // This is called at the start of every RTS function that may allocate memory. // It is can be called safely to get the thread's own TaskData object without // a lock but any call to get the TaskData for another thread must take the // schedLock first in case the thread is exiting. static TaskData *FindTaskForId(PolyObject *taskId) { return *(TaskData**)(((ThreadObject*)taskId)->threadRef.AsObjPtr()); } private: // If a thread has to block it will block on this. PCondVar threadLock; // External requests made are stored here until they // can be actioned. ThreadRequests requests; // Pointer to the mutex when blocked. Set to NULL when it doesn't apply. PolyObject *blockMutex; // This is set to false when a thread blocks or enters foreign code, // While it is true the thread can manipulate ML memory so no other // thread can garbage collect. bool inMLHeap; // In Linux, at least, we need to run a separate timer in each thread bool runningProfileTimer; #ifdef HAVE_WINDOWS_H LONGLONG lastCPUTime; // Used for profiling #endif public: bool threadExited; private: #ifdef HAVE_PTHREAD_H pthread_t threadId; #endif #ifdef HAVE_WINDOWS_H public: // Because, on Cygwin, it's used in NewThreadFunction HANDLE threadHandle; private: #endif friend class Processes; }; NORETURNFN(extern Handle exitThread(TaskData *mdTaskData)); class ScanAddress; // Indicate what the main thread is doing if the profile // timer goes off. extern enum _mainThreadPhase { MTP_USER_CODE=0, MTP_GCPHASESHARING, MTP_GCPHASEMARK, MTP_GCPHASECOMPACT, MTP_GCPHASEUPDATE, MTP_GCQUICK, MTP_SHARING, MTP_EXPORTING, MTP_SAVESTATE, MTP_LOADSTATE, MTP_PROFILING, MTP_SIGHANDLER, MTP_CYGWINSPAWN, MTP_STOREMODULE, MTP_LOADMODULE, MTP_MAXENTRY } mainThreadPhase; // Data structure used for requests from a thread to the root // thread. These are GCs or similar. class MainThreadRequest { public: MainThreadRequest (enum _mainThreadPhase phase): mtp(phase), completed(false) {} virtual ~MainThreadRequest () {} // Suppress silly GCC warning const enum _mainThreadPhase mtp; bool completed; virtual void Perform() = 0; }; class PLock; // Class to wait for a given time or for an event, whichever comes first. // // A pointer to this class or a subclass is passed to ThreadPauseForIO. // Because a thread may be interrupted or killed by another ML thread we // don't allow any thread to block indefinitely. Instead whenever a // thread wants to do an operation that may block we have it enter a // loop that polls for the desired condition and if it is not ready it // calls ThreadPauseForIO. The default action is to block for a short // period and then return so that the caller can poll again. That can // limit performance when, for example, reading from a pipe so where possible // we use a sub-class that waits until either input is available or it times // out, whichever comes first, using "select" in Unix or MsgWaitForMultipleObjects // in Windows. // During a call to Waiter::Wait the thread is set as "not using ML memory" // so a GC can happen while this thread is blocked. class Waiter { public: Waiter() {} virtual ~Waiter() {} virtual void Wait(unsigned maxMillisecs); static Waiter *defaultWaiter; }; -#ifdef HAVE_WINDOWS_H +#ifdef _WIN32 class WaitHandle: public Waiter { public: WaitHandle(HANDLE h): m_Handle(h) {} virtual void Wait(unsigned maxMillisecs); private: HANDLE m_Handle; }; -#endif -#if (! defined(_WIN32) || defined(__CYGWIN__)) +#else + // Unix: Wait until a file descriptor is available for input class WaitInputFD: public Waiter { public: WaitInputFD(int fd): m_waitFD(fd) {} virtual void Wait(unsigned maxMillisecs); private: int m_waitFD; }; #endif // External interface to the Process module. These functions are all implemented // by the Processes class. class ProcessExternal { public: virtual ~ProcessExternal() {} // Defined to suppress a warning from GCC virtual TaskData *GetTaskDataForThread(void) = 0; virtual TaskData *CreateNewTaskData(Handle threadId, Handle threadFunction, Handle args, PolyWord flags) = 0; // Request all ML threads to exit and set the result code. Does not cause // the calling thread itself to exit since this may be called on the GUI thread. virtual void RequestProcessExit(int n) = 0; // Exit from this thread. virtual NORETURNFN(void ThreadExit(TaskData *taskData)) = 0; virtual void BroadcastInterrupt(void) = 0; virtual void BeginRootThread(PolyObject *rootFunction) = 0; // Called when a thread may block. Returns some time later when perhaps // the input is available. virtual void ThreadPauseForIO(TaskData *taskData, Waiter *pWait) = 0; // As ThreadPauseForIO but when there is no stream virtual void ThreadPause(TaskData *taskData) { ThreadPauseForIO(taskData, Waiter::defaultWaiter); } // If a thread is blocking for some time it should release its use // of the ML memory. That allows a GC. ThreadUseMLMemory returns true if // a GC was in progress. virtual void ThreadUseMLMemory(TaskData *taskData) = 0; virtual void ThreadReleaseMLMemory(TaskData *taskData) = 0; // Requests from the threads for actions that need to be performed by // the root thread. virtual void MakeRootRequest(TaskData *taskData, MainThreadRequest *request) = 0; // Deal with any interrupt or kill requests. virtual bool ProcessAsynchRequests(TaskData *taskData) = 0; // Process an interrupt request synchronously. virtual void TestSynchronousRequests(TaskData *taskData) = 0; // Process any events, synchronous or asynchronous. virtual void TestAnyEvents(TaskData *taskData) = 0; // ForkFromRTS. Creates a new thread from within the RTS. virtual bool ForkFromRTS(TaskData *taskData, Handle proc, Handle arg) = 0; // Profiling control. virtual void StartProfiling(void) = 0; virtual void StopProfiling(void) = 0; // Find space for an object. Returns a pointer to the start. "words" must include // the length word and the result points at where the length word will go. // If the allocation succeeds it may update the allocation values in the taskData object. // If the heap is exhausted it may set this thread (or other threads) to raise an exception. virtual PolyWord *FindAllocationSpace(TaskData *taskData, POLYUNSIGNED words, bool alwaysInSeg) = 0; // Signal handling support. The ML signal handler thread blocks until it is // woken up by the signal detection thread. virtual bool WaitForSignal(TaskData *taskData, PLock *sigLock) = 0; virtual void SignalArrived(void) = 0; // After a Unix fork we only have a single thread in the new process. virtual void SetSingleThreaded(void) = 0; virtual poly_exn* GetInterrupt(void) = 0; }; // Return the number of processors. Used when configuring multi-threaded GC. extern unsigned NumberOfProcessors(void); extern unsigned NumberOfPhysicalProcessors(void); extern ProcessExternal *processes; extern struct _entrypts processesEPT[]; #endif diff --git a/libpolyml/run_time.cpp b/libpolyml/run_time.cpp index 4b9c3034..ce0751de 100644 --- a/libpolyml/run_time.cpp +++ b/libpolyml/run_time.cpp @@ -1,417 +1,417 @@ /* Title: Run-time system. Author: Dave Matthews, Cambridge University Computer Laboratory Copyright (c) 2000 Cambridge University Technical Services Limited Further work copyright David C. J. Matthews 2009, 2012, 2015-18 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) 0 #endif #include "globals.h" #include "gc.h" #include "mpoly.h" #include "arb.h" #include "diagnostics.h" #include "processes.h" #include "profiling.h" #include "run_time.h" #include "sys.h" #include "polystring.h" #include "save_vec.h" #include "rtsentry.h" #include "memmgr.h" extern "C" { POLYEXTERNALSYMBOL POLYUNSIGNED PolyFullGC(PolyObject *threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyIsBigEndian(); } #define SAVE(x) taskData->saveVec.push(x) #define SIZEOF(x) (sizeof(x)/sizeof(PolyWord)) // This is the storage allocator for allocating heap objects in the RTS. PolyObject *alloc(TaskData *taskData, uintptr_t data_words, unsigned flags) /* Allocate a number of words. */ { // Check the size. This might possibly happen with a long string. if (data_words > MAX_OBJECT_SIZE) raise_exception0(taskData, EXC_size); POLYUNSIGNED words = (POLYUNSIGNED)data_words + 1; if (profileMode == kProfileStoreAllocation) taskData->addProfileCount(words); PolyWord *foundSpace = processes->FindAllocationSpace(taskData, words, false); if (foundSpace == 0) { // Failed - the thread is set to raise an exception. throw IOException(); } PolyObject *pObj = (PolyObject*)(foundSpace + 1); pObj->SetLengthWord((POLYUNSIGNED)data_words, flags); // Must initialise object here, because GC doesn't clean store. // Is this necessary any more? This used to be necessary when we used // structural equality and wanted to make sure that unused bytes were cleared. // N.B. This sets the store to zero NOT TAGGED(0). for (POLYUNSIGNED i = 0; i < data_words; i++) pObj->Set(i, PolyWord::FromUnsigned(0)); return pObj; } Handle alloc_and_save(TaskData *taskData, uintptr_t size, unsigned flags) /* Allocate and save the result on the vector. */ { return taskData->saveVec.push(alloc(taskData, size, flags)); } POLYUNSIGNED PolyFullGC(PolyObject *threadId) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); try { // Can this raise an exception e.g. if there is insufficient memory? FullGC(taskData); } catch (...) { } // If an ML exception is raised taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); // Returns unit. } /******************************************************************************/ /* */ /* Error Messages */ /* */ /******************************************************************************/ // Return the handle to a string error message. This will return // something like "Unknown error" from strerror if it doesn't match // anything. Handle errorMsg(TaskData *taskData, int err) { -#if (defined(_WIN32) || defined(__CYGWIN__)) +#if (defined(_WIN32)) LPTSTR lpMsg = NULL; TCHAR *p; if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, (DWORD)err, 0, (LPTSTR)&lpMsg, 1, NULL) > 0) { /* The message is returned with CRLF at the end. Remove them. */ for (p = lpMsg; *p != '\0' && *p != '\n' && *p != '\r'; p++); *p = '\0'; Handle res = SAVE(C_string_to_Poly(taskData, lpMsg)); LocalFree(lpMsg); return res; } #endif // Unix and unknown Windows errors. return SAVE(C_string_to_Poly(taskData, strerror(err))); } #define DEREFEXNHANDLE(_x) ((poly_exn *)DEREFHANDLE(_x)) static Handle make_exn(TaskData *taskData, int id, Handle arg, const char *fileName, int lineNo) { const char *exName; switch (id) { case EXC_interrupt: exName = "Interrupt"; break; case EXC_syserr: exName = "SysErr"; break; case EXC_size: exName = "Size"; break; case EXC_overflow: exName = "Overflow"; break; case EXC_underflow: exName = "Underflow"; break; case EXC_divide: exName = "Div"; break; case EXC_conversion: exName = "Conversion"; break; case EXC_XWindows: exName = "XWindows"; break; case EXC_subscript: exName = "Subscript"; break; case EXC_foreign: exName = "Foreign"; break; case EXC_Fail: exName = "Fail"; break; case EXC_thread: exName = "Thread"; break; case EXC_extrace: exName = "ExTrace"; break; default: ASSERT(0); exName = "Unknown"; // Shouldn't happen. } Handle pushed_name = SAVE(C_string_to_Poly(taskData, exName)); Handle exnHandle = alloc_and_save(taskData, SIZEOF(poly_exn)); Handle location; // The location data in an exception packet is either "NoLocation" (tagged 0) // or the address of a record. if (fileName == 0) location = taskData->saveVec.push(TAGGED(0)); else { Handle file = taskData->saveVec.push(C_string_to_Poly(taskData, fileName)); Handle line = Make_fixed_precision(taskData, lineNo); location = alloc_and_save(taskData, 5); location->WordP()->Set(0, file->Word()); // file location->WordP()->Set(1, line->Word()); // startLine location->WordP()->Set(2, line->Word()); // endLine location->WordP()->Set(3, TAGGED(0)); // startPosition location->WordP()->Set(4, TAGGED(0)); // endPosition } DEREFEXNHANDLE(exnHandle)->ex_id = TAGGED(id); DEREFEXNHANDLE(exnHandle)->ex_name = pushed_name->Word(); DEREFEXNHANDLE(exnHandle)->arg = arg->Word(); DEREFEXNHANDLE(exnHandle)->ex_location = location->Word(); return exnHandle; } // Create an exception packet, e.g. Interrupt, for later use. This does not have a // location. poly_exn *makeExceptionPacket(TaskData *taskData, int id) { Handle exn = make_exn(taskData, id, taskData->saveVec.push(TAGGED(0)), 0, 0); return DEREFEXNHANDLE(exn); } static NORETURNFN(void raise_exception(TaskData *taskData, int id, Handle arg, const char *file, int line)); void raise_exception(TaskData *taskData, int id, Handle arg, const char *file, int line) /* Raise an exception with no arguments. */ { Handle exn = make_exn(taskData, id, arg, file, line); taskData->SetException(DEREFEXNHANDLE(exn)); throw IOException(); /* Return to Poly code immediately. */ /*NOTREACHED*/ } void raiseException0WithLocation(TaskData *taskData, int id, const char *file, int line) /* Raise an exception with no arguments. */ { raise_exception(taskData, id, SAVE(TAGGED(0)), file, line); /*NOTREACHED*/ } void raiseExceptionStringWithLocation(TaskData *taskData, int id, const char *str, const char *file, int line) /* Raise an exception with a C string as the argument. */ { raise_exception(taskData, id, SAVE(C_string_to_Poly(taskData, str)), file, line); /*NOTREACHED*/ } // This is called via a macro that puts in the file name and line number. void raiseSycallWithLocation(TaskData *taskData, const char *errmsg, int err, const char *file, int line) { if (err == 0) { Handle pushed_option = SAVE(NONE_VALUE); /* NONE */ Handle pushed_name = SAVE(C_string_to_Poly(taskData, errmsg)); Handle pair = alloc_and_save(taskData, 2); DEREFHANDLE(pair)->Set(0, pushed_name->Word()); DEREFHANDLE(pair)->Set(1, pushed_option->Word()); raise_exception(taskData, EXC_syserr, pair, file, line); } else { Handle errornum = Make_sysword(taskData, err); Handle pushed_option = alloc_and_save(taskData, 1); DEREFHANDLE(pushed_option)->Set(0, errornum->Word()); /* SOME err */ Handle pushed_name = errorMsg(taskData, err); // Generate the string. Handle pair = alloc_and_save(taskData, 2); DEREFHANDLE(pair)->Set(0, pushed_name->Word()); DEREFHANDLE(pair)->Set(1, pushed_option->Word()); raise_exception(taskData, EXC_syserr, pair, file, line); } } void raiseExceptionFailWithLocation(TaskData *taskData, const char *str, const char *file, int line) { raiseExceptionStringWithLocation(taskData, EXC_Fail, str, file, line); } /* "Polymorphic" function to generate a list. */ Handle makeList(TaskData *taskData, int count, char *p, int size, void *arg, Handle (mkEntry)(TaskData *, void*, char*)) { Handle saved = taskData->saveVec.mark(); Handle list = SAVE(ListNull); /* Start from the end of the list. */ p += count*size; while (count > 0) { Handle value, next; p -= size; /* Back up to the last entry. */ value = mkEntry(taskData, arg, p); next = alloc_and_save(taskData, SIZEOF(ML_Cons_Cell)); DEREFLISTHANDLE(next)->h = value->Word(); DEREFLISTHANDLE(next)->t = list->Word(); taskData->saveVec.reset(saved); list = SAVE(next->Word()); count--; } return list; } void CheckAndGrowStack(TaskData *taskData, uintptr_t minSize) /* Expands the current stack if it has grown. We cannot shrink a stack segment when it grows smaller because the frame is checked only at the beginning of a function to ensure that there is enough space for the maximum that can be allocated. */ { /* Get current size of new stack segment. */ uintptr_t old_len = taskData->stack->spaceSize(); if (old_len >= minSize) return; /* Ok with present size. */ // If it is too small double its size. uintptr_t new_len; /* New size */ for (new_len = old_len; new_len < minSize; new_len *= 2); uintptr_t limitSize = getPolyUnsigned(taskData, taskData->threadObject->mlStackSize); // Do not grow the stack if its size is already too big. if ((limitSize != 0 && old_len >= limitSize) || ! gMem.GrowOrShrinkStack(taskData, new_len)) { /* Cannot expand the stack any further. */ extern FILE *polyStderr; fprintf(polyStderr, "Warning - Unable to increase stack - interrupting thread\n"); if (debugOptions & DEBUG_THREADS) Log("THREAD: Unable to grow stack for thread %p from %lu to %lu\n", taskData, old_len, new_len); // We really should do this only if the thread is handling interrupts // asynchronously. On the other hand what else do we do? taskData->SetException(processes->GetInterrupt()); } else { if (debugOptions & DEBUG_THREADS) Log("THREAD: Growing stack for thread %p from %lu to %lu\n", taskData, old_len, new_len); } } Handle Make_fixed_precision(TaskData *taskData, int val) { if (val > MAXTAGGED || val < -MAXTAGGED-1) raise_exception0(taskData, EXC_overflow); return taskData->saveVec.push(TAGGED(val)); } Handle Make_fixed_precision(TaskData *taskData, unsigned uval) { if (uval > MAXTAGGED) raise_exception0(taskData, EXC_overflow); return taskData->saveVec.push(TAGGED(uval)); } Handle Make_fixed_precision(TaskData *taskData, long val) { if (val > MAXTAGGED || val < -MAXTAGGED-1) raise_exception0(taskData, EXC_overflow); return taskData->saveVec.push(TAGGED(val)); } Handle Make_fixed_precision(TaskData *taskData, unsigned long uval) { if (uval > MAXTAGGED) raise_exception0(taskData, EXC_overflow); return taskData->saveVec.push(TAGGED(uval)); } #ifdef HAVE_LONG_LONG Handle Make_fixed_precision(TaskData *taskData, long long val) { if (val > MAXTAGGED || val < -MAXTAGGED-1) raise_exception0(taskData, EXC_overflow); return taskData->saveVec.push(TAGGED((POLYSIGNED)val)); } Handle Make_fixed_precision(TaskData *taskData, unsigned long long uval) { if (uval > MAXTAGGED) raise_exception0(taskData, EXC_overflow); return taskData->saveVec.push(TAGGED((POLYUNSIGNED)uval)); } #endif Handle Make_sysword(TaskData *taskData, uintptr_t p) { Handle result = alloc_and_save(taskData, sizeof(uintptr_t)/sizeof(PolyWord), F_BYTE_OBJ); *(uintptr_t*)(result->Word().AsCodePtr()) = p; return result; } // A volatile ref is used for data that is not valid in a different session. // When loaded from a saved state it is cleared to zero. Handle MakeVolatileWord(TaskData *taskData, void *p) { Handle result = alloc_and_save(taskData, WORDS(SIZEOF_VOIDP), F_BYTE_OBJ | F_WEAK_BIT | F_MUTABLE_BIT | F_NO_OVERWRITE); *(void**)(result->Word().AsCodePtr()) = p; return result; } Handle MakeVolatileWord(TaskData *taskData, uintptr_t p) { return MakeVolatileWord(taskData, (void*)p); } // This is used to determine the endian-ness that Poly/ML is running under. // It's really only needed for the interpreter. In particular the pre-built // compiler may be running under either byte order and has to check at // run-time. POLYUNSIGNED PolyIsBigEndian() { #ifdef WORDS_BIGENDIAN return TAGGED(1).AsUnsigned(); #else return TAGGED(0).AsUnsigned(); #endif } struct _entrypts runTimeEPT[] = { { "PolyFullGC", (polyRTSFunction)&PolyFullGC}, { "PolyIsBigEndian", (polyRTSFunction)&PolyIsBigEndian}, { NULL, NULL} // End of list. }; diff --git a/libpolyml/savestate.cpp b/libpolyml/savestate.cpp index 8cc1c069..8b4822f9 100644 --- a/libpolyml/savestate.cpp +++ b/libpolyml/savestate.cpp @@ -1,2211 +1,2211 @@ /* Title: savestate.cpp - Save and Load state Copyright (c) 2007, 2015, 2017-19 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_WINDOWS_H #include // For MAX_PATH #endif #ifdef HAVE_SYS_PARAM_H #include // For MAX_PATH #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_TIME_H #include #endif #ifdef HAVE_SYS_TYPES_H #include #endif #ifdef HAVE_SYS_STAT_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #include #define ERRORNUMBER _doserrno #define NOMEMORY ERROR_NOT_ENOUGH_MEMORY #else typedef char TCHAR; #define _T(x) x #define _tfopen fopen #define _tcscpy strcpy #define _tcsdup strdup #define _tcslen strlen #define _fputtc fputc #define _fputts fputs #ifndef lstrcmpi #define lstrcmpi strcasecmp #endif #define ERRORNUMBER errno #define NOMEMORY ENOMEM #endif #include "globals.h" #include "savestate.h" #include "processes.h" #include "run_time.h" #include "polystring.h" #include "scanaddrs.h" #include "arb.h" #include "memmgr.h" #include "mpoly.h" // For exportTimeStamp #include "exporter.h" // For CopyScan #include "machine_dep.h" #include "osmem.h" #include "gc.h" // For FullGC. #include "timing.h" #include "rtsentry.h" #include "check_objects.h" #include "rtsentry.h" #include "../polyexports.h" // For InitHeaderFromExport #include "version.h" // For InitHeaderFromExport #ifdef _MSC_VER // Don't tell me about ISO C++ changes. #pragma warning(disable:4996) #endif extern "C" { POLYEXTERNALSYMBOL POLYUNSIGNED PolySaveState(PolyObject *threadId, PolyWord fileName, PolyWord depth); POLYEXTERNALSYMBOL POLYUNSIGNED PolyLoadState(PolyObject *threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyShowHierarchy(PolyObject *threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyRenameParent(PolyObject *threadId, PolyWord childName, PolyWord parentName); POLYEXTERNALSYMBOL POLYUNSIGNED PolyShowParent(PolyObject *threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyStoreModule(PolyObject *threadId, PolyWord name, PolyWord contents); POLYEXTERNALSYMBOL POLYUNSIGNED PolyLoadModule(PolyObject *threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyLoadHierarchy(PolyObject *threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetModuleDirectory(PolyObject *threadId); } // Helper class to close files on exit. class AutoClose { public: AutoClose(FILE *f = 0): m_file(f) {} ~AutoClose() { if (m_file) ::fclose(m_file); } operator FILE*() { return m_file; } FILE* operator = (FILE* p) { return (m_file = p); } private: FILE *m_file; }; // This is probably generally useful so may be moved into // a general header file. template class AutoFree { public: AutoFree(BASE p = 0): m_value(p) {} ~AutoFree() { free(m_value); } // Automatic conversions to the base type. operator BASE() { return m_value; } BASE operator = (BASE p) { return (m_value = p); } private: BASE m_value; }; /* * Structure definitions for the saved state files. */ #define SAVEDSTATESIGNATURE "POLYSAVE" #define SAVEDSTATEVERSION 2 // File header for a saved state file. This appears as the first entry // in the file. typedef struct _savedStateHeader { // These entries are primarily to check that we have a valid // saved state file before we try to interpret anything else. char headerSignature[8]; // Should contain SAVEDSTATESIGNATURE unsigned headerVersion; // Should contain SAVEDSTATEVERSION unsigned headerLength; // Number of bytes in the header unsigned segmentDescrLength; // Number of bytes in a descriptor // These entries contain the real data. off_t segmentDescr; // Position of segment descriptor table unsigned segmentDescrCount; // Number of segment descriptors in the table off_t stringTable; // Pointer to the string table (zero if none) size_t stringTableSize; // Size of string table unsigned parentNameEntry; // Position of parent name in string table (0 if top) time_t timeStamp; // The time stamp for this file. time_t parentTimeStamp; // The time stamp for the parent. void *originalBaseAddr; // Original base address (32-in-64 only) } SavedStateHeader; // Entry for segment table. This describes the segments on the disc that // need to be loaded into memory. typedef struct _savedStateSegmentDescr { off_t segmentData; // Position of the segment data size_t segmentSize; // Size of the segment data off_t relocations; // Position of the relocation table unsigned relocationCount; // Number of entries in relocation table unsigned relocationSize; // Size of a relocation entry unsigned segmentFlags; // Segment flags (see SSF_ values) unsigned segmentIndex; // The index of this segment or the segment it overwrites void *originalAddress; // The base address when the segment was written. } SavedStateSegmentDescr; #define SSF_WRITABLE 1 // The segment contains mutable data #define SSF_OVERWRITE 2 // The segment overwrites the data (mutable) in a parent. #define SSF_NOOVERWRITE 4 // The segment must not be further overwritten #define SSF_BYTES 8 // The segment contains only byte data #define SSF_CODE 16 // The segment contains only code typedef struct _relocationEntry { // Each entry indicates a location that has to be set to an address. // The location to be set is determined by adding "relocAddress" to the base address of // this segment (the one to which these relocations apply) and the value to store // by adding "targetAddress" to the base address of the segment indicated by "targetSegment". POLYUNSIGNED relocAddress; // The (byte) offset in this segment that we will set POLYUNSIGNED targetAddress; // The value to add to the base of the destination segment unsigned targetSegment; // The base segment. 0 is IO segment. ScanRelocationKind relKind; // The kind of relocation (processor dependent). } RelocationEntry; #define SAVE(x) taskData->saveVec.push(x) /* * Hierarchy table: contains information about last loaded or saved state. */ // Pointer to list of files loaded in last load. // There's no need for a lock since the update is only made when all // the ML threads have stopped. class HierarchyTable { public: HierarchyTable(const TCHAR *file, time_t time): fileName(_tcsdup(file)), timeStamp(time) { } AutoFree fileName; time_t timeStamp; }; HierarchyTable **hierarchyTable; static unsigned hierarchyDepth; static bool AddHierarchyEntry(const TCHAR *fileName, time_t timeStamp) { // Add an entry to the hierarchy table for this file. HierarchyTable *newEntry = new HierarchyTable(fileName, timeStamp); if (newEntry == 0) return false; HierarchyTable **newTable = (HierarchyTable **)realloc(hierarchyTable, sizeof(HierarchyTable *)*(hierarchyDepth+1)); if (newTable == 0) return false; hierarchyTable = newTable; hierarchyTable[hierarchyDepth++] = newEntry; return true; } // Test whether we're overwriting a parent of ourself. #if (defined(_WIN32) || defined(__CYGWIN__)) static bool sameFile(const TCHAR *x, const TCHAR *y) { HANDLE hXFile = INVALID_HANDLE_VALUE, hYFile = INVALID_HANDLE_VALUE; bool result = false; hXFile = CreateFile(x, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (hXFile == INVALID_HANDLE_VALUE) goto closeAndExit; hYFile = CreateFile(y, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (hYFile == INVALID_HANDLE_VALUE) goto closeAndExit; BY_HANDLE_FILE_INFORMATION fileInfoX, fileInfoY; if (! GetFileInformationByHandle(hXFile, &fileInfoX)) goto closeAndExit; if (! GetFileInformationByHandle(hYFile, &fileInfoY)) goto closeAndExit; result = fileInfoX.dwVolumeSerialNumber == fileInfoY.dwVolumeSerialNumber && fileInfoX.nFileIndexLow == fileInfoY.nFileIndexLow && fileInfoX.nFileIndexHigh == fileInfoY.nFileIndexHigh; closeAndExit: if (hXFile != INVALID_HANDLE_VALUE) CloseHandle(hXFile); if (hYFile != INVALID_HANDLE_VALUE) CloseHandle(hYFile); return result; } #else static bool sameFile(const char *x, const char *y) { struct stat xStat, yStat; // If either file does not exist that's fine. if (stat(x, &xStat) != 0 || stat(y, &yStat) != 0) return false; return (xStat.st_dev == yStat.st_dev && xStat.st_ino == yStat.st_ino); } #endif /* * Saving state. */ // This class is used to create the relocations. It uses Exporter // for this but this may perhaps be too heavyweight. class SaveStateExport: public Exporter, public ScanAddress { public: SaveStateExport(unsigned int h=0): Exporter(h), relocationCount(0) {} public: virtual void exportStore(void) {} // Not used. private: // ScanAddress overrides virtual void ScanConstant(PolyObject *base, byte *addrOfConst, ScanRelocationKind code); // At the moment we should only get calls to ScanConstant. virtual PolyObject *ScanObjectAddress(PolyObject *base) { return base; } protected: void setRelocationAddress(void *p, POLYUNSIGNED *reloc); PolyWord createRelocation(PolyWord p, void *relocAddr); unsigned relocationCount; friend class SaveRequest; }; // Generate the address relative to the start of the segment. void SaveStateExport::setRelocationAddress(void *p, POLYUNSIGNED *reloc) { unsigned area = findArea(p); POLYUNSIGNED offset = (POLYUNSIGNED)((char*)p - (char*)memTable[area].mtOriginalAddr); *reloc = offset; } // Create a relocation entry for an address at a given location. PolyWord SaveStateExport::createRelocation(PolyWord p, void *relocAddr) { RelocationEntry reloc; // Set the offset within the section we're scanning. setRelocationAddress(relocAddr, &reloc.relocAddress); void *addr = p.AsAddress(); unsigned addrArea = findArea(addr); reloc.targetAddress = (POLYUNSIGNED)((char*)addr - (char*)memTable[addrArea].mtOriginalAddr); reloc.targetSegment = (unsigned)memTable[addrArea].mtIndex; reloc.relKind = PROCESS_RELOC_DIRECT; fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; return p; // Don't change the contents } /* This is called for each constant within the code. Print a relocation entry for the word and return a value that means that the offset is saved in original word. */ void SaveStateExport::ScanConstant(PolyObject *base, byte *addr, ScanRelocationKind code) { PolyObject *p = GetConstantValue(addr, code); if (p == 0) return; void *a = p; unsigned aArea = findArea(a); // We don't need a relocation if this is relative to the current segment // since the relative address will already be right. if (code == PROCESS_RELOC_I386RELATIVE && aArea == findArea(addr)) return; // Set the value at the address to the offset relative to the symbol. RelocationEntry reloc; setRelocationAddress(addr, &reloc.relocAddress); reloc.targetAddress = (POLYUNSIGNED)((char*)a - (char*)memTable[aArea].mtOriginalAddr); reloc.targetSegment = (unsigned)memTable[aArea].mtIndex; reloc.relKind = code; fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; } // Request to the main thread to save data. class SaveRequest: public MainThreadRequest { public: SaveRequest(const TCHAR *name, unsigned h): MainThreadRequest(MTP_SAVESTATE), fileName(name), newHierarchy(h), errorMessage(0), errCode(0) {} virtual void Perform(); const TCHAR *fileName; unsigned newHierarchy; const char *errorMessage; int errCode; }; // This class is used to update references to objects that have moved. If // we have copied an object into the area to be exported we may still have references // to it from the stack or from RTS data structures. We have to ensure that these // are updated. // This is very similar to ProcessFixupAddress in sharedata.cpp class SaveFixupAddress: public ScanAddress { protected: virtual POLYUNSIGNED ScanAddressAt(PolyWord *pt); virtual POLYUNSIGNED ScanCodeAddressAt(PolyObject **pt) { *pt = ScanObjectAddress(*pt); return 0; } virtual PolyObject *ScanObjectAddress(PolyObject *base); public: void ScanCodeSpace(CodeSpace *space); }; POLYUNSIGNED SaveFixupAddress::ScanAddressAt(PolyWord *pt) { PolyWord val = *pt; if (val.IsDataPtr() && val != PolyWord::FromUnsigned(0)) *pt = ScanObjectAddress(val.AsObjPtr()); return 0; } // Returns the new address if the argument is the address of an object that // has moved, otherwise returns the original. PolyObject *SaveFixupAddress::ScanObjectAddress(PolyObject *obj) { if (obj->ContainsForwardingPtr()) // tombstone is a pointer to a moved object { #ifdef POLYML32IN64 MemSpace *space = gMem.SpaceForAddress((PolyWord*)obj - 1); PolyObject *newp; if (space->isCode) newp = (PolyObject*)(globalCodeBase + ((obj->LengthWord() & ~_OBJ_TOMBSTONE_BIT) << 1)); else newp = obj->GetForwardingPtr(); #else PolyObject *newp = obj->GetForwardingPtr(); #endif ASSERT (newp->ContainsNormalLengthWord()); return newp; } ASSERT (obj->ContainsNormalLengthWord()); // object is not moved return obj; } // Fix up addresses in the code area. Unlike ScanAddressesInRegion this updates // cells that have been moved. We need to do that because we may still have // return addresses into those cells and we don't move return addresses. We // do want the code to see updated constant addresses. void SaveFixupAddress::ScanCodeSpace(CodeSpace *space) { for (PolyWord *pt = space->bottom; pt < space->top; ) { pt++; PolyObject *obj = (PolyObject*)pt; #ifdef POLYML32IN64 PolyObject *dest = obj; while (dest->ContainsForwardingPtr()) { MemSpace *space = gMem.SpaceForAddress((PolyWord*)dest - 1); if (space->isCode) dest = (PolyObject*)(globalCodeBase + ((dest->LengthWord() & ~_OBJ_TOMBSTONE_BIT) << 1)); else dest = dest->GetForwardingPtr(); } #else PolyObject *dest = obj->FollowForwardingChain(); #endif POLYUNSIGNED length = dest->Length(); if (length != 0) ScanAddressesInObject(obj, dest->LengthWord()); pt += length; } } // Called by the root thread to actually save the state and write the file. void SaveRequest::Perform() { if (debugOptions & DEBUG_SAVING) Log("SAVE: Beginning saving state.\n"); // Check that we aren't overwriting our own parent. for (unsigned q = 0; q < newHierarchy-1; q++) { if (sameFile(hierarchyTable[q]->fileName, fileName)) { errorMessage = "File being saved is used as a parent of this file"; errCode = 0; if (debugOptions & DEBUG_SAVING) Log("SAVE: File being saved is used as a parent of this file.\n"); return; } } SaveStateExport exports; // Open the file. This could quite reasonably fail if the path is wrong. exports.exportFile = _tfopen(fileName, _T("wb")); if (exports.exportFile == NULL) { errorMessage = "Cannot open save file"; errCode = ERRORNUMBER; if (debugOptions & DEBUG_SAVING) Log("SAVE: Cannot open save file.\n"); return; } // Scan over the permanent mutable area copying all reachable data that is // not in a lower hierarchy into new permanent segments. CopyScan copyScan(newHierarchy); copyScan.initialise(false); bool success = true; try { for (std::vector::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) { PermanentMemSpace *space = *i; if (space->isMutable && !space->noOverwrite && !space->byteOnly) { if (debugOptions & DEBUG_SAVING) Log("SAVE: Scanning permanent mutable area %p allocated at %p size %lu\n", space, space->bottom, space->spaceSize()); copyScan.ScanAddressesInRegion(space->bottom, space->top); } } } catch (MemoryException &) { success = false; if (debugOptions & DEBUG_SAVING) Log("SAVE: Scan of permanent mutable area raised memory exception.\n"); } // Copy the areas into the export object. Make sufficient space for // the largest possible number of entries. exports.memTable = new memoryTableEntry[gMem.eSpaces.size()+gMem.pSpaces.size()+1]; unsigned memTableCount = 0; // Permanent spaces at higher level. These have to have entries although // only the mutable entries will be written. for (std::vector::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) { PermanentMemSpace *space = *i; if (space->hierarchy < newHierarchy) { memoryTableEntry *entry = &exports.memTable[memTableCount++]; entry->mtOriginalAddr = entry->mtCurrentAddr = space->bottom; entry->mtLength = (space->topPointer-space->bottom)*sizeof(PolyWord); entry->mtIndex = space->index; entry->mtFlags = 0; if (space->isMutable) { entry->mtFlags |= MTF_WRITEABLE; if (space->noOverwrite) entry->mtFlags |= MTF_NO_OVERWRITE; if (space->byteOnly) entry->mtFlags |= MTF_BYTES; } if (space->isCode) entry->mtFlags |= MTF_EXECUTABLE; } } unsigned permanentEntries = memTableCount; // Remember where new entries start. // Newly created spaces. for (std::vector::iterator i = gMem.eSpaces.begin(); i < gMem.eSpaces.end(); i++) { memoryTableEntry *entry = &exports.memTable[memTableCount++]; PermanentMemSpace *space = *i; entry->mtOriginalAddr = entry->mtCurrentAddr = space->bottom; entry->mtLength = (space->topPointer-space->bottom)*sizeof(PolyWord); entry->mtIndex = space->index; entry->mtFlags = 0; if (space->isMutable) { entry->mtFlags |= MTF_WRITEABLE; if (space->noOverwrite) entry->mtFlags |= MTF_NO_OVERWRITE; if (space->byteOnly) entry->mtFlags |= MTF_BYTES; } if (space->isCode) entry->mtFlags |= MTF_EXECUTABLE; } exports.memTableEntries = memTableCount; if (debugOptions & DEBUG_SAVING) Log("SAVE: Updating references to moved objects.\n"); // Update references to moved objects. SaveFixupAddress fixup; for (std::vector::iterator i = gMem.lSpaces.begin(); i < gMem.lSpaces.end(); i++) { LocalMemSpace *space = *i; fixup.ScanAddressesInRegion(space->bottom, space->lowerAllocPtr); fixup.ScanAddressesInRegion(space->upperAllocPtr, space->top); } for (std::vector::iterator i = gMem.cSpaces.begin(); i < gMem.cSpaces.end(); i++) fixup.ScanCodeSpace(*i); GCModules(&fixup); // Restore the length words in the code areas. // Although we've updated any pointers to the start of the code we could have return addresses // pointing to the original code. GCModules updates the stack but doesn't update return addresses. for (std::vector::iterator i = gMem.cSpaces.begin(); i < gMem.cSpaces.end(); i++) { CodeSpace *space = *i; for (PolyWord *pt = space->bottom; pt < space->top; ) { pt++; PolyObject *obj = (PolyObject*)pt; if (obj->ContainsForwardingPtr()) { #ifdef POLYML32IN64 PolyObject *forwardedTo = obj; while (forwardedTo->ContainsForwardingPtr()) forwardedTo = (PolyObject*)(globalCodeBase + ((forwardedTo->LengthWord() & ~_OBJ_TOMBSTONE_BIT) << 1)); #else PolyObject *forwardedTo = obj->FollowForwardingChain(); #endif POLYUNSIGNED lengthWord = forwardedTo->LengthWord(); obj->SetLengthWord(lengthWord); } pt += obj->Length(); } } // Update the global memory space table. Old segments at the same level // or lower are removed. The new segments become permanent. // Try to promote the spaces even if we've had a failure because export // spaces are deleted in ~CopyScan and we may have already copied // some objects there. if (debugOptions & DEBUG_SAVING) Log("SAVE: Promoting export spaces to permanent spaces.\n"); if (! gMem.PromoteExportSpaces(newHierarchy) || ! success) { errorMessage = "Out of Memory"; errCode = NOMEMORY; if (debugOptions & DEBUG_SAVING) Log("SAVE: Unable to promote export spaces.\n"); return; } // Remove any deeper entries from the hierarchy table. while (hierarchyDepth > newHierarchy-1) { hierarchyDepth--; delete(hierarchyTable[hierarchyDepth]); hierarchyTable[hierarchyDepth] = 0; } if (debugOptions & DEBUG_SAVING) Log("SAVE: Writing out data.\n"); // Write out the file header. SavedStateHeader saveHeader; memset(&saveHeader, 0, sizeof(saveHeader)); saveHeader.headerLength = sizeof(saveHeader); strncpy(saveHeader.headerSignature, SAVEDSTATESIGNATURE, sizeof(saveHeader.headerSignature)); saveHeader.headerVersion = SAVEDSTATEVERSION; saveHeader.segmentDescrLength = sizeof(SavedStateSegmentDescr); if (newHierarchy == 1) saveHeader.parentTimeStamp = exportTimeStamp; else { saveHeader.parentTimeStamp = hierarchyTable[newHierarchy-2]->timeStamp; saveHeader.parentNameEntry = sizeof(TCHAR); // Always the first entry. } saveHeader.timeStamp = getBuildTime(); saveHeader.segmentDescrCount = exports.memTableEntries; // One segment for each space. #ifdef POLYML32IN64 saveHeader.originalBaseAddr = globalHeapBase; #endif // Write out the header. fwrite(&saveHeader, sizeof(saveHeader), 1, exports.exportFile); // We need a segment header for each permanent area whether it is // actually in this file or not. SavedStateSegmentDescr *descrs = new SavedStateSegmentDescr [exports.memTableEntries]; for (unsigned j = 0; j < exports.memTableEntries; j++) { memoryTableEntry *entry = &exports.memTable[j]; memset(&descrs[j], 0, sizeof(SavedStateSegmentDescr)); descrs[j].relocationSize = sizeof(RelocationEntry); descrs[j].segmentIndex = (unsigned)entry->mtIndex; descrs[j].segmentSize = entry->mtLength; // Set this even if we don't write it. descrs[j].originalAddress = entry->mtOriginalAddr; if (entry->mtFlags & MTF_WRITEABLE) { descrs[j].segmentFlags |= SSF_WRITABLE; if (entry->mtFlags & MTF_NO_OVERWRITE) descrs[j].segmentFlags |= SSF_NOOVERWRITE; if (j < permanentEntries && (entry->mtFlags & MTF_NO_OVERWRITE) == 0) descrs[j].segmentFlags |= SSF_OVERWRITE; if (entry->mtFlags & MTF_BYTES) descrs[j].segmentFlags |= SSF_BYTES; } if (entry->mtFlags & MTF_EXECUTABLE) descrs[j].segmentFlags |= SSF_CODE; } // Write out temporarily. Will be overwritten at the end. saveHeader.segmentDescr = ftell(exports.exportFile); fwrite(descrs, sizeof(SavedStateSegmentDescr), exports.memTableEntries, exports.exportFile); // Write out the relocations and the data. for (unsigned k = 1 /* Not IO area */; k < exports.memTableEntries; k++) { memoryTableEntry *entry = &exports.memTable[k]; // Write out the contents if this is new or if it is a normal, overwritable // mutable area. if (k >= permanentEntries || (entry->mtFlags & (MTF_WRITEABLE|MTF_NO_OVERWRITE)) == MTF_WRITEABLE) { descrs[k].relocations = ftell(exports.exportFile); // Have to write this out. exports.relocationCount = 0; // Create the relocation table. char *start = (char*)entry->mtOriginalAddr; char *end = start + entry->mtLength; for (PolyWord *p = (PolyWord*)start; p < (PolyWord*)end; ) { p++; PolyObject *obj = (PolyObject*)p; POLYUNSIGNED length = obj->Length(); // Most relocations can be computed when the saved state is // loaded so we only write out the difficult ones: those that // occur within compiled code. // exports.relocateObject(obj); if (length != 0 && obj->IsCodeObject()) machineDependent->ScanConstantsWithinCode(obj, &exports); p += length; } descrs[k].relocationCount = exports.relocationCount; // Write out the data. descrs[k].segmentData = ftell(exports.exportFile); fwrite(entry->mtOriginalAddr, entry->mtLength, 1, exports.exportFile); } } // If this is a child we need to write a string table containing the parent name. if (newHierarchy > 1) { saveHeader.stringTable = ftell(exports.exportFile); _fputtc(0, exports.exportFile); // First byte of string table is zero _fputts(hierarchyTable[newHierarchy-2]->fileName, exports.exportFile); _fputtc(0, exports.exportFile); // A terminating null. saveHeader.stringTableSize = (_tcslen(hierarchyTable[newHierarchy-2]->fileName) + 2)*sizeof(TCHAR); } // Rewrite the header and the segment tables now they're complete. fseek(exports.exportFile, 0, SEEK_SET); fwrite(&saveHeader, sizeof(saveHeader), 1, exports.exportFile); fwrite(descrs, sizeof(SavedStateSegmentDescr), exports.memTableEntries, exports.exportFile); if (debugOptions & DEBUG_SAVING) Log("SAVE: Writing complete.\n"); // Add an entry to the hierarchy table for this file. (void)AddHierarchyEntry(fileName, saveHeader.timeStamp); delete[](descrs); CheckMemory(); } // Write a saved state file. POLYUNSIGNED PolySaveState(PolyObject *threadId, PolyWord fileName, PolyWord depth) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); try { TempString fileNameBuff(Poly_string_to_T_alloc(fileName)); // The value of depth is zero for top-level save so we need to add one for hierarchy. unsigned newHierarchy = get_C_unsigned(taskData, depth) + 1; if (newHierarchy > hierarchyDepth + 1) raise_fail(taskData, "Depth must be no more than the current hierarchy plus one"); // Request a full GC first. The main reason is to avoid running out of memory as a // result of repeated saves. Old export spaces are turned into local spaces and // the GC will delete them if they are completely empty FullGC(taskData); SaveRequest request(fileNameBuff, newHierarchy); processes->MakeRootRequest(taskData, &request); if (request.errorMessage) raise_syscall(taskData, request.errorMessage, request.errCode); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } /* * Loading saved state files. */ class StateLoader: public MainThreadRequest { public: StateLoader(bool isH, Handle files): MainThreadRequest(MTP_LOADSTATE), isHierarchy(isH), fileNameList(files), errorResult(0), errNumber(0) { } virtual void Perform(void); bool LoadFile(bool isInitial, time_t requiredStamp, PolyWord tail); bool isHierarchy; Handle fileNameList; const char *errorResult; // The fileName here is the last file loaded. As well as using it // to load the name can also be printed out at the end to identify the // particular file in the hierarchy that failed. AutoFree fileName; int errNumber; }; // Called by the main thread once all the ML threads have stopped. void StateLoader::Perform(void) { // Copy the first file name into the buffer. if (isHierarchy) { if (ML_Cons_Cell::IsNull(fileNameList->Word())) { errorResult = "Hierarchy list is empty"; return; } ML_Cons_Cell *p = DEREFLISTHANDLE(fileNameList); fileName = Poly_string_to_T_alloc(p->h); if (fileName == NULL) { errorResult = "Insufficient memory"; errNumber = NOMEMORY; return; } (void)LoadFile(true, 0, p->t); } else { fileName = Poly_string_to_T_alloc(fileNameList->Word()); if (fileName == NULL) { errorResult = "Insufficient memory"; errNumber = NOMEMORY; return; } (void)LoadFile(true, 0, TAGGED(0)); } } class ClearWeakByteRef: public ScanAddress { public: ClearWeakByteRef() {} virtual PolyObject *ScanObjectAddress(PolyObject *base) { return base; } virtual void ScanAddressesInObject(PolyObject *base, POLYUNSIGNED lengthWord); }; // Set the values of external references and clear the values of other weak byte refs. void ClearWeakByteRef::ScanAddressesInObject(PolyObject *base, POLYUNSIGNED lengthWord) { if (OBJ_IS_MUTABLE_OBJECT(lengthWord) && OBJ_IS_BYTE_OBJECT(lengthWord) && OBJ_IS_WEAKREF_OBJECT(lengthWord)) { POLYUNSIGNED len = OBJ_OBJECT_LENGTH(lengthWord); if (len > 0) base->Set(0, PolyWord::FromSigned(0)); setEntryPoint(base); } } // This is copied from the B-tree in MemMgr. It probably should be // merged but will do for the moment. It's intended to reduce the // cost of finding the segment for relocation. class SpaceBTree { public: SpaceBTree(bool is, unsigned i = 0) : isLeaf(is), index(i) { } virtual ~SpaceBTree() {} bool isLeaf; unsigned index; // The index if this is a leaf }; // A non-leaf node in the B-tree class SpaceBTreeTree : public SpaceBTree { public: SpaceBTreeTree(); virtual ~SpaceBTreeTree(); SpaceBTree *tree[256]; }; SpaceBTreeTree::SpaceBTreeTree() : SpaceBTree(false) { for (unsigned i = 0; i < 256; i++) tree[i] = 0; } SpaceBTreeTree::~SpaceBTreeTree() { for (unsigned i = 0; i < 256; i++) delete(tree[i]); } // This class is used to relocate addresses in areas that have been loaded. class LoadRelocate: public ScanAddress { public: LoadRelocate(bool pcc = false): processCodeConstants(pcc), originalBaseAddr(0), descrs(0), targetAddresses(0), nDescrs(0), spaceTree(0) {} ~LoadRelocate(); void RelocateObject(PolyObject *p); virtual PolyObject *ScanObjectAddress(PolyObject *base) { ASSERT(0); return base; } // Not used virtual void ScanConstant(PolyObject *base, byte *addressOfConstant, ScanRelocationKind code); void RelocateAddressAt(PolyWord *pt); PolyObject *RelocateAddress(PolyObject *obj); void AddTreeRange(SpaceBTree **t, unsigned index, uintptr_t startS, uintptr_t endS); bool processCodeConstants; PolyWord *originalBaseAddr; SavedStateSegmentDescr *descrs; PolyWord **targetAddresses; unsigned nDescrs; SpaceBTree *spaceTree; intptr_t relativeOffset; }; LoadRelocate::~LoadRelocate() { if (descrs) delete[](descrs); if (targetAddresses) delete[](targetAddresses); delete(spaceTree); } // Add an entry to the space B-tree. void LoadRelocate::AddTreeRange(SpaceBTree **tt, unsigned index, uintptr_t startS, uintptr_t endS) { if (*tt == 0) *tt = new SpaceBTreeTree; ASSERT(!(*tt)->isLeaf); SpaceBTreeTree *t = (SpaceBTreeTree*)*tt; const unsigned shift = (sizeof(void*) - 1) * 8; // Takes the high-order byte uintptr_t r = startS >> shift; ASSERT(r < 256); const uintptr_t s = endS == 0 ? 256 : endS >> shift; ASSERT(s >= r && s <= 256); if (r == s) // Wholly within this entry AddTreeRange(&(t->tree[r]), index, startS << 8, endS << 8); else { // Deal with any remainder at the start. if ((r << shift) != startS) { AddTreeRange(&(t->tree[r]), index, startS << 8, 0 /*End of range*/); r++; } // Whole entries. while (r < s) { ASSERT(t->tree[r] == 0); t->tree[r] = new SpaceBTree(true, index); r++; } // Remainder at the end. if ((s << shift) != endS) AddTreeRange(&(t->tree[r]), index, 0, endS << 8); } } // Update the addresses in a group of words. void LoadRelocate::RelocateAddressAt(PolyWord *pt) { PolyWord val = *pt; if (! val.IsTagged()) *pt = RelocateAddress(val.AsObjPtr(originalBaseAddr)); } PolyObject *LoadRelocate::RelocateAddress(PolyObject *obj) { // Which segment is this address in? // N.B. As with SpaceForAddress we need to subtract 1 to point to the length word. uintptr_t t = (uintptr_t)((PolyWord*)obj - 1); SpaceBTree *tr = spaceTree; // Each level of the tree is either a leaf or a vector of trees. unsigned j = sizeof(void *) * 8; for (;;) { if (tr == 0) break; if (tr->isLeaf) { // It's in this segment: relocate it to the current position. unsigned i = tr->index; SavedStateSegmentDescr *descr = &descrs[i]; PolyWord *newAddress = targetAddresses[descr->segmentIndex]; ASSERT((char*)obj > descr->originalAddress && (char*)obj <= (char*)descr->originalAddress + descr->segmentSize); ASSERT(newAddress != 0); byte *setAddress = (byte*)newAddress + ((char*)obj - (char*)descr->originalAddress); return (PolyObject*)setAddress; } j -= 8; tr = ((SpaceBTreeTree*)tr)->tree[(t >> j) & 0xff]; } // This should never happen. ASSERT(0); return 0; } // This is based on Exporter::relocateObject but does the reverse. // It attempts to adjust all the addresses in the object when it has // been read in. void LoadRelocate::RelocateObject(PolyObject *p) { if (p->IsByteObject()) { } else if (p->IsCodeObject()) { POLYUNSIGNED constCount; PolyWord *cp; ASSERT(! p->IsMutable() ); p->GetConstSegmentForCode(cp, constCount); /* Now the constant area. */ for (POLYUNSIGNED i = 0; i < constCount; i++) RelocateAddressAt(&(cp[i])); // Saved states and modules have relocation entries for constants in the code. // We can't use them when loading object files in 32-in-64 so have to process the // constants here. if (processCodeConstants) { POLYUNSIGNED length = p->Length(); machineDependent->ScanConstantsWithinCode(p, p, length, this); } } else if (p->IsClosureObject()) { // The first word is the address of the code. POLYUNSIGNED length = p->Length(); *(PolyObject**)p = RelocateAddress(*(PolyObject**)p); for (POLYUNSIGNED i = sizeof(PolyObject*)/sizeof(PolyWord); i < length; i++) RelocateAddressAt(p->Offset(i)); } else /* Ordinary objects, essentially tuples. */ { POLYUNSIGNED length = p->Length(); for (POLYUNSIGNED i = 0; i < length; i++) RelocateAddressAt(p->Offset(i)); } } // Update addresses as constants within the code. void LoadRelocate::ScanConstant(PolyObject *base, byte *addressOfConstant, ScanRelocationKind code) { PolyObject *p = GetConstantValue(addressOfConstant, code, originalBaseAddr); if (p != 0) { // Relative addresses are computed by adding the CURRENT address. // We have to convert them into addresses in original space before we // can relocate them. if (code == PROCESS_RELOC_I386RELATIVE) p = (PolyObject*)((PolyWord*)p + relativeOffset); PolyObject *newValue = RelocateAddress(p); SetConstantValue(addressOfConstant, newValue, code); } } // Load a saved state file. Calls itself to handle parent files. bool StateLoader::LoadFile(bool isInitial, time_t requiredStamp, PolyWord tail) { LoadRelocate relocate; AutoFree thisFile(_tcsdup(fileName)); AutoClose loadFile(_tfopen(fileName, _T("rb"))); if ((FILE*)loadFile == NULL) { errorResult = "Cannot open load file"; errNumber = ERRORNUMBER; return false; } SavedStateHeader header; // Read the header and check the signature. if (fread(&header, sizeof(SavedStateHeader), 1, loadFile) != 1) { errorResult = "Unable to load header"; return false; } if (strncmp(header.headerSignature, SAVEDSTATESIGNATURE, sizeof(header.headerSignature)) != 0) { errorResult = "File is not a saved state"; return false; } if (header.headerVersion != SAVEDSTATEVERSION || header.headerLength != sizeof(SavedStateHeader) || header.segmentDescrLength != sizeof(SavedStateSegmentDescr)) { errorResult = "Unsupported version of saved state file"; return false; } // Check that we have the required stamp before loading any children. // If a parent has been overwritten we could get a loop. if (! isInitial && header.timeStamp != requiredStamp) { // Time-stamps don't match. errorResult = "The parent for this saved state does not match or has been changed"; return false; } // Have verified that this is a reasonable saved state file. If it isn't a // top-level file we have to load the parents first. if (header.parentNameEntry != 0) { if (isHierarchy) { // Take the file name from the list if (ML_Cons_Cell::IsNull(tail)) { errorResult = "Missing parent name in argument list"; return false; } ML_Cons_Cell *p = (ML_Cons_Cell *)tail.AsObjPtr(); fileName = Poly_string_to_T_alloc(p->h); if (fileName == NULL) { errorResult = "Insufficient memory"; errNumber = NOMEMORY; return false; } if (! LoadFile(false, header.parentTimeStamp, p->t)) return false; } else { size_t toRead = header.stringTableSize-header.parentNameEntry; size_t elems = ((toRead + sizeof(TCHAR) - 1) / sizeof(TCHAR)); // Always allow space for null terminator size_t roundedBytes = (elems + 1) * sizeof(TCHAR); TCHAR *newFileName = (TCHAR *)realloc(fileName, roundedBytes); if (newFileName == NULL) { errorResult = "Insufficient memory"; errNumber = NOMEMORY; return false; } fileName = newFileName; if (header.parentNameEntry >= header.stringTableSize /* Bad entry */ || fseek(loadFile, header.stringTable + header.parentNameEntry, SEEK_SET) != 0 || fread(fileName, 1, toRead, loadFile) != toRead) { errorResult = "Unable to read parent file name"; return false; } fileName[elems] = 0; // Should already be null-terminated, but just in case. if (! LoadFile(false, header.parentTimeStamp, TAGGED(0))) return false; } ASSERT(hierarchyDepth > 0 && hierarchyTable[hierarchyDepth-1] != 0); } else // Top-level file { if (isHierarchy && ! ML_Cons_Cell::IsNull(tail)) { // There should be no further file names if this is really the top. errorResult = "Too many file names in the list"; return false; } if (header.parentTimeStamp != exportTimeStamp) { // Time-stamp does not match executable. errorResult = "Saved state was exported from a different executable or the executable has changed"; return false; } // Any existing spaces at this level or greater must be turned // into local spaces. We may have references from the stack to objects that // have previously been imported but otherwise these spaces are no longer // needed. gMem.DemoteImportSpaces(); // Clean out the hierarchy table. for (unsigned h = 0; h < hierarchyDepth; h++) { delete(hierarchyTable[h]); hierarchyTable[h] = 0; } hierarchyDepth = 0; } // Now have a valid, matching saved state. // Load the segment descriptors. relocate.nDescrs = header.segmentDescrCount; relocate.descrs = new SavedStateSegmentDescr[relocate.nDescrs]; relocate.originalBaseAddr = (PolyWord*)header.originalBaseAddr; if (fseek(loadFile, header.segmentDescr, SEEK_SET) != 0 || fread(relocate.descrs, sizeof(SavedStateSegmentDescr), relocate.nDescrs, loadFile) != relocate.nDescrs) { errorResult = "Unable to read segment descriptors"; return false; } { unsigned maxIndex = 0; for (unsigned i = 0; i < relocate.nDescrs; i++) { if (relocate.descrs[i].segmentIndex > maxIndex) maxIndex = relocate.descrs[i].segmentIndex; relocate.AddTreeRange(&relocate.spaceTree, i, (uintptr_t)relocate.descrs[i].originalAddress, (uintptr_t)((char*)relocate.descrs[i].originalAddress + relocate.descrs[i].segmentSize-1)); } relocate.targetAddresses = new PolyWord*[maxIndex+1]; for (unsigned i = 0; i <= maxIndex; i++) relocate.targetAddresses[i] = 0; } // Read in and create the new segments first. If we have problems, // in particular if we have run out of memory, then it's easier to recover. for (unsigned i = 0; i < relocate.nDescrs; i++) { SavedStateSegmentDescr *descr = &relocate.descrs[i]; MemSpace *space = gMem.SpaceForIndex(descr->segmentIndex); if (space != NULL) relocate.targetAddresses[descr->segmentIndex] = space->bottom; if (descr->segmentData == 0) { // No data - just an entry in the index. if (space == NULL/* || descr->segmentSize != (size_t)((char*)space->top - (char*)space->bottom)*/) { errorResult = "Mismatch for existing memory space"; return false; } } else if ((descr->segmentFlags & SSF_OVERWRITE) == 0) { // New segment. if (space != NULL) { errorResult = "Segment already exists"; return false; } // Allocate memory for the new segment. unsigned mFlags = (descr->segmentFlags & SSF_WRITABLE ? MTF_WRITEABLE : 0) | (descr->segmentFlags & SSF_NOOVERWRITE ? MTF_NO_OVERWRITE : 0) | (descr->segmentFlags & SSF_BYTES ? MTF_BYTES : 0) | (descr->segmentFlags & SSF_CODE ? MTF_EXECUTABLE : 0); PermanentMemSpace *newSpace = gMem.AllocateNewPermanentSpace(descr->segmentSize, mFlags, descr->segmentIndex, hierarchyDepth + 1); if (newSpace == 0) { errorResult = "Unable to allocate memory"; return false; } PolyWord *mem = newSpace->bottom; if (fseek(loadFile, descr->segmentData, SEEK_SET) != 0 || fread(mem, descr->segmentSize, 1, loadFile) != 1) { errorResult = "Unable to read segment"; return false; } // Fill unused space to the top of the area. gMem.FillUnusedSpace(mem+descr->segmentSize/sizeof(PolyWord), newSpace->spaceSize() - descr->segmentSize/sizeof(PolyWord)); // Leave it writable until we've done the relocations. relocate.targetAddresses[descr->segmentIndex] = mem; if (newSpace->isMutable && newSpace->byteOnly) { ClearWeakByteRef cwbr; cwbr.ScanAddressesInRegion(newSpace->bottom, newSpace->topPointer); } } } // Now read in the mutable overwrites and relocate. for (unsigned j = 0; j < relocate.nDescrs; j++) { SavedStateSegmentDescr *descr = &relocate.descrs[j]; MemSpace *space = gMem.SpaceForIndex(descr->segmentIndex); ASSERT(space != NULL); // We should have created it. if (descr->segmentFlags & SSF_OVERWRITE) { if (fseek(loadFile, descr->segmentData, SEEK_SET) != 0 || fread(space->bottom, descr->segmentSize, 1, loadFile) != 1) { errorResult = "Unable to read segment"; return false; } } // Relocation. if (descr->segmentData != 0) { // Adjust the addresses in the loaded segment. for (PolyWord *p = space->bottom; p < space->top; ) { p++; PolyObject *obj = (PolyObject*)p; POLYUNSIGNED length = obj->Length(); relocate.RelocateObject(obj); p += length; } } // Process explicit relocations. // If we get errors just skip the error and continue rather than leave // everything in an unstable state. if (descr->relocations) { if (fseek(loadFile, descr->relocations, SEEK_SET) != 0) { errorResult = "Unable to read relocation segment"; return false; } for (unsigned k = 0; k < descr->relocationCount; k++) { RelocationEntry reloc; if (fread(&reloc, sizeof(reloc), 1, loadFile) != 1) { errorResult = "Unable to read relocation segment"; return false; } MemSpace *toSpace = gMem.SpaceForIndex(reloc.targetSegment); if (toSpace == NULL) { errorResult = "Unknown space reference in relocation"; continue; } byte *setAddress = (byte*)space->bottom + reloc.relocAddress; byte *targetAddress = (byte*)toSpace->bottom + reloc.targetAddress; if (setAddress >= (byte*)space->top || targetAddress >= (byte*)toSpace->top) { errorResult = "Bad relocation"; continue; } ScanAddress::SetConstantValue(setAddress, (PolyObject*)(targetAddress), reloc.relKind); } } } // Set the final permissions. for (unsigned j = 0; j < relocate.nDescrs; j++) { SavedStateSegmentDescr *descr = &relocate.descrs[j]; PermanentMemSpace *space = gMem.SpaceForIndex(descr->segmentIndex); gMem.CompletePermanentSpaceAllocation(space); } // Add an entry to the hierarchy table for this file. if (! AddHierarchyEntry(thisFile, header.timeStamp)) return false; return true; // Succeeded } static void LoadState(TaskData *taskData, bool isHierarchy, Handle hFileList) // Load a saved state or a hierarchy. // hFileList is a list if this is a hierarchy and a single name if it is not. { StateLoader loader(isHierarchy, hFileList); // Request the main thread to do the load. This may set the error string if it failed. processes->MakeRootRequest(taskData, &loader); if (loader.errorResult != 0) { if (loader.errNumber == 0) raise_fail(taskData, loader.errorResult); else { AutoFree buff((char *)malloc(strlen(loader.errorResult) + 2 + _tcslen(loader.fileName) * sizeof(TCHAR) + 1)); #if (defined(_WIN32) && defined(UNICODE)) sprintf(buff, "%s: %S", loader.errorResult, (TCHAR *)loader.fileName); #else sprintf(buff, "%s: %s", loader.errorResult, (TCHAR *)loader.fileName); #endif raise_syscall(taskData, buff, loader.errNumber); } } } // Load a saved state file and any ancestors. POLYUNSIGNED PolyLoadState(PolyObject *threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); try { LoadState(taskData, false, pushedArg); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } // Load hierarchy. This provides a complete list of children and parents. POLYUNSIGNED PolyLoadHierarchy(PolyObject *threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); try { LoadState(taskData, true, pushedArg); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } /* * Additional functions to provide information or change saved-state files. */ // These functions do not affect the global state so can be executed by // the ML threads directly. static Handle ShowHierarchy(TaskData *taskData) // Return the list of files in the hierarchy. { Handle saved = taskData->saveVec.mark(); Handle list = SAVE(ListNull); // Process this in reverse order. for (unsigned i = hierarchyDepth; i > 0; i--) { Handle value = SAVE(C_string_to_Poly(taskData, hierarchyTable[i-1]->fileName)); Handle next = alloc_and_save(taskData, sizeof(ML_Cons_Cell)/sizeof(PolyWord)); DEREFLISTHANDLE(next)->h = value->Word(); DEREFLISTHANDLE(next)->t = list->Word(); taskData->saveVec.reset(saved); list = SAVE(next->Word()); } return list; } // Show the hierarchy. POLYUNSIGNED PolyShowHierarchy(PolyObject *threadId) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = ShowHierarchy(taskData); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } static void RenameParent(TaskData *taskData, PolyWord childName, PolyWord parentName) // Change the name of the immediate parent stored in a child { // The name of the file to modify. AutoFree fileNameBuff(Poly_string_to_T_alloc(childName)); if (fileNameBuff == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); // The new parent name to insert. AutoFree parentNameBuff(Poly_string_to_T_alloc(parentName)); if (parentNameBuff == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); AutoClose loadFile(_tfopen(fileNameBuff, _T("r+b"))); // Open for reading and writing if ((FILE*)loadFile == NULL) { AutoFree buff((char *)malloc(23 + _tcslen(fileNameBuff) * sizeof(TCHAR) + 1)); #if (defined(_WIN32) && defined(UNICODE)) sprintf(buff, "Cannot open load file: %S", (TCHAR *)fileNameBuff); #else sprintf(buff, "Cannot open load file: %s", (TCHAR *)fileNameBuff); #endif raise_syscall(taskData, buff, ERRORNUMBER); } SavedStateHeader header; // Read the header and check the signature. if (fread(&header, sizeof(SavedStateHeader), 1, loadFile) != 1) raise_fail(taskData, "Unable to load header"); if (strncmp(header.headerSignature, SAVEDSTATESIGNATURE, sizeof(header.headerSignature)) != 0) raise_fail(taskData, "File is not a saved state"); if (header.headerVersion != SAVEDSTATEVERSION || header.headerLength != sizeof(SavedStateHeader) || header.segmentDescrLength != sizeof(SavedStateSegmentDescr)) { raise_fail(taskData, "Unsupported version of saved state file"); } // Does this actually have a parent? if (header.parentNameEntry == 0) raise_fail(taskData, "File does not have a parent"); // At the moment the only entry in the string table is the parent // name so we can simply write a new one on the end of the file. // This makes the file grow slightly each time but it shouldn't be // significant. fseek(loadFile, 0, SEEK_END); header.stringTable = ftell(loadFile); // Remember where this is _fputtc(0, loadFile); // First byte of string table is zero _fputts(parentNameBuff, loadFile); _fputtc(0, loadFile); // A terminating null. header.stringTableSize = (_tcslen(parentNameBuff) + 2)*sizeof(TCHAR); // Now rewind and write the header with the revised string table. fseek(loadFile, 0, SEEK_SET); fwrite(&header, sizeof(header), 1, loadFile); } POLYUNSIGNED PolyRenameParent(PolyObject *threadId, PolyWord childName, PolyWord parentName) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); try { RenameParent(taskData, childName, parentName); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } static Handle ShowParent(TaskData *taskData, Handle hFileName) // Return the name of the immediate parent stored in a child { AutoFree fileNameBuff(Poly_string_to_T_alloc(hFileName->Word())); if (fileNameBuff == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); AutoClose loadFile(_tfopen(fileNameBuff, _T("rb"))); if ((FILE*)loadFile == NULL) { AutoFree buff((char *)malloc(23 + _tcslen(fileNameBuff) * sizeof(TCHAR) + 1)); if (buff == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); #if (defined(_WIN32) && defined(UNICODE)) sprintf(buff, "Cannot open load file: %S", (TCHAR *)fileNameBuff); #else sprintf(buff, "Cannot open load file: %s", (TCHAR *)fileNameBuff); #endif raise_syscall(taskData, buff, ERRORNUMBER); } SavedStateHeader header; // Read the header and check the signature. if (fread(&header, sizeof(SavedStateHeader), 1, loadFile) != 1) raise_fail(taskData, "Unable to load header"); if (strncmp(header.headerSignature, SAVEDSTATESIGNATURE, sizeof(header.headerSignature)) != 0) raise_fail(taskData, "File is not a saved state"); if (header.headerVersion != SAVEDSTATEVERSION || header.headerLength != sizeof(SavedStateHeader) || header.segmentDescrLength != sizeof(SavedStateSegmentDescr)) { raise_fail(taskData, "Unsupported version of saved state file"); } // Does this have a parent? if (header.parentNameEntry != 0) { size_t toRead = header.stringTableSize-header.parentNameEntry; size_t elems = ((toRead + sizeof(TCHAR) - 1) / sizeof(TCHAR)); // Always allow space for null terminator size_t roundedBytes = (elems + 1) * sizeof(TCHAR); AutoFree parentFileName((TCHAR *)malloc(roundedBytes)); if (parentFileName == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); if (header.parentNameEntry >= header.stringTableSize /* Bad entry */ || fseek(loadFile, header.stringTable + header.parentNameEntry, SEEK_SET) != 0 || fread(parentFileName, 1, toRead, loadFile) != toRead) { raise_fail(taskData, "Unable to read parent file name"); } parentFileName[elems] = 0; // Should already be null-terminated, but just in case. // Convert the name into a Poly string and then build a "Some" value. // It's possible, although silly, to have the empty string as a parent name. Handle resVal = SAVE(C_string_to_Poly(taskData, parentFileName)); Handle result = alloc_and_save(taskData, 1); DEREFHANDLE(result)->Set(0, resVal->Word()); return result; } else return SAVE(NONE_VALUE); } // Return the name of the immediate parent stored in a child POLYUNSIGNED PolyShowParent(PolyObject *threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { result = ShowParent(taskData, pushedArg); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Module system #define MODULESIGNATURE "POLYMODU" #define MODULEVERSION 2 typedef struct _moduleHeader { // These entries are primarily to check that we have a valid // saved state file before we try to interpret anything else. char headerSignature[8]; // Should contain MODULESIGNATURE unsigned headerVersion; // Should contain MODULEVERSION unsigned headerLength; // Number of bytes in the header unsigned segmentDescrLength; // Number of bytes in a descriptor // These entries contain the real data. off_t segmentDescr; // Position of segment descriptor table unsigned segmentDescrCount; // Number of segment descriptors in the table time_t timeStamp; // The time stamp for this file. time_t executableTimeStamp; // The time stamp for the parent executable. // Root uintptr_t rootSegment; POLYUNSIGNED rootOffset; } ModuleHeader; // Store a module class ModuleStorer: public MainThreadRequest { public: ModuleStorer(const TCHAR *file, Handle r): MainThreadRequest(MTP_STOREMODULE), fileName(file), root(r), errorMessage(0), errCode(0) {} virtual void Perform(); const TCHAR *fileName; Handle root; const char *errorMessage; int errCode; }; class ModuleExport: public SaveStateExport { public: ModuleExport(): SaveStateExport(1/* Everything EXCEPT the executable. */) {} virtual void exportStore(void); // Write the data out. }; void ModuleStorer::Perform() { ModuleExport exporter; #if (defined(_WIN32) && defined(UNICODE)) exporter.exportFile = _wfopen(fileName, L"wb"); #else exporter.exportFile = fopen(fileName, "wb"); #endif if (exporter.exportFile == NULL) { errorMessage = "Cannot open export file"; errCode = ERRORNUMBER; return; } // RunExport copies everything reachable from the root, except data from // the executable because we've set the hierarchy to 1, using CopyScan. // It builds the tables in the export data structure then calls exportStore // to actually write the data. if (! root->Word().IsDataPtr()) { // If we have a completely empty module the list may be null. // This needs to be dealt with at a higher level. errorMessage = "Module root is not an address"; return; } exporter.RunExport(root->WordP()); errorMessage = exporter.errorMessage; // This will be null unless there's been an error. } void ModuleExport::exportStore(void) { // What we need to do here is implement the export in a similar way to e.g. PECOFFExport::exportStore // This is copied from SaveRequest::Perform and should be common code. ModuleHeader modHeader; memset(&modHeader, 0, sizeof(modHeader)); modHeader.headerLength = sizeof(modHeader); strncpy(modHeader.headerSignature, MODULESIGNATURE, sizeof(modHeader.headerSignature)); modHeader.headerVersion = MODULEVERSION; modHeader.segmentDescrLength = sizeof(SavedStateSegmentDescr); modHeader.executableTimeStamp = exportTimeStamp; { unsigned rootArea = findArea(this->rootFunction); struct _memTableEntry *mt = &memTable[rootArea]; modHeader.rootSegment = mt->mtIndex; modHeader.rootOffset = (POLYUNSIGNED)((char*)this->rootFunction - (char*)mt->mtOriginalAddr); } modHeader.timeStamp = getBuildTime(); modHeader.segmentDescrCount = this->memTableEntries; // One segment for each space. // Write out the header. fwrite(&modHeader, sizeof(modHeader), 1, this->exportFile); SavedStateSegmentDescr *descrs = new SavedStateSegmentDescr [this->memTableEntries]; // We need an entry in the descriptor tables for each segment in the executable because // we may have relocations that refer to addresses in it. for (unsigned j = 0; j < this->memTableEntries; j++) { SavedStateSegmentDescr *thisDescr = &descrs[j]; memoryTableEntry *entry = &this->memTable[j]; memset(thisDescr, 0, sizeof(SavedStateSegmentDescr)); thisDescr->relocationSize = sizeof(RelocationEntry); thisDescr->segmentIndex = (unsigned)entry->mtIndex; thisDescr->segmentSize = entry->mtLength; // Set this even if we don't write it. thisDescr->originalAddress = entry->mtOriginalAddr; if (entry->mtFlags & MTF_WRITEABLE) { thisDescr->segmentFlags |= SSF_WRITABLE; if (entry->mtFlags & MTF_NO_OVERWRITE) thisDescr->segmentFlags |= SSF_NOOVERWRITE; if ((entry->mtFlags & MTF_NO_OVERWRITE) == 0) thisDescr->segmentFlags |= SSF_OVERWRITE; if (entry->mtFlags & MTF_BYTES) thisDescr->segmentFlags |= SSF_BYTES; } if (entry->mtFlags & MTF_EXECUTABLE) thisDescr->segmentFlags |= SSF_CODE; } // Write out temporarily. Will be overwritten at the end. modHeader.segmentDescr = ftell(this->exportFile); fwrite(descrs, sizeof(SavedStateSegmentDescr), this->memTableEntries, this->exportFile); // Write out the relocations and the data. for (unsigned k = 0; k < this->memTableEntries; k++) { SavedStateSegmentDescr *thisDescr = &descrs[k]; memoryTableEntry *entry = &this->memTable[k]; if (k >= newAreas) // Not permanent areas { thisDescr->relocations = ftell(this->exportFile); // Have to write this out. this->relocationCount = 0; // Create the relocation table. char *start = (char*)entry->mtOriginalAddr; char *end = start + entry->mtLength; for (PolyWord *p = (PolyWord*)start; p < (PolyWord*)end; ) { p++; PolyObject *obj = (PolyObject*)p; POLYUNSIGNED length = obj->Length(); // For saved states we don't include explicit relocations except // in code but it's easier if we do for modules. if (length != 0 && obj->IsCodeObject()) machineDependent->ScanConstantsWithinCode(obj, this); relocateObject(obj); p += length; } thisDescr->relocationCount = this->relocationCount; // Write out the data. thisDescr->segmentData = ftell(exportFile); fwrite(entry->mtOriginalAddr, entry->mtLength, 1, exportFile); } } // Rewrite the header and the segment tables now they're complete. fseek(exportFile, 0, SEEK_SET); fwrite(&modHeader, sizeof(modHeader), 1, exportFile); fwrite(descrs, sizeof(SavedStateSegmentDescr), this->memTableEntries, exportFile); delete[](descrs); fclose(exportFile); exportFile = NULL; } // Store a module POLYUNSIGNED PolyStoreModule(PolyObject *threadId, PolyWord name, PolyWord contents) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedContents = taskData->saveVec.push(contents); try { TempString fileName(name); ModuleStorer storer(fileName, pushedContents); processes->MakeRootRequest(taskData, &storer); if (storer.errorMessage) raise_syscall(taskData, storer.errorMessage, storer.errCode); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } // Load a module. class ModuleLoader: public MainThreadRequest { public: ModuleLoader(TaskData *taskData, const TCHAR *file): MainThreadRequest(MTP_LOADMODULE), callerTaskData(taskData), fileName(file), errorResult(NULL), errNumber(0), rootHandle(0) {} virtual void Perform(); TaskData *callerTaskData; const TCHAR *fileName; const char *errorResult; int errNumber; Handle rootHandle; }; void ModuleLoader::Perform() { AutoClose loadFile(_tfopen(fileName, _T("rb"))); if ((FILE*)loadFile == NULL) { errorResult = "Cannot open load file"; errNumber = ERRORNUMBER; return; } ModuleHeader header; // Read the header and check the signature. if (fread(&header, sizeof(ModuleHeader), 1, loadFile) != 1) { errorResult = "Unable to load header"; return; } if (strncmp(header.headerSignature, MODULESIGNATURE, sizeof(header.headerSignature)) != 0) { errorResult = "File is not a Poly/ML module"; return; } if (header.headerVersion != MODULEVERSION || header.headerLength != sizeof(ModuleHeader) || header.segmentDescrLength != sizeof(SavedStateSegmentDescr)) { errorResult = "Unsupported version of module file"; return; } if (header.executableTimeStamp != exportTimeStamp) { // Time-stamp does not match executable. errorResult = "Module was exported from a different executable or the executable has changed"; return; } LoadRelocate relocate; relocate.nDescrs = header.segmentDescrCount; relocate.descrs = new SavedStateSegmentDescr[relocate.nDescrs]; if (fseek(loadFile, header.segmentDescr, SEEK_SET) != 0 || fread(relocate.descrs, sizeof(SavedStateSegmentDescr), relocate.nDescrs, loadFile) != relocate.nDescrs) { errorResult = "Unable to read segment descriptors"; return; } { unsigned maxIndex = 0; for (unsigned i = 0; i < relocate.nDescrs; i++) if (relocate.descrs[i].segmentIndex > maxIndex) maxIndex = relocate.descrs[i].segmentIndex; relocate.targetAddresses = new PolyWord*[maxIndex+1]; for (unsigned i = 0; i <= maxIndex; i++) relocate.targetAddresses[i] = 0; } // Read in and create the new segments first. If we have problems, // in particular if we have run out of memory, then it's easier to recover. for (unsigned i = 0; i < relocate.nDescrs; i++) { SavedStateSegmentDescr *descr = &relocate.descrs[i]; MemSpace *space = gMem.SpaceForIndex(descr->segmentIndex); if (descr->segmentData == 0) { // No data - just an entry in the index. if (space == NULL/* || descr->segmentSize != (size_t)((char*)space->top - (char*)space->bottom)*/) { errorResult = "Mismatch for existing memory space"; return; } else relocate.targetAddresses[descr->segmentIndex] = space->bottom; } else { // New segment. if (space != NULL) { errorResult = "Segment already exists"; return; } // Allocate memory for the new segment. size_t actualSize = descr->segmentSize; MemSpace *space; if (descr->segmentFlags & SSF_CODE) { CodeSpace *cSpace = gMem.NewCodeSpace(actualSize); if (cSpace == 0) { errorResult = "Unable to allocate memory"; return; } space = cSpace; cSpace->firstFree = (PolyWord*)((byte*)space->bottom + descr->segmentSize); if (cSpace->firstFree != cSpace->top) gMem.FillUnusedSpace(cSpace->firstFree, cSpace->top - cSpace->firstFree); } else { LocalMemSpace *lSpace = gMem.NewLocalSpace(actualSize, descr->segmentFlags & SSF_WRITABLE); if (lSpace == 0) { errorResult = "Unable to allocate memory"; return; } space = lSpace; lSpace->lowerAllocPtr = (PolyWord*)((byte*)lSpace->bottom + descr->segmentSize); } if (fseek(loadFile, descr->segmentData, SEEK_SET) != 0 || fread(space->bottom, descr->segmentSize, 1, loadFile) != 1) { errorResult = "Unable to read segment"; return; } relocate.targetAddresses[descr->segmentIndex] = space->bottom; if (space->isMutable && (descr->segmentFlags & SSF_BYTES) != 0) { ClearWeakByteRef cwbr; cwbr.ScanAddressesInRegion(space->bottom, (PolyWord*)((byte*)space->bottom + descr->segmentSize)); } } } // Now deal with relocation. for (unsigned j = 0; j < relocate.nDescrs; j++) { SavedStateSegmentDescr *descr = &relocate.descrs[j]; PolyWord *baseAddr = relocate.targetAddresses[descr->segmentIndex]; ASSERT(baseAddr != NULL); // We should have created it. // Process explicit relocations. // If we get errors just skip the error and continue rather than leave // everything in an unstable state. if (descr->relocations) { if (fseek(loadFile, descr->relocations, SEEK_SET) != 0) errorResult = "Unable to read relocation segment"; for (unsigned k = 0; k < descr->relocationCount; k++) { RelocationEntry reloc; if (fread(&reloc, sizeof(reloc), 1, loadFile) != 1) errorResult = "Unable to read relocation segment"; byte *setAddress = (byte*)baseAddr + reloc.relocAddress; byte *targetAddress = (byte*)relocate.targetAddresses[reloc.targetSegment] + reloc.targetAddress; ScanAddress::SetConstantValue(setAddress, (PolyObject*)(targetAddress), reloc.relKind); } } } // Get the root address. Push this to the caller's save vec. If we put the // newly created areas into local memory we could get a GC as soon as we // complete this root request. { PolyWord *baseAddr = relocate.targetAddresses[header.rootSegment]; rootHandle = callerTaskData->saveVec.push((PolyObject*)((byte*)baseAddr + header.rootOffset)); } } static Handle LoadModule(TaskData *taskData, Handle args) { TempString fileName(args->Word()); ModuleLoader loader(taskData, fileName); processes->MakeRootRequest(taskData, &loader); if (loader.errorResult != 0) { if (loader.errNumber == 0) raise_fail(taskData, loader.errorResult); else { AutoFree buff((char *)malloc(strlen(loader.errorResult) + 2 + _tcslen(loader.fileName) * sizeof(TCHAR) + 1)); #if (defined(_WIN32) && defined(UNICODE)) sprintf(buff, "%s: %S", loader.errorResult, loader.fileName); #else sprintf(buff, "%s: %s", loader.errorResult, loader.fileName); #endif raise_syscall(taskData, buff, loader.errNumber); } } return loader.rootHandle; } // Load a module POLYUNSIGNED PolyLoadModule(PolyObject *threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { result = LoadModule(taskData, pushedArg); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } PolyObject *InitHeaderFromExport(struct _exportDescription *exports) { // Check the structure sizes stored in the export structure match the versions // used in this library. if (exports->structLength != sizeof(exportDescription) || exports->memTableSize != sizeof(memoryTableEntry) || exports->rtsVersion < FIRST_supported_version || exports->rtsVersion > LAST_supported_version) { #if (FIRST_supported_version == LAST_supported_version) Exit("The exported object file has version %0.2f but this library supports %0.2f", ((float)exports->rtsVersion) / 100.0, ((float)FIRST_supported_version) / 100.0); #else Exit("The exported object file has version %0.2f but this library supports %0.2f-%0.2f", ((float)exports->rtsVersion) / 100.0, ((float)FIRST_supported_version) / 100.0, ((float)LAST_supported_version) / 100.0); #endif } // We could also check the RTS version and the architecture. exportTimeStamp = exports->timeStamp; // Needed for load and save. memoryTableEntry *memTable = exports->memTable; #ifdef POLYML32IN64 // We need to copy this into the heap before beginning execution. // This is very like loading a saved state and the code should probably // be merged. LoadRelocate relocate(true); relocate.nDescrs = exports->memTableEntries; relocate.descrs = new SavedStateSegmentDescr[relocate.nDescrs]; relocate.targetAddresses = new PolyWord*[exports->memTableEntries]; relocate.originalBaseAddr = (PolyWord*)exports->originalBaseAddr; PolyObject *root = 0; for (unsigned i = 0; i < exports->memTableEntries; i++) { relocate.descrs[i].segmentIndex = memTable[i].mtIndex; relocate.descrs[i].originalAddress = memTable[i].mtOriginalAddr; relocate.descrs[i].segmentSize = memTable[i].mtLength; PermanentMemSpace *newSpace = gMem.AllocateNewPermanentSpace(memTable[i].mtLength, (unsigned)memTable[i].mtFlags, (unsigned)memTable[i].mtIndex); if (newSpace == 0) Exit("Unable to initialise a permanent memory space"); PolyWord *mem = newSpace->bottom; memcpy(mem, memTable[i].mtCurrentAddr, memTable[i].mtLength); gMem.FillUnusedSpace(mem + memTable[i].mtLength / sizeof(PolyWord), newSpace->spaceSize() - memTable[i].mtLength / sizeof(PolyWord)); if (newSpace == 0) Exit("Unable to initialise a permanent memory space"); relocate.targetAddresses[i] = mem; relocate.AddTreeRange(&relocate.spaceTree, i, (uintptr_t)relocate.descrs[i].originalAddress, (uintptr_t)((char*)relocate.descrs[i].originalAddress + relocate.descrs[i].segmentSize - 1)); // Relocate the root function. if (exports->rootFunction >= memTable[i].mtCurrentAddr && exports->rootFunction < (char*)memTable[i].mtCurrentAddr + memTable[i].mtLength) { root = (PolyObject*)((char*)mem + ((char*)exports->rootFunction - (char*)memTable[i].mtCurrentAddr)); } } // Now relocate the addresses for (unsigned j = 0; j < exports->memTableEntries; j++) { SavedStateSegmentDescr *descr = &relocate.descrs[j]; MemSpace *space = gMem.SpaceForIndex(descr->segmentIndex); // Any relative addresses have to be corrected by adding this. relocate.relativeOffset = (PolyWord*)descr->originalAddress - space->bottom; for (PolyWord *p = space->bottom; p < space->top; ) { #ifdef POLYML32IN64 if ((((uintptr_t)p) & 4) == 0) { // Skip any padding. The length word should be on an odd-word boundary. p++; continue; } #endif p++; PolyObject *obj = (PolyObject*)p; POLYUNSIGNED length = obj->Length(); relocate.RelocateObject(obj); p += length; } } // Set the final permissions. for (unsigned j = 0; j < exports->memTableEntries; j++) { PermanentMemSpace *space = gMem.SpaceForIndex(memTable[j].mtIndex); gMem.CompletePermanentSpaceAllocation(space); } return root; #else for (unsigned i = 0; i < exports->memTableEntries; i++) { // Construct a new space for each of the entries. if (gMem.NewPermanentSpace( (PolyWord*)memTable[i].mtCurrentAddr, memTable[i].mtLength / sizeof(PolyWord), (unsigned)memTable[i].mtFlags, (unsigned)memTable[i].mtIndex) == 0) Exit("Unable to initialise a permanent memory space"); } return (PolyObject *)exports->rootFunction; #endif } // Return the system directory for modules. This is configured differently // in Unix and in Windows. POLYUNSIGNED PolyGetModuleDirectory(PolyObject *threadId) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { #if (defined(MODULEDIR)) result = SAVE(C_string_to_Poly(taskData, MODULEDIR)); -#elif (defined(_WIN32) && ! defined(__CYGWIN__)) +#elif (defined(_WIN32)) { // This registry key is configured when Poly/ML is installed using the installer. // It gives the path to the Poly/ML installation directory. We return the // Modules subdirectory. HKEY hk; if (RegOpenKeyEx(HKEY_LOCAL_MACHINE, _T("SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\PolyML.exe"), 0, KEY_QUERY_VALUE, &hk) == ERROR_SUCCESS) { DWORD valSize; if (RegQueryValueEx(hk, _T("Path"), 0, NULL, NULL, &valSize) == ERROR_SUCCESS) { #define MODULEDIR _T("Modules") TempString buff((TCHAR*)malloc(valSize + (_tcslen(MODULEDIR) + 1) * sizeof(TCHAR))); DWORD dwType; if (RegQueryValueEx(hk, _T("Path"), 0, &dwType, (LPBYTE)(LPTSTR)buff, &valSize) == ERROR_SUCCESS) { // The registry entry should end with a backslash. _tcscat(buff, MODULEDIR); result = SAVE(C_string_to_Poly(taskData, buff)); } } RegCloseKey(hk); } result = SAVE(C_string_to_Poly(taskData, "")); } #else result = SAVE(C_string_to_Poly(taskData, "")); #endif } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } struct _entrypts savestateEPT[] = { { "PolySaveState", (polyRTSFunction)&PolySaveState }, { "PolyLoadState", (polyRTSFunction)&PolyLoadState }, { "PolyShowHierarchy", (polyRTSFunction)&PolyShowHierarchy }, { "PolyRenameParent", (polyRTSFunction)&PolyRenameParent }, { "PolyShowParent", (polyRTSFunction)&PolyShowParent }, { "PolyStoreModule", (polyRTSFunction)&PolyStoreModule }, { "PolyLoadModule", (polyRTSFunction)&PolyLoadModule }, { "PolyLoadHierarchy", (polyRTSFunction)&PolyLoadHierarchy }, { "PolyGetModuleDirectory", (polyRTSFunction)&PolyGetModuleDirectory }, { NULL, NULL } // End of list. }; diff --git a/libpolyml/sighandler.cpp b/libpolyml/sighandler.cpp index 6a535e18..bc2079a0 100644 --- a/libpolyml/sighandler.cpp +++ b/libpolyml/sighandler.cpp @@ -1,586 +1,579 @@ /* Title: Signal handling Author: David C.J. Matthews - Copyright (c) 2000-8, 2016 David C.J. Matthews + Copyright (c) 2000-8, 2016, 2019 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_SYS_TYPES_H #include #endif #ifdef HAVE_SIGNAL_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) 0 #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_IO_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_STDLIB_H #include // For malloc #endif -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_SEMAPHORE_H)) +#if (defined(HAVE_SEMAPHORE_H) && !defined(_WIN32)) // Don't include semaphore.h on Mingw. It's provided but doesn't compile. #include #endif -#if ((!defined(_WIN32) || defined(__CYGWIN__)) && defined(HAVE_LIBPTHREAD) && defined(HAVE_PTHREAD_H) && defined(HAVE_SEMAPHORE_H)) -// If we have the pthread library and header and we have semaphores we can use the pthread -// signalling mechanism. But if this is a native Windows build we don't use semaphores or -// pthread even if they're provided. -#define USE_PTHREAD_SIGNALS 1 -#endif - -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #define INVALIDSIGNAL ERROR_INVALID_PARAMETER #else #define INVALIDSIGNAL EINVAL #endif /* Signal handling is complicated in a multi-threaded environment. The pthread mutex and condition variables are not safe to use in a signal handler so we need to use POSIX semaphores since sem_post is safe. */ #if (defined(HAVE_STACK_T) && defined(HAVE_SIGALTSTACK)) extern "C" { // This is missing in older versions of Mac OS X int sigaltstack(const stack_t *, stack_t *); } #endif #include "globals.h" #include "arb.h" #include "run_time.h" #include "sighandler.h" #include "processes.h" #include "machine_dep.h" #include "sys.h" #include "save_vec.h" #include "rts_module.h" #include "gc.h" // For convertedWeak #include "scanaddrs.h" #include "locking.h" #include "rtsentry.h" extern "C" { POLYEXTERNALSYMBOL POLYUNSIGNED PolySetSignalHandler(PolyObject *threadId, PolyWord signalNo, PolyWord action); POLYEXTERNALSYMBOL POLYUNSIGNED PolyWaitForSignal(PolyObject *threadId); } #define SAVE(x) taskData->saveVec.push(x) #define SIZEOF(x) (sizeof(x)/sizeof(word)) #define DEFAULT_SIG 0 #define IGNORE_SIG 1 #define HANDLE_SIG 2 // This is only used in SignalRequest static struct _sigData { bool nonMaskable; // True if this sig is used within the RTS. Must not be ignored or replaced PolyWord handler; // User-installed handler, TAGGED(DEFAULT_SIG) or TAGGED(IGNORE_SIG) int signalCount; } sigData[NSIG]; unsigned receivedSignalCount = 0; // Incremented each time we get a signal // sigLock protects access to the signalCount values in sigData but // not the "handler" field. static PLock sigLock; -#ifdef USE_PTHREAD_SIGNALS +#if (!defined(_WIN32)) static PSemaphore *waitSema; static int lastSignals[NSIG]; static bool terminate = false; #endif // This must not be called from an asynchronous signal handler. static void signalArrived(int sig) { sigLock.Lock(); receivedSignalCount++; sigData[sig].signalCount++; sigLock.Unlock(); // To avoid deadlock we must release sigLock first. processes->SignalArrived(); } // Called whenever a signal handler is installed other than in this // module. Because modules are initialised in an unspecified order // we may have already masked off this signal. void markSignalInuse(int sig) { sigData[sig].nonMaskable = true; -#ifdef USE_PTHREAD_SIGNALS +#if (!defined(_WIN32)) // Enable this signal. sigset_t sigset; sigemptyset(&sigset); sigaddset(&sigset, sig); pthread_sigmask(SIG_UNBLOCK, &sigset, NULL); #endif } /* Find the existing handler for this signal. */ static PolyWord findHandler(int sig) { if ((unsigned)sig >= NSIG) // Check it's in range. return TAGGED(DEFAULT_SIG); /* Not there - default action. */ else return sigData[sig].handler; } #if (defined(_WIN32) && ! defined(__CYGWIN__)) // This is called to simulate a SIGINT in Windows. void RequestConsoleInterrupt(void) { // The default action for SIGINT is to exit. if (findHandler(SIGINT) == TAGGED(DEFAULT_SIG)) processes->RequestProcessExit(2); // Exit with the signal value. else signalArrived(SIGINT); } #endif -#ifdef USE_PTHREAD_SIGNALS +#if (!defined(_WIN32)) // Request the main thread to change the blocking state of a signal. class SignalRequest: public MainThreadRequest { public: SignalRequest(int s, int r): MainThreadRequest(MTP_SIGHANDLER), signl(s), state(r) {} virtual void Perform(); int signl, state; }; // Called whenever a signal is received. static void handle_signal(SIG_HANDLER_ARGS(s, c)) { if (waitSema != 0) { lastSignals[s]++; // Assume this is atomic with respect to reading. // Wake the signal detection thread. waitSema->Signal(); } } void SignalRequest::Perform() { struct sigaction action; memset(&action, 0, sizeof(action)); switch (state) { case DEFAULT_SIG: action.sa_handler = SIG_DFL; sigaction(signl, &action, 0); break; case IGNORE_SIG: action.sa_handler = SIG_IGN; sigaction(signl, &action, 0); break; case HANDLE_SIG: setSignalHandler(signl, handle_signal); break; } } #endif static Handle waitForSignal(TaskData *taskData) { while (true) { processes->ProcessAsynchRequests(taskData); // Check for kill. sigLock.Lock(); // Any pending signals? for (int sig = 0; sig < NSIG; sig++) { if (sigData[sig].signalCount > 0) { sigData[sig].signalCount--; if (!IS_INT(findHandler(sig))) /* If it's not DEFAULT or IGNORE. */ { // Create a pair of the handler and signal and pass // them back to be run. Handle pair = alloc_and_save(taskData, 2); // Have to call findHandler again here because that // allocation could have garbage collected. DEREFHANDLE(pair)->Set(0, findHandler(sig)); DEREFHANDLE(pair)->Set(1, TAGGED(sig)); sigLock.Unlock(); return pair; } } } if (convertedWeak) { // Last GC converted a weak SOME into NONE. This isn't // anything to do with signals but the signal thread can // deal with this. sigLock.Unlock(); convertedWeak = false; return SAVE(TAGGED(0)); } // No pending signal. Wait until we're woken up. // This releases sigLock after acquiring schedLock. if (! processes->WaitForSignal(taskData, &sigLock)) raise_exception_string(taskData, EXC_Fail, "Only one thread may wait for signals"); } } POLYUNSIGNED PolySetSignalHandler(PolyObject *threadId, PolyWord signalNo, PolyWord action) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedAction = taskData->saveVec.push(action); Handle oldaction = 0; try { { int sign; int action; { // Lock while we look at the signal vector but release // it before making a root request. PLocker locker(&sigLock); // We have to pass this to the main thread to // set up the signal handler. sign = get_C_int(taskData, signalNo); /* Decode the action if it is Ignore or Default. */ if (pushedAction->Word().IsTagged()) action = (int)pushedAction->Word().UnTagged(); else action = HANDLE_SIG; /* Set the handler. */ if (sign <= 0 || sign >= NSIG) raise_syscall(taskData, "Invalid signal value", INVALIDSIGNAL); /* Get the old action before updating the vector. */ oldaction = SAVE(findHandler(sign)); // Now update it. sigData[sign].handler = pushedAction->Word(); } // Request a change in the masking by the root thread. // This doesn't do anything in Windows so the only "signal" // we affect is SIGINT and that is handled by RequestConsoleInterrupt. if (! sigData[sign].nonMaskable) { -#ifdef USE_PTHREAD_SIGNALS +#if (!defined(_WIN32)) SignalRequest request(sign, action); processes->MakeRootRequest(taskData, &request); #endif } } } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (oldaction == 0) return TAGGED(0).AsUnsigned(); else return oldaction->Word().AsUnsigned(); } // Called by the signal handler thread. Blocks until a signal is available. POLYUNSIGNED PolyWaitForSignal(PolyObject *threadId) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = waitForSignal(taskData); } catch (KillException &) { processes->ThreadExit(taskData); // May test for kill } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Set up per-thread signal data: basically signal stack. // This is really only needed for profiling timer signals. void initThreadSignals(TaskData *taskData) { #if (!(defined(_WIN32)||defined(MACOSX))) // On the i386, at least, we need to set up a signal stack for // each thread if it might receive a signal. ML code checks for // stack overflow but a signal could result in C code being // executed on the ML stack. The signal stack avoids this. // On some architectures the C stack pointer is left unused // when executing ML code so this isn't a problem. // In Linux each thread can receive a SIGVTALRM signal when // profiling. // This is currently disabled in Mac OS X. In 10.4 and before // setting a signal stack in a thread seemed to set it for the // whole process and crash with an illegal instruction on the // second signal. This isn't currently a problem since only the // main thread receives signals in Mac OS X. #if (defined(SA_ONSTACK) && defined(HAVE_SIGALTSTACK)) taskData->signalStack = malloc(SIGSTKSZ); #ifdef HAVE_STACK_T stack_t ex_stack; #else // This used to be used in FreeBSD and Mac OS X struct sigaltstack ex_stack; #endif memset(&ex_stack, 0, sizeof(ex_stack)); // Cast to char* because ss_sp is char* in FreeBSD. // Linux simply casts it back to void*. ex_stack.ss_sp = (char*)taskData->signalStack; ex_stack.ss_size = SIGSTKSZ; ex_stack.ss_flags = 0; /* not SS_DISABLE */ int sigaltstack_result = sigaltstack(&ex_stack, NULL); ASSERT(sigaltstack_result == 0); #endif #endif /* not the PC */ -#ifdef USE_PTHREAD_SIGNALS +#if (!defined(_WIN32)) // Block all signals except those marked as in use by the RTS so // that they will only be picked up by the signal detection thread. // Since the signal mask is inherited we really don't need to do // this for every thread, just the initial one. sigset_t sigset; sigfillset(&sigset); for (int i = 0; i < NSIG; i++) { if (sigData[i].nonMaskable) sigdelset(&sigset, i); } pthread_sigmask(SIG_SETMASK, &sigset, NULL); #endif } /* General purpose function to set up a signal handler. */ -#if (!defined(_WIN32) || defined(__CYGWIN__)) +#if (!defined(_WIN32)) bool setSignalHandler(int sig, signal_handler_type func) { struct sigaction sigcatch; memset(&sigcatch, 0, sizeof(sigcatch)); sigcatch.sa_sigaction = func; /* Both Linux and FreeBSD now use SA_SIGINFO in a similar way. If SA_SIGINFO is set the handler is supposed to be in sa_sigaction rather than sa_handler (actually this is a union so they're in the same place). */ init_asyncmask(&sigcatch.sa_mask); sigcatch.sa_flags = 0; #if defined(SA_ONSTACK) && defined(HAVE_SIGALTSTACK) sigcatch.sa_flags |= SA_ONSTACK; #endif #ifdef SA_RESTART sigcatch.sa_flags |= SA_RESTART; #endif #ifdef SA_SIGINFO sigcatch.sa_flags |= SA_SIGINFO; #endif #ifdef SV_SAVE_REGS sigcatch.sa_flags |= SV_SAVE_REGS; #endif return sigaction(sig, &sigcatch,NULL) >= 0; } // Signals to mask off when handling a signal. The signal being handled // is always masked off. This really only applied when emulation traps // and requests to GC involved signals. That no longer applies except // on the Sparc. void init_asyncmask(sigset_t *mask) { /* disable asynchronous interrupts while servicing interrupt */ sigemptyset(mask); sigaddset(mask,SIGVTALRM); sigaddset(mask,SIGINT); sigaddset(mask,SIGUSR2); sigaddset(mask,SIGWINCH); // This next used to be needed when emulation traps resulted in // signals. This no longer applies except on the Sparc. #ifdef SPARC sigaddset(mask,SIGILL); sigaddset(mask,SIGFPE); /* Mask off SIGSEGV. This is definitely needed when we are installing a handler for SIGINT under Linux and may also be needed in other cases as well e.g. SIGVTALRM. Without it typing control-C to a program which is taking lots of emulation traps can cause a crash because the signals are delivered in the "wrong" order and the pc value given to catchSEGV can point at the handler for SIGINT. DCJM 7/2/01. */ sigaddset(mask,SIGSEGV); /* And, just to be sure, include SIGBUS. DCJM 22/5/02. */ sigaddset(mask,SIGBUS); #endif } #endif struct _entrypts sigHandlerEPT[] = { { "PolySetSignalHandler", (polyRTSFunction)&PolySetSignalHandler}, { "PolyWaitForSignal", (polyRTSFunction)&PolyWaitForSignal}, { NULL, NULL} // End of list. }; class SigHandler: public RtsModule { public: virtual void Init(void); virtual void Stop(void); virtual void GarbageCollect(ScanAddress * /*process*/); -#ifdef USE_PTHREAD_SIGNALS +#if (!defined(_WIN32)) SigHandler() { threadRunning = false; } pthread_t detectionThreadId; bool threadRunning; #endif }; // Declare this. It will be automatically added to the table. static SigHandler sighandlerModule; -#ifdef USE_PTHREAD_SIGNALS +#if (!defined(_WIN32)) // This thread is really only to convert between POSIX semaphores and // pthread condition variables. It waits for a semphore to be released by the // signal handler running on the main thread and then wakes up the ML handler // thread. The ML thread must not wait directly on a POSIX semaphore because it // may also be woken by other events, particularly a kill request when the program // exits. static void *SignalDetectionThread(void *) { // Block all signals so they will be delivered to the main thread. sigset_t active_signals; sigfillset(&active_signals); pthread_sigmask(SIG_SETMASK, &active_signals, NULL); int readSignals[NSIG] = {0}; while (true) { if (waitSema == 0) return 0; // Wait until we are woken up by an arriving signal. // waitSema will be incremented for each signal so we should // not block until we have processed them all. if (! waitSema->Wait() || terminate) return 0; for (int j = 1; j < NSIG; j++) { if (readSignals[j] < lastSignals[j]) { readSignals[j]++; signalArrived(j); } } } } #endif void SigHandler::Init(void) { // Mark certain signals as non-maskable since they really // indicate a fatal error. #ifdef SIGSEGV sigData[SIGSEGV].nonMaskable = true; #endif #ifdef SIGBUS sigData[SIGBUS].nonMaskable = true; #endif #ifdef SIGILL sigData[SIGILL].nonMaskable = true; #endif -#ifdef USE_PTHREAD_SIGNALS +#if (!defined(_WIN32)) static PSemaphore waitSemaphore; // Initialise the "wait" semaphore so that it blocks immediately. if (! waitSemaphore.Init(0, NSIG)) return; waitSema = &waitSemaphore; // Create a new thread to handle signals synchronously. // for it to finish. pthread_attr_t attrs; pthread_attr_init(&attrs); #ifdef PTHREAD_STACK_MIN #if (PTHREAD_STACK_MIN < 4096) pthread_attr_setstacksize(&attrs, 4096); // But not too small: FreeBSD makes it 2k #else pthread_attr_setstacksize(&attrs, PTHREAD_STACK_MIN); // Only small stack. #endif #endif threadRunning = pthread_create(&detectionThreadId, &attrs, SignalDetectionThread, 0) == 0; pthread_attr_destroy(&attrs); #endif } // Wait for the signal thread to finish before the semaphore is deleted in the // final clean-up. Failing to do this causes a hang in Mac OS X. void SigHandler::Stop(void) { -#ifdef USE_PTHREAD_SIGNALS +#if (!defined(_WIN32)) terminate = true; waitSema->Signal(); pthread_join(detectionThreadId, NULL); #endif } void SigHandler::GarbageCollect(ScanAddress *process) { for (unsigned i = 0; i < NSIG; i++) { if (sigData[i].handler != PolyWord::FromUnsigned(0)) process->ScanRuntimeWord(&sigData[i].handler); } } diff --git a/libpolyml/sighandler.h b/libpolyml/sighandler.h index c5a611c1..933d9767 100644 --- a/libpolyml/sighandler.h +++ b/libpolyml/sighandler.h @@ -1,52 +1,52 @@ /* Title: sighandler.h - Copyright (c) 2000-7, 2016 David C.J. Matthews + Copyright (c) 2000-7, 2016, 2019 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef _SIGHANDLER_H #define _SIGHANDLER_H 1 class TaskData; extern void markSignalInuse(int sig); -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) extern void RequestConsoleInterrupt(void); #else #ifdef HAVE_SIGNAL_H #include #endif extern void init_asyncmask(sigset_t *mask); #define SIG_HANDLER_ARGS(_sig,_contxt) int _sig, siginfo_t *, void *_contxt typedef void (*signal_handler_type)(SIG_HANDLER_ARGS(s, c)); extern bool setSignalHandler(int sig, signal_handler_type func); // Set up per-thread signal data: basically signal stack. extern void initThreadSignals(TaskData *taskData); #endif /* ! _WIN32 */ extern unsigned receivedSignalCount; // Incremented each time we get a signal extern struct _entrypts sigHandlerEPT[]; #endif diff --git a/libpolyml/statistics.cpp b/libpolyml/statistics.cpp index dd211cb9..50f8cff6 100644 --- a/libpolyml/statistics.cpp +++ b/libpolyml/statistics.cpp @@ -1,838 +1,838 @@ /* Title: statics.cpp - Profiling statistics Copyright (c) 2011, 2013, 2015, 2019 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_WINDOWS_H #include #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_SYS_TYPES_H #include #endif #ifdef HAVE_SYS_MMAN_H #include #endif #ifdef HAVE_SYS_STAT_H #include #endif #ifdef HAVE_FCNTL_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_SYS_PARAM_H #include #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_TIME_H #include #endif #ifdef HAVE_SYS_TIMES_H #include #endif #ifdef HAVE_SYS_TIME_H #include #endif #ifdef HAVE_SYS_RESOURCE_H #include #endif #ifdef HAVE_STDLIB_H #include #endif #if defined(HAVE_MMAP) // How do we get the page size? #ifndef HAVE_GETPAGESIZE #ifdef _SC_PAGESIZE #define getpagesize() sysconf(_SC_PAGESIZE) #else // If this fails we're stuck #define getpagesize() PAGESIZE #endif #endif #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #include #else #define _T(x) x #endif #include #ifdef max #undef max #endif #include "run_time.h" #include "sys.h" #include "save_vec.h" #include "rts_module.h" #include "timing.h" #include "polystring.h" #include "processes.h" #include "statistics.h" #include "../polystatistics.h" #include "rtsentry.h" #include "arb.h" extern "C" { POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetUserStatsCount(); POLYEXTERNALSYMBOL POLYUNSIGNED PolySetUserStat(PolyObject *threadId, PolyWord index, PolyWord value); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetLocalStats(PolyObject *threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetRemoteStats(PolyObject *threadId, PolyWord procId); // POLYEXTERNALSYMBOL POLYUNSIGNED PolySpecificGeneral(PolyObject *threadId, PolyWord code, PolyWord arg); } #define STATS_SPACE 4096 // Enough for all the statistics #define ASN1_U_BOOL 1 #define ASN1_U_INT 2 #define ASN1_U_STRING 4 #define ASN1_U_NULL 5 #define ASN1_U_ENUM 10 #define ASN1_U_SEQUENCE 16 // For the moment we don't bother to interlock access to the statistics memory. // Other processes only read the memory and at worst they may get a glitch in // the values. Statistics::Statistics(): accessLock("Statistics") { statMemory = 0; memSize = 0; newPtr = 0; for (unsigned i = 0; i < N_PS_INTS; i++) counterAddrs[i] = 0; for (unsigned j = 0; j < N_PS_TIMES; j++) timeAddrs[j].secAddr = timeAddrs[j].usecAddr = 0; for (unsigned k = 0; k < N_PS_USER; k++) userAddrs[k] = 0; memset(&gcUserTime, 0, sizeof(gcUserTime)); memset(&gcSystemTime, 0, sizeof(gcSystemTime)); memset(&gcRealTime, 0, sizeof(gcRealTime)); #ifdef HAVE_WINDOWS_H // File mapping handle hFileMap = NULL; exportStats = true; // Actually unused #else mapFd = -1; mapFileName = 0; exportStats = false; // Don't export by default #endif memSize = 0; statMemory = 0; newPtr = 0; } void Statistics::Init() { -#if (defined(HAVE_WINDOWS_H) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) // Record an initial time of day to use as the basis of real timing GetSystemTimeAsFileTime(&startTime); #else gettimeofday(&startTime, NULL); #endif #ifdef HAVE_WINDOWS_H // Get the process ID to use in the shared memory name DWORD pid = ::GetCurrentProcessId(); TCHAR shmName[MAX_PATH]; wsprintf(shmName, _T(POLY_STATS_NAME) _T("%lu"), pid); // Create a piece of shared memory hFileMap = CreateFileMapping(INVALID_HANDLE_VALUE, NULL, PAGE_READWRITE, 0, STATS_SPACE, shmName); if (hFileMap == NULL) return; // If it already exists it's the wrong one. if (GetLastError() == ERROR_ALREADY_EXISTS) { CloseHandle(hFileMap); hFileMap = NULL; return; } statMemory = (unsigned char*)MapViewOfFile(hFileMap, FILE_MAP_ALL_ACCESS, 0, 0, STATS_SPACE); if (statMemory == NULL) { CloseHandle(hFileMap); hFileMap = NULL; return; } memSize = STATS_SPACE; #else #if HAVE_MMAP if (exportStats) { // Create the shared memory in the user's .polyml directory int pageSize = getpagesize(); memSize = (STATS_SPACE + pageSize-1) & ~(pageSize-1); char *homeDir = getenv("HOME"); if (homeDir == NULL) return; mapFileName = (char*)malloc(strlen(homeDir) + 100); strcpy(mapFileName, homeDir); strcat(mapFileName, "/.polyml"); mkdir(mapFileName, 0777); // Make the directory to ensure it exists sprintf(mapFileName + strlen(mapFileName), "/" POLY_STATS_NAME "%d", getpid()); // Open the file. Truncates it if it already exists. That should only happen // if a previous run with the same process id crashed. mapFd = open(mapFileName, O_RDWR|O_CREAT, 0444); if (mapFd == -1) return; // Write enough of the file to fill the space. char ch = 0; for (size_t i = 0; i < memSize; i++) write(mapFd, &ch, 1); statMemory = (unsigned char*)mmap(0, memSize, PROT_READ|PROT_WRITE, MAP_SHARED, mapFd, 0); if (statMemory == MAP_FAILED) { statMemory = 0; return; } } else #endif { // If we just want the statistics locally. statMemory = (unsigned char*)calloc(STATS_SPACE, sizeof(unsigned char)); if (statMemory == 0) return; } #endif // Set up the ASN1 structure in the statistics area. newPtr = statMemory; *newPtr++ = POLY_STATS_C_STATISTICS; // Context tag for statistics *newPtr++ = 0x82; // Extended length, 2 bytes *newPtr++ = 0x00; // Length is initially zero *newPtr++ = 0x00; addCounter(PSC_THREADS, POLY_STATS_ID_THREADS, "ThreadCount"); addCounter(PSC_THREADS_IN_ML, POLY_STATS_ID_THREADS_IN_ML, "ThreadsInML"); addCounter(PSC_THREADS_WAIT_IO, POLY_STATS_ID_THREADS_WAIT_IO, "ThreadsInIOWait"); addCounter(PSC_THREADS_WAIT_MUTEX, POLY_STATS_ID_THREADS_WAIT_MUTEX, "ThreadsInMutexWait"); addCounter(PSC_THREADS_WAIT_CONDVAR, POLY_STATS_ID_THREADS_WAIT_CONDVAR, "ThreadsInCondVarWait"); addCounter(PSC_THREADS_WAIT_SIGNAL, POLY_STATS_ID_THREADS_WAIT_SIGNAL, "ThreadsInSignalWait"); addCounter(PSC_GC_FULLGC, POLY_STATS_ID_GC_FULLGC, "FullGCCount"); addCounter(PSC_GC_PARTIALGC, POLY_STATS_ID_GC_PARTIALGC, "PartialGCCount"); addCounter(PSC_GC_SHARING, POLY_STATS_ID_GC_SHARING, "GCSharingCount"); addSize(PSS_TOTAL_HEAP, POLY_STATS_ID_TOTAL_HEAP, "TotalHeap"); addSize(PSS_AFTER_LAST_GC, POLY_STATS_ID_AFTER_LAST_GC, "HeapAfterLastGC"); addSize(PSS_AFTER_LAST_FULLGC, POLY_STATS_ID_AFTER_LAST_FULLGC, "HeapAfterLastFullGC"); addSize(PSS_ALLOCATION, POLY_STATS_ID_ALLOCATION, "AllocationSpace"); addSize(PSS_ALLOCATION_FREE, POLY_STATS_ID_ALLOCATION_FREE, "AllocationSpaceFree"); addSize(PSS_CODE_SPACE, POLY_STATS_ID_CODE_SPACE, "CodeSpace"); addSize(PSS_STACK_SPACE, POLY_STATS_ID_STACK_SPACE, "StackSpace"); addTime(PST_NONGC_UTIME, POLY_STATS_ID_NONGC_UTIME, "NonGCUserTime"); addTime(PST_NONGC_STIME, POLY_STATS_ID_NONGC_STIME, "NonGCSystemTime"); addTime(PST_GC_UTIME, POLY_STATS_ID_GC_UTIME, "GCUserTime"); addTime(PST_GC_STIME, POLY_STATS_ID_GC_STIME, "GCSystemTime"); addTime(PST_NONGC_RTIME, POLY_STATS_ID_NONGC_RTIME, "NonGCRealTime"); addTime(PST_GC_RTIME, POLY_STATS_ID_GC_RTIME, "GCRealTime"); addUser(0, POLY_STATS_ID_USER0, "UserCounter0"); addUser(1, POLY_STATS_ID_USER1, "UserCounter1"); addUser(2, POLY_STATS_ID_USER2, "UserCounter2"); addUser(3, POLY_STATS_ID_USER3, "UserCounter3"); addUser(4, POLY_STATS_ID_USER4, "UserCounter4"); addUser(5, POLY_STATS_ID_USER5, "UserCounter5"); addUser(6, POLY_STATS_ID_USER6, "UserCounter6"); addUser(7, POLY_STATS_ID_USER7, "UserCounter7"); } void Statistics::addCounter(int cEnum, unsigned statId, const char *name) { // Tag header *newPtr++ = POLY_STATS_C_COUNTERSTAT; *newPtr++ = 0x00; // Initial length - overwritten at the end unsigned char *tagStart = newPtr; // First item - Id of this statistic - Implicit int *newPtr++ = POLY_STATS_C_IDENTIFIER; *newPtr++ = 0x01; ASSERT(statId < 128); *newPtr++ = statId; // Second item - The name size_t nameLength = strlen(name); ASSERT(nameLength < 125); *newPtr++ = POLY_STATS_C_NAME; *newPtr++ = (unsigned char)nameLength; for (unsigned i = 0; i < nameLength; i++) *newPtr++ = name[i]; // Third item - the counter itself. // This, along with the other counters, is technically incorrect // for an ASN1 integer because it should not contain more than // one zero byte. *newPtr++ = POLY_STATS_C_COUNTER_VALUE; *newPtr++ = sizeof(POLYUNSIGNED); counterAddrs[cEnum] = newPtr; // This is the address for (unsigned j = 0; j < sizeof(POLYUNSIGNED); j++) *newPtr++ = 0; // Finally set the tag length and the overall size. size_t length = newPtr - tagStart; ASSERT(length < 128); tagStart[-1] = (unsigned char)length; // Set the overall size. length = newPtr-statMemory - 4; statMemory[2] = (length >> 8) & 0xff; statMemory[3] = length & 0xff; } void Statistics::addSize(int cEnum, unsigned statId, const char *name) { // Tag header *newPtr++ = POLY_STATS_C_SIZESTAT; *newPtr++ = 0x00; // Initial length - overwritten at the end unsigned char *tagStart = newPtr; // First item - Id of this statistic - Implicit int *newPtr++ = POLY_STATS_C_IDENTIFIER; *newPtr++ = 0x01; ASSERT(statId < 128); *newPtr++ = statId; // Second item - The name size_t nameLength = strlen(name); ASSERT(nameLength < 125); *newPtr++ = POLY_STATS_C_NAME; *newPtr++ = (unsigned char)nameLength; for (unsigned i = 0; i < nameLength; i++) *newPtr++ = name[i]; // Third item - the size value itself. We have to allow one // byte extra to ensure that the value we encode is unsigned. unsigned bytes = sizeof(size_t) + 1; *newPtr++ = POLY_STATS_C_BYTE_COUNT; *newPtr++ = bytes; counterAddrs[cEnum] = newPtr; // This is the address for (unsigned j = 0; j < bytes; j++) *newPtr++ = 0; // Finally set the tag length and the overall size. size_t length = newPtr - tagStart; ASSERT(length < 128); tagStart[-1] = (unsigned char)length; // Set the overall size. length = newPtr-statMemory - 4; statMemory[2] = (length >> 8) & 0xff; statMemory[3] = length & 0xff; } void Statistics::addTime(int cEnum, unsigned statId, const char *name) { // Tag header *newPtr++ = POLY_STATS_C_TIMESTAT; *newPtr++ = 0x00; // Initial length - overwritten at the end unsigned char *tagStart = newPtr; // First item - Id of this statistic - Implicit int *newPtr++ = POLY_STATS_C_IDENTIFIER; *newPtr++ = 0x01; ASSERT(statId < 128); *newPtr++ = statId; // Second item - The name size_t nameLength = strlen(name); ASSERT(nameLength < 125); *newPtr++ = POLY_STATS_C_NAME; *newPtr++ = (unsigned char)nameLength; for (unsigned i = 0; i < nameLength; i++) *newPtr++ = name[i]; // Third item - the time. Two four byte values. *newPtr++ = POLY_STATS_C_TIME; *newPtr++ = 12; *newPtr++ = POLY_STATS_C_SECONDS; *newPtr++ = 4; timeAddrs[cEnum].secAddr = newPtr; // This is the address for (unsigned j = 0; j < 4; j++) *newPtr++ = 0; *newPtr++ = POLY_STATS_C_MICROSECS; *newPtr++ = 4; timeAddrs[cEnum].usecAddr = newPtr; // This is the address for (unsigned k = 0; k < 4; k++) *newPtr++ = 0; // Finally set the tag length and the overall size. size_t length = newPtr - tagStart; ASSERT(length < 128); tagStart[-1] = (unsigned char)length; // Set the overall size. length = newPtr-statMemory - 4; statMemory[2] = (length >> 8) & 0xff; statMemory[3] = length & 0xff; } void Statistics::addUser(int n, unsigned statId, const char *name) { // Tag header *newPtr++ = POLY_STATS_C_USERSTAT; *newPtr++ = 0x00; // Initial length - overwritten at the end unsigned char *tagStart = newPtr; // First item - Id of this statistic - Implicit int *newPtr++ = POLY_STATS_C_IDENTIFIER; *newPtr++ = 0x01; ASSERT(statId < 128); *newPtr++ = statId; // Second item - The name size_t nameLength = strlen(name); ASSERT(nameLength < 125); *newPtr++ = POLY_STATS_C_NAME; *newPtr++ = (unsigned char)nameLength; for (unsigned i = 0; i < nameLength; i++) *newPtr++ = name[i]; // Third item - the counter itself. For a user counter the value is a POLYSIGNED. *newPtr++ = POLY_STATS_C_COUNTER_VALUE; *newPtr++ = sizeof(POLYSIGNED); userAddrs[n] = newPtr; // This is the address for (unsigned j = 0; j < sizeof(POLYSIGNED); j++) *newPtr++ = 0; // Finally set the tag length and the overall size. size_t length = newPtr - tagStart; ASSERT(length < 128); tagStart[-1] = (unsigned char)length; // Set the overall size. length = newPtr-statMemory - 4; statMemory[2] = (length >> 8) & 0xff; statMemory[3] = length & 0xff; } Statistics::~Statistics() { #ifdef HAVE_WINDOWS_H if (statMemory != NULL) ::UnmapViewOfFile(statMemory); if (hFileMap != NULL) ::CloseHandle(hFileMap); #else #if HAVE_MMAP if (mapFileName != 0) { if (statMemory != 0 && statMemory != MAP_FAILED) munmap(statMemory, memSize); if (mapFd != -1) close(mapFd); if (mapFileName != 0) unlink(mapFileName); free(mapFileName); } else #endif { free(statMemory); } #endif } // Counters. These are used for thread state so need interlocks void Statistics::incCount(int which) { if (statMemory && counterAddrs[which]) { PLocker lock(&accessLock); unsigned length = counterAddrs[which][-1]; while (length--) { if ((++counterAddrs[which][length]) != 0) break; } } } void Statistics::decCount(int which) { if (statMemory && counterAddrs[which]) { PLocker lock(&accessLock); unsigned length = counterAddrs[which][-1]; while (length--) { if ((counterAddrs[which][length]--) != 0) break; } } } // Sizes. Some of these are only set during GC so may not need interlocks size_t Statistics::getSizeWithLock(int which) { unsigned length = counterAddrs[which][-1]; size_t result = 0; for (unsigned i = 0; i < length; i++) result = (result << 8) | counterAddrs[which][i]; return result; } void Statistics::setSizeWithLock(int which, size_t s) { unsigned length = counterAddrs[which][-1]; while (length--) { counterAddrs[which][length] = (unsigned char)(s & 0xff); s = s >> 8; } } void Statistics::setSize(int which, size_t s) { if (statMemory && counterAddrs[which]) { PLocker lock(&accessLock); setSizeWithLock(which, s); } } void Statistics::incSize(int which, size_t s) { if (statMemory && counterAddrs[which]) { PLocker lock(&accessLock); setSizeWithLock(which, getSizeWithLock(which) + s); } } void Statistics::decSize(int which, size_t s) { if (statMemory && counterAddrs[which]) { PLocker lock(&accessLock); setSizeWithLock(which, getSizeWithLock(which) - s); } } size_t Statistics::getSize(int which) { if (statMemory && counterAddrs[which]) { PLocker lock(&accessLock); return getSizeWithLock(which); } else return 0; } void Statistics::setTimeValue(int which, unsigned long secs, unsigned long usecs) { if (statMemory && timeAddrs[which].secAddr && timeAddrs[which].usecAddr) { PLocker lock(&accessLock); // Necessary ??? unsigned sLength = timeAddrs[which].secAddr[-1]; while (sLength--) { timeAddrs[which].secAddr[sLength] = (unsigned char)(secs & 0xff); secs = secs >> 8; } unsigned usLength = timeAddrs[which].usecAddr[-1]; while (usLength--) { timeAddrs[which].usecAddr[usLength] = (unsigned char)(usecs & 0xff); usecs = usecs >> 8; } } } -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) // Native Windows void Statistics::copyGCTimes(const FILETIME &gcUtime, const FILETIME &gcStime, const FILETIME &gcRtime) { gcUserTime = gcUtime; gcSystemTime = gcStime; ULARGE_INTEGER li; li.LowPart = gcUtime.dwLowDateTime; li.HighPart = gcUtime.dwHighDateTime; setTimeValue(PST_GC_UTIME, (unsigned long)(li.QuadPart / 10000000), (unsigned long)((li.QuadPart / 10) % 1000000)); li.LowPart = gcStime.dwLowDateTime; li.HighPart = gcStime.dwHighDateTime; setTimeValue(PST_GC_STIME, (unsigned long)(li.QuadPart / 10000000), (unsigned long)((li.QuadPart / 10) % 1000000)); li.LowPart = gcRtime.dwLowDateTime; li.HighPart = gcRtime.dwHighDateTime; setTimeValue(PST_GC_RTIME, (unsigned long)(li.QuadPart / 10000000), (unsigned long)((li.QuadPart / 10) % 1000000)); } #else // Unix void Statistics::copyGCTimes(const struct timeval &gcUtime, const struct timeval &gcStime, const struct timeval &gcRtime) { gcUserTime = gcUtime; gcSystemTime = gcStime; setTimeValue(PST_GC_UTIME, gcUtime.tv_sec, gcUtime.tv_usec); setTimeValue(PST_GC_STIME, gcStime.tv_sec, gcStime.tv_usec); setTimeValue(PST_GC_RTIME, gcRtime.tv_sec, gcRtime.tv_usec); } #endif // Update the statistics that are not otherwise copied. Called from the // root thread every second. void Statistics::updatePeriodicStats(size_t freeWords, unsigned threadsInML) { setSize(PSS_ALLOCATION_FREE, freeWords*sizeof(PolyWord)); -#if (defined(HAVE_WINDOWS_H) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) FILETIME ct, et, st, ut, rt; GetProcessTimes(GetCurrentProcess(), &ct, &et, &st, &ut); GetSystemTimeAsFileTime(&rt); subFiletimes(&st, &gcSystemTime); subFiletimes(&ut, &gcUserTime); subFiletimes(&rt, &startTime); subFiletimes(&rt, &gcRealTime); ULARGE_INTEGER li; li.LowPart = ut.dwLowDateTime; li.HighPart = ut.dwHighDateTime; setTimeValue(PST_NONGC_UTIME, (unsigned long)(li.QuadPart / 10000000), (unsigned long)((li.QuadPart / 10) % 1000000)); li.LowPart = st.dwLowDateTime; li.HighPart = st.dwHighDateTime; setTimeValue(PST_NONGC_STIME, (unsigned long)(li.QuadPart / 10000000), (unsigned long)((li.QuadPart / 10) % 1000000)); li.LowPart = rt.dwLowDateTime; li.HighPart = rt.dwHighDateTime; setTimeValue(PST_NONGC_RTIME, (unsigned long)(li.QuadPart / 10000000), (unsigned long)((li.QuadPart / 10) % 1000000)); #else struct rusage usage; struct timeval tv; getrusage(RUSAGE_SELF, &usage); gettimeofday(&tv, NULL); subTimevals(&usage.ru_stime, &gcSystemTime); subTimevals(&usage.ru_utime, &gcUserTime); subTimevals(&tv, &startTime); subTimevals(&tv, &gcRealTime); setTimeValue(PST_NONGC_UTIME, usage.ru_utime.tv_sec, usage.ru_utime.tv_usec); setTimeValue(PST_NONGC_STIME, usage.ru_stime.tv_sec, usage.ru_stime.tv_usec); setTimeValue(PST_NONGC_RTIME, tv.tv_sec, tv.tv_usec); #endif if (statMemory && counterAddrs[PSC_THREADS_IN_ML]) { PLocker lock(&accessLock); unsigned length = counterAddrs[PSC_THREADS_IN_ML][-1]; while (length--) { counterAddrs[PSC_THREADS_IN_ML][length] = (unsigned char)(threadsInML & 0xff); threadsInML = threadsInML >> 8; } } } void Statistics::setUserCounter(unsigned which, POLYSIGNED value) { if (statMemory && userAddrs[which]) { PLocker lock(&accessLock); // Not really needed // The ASN1 int is big-endian unsigned length = userAddrs[which][-1]; while (length--) { userAddrs[which][length] = (unsigned char)value; value = value >> 8; } } } Handle Statistics::returnStatistics(TaskData *taskData, unsigned char *stats) { // Parse the ASN1 tag and length. unsigned char *p = stats; if (*p == POLY_STATS_C_STATISTICS) // Check and skip the tag { p++; if ((*p & 0x80) == 0) p += *p + 1; else { int lengthOfLength = *p++ & 0x7f; if (lengthOfLength != 0) { unsigned l = 0; while (lengthOfLength--) l = (l << 8) | *p++; p += l; } } } return taskData->saveVec.push(C_string_to_Poly(taskData, (const char*)stats, p - stats)); } // Copy the local statistics into the buffer Handle Statistics::getLocalStatistics(TaskData *taskData) { if (statMemory == 0) raise_exception_string(taskData, EXC_Fail, "No statistics available"); return returnStatistics(taskData, statMemory); } // Get statistics for a remote instance. We don't do any locking Handle Statistics::getRemoteStatistics(TaskData *taskData, POLYUNSIGNED pid) { #ifdef HAVE_WINDOWS_H TCHAR shmName[MAX_PATH]; wsprintf(shmName, _T(POLY_STATS_NAME) _T("%") _T(POLYUFMT), pid); HANDLE hRemMemory = OpenFileMapping(FILE_MAP_READ, FALSE, shmName); if (hRemMemory == NULL) raise_exception_string(taskData, EXC_Fail, "No statistics available"); unsigned char *sMem = (unsigned char *)MapViewOfFile(hRemMemory, FILE_MAP_READ, 0, 0, 0); CloseHandle(hRemMemory); if (sMem == NULL) raise_exception_string(taskData, EXC_Fail, "No statistics available"); if (*sMem != POLY_STATS_C_STATISTICS) { UnmapViewOfFile(sMem); raise_exception_string(taskData, EXC_Fail, "Statistics data malformed"); } Handle result = returnStatistics(taskData, sMem); UnmapViewOfFile(sMem); return result; #elif HAVE_MMAP // Find the shared memory in the user's home directory char *homeDir = getenv("HOME"); if (homeDir == NULL) raise_exception_string(taskData, EXC_Fail, "No statistics available"); int remMapFd = -1; size_t remMapSize = 4096; TempCString remMapFileName((char *)malloc(remMapSize)); if (remMapFileName == NULL) raise_exception_string(taskData, EXC_Fail, "No statistics available"); while ((snprintf(remMapFileName, remMapSize, "%s/.polyml/" POLY_STATS_NAME "%" POLYUFMT, homeDir, pid), strlen(remMapFileName) >= remMapSize - 1)) { if (remMapSize > std::numeric_limits::max() / 2) raise_exception_string(taskData, EXC_Fail, "No statistics available"); remMapSize *= 2; char *newFileName = (char *)realloc(remMapFileName, remMapSize); if (newFileName == NULL) raise_exception_string(taskData, EXC_Fail, "No statistics available"); remMapFileName = newFileName; } remMapFd = open(remMapFileName, O_RDONLY); if (remMapFd == -1) raise_exception_string(taskData, EXC_Fail, "No statistics available"); unsigned char *sMem = (unsigned char*)mmap(0, memSize, PROT_READ, MAP_PRIVATE, remMapFd, 0); if (sMem == MAP_FAILED) { close(remMapFd); raise_exception_string(taskData, EXC_Fail, "No statistics available"); } // Check the tag. if (*sMem != POLY_STATS_C_STATISTICS) { munmap(sMem, memSize); close(remMapFd); raise_exception_string(taskData, EXC_Fail, "Statistics data malformed"); } Handle result = returnStatistics(taskData, sMem); munmap(sMem, memSize); close(remMapFd); return result; #else raise_exception_string(taskData, EXC_Fail, "No statistics available"); #endif } // Create the global statistics object. Statistics globalStats; POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetUserStatsCount() { return TAGGED(N_PS_USER).AsUnsigned(); } POLYEXTERNALSYMBOL POLYUNSIGNED PolySetUserStat(PolyObject *threadId, PolyWord indexVal, PolyWord valueVal) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); try { unsigned index = get_C_unsigned(taskData, indexVal); if (index >= N_PS_USER) raise_exception0(taskData, EXC_subscript); POLYSIGNED value = getPolySigned(taskData, valueVal); globalStats.setUserCounter(index, value); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetLocalStats(PolyObject *threadId) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = globalStats.getLocalStatistics(taskData); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetRemoteStats(PolyObject *threadId, PolyWord procId) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = globalStats.getRemoteStatistics(taskData, getPolyUnsigned(taskData, procId)); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } struct _entrypts statisticsEPT[] = { { "PolyGetUserStatsCount", (polyRTSFunction)&PolyGetUserStatsCount }, { "PolySetUserStat", (polyRTSFunction)&PolySetUserStat }, { "PolyGetLocalStats", (polyRTSFunction)&PolyGetLocalStats }, { "PolyGetRemoteStats", (polyRTSFunction)&PolyGetRemoteStats }, { NULL, NULL } // End of list. }; diff --git a/libpolyml/statistics.h b/libpolyml/statistics.h index b2553a5c..d1c8593d 100644 --- a/libpolyml/statistics.h +++ b/libpolyml/statistics.h @@ -1,140 +1,140 @@ /* Title: statics.h - Interface to profiling statistics Copyright (c) 2011, 2015, 2019 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef STATISTICS_INCLUDED #define STATISTICS_INCLUDED #ifdef HAVE_WINDOWS_H #include #endif #include "globals.h" #include "locking.h" #include "rts_module.h" #include "../polystatistics.h" enum { PSC_THREADS = 0, // Total number of threads PSC_THREADS_IN_ML, // Threads running ML code PSC_THREADS_WAIT_IO, // Threads waiting for IO PSC_THREADS_WAIT_MUTEX, // Threads waiting for a mutex PSC_THREADS_WAIT_CONDVAR, // Threads waiting for a condition var PSC_THREADS_WAIT_SIGNAL, // Special case - signal handling thread PSC_GC_FULLGC, // Number of full garbage collections PSC_GC_PARTIALGC, // Number of partial GCs PSC_GC_SHARING, // Number of sharing passes PSS_TOTAL_HEAP, // Total size of the local heap PSS_AFTER_LAST_GC, // Space free after last GC PSS_AFTER_LAST_FULLGC, // Space free after the last full GC PSS_ALLOCATION, // Size of allocation space PSS_ALLOCATION_FREE, // Space available in allocation area PSS_CODE_SPACE, // Space for code PSS_STACK_SPACE, // Space for stack N_PS_INTS }; enum { PST_NONGC_UTIME, PST_NONGC_STIME, PST_GC_UTIME, PST_GC_STIME, PST_NONGC_RTIME, PST_GC_RTIME, N_PS_TIMES }; // A few counters that can be used by the application #define N_PS_USER 8 class TaskData; class SaveVecEntry; typedef SaveVecEntry *Handle; class Statistics: RtsModule { public: Statistics(); ~Statistics(); virtual void Init(void); // Initialise after set-up Handle getLocalStatistics(TaskData *taskData); Handle getRemoteStatistics(TaskData *taskData, POLYUNSIGNED processId); void incCount(int which); void decCount(int which); void setSize(int which, size_t s); void incSize(int which, size_t s); void decSize(int which, size_t s); size_t getSize(int which); void setUserCounter(unsigned which, POLYSIGNED value); -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) // Native Windows void copyGCTimes(const FILETIME &gcUtime, const FILETIME &gcStime, const FILETIME &gcRtime); FILETIME gcUserTime, gcSystemTime, gcRealTime, startTime; #else // Unix and Cygwin void copyGCTimes(const struct timeval &gcUtime, const struct timeval &gcStime, const struct timeval &gcRtime); struct timeval gcUserTime, gcSystemTime, gcRealTime, startTime; #endif void updatePeriodicStats(size_t freeSpace, unsigned threadsInML); bool exportStats; private: PLock accessLock; #ifdef HAVE_WINDOWS_H // File mapping handle HANDLE hFileMap; #else char *mapFileName; int mapFd; #endif size_t memSize; unsigned char *statMemory; unsigned char *newPtr; unsigned char *counterAddrs[N_PS_INTS]; struct { unsigned char *secAddr; unsigned char *usecAddr; } timeAddrs[N_PS_TIMES]; unsigned char *userAddrs[N_PS_USER]; Handle returnStatistics(TaskData *taskData, unsigned char *stats); void addCounter(int cEnum, unsigned statId, const char *name); void addSize(int cEnum, unsigned statId, const char *name); void addTime(int cEnum, unsigned statId, const char *name); void addUser(int n, unsigned statId, const char *name); size_t getSizeWithLock(int which); void setSizeWithLock(int which, size_t s); void setTimeValue(int which, unsigned long secs, unsigned long usecs); }; extern Statistics globalStats; extern struct _entrypts statisticsEPT[]; #endif // STATISTICS_INCLUDED diff --git a/libpolyml/timing.cpp b/libpolyml/timing.cpp index 3144e58f..2bd13a97 100644 --- a/libpolyml/timing.cpp +++ b/libpolyml/timing.cpp @@ -1,599 +1,599 @@ /* Title: Time functions. Author: Dave Matthews, Cambridge University Computer Laboratory Copyright (c) 2000 Cambridge University Technical Services Limited Further development copyright David C.J. Matthews 2011,12,16 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_LOCALE_H #include #endif #ifdef HAVE_SYS_PARAM_H #include #endif #ifdef HAVE_TIME_H #include #endif #ifdef HAVE_SYS_TIMES_H #include #endif #ifdef HAVE_SYS_TIME_H #include #endif #ifdef HAVE_SYS_RESOURCE_H #include #endif #ifdef HAVE_SYS_TYPES_H #include #endif #ifdef HAVE_SYS_STAT_H #include #endif #ifdef HAVE_SYS_SIGNAL_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_LIMITS_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) 0 #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_WINDOWS_H #include #endif #include // Windows headers define min/max macros, which messes up trying to use std::numeric_limits::min/max() #ifdef min #undef min #endif #ifdef max #undef max #endif #include "locking.h" #include "globals.h" #include "arb.h" #include "run_time.h" #include "sys.h" #include "timing.h" #include "polystring.h" #include "save_vec.h" #include "rts_module.h" #include "processes.h" #include "heapsizing.h" #include "rtsentry.h" #include "mpoly.h" // For polyStderr extern "C" { POLYEXTERNALSYMBOL POLYUNSIGNED PolyTimingGeneral(PolyObject *threadId, PolyWord code, PolyWord arg); } -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) /* Windows file times are 64-bit numbers representing times in tenths of a microsecond. */ #define TICKS_PER_MICROSECOND 10 #ifdef __GNUC__ #define SECSSINCE1601 11644473600LL #else #define SECSSINCE1601 11644473600 #endif #else /* For Unix return times in microseconds. */ #define TICKS_PER_MICROSECOND 1 #endif /* The original Poly timing functions used a variety of timing bases (e.g. seconds, tenths of a second). The old functions have been retained but the intention is to phase them out in favour of new functions. Most of these are handled through the timing_dispatch function. The intention behind the timing functions is to make use of the arbitrary precision arithmetic to allow for a wider range of dates than the usual mktime range of 1970 to 2036. We also want to handle more accurate timing than per second or per microsecond where the operating system provides it. */ -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) static FILETIME startTime; #define StrToLL _strtoi64 #else static struct timeval startTime; #define StrToLL strtoll #endif #if(!(defined(HAVE_GMTIME_R) && defined(HAVE_LOCALTIME_R))) // gmtime and localtime are not re-entrant so if we don't have the // re-entrant versions we need to use a lock. static PLock timeLock("Timing"); #endif #define XSTR(X) STR(X) #define STR(X) #X static Handle timing_dispatch_c(TaskData *taskData, Handle args, Handle code) { unsigned c = get_C_unsigned(taskData, code->Word()); 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__)) +#if (defined(_WIN32)) 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__)) +#if (defined(_WIN32)) 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__)) +#if (defined(_WIN32)) /* 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, DEREFWORD(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__)) +#if (defined(_WIN32)) 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, DEREFWORD(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__)) +#if (defined(_WIN32)) _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__)) +#if (defined(_WIN32)) FILETIME ut, ct, et, kt; if (! GetProcessTimes(GetCurrentProcess(), &ct, &et, &kt, &ut)) raise_syscall(taskData, "GetProcessTimes failed", 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__)) +#if (defined(_WIN32)) FILETIME ct, et, kt, ut; if (! GetProcessTimes(GetCurrentProcess(), &ct, &et, &kt, &ut)) raise_syscall(taskData, "GetProcessTimes failed", 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__)) +#if (defined(_WIN32)) 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__)) +#if (defined(_WIN32)) 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__)) +#if (defined(_WIN32)) 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; } } } // General interface to timing. Ideally the various cases will be made into // separate functions. POLYUNSIGNED PolyTimingGeneral(PolyObject *threadId, PolyWord code, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedCode = taskData->saveVec.push(code); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { result = timing_dispatch_c(taskData, pushedArg, pushedCode); } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } -#ifdef HAVE_WINDOWS_H +#ifdef _WIN32 void addFiletimes(FILETIME *result, const FILETIME *x) { ULARGE_INTEGER liA, liB; liA.LowPart = result->dwLowDateTime; liA.HighPart = result->dwHighDateTime; liB.LowPart = x->dwLowDateTime; liB.HighPart = x->dwHighDateTime; liA.QuadPart += liB.QuadPart; result->dwLowDateTime = liA.LowPart; result->dwHighDateTime = liA.HighPart; } void subFiletimes(FILETIME *result, const FILETIME *x) { ULARGE_INTEGER liA, liB; liA.LowPart = result->dwLowDateTime; liA.HighPart = result->dwHighDateTime; liB.LowPart = x->dwLowDateTime; liB.HighPart = x->dwHighDateTime; liA.QuadPart -= liB.QuadPart; result->dwLowDateTime = liA.LowPart; result->dwHighDateTime = liA.HighPart; } float filetimeToSeconds(const FILETIME *x) { ULARGE_INTEGER ul; ul.LowPart = x->dwLowDateTime; ul.HighPart = x->dwHighDateTime; return (float)ul.QuadPart / (float)1.0E7; } void FileTimeTime::fromSeconds(unsigned u) { ULARGE_INTEGER li; li.QuadPart = (ULONGLONG)u * TICKS_PER_MICROSECOND * 1000000; t.dwLowDateTime = li.LowPart; t.dwHighDateTime = li.HighPart; } void FileTimeTime::add(const FileTimeTime &f) { addFiletimes(&t, &f.t); } void FileTimeTime::sub(const FileTimeTime &f) { subFiletimes(&t, &f.t); } float FileTimeTime::toSeconds(void) { return filetimeToSeconds(&t); } #endif #ifdef HAVE_SYS_TIME_H void addTimevals(struct timeval *result, const struct timeval *x) { long uSecs = result->tv_usec + x->tv_usec; result->tv_sec += x->tv_sec; if (uSecs >= 1000000) { result->tv_sec++; uSecs -= 1000000; } result->tv_usec = uSecs; } void subTimevals(struct timeval *result, const struct timeval *x) { long uSecs = result->tv_usec - x->tv_usec; result->tv_sec -= x->tv_sec; if (uSecs < 0) { result->tv_sec--; uSecs += 1000000; } result->tv_usec = uSecs; } float timevalToSeconds(const struct timeval *x) { return (float)x->tv_sec + (float)x->tv_usec / 1.0E6; } void TimeValTime::add(const TimeValTime &f) { addTimevals(&t, &f.t); } void TimeValTime::sub(const TimeValTime &f) { subTimevals(&t, &f.t); } #endif struct _entrypts timingEPT[] = { { "PolyTimingGeneral", (polyRTSFunction)&PolyTimingGeneral}, { NULL, NULL} // End of list. }; class Timing: public RtsModule { public: virtual void Init(void); }; // Declare this. It will be automatically added to the table. static Timing timingModule; void Timing::Init(void) { -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) // Record an initial time of day to use as the basis of real timing GetSystemTimeAsFileTime(&startTime); #else gettimeofday(&startTime, NULL); #endif } time_t getBuildTime(void) { char *source_date_epoch = getenv("SOURCE_DATE_EPOCH"); if (source_date_epoch) { errno = 0; char *endptr; long long epoch = StrToLL(source_date_epoch, &endptr, 10); if ((errno == ERANGE && (epoch == LLONG_MIN || epoch == LLONG_MAX)) || (errno != 0 && epoch == 0)) { fprintf(polyStderr, "Environment variable $SOURCE_DATE_EPOCH: " XSTR(StrToLL) ": %s\n", strerror(errno)); goto err; } if (endptr == source_date_epoch) { fprintf(polyStderr, "Environment variable $SOURCE_DATE_EPOCH: No digits were found: %s\n", endptr); goto err; } if (*endptr != '\0') { fprintf(polyStderr, "Environment variable $SOURCE_DATE_EPOCH: Trailing garbage: %s\n", endptr); goto err; } if (epoch < (long long)std::numeric_limits::min()) { fprintf(polyStderr, "Environment variable $SOURCE_DATE_EPOCH: value must be greater than or equal to: %lld but was found to be: %lld\n", (long long)std::numeric_limits::min(), epoch); goto err; } if (epoch > (long long)std::numeric_limits::max()) { fprintf(polyStderr, "Environment variable $SOURCE_DATE_EPOCH: value must be smaller than or equal to: %lld but was found to be: %lld\n", (long long)std::numeric_limits::max(), epoch); goto err; } return (time_t) epoch; } err: return time(NULL); } diff --git a/libpolyml/timing.h b/libpolyml/timing.h index 9bc743ce..3eaa12cd 100644 --- a/libpolyml/timing.h +++ b/libpolyml/timing.h @@ -1,109 +1,107 @@ /* Title: Header for time functions Copyright (c) 2000 Cambridge University Technical Services Limited - Further development Copyright David C.J. Matthews 2011-12, 16. + Further development Copyright David C.J. Matthews 2011-12, 16, 19. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef _TIMING_H_DEFINED #define _TIMING_H_DEFINED 1 #ifdef HAVE_TIME_H #include #endif #ifdef HAVE_SYS_TIMES_H #include #endif #ifdef HAVE_SYS_TIME_H #include #endif #ifdef HAVE_SYS_RESOURCE_H #include #endif #ifdef HAVE_WINDOWS_H #include #endif class SaveVecEntry; typedef SaveVecEntry *Handle; class TaskData; /* time functions etc */ // Define classes for operations on time values in Windows and Posix. -// N.B. In Cygwin we use both classes because in some cases we need -// Windows-style timing and in other places we use Unix-style. -#ifdef HAVE_WINDOWS_H +#ifdef _WIN32 class FileTimeTime { public: FileTimeTime() { t.dwLowDateTime = t.dwHighDateTime = 0; } FileTimeTime(const FILETIME f) { t = f; } void fromSeconds(unsigned u); void add(const FileTimeTime &); void sub(const FileTimeTime &); float toSeconds(void); operator FILETIME() const { return t; } protected: FILETIME t; }; #endif #ifdef HAVE_SYS_TIME_H class TimeValTime { public: TimeValTime() { t.tv_sec = 0; t.tv_usec = 0; } TimeValTime(const timeval f) { t = f; } void fromSeconds(unsigned u) { t.tv_sec = u; t.tv_usec = 0; } void add(const TimeValTime &); void sub(const TimeValTime &); float toSeconds(void) { return (float)t.tv_sec + (float)t.tv_usec / 1.0E6; } operator timeval() const { return t; } protected: struct timeval t; }; #endif -#if (defined(_WIN32) && ! defined(__CYGWIN__)) /* Native windows */ +#ifdef _WIN32 /* Native windows */ #define TIMEDATA FileTimeTime #else /* Unix and Cygwin. */ #define TIMEDATA TimeValTime #endif #ifdef HAVE_WINDOWS_H extern void addFiletimes(FILETIME *result, const FILETIME *x); extern void subFiletimes(FILETIME *result, const FILETIME *x); extern float filetimeToSeconds(const FILETIME *x); #endif #ifdef HAVE_SYS_TIME_H extern void addTimevals(struct timeval *result, const struct timeval *x); extern void subTimevals(struct timeval *result, const struct timeval *x); extern float timevalToSeconds(const struct timeval *x); #endif extern time_t getBuildTime(void); extern struct _entrypts timingEPT[]; #endif diff --git a/libpolyml/x86_dep.cpp b/libpolyml/x86_dep.cpp index 6aaed2d7..65b0632d 100644 --- a/libpolyml/x86_dep.cpp +++ b/libpolyml/x86_dep.cpp @@ -1,1462 +1,1462 @@ /* Title: Machine dependent code for i386 and X64 under Windows and Unix Copyright (c) 2000-7 Cambridge University Technical Services Limited Further work copyright David C. J. Matthews 2011-19 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDLIB_H #include #endif #include #ifdef HAVE_SIGNAL_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #if (defined(_WIN32)) #include #include #endif #include "globals.h" #include "run_time.h" #include "diagnostics.h" #include "processes.h" #include "profiling.h" #include "machine_dep.h" #include "scanaddrs.h" #include "memmgr.h" #include "rtsentry.h" #include "sys.h" // Temporary /********************************************************************** * * Register usage: * * %Reax: First argument to function. Result of function call. * %Rebx: Second argument to function. * %Recx: General register * %Redx: Closure pointer in call. * %Rebp: Points to memory used for extra registers * %Resi: General register. * %Redi: General register. * %Resp: Stack pointer. * The following apply only on the X64 * %R8: Third argument to function * %R9: Fourth argument to function * %R10: Fifth argument to function * %R11: General register * %R12: General register * %R13: General register * %R14: General register * %R15: Memory allocation pointer * **********************************************************************/ #ifdef HOSTARCHITECTURE_X86_64 struct fpSaveArea { double fpregister[7]; // Save area for xmm0-6 }; #else // Structure of floating point save area. // This is dictated by the hardware. typedef byte fpregister[10]; struct fpSaveArea { unsigned short cw; unsigned short _unused0; unsigned short sw; unsigned short _unused1; unsigned short tw; unsigned short _unused2; unsigned fip; unsigned short fcs0; unsigned short _unused3; unsigned foo; unsigned short fcs1; unsigned short _unused4; fpregister registers[8]; }; #endif /* the amount of ML stack space to reserve for registers, C exception handling etc. The compiler requires us to reserve 2 stack-frames worth (2 * 20 words). We actually reserve slightly more than this. */ #if (!defined(_WIN32) && !defined(HAVE_SIGALTSTACK)) // If we can't handle signals on a separate stack make sure there's space // on the Poly stack. #define OVERFLOW_STACK_SIZE (50+1024) #else #define OVERFLOW_STACK_SIZE 50 #endif union stackItem { /* #ifndef POLYML32IN64 stackItem(PolyWord v) { words[0] = v.AsUnsigned(); }; stackItem() { words[0] = TAGGED(0).AsUnsigned(); } POLYUNSIGNED words[1]; #else // In 32-in-64 we need to clear the second PolyWord. This assumes little-endian. stackItem(PolyWord v) { words[0] = v.AsUnsigned(); words[1] = 0; }; stackItem() { words[0] = TAGGED(0).AsUnsigned(); words[1] = 0; } POLYUNSIGNED words[2]; #endif */ stackItem(PolyWord v) { argValue = v.AsUnsigned(); } stackItem() { argValue = TAGGED(0).AsUnsigned(); } // These return the low order word. PolyWord w()const { return PolyWord::FromUnsigned((POLYUNSIGNED)argValue); } operator PolyWord () { return PolyWord::FromUnsigned((POLYUNSIGNED)argValue); } POLYCODEPTR codeAddr; // Return addresses stackItem *stackAddr; // Stack addresses uintptr_t argValue; // Treat an address as an int }; class X86TaskData; // This is passed as the argument vector to X86AsmSwitchToPoly. // The offsets are built into the assembly code and the code-generator. // localMpointer and stackPtr are updated before control returns to C. typedef struct _AssemblyArgs { public: PolyWord *localMpointer; // Allocation ptr + 1 word stackItem *handlerRegister; // Current exception handler PolyWord *localMbottom; // Base of memory + 1 word stackItem *stackLimit; // Lower limit of stack stackItem exceptionPacket; // Set if there is an exception byte unusedRequestCode; // No longer used. byte unusedFlag; // No longer used byte returnReason; // Reason for returning from ML. byte unusedRestore; // No longer used. uintptr_t saveCStack; // Saved C stack frame. PolyWord threadId; // My thread id. Saves having to call into RTS for it. stackItem *stackPtr; // Current stack pointer byte *noLongerUsed; // Now removed byte *heapOverFlowCall; // These are filled in with the functions. byte *stackOverFlowCall; byte *stackOverFlowCallEx; // Saved registers, where applicable. stackItem p_rax; stackItem p_rbx; stackItem p_rcx; stackItem p_rdx; stackItem p_rsi; stackItem p_rdi; #ifdef HOSTARCHITECTURE_X86_64 stackItem p_r8; stackItem p_r9; stackItem p_r10; stackItem p_r11; stackItem p_r12; stackItem p_r13; stackItem p_r14; #endif struct fpSaveArea p_fp; } AssemblyArgs; // These next few are temporarily added for the interpreter // This duplicates some code in reals.cpp but is now updated. #define DOUBLESIZE (sizeof(double)/sizeof(POLYUNSIGNED)) union realdb { double dble; POLYUNSIGNED puns[DOUBLESIZE]; }; #define LGWORDSIZE (sizeof(uintptr_t) / sizeof(PolyWord)) class X86TaskData: public TaskData { public: X86TaskData(); unsigned allocReg; // The register to take the allocated space. POLYUNSIGNED allocWords; // The words to allocate. Handle callBackResult; AssemblyArgs assemblyInterface; int saveRegisterMask; // Registers that need to be updated by a GC. virtual void GarbageCollect(ScanAddress *process); void ScanStackAddress(ScanAddress *process, stackItem &val, StackSpace *stack); virtual Handle EnterPolyCode(); // Start running ML virtual void InterruptCode(); virtual bool AddTimeProfileCount(SIGNALCONTEXT *context); virtual void InitStackFrame(TaskData *parentTask, Handle proc, Handle arg); virtual void SetException(poly_exn *exc); // Release a mutex in exactly the same way as compiler code virtual Handle AtomicIncrement(Handle mutexp); virtual void AtomicReset(Handle mutexp); // Return the minimum space occupied by the stack. Used when setting a limit. // N.B. This is PolyWords not native words. virtual uintptr_t currentStackSpace(void) const { return (this->stack->top - (PolyWord*)assemblyInterface.stackPtr) + OVERFLOW_STACK_SIZE*sizeof(uintptr_t)/sizeof(PolyWord); } // Increment the profile count for an allocation. Also now used for mutex contention. virtual void addProfileCount(POLYUNSIGNED words) { add_count(this, assemblyInterface.stackPtr[0].codeAddr, words); } // PreRTSCall: After calling from ML to the RTS we need to save the current heap pointer virtual void PreRTSCall(void) { TaskData::PreRTSCall(); SaveMemRegisters(); } // PostRTSCall: Before returning we need to restore the heap pointer. // If there has been a GC in the RTS call we need to create a new heap area. virtual void PostRTSCall(void) { SetMemRegisters(); TaskData::PostRTSCall(); } virtual void CopyStackFrame(StackObject *old_stack, uintptr_t old_length, StackObject *new_stack, uintptr_t new_length); virtual Handle EnterCallbackFunction(Handle func, Handle args); int SwitchToPoly(); void HeapOverflowTrap(byte *pcPtr); void SetMemRegisters(); void SaveMemRegisters(); void SetRegisterMask(); void MakeTrampoline(byte **pointer, byte*entryPt); PLock interruptLock; stackItem *get_reg(int n); stackItem *®SP() { return assemblyInterface.stackPtr; } stackItem ®AX() { return assemblyInterface.p_rax; } stackItem ®BX() { return assemblyInterface.p_rbx; } stackItem ®CX() { return assemblyInterface.p_rcx; } stackItem ®DX() { return assemblyInterface.p_rdx; } stackItem ®SI() { return assemblyInterface.p_rsi; } stackItem ®DI() { return assemblyInterface.p_rdi; } #ifdef HOSTARCHITECTURE_X86_64 stackItem ®8() { return assemblyInterface.p_r8; } stackItem ®9() { return assemblyInterface.p_r9; } stackItem ®10() { return assemblyInterface.p_r10; } stackItem ®11() { return assemblyInterface.p_r11; } stackItem ®12() { return assemblyInterface.p_r12; } stackItem ®13() { return assemblyInterface.p_r13; } stackItem ®14() { return assemblyInterface.p_r14; } #endif -#if (defined(_WIN32) && !defined(__CYGWIN__)) +#if (defined(_WIN32)) DWORD savedErrno; #else int savedErrno; #endif }; class X86Dependent: public MachineDependent { public: X86Dependent() {} // Create a task data object. virtual TaskData *CreateTaskData(void) { return new X86TaskData(); } // Initial size of stack in PolyWords virtual unsigned InitialStackSize(void) { return (128+OVERFLOW_STACK_SIZE) * sizeof(uintptr_t) / sizeof(PolyWord); } virtual void ScanConstantsWithinCode(PolyObject *addr, PolyObject *oldAddr, POLYUNSIGNED length, ScanAddress *process); virtual Architectures MachineArchitecture(void) #ifndef HOSTARCHITECTURE_X86_64 { return MA_I386; } #elif defined(POLYML32IN64) { return MA_X86_64_32; } #else { return MA_X86_64; } #endif }; // Values for the returnReason byte enum RETURN_REASON { RETURN_IO_CALL_NOW_UNUSED = 0, RETURN_HEAP_OVERFLOW = 1, RETURN_STACK_OVERFLOW = 2, RETURN_STACK_OVERFLOWEX = 3, RETURN_CALLBACK_RETURN = 6, RETURN_CALLBACK_EXCEPTION = 7, RETURN_KILL_SELF = 9 }; extern "C" { // These are declared in the assembly code segment. void X86AsmSwitchToPoly(void *); extern int X86AsmKillSelf(void); extern int X86AsmCallbackReturn(void); extern int X86AsmCallbackException(void); extern int X86AsmPopArgAndClosure(void); extern int X86AsmRaiseException(void); extern int X86AsmCallExtraRETURN_HEAP_OVERFLOW(void); extern int X86AsmCallExtraRETURN_STACK_OVERFLOW(void); extern int X86AsmCallExtraRETURN_STACK_OVERFLOWEX(void); POLYUNSIGNED X86AsmAtomicIncrement(PolyObject*); POLYUNSIGNED X86AsmAtomicDecrement(PolyObject*); }; // Pointers to assembly code or trampolines to assembly code. static byte *popArgAndClosure, *killSelf, *raiseException, *callbackException, *callbackReturn; X86TaskData::X86TaskData(): allocReg(0), allocWords(0), saveRegisterMask(0) { assemblyInterface.heapOverFlowCall = (byte*)X86AsmCallExtraRETURN_HEAP_OVERFLOW; assemblyInterface.stackOverFlowCall = (byte*)X86AsmCallExtraRETURN_STACK_OVERFLOW; assemblyInterface.stackOverFlowCallEx = (byte*)X86AsmCallExtraRETURN_STACK_OVERFLOWEX; savedErrno = 0; } void X86TaskData::GarbageCollect(ScanAddress *process) { TaskData::GarbageCollect(process); // Process the parent first assemblyInterface.threadId = threadObject; if (stack != 0) { // Now the values on the stack. for (stackItem *q = assemblyInterface.stackPtr; q < (stackItem*)stack->top; q++) ScanStackAddress(process, *q, stack); } // Register mask for (int i = 0; i < 16; i++) { if (saveRegisterMask & (1 << i)) ScanStackAddress(process, *get_reg(i), stack); } } // Process a value within the stack. void X86TaskData::ScanStackAddress(ScanAddress *process, stackItem &stackItem, StackSpace *stack) { // We may have return addresses on the stack which could look like // tagged values. Check whether the value is in the code area before // checking whether it is untagged. #ifdef POLYML32IN64 // In 32-in-64 return addresses always have the top 32 bits non-zero. if (stackItem.argValue < ((uintptr_t)1 << 32)) { // It's either a tagged integer or an object pointer. if (stackItem.w().IsDataPtr()) { PolyWord val = process->ScanObjectAddress(stackItem.w().AsObjPtr()); stackItem = val; } } else { // Could be a code address or a stack address. MemSpace *space = gMem.SpaceForAddress(stackItem.codeAddr - 1); if (space == 0 || space->spaceType != ST_CODE) return; PolyObject *obj = gMem.FindCodeObject(stackItem.codeAddr); ASSERT(obj != 0); // Process the address of the start. Don't update anything. process->ScanObjectAddress(obj); } #else // The -1 here is because we may have a zero-sized cell in the last // word of a space. MemSpace *space = gMem.SpaceForAddress(stackItem.codeAddr-1); if (space == 0) return; // In particular we may have one of the assembly code addresses. if (space->spaceType == ST_CODE) { PolyObject *obj = gMem.FindCodeObject(stackItem.codeAddr); // If it is actually an integer it might be outside a valid code object. if (obj == 0) { ASSERT(stackItem.w().IsTagged()); // It must be an integer } else // Process the address of the start. Don't update anything. process->ScanObjectAddress(obj); } else if (space->spaceType == ST_LOCAL && stackItem.w().IsDataPtr()) // Local values must be word addresses. { PolyWord val = process->ScanObjectAddress(stackItem.w().AsObjPtr()); stackItem = val; } #endif } // Copy a stack void X86TaskData::CopyStackFrame(StackObject *old_stack, uintptr_t old_length, StackObject *new_stack, uintptr_t new_length) { /* Moves a stack, updating all references within the stack */ #ifdef POLYML32IN64 old_length = old_length / 2; new_length = new_length / 2; #endif stackItem *old_base = (stackItem *)old_stack; stackItem *new_base = (stackItem*)new_stack; stackItem *old_top = old_base + old_length; /* Calculate the offset of the new stack from the old. If the frame is being extended objects in the new frame will be further up the stack than in the old one. */ uintptr_t offset = new_base - old_base + new_length - old_length; stackItem *oldStackPtr = assemblyInterface.stackPtr; // Adjust the stack pointer and handler pointer since these point into the stack. assemblyInterface.stackPtr = assemblyInterface.stackPtr + offset; assemblyInterface.handlerRegister = assemblyInterface.handlerRegister + offset; // We need to adjust any values on the stack that are pointers within the stack. // Skip the unused part of the stack. size_t i = oldStackPtr - old_base; ASSERT (i <= old_length); i = old_length - i; stackItem *old = oldStackPtr; stackItem *newp = assemblyInterface.stackPtr; while (i--) { stackItem old_word = *old++; if (old_word.w().IsDataPtr() && old_word.stackAddr >= old_base && old_word.stackAddr <= old_top) old_word.stackAddr = old_word.stackAddr + offset; else if (old_word.w().IsDataPtr() && IsHeapAddress(old_word.stackAddr)) { stackItem *addr = (stackItem*)old_word.w().AsStackAddr(); if (addr >= old_base && addr <= old_top) { addr += offset; old_word = PolyWord::FromStackAddr((PolyWord*)addr); } } *newp++ = old_word; } ASSERT(old == ((stackItem*)old_stack)+old_length); ASSERT(newp == ((stackItem*)new_stack)+new_length); // And change any registers that pointed into the old stack for (int j = 0; j < 16; j++) { if (saveRegisterMask & (1 << j)) { stackItem *regAddr = get_reg(j); stackItem old_word = *regAddr; if (old_word.w().IsDataPtr() && old_word.stackAddr >= old_base && old_word.stackAddr <= old_top) old_word.stackAddr = old_word.stackAddr + offset; else if (old_word.w().IsDataPtr() && IsHeapAddress(old_word.stackAddr)) { stackItem *addr = (stackItem*)old_word.w().AsStackAddr(); if (addr >= old_base && addr <= old_top) { addr += offset; old_word = PolyWord::FromStackAddr((PolyWord*)addr); } } *regAddr = old_word; } } } Handle X86TaskData::EnterPolyCode() /* Called from "main" to enter the code. */ { Handle hOriginal = this->saveVec.mark(); // Set this up for the IO calls. while (1) { this->saveVec.reset(hOriginal); // Remove old RTS arguments and results. // Run the ML code and return with the function to call. this->inML = true; int ioFunction = SwitchToPoly(); this->inML = false; try { switch (ioFunction) { case -1: // We've been interrupted. This usually involves simulating a // stack overflow so we could come here because of a genuine // stack overflow. // Previously this code was executed on every RTS call but there // were problems on Mac OS X at least with contention on schedLock. // Process any asynchronous events i.e. interrupts or kill processes->ProcessAsynchRequests(this); // Release and re-acquire use of the ML memory to allow another thread // to GC. processes->ThreadReleaseMLMemory(this); processes->ThreadUseMLMemory(this); break; case -2: // A callback has returned. return callBackResult; // Return the saved value. Not used in the new interface. default: Crash("Unknown io operation %d\n", ioFunction); } } catch (IOException &) { } } } // Run the current ML process. X86AsmSwitchToPoly saves the C state so that // whenever the ML requires assistance from the rest of the RTS it simply // returns to C with the appropriate values set in assemblyInterface.requestCode and // int X86TaskData::SwitchToPoly() // (Re)-enter the Poly code from C. Returns with the io function to call or // -1 if we are responding to an interrupt. { Handle mark = this->saveVec.mark(); do { this->saveVec.reset(mark); // Remove old data e.g. from arbitrary precision. SetMemRegisters(); // We need to save the C stack entry across this call in case // we're making a callback and the previous C stack entry is // for the original call. uintptr_t savedCStack = this->assemblyInterface.saveCStack; // Restore the saved error state. -#if (defined(_WIN32) && !defined(__CYGWIN__)) +#if (defined(_WIN32)) SetLastError(savedErrno); #else errno = savedErrno; #endif // Enter the ML code. X86AsmSwitchToPoly(&this->assemblyInterface); this->assemblyInterface.saveCStack = savedCStack; // Save the error codes. We may have made an RTS/FFI call that // has set these and we don't want to do anything to change them. -#if (defined(_WIN32) && !defined(__CYGWIN__)) +#if (defined(_WIN32)) savedErrno = GetLastError(); #else savedErrno = errno; #endif SaveMemRegisters(); // Update globals from the memory registers. // Handle any heap/stack overflows or arbitrary precision traps. switch (this->assemblyInterface.returnReason) { case RETURN_HEAP_OVERFLOW: // The heap has overflowed. SetRegisterMask(); this->HeapOverflowTrap(assemblyInterface.stackPtr[0].codeAddr); // Computes a value for allocWords only break; case RETURN_STACK_OVERFLOW: case RETURN_STACK_OVERFLOWEX: { SetRegisterMask(); uintptr_t min_size; // Size in PolyWords if (assemblyInterface.returnReason == RETURN_STACK_OVERFLOW) { min_size = (this->stack->top - (PolyWord*)assemblyInterface.stackPtr) + OVERFLOW_STACK_SIZE * sizeof(uintptr_t) / sizeof(PolyWord); } else { // Stack limit overflow. If the required stack space is larger than // the fixed overflow size the code will calculate the limit in %EDI. stackItem *stackP = regDI().stackAddr; min_size = (this->stack->top - (PolyWord*)stackP) + OVERFLOW_STACK_SIZE * sizeof(uintptr_t) / sizeof(PolyWord); } try { // The stack check has failed. This may either be because we really have // overflowed the stack or because the stack limit value has been adjusted // to result in a call here. CheckAndGrowStack(this, min_size); } catch (IOException &) { // We may get an exception while handling this if we run out of store } { PLocker l(&interruptLock); // Set the stack limit. This clears any interrupt and also sets the // correct value if we've grown the stack. this->assemblyInterface.stackLimit = (stackItem*)this->stack->bottom + OVERFLOW_STACK_SIZE; } return -1; // We're in a safe state to handle any interrupts. } case RETURN_CALLBACK_RETURN: // regSP has been set by the assembly code. N.B. This may not be the same value as when // EnterCallbackFunction was called because the callback may have grown and moved the stack. // Remove the extra exception handler we created in EnterCallbackFunction ASSERT(assemblyInterface.handlerRegister == regSP()); regSP() += 1; assemblyInterface.handlerRegister = (*(regSP()++)).stackAddr; // Restore the previous handler. this->callBackResult = this->saveVec.push(regAX()); // Argument to return is in RAX. return -2; case RETURN_CALLBACK_EXCEPTION: // An ML callback has raised an exception. // It isn't possible to do anything here except abort. Crash("An ML function called from foreign code raised an exception. Unable to continue."); case RETURN_KILL_SELF: exitThread(this); default: Crash("Unknown return reason code %u", this->assemblyInterface.returnReason); } } while (1); } void X86TaskData::MakeTrampoline(byte **pointer, byte *entryPt) { #ifdef POLYML32IN64 // In the native address versions we can store the address directly onto the stack. // We can't do that in 32-in-64 because it's likely that the address will be in the // bottom 32-bits and we can't distinguish it from an object ID. Instead we have to // build a small code segment which jumps to the code. unsigned requiredSize = 8; // 8 words i.e. 32 bytes PolyObject *result = gMem.AllocCodeSpace(requiredSize); byte *p = (byte*)result; *p++ = 0x48; // rex.w *p++ = 0x8b; // Movl *p++ = 0x0d; // rcx, pc relative *p++ = 0x09; // +2 bytes *p++ = 0x00; *p++ = 0x00; *p++ = 0x00; *p++ = 0xff; // jmp *p++ = 0xe1; // rcx *p++ = 0xf4; // hlt - needed to stop scan of constants for (unsigned i = 0; i < 6; i++) *p++ = 0; uintptr_t ep = (uintptr_t)entryPt; for (unsigned i = 0; i < 8; i++) { *p++ = ep & 0xff; ep >>= 8; } // Clear the remainder. In particular this sets the number // of address constants to zero. for (unsigned i = 0; i < 8; i++) *p++ = 0; result->SetLengthWord(requiredSize, F_CODE_OBJ); *pointer = (byte*)result; #else *pointer = entryPt; // Can go there directly #endif } void X86TaskData::InitStackFrame(TaskData *parentTaskData, Handle proc, Handle arg) /* Initialise stack frame. */ { // Set the assembly code addresses. if (popArgAndClosure == 0) MakeTrampoline(&popArgAndClosure, (byte*)&X86AsmPopArgAndClosure); if (killSelf == 0) MakeTrampoline(&killSelf, (byte*)&X86AsmKillSelf); if (raiseException == 0) MakeTrampoline(&raiseException, (byte*)&X86AsmRaiseException); if (callbackException == 0) MakeTrampoline(&callbackException, (byte*)&X86AsmCallbackException); if (callbackReturn == 0) MakeTrampoline(&callbackReturn, (byte*)&X86AsmCallbackReturn); StackSpace *space = this->stack; StackObject * newStack = space->stack(); uintptr_t stack_size = space->spaceSize() * sizeof(PolyWord) / sizeof(stackItem); uintptr_t topStack = stack_size-6; stackItem *stackTop = (stackItem*)newStack + topStack; assemblyInterface.stackPtr = stackTop; assemblyInterface.stackLimit = (stackItem*)space->bottom + OVERFLOW_STACK_SIZE; assemblyInterface.handlerRegister = (stackItem*)newStack+topStack+4; // Floating point save area. memset(&assemblyInterface.p_fp, 0, sizeof(struct fpSaveArea)); #ifndef HOSTARCHITECTURE_X86_64 // Set the control word for 64-bit precision otherwise we get inconsistent results. assemblyInterface.p_fp.cw = 0x027f ; // Control word assemblyInterface.p_fp.tw = 0xffff; // Tag registers - all unused #endif // Initial entry point - on the stack. stackTop[0].codeAddr = popArgAndClosure; // Push the argument and the closure on the stack. We can't put them into the registers // yet because we might get a GC before we actually start the code. stackTop[1] = proc->Word(); // Closure stackTop[2] = (arg == 0) ? TAGGED(0) : DEREFWORD(arg); // Argument /* We initialise the end of the stack with a sequence that will jump to kill_self whether the process ends with a normal return or by raising an exception. A bit of this was added to fix a bug when stacks were objects on the heap and could be scanned by the GC. */ stackTop[5] = TAGGED(0); // Probably no longer needed // Set the default handler and return address to point to this code. // PolyWord killJump(PolyWord::FromCodePtr((byte*)&X86AsmKillSelf)); // Exception handler. stackTop[4].codeAddr = killSelf; // Normal return address. We need a separate entry on the stack from // the exception handler because it is possible that the code we are entering // may replace this entry with an argument. The code-generator optimises tail-recursive // calls to functions with more args than the called function. stackTop[3].codeAddr = killSelf; #ifdef POLYML32IN64 // In 32-in-64 RBX always contains the heap base address. assemblyInterface.p_rbx.stackAddr = (stackItem*)globalHeapBase; #endif } // In Solaris-x86 the registers are named EIP and ESP. #if (!defined(REG_EIP) && defined(EIP)) #define REG_EIP EIP #endif #if (!defined(REG_ESP) && defined(ESP)) #define REG_ESP ESP #endif // Get the PC and SP(stack) from a signal context. This is needed for profiling. // This version gets the actual sp and pc if we are in ML. bool X86TaskData::AddTimeProfileCount(SIGNALCONTEXT *context) { stackItem * sp = 0; POLYCODEPTR pc = 0; if (context != 0) { // The tests for HAVE_UCONTEXT_T, HAVE_STRUCT_SIGCONTEXT and HAVE_WINDOWS_H need // to follow the tests in processes.h. #if defined(HAVE_WINDOWS_H) #ifdef _WIN64 sp = (stackItem *)context->Rsp; pc = (POLYCODEPTR)context->Rip; #else // Windows 32 including cygwin. sp = (stackItem *)context->Esp; pc = (POLYCODEPTR)context->Eip; #endif #elif defined(HAVE_UCONTEXT_T) #ifdef HAVE_MCONTEXT_T_GREGS // Linux #ifndef HOSTARCHITECTURE_X86_64 pc = (byte*)context->uc_mcontext.gregs[REG_EIP]; sp = (stackItem*)context->uc_mcontext.gregs[REG_ESP]; #else /* HOSTARCHITECTURE_X86_64 */ pc = (byte*)context->uc_mcontext.gregs[REG_RIP]; sp = (stackItem*)context->uc_mcontext.gregs[REG_RSP]; #endif /* HOSTARCHITECTURE_X86_64 */ #elif defined(HAVE_MCONTEXT_T_MC_ESP) // FreeBSD #ifndef HOSTARCHITECTURE_X86_64 pc = (byte*)context->uc_mcontext.mc_eip; sp = (stackItem*)context->uc_mcontext.mc_esp; #else /* HOSTARCHITECTURE_X86_64 */ pc = (byte*)context->uc_mcontext.mc_rip; sp = (stackItem*)context->uc_mcontext.mc_rsp; #endif /* HOSTARCHITECTURE_X86_64 */ #else // Mac OS X #ifndef HOSTARCHITECTURE_X86_64 #if(defined(HAVE_STRUCT_MCONTEXT_SS)||defined(HAVE_STRUCT___DARWIN_MCONTEXT32_SS)) pc = (byte*)context->uc_mcontext->ss.eip; sp = (PolyWord*)context->uc_mcontext->ss.esp; #elif(defined(HAVE_STRUCT___DARWIN_MCONTEXT32___SS)) pc = (byte*)context->uc_mcontext->__ss.__eip; sp = (PolyWord*)context->uc_mcontext->__ss.__esp; #endif #else /* HOSTARCHITECTURE_X86_64 */ #if(defined(HAVE_STRUCT_MCONTEXT_SS)||defined(HAVE_STRUCT___DARWIN_MCONTEXT64_SS)) pc = (byte*)context->uc_mcontext->ss.rip; sp = (PolyWord*)context->uc_mcontext->ss.rsp; #elif(defined(HAVE_STRUCT___DARWIN_MCONTEXT64___SS)) pc = (byte*)context->uc_mcontext->__ss.__rip; sp = (PolyWord*)context->uc_mcontext->__ss.__rsp; #endif #endif /* HOSTARCHITECTURE_X86_64 */ #endif #elif defined(HAVE_STRUCT_SIGCONTEXT) #if defined(HOSTARCHITECTURE_X86_64) && defined(__OpenBSD__) // CPP defines missing in amd64/signal.h in OpenBSD pc = (byte*)context->sc_rip; sp = (PolyWord*)context->sc_rsp; #else // !HOSTARCHITEXTURE_X86_64 || !defined(__OpenBSD__) pc = (byte*)context->sc_pc; sp = (PolyWord*)context->sc_sp; #endif #endif } if (pc != 0) { // See if the PC we've got is an ML code address. MemSpace *space = gMem.SpaceForAddress(pc); if (space != 0 && (space->spaceType == ST_CODE || space->spaceType == ST_PERMANENT)) { add_count(this, pc, 1); return true; } } // See if the sp value is in the current stack. if (sp >= (stackItem*)this->stack->bottom && sp < (stackItem*)this->stack->top) { // We may be in the assembly code. The top of the stack will be a return address. pc = sp[0].w().AsCodePtr(); MemSpace *space = gMem.SpaceForAddress(pc); if (space != 0 && (space->spaceType == ST_CODE || space->spaceType == ST_PERMANENT)) { add_count(this, pc, 1); return true; } } // See if the value of regSP is a valid stack pointer. // This works if we happen to be in an RTS call using a "Full" call. // It doesn't work if we've used a "Fast" call because that doesn't save the SP. sp = assemblyInterface.stackPtr; if (sp >= (stackItem*)this->stack->bottom && sp < (stackItem*)this->stack->top) { // We may be in the run-time system. pc = sp[0].w().AsCodePtr(); MemSpace *space = gMem.SpaceForAddress(pc); if (space != 0 && (space->spaceType == ST_CODE || space->spaceType == ST_PERMANENT)) { add_count(this, pc, 1); return true; } } // None of those worked return false; } // This is called from a different thread so we have to be careful. void X86TaskData::InterruptCode() { PLocker l(&interruptLock); // Set the stack limit pointer to the top of the stack to cause // a trap when we next check for stack overflow. // We use a lock here to ensure that we always use the current value of the // stack. The thread we're interrupting could be growing the stack at this point. if (this->stack != 0) this->assemblyInterface.stackLimit = (stackItem*)(this->stack->top-1); } // This is called from SwitchToPoly before we enter the ML code. void X86TaskData::SetMemRegisters() { // Copy the current store limits into variables before we go into the assembly code. // If we haven't yet set the allocation area or we don't have enough we need // to create one (or a new one). if (this->allocPointer <= this->allocLimit + this->allocWords) { if (this->allocPointer < this->allocLimit) Crash ("Bad length in heap overflow trap"); // Find some space to allocate in. Updates taskData->allocPointer and // returns a pointer to the newly allocated space (if allocWords != 0) PolyWord *space = processes->FindAllocationSpace(this, this->allocWords, true); if (space == 0) { // We will now raise an exception instead of returning. // Set allocWords to zero so we don't set the allocation register // since that could be holding the exception packet. this->allocWords = 0; } // Undo the allocation just now. this->allocPointer += this->allocWords; } if (this->allocWords != 0) { // If we have had a heap trap we actually do the allocation here. // We will have already garbage collected and recovered sufficient space. // This also happens if we have just trapped because of store profiling. this->allocPointer -= this->allocWords; // Now allocate // Set the allocation register to this area. N.B. This is an absolute address. if (this->allocReg < 15) get_reg(this->allocReg)[0].codeAddr = (POLYCODEPTR)(this->allocPointer + 1); /* remember: it's off-by-one */ this->allocWords = 0; } // If we have run out of store, either just above or while allocating in the RTS, // allocPointer and allocLimit will have been set to zero as part of the GC. We will // now be raising an exception which may free some store but we need to come back here // before we allocate anything. The compiled code uses unsigned arithmetic to check for // heap overflow but only after subtracting the space required. We need to make sure // that the values are still non-negative after substracting any object size. if (this->allocPointer == 0) this->allocPointer += MAX_OBJECT_SIZE; if (this->allocLimit == 0) this->allocLimit += MAX_OBJECT_SIZE; this->assemblyInterface.localMbottom = this->allocLimit + 1; this->assemblyInterface.localMpointer = this->allocPointer + 1; // If we are profiling store allocation we set mem_hl so that a trap // will be generated. if (profileMode == kProfileStoreAllocation) this->assemblyInterface.localMbottom = this->assemblyInterface.localMpointer; this->assemblyInterface.returnReason = RETURN_IO_CALL_NOW_UNUSED; this->assemblyInterface.threadId = this->threadObject; } // This is called whenever we have returned from ML to C. void X86TaskData::SaveMemRegisters() { this->allocPointer = this->assemblyInterface.localMpointer - 1; this->allocWords = 0; this->assemblyInterface.exceptionPacket = TAGGED(0); this->saveRegisterMask = 0; } // Called on a GC or stack overflow trap. The register mask // is in the bytes after the trap call. void X86TaskData::SetRegisterMask() { byte *pc = assemblyInterface.stackPtr[0].codeAddr; if (*pc == 0xcd) // CD - INT n is used for a single byte { pc++; saveRegisterMask = *pc++; } else if (*pc == 0xca) // CA - FAR RETURN is used for a two byte mask { pc++; saveRegisterMask = pc[0] | (pc[1] << 8); pc += 2; } assemblyInterface.stackPtr[0].codeAddr = pc; } stackItem *X86TaskData::get_reg(int n) /* Returns a pointer to the register given by n. */ { switch (n) { case 0: return &assemblyInterface.p_rax; case 1: return &assemblyInterface.p_rcx; case 2: return &assemblyInterface.p_rdx; case 3: return &assemblyInterface.p_rbx; // Should not have rsp or rbp. case 6: return &assemblyInterface.p_rsi; case 7: return &assemblyInterface.p_rdi; #ifdef HOSTARCHITECTURE_X86_64 case 8: return &assemblyInterface.p_r8; case 9: return &assemblyInterface.p_r9; case 10: return &assemblyInterface.p_r10; case 11: return &assemblyInterface.p_r11; case 12: return &assemblyInterface.p_r12; case 13: return &assemblyInterface.p_r13; case 14: return &assemblyInterface.p_r14; // R15 is the heap pointer so shouldn't occur here. #endif /* HOSTARCHITECTURE_X86_64 */ default: Crash("Unknown register %d\n", n); } } // Called as a result of a heap overflow trap void X86TaskData::HeapOverflowTrap(byte *pcPtr) { X86TaskData *mdTask = this; POLYUNSIGNED wordsNeeded = 0; // The next instruction, after any branches round forwarding pointers or pop // instructions, will be a store of register containing the adjusted heap pointer. // We need to find that register and the value in it in order to find out how big // the area we actually wanted is. N.B. The code-generator and assembly code // must generate the correct instruction sequence. // byte *pcPtr = assemblyInterface.programCtr; while (true) { if (pcPtr[0] == 0xeb) { // Forwarding pointer if (pcPtr[1] >= 128) pcPtr += 256 - pcPtr[1] + 2; else pcPtr += pcPtr[1] + 2; } else if ((pcPtr[0] & 0xf8) == 0x58) // Pop instruction. pcPtr++; else if (pcPtr[0] == 0x41 && ((pcPtr[1] & 0xf8) == 0x58)) // Pop with Rex prefix pcPtr += 2; else break; } #ifndef HOSTARCHITECTURE_X86_64 // This should be movl REG,0[%ebp]. ASSERT(pcPtr[0] == 0x89); mdTask->allocReg = (pcPtr[1] >> 3) & 7; // Remember this until we allocate the memory stackItem *reg = get_reg(mdTask->allocReg); stackItem reg_val = *reg; // The space we need is the difference between this register // and the current value of newptr. // The +1 here is because assemblyInterface.localMpointer is A.M.pointer +1. The reason // is that after the allocation we have the register pointing at the address we will // actually use. wordsNeeded = (this->allocPointer - (PolyWord*)reg_val.stackAddr) + 1; *reg = TAGGED(0); // Clear this - it's not a valid address. /* length in words, including length word */ ASSERT (wordsNeeded <= (1<<24)); /* Max object size including length/flag word is 2^24 words. */ #else /* HOSTARCHITECTURE_X86_64 */ ASSERT(pcPtr[1] == 0x89 || pcPtr[1] == 0x8b); if (pcPtr[1] == 0x89) { // New (5.4) format. This should be movq REG,%r15 ASSERT(pcPtr[0] == 0x49 || pcPtr[0] == 0x4d); mdTask->allocReg = (pcPtr[2] >> 3) & 7; // Remember this until we allocate the memory if (pcPtr[0] & 0x4) mdTask->allocReg += 8; } else { // Alternative form of movq REG,%r15 ASSERT(pcPtr[0] == 0x4c || pcPtr[0] == 0x4d); mdTask->allocReg = pcPtr[2] & 7; // Remember this until we allocate the memory if (pcPtr[0] & 0x1) mdTask->allocReg += 8; } stackItem *reg = get_reg(this->allocReg); stackItem reg_val = *reg; wordsNeeded = (POLYUNSIGNED)((this->allocPointer - (PolyWord*)reg_val.stackAddr) + 1); *reg = TAGGED(0); // Clear this - it's not a valid address. #endif /* HOSTARCHITECTURE_X86_64 */ if (profileMode == kProfileStoreAllocation) addProfileCount(wordsNeeded); mdTask->allocWords = wordsNeeded; // The actual allocation is done in SetMemRegisters. } void X86TaskData::SetException(poly_exn *exc) // Set up the stack to raise an exception. { // Do we need to set the PC value any longer? It may be necessary if // we have taken a trap because another thread has sent a broadcast interrupt. (--assemblyInterface.stackPtr)->codeAddr = raiseException; regAX() = (PolyWord)exc; /* put exception data into eax */ assemblyInterface.exceptionPacket = (PolyWord)exc; // Set for direct calls. } // Sets up a callback function on the current stack. The present state is that // the ML code has made a call in to foreign_dispatch. We need to set the stack // up so that we will enter the callback (as with CallCodeTupled) but when we return // the result we enter callback_return. Handle X86TaskData::EnterCallbackFunction(Handle func, Handle args) { // If we ever implement a light version of the FFI that allows a call to C // code without saving enough to allow allocation in C code we need to ensure // that this code doesn't do any allocation. Essentially we need the values // in localMpointer and localMbottom to be valid across a call to C. If we do // a callback the ML callback function would pick up the values saved in the // originating call. // However, it is essential that the light version still saves the stack pointer // and reloads it afterwards. // Set up an exception handler so we will enter callBackException if there is an exception. (--regSP())->stackAddr = assemblyInterface.handlerRegister; // Create a special handler entry (--regSP())->codeAddr = callbackException; assemblyInterface.handlerRegister = regSP(); // Push the call to callBackReturn onto the stack as the return address. (--regSP())->codeAddr = callbackReturn; // Set up the entry point of the callback. PolyObject *functToCall = func->WordP(); regDX() = (PolyWord)functToCall; // Closure address regAX() = args->Word(); // Push entry point address (--regSP())->codeAddr = *(POLYCODEPTR*)functToCall; // First word of closure is entry pt. return EnterPolyCode(); } // Decode and process an effective address. There may // be a constant address in here but in any case we need // to decode it to work out where the next instruction starts. // If this is an lea instruction any addresses are just constants // so must not be treated as addresses. static void skipea(PolyObject *base, byte **pt, ScanAddress *process, bool lea) { unsigned int modrm = *((*pt)++); unsigned int md = modrm >> 6; unsigned int rm = modrm & 7; if (md == 3) { } /* Register. */ else if (rm == 4) { /* s-i-b present. */ unsigned int sib = *((*pt)++); if (md == 0) { if ((sib & 7) == 5) { if (! lea) { #ifndef HOSTARCHITECTURE_X86_64 process->ScanConstant(base, *pt, PROCESS_RELOC_DIRECT); #endif /* HOSTARCHITECTURE_X86_64 */ } (*pt) += 4; } } else if (md == 1) (*pt)++; else if (md == 2) (*pt) += 4; } else if (md == 0 && rm == 5) { if (!lea) { #ifndef HOSTARCHITECTURE_X86_64 /* Absolute address. */ process->ScanConstant(base, *pt, PROCESS_RELOC_DIRECT); #endif /* HOSTARCHITECTURE_X86_64 */ } *pt += 4; } else { if (md == 1) *pt += 1; else if (md == 2) *pt += 4; } } /* Added to deal with constants within the code rather than in the constant area. The constant area is still needed for the function name. DCJM 2/1/2001 */ void X86Dependent::ScanConstantsWithinCode(PolyObject *addr, PolyObject *old, POLYUNSIGNED length, ScanAddress *process) { byte *pt = (byte*)addr; PolyWord *end = addr->Offset(length - 1); #ifdef POLYML32IN64 // If this begins with enter-int it's interpreted code - ignore if (pt[0] == 0xff && pt[1] == 0x55 && pt[2] == 0x48) return; #endif while (true) { // Escape prefixes come before any Rex byte if (*pt == 0xf2 || *pt == 0xf3 || *pt == 0x66) pt++; #ifdef HOSTARCHITECTURE_X86_64 // REX prefixes. Set this first. byte lastRex; if (*pt >= 0x40 && *pt <= 0x4f) lastRex = *pt++; else lastRex = 0; //printf("pt=%p *pt=%x\n", pt, *pt); #endif /* HOSTARCHITECTURE_X86_64 */ switch (*pt) { case 0x00: return; // This is actually the first byte of the old "marker" word. case 0xf4: return; // Halt - now used as a marker. case 0x50: case 0x51: case 0x52: case 0x53: case 0x54: case 0x55: case 0x56: case 0x57: /* Push */ case 0x58: case 0x59: case 0x5a: case 0x5b: case 0x5c: case 0x5d: case 0x5e: case 0x5f: /* Pop */ case 0x90: /* nop */ case 0xc3: /* ret */ case 0xf9: /* stc */ case 0xce: /* into */ case 0xf0: /* lock. */ case 0xf3: /* rep/repe */ case 0xa4: case 0xa5: case 0xaa: case 0xab: /* movs/stos */ case 0xa6: /* cmpsb */ case 0x9e: /* sahf */ case 0x99: /* cqo/cdq */ pt++; break; case 0x70: case 0x71: case 0x72: case 0x73: case 0x74: case 0x75: case 0x76: case 0x77: case 0x78: case 0x79: case 0x7a: case 0x7b: case 0x7c: case 0x7d: case 0x7e: case 0x7f: case 0xeb: /* short jumps. */ case 0xcd: /* INT - now used for a register mask */ case 0xa8: /* TEST_ACC8 */ case 0x6a: /* PUSH_8 */ pt += 2; break; case 0xc2: /* RET_16 */ case 0xca: /* FAR RET 16 - used for a register mask */ pt += 3; break; case 0x8d: /* leal. */ pt++; skipea(addr, &pt, process, true); break; case 0x03: case 0x0b: case 0x13: case 0x1b: case 0x23: case 0x2b: case 0x33: case 0x3b: /* Add r,ea etc. */ case 0x88: /* MOVB_R_A */ case 0x89: /* MOVL_R_A */ case 0x8b: /* MOVL_A_R */ case 0x62: /* BOUNDL */ case 0xff: /* Group5 */ case 0xd1: /* Group2_1_A */ case 0x8f: /* POP_A */ case 0xd3: /* Group2_CL_A */ case 0x87: // XCHNG case 0x63: // MOVSXD pt++; skipea(addr, &pt, process, false); break; case 0xf6: /* Group3_a */ { int isTest = 0; pt++; /* The test instruction has an immediate operand. */ if ((*pt & 0x38) == 0) isTest = 1; skipea(addr, &pt, process, false); if (isTest) pt++; break; } case 0xf7: /* Group3_A */ { int isTest = 0; pt++; /* The test instruction has an immediate operand. */ if ((*pt & 0x38) == 0) isTest = 1; skipea(addr, &pt, process, false); if (isTest) pt += 4; break; } case 0xc1: /* Group2_8_A */ case 0xc6: /* MOVB_8_A */ case 0x83: /* Group1_8_A */ case 0x80: /* Group1_8_a */ case 0x6b: // IMUL Ev,Ib pt++; skipea(addr, &pt, process, false); pt++; break; case 0x69: // IMUL Ev,Iv pt++; skipea(addr, &pt, process, false); pt += 4; break; case 0x81: /* Group1_32_A */ { pt ++; #ifndef HOSTARCHITECTURE_X86_64 unsigned opCode = *pt; #endif skipea(addr, &pt, process, false); // Only check the 32 bit constant if this is a comparison. // For other operations this may be untagged and shouldn't be an address. #ifndef HOSTARCHITECTURE_X86_64 if ((opCode & 0x38) == 0x38) process->ScanConstant(addr, pt, PROCESS_RELOC_DIRECT); #endif pt += 4; break; } case 0xe8: case 0xe9: // Long jump and call. These are used to call constant (known) functions // and also long jumps within the function. { pt++; POLYSIGNED disp = (pt[3] & 0x80) ? -1 : 0; // Set the sign just in case. for(unsigned i = 4; i > 0; i--) disp = (disp << 8) | pt[i-1]; byte *absAddr = pt + disp + 4; // The address is relative to AFTER the constant // If the new address is within the current piece of code we don't do anything if (absAddr >= (byte*)addr && absAddr < (byte*)end) {} else { #ifdef HOSTARCHITECTURE_X86_64 ASSERT(sizeof(PolyWord) == 4); // Should only be used internally on x64 #endif /* HOSTARCHITECTURE_X86_64 */ if (addr != old) { // The old value of the displacement was relative to the old address before // we copied this code segment. // We have to correct it back to the original address. absAddr = absAddr - (byte*)addr + (byte*)old; // We have to correct the displacement for the new location and store // that away before we call ScanConstant. size_t newDisp = absAddr - pt - 4; for (unsigned i = 0; i < 4; i++) { pt[i] = (byte)(newDisp & 0xff); newDisp >>= 8; } } process->ScanConstant(addr, pt, PROCESS_RELOC_I386RELATIVE); } pt += 4; break; } case 0xc7:/* MOVL_32_A */ { pt++; if ((*pt & 0xc0) == 0x40 /* Byte offset or sib present */ && ((*pt & 7) != 4) /* But not sib present */ && pt[1] == 256-sizeof(PolyWord)) { /* We may use a move instruction to set the length word on a new segment. We mustn't try to treat this as a constant. */ pt += 6; /* Skip the modrm byte, the offset and the constant. */ } else { skipea(addr, &pt, process, false); #ifndef HOSTARCHITECTURE_X86_64 // This isn't used for addresses even in 32-in-64 process->ScanConstant(addr, pt, PROCESS_RELOC_DIRECT); #endif /* HOSTARCHITECTURE_X86_64 */ pt += 4; } break; } case 0xb8: case 0xb9: case 0xba: case 0xbb: case 0xbc: case 0xbd: case 0xbe: case 0xbf: /* MOVL_32_64_R */ pt ++; #ifdef HOSTARCHITECTURE_X86_64 if ((lastRex & 8) == 0) pt += 4; // 32-bit mode on 64-bits else #endif /* HOSTARCHITECTURE_X86_64 */ { // This is no longer generated in 64-bit mode but needs to // be retained in native 64-bit for backwards compatibility. #ifndef POLYML32IN64 // 32 bits in 32-bit mode, 64-bits in 64-bit mode. process->ScanConstant(addr, pt, PROCESS_RELOC_DIRECT); #endif pt += sizeof(PolyWord); } break; case 0x68: /* PUSH_32 */ pt ++; #if (!defined(HOSTARCHITECTURE_X86_64) || defined(POLYML32IN64)) // Currently the only inline constant in 32-in-64. process->ScanConstant(addr, pt, PROCESS_RELOC_DIRECT); #endif pt += 4; break; case 0x0f: /* ESCAPE */ { pt++; switch (*pt) { case 0xb6: /* movzl */ case 0xb7: // movzw case 0xc1: /* xaddl */ case 0xae: // ldmxcsr/stmxcsr case 0xaf: // imul case 0x40: case 0x41: case 0x42: case 0x43: case 0x44: case 0x45: case 0x46: case 0x47: case 0x48: case 0x49: case 0x4a: case 0x4b: case 0x4c: case 0x4d: case 0x4e: case 0x4f: // cmov pt++; skipea(addr, &pt, process, false); break; case 0x80: case 0x81: case 0x82: case 0x83: case 0x84: case 0x85: case 0x86: case 0x87: case 0x88: case 0x89: case 0x8a: case 0x8b: case 0x8c: case 0x8d: case 0x8e: case 0x8f: /* Conditional branches with 32-bit displacement. */ pt += 5; break; case 0x90: case 0x91: case 0x92: case 0x93: case 0x94: case 0x95: case 0x96: case 0x97: case 0x98: case 0x99: case 0x9a: case 0x9b: case 0x9c: case 0x9d: case 0x9e: case 0x9f: /* SetCC. */ pt++; skipea(addr, &pt, process, false); break; // These are SSE2 instructions case 0x10: case 0x11: case 0x58: case 0x5c: case 0x59: case 0x5e: case 0x2e: case 0x2a: case 0x54: case 0x57: case 0x5a: case 0x6e: case 0x7e: case 0x2c: case 0x2d: pt++; skipea(addr, &pt, process, false); break; case 0x73: // PSRLDQ - EA,imm pt++; skipea(addr, &pt, process, false); pt++; break; default: Crash("Unknown opcode %d at %p\n", *pt, pt); } break; } case 0xd8: case 0xd9: case 0xda: case 0xdb: case 0xdc: case 0xdd: case 0xde: case 0xdf: // Floating point escape instructions { pt++; if ((*pt & 0xe0) == 0xe0) pt++; else skipea(addr, &pt, process, false); break; } default: Crash("Unknown opcode %d at %p\n", *pt, pt); } } } // Increment the value contained in the first word of the mutex. Handle X86TaskData::AtomicIncrement(Handle mutexp) { PolyObject *p = DEREFHANDLE(mutexp); POLYUNSIGNED result = X86AsmAtomicIncrement(p); return this->saveVec.push(PolyWord::FromUnsigned(result)); } // Release a mutex. Because the atomic increment and decrement // use the hardware LOCK prefix we can simply set this to one. void X86TaskData::AtomicReset(Handle mutexp) { DEREFHANDLE(mutexp)->Set(0, TAGGED(1)); } static X86Dependent x86Dependent; MachineDependent *machineDependent = &x86Dependent; class X86Module : public RtsModule { public: virtual void GarbageCollect(ScanAddress * /*process*/); }; // Declare this. It will be automatically added to the table. static X86Module x86Module; void X86Module::GarbageCollect(ScanAddress *process) { #ifdef POLYML32IN64 // These are trampolines in the code area rather than direct calls. if (popArgAndClosure != 0) process->ScanRuntimeAddress((PolyObject**)&popArgAndClosure, ScanAddress::STRENGTH_STRONG); if (killSelf != 0) process->ScanRuntimeAddress((PolyObject**)&killSelf, ScanAddress::STRENGTH_STRONG); if (raiseException != 0) process->ScanRuntimeAddress((PolyObject**)&raiseException, ScanAddress::STRENGTH_STRONG); if (callbackException != 0) process->ScanRuntimeAddress((PolyObject**)&callbackException, ScanAddress::STRENGTH_STRONG); if (callbackReturn != 0) process->ScanRuntimeAddress((PolyObject**)&callbackReturn, ScanAddress::STRENGTH_STRONG); #endif } \ No newline at end of file diff --git a/polyexports.h b/polyexports.h index 11944504..526f4d6a 100644 --- a/polyexports.h +++ b/polyexports.h @@ -1,114 +1,114 @@ /* Title: polyexports.h - Copyright (c) 2006, 2011, 2015 David C.J. Matthews + Copyright (c) 2006, 2011, 2015, 2019 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ /* This header contains the structures used in saved state created by "export". */ #ifndef _STANDALONE_H #define _STANDALONE_H 1 // Get time_t #ifdef HAVE_TIME_H #include #endif // Get uintptr_t #if HAVE_STDINT_H # include #endif #if HAVE_INTTYPES_H # ifndef __STDC_FORMAT_MACROS # define __STDC_FORMAT_MACROS # endif # include #endif #ifdef HAVE_STDDEF_H # include #endif #if defined(HAVE_WINDOWS_H) # include #endif // There are several entries typedef struct _memTableEntry { void *mtCurrentAddr; // The address of the area of memory void *mtOriginalAddr; // The original address, for saved states and 32-in-64. uintptr_t mtLength; // The length in bytes of the area unsigned mtFlags; // Flags describing the area. unsigned mtIndex; // An index to identify permanent spaces. } memoryTableEntry; #define MTF_WRITEABLE 0x00000001 // The area is writeable by ML code #define MTF_EXECUTABLE 0x00000002 // The area contains executable code #define MTF_NO_OVERWRITE 0x00000004 // With MTF_WRITEABLE: Don't load over the top #define MTF_BYTES 0x00000008 // Contains only byte data and no addresses typedef struct _exportDescription { unsigned structLength; // The length of this structure unsigned memTableSize; // The size of each entry in the memory table unsigned memTableEntries; // The number of entries in the memory table memoryTableEntry *memTable; // Pointer to the memory table. void *rootFunction; // Points to the start-up function time_t timeStamp; // Creation time stamp unsigned architecture; // Machine architecture unsigned rtsVersion; // Run-time system version void *originalBaseAddr; // Original base address (32-in-64 only) } exportDescription; extern exportDescription poly_exports; #ifdef __cplusplus extern "C" { #endif -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) #include # ifdef LIBPOLYML_BUILD # ifdef DLL_EXPORT # define POLYLIB_API __declspec (dllexport) # endif # elif defined _MSC_VER // Visual C - POLYLIB_EXPORTS is defined in the library project settings # ifdef POLYLIB_EXPORTS # define POLYLIB_API __declspec (dllexport) # else # define POLYLIB_API __declspec (dllimport) # endif # elif defined DLL_EXPORT # define POLYLIB_API __declspec (dllimport) # else # define POLYLIB_API # endif extern POLYLIB_API int PolyWinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int nCmdShow, exportDescription *exports); #else int polymain(int argc, char *argv[], exportDescription *exports); #endif #ifdef __cplusplus }; #endif #endif diff --git a/polyimport.c b/polyimport.c index 69589e93..27d4689c 100644 --- a/polyimport.c +++ b/polyimport.c @@ -1,45 +1,45 @@ /* Title: polyimport.c - Copyright (c) 2006, 2015 David C.J. Matthews + Copyright (c) 2006, 2015, 2019 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ // This is the start-up function for Poly/ML for importing a portable database. #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #include "polyexports.h" -#if (defined(_WIN32) && ! defined(__CYGWIN__)) +#if (defined(_WIN32)) int WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int nCmdShow) { return PolyWinMain(hInstance, hPrevInstance, lpCmdLine, nCmdShow, 0); } #else int main(int argc, char *argv[]) { return polymain(argc, argv, 0); } #endif