diff --git a/configure.ac b/configure.ac index a2822597..b32e1db3 100644 --- a/configure.ac +++ b/configure.ac @@ -1,594 +1,604 @@ # -*- Autoconf -*- # Process this file with autoconf to produce a configure script. AC_INIT([Poly/ML],[5.9],[polyml AT polyml DOT org],[polyml]) AM_INIT_AUTOMAKE AC_PREREQ(2.69) # libtoolize recommends this line. AC_CONFIG_MACRO_DIR([m4]) ac_debug_mode="no" AC_ARG_ENABLE([debug], [ --enable-debug Compiles without optimisation for debugging ], [ac_debug_mode="yes"]) if test "$ac_debug_mode" != "yes"; then # Default to maximum optimisation. -O2 is not good enough. # Set CCASFLAGS to empty so that it doesn't get set to CFLAGS. # The -g option on assembler causes problems on Sparc/Solaris 10. # test X || Y is equivalent to if !X then Y test "${CFLAGS+set}" = set || CFLAGS="-O3" test "${CXXFLAGS+set}" = set || CXXFLAGS="-O3" test "${CCASFLAGS+set}" = set || CCASFLAGS="" else test "${CFLAGS+set}" = set || CFLAGS="-g" test "${CXXFLAGS+set}" = set || CXXFLAGS="-g" test "${CCASFLAGS+set}" = set || CCASFLAGS="" fi AC_CANONICAL_HOST # If the compiler defines _WIN32 we're building for native Windows otherwise we're # building for something else. AC_CHECK_DECL([_WIN32], [poly_native_windows=yes], [poly_native_windows=no]) # If we are building on cygwin or mingw we need to give the -no-defined flag to # build a DLL. We also have to use Windows calling conventions rather than # SysV on 64-bit. poly_use_windowscc=no poly_need_macosopt=no case "${host_os}" in darwin*) AC_SUBST([OSFLAG], [-DMACOSX]) ;; sunos* | solaris*) AC_SUBST([OSFLAG], [-DSOLARIS]) ;; + haiku*) + # Haiku error codes are negative by default; defining + # B_USE_POSITIVE_POSIX_ERRORS translates the constants on header + # files, and posix_error_mapper takes care of ensuring error + # codes are positive at runtime. + AC_CHECK_LIB([posix_error_mapper], [_errnop], + [AC_SUBST([OSFLAG], [-DB_USE_POSITIVE_POSIX_ERRORS]) + LIBS="-lposix_error_mapper $LIBS"], + [AC_MSG_FAILURE([Cannot link against posix_error_mapper])]) + ;; *mingw* | *cygwin*) poly_no_undefined=yes poly_use_windowscc=yes ;; esac # libpolyml can be a DLL but libpolymain can't. # Enable shared libraries by default. It complicates installation a bit if the # the library is installed to a non-standard location but simplifies polyc. LT_INIT([win32-dll]) AM_MAINTAINER_MODE # Check we're in the right directory AC_CONFIG_SRCDIR([polyexports.h]) AC_CONFIG_HEADER([config.h]) # Checks for programs. AC_PROG_CXX # The following check was supposed to check that there was actually a # C++ compiler but doesn't work properly if CXX is set by the user. #AC_CHECK_PROG(check_cpp, $CXX, "yes", "no") #if test "$check_cpp" != "yes"; then # AC_MSG_ERROR([No C++ compiler found. Unable to build Poly/ML.]) #fi AC_PROG_CC AC_PROG_MAKE_SET AC_PROG_CPP AM_PROG_AS # Activate large file mode if needed AC_SYS_LARGEFILE # Checks for libraries. AC_CHECK_LIB(stdc++, main) # These can sometimes be in the standard libraries AC_SEARCH_LIBS([dlopen], [dl dld]) AC_SEARCH_LIBS([floor], [m]) ## External names on Win64. They have no leading underscores as per ## the X64 ABI published by MS. Earlier versions of GCC (anything ## prior to 4.5.0) were faulty. LT_SYS_SYMBOL_USCORE if test x$sys_symbol_underscore = xyes; then AC_DEFINE(SYMBOLS_REQUIRE_UNDERSCORE, [1], [Defined if external symbols are prefixed by underscores]) fi # Check for headers AC_FUNC_ALLOCA AC_HEADER_DIRENT AC_HEADER_STDC AC_HEADER_SYS_WAIT AC_CHECK_HEADERS([stdio.h time.h fcntl.h float.h limits.h locale.h malloc.h netdb.h netinet/in.h stddef.h]) AC_CHECK_HEADERS([stdlib.h string.h sys/file.h sys/ioctl.h sys/param.h sys/socket.h sys/systeminfo.h]) AC_CHECK_HEADERS([sys/time.h unistd.h values.h dlfcn.h signal.h ucontext.h]) AC_CHECK_HEADERS([assert.h ctype.h direct.h errno.h excpt.h fenv.h fpu_control.h grp.h]) AC_CHECK_HEADERS([ieeefp.h io.h math.h memory.h netinet/tcp.h arpa/inet.h poll.h pwd.h siginfo.h]) AC_CHECK_HEADERS([stdarg.h sys/errno.h sys/filio.h sys/mman.h sys/resource.h]) AC_CHECK_HEADERS([sys/sockio.h sys/stat.h termios.h sys/times.h]) AC_CHECK_HEADERS([sys/types.h sys/uio.h sys/un.h sys/utsname.h sys/select.h sys/sysctl.h]) AC_CHECK_HEADERS([sys/elf_SPARC.h sys/elf_386.h sys/elf_amd64.h asm/elf.h machine/reloc.h i386/elf_machdep.h]) -AC_CHECK_HEADERS([mach-o/x86_64/reloc.h mach-o/arm64/reloc.h]) +AC_CHECK_HEADERS([mach-o/x86_64/reloc.h mach-o/arm64/reloc.h private/system/arch/x86_64/arch_elf.h]) AC_CHECK_HEADERS([windows.h tchar.h semaphore.h]) AC_CHECK_HEADERS([stdint.h inttypes.h]) # Only check for the X headers if the user said --with-x. if test "${with_x+set}" = set; then AC_CHECK_HEADERS([X11/Xlib.h Xm/Xm.h]) fi PKG_PROG_PKG_CONFIG # Check for GMP AC_ARG_WITH([gmp], [AS_HELP_STRING([--with-gmp], [use the GMP library for arbitrary precision arithmetic @<:@default=check@:>@])], [], [with_gmp=check]) # If we want GMP check that the library and headers are installed. if test "x$with_gmp" != "xno"; then AC_CHECK_LIB([gmp], [__gmpn_tdiv_qr], [AC_DEFINE([HAVE_LIBGMP], [1], [Define to 1 if you have libgmp]) [LIBS="-lgmp $LIBS"] AC_CHECK_HEADER([gmp.h], [AC_DEFINE([HAVE_GMP_H], [1], [Define to 1 if you have the gmp.h header file])], [if test "x$with_gmp" != "xcheck"; then AC_MSG_FAILURE( [--with-gmp was given, but gmp.h header file is not installed]) fi ]) ], [if test "x$with_gmp" != "xcheck"; then AC_MSG_FAILURE( [--with-gmp was given, but gmp library (version 4 or later) is not installed]) fi ]) fi # Special configuration for Windows or Unix. poly_windows_enablegui=false if test "x$poly_native_windows" = xyes; then # The next two are only used with mingw. We mustn't include ws2_32 in Cygwin64 because # the "select" function gets used instead of Cygwin's own. AC_CHECK_LIB(ws2_32, main) AC_CHECK_LIB(gdi32, main) CFLAGS="$CFLAGS -mthreads" CXXFLAGS="$CXXFLAGS -mthreads" AC_SUBST([OSFLAG], ["-DUNICODE -D_UNICODE -D_WIN32_WINNT=0x600"]) AC_CHECK_TOOL(WINDRES, windres) # Enable/Disable the GUI in Windows. AC_ARG_ENABLE([windows-gui], [AS_HELP_STRING([--enable-windows-gui], [create a GUI in Windows. If this is disabled use a Windows console. @<:@default=yes@:>@])], [case "${enableval}" in yes) poly_windows_enablegui=true ;; no) poly_windows_enablegui=false ;; *) AC_MSG_ERROR([bad value ${enableval} for --enable-windows-gui]) ;; esac], [poly_windows_enablegui=true]) else # Unix or similar e.g. Cygwin. We need pthreads. # On Android pthread_create is in the standard library AC_SEARCH_LIBS([pthread_create], [pthread], [AC_DEFINE([HAVE_LIBPTHREAD], [1], [Define to 1 if you have the `pthread' library (-lpthread).]) AC_CHECK_HEADER([pthread.h], [AC_DEFINE([HAVE_PTHREAD_H], [1], [Define to 1 if you have the header file.])], [ AC_MSG_FAILURE([pthread.h header file is not installed]) ]) ], [ AC_MSG_FAILURE([pthread library is not installed]) ]) - # Solaris needs -lsocket, -lnsl and -lrt + # Solaris needs -lsocket, -lnsl and -lrt, Haiku needs -lnetwork AC_SEARCH_LIBS([gethostbyname], [nsl]) - AC_SEARCH_LIBS([getsockopt], [socket]) + AC_SEARCH_LIBS([getsockopt], [socket network]) AC_SEARCH_LIBS([sem_wait], [rt]) # Check for X and Motif headers and libraries AC_PATH_X if test "x${with_x}" = "xyes"; then AC_DEFINE([WITH_XWINDOWS], [1], [Define if the X-Windows interface should be built]) if test "$x_includes" != "" ; then if test "$x_includes" != "NONE" ; then CFLAGS="$CFLAGS -I$x_includes" CXXFLAGS="$CXXFLAGS -I$x_includes" CPPFLAGS="$CPPFLAGS -I$x_includes" fi fi if test "$x_libraries" != "" ; then if test "$x_libraries" != "NONE" ; then LIBS="-L$x_libraries $LIBS" fi fi AC_CHECK_LIB(X11, XCreateGC) AC_CHECK_LIB(Xt, XtMalloc) AC_CHECK_LIB(Xext, XextAddDisplay) if test "$xm_includes" != "" ; then if test "$xm_includes" != "NONE" ; then CFLAGS="$CFLAGS -I$xm_includes" CXXFLAGS="$CXXFLAGS -I$xm_includes" CPPFLAGS="$CPPFLAGS -I$xm_includes" fi fi if test "$xm_libraries" != "" ; then if test "$xm_libraries" != "NONE" ; then LIBS="-L$xm_libraries $LIBS" fi fi AC_CHECK_LIB(Xm, XmGetDestination) fi # TODO: May need AC_PATH_XTRA for Solaris fi # End of Windows/Unix configuration. # Find out which type of object code exporter to use. # If we have winnt use PECOFF. This really only applies to cygwin here. # If we have elf.h use ELF. # If we have mach-o/reloc.h use Mach-O # Otherwise use the C source code exporter. AC_CHECK_TYPES([IMAGE_FILE_HEADER], [AC_DEFINE([HAVE_PECOFF], [], [Define to 1 if you have the PE/COFF types.])] [polyexport=pecoff], [AC_CHECK_HEADER([elf.h], [AC_DEFINE([HAVE_ELF_H], [], [Define to 1 if you have the header file.])] [polyexport=elf], [AC_CHECK_HEADER([mach-o/reloc.h], [AC_DEFINE([HAVE_MACH_O_RELOC_H], [], [Define to 1 if you have the header file.])] [polyexport=macho], [AC_CHECK_HEADERS([elf_abi.h machine/reloc.h], [AC_DEFINE([HAVE_ELF_ABI_H], [], [Define to 1 if you have and header files.])] [polyexport=elf] )] )] )], [#include ] ) AM_CONDITIONAL([EXPPECOFF], [test "$polyexport" = pecoff]) AM_CONDITIONAL([EXPELF], [test "$polyexport" = elf]) AM_CONDITIONAL([EXPMACHO], [test "$polyexport" = macho]) # Checks for typedefs, structures, and compiler characteristics. AC_HEADER_STDBOOL AC_C_CONST AC_TYPE_INT16_T AC_TYPE_UINT16_T AC_TYPE_INT32_T AC_TYPE_UINT32_T AC_TYPE_INT64_T AC_TYPE_UINT64_T AC_TYPE_INTPTR_T AC_TYPE_UINTPTR_T AC_TYPE_UID_T AC_TYPE_MODE_T AC_TYPE_OFF_T AC_TYPE_PID_T AC_TYPE_SIZE_T AC_TYPE_SSIZE_T AC_HEADER_TIME AC_STRUCT_TM # Check for the various sub-second fields of the stat structure. AC_CHECK_MEMBERS([struct stat.st_atim, struct stat.st_atimespec, struct stat.st_atimensec, struct stat.st_atime_n, struct stat.st_uatime]) # Mac OS X, at any rate, needs signal.h to be included first. AC_CHECK_TYPES([ucontext_t], , , [#include "signal.h" #include "ucontext.h"]) AC_CHECK_TYPES([struct sigcontext, stack_t, sighandler_t, sig_t], , ,[#include "signal.h"]) AC_CHECK_TYPES([socklen_t],,,[#include "sys/types.h" #include "sys/socket.h"]) AC_CHECK_TYPES([SYSTEM_LOGICAL_PROCESSOR_INFORMATION],,,[#include "windows.h"]) AC_CHECK_TYPES(long long) AC_CHECK_TYPES(ssize_t) AC_CHECK_TYPES([ptrdiff_t], [], [AC_DEFINE_UNQUOTED([ptrdiff_t], [int], [Define to `int' if does not define.])]) AC_CHECK_SIZEOF(void*) AC_CHECK_SIZEOF(long) AC_CHECK_SIZEOF(int) AC_CHECK_SIZEOF(long long) AC_CHECK_SIZEOF(double) AC_CHECK_SIZEOF(float) AC_C_BIGENDIAN # Checks for library functions. AC_FUNC_ERROR_AT_LINE AC_FUNC_GETGROUPS AC_FUNC_GETPGRP AC_PROG_GCC_TRADITIONAL AC_FUNC_SELECT_ARGTYPES AC_FUNC_STAT AC_FUNC_STRTOD AC_CHECK_FUNCS([dlopen strtod dtoa getpagesize sigaltstack mmap mkstemp]) ## There does not seem to be a declaration for fpsetmask in mingw64. AC_CHECK_DECLS([fpsetmask], [], [], [[#include ]]) AC_CHECK_FUNCS([sysctl sysctlbyname]) AC_CHECK_FUNCS([localtime_r gmtime_r]) AC_CHECK_FUNCS([ctermid tcdrain]) AC_CHECK_FUNCS([_ftelli64]) AC_CHECK_FUNCS([pthread_jit_write_protect_np]) # Where are the registers when we get a signal? Used in time profiling. #Linux: AC_CHECK_MEMBERS([mcontext_t.gregs, mcontext_t.regs, mcontext_t.mc_esp],,,[#include "ucontext.h"]) #Mac OS X: AC_CHECK_MEMBERS([struct mcontext.ss, struct __darwin_mcontext.ss, struct __darwin_mcontext.__ss, struct __darwin_mcontext32.ss, struct __darwin_mcontext32.__ss, struct __darwin_mcontext64.ss, struct __darwin_mcontext64.__ss],,, [#include "signal.h" #include "ucontext.h"]) # FreeBSD includes a sun_len member in struct sockaddr_un AC_CHECK_MEMBERS([struct sockaddr_un.sun_len],,, [#include ]) # This option enables the native code generator. More precisely it allows # the byte code interpreter to be built on X86. AC_ARG_ENABLE([native-codegeneration], [AS_HELP_STRING([--disable-native-codegeneration], [disable the native code generator and use the slow byte code interpreter instead.])], [case "${enableval}" in no) with_portable=yes ;; yes) with_portable=no ;; *) AC_MSG_ERROR([bad value ${enableval} for --enable-native-codegeneration]) ;; esac], [with_portable=check]) # Check which CPU we're building for. Can we use a native pre-built compiler # or do we need to fall back to the interpreter? Most of these settings are to tweak # the ELF exporter. case "${host_cpu}" in i[[3456]]86*) AC_DEFINE([HOSTARCHITECTURE_X86], [1], [Define if the host is an X86 (32-bit)]) polyarch=i386 ;; x86_64* | amd64*) if test X"$ac_cv_sizeof_voidp" = X8; then AC_DEFINE([HOSTARCHITECTURE_X86_64], [1], [Define if the host is an X86 (64-bit)]) polyarch=x86_64 else AC_DEFINE([HOSTARCHITECTURE_X32], [1], [Define if the host is an X86 (32-bit ABI, 64-bit processor)]) polyarch=interpret fi ;; aarch64* | arm*) # MacOS seems to return "arm" on 64-bit ARM. if test X"$ac_cv_sizeof_voidp" = X8; then AC_DEFINE([HOSTARCHITECTURE_AARCH64], [1], [Define if the host is an ARM (64-bit)]) polyarch=aarch64 else AC_DEFINE([HOSTARCHITECTURE_ARM], [1], [Define if the host is an ARM (32-bit)]) polyarch=interpret fi ;; sparc64*) AC_DEFINE([HOSTARCHITECTURE_SPARC64], [1], [Define if the host is a Sparc (64-bit)]) polyarch=interpret ;; sparc*) AC_DEFINE([HOSTARCHITECTURE_SPARC], [1], [Define if the host is a Sparc (32-bit)]) polyarch=interpret ;; powerpc64* | ppc64*) AC_DEFINE([HOSTARCHITECTURE_PPC64], [1], [Define if the host is a PowerPC (64-bit)]) polyarch=interpret ;; power* | ppc*) AC_DEFINE([HOSTARCHITECTURE_PPC], [1], [Define if the host is a PowerPC (32-bit)]) polyarch=interpret ;; hppa*) AC_DEFINE([HOSTARCHITECTURE_HPPA], [1], [Define if the host is an HP PA-RISC (32-bit)]) polyarch=interpret ;; ia64*) AC_DEFINE([HOSTARCHITECTURE_IA64], [1], [Define if the host is an Itanium]) polyarch=interpret ;; m68k*) AC_DEFINE([HOSTARCHITECTURE_M68K], [1], [Define if the host is a Motorola 68000]) polyarch=interpret ;; mips64*) AC_DEFINE([HOSTARCHITECTURE_MIPS64], [1], [Define if the host is a MIPS (64-bit)]) polyarch=interpret ;; mips*) AC_DEFINE([HOSTARCHITECTURE_MIPS], [1], [Define if the host is a MIPS (32-bit)]) polyarch=interpret ;; s390x*) AC_DEFINE([HOSTARCHITECTURE_S390X], [1], [Define if the host is an S/390 (64-bit)]) polyarch=interpret ;; s390*) AC_DEFINE([HOSTARCHITECTURE_S390], [1], [Define if the host is an S/390 (32-bit)]) polyarch=interpret ;; sh*) AC_DEFINE([HOSTARCHITECTURE_SH], [1], [Define if the host is a SuperH (32-bit)]) polyarch=interpret ;; alpha*) AC_DEFINE([HOSTARCHITECTURE_ALPHA], [1], [Define if the host is an Alpha (64-bit)]) polyarch=interpret # GCC defaults to non-conforming floating-point, and does not respect the rounding mode # in the floating-point control register, so we force it to conform to IEEE and use the # dynamic suffix on the floating-point instructions it produces. CFLAGS="$CFLAGS -mieee -mfp-rounding-mode=d" CXXFLAGS="$CXXFLAGS -mieee -mfp-rounding-mode=d" ;; riscv32) AC_DEFINE([HOSTARCHITECTURE_RISCV32], [1], [Define if the host is a RISC-V (32-bit)]) polyarch=interpret ;; riscv64) AC_DEFINE([HOSTARCHITECTURE_RISCV64], [1], [Define if the host is a RISC-V (64-bit)]) polyarch=interpret ;; *) AC_MSG_ERROR([Poly/ML is not supported for this architecture]) ;; esac # If we explicitly asked to use the interpreter set the architecture to interpreted. if test "x$with_portable" = "xyes" ; then if test "x$polyarch" != "xinterpret" ; then AC_MSG_WARN( [*******You have disabled native code generation. Are you really sure you want to do that?*******]) fi polyarch=interpret fi # If we asked not to use the interpreter check we have native code support. if test "x$with_portable" = "xno" ; then if test "x$polyarch" = "xinterpret" ; then AC_MSG_ERROR( [--enable-native-codegeneration was given but native code is not supported on this platform]) fi fi # Check for libffi only if we're building the interpreted version if test "x$polyarch" = "xinterpret" ; then AC_CHECK_LIB([ffi], [ffi_prep_closure_loc]) AC_CHECK_HEADERS([ffi.h]) fi if test X"$ac_cv_sizeof_voidp" = X8 ; then bootstrap64="yes" else bootstrap64="no" fi # Build 32-bit in 64-bits. This is only allowed when building on native 64-bit X86. AC_ARG_ENABLE([compact32bit], [AS_HELP_STRING([--enable-compact32bit], [use 32-bit values rather than native 64-bits.])]) if test "x$enable_compact32bit" = "xyes"; then if test X"$ac_cv_sizeof_voidp" = X8 ; then AC_DEFINE([POLYML32IN64], [1], [Define if this should use 32-bit values in 64-bit architectures]) bootstrap64="no" else AC_MSG_ERROR([--enable-compact32bit is only available on a 64-bit architecture]) fi fi # Put this test at the end where it's less likely to be missed. # If we're compiling on Cygwin (and mingw?) and /usr/bin/file is not present # the link step will produce some strange warning messages of the form: # "Warning: linker path does not have real file for library -lXXX". I think # that's really a bug in autoconf but to explain what's happening to the user # add a test here. if test "$lt_cv_file_magic_cmd" = "func_win32_libid"; then if test \! -x /usr/bin/file; then echo "" echo "*** Warning: You are building Poly/ML on Cygwin/Mingw but '/usr/bin/file' cannot be found." echo "*** You can still go ahead and build Poly/ML but libpolyml will not be built as a" echo "*** shared library and you may get strange warning messages from the linker step." echo "*** Install the 'file' package to correct this problem." echo "" fi fi AM_CONDITIONAL([ARCHI386], [test "$polyarch" = i386]) AM_CONDITIONAL([ARCHX86_64], [test "$polyarch" = x86_64]) AM_CONDITIONAL([ARCHARM_64], [test "$polyarch" = aarch64]) AM_CONDITIONAL([ARCHINTERPRET], [test "$polyarch" = interpret]) # Are we bootstrapping from the 32-bit or 64-bit pre-built compiler? AM_CONDITIONAL([BOOT64], [test "$bootstrap64" = yes]) # If we are targeting Windows rather than *nix we need the pre=built compiler with Windows conventions. AM_CONDITIONAL([WINDOWSCALLCONV], [test "$poly_use_windowscc" = yes]) # This is true if we are building for native Windows rather than Cygwin AM_CONDITIONAL([NATIVE_WINDOWS], [test "$poly_native_windows" = yes]) AM_CONDITIONAL([NO_UNDEFINED], [test "$poly_no_undefined" = yes]) AM_CONDITIONAL([WINDOWSGUI], [test x$poly_windows_enablegui = xtrue]) # If we're building only the static version of libpolyml # then polyc and polyml.pc have to include the dependent libraries. dependentlibs="" if test "${enable_shared}" != yes; then dependentlibs=${LIBS} fi AC_SUBST([dependentlibs], ["$dependentlibs"]) # Test whether this is a git directory and set the version if possible AC_CHECK_PROG([gitinstalled], [git], [yes], [no]) if test X"$gitinstalled" = "Xyes" -a -d ".git"; then GIT_VERSION='-DGIT_VERSION=\"$(shell git describe --tags --always)\"' AC_SUBST(GIT_VERSION) fi # Strip -fdebug-prefix-map= from CFLAGS; it's meaningless for users of polyc, # and hurts reproducibility. polyc_CFLAGS= for cflag in $CFLAGS; do cflag="${cflag##-fdebug-prefix-map=*}" if test -n "$cflag"; then if test -n "$polyc_CFLAGS"; then polyc_CFLAGS="$polyc_CFLAGS $cflag" else polyc_CFLAGS="$cflag" fi fi done AC_SUBST([polyc_CFLAGS], ["$polyc_CFLAGS"]) # Modules directory AC_ARG_WITH([moduledir], [AS_HELP_STRING([--with-moduledir=DIR], [directory for Poly/ML modules])], [moduledir=$withval], [moduledir="\${libdir}/polyml/modules"]) AC_SUBST([moduledir], [$moduledir]) # Control whether to build the basis library with arbitrary precision as the default int AC_ARG_ENABLE([intinf-as-int], [AS_HELP_STRING([--enable-intinf-as-int], [set arbitrary precision as the default int type])], [case "${enableval}" in no) intisintinf=no ;; yes) intisintinf=yes ;; *) AC_MSG_ERROR([bad value ${enableval} for --enable-intinf-as-int]) ;; esac], [intisintinf=no]) AM_CONDITIONAL([INTINFISINT], [test "$intisintinf" = "yes"]) # These are needed for building in a separate build directory, as they are # referenced from exportPoly.sml. AC_CONFIG_COMMANDS([basis], [test -e basis || ln -sf ${ac_top_srcdir}/basis .]) AC_CONFIG_COMMANDS([mlsource], [test -e mlsource || ln -sf ${ac_top_srcdir}/mlsource .]) AC_CONFIG_FILES([Makefile libpolyml/Makefile libpolyml/polyml.pc libpolymain/Makefile modules/Makefile modules/IntInfAsInt/Makefile]) AC_CONFIG_FILES([polyc], [chmod +x polyc]) AC_OUTPUT diff --git a/libpolyml/elfexport.cpp b/libpolyml/elfexport.cpp index 13a2c43e..63810c15 100644 --- a/libpolyml/elfexport.cpp +++ b/libpolyml/elfexport.cpp @@ -1,873 +1,879 @@ /* Title: Write out a database as an ELF object file Author: David Matthews. Copyright (c) 2006-7, 2011, 2016-18, 2020-21 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 H 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 */ #include "config.h" #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_STDDEF_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_TIME_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif #ifdef HAVE_ELF_H #include #elif defined(HAVE_ELF_ABI_H) #include #endif #ifdef HAVE_MACHINE_RELOC_H #include #ifndef EM_X86_64 #define EM_X86_64 EM_AMD64 #endif #if defined(HOSTARCHITECTURE_X86_64) #ifndef R_386_PC32 #define R_386_PC32 R_X86_64_PC32 #endif #ifndef R_386_32 #define R_386_32 R_X86_64_32 #endif #ifndef R_X86_64_64 #define R_X86_64_64 R_X86_64_64 #endif #endif /* HOSTARCHITECTURE_X86_64 */ #endif // Solaris seems to put processor-specific constants in separate files #ifdef HAVE_SYS_ELF_SPARC_H #include #endif #ifdef HAVE_SYS_ELF_386_H #include #endif #ifdef HAVE_SYS_ELF_AMD64_H #include #endif // Android has the ARM relocation symbol here #ifdef HAVE_ASM_ELF_H #include #endif // NetBSD relocation symbols #ifdef HAVE_I386_ELF_MACHDEP_H #include #endif // Work around problems in NetBSD #if (defined(R_AARCH_LDST64_ABS_LO12_NC) && !defined(R_AARCH64_LDST64_ABS_LO12_NC)) #define R_AARCH64_LDST64_ABS_LO12_NC R_AARCH_LDST64_ABS_LO12_NC #endif #if (defined(R_AARCH_LDST32_ABS_LO12_NC) && !defined(R_AARCH64_LDST32_ABS_LO12_NC)) #define R_AARCH64_LDST32_ABS_LO12_NC R_AARCH_LDST32_ABS_LO12_NC #endif +// Haiku x86_64 relocation symbols +// The x86 ones are already defined on elf.h +#ifdef HAVE_PRIVATE_SYSTEM_ARCH_X86_64_ARCH_ELF_H +#include +#endif + #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_SYS_UTSNAME_H #include #endif #include "globals.h" #include "diagnostics.h" #include "sys.h" #include "machine_dep.h" #include "gc.h" #include "mpoly.h" #include "scanaddrs.h" #include "elfexport.h" #include "run_time.h" #include "version.h" #include "polystring.h" #include "timing.h" #include "memmgr.h" #define sym_last_local_sym sym_data_section #if defined(HOSTARCHITECTURE_X86) # define HOST_E_MACHINE EM_386 # define HOST_DIRECT_DATA_RELOC R_386_32 # define HOST_DIRECT_FPTR_RELOC R_386_32 # define USE_RELA 0 #elif defined(HOSTARCHITECTURE_PPC) # define HOST_E_MACHINE EM_PPC # define HOST_DIRECT_DATA_RELOC R_PPC_ADDR32 # define HOST_DIRECT_FPTR_RELOC R_PPC_ADDR32 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_PPC64) # define HOST_E_MACHINE EM_PPC64 # define HOST_DIRECT_DATA_RELOC R_PPC64_ADDR64 # define HOST_DIRECT_FPTR_RELOC R_PPC64_ADDR64 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_S390) # define HOST_E_MACHINE EM_S390 # define HOST_DIRECT_DATA_RELOC R_390_32 # define HOST_DIRECT_FPTR_RELOC R_390_32 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_S390X) # define HOST_E_MACHINE EM_S390 # define HOST_DIRECT_DATA_RELOC R_390_64 # define HOST_DIRECT_FPTR_RELOC R_390_64 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_SH) # define HOST_E_MACHINE EM_SH # define HOST_DIRECT_DATA_RELOC R_SH_DIR32 # define HOST_DIRECT_FPTR_RELOC R_SH_DIR32 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_SPARC) # define HOST_E_MACHINE EM_SPARC # define HOST_DIRECT_DATA_RELOC R_SPARC_32 # define HOST_DIRECT_FPTR_RELOC R_SPARC_32 # define USE_RELA 1 /* Sparc/Solaris, at least 2.8, requires ELF32_Rela relocations. For some reason, though, it adds the value in the location being relocated (as with ELF32_Rel relocations) as well as the addend. To be safe, whenever we use an ELF32_Rela relocation we always zero the location to be relocated. */ #elif defined(HOSTARCHITECTURE_SPARC64) # define HOST_E_MACHINE EM_SPARCV9 # define HOST_DIRECT_DATA_RELOC R_SPARC_64 # define HOST_DIRECT_FPTR_RELOC R_SPARC_64 /* Use the most relaxed memory model. At link time, the most restrictive one is chosen, so it does no harm to be as permissive as possible here. */ # define HOST_E_FLAGS EF_SPARCV9_RMO # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_X86_64) /* It seems Solaris/X86-64 only supports ELF64_Rela relocations. It appears that Linux will support either so we now use Rela on X86-64. */ # define HOST_E_MACHINE EM_X86_64 # define HOST_DIRECT_DATA_RELOC R_X86_64_64 # define HOST_DIRECT_FPTR_RELOC R_X86_64_64 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_X32) # define HOST_E_MACHINE EM_X86_64 # define HOST_DIRECT_DATA_RELOC R_X86_64_32 # define HOST_DIRECT_FPTR_RELOC R_X86_64_32 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_ARM) # ifndef EF_ARM_EABI_VER4 # define EF_ARM_EABI_VER4 0x04000000 # endif // When linking ARM binaries the linker checks the ABI version. We // need to set the version to the same as the libraries. // GCC currently uses version 4. # define HOST_E_MACHINE EM_ARM # define HOST_DIRECT_DATA_RELOC R_ARM_ABS32 # define HOST_DIRECT_FPTR_RELOC R_ARM_ABS32 # define USE_RELA 0 # define HOST_E_FLAGS EF_ARM_EABI_VER4 #elif defined(HOSTARCHITECTURE_HPPA) # if defined(__hpux) # define HOST_OSABI ELFOSABI_HPUX # elif defined(__NetBSD__) # define HOST_OSABI ELFOSABI_NETBSD # elif defined(__linux__) # define HOST_OSABI ELFOSABI_GNU # endif # define HOST_E_MACHINE EM_PARISC # define HOST_DIRECT_DATA_RELOC R_PARISC_DIR32 # define HOST_DIRECT_FPTR_RELOC R_PARISC_PLABEL32 # define HOST_E_FLAGS EFA_PARISC_1_0 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_IA64) # define HOST_E_MACHINE EM_IA_64 # define HOST_DIRECT_DATA_RELOC R_IA64_DIR64LSB # define HOST_DIRECT_FPTR_RELOC R_IA64_FPTR64LSB # define HOST_E_FLAGS EF_IA_64_ABI64 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_AARCH64) # define HOST_E_MACHINE EM_AARCH64 # define HOST_DIRECT_DATA_RELOC R_AARCH64_ABS64 # define HOST_DIRECT_FPTR_RELOC R_AARCH64_ABS64 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_M68K) # define HOST_E_MACHINE EM_68K # define HOST_DIRECT_DATA_RELOC R_68K_32 # define HOST_DIRECT_FPTR_RELOC R_68K_32 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_MIPS) # define HOST_E_MACHINE EM_MIPS # define HOST_DIRECT_DATA_RELOC R_MIPS_32 # define HOST_DIRECT_FPTR_RELOC R_MIPS_32 # ifdef __PIC__ # define HOST_E_FLAGS EF_MIPS_CPIC # endif # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_MIPS64) # define HOST_E_MACHINE EM_MIPS # define HOST_DIRECT_DATA_RELOC R_MIPS_64 # define HOST_DIRECT_FPTR_RELOC R_MIPS_64 # ifdef __PIC__ # define HOST_E_FLAGS (EF_MIPS_ARCH_64 | EF_MIPS_CPIC) # else # define HOST_E_FLAGS EF_MIPS_ARCH_64 # endif # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_ALPHA) # define HOST_E_MACHINE EM_ALPHA # define HOST_DIRECT_DATA_RELOC R_ALPHA_REFQUAD # define HOST_DIRECT_FPTR_RELOC R_ALPHA_REFQUAD # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_RISCV32) || defined(HOSTARCHITECTURE_RISCV64) # define HOST_E_MACHINE EM_RISCV # if defined(HOSTARCHITECTURE_RISCV32) # define HOST_DIRECT_DATA_RELOC R_RISCV_32 # define HOST_DIRECT_FPTR_RELOC R_RISCV_32 # else # define HOST_DIRECT_DATA_RELOC R_RISCV_64 # define HOST_DIRECT_FPTR_RELOC R_RISCV_64 # endif # if defined(__riscv_float_abi_soft) # define HOST_E_FLAGS_FLOAT_ABI EF_RISCV_FLOAT_ABI_SOFT # elif defined(__riscv_float_abi_single) # define HOST_E_FLAGS_FLOAT_ABI EF_RISCV_FLOAT_ABI_SINGLE # elif defined(__riscv_float_abi_double) # define HOST_E_FLAGS_FLOAT_ABI EF_RISCV_FLOAT_ABI_DOUBLE # elif defined(__riscv_float_abi_quad) # define HOST_E_FLAGS_FLOAT_ABI EF_RISCV_FLOAT_ABI_QUAD # else # error "Unknown RISC-V float ABI" # endif # ifdef __riscv_32e # define HOST_E_FLAGS_RVE __riscv_32e # else # define HOST_E_FLAGS_RVE 0 # endif # define HOST_E_FLAGS (HOST_E_FLAGS_FLOAT_ABI | HOST_E_FLAGS_RVE) # define USE_RELA 1 #else # error "No support for exporting on this architecture" #endif // The first two symbols are special: // Zero is always special in ELF // 1 is used for the data section #define EXTRA_SYMBOLS 2 static unsigned AreaToSym(unsigned area) { return area+EXTRA_SYMBOLS; } // Section table entries enum { sect_initial = 0, sect_sectionnametable, sect_stringtable, // Data and relocation entries come in here. sect_data // Finally the symbol table }; // Add an external reference to the RTS void ELFExport::addExternalReference(void *relocAddr, const char *name, bool isFuncPtr) { externTable.makeEntry(name); // The symbol is added after the memory table entries and poly_exports writeRelocation(0, relocAddr, symbolNum++, isFuncPtr); } // Generate the address relative to the start of the segment. void ELFExport::setRelocationAddress(void *p, ElfXX_Addr *reloc) { unsigned area = findArea(p); POLYUNSIGNED offset = (char*)p - (char*)memTable[area].mtOriginalAddr; *reloc = offset; } /* Get the index corresponding to an address. */ PolyWord ELFExport::createRelocation(PolyWord p, void *relocAddr) { void *addr = p.AsAddress(); unsigned addrArea = findArea(addr); POLYUNSIGNED offset = (char*)addr - (char*)memTable[addrArea].mtOriginalAddr; return writeRelocation(offset, relocAddr, AreaToSym(addrArea), false); } PolyWord ELFExport::writeRelocation(POLYUNSIGNED offset, void *relocAddr, unsigned symbolNum, bool isFuncPtr) { #if USE_RELA ElfXX_Rela reloc; reloc.r_addend = offset; offset = 0; #else ElfXX_Rel reloc; #endif // Set the offset within the section we're scanning. setRelocationAddress(relocAddr, &reloc.r_offset); #ifdef HOSTARCHITECTURE_MIPS64 reloc.r_sym = symbolNum; reloc.r_ssym = 0; reloc.r_type = isFuncPtr ? HOST_DIRECT_FPTR_RELOC : HOST_DIRECT_DATA_RELOC; reloc.r_type2 = 0; reloc.r_type3 = 0; #else reloc.r_info = ELFXX_R_INFO(symbolNum, isFuncPtr ? HOST_DIRECT_FPTR_RELOC : HOST_DIRECT_DATA_RELOC); #endif fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; return PolyWord::FromUnsigned(offset); } /* 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 ELFExport::ScanConstant(PolyObject *base, byte *addr, ScanRelocationKind code, intptr_t displacement) { #ifndef POLYML32IN64 PolyObject *p = GetConstantValue(addr, code, displacement); 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. POLYUNSIGNED offset = (char*)a - (char*)memTable[aArea].mtOriginalAddr; switch (code) { case PROCESS_RELOC_DIRECT: // 32 or 64 bit address of target { PolyWord r = createRelocation(p, addr); POLYUNSIGNED w = r.AsUnsigned(); for (unsigned i = 0; i < sizeof(PolyWord); i++) { addr[i] = (byte)(w & 0xff); w >>= 8; } } break; #if(defined(HOSTARCHITECTURE_X86) || defined(HOSTARCHITECTURE_X86_64) || \ defined(HOSTARCHITECTURE_X32)) #ifdef HOSTARCHITECTURE_X86 #define R_PC_RELATIVE R_386_PC32 #else #define R_PC_RELATIVE R_X86_64_PC32 #endif case PROCESS_RELOC_I386RELATIVE: // 32 bit relative address { // We seem to need to subtract 4 bytes to get the correct offset in ELF offset -= 4; #if USE_RELA ElfXX_Rela reloc; reloc.r_addend = offset; #else ElfXX_Rel reloc; #endif setRelocationAddress(addr, &reloc.r_offset); reloc.r_info = ELFXX_R_INFO(AreaToSym(aArea), R_PC_RELATIVE); byte *writAble = gMem.SpaceForAddress(addr)->writeAble(addr); #if USE_RELA // Clear the field. Even though it's not supposed to be used with Rela the // Linux linker at least seems to add the value in here sometimes. memset(writAble, 0, 4); #else for (unsigned i = 0; i < 4; i++) { writAble[i] = (byte)(offset & 0xff); offset >>= 8; } #endif fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; } break; #endif #if defined(HOSTARCHITECTURE_AARCH64) case PROCESS_RELOC_ARM64ADRPLDR64: case PROCESS_RELOC_ARM64ADRPLDR32: case PROCESS_RELOC_ARM64ADRPADD: { ElfXX_Rela reloc; reloc.r_addend = offset; setRelocationAddress(addr, &reloc.r_offset); reloc.r_info = ELFXX_R_INFO(AreaToSym(aArea), R_AARCH64_ADR_PREL_PG_HI21); fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; setRelocationAddress(addr+4, &reloc.r_offset); int relType = code == PROCESS_RELOC_ARM64ADRPLDR64 ? R_AARCH64_LDST64_ABS_LO12_NC : code == PROCESS_RELOC_ARM64ADRPLDR32 ? R_AARCH64_LDST32_ABS_LO12_NC : R_AARCH64_ADD_ABS_LO12_NC; reloc.r_info = ELFXX_R_INFO(AreaToSym(aArea), relType); fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; // Clear the offsets within the instruction just in case uint32_t* writAble = (uint32_t *)gMem.SpaceForAddress(addr)->writeAble(addr); writAble[0] = toARMInstr(fromARMInstr(writAble[0]) & 0x9f00001f); writAble[1] = toARMInstr(fromARMInstr(writAble[1]) & 0xffc003ff); } break; #endif default: ASSERT(0); // Wrong type of relocation for this architecture. } #endif } unsigned long ELFExport::makeStringTableEntry(const char *str, ExportStringTable *stab) { if (str == NULL || str[0] == 0) return 0; // First entry is the null string. else return stab->makeEntry(str); } void ELFExport::writeSymbol(const char *symbolName, long value, long size, int binding, int sttype, int section) { ElfXX_Sym symbol; memset(&symbol, 0, sizeof(symbol)); // Zero unused fields symbol.st_name = makeStringTableEntry(symbolName, &symStrings); symbol.st_value = value; symbol.st_size = size; symbol.st_info = ELFXX_ST_INFO(binding, sttype); symbol.st_other = 0; symbol.st_shndx = section; fwrite(&symbol, sizeof(symbol), 1, exportFile); } // Set the file alignment. void ELFExport::alignFile(int align) { char pad[32] = {0}; // Maximum alignment int offset = ftell(exportFile); if ((offset % align) == 0) return; fwrite(&pad, align - (offset % align), 1, exportFile); } void ELFExport::createStructsRelocation(unsigned sym, size_t offset, size_t addend) { #if USE_RELA ElfXX_Rela reloc; reloc.r_addend = addend; #else ElfXX_Rel reloc; #endif reloc.r_offset = offset; #ifdef HOSTARCHITECTURE_MIPS64 reloc.r_sym = sym; reloc.r_ssym = 0; reloc.r_type = HOST_DIRECT_DATA_RELOC; reloc.r_type2 = 0; reloc.r_type3 = 0; #else reloc.r_info = ELFXX_R_INFO(sym, HOST_DIRECT_DATA_RELOC); #endif fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; } void ELFExport::exportStore(void) { PolyWord *p; ElfXX_Ehdr fhdr; ElfXX_Shdr *sections = 0; #ifdef __linux__ unsigned extraSections = 1; // Extra section for .note.GNU-stack #else unsigned extraSections = 0; #endif unsigned numSections = 0; for (unsigned j = 0; j < memTableEntries; j++) { if ((memTable[j].mtFlags & (MTF_BYTES|MTF_WRITEABLE)) == MTF_BYTES) numSections += 1; else numSections += 2; } // The symbol table comes at the end. unsigned sect_symtab = sect_data + numSections + 2; numSections += 6 + extraSections; // External symbols start after the memory table entries and "poly_exports". symbolNum = EXTRA_SYMBOLS+memTableEntries+1; // Both the string tables have an initial null entry. symStrings.makeEntry(""); sectionStrings.makeEntry(""); // Write out initial values for the headers. These are overwritten at the end. // File header memset(&fhdr, 0, sizeof(fhdr)); fhdr.e_ident[EI_MAG0] = 0x7f; fhdr.e_ident[EI_MAG1] = 'E'; fhdr.e_ident[EI_MAG2] = 'L'; fhdr.e_ident[EI_MAG3] = 'F'; fhdr.e_ident[EI_CLASS] = ELFCLASSXX; // ELFCLASS32 or ELFCLASS64 fhdr.e_ident[EI_VERSION] = EV_CURRENT; #ifdef HOST_OSABI fhdr.e_ident[EI_OSABI] = HOST_OSABI; #endif { union { unsigned long wrd; char chrs[sizeof(unsigned long)]; } endian; endian.wrd = 1; if (endian.chrs[0] == 0) fhdr.e_ident[EI_DATA] = ELFDATA2MSB; // Big endian else fhdr.e_ident[EI_DATA] = ELFDATA2LSB; // Little endian } fhdr.e_type = ET_REL; // The machine needs to match the machine we're compiling for // even if this is actually portable code. fhdr.e_machine = HOST_E_MACHINE; #ifdef HOST_E_FLAGS fhdr.e_flags = HOST_E_FLAGS; #endif fhdr.e_version = EV_CURRENT; fhdr.e_shoff = sizeof(fhdr); // Offset to section header - immediately follows fhdr.e_ehsize = sizeof(fhdr); fhdr.e_shentsize = sizeof(ElfXX_Shdr); fhdr.e_shnum = numSections; fhdr.e_shstrndx = sect_sectionnametable; // Section name table section index; fwrite(&fhdr, sizeof(fhdr), 1, exportFile); // Write it for the moment. sections = new ElfXX_Shdr[numSections]; memset(sections, 0, sizeof(ElfXX_Shdr) * numSections); // Necessary? // Set up the section header but don't write it yet. // Section 0 - all zeros sections[sect_initial].sh_type = SHT_NULL; sections[sect_initial].sh_link = SHN_UNDEF; // Section name table. sections[sect_sectionnametable].sh_name = makeStringTableEntry(".shstrtab", §ionStrings); sections[sect_sectionnametable].sh_type = SHT_STRTAB; sections[sect_sectionnametable].sh_addralign = sizeof(char); // sections[sect_sectionnametable].sh_offset is set later // sections[sect_sectionnametable].sh_size is set later // Symbol name table. sections[sect_stringtable].sh_name = makeStringTableEntry(".strtab", §ionStrings); sections[sect_stringtable].sh_type = SHT_STRTAB; sections[sect_stringtable].sh_addralign = sizeof(char); // sections[sect_stringtable].sh_offset is set later // sections[sect_stringtable].sh_size is set later unsigned long dataName = makeStringTableEntry(".data", §ionStrings); unsigned long dataRelName = makeStringTableEntry(USE_RELA ? ".rela.data" : ".rel.data", §ionStrings); #ifndef CODEISNOTEXECUTABLE unsigned long textName = makeStringTableEntry(".text", §ionStrings); unsigned long textRelName = makeStringTableEntry(USE_RELA ? ".rela.text" : ".rel.text", §ionStrings); #endif // The Linux linker does not like relocations in the .rodata section and marks the executable // as containing text relocations. Putting the data in a .data.rel.ro section seems to work. unsigned long relDataName = makeStringTableEntry(".data.rel.ro", §ionStrings); unsigned long relDataRelName = makeStringTableEntry(USE_RELA ? ".rela.data.rel.ro" : ".rel.data.rel.ro", §ionStrings); // Byte and other leaf data that do not require relocation can go in the .rodata section unsigned long nRelDataName = makeStringTableEntry(".rodata", §ionStrings); // Main data sections. Each one has a relocation section. unsigned s = sect_data; for (unsigned i=0; i < memTableEntries; i++) { sections[s].sh_addralign = 8; // 8-byte alignment sections[s].sh_type = SHT_PROGBITS; if (memTable[i].mtFlags & MTF_WRITEABLE) { // Mutable areas ASSERT(!(memTable[i].mtFlags & MTF_EXECUTABLE)); // Executable areas can't be writable. sections[s].sh_name = dataName; sections[s].sh_flags = SHF_WRITE | SHF_ALLOC; s++; // Mutable byte areas can contain external references so need relocation sections[s].sh_name = dataRelName; // Name of relocation section } #ifndef CODEISNOTEXECUTABLE // Not if we're building the interpreted version. else if (memTable[i].mtFlags & MTF_EXECUTABLE) { // Code areas are marked as executable. sections[s].sh_name = textName; sections[s].sh_flags = SHF_ALLOC | SHF_EXECINSTR; s++; sections[s].sh_name = textRelName; // Name of relocation section } #endif else if (memTable[i].mtFlags & MTF_BYTES) { // Data that does not require relocation. // Non-code immutable areas sections[s].sh_name = nRelDataName; sections[s].sh_flags = SHF_ALLOC; s++; continue; // Skip the relocation section for this } else { // Non-code immutable areas sections[s].sh_name = relDataName; // The .data.rel.ro has to be writable in order to be relocated. // It is set to read-only after relocation. sections[s].sh_flags = SHF_WRITE | SHF_ALLOC; s++; sections[s].sh_name = relDataRelName; // Name of relocation section } // sections[s].sh_size is set later // sections[s].sh_offset is set later. // sections[s].sh_size is set later. // Relocation section sections[s].sh_type = USE_RELA ? SHT_RELA : SHT_REL; // Contains relocation with/out explicit addends (ElfXX_Rel) sections[s].sh_link = sect_symtab; // Index to symbol table sections[s].sh_info = s-1; // Applies to the data section sections[s].sh_addralign = sizeof(long); // Align to a word sections[s].sh_entsize = USE_RELA ? sizeof(ElfXX_Rela) : sizeof(ElfXX_Rel); s++; // sections[s+1].sh_offset is set later. // sections[s+1].sh_size is set later. } // Table data - Poly tables that describe the memory layout. unsigned sect_table_data = s; sections[sect_table_data].sh_name = dataName; sections[sect_table_data].sh_type = SHT_PROGBITS; sections[sect_table_data].sh_flags = SHF_WRITE | SHF_ALLOC; sections[sect_table_data].sh_addralign = 8; // 8-byte alignment // Table relocation sections[sect_table_data+1].sh_name = dataRelName; sections[sect_table_data+1].sh_type = USE_RELA ? SHT_RELA : SHT_REL; // Contains relocation with/out explicit addends (ElfXX_Rel) sections[sect_table_data+1].sh_link = sect_symtab; // Index to symbol table sections[sect_table_data+1].sh_info = sect_table_data; // Applies to table section sections[sect_table_data+1].sh_addralign = sizeof(long); // Align to a word sections[sect_table_data+1].sh_entsize = USE_RELA ? sizeof(ElfXX_Rela) : sizeof(ElfXX_Rel); // Symbol table. sections[sect_symtab].sh_name = makeStringTableEntry(".symtab", §ionStrings); sections[sect_symtab].sh_type = SHT_SYMTAB; sections[sect_symtab].sh_link = sect_stringtable; // String table to use sections[sect_symtab].sh_addralign = sizeof(long); // Align to a word sections[sect_symtab].sh_entsize = sizeof(ElfXX_Sym); // sections[sect_symtab].sh_info is set later // sections[sect_symtab].sh_size is set later // sections[sect_symtab].sh_offset is set later #ifdef __linux__ // Add a .note.GNU-stack section to indicate this does not require executable stack sections[numSections-1].sh_name = makeStringTableEntry(".note.GNU-stack", §ionStrings); sections[numSections - 1].sh_type = SHT_PROGBITS; #endif // Write the relocations. unsigned relocSection = sect_data; for (unsigned i = 0; i < memTableEntries; i++) { relocSection++; if ((memTable[i].mtFlags & (MTF_BYTES|MTF_WRITEABLE)) == MTF_BYTES) continue; alignFile(sections[relocSection].sh_addralign); sections[relocSection].sh_offset = ftell(exportFile); relocationCount = 0; // Create the relocation table and turn all addresses into offsets. char *start = (char*)memTable[i].mtOriginalAddr; char *end = start + memTable[i].mtLength; for (p = (PolyWord*)start; p < (PolyWord*)end; ) { p++; PolyObject *obj = (PolyObject*)p; POLYUNSIGNED length = obj->Length(); if (length != 0 && obj->IsCodeObject()) { POLYUNSIGNED constCount; PolyWord* cp; // Get the constant area pointer first because ScanConstantsWithinCode // may alter it. machineDependent->GetConstSegmentForCode(obj, cp, constCount); // Update any constants before processing the object // We need that for relative jumps/calls in X86/64. machineDependent->RelocateConstantsWithinCode(obj, this); if (cp > (PolyWord*)obj && cp < ((PolyWord*)obj) + length) { // Process the constants if they're in the area but not if they've been moved. for (POLYUNSIGNED i = 0; i < constCount; i++) relocateValue(&(cp[i])); } } else relocateObject(obj); p += length; } sections[relocSection].sh_size = relocationCount * (USE_RELA ? sizeof(ElfXX_Rela) : sizeof(ElfXX_Rel)); relocSection++; } // Relocations for "exports" and "memTable"; alignFile(sections[sect_table_data+1].sh_addralign); sections[sect_table_data+1].sh_offset = ftell(exportFile); relocationCount = 0; // TODO: This won't be needed if we put these in a separate section. POLYUNSIGNED areaSpace = 0; for (unsigned i = 0; i < memTableEntries; i++) areaSpace += memTable[i].mtLength; // Address of "memTable" within "exports". We can't use createRelocation because // the position of the relocation is not in either the mutable or the immutable area. size_t memTableOffset = sizeof(exportDescription); // It follows immediately after this. createStructsRelocation(AreaToSym(memTableEntries), offsetof(exportDescription, memTable), memTableOffset); // Address of "rootFunction" within "exports" unsigned rootAddrArea = findArea(rootFunction); size_t rootOffset = (char*)rootFunction - (char*)memTable[rootAddrArea].mtOriginalAddr; createStructsRelocation(AreaToSym(rootAddrArea), offsetof(exportDescription, rootFunction), rootOffset); // Addresses of the areas within memtable. for (unsigned i = 0; i < memTableEntries; i++) { createStructsRelocation(AreaToSym(i), sizeof(exportDescription) + i * sizeof(memoryTableEntry) + offsetof(memoryTableEntry, mtCurrentAddr), 0 /* No offset relative to base symbol*/); } sections[sect_table_data+1].sh_size = relocationCount * (USE_RELA ? sizeof(ElfXX_Rela) : sizeof(ElfXX_Rel)); // Now the symbol table. alignFile(sections[sect_symtab].sh_addralign); sections[sect_symtab].sh_offset = ftell(exportFile); writeSymbol("", 0, 0, 0, 0, 0); // Initial symbol // Write the local symbols first. writeSymbol("", 0, 0, STB_LOCAL, STT_SECTION, sect_data); // .data section // Create symbols for the address areas. AreaToSym assumes these come first. s = sect_data; for (unsigned i = 0; i < memTableEntries; i++) { char buff[50]; sprintf(buff, "area%1u", i); writeSymbol(buff, 0, 0, STB_LOCAL, STT_OBJECT, s); if ((memTable[i].mtFlags & (MTF_BYTES|MTF_WRITEABLE)) == MTF_BYTES) s += 1; else s += 2; } // Global symbols - Exported symbol for table. writeSymbol("poly_exports", 0, sizeof(exportDescription)+sizeof(memoryTableEntry)*memTableEntries, STB_GLOBAL, STT_OBJECT, sect_table_data); // External references for (unsigned i = 0; i < externTable.stringSize; i += (unsigned)strlen(externTable.strings+i) + 1) writeSymbol(externTable.strings+i, 0, 0, STB_GLOBAL, STT_FUNC, SHN_UNDEF); sections[sect_symtab].sh_info = EXTRA_SYMBOLS+memTableEntries; // One more than last local sym sections[sect_symtab].sh_size = sizeof(ElfXX_Sym) * symbolNum; // Now the binary data. unsigned dataSection = sect_data; for (unsigned i = 0; i < memTableEntries; i++) { sections[dataSection].sh_size = memTable[i].mtLength; alignFile(sections[dataSection].sh_addralign); sections[dataSection].sh_offset = ftell(exportFile); fwrite(memTable[i].mtOriginalAddr, 1, memTable[i].mtLength, exportFile); if ((memTable[i].mtFlags & (MTF_BYTES|MTF_WRITEABLE)) == MTF_BYTES) dataSection += 1; else dataSection += 2; } exportDescription exports; memset(&exports, 0, sizeof(exports)); exports.structLength = sizeof(exportDescription); exports.memTableSize = sizeof(memoryTableEntry); exports.memTableEntries = memTableEntries; exports.memTable = USE_RELA ? 0 : (memoryTableEntry *)memTableOffset; // Set the value to be the offset relative to the base of the area. We have set a relocation // already which will add the base of the area. exports.rootFunction = USE_RELA ? 0 : (void*)rootOffset; exports.timeStamp = getBuildTime(); exports.architecture = machineDependent->MachineArchitecture(); exports.rtsVersion = POLY_version_number; #ifdef POLYML32IN64 exports.originalBaseAddr = globalHeapBase; #else exports.originalBaseAddr = 0; #endif // Set the address values to zero before we write. They will always // be relative to their base symbol. for (unsigned i = 0; i < memTableEntries; i++) memTable[i].mtCurrentAddr = 0; // Now the binary data. alignFile(sections[sect_table_data].sh_addralign); sections[sect_table_data].sh_offset = ftell(exportFile); sections[sect_table_data].sh_size = sizeof(exportDescription) + memTableEntries*sizeof(memoryTableEntry); fwrite(&exports, sizeof(exports), 1, exportFile); fwrite(memTable, sizeof(memoryTableEntry), memTableEntries, exportFile); // The section name table sections[sect_sectionnametable].sh_offset = ftell(exportFile); fwrite(sectionStrings.strings, sectionStrings.stringSize, 1, exportFile); sections[sect_sectionnametable].sh_size = sectionStrings.stringSize; // The symbol name table sections[sect_stringtable].sh_offset = ftell(exportFile); fwrite(symStrings.strings, symStrings.stringSize, 1, exportFile); sections[sect_stringtable].sh_size = symStrings.stringSize; // Finally the section headers. alignFile(4); fhdr.e_shoff = ftell(exportFile); fwrite(sections, sizeof(ElfXX_Shdr) * numSections, 1, exportFile); // Rewind to rewrite the file header with the offset of the section headers. rewind(exportFile); fwrite(&fhdr, sizeof(fhdr), 1, exportFile); fclose(exportFile); exportFile = NULL; delete[]sections; } diff --git a/libpolyml/mpoly.cpp b/libpolyml/mpoly.cpp index f7f06f8a..8f547454 100644 --- a/libpolyml/mpoly.cpp +++ b/libpolyml/mpoly.cpp @@ -1,510 +1,534 @@ /* Title: Main program Copyright (c) 2000 Cambridge University Technical Services Limited Further development copyright David C.J. Matthews 2001-12, 2015, 2017-19, 2021 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 +#ifdef HAVE_ERRNO_H +#include +#endif + +#ifdef HAVE_SYS_RESOURCE_H +#include +#endif + #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)) #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)) #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)) 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]; } +#ifdef __HAIKU__ + // On Haiku, select() checks whether the first argument is higher + // than the current process' fd table, and errors out if not; so + // we make sure it is at least FD_SETSIZE + struct rlimit lim; + + if (getrlimit(RLIMIT_NOFILE, &lim) < 0) + Usage("Unable to get file limit: %s\n", strerror(errno)); + + if (lim.rlim_cur < FD_SETSIZE) + lim.rlim_cur = FD_SETSIZE; + + if (setrlimit(RLIMIT_NOFILE, &lim) < 0) + Usage("Unable to set file limit: %s\n", strerror(errno)); +#endif + 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)) SetupDDEHandler(lpszServiceName); // Windows: Start the DDE handler now we processed any service name. #endif #ifdef HAVE_PTHREAD_JIT_WRITE_PROTECT_NP pthread_jit_write_protect_np(false); // This may well write to exec memory. #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)) 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)) 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/network.cpp b/libpolyml/network.cpp index 872bce21..eb4bf682 100644 --- a/libpolyml/network.cpp +++ b/libpolyml/network.cpp @@ -1,2222 +1,2231 @@ /* Title: Network functions. Copyright (c) 2000-7, 2016, 2018, 2019, 2022 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 #ifdef HAVE_ARPA_INET_H #include #endif #ifdef HAVE_LIMITS_H #include #endif #ifndef HAVE_SOCKLEN_T typedef int socklen_t; #endif #if (defined(_WIN32)) #include #include // For getaddrinfo #else typedef int SOCKET; #endif #ifdef HAVE_WINDOWS_H #include #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 PolyNetworkGetAddrList(POLYUNSIGNED threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetSockTypeList(POLYUNSIGNED threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkCreateSocket(POLYUNSIGNED threadId, POLYUNSIGNED af, POLYUNSIGNED st, POLYUNSIGNED prot); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkSetOption(POLYUNSIGNED threadId, POLYUNSIGNED code, POLYUNSIGNED sock, POLYUNSIGNED opt); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetOption(POLYUNSIGNED threadId, POLYUNSIGNED code, POLYUNSIGNED arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkSetLinger(POLYUNSIGNED threadId, POLYUNSIGNED sock, POLYUNSIGNED linger); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetLinger(POLYUNSIGNED threadId, POLYUNSIGNED arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetPeerName(POLYUNSIGNED threadId, POLYUNSIGNED arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetSockName(POLYUNSIGNED threadId, POLYUNSIGNED arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkBytesAvailable(POLYUNSIGNED threadId, POLYUNSIGNED arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetAtMark(POLYUNSIGNED threadId, POLYUNSIGNED arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkBind(POLYUNSIGNED threadId, POLYUNSIGNED sock, POLYUNSIGNED addr); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkListen(POLYUNSIGNED threadId, POLYUNSIGNED sock, POLYUNSIGNED back); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkShutdown(POLYUNSIGNED threadId, POLYUNSIGNED skt, POLYUNSIGNED smode); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkCreateSocketPair(POLYUNSIGNED threadId, POLYUNSIGNED af, POLYUNSIGNED st, POLYUNSIGNED prot); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkUnixPathToSockAddr(POLYUNSIGNED threadId, POLYUNSIGNED arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkUnixSockAddrToPath(POLYUNSIGNED threadId, POLYUNSIGNED arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetServByName(POLYUNSIGNED threadId, POLYUNSIGNED servName); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetServByNameAndProtocol(POLYUNSIGNED threadId, POLYUNSIGNED servName, POLYUNSIGNED protName); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetServByPort(POLYUNSIGNED threadId, POLYUNSIGNED portNo); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetServByPortAndProtocol(POLYUNSIGNED threadId, POLYUNSIGNED portNo, POLYUNSIGNED protName); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetProtByName(POLYUNSIGNED threadId, POLYUNSIGNED protocolName); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetProtByNo(POLYUNSIGNED threadId, POLYUNSIGNED protoNo); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetHostName(POLYUNSIGNED threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetAddrInfo(POLYUNSIGNED threadId, POLYUNSIGNED hostName, POLYUNSIGNED addrFamily); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetNameInfo(POLYUNSIGNED threadId, POLYUNSIGNED sockAddr); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkCloseSocket(POLYUNSIGNED threadId, POLYUNSIGNED arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkSelect(POLYUNSIGNED threadId, POLYUNSIGNED fdVecTriple, POLYUNSIGNED maxMillisecs); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetSocketError(POLYUNSIGNED threadId, POLYUNSIGNED skt); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkConnect(POLYUNSIGNED threadId, POLYUNSIGNED skt, POLYUNSIGNED addr); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkAccept(POLYUNSIGNED threadId, POLYUNSIGNED skt); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkSend(POLYUNSIGNED threadId, POLYUNSIGNED args); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkSendTo(POLYUNSIGNED threadId, POLYUNSIGNED args); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkReceive(POLYUNSIGNED threadId, POLYUNSIGNED args); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkReceiveFrom(POLYUNSIGNED threadId, POLYUNSIGNED args); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetFamilyFromAddress(POLYUNSIGNED sockAddress); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetAddressAndPortFromIP4(POLYUNSIGNED threadId, POLYUNSIGNED sockAddress); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkCreateIP4Address(POLYUNSIGNED threadId, POLYUNSIGNED ip4Address, POLYUNSIGNED portNumber); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkReturnIP4AddressAny(POLYUNSIGNED threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetAddressAndPortFromIP6(POLYUNSIGNED threadId, POLYUNSIGNED sockAddress); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkCreateIP6Address(POLYUNSIGNED threadId, POLYUNSIGNED ip6Address, POLYUNSIGNED portNumber); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkReturnIP6AddressAny(POLYUNSIGNED threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkIP6AddressToString(POLYUNSIGNED threadId, POLYUNSIGNED ip6Address); POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkStringToIP6Address(POLYUNSIGNED threadId, POLYUNSIGNED stringRep); } #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)) 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 }, // This one should always be there. #endif #ifdef AF_NATM { "NATM", AF_NATM }, #endif #ifdef AF_ATM { "ATM", AF_ATM }, #endif #ifdef AF_NETGRAPH { "NETGRAPH", AF_NETGRAPH }, #endif #ifdef AF_CLUSTER { "CLUSTER", AF_CLUSTER }, #endif #ifdef AF_12844 { "12844", AF_12844 }, #endif #ifdef AF_IRDA { "IRDA", AF_IRDA }, #endif #ifdef AF_NETDES { "NETDES", AF_NETDES }, #endif #ifdef AF_TCNPROCESS { "TCNPROCESS", AF_TCNPROCESS }, #endif #ifdef AF_TCNMESSAGE { "TCNMESSAGE", AF_TCNMESSAGE }, #endif #ifdef AF_ICLFXBM { "ICLFXBM", AF_ICLFXBM }, #endif #ifdef AF_BTH { "BTH", AF_BTH }, #endif #ifdef AF_HYPERV { "HYPERV", AF_HYPERV }, #endif #ifdef AF_FILE { "FILE", AF_FILE }, #endif #ifdef AF_AX25 { "AX25", AF_AX25 }, #endif #ifdef AF_NETROM { "NETROM", AF_NETROM }, #endif #ifdef AF_BRIDGE { "BRIDGE", AF_BRIDGE }, #endif #ifdef AF_ATMPVC { "ATMPVC", AF_ATMPVC }, #endif #ifdef AF_X25 { "X25", AF_X25 }, #endif #ifdef AF_ROSE { "ROSE", AF_ROSE }, #endif #ifdef AF_NETBEUI { "NETBEUI", AF_NETBEUI }, #endif #ifdef AF_SECURITY { "SECURITY", AF_SECURITY }, #endif #ifdef AF_KEY { "KEY", AF_KEY }, #endif #ifdef AF_NETLINK { "NETLINK", AF_NETLINK }, #endif #ifdef AF_PACKET { "PACKET", AF_PACKET }, #endif #ifdef AF_ASH { "ASH", AF_ASH }, #endif #ifdef AF_ECONET { "ECONET", AF_ECONET }, #endif #ifdef AF_ATMSVC { "ATMSVC", AF_ATMSVC }, #endif #ifdef AF_RDS { "RDS", AF_RDS }, #endif #ifdef AF_PPPOX { "PPPOX", AF_PPPOX }, #endif #ifdef AF_WANPIPE { "WANPIPE", AF_WANPIPE }, #endif #ifdef AF_LLC { "LLC", AF_LLC }, #endif #ifdef AF_IB { "IB", AF_IB }, #endif #ifdef AF_MPLS { "MPLS", AF_MPLS }, #endif #ifdef AF_CAN { "CAN", AF_CAN }, #endif #ifdef AF_TIPC { "TIPC", AF_TIPC }, #endif #ifdef AF_BLUETOOTH { "BLUETOOTH", AF_BLUETOOTH }, #endif #ifdef AF_IUCV { "IUCV", AF_IUCV }, #endif #ifdef AF_RXRPC { "RXRPC", AF_RXRPC }, #endif #ifdef AF_PHONET { "PHONET", AF_PHONET }, #endif #ifdef AF_IEEE802154 { "IEEE802154", AF_IEEE802154 }, #endif #ifdef AF_CAIF { "CAIF", AF_CAIF }, #endif #ifdef AF_ALG { "ALG", AF_ALG }, #endif #ifdef AF_NFC { "NFC", AF_NFC }, #endif #ifdef AF_VSOCK { "VSOCK", AF_VSOCK }, #endif #ifdef AF_KCM { "KCM", AF_KCM }, #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 }, +#ifdef SOCK_RDM { "RDM", SOCK_RDM }, +#endif { "SEQPACKET", SOCK_SEQPACKET }, #ifdef SOCK_DCCP { "DCCP", SOCK_DCCP }, #endif }; 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 sockHandle, Handle optHandle, int level, int opt); static Handle getSocketOption(TaskData *taskData, Handle args, int level, int opt); #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 +// On Haiku, errors returned by getsockopt(SO_ERROR) will still be +// negative, in spite of B_USE_POSITIVE_POSIX_ERRORS/posix_error_mapper +#ifdef B_TO_POSITIVE_ERROR +#define TRANSLATE_SO_ERROR(x) (B_TO_POSITIVE_ERROR(x)) +#else +#define TRANSLATE_SO_ERROR(x) (x) +#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; } #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 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_fixed_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_fixed_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_fixed_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_fixed_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 sockHandle, Handle optHandle, int level, int opt) { SOCKET sock = getStreamSocket(taskData, sockHandle->Word()); int onOff = get_C_int(taskData, optHandle->Word()); if (setsockopt(sock, level, opt, (char*)&onOff, sizeof(int)) != 0) raise_syscall(taskData, "setsockopt failed", GETERROR); return Make_fixed_precision(taskData, 0); } // Get a socket option as an integer. static Handle getSocketOption(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_fixed_precision(taskData, optVal); } // Get and clear the error state for the socket. Returns a SysWord.word value. POLYUNSIGNED PolyNetworkGetSocketError(POLYUNSIGNED threadId, POLYUNSIGNED skt) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { SOCKET sock = getStreamSocket(taskData, PolyWord::FromUnsigned(skt)); int intVal = 0; socklen_t size = sizeof(int); if (getsockopt(sock, SOL_SOCKET, SO_ERROR, (char*)&intVal, &size) != 0) raise_syscall(taskData, "getsockopt failed", GETERROR); - result = Make_sysword(taskData, intVal); + result = Make_sysword(taskData, TRANSLATE_SO_ERROR(intVal)); } 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(); } // 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. */ POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkSelect(POLYUNSIGNED threadId, POLYUNSIGNED fdVecTriple, POLYUNSIGNED maxMillisecs) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; POLYUNSIGNED maxMilliseconds = PolyWord::FromUnsigned(maxMillisecs).UnTaggedUnsigned(); Handle fdVecTripleHandle = taskData->saveVec.push(fdVecTriple); /* Set up the bitmaps for the select call from the arrays. */ try { WaitSelect waitSelect((unsigned int)maxMilliseconds); PolyObject *readVec = fdVecTripleHandle->WordP()->Get(0).AsObjPtr(); PolyObject *writeVec = fdVecTripleHandle->WordP()->Get(1).AsObjPtr(); PolyObject *excVec = fdVecTripleHandle->WordP()->Get(2).AsObjPtr(); for (POLYUNSIGNED i = 0; i < readVec->Length(); i++) waitSelect.SetRead(getStreamSocket(taskData, readVec->Get(i))); for (POLYUNSIGNED i = 0; i < writeVec->Length(); i++) waitSelect.SetWrite(getStreamSocket(taskData, writeVec->Get(i))); for (POLYUNSIGNED i = 0; i < excVec->Length(); 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()); // Construct the result vectors. Handle rdResult = getSelectResult(taskData, fdVecTripleHandle, 0, &waitSelect); Handle wrResult = getSelectResult(taskData, fdVecTripleHandle, 1, &waitSelect); Handle exResult = getSelectResult(taskData, fdVecTripleHandle, 2, &waitSelect); result = ALLOC(3); DEREFHANDLE(result)->Set(0, rdResult->Word()); DEREFHANDLE(result)->Set(1, wrResult->Word()); DEREFHANDLE(result)->Set(2, exResult->Word()); } 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 PolyNetworkConnect(POLYUNSIGNED threadId, POLYUNSIGNED skt, POLYUNSIGNED addr) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); try { SOCKET sock = getStreamSocket(taskData, PolyWord::FromUnsigned(skt)); PolyStringObject * psAddr = (PolyStringObject *)(PolyWord::FromUnsigned(addr).AsObjPtr()); struct sockaddr *psock = (struct sockaddr *)&psAddr->chars; // Begin the connection. The socket is always non-blocking so this will return immediately. if (connect(sock, psock, (int)psAddr->length) != 0) raise_syscall(taskData, "connect failed", GETERROR); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); // Always returns unit } POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkAccept(POLYUNSIGNED threadId, POLYUNSIGNED skt) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { SOCKET sock = getStreamSocket(taskData, PolyWord::FromUnsigned(skt)); struct sockaddr_storage resultAddr; socklen_t addrLen = sizeof(resultAddr); SOCKET resultSkt = accept(sock, (struct sockaddr*)&resultAddr, &addrLen); if (resultSkt == INVALID_SOCKET) raise_syscall(taskData, "accept failed", GETERROR); if (addrLen > sizeof(resultAddr)) addrLen = sizeof(resultAddr); Handle addrHandle = taskData->saveVec.push(C_string_to_Poly(taskData, (char*)&resultAddr, addrLen)); // Return a pair of the new socket and the address. Handle resSkt = wrapStreamSocket(taskData, resultSkt); result = alloc_and_save(taskData, 2); result->WordP()->Set(0, resSkt->Word()); result->WordP()->Set(1, addrHandle->Word()); } 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 PolyNetworkSend(POLYUNSIGNED threadId, POLYUNSIGNED argsAsWord) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle args = taskData->saveVec.push(argsAsWord); #if(defined(_WIN32) && ! defined(_CYGWIN)) int sent = 0; #else ssize_t sent = 0; #endif try { SOCKET sock = getStreamSocket(taskData, DEREFHANDLE(args)->Get(0)); PolyWord pBase = DEREFHANDLE(args)->Get(1); POLYUNSIGNED offset = getPolyUnsigned(taskData, DEREFHANDLE(args)->Get(2)); #if(defined(_WIN32) && ! defined(_CYGWIN)) 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; char *base = (char*)pBase.AsObjPtr()->AsBytePtr(); sent = send(sock, base + offset, length, flags); if (sent == SOCKET_ERROR) raise_syscall(taskData, "send failed", GETERROR); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(sent).AsUnsigned(); } POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkSendTo(POLYUNSIGNED threadId, POLYUNSIGNED argsAsWord) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle args = taskData->saveVec.push(argsAsWord); #if(defined(_WIN32) && ! defined(_CYGWIN)) int sent = 0; #else ssize_t sent = 0; #endif try { SOCKET sock = getStreamSocket(taskData, DEREFHANDLE(args)->Get(0)); PolyStringObject * psAddr = (PolyStringObject *)args->WordP()->Get(1).AsObjPtr(); PolyWord pBase = DEREFHANDLE(args)->Get(2); POLYUNSIGNED offset = getPolyUnsigned(taskData, DEREFHANDLE(args)->Get(3)); #if(defined(_WIN32) && ! defined(_CYGWIN)) 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; char *base = (char*)pBase.AsObjPtr()->AsBytePtr(); sent = sendto(sock, base + offset, length, flags, (struct sockaddr *)psAddr->chars, (int)psAddr->length); if (sent == SOCKET_ERROR) raise_syscall(taskData, "sendto failed", GETERROR); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(sent).AsUnsigned(); } POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkReceive(POLYUNSIGNED threadId, POLYUNSIGNED argsAsWord) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle args = taskData->saveVec.push(argsAsWord); #if(defined(_WIN32) && ! defined(_CYGWIN)) int recvd = 0; #else ssize_t recvd = 0; #endif try { 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)) 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; recvd = recv(sock, base + offset, length, flags); if (recvd == SOCKET_ERROR) raise_syscall(taskData, "recv failed", GETERROR); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(recvd).AsUnsigned(); } POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkReceiveFrom(POLYUNSIGNED threadId, POLYUNSIGNED argsAsWord) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle args = taskData->saveVec.push(argsAsWord); Handle result = 0; try { 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)) 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; struct sockaddr_storage resultAddr; socklen_t addrLen = sizeof(resultAddr); if (peek != 0) flags |= MSG_PEEK; if (outOfBand != 0) flags |= MSG_OOB; #if(defined(_WIN32) && ! defined(_CYGWIN)) int recvd; #else ssize_t recvd; #endif recvd = recvfrom(sock, base + offset, length, flags, (struct sockaddr*)&resultAddr, &addrLen); if (recvd == SOCKET_ERROR) raise_syscall(taskData, "recvfrom failed", GETERROR); if (recvd > (int)length) recvd = length; Handle lengthHandle = Make_fixed_precision(taskData, recvd); if (addrLen > sizeof(resultAddr)) addrLen = sizeof(resultAddr); Handle addrHandle = SAVE(C_string_to_Poly(taskData, (char*)&resultAddr, addrLen)); result = ALLOC(2); DEREFHANDLE(result)->Set(0, lengthHandle->Word()); DEREFHANDLE(result)->Set(1, addrHandle->Word()); } 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(); } /* Return a list of known address families. */ POLYUNSIGNED PolyNetworkGetAddrList(POLYUNSIGNED threadId) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = makeList(taskData, sizeof(af_table) / sizeof(af_table[0]), (char*)af_table, sizeof(af_table[0]), 0, mkAftab); } 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(); } /* Return a list of known socket types. */ POLYUNSIGNED PolyNetworkGetSockTypeList(POLYUNSIGNED threadId) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = makeList(taskData, sizeof(sk_table) / sizeof(sk_table[0]), (char*)sk_table, sizeof(sk_table[0]), 0, mkSktab); } 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(); } // Create a socket */ POLYUNSIGNED PolyNetworkCreateSocket(POLYUNSIGNED threadId, POLYUNSIGNED family, POLYUNSIGNED st, POLYUNSIGNED prot) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; int af = (int)PolyWord::FromUnsigned(family).UnTagged(); int type = (int)PolyWord::FromUnsigned(st).UnTagged(); int proto = (int)PolyWord::FromUnsigned(prot).UnTagged(); try { SOCKET skt = 0; do { skt = socket(af, type, proto); } while (skt == INVALID_SOCKET && GETERROR == CALLINTERRUPTED); if (skt == INVALID_SOCKET) raise_syscall(taskData, "socket failed", GETERROR); /* Set the socket to non-blocking mode. */ #if (defined(_WIN32) && ! defined(__CYGWIN__)) 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__)) closesocket(skt); #else close(skt); #endif raise_syscall(taskData, "ioctl failed", GETERROR); } result = wrapStreamSocket(taskData, skt); } 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 PolyNetworkSetOption(POLYUNSIGNED threadId, POLYUNSIGNED code, POLYUNSIGNED sock, POLYUNSIGNED opt) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedSock = taskData->saveVec.push(sock); Handle pushedOpt = taskData->saveVec.push(opt); try { switch (UNTAGGED(PolyWord::FromUnsigned(code))) { case 15: /* Set TCP No-delay option. */ setSocketOption(taskData, pushedSock, pushedOpt, IPPROTO_TCP, TCP_NODELAY); break; case 17: /* Set Debug option. */ setSocketOption(taskData, pushedSock, pushedOpt, SOL_SOCKET, SO_DEBUG); break; case 19: /* Set REUSEADDR option. */ setSocketOption(taskData, pushedSock, pushedOpt, SOL_SOCKET, SO_REUSEADDR); break; case 21: /* Set KEEPALIVE option. */ setSocketOption(taskData, pushedSock, pushedOpt, SOL_SOCKET, SO_KEEPALIVE); break; case 23: /* Set DONTROUTE option. */ setSocketOption(taskData, pushedSock, pushedOpt, SOL_SOCKET, SO_DONTROUTE); break; case 25: /* Set BROADCAST option. */ setSocketOption(taskData, pushedSock, pushedOpt, SOL_SOCKET, SO_BROADCAST); break; case 27: /* Set OOBINLINE option. */ setSocketOption(taskData, pushedSock, pushedOpt, SOL_SOCKET, SO_OOBINLINE); break; case 29: /* Set SNDBUF size. */ setSocketOption(taskData, pushedSock, pushedOpt, SOL_SOCKET, SO_SNDBUF); break; case 31: /* Set RCVBUF size. */ setSocketOption(taskData, pushedSock, pushedOpt, SOL_SOCKET, SO_RCVBUF); break; } } catch (KillException&) { processes->ThreadExit(taskData); // May test for kill } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } POLYUNSIGNED PolyNetworkGetOption(POLYUNSIGNED threadId, POLYUNSIGNED code, POLYUNSIGNED 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 { switch (UNTAGGED(PolyWord::FromUnsigned(code))) { case 16: /* Get TCP No-delay option. */ result = getSocketOption(taskData, pushedArg, IPPROTO_TCP, TCP_NODELAY); break; case 18: /* Get Debug option. */ result = getSocketOption(taskData, pushedArg, SOL_SOCKET, SO_DEBUG); break; case 20: /* Get REUSEADDR option. */ result = getSocketOption(taskData, pushedArg, SOL_SOCKET, SO_REUSEADDR); break; case 22: /* Get KEEPALIVE option. */ result = getSocketOption(taskData, pushedArg, SOL_SOCKET, SO_KEEPALIVE); break; case 24: /* Get DONTROUTE option. */ result = getSocketOption(taskData, pushedArg, SOL_SOCKET, SO_DONTROUTE); break; case 26: /* Get BROADCAST option. */ result = getSocketOption(taskData, pushedArg, SOL_SOCKET, SO_BROADCAST); break; case 28: /* Get OOBINLINE option. */ result = getSocketOption(taskData, pushedArg, SOL_SOCKET, SO_OOBINLINE); break; case 30: /* Get SNDBUF size. */ result = getSocketOption(taskData, pushedArg, SOL_SOCKET, SO_SNDBUF); break; case 32: /* Get RCVBUF size. */ result = getSocketOption(taskData, pushedArg, SOL_SOCKET, SO_RCVBUF); break; case 33: /* Get socket type e.g. SOCK_STREAM. */ result = getSocketOption(taskData, pushedArg, SOL_SOCKET, SO_TYPE); break; } } 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 Linger time. */ POLYUNSIGNED PolyNetworkSetLinger(POLYUNSIGNED threadId, POLYUNSIGNED sock, POLYUNSIGNED lingerTime) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); try { SOCKET skt = getStreamSocket(taskData, PolyWord::FromUnsigned(sock)); int lTime = get_C_int(taskData, PolyWord::FromUnsigned(lingerTime)); struct linger linger; /* 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); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } /* Get Linger time. */ POLYUNSIGNED PolyNetworkGetLinger(POLYUNSIGNED threadId, POLYUNSIGNED sock) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { SOCKET skt = getStreamSocket(taskData, PolyWord::FromUnsigned(sock)); socklen_t size = sizeof(linger); int lTime = 0; struct linger linger; 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; result = Make_arbitrary_precision(taskData, lTime); // Returns LargeInt.int } 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(); } /* Get peer name. */ POLYUNSIGNED PolyNetworkGetPeerName(POLYUNSIGNED threadId, POLYUNSIGNED sock) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { SOCKET skt = getStreamSocket(taskData, PolyWord::FromUnsigned(sock)); struct sockaddr_storage sockA; socklen_t size = sizeof(sockA); if (getpeername(skt, (struct sockaddr*) & sockA, &size) != 0) raise_syscall(taskData, "getpeername failed", GETERROR); if (size > sizeof(sockA)) size = sizeof(sockA); /* Addresses are treated as strings. */ result = (SAVE(C_string_to_Poly(taskData, (char*)& sockA, size))); } 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(); } /* Get socket name. */ POLYUNSIGNED PolyNetworkGetSockName(POLYUNSIGNED threadId, POLYUNSIGNED sock) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { SOCKET skt = getStreamSocket(taskData, PolyWord::FromUnsigned(sock)); struct sockaddr_storage sockA; socklen_t size = sizeof(sockA); if (getsockname(skt, (struct sockaddr*) & sockA, &size) != 0) raise_syscall(taskData, "getsockname failed", GETERROR); if (size > sizeof(sockA)) size = sizeof(sockA); result = (SAVE(C_string_to_Poly(taskData, (char*)& sockA, size))); } 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(); } /* Find number of bytes available. */ POLYUNSIGNED PolyNetworkBytesAvailable(POLYUNSIGNED threadId, POLYUNSIGNED sock) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { SOCKET skt = getStreamSocket(taskData, PolyWord::FromUnsigned(sock)); #if (defined(_WIN32) && ! defined(__CYGWIN__)) 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 result = Make_fixed_precision(taskData, readable); } 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(); } /* Find out if we are at the mark. */ POLYUNSIGNED PolyNetworkGetAtMark(POLYUNSIGNED threadId, POLYUNSIGNED sock) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { SOCKET skt = getStreamSocket(taskData, PolyWord::FromUnsigned(sock)); #if (defined(_WIN32) && ! defined(__CYGWIN__)) 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 result = Make_fixed_precision(taskData, atMark == 0 ? 0 : 1); } 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(); } /* Bind an address to a socket. */ POLYUNSIGNED PolyNetworkBind(POLYUNSIGNED threadId, POLYUNSIGNED sock, POLYUNSIGNED addr) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); try { SOCKET skt = getStreamSocket(taskData, PolyWord::FromUnsigned(sock)); PolyStringObject* psAddr = (PolyStringObject*)PolyWord::FromUnsigned(addr).AsObjPtr(); struct sockaddr* psock = (struct sockaddr*) & psAddr->chars; if (bind(skt, psock, (int)psAddr->length) != 0) raise_syscall(taskData, "bind failed", GETERROR); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } /* Put socket into listening mode. */ POLYUNSIGNED PolyNetworkListen(POLYUNSIGNED threadId, POLYUNSIGNED skt, POLYUNSIGNED back) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); try { SOCKET sock = getStreamSocket(taskData, PolyWord::FromUnsigned(skt)); int backlog = get_C_int(taskData, PolyWord::FromUnsigned(back)); if (listen(sock, backlog) != 0) raise_syscall(taskData, "listen failed", GETERROR); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } /* Shutdown the socket. */ POLYUNSIGNED PolyNetworkShutdown(POLYUNSIGNED threadId, POLYUNSIGNED skt, POLYUNSIGNED smode) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); try { SOCKET sock = getStreamSocket(taskData, PolyWord::FromUnsigned(skt)); int mode = 0; switch (get_C_ulong(taskData, PolyWord::FromUnsigned(smode))) { 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); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } /* Create a socket pair. */ POLYUNSIGNED PolyNetworkCreateSocketPair(POLYUNSIGNED threadId, POLYUNSIGNED family, POLYUNSIGNED st, POLYUNSIGNED prot) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { #if (defined(_WIN32) && ! defined(__CYGWIN__)) /* Not implemented. */ raise_syscall(taskData, "socketpair not implemented", WSAEAFNOSUPPORT); #else int af = PolyWord::FromUnsigned(family).UnTagged(); int type = PolyWord::FromUnsigned(st).UnTagged(); int proto = PolyWord::FromUnsigned(prot).UnTagged(); SOCKET skt[2]; int skPRes = 0; do { skPRes = socketpair(af, type, proto, skt); } while (skPRes != 0 && GETERROR == CALLINTERRUPTED); int onOff = 1; /* 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. */ result = ALLOC(2); DEREFHANDLE(result)->Set(0, DEREFWORD(str_token1)); DEREFHANDLE(result)->Set(1, DEREFWORD(str_token2)); #endif } 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(); } /* Create a Unix socket address from a string. */ POLYUNSIGNED PolyNetworkUnixPathToSockAddr(POLYUNSIGNED threadId, POLYUNSIGNED arg) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { #if (defined(_WIN32) && ! defined(__CYGWIN__)) /* 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(PolyWord::FromUnsigned(arg), addr.sun_path, sizeof(addr.sun_path)); if (length > (int)sizeof(addr.sun_path)) raise_syscall(taskData, "Address too long", ENAMETOOLONG); result = SAVE(C_string_to_Poly(taskData, (char*)& addr, sizeof(addr))); #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(); } /* Get the file name from a Unix socket address. */ POLYUNSIGNED PolyNetworkUnixSockAddrToPath(POLYUNSIGNED threadId, POLYUNSIGNED arg) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { #if (defined(_WIN32) && ! defined(__CYGWIN__)) /* Not implemented. */ raise_syscall(taskData, "Unix addresses not implemented", WSAEAFNOSUPPORT); #else PolyStringObject* psAddr = (PolyStringObject*)PolyWord::FromUnsigned(arg).AsObjPtr(); struct sockaddr_un* psock = (struct sockaddr_un*) & psAddr->chars; result = SAVE(C_string_to_Poly(taskData, psock->sun_path)); #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(); } POLYUNSIGNED PolyNetworkGetServByName(POLYUNSIGNED threadId, POLYUNSIGNED 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(PolyWord::FromUnsigned(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(POLYUNSIGNED threadId, POLYUNSIGNED serviceName, POLYUNSIGNED 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(PolyWord::FromUnsigned(serviceName))); TempCString protoName(Poly_string_to_C_alloc(PolyWord::FromUnsigned(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(POLYUNSIGNED threadId, POLYUNSIGNED 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, PolyWord::FromUnsigned(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(POLYUNSIGNED threadId, POLYUNSIGNED portNo, POLYUNSIGNED 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, PolyWord::FromUnsigned(portNo))); TempCString protoName(Poly_string_to_C_alloc(PolyWord::FromUnsigned(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(POLYUNSIGNED threadId, POLYUNSIGNED 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(PolyWord::FromUnsigned(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(POLYUNSIGNED threadId, POLYUNSIGNED 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, PolyWord::FromUnsigned(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(POLYUNSIGNED 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. */ // Since the maximum length of a FQDN is 256 bytes it should fit in the buffer. #ifdef HOST_NAME_MAX char hostName[HOST_NAME_MAX+1]; #else char hostName[1024]; #endif int err = gethostname(hostName, sizeof(hostName)); if (err != 0) raise_syscall(taskData, "gethostname failed", GETERROR); // Add a null at the end just in case. See gethostname man page. hostName[sizeof(hostName) - 1] = 0; 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 PolyNetworkGetNameInfo(POLYUNSIGNED threadId, POLYUNSIGNED sockAddr) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { PolyStringObject* psAddr = (PolyStringObject*)PolyWord::FromUnsigned(sockAddr).AsObjPtr(); struct sockaddr* psock = (struct sockaddr*) & psAddr->chars; // Since the maximum length of a FQDN is 256 bytes it should fit in the buffer. char hostName[1024]; int gniRes = getnameinfo(psock, (socklen_t)psAddr->length, hostName, sizeof(hostName), NULL, 0, 0); if (gniRes != 0) { #if (defined(_WIN32) && ! defined(__CYGWIN__)) raise_syscall(taskData, "getnameinfo failed", GETERROR); #else if (gniRes == EAI_SYSTEM) raise_syscall(taskData, "getnameinfo failed", GETERROR); else raise_syscall(taskData, gai_strerror(gniRes), 0); #endif } 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(); } // Copy addrInfo data into ML memory. We copy this although most of it // is currently unused. static Handle extractAddrInfo(TaskData *taskData, struct addrinfo *ainfo) { if (ainfo == 0) return taskData->saveVec.push(ListNull); Handle reset = taskData->saveVec.mark(); Handle tail = extractAddrInfo(taskData, ainfo->ai_next); Handle name = 0; // Only the first entry may have a canonical name. if (ainfo->ai_canonname == 0) name = taskData->saveVec.push(C_string_to_Poly(taskData, "")); else name = taskData->saveVec.push(C_string_to_Poly(taskData, ainfo->ai_canonname)); Handle address = taskData->saveVec.push(C_string_to_Poly(taskData, (char*)ainfo->ai_addr, ainfo->ai_addrlen)); Handle value = alloc_and_save(taskData, 6); value->WordP()->Set(0, TAGGED(ainfo->ai_flags)); value->WordP()->Set(1, TAGGED(ainfo->ai_family)); value->WordP()->Set(2, TAGGED(ainfo->ai_socktype)); value->WordP()->Set(3, TAGGED(ainfo->ai_protocol)); value->WordP()->Set(4, address->Word()); value->WordP()->Set(5, name->Word()); ML_Cons_Cell *next = (ML_Cons_Cell*)alloc(taskData, SIZEOF(ML_Cons_Cell)); next->h = value->Word(); next->t = tail->Word(); taskData->saveVec.reset(reset); return taskData->saveVec.push(next); } POLYUNSIGNED PolyNetworkGetAddrInfo(POLYUNSIGNED threadId, POLYUNSIGNED hName, POLYUNSIGNED addrFamily) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; struct addrinfo *resAddr = 0; try { TempCString hostName(Poly_string_to_C_alloc(PolyWord::FromUnsigned(hName))); struct addrinfo hints; memset(&hints, 0, sizeof(hints)); hints.ai_family = (int)UNTAGGED(PolyWord::FromUnsigned(addrFamily)); // AF_INET or AF_INET6 or, possibly, AF_UNSPEC. hints.ai_flags = AI_CANONNAME; int gaiRes = getaddrinfo(hostName, 0, &hints, &resAddr); if (gaiRes != 0) { #if (defined(_WIN32) && ! defined(__CYGWIN__)) raise_syscall(taskData, "getaddrinfo failed", GETERROR); #else if (gaiRes == EAI_SYSTEM) raise_syscall(taskData, "getnameinfo failed", GETERROR); else raise_syscall(taskData, gai_strerror(gaiRes), 0); #endif } result = extractAddrInfo(taskData, resAddr); } catch (...) { } // Could raise an exception if we run out of heap space if (resAddr) freeaddrinfo(resAddr); taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } POLYUNSIGNED PolyNetworkCloseSocket(POLYUNSIGNED threadId, POLYUNSIGNED 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)) 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(); } // Return the family POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetFamilyFromAddress(POLYUNSIGNED sockAddress) { PolyStringObject* psAddr = (PolyStringObject*)PolyWord::FromUnsigned(sockAddress).AsObjPtr(); struct sockaddr* psock = (struct sockaddr*) & psAddr->chars; return TAGGED(psock->sa_family).AsUnsigned(); } // Return internet address and port from an internet socket address. // Assumes that we've already checked the address family. POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkGetAddressAndPortFromIP4(POLYUNSIGNED threadId, POLYUNSIGNED sockAddress) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { PolyStringObject* psAddr = (PolyStringObject*)PolyWord::FromUnsigned(sockAddress).AsObjPtr(); struct sockaddr_in* psock = (struct sockaddr_in*) & psAddr->chars; Handle ipAddr = Make_arbitrary_precision(taskData, ntohl(psock->sin_addr.s_addr)); // IPv4 addr is LargeInt.int result = alloc_and_save(taskData, 2); result->WordP()->Set(0, ipAddr->Word()); result->WordP()->Set(1, TAGGED(ntohs(psock->sin_port))); } 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(); } // Create a socket address from a port number and internet address. POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkCreateIP4Address(POLYUNSIGNED threadId, POLYUNSIGNED ip4Address, POLYUNSIGNED portNumber) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { struct sockaddr_in sockaddr; memset(&sockaddr, 0, sizeof(sockaddr)); sockaddr.sin_family = AF_INET; sockaddr.sin_port = htons(get_C_ushort(taskData, PolyWord::FromUnsigned(portNumber))); sockaddr.sin_addr.s_addr = htonl(get_C_unsigned(taskData, PolyWord::FromUnsigned(ip4Address))); result = SAVE(C_string_to_Poly(taskData, (char*)&sockaddr, sizeof(sockaddr))); } 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(); } // Return the value of INADDR_ANY. POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkReturnIP4AddressAny(POLYUNSIGNED threadId) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = Make_arbitrary_precision(taskData, INADDR_ANY); // IPv4 addr is LargeInt.int } 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 PolyNetworkGetAddressAndPortFromIP6(POLYUNSIGNED threadId, POLYUNSIGNED sockAddress) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { PolyStringObject* psAddr = (PolyStringObject*)PolyWord::FromUnsigned(sockAddress).AsObjPtr(); if (psAddr->length != sizeof(struct sockaddr_in6)) raise_fail(taskData, "Invalid length"); struct sockaddr_in6* psock = (struct sockaddr_in6*) & psAddr->chars; Handle ipAddr = SAVE(C_string_to_Poly(taskData, (const char*)&psock->sin6_addr, sizeof(struct in6_addr))); result = alloc_and_save(taskData, 2); result->WordP()->Set(0, ipAddr->Word()); result->WordP()->Set(1, TAGGED(ntohs(psock->sin6_port))); } 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 PolyNetworkCreateIP6Address(POLYUNSIGNED threadId, POLYUNSIGNED ip6Address, POLYUNSIGNED portNumber) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { struct sockaddr_in6 addr; memset(&addr, 0, sizeof(addr)); result = SAVE(C_string_to_Poly(taskData, (const char*)&addr, sizeof(struct in6_addr))); addr.sin6_family = AF_INET6; addr.sin6_port = htons(get_C_ushort(taskData, PolyWord::FromUnsigned(portNumber))); PolyStringObject* addrAsString = (PolyStringObject*)PolyWord::FromUnsigned(ip6Address).AsObjPtr(); if (addrAsString->length != sizeof(addr.sin6_addr)) raise_fail(taskData, "Invalid address length"); memcpy(&addr.sin6_addr, addrAsString->chars, sizeof(addr.sin6_addr)); result = SAVE(C_string_to_Poly(taskData, (char*)&addr, sizeof(addr))); } 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 PolyNetworkReturnIP6AddressAny(POLYUNSIGNED threadId) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = SAVE(C_string_to_Poly(taskData, (const char*)&in6addr_any, sizeof(struct in6_addr))); } 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(); } // Convert an IPV6 address to string. This could be done in ML but the rules // for converting zeros to double-colon are complicated. POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkIP6AddressToString(POLYUNSIGNED threadId, POLYUNSIGNED ip6Address) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { char buffer[80]; // 40 should actually be enough: 32 hex bytes, 7 colons and a null. PolyStringObject* addrAsString = (PolyStringObject*)PolyWord::FromUnsigned(ip6Address).AsObjPtr(); if (addrAsString->length != sizeof(struct in6_addr)) raise_fail(taskData, "Invalid address length"); if (inet_ntop(AF_INET6, addrAsString->chars, buffer, sizeof(buffer)) == 0) raise_syscall(taskData, "inet_ntop", GETERROR); result = SAVE(C_string_to_Poly(taskData, buffer)); } 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(); } // Convert a string to an IPv6 address. The parsing has to be done in ML. POLYEXTERNALSYMBOL POLYUNSIGNED PolyNetworkStringToIP6Address(POLYUNSIGNED threadId, POLYUNSIGNED stringRep) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { struct in6_addr address; TempCString stringAddr(Poly_string_to_C_alloc(PolyWord::FromUnsigned(stringRep))); if (inet_pton(AF_INET6, stringAddr, &address) != 1) raise_fail(taskData, "Invalid IPv6 address"); result = taskData->saveVec.push(C_string_to_Poly(taskData, (const char *)&address, sizeof(struct in6_addr))); } 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[] = { { "PolyNetworkGetAddrList", (polyRTSFunction)&PolyNetworkGetAddrList}, { "PolyNetworkGetSockTypeList", (polyRTSFunction)&PolyNetworkGetSockTypeList}, { "PolyNetworkCreateSocket", (polyRTSFunction)&PolyNetworkCreateSocket}, { "PolyNetworkSetOption", (polyRTSFunction)&PolyNetworkSetOption}, { "PolyNetworkGetOption", (polyRTSFunction)&PolyNetworkGetOption}, { "PolyNetworkSetLinger", (polyRTSFunction)&PolyNetworkSetLinger}, { "PolyNetworkGetLinger", (polyRTSFunction)&PolyNetworkGetLinger}, { "PolyNetworkGetPeerName", (polyRTSFunction)&PolyNetworkGetPeerName}, { "PolyNetworkGetSockName", (polyRTSFunction)&PolyNetworkGetSockName}, { "PolyNetworkBytesAvailable", (polyRTSFunction)&PolyNetworkBytesAvailable}, { "PolyNetworkGetAtMark", (polyRTSFunction)&PolyNetworkGetAtMark}, { "PolyNetworkBind", (polyRTSFunction)&PolyNetworkBind}, { "PolyNetworkListen", (polyRTSFunction)&PolyNetworkListen}, { "PolyNetworkShutdown", (polyRTSFunction)&PolyNetworkShutdown}, { "PolyNetworkCreateSocketPair", (polyRTSFunction)&PolyNetworkCreateSocketPair}, { "PolyNetworkUnixPathToSockAddr", (polyRTSFunction)&PolyNetworkUnixPathToSockAddr}, { "PolyNetworkUnixSockAddrToPath", (polyRTSFunction)&PolyNetworkUnixSockAddrToPath}, { "PolyNetworkGetServByName", (polyRTSFunction)&PolyNetworkGetServByName}, { "PolyNetworkGetServByNameAndProtocol", (polyRTSFunction)&PolyNetworkGetServByNameAndProtocol}, { "PolyNetworkGetServByPort", (polyRTSFunction)&PolyNetworkGetServByPort}, { "PolyNetworkGetServByPortAndProtocol", (polyRTSFunction)&PolyNetworkGetServByPortAndProtocol}, { "PolyNetworkGetProtByName", (polyRTSFunction)&PolyNetworkGetProtByName}, { "PolyNetworkGetProtByNo", (polyRTSFunction)&PolyNetworkGetProtByNo}, { "PolyNetworkGetHostName", (polyRTSFunction)&PolyNetworkGetHostName}, { "PolyNetworkGetNameInfo", (polyRTSFunction)&PolyNetworkGetNameInfo}, { "PolyNetworkCloseSocket", (polyRTSFunction)&PolyNetworkCloseSocket }, { "PolyNetworkSelect", (polyRTSFunction)&PolyNetworkSelect }, { "PolyNetworkGetSocketError", (polyRTSFunction)&PolyNetworkGetSocketError }, { "PolyNetworkConnect", (polyRTSFunction)&PolyNetworkConnect }, { "PolyNetworkAccept", (polyRTSFunction)&PolyNetworkAccept }, { "PolyNetworkSend", (polyRTSFunction)&PolyNetworkSend }, { "PolyNetworkSendTo", (polyRTSFunction)&PolyNetworkSendTo }, { "PolyNetworkReceive", (polyRTSFunction)&PolyNetworkReceive }, { "PolyNetworkReceiveFrom", (polyRTSFunction)&PolyNetworkReceiveFrom }, { "PolyNetworkGetAddrInfo", (polyRTSFunction)&PolyNetworkGetAddrInfo }, { "PolyNetworkGetFamilyFromAddress", (polyRTSFunction)&PolyNetworkGetFamilyFromAddress }, { "PolyNetworkGetAddressAndPortFromIP4", (polyRTSFunction)&PolyNetworkGetAddressAndPortFromIP4 }, { "PolyNetworkCreateIP4Address", (polyRTSFunction)&PolyNetworkCreateIP4Address }, { "PolyNetworkReturnIP4AddressAny", (polyRTSFunction)&PolyNetworkReturnIP4AddressAny }, { "PolyNetworkGetAddressAndPortFromIP6", (polyRTSFunction)&PolyNetworkGetAddressAndPortFromIP6 }, { "PolyNetworkCreateIP6Address", (polyRTSFunction)&PolyNetworkCreateIP6Address }, { "PolyNetworkReturnIP6AddressAny", (polyRTSFunction)&PolyNetworkReturnIP6AddressAny }, { "PolyNetworkIP6AddressToString", (polyRTSFunction)&PolyNetworkIP6AddressToString }, { "PolyNetworkStringToIP6Address", (polyRTSFunction)&PolyNetworkStringToIP6Address }, { 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)) #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)) if (winsock_init) WSACleanup(); winsock_init = 0; #endif }