diff --git a/PolyML/PolyML.vcxproj b/PolyML/PolyML.vcxproj index a32c72f9..866959b6 100644 --- a/PolyML/PolyML.vcxproj +++ b/PolyML/PolyML.vcxproj @@ -1,1071 +1,1087 @@  Debug32in64 Win32 Debug32in64 x64 DebugInt32in64 Win32 DebugInt32in64 x64 Debug Win32 DebugInterpreted Win32 DebugInterpreted x64 ReleaseInt32in64 Win32 ReleaseInt32in64 x64 ReleaseInterpreted Win32 ReleaseInterpreted x64 Release32in64 Win32 Release32in64 x64 Release Win32 Debug x64 Release x64 {0326c47a-00af-42cb-b87d-0369a241b570} {0ba5d5b5-f85b-4c49-8a27-67186fa68922} {1ba3e7a2-d64f-4ce3-9fe5-7846b855c19f} true true true true true true true true copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt true true true true true true false false true true false false true true true true true true true true copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt true true true true true true true true true true false true true true false true copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj true true true true copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt true true true true true true true true false true true true false true true true copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt true true true true true true true true true false true true true true true false copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt ..\polytemp.txt copy "%(FullPath)" ..\polytemp.txt ..\polytemp.txt true true true true true true true true true false true false true true true true cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml + $(IntDir)polyexport.obj + $(IntDir)polyexport.obj + $(IntDir)polyexport.obj + $(IntDir)polyexport.obj + $(IntDir)polyexport.obj + $(IntDir)polyexport.obj + $(IntDir)polyexport.obj + $(IntDir)polyexport.obj + $(IntDir)polyexport.obj + $(IntDir)polyexport.obj + $(IntDir)polyexport.obj + $(IntDir)polyexport.obj + $(IntDir)polyexport.obj + $(IntDir)polyexport.obj + $(IntDir)polyexport.obj + $(IntDir)polyexport.obj true true true true true true true true true true true true true true true true cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml cd .. $(OutDir)PolyImport.exe -H 32 "%(FullPath)" -o PolyML\$(IntDir)polyexport.obj < exportPoly.sml $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj $(IntDir)polyexport.obj {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF} Win32Proj PolyML 10.0 Application true v142 Unicode Application true v142 Unicode Application true v142 Unicode Application true v142 Unicode Application false v142 true Unicode Application false v142 true Unicode Application false v142 true Unicode Application false v142 true Unicode Application true v142 Unicode Application true v142 Unicode Application true v142 Unicode Application true v142 Unicode Application false v142 true Unicode Application false v142 true Unicode Application false v142 true Unicode Application false v142 true Unicode true true true true true true true true false false false false false false false false NotUsing Level3 Disabled WIN32;_DEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true libcmtd.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false NotUsing Level3 Disabled WIN32;_DEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true libcmtd.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false NotUsing Level3 Disabled WIN32;_DEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true libcmtd.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false NotUsing Level3 Disabled WIN32;_DEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true libcmtd.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false NotUsing Level3 Disabled _DEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true libcmtd.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false NotUsing Level3 Disabled _DEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true libcmtd.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false NotUsing Level3 Disabled _DEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true libcmtd.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false NotUsing Level3 Disabled _DEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true libcmtd.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false Level3 NotUsing MaxSpeed true true WIN32;NDEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true true true libcmt.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false Level3 NotUsing MaxSpeed true true WIN32;NDEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true true true libcmt.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false Level3 NotUsing MaxSpeed true true WIN32;NDEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true true true libcmt.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false Level3 NotUsing MaxSpeed true true WIN32;NDEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true true true libcmt.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false Level3 NotUsing MaxSpeed true true NDEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true true true libcmt.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false Level3 NotUsing MaxSpeed true true NDEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true true true libcmt.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false Level3 NotUsing MaxSpeed true true NDEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true true true libcmt.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false Level3 NotUsing MaxSpeed true true NDEBUG;_WINDOWS;%(PreprocessorDefinitions) Windows true true true libcmt.lib;kernel32.lib;user32.lib;gdi32.lib;winspool.lib;comdlg32.lib;advapi32.lib;shell32.lib;ole32.lib;oleaut32.lib;uuid.lib;odbc32.lib;odbccp32.lib;%(AdditionalDependencies) true 6.0 false \ No newline at end of file diff --git a/libpolyml/globals.h b/libpolyml/globals.h index c323a731..ed6e7f8c 100644 --- a/libpolyml/globals.h +++ b/libpolyml/globals.h @@ -1,415 +1,428 @@ /* Title: Globals for the system. Author: Dave Matthews, Cambridge University Computer Laboratory - Copyright David C. J. Matthews 2017-19 + Copyright David C. J. Matthews 2017-20 Copyright (c) 2000-7 Cambridge University Technical Services Limited - Further work copyright David C.J. Matthews 2006-18 - This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef _GLOBALS_H #define _GLOBALS_H /* Poly words, pointers and cells (objects). The garbage collector needs to be able to distinguish different uses of a memory word. We need to be able find which words are pointers to other objects and which are simple integers. The simple distinction is between integers, which are tagged by having the bottom bit set, and Addresses which are word aligned (bottom 2 bits zero on a 32 bit machine, bottom 3 bits on a 64 bit machine, bottom bit in 32-in-64). Addresses always point to the start of cells. The preceding word of a cell is the length word. This contains the length of the cell in words in the low-order 3 (7 in native 64-bits) bytes and a flag byte in the top byte. The flags give information about the type of the object. The length word is also used by the garbage collector and other object processors. */ #if HAVE_STDINT_H # include #endif #if HAVE_INTTYPES_H # ifndef __STDC_FORMAT_MACROS # define __STDC_FORMAT_MACROS # endif # include #elif (defined(_MSC_VER) && (_MSC_VER >= 1900)) // In VS 2015 and later we need to use # include #endif #ifdef HAVE_STDDEF_H # include #endif #define POLY_TAGSHIFT 1 #if (defined(_WIN32)) # include #endif #ifdef POLYML32IN64 typedef int32_t POLYSIGNED; typedef uint32_t POLYUNSIGNED; #define SIZEOF_POLYWORD 4 #else typedef intptr_t POLYSIGNED; typedef uintptr_t POLYUNSIGNED; #define SIZEOF_POLYWORD SIZEOF_VOIDP #endif // libpolyml uses printf-style I/O instead of C++ standard IOstreams, // so we need specifier to format POLYUNSIGNED/POLYSIGNED values. #ifdef POLYML32IN64 #if (defined(PRIu32)) # define POLYUFMT PRIu32 # define POLYSFMT PRId32 #elif (defined(_MSC_VER)) # define POLYUFMT "lu" # define POLYSFMT "ld" #else # define POLYUFMT "u" # define POLYSFMT "d" #endif #elif (defined(PRIuPTR)) # define POLYUFMT PRIuPTR # define POLYSFMT PRIdPTR #elif (defined(_MSC_VER) && (SIZEOF_POLYWORD == 8)) # define POLYUFMT "llu" # define POLYSFMT "lld" #else # define POLYUFMT "lu" // as before. Cross your fingers. # define POLYSFMT "ld" // idem. #endif // We can use the C99 %zu in most cases except MingW since it uses // the old msvcrt and that only supports C89. #if (defined(_WIN32) && (! defined(_MSC_VER) || _MSC_VER < 1800)) # if (SIZEOF_VOIDP == 8) # define PRI_SIZET PRIu64 # else # define PRI_SIZET PRIu32 # endif #else # define PRI_SIZET "zu" #endif typedef unsigned char byte; class PolyObject; typedef PolyObject *POLYOBJPTR; #ifdef POLYML32IN64 class PolyWord; extern PolyWord *globalHeapBase, *globalCodeBase; typedef uint32_t POLYOBJECTPTR; // This is an index into globalHeapBase // If a 64-bit value if in the range of the object pointers. inline bool IsHeapAddress(void *addr) { return (uintptr_t)addr <= 0xffffffff; } #else typedef POLYOBJPTR POLYOBJECTPTR; inline bool IsHeapAddress(void *) { return true; } #endif typedef byte *POLYCODEPTR; class PolyWord { public: // Initialise to TAGGED(0). This is very rarely used. PolyWord() { contents.unsignedInt = 1; } // Integers need to be tagged. static PolyWord TaggedInt(POLYSIGNED s) { return PolyWord((s << POLY_TAGSHIFT) | (POLYSIGNED)0x01); } static PolyWord TaggedUnsigned(POLYUNSIGNED u) { return PolyWord((u << POLY_TAGSHIFT) | 0x01); } static PolyWord FromStackAddr(PolyWord *sp) { return PolyWord(sp); } static PolyWord FromCodePtr(POLYCODEPTR p) { return PolyWord(p); } // Tests for the various cases. bool IsTagged(void) const { return (contents.unsignedInt & 1) != 0; } #ifndef POLYML32IN64 // In native 32-bit and 64-bit addresses are on word boundaries bool IsDataPtr(void) const { return (contents.unsignedInt & (sizeof(PolyWord) - 1)) == 0; } #else // In 32-in-64 addresses are anything that isn't tagged. bool IsDataPtr(void) const { return (contents.unsignedInt & 1) == 0; } #ifdef POLYML32IN64DEBUG static POLYOBJECTPTR AddressToObjectPtr(void *address); #else static POLYOBJECTPTR AddressToObjectPtr(void *address) { return (POLYOBJECTPTR)((PolyWord*)address - globalHeapBase); } #endif #endif // Extract the various cases. POLYSIGNED UnTagged(void) const { return contents.signedInt >> POLY_TAGSHIFT; } POLYUNSIGNED UnTaggedUnsigned(void) const { return contents.unsignedInt >> POLY_TAGSHIFT; } #ifdef POLYML32IN64 PolyWord(POLYOBJPTR p) { contents.objectPtr = AddressToObjectPtr(p); } PolyWord *AsStackAddr(PolyWord *base = globalHeapBase) const { return base + contents.objectPtr; } POLYOBJPTR AsObjPtr(PolyWord *base = globalHeapBase) const { return (POLYOBJPTR)AsStackAddr(base); } #else // An object pointer can become a word directly. PolyWord(POLYOBJPTR p) { contents.objectPtr = p; } POLYOBJPTR AsObjPtr(PolyWord *base = 0) const { return contents.objectPtr; } PolyWord *AsStackAddr(PolyWord *base=0) const { return (PolyWord *)contents.objectPtr; } #endif POLYCODEPTR AsCodePtr(void) const { return (POLYCODEPTR)AsObjPtr(); } void *AsAddress(void)const { return AsCodePtr(); } // There are a few cases where we need to store and extract untagged values static PolyWord FromUnsigned(POLYUNSIGNED u) { return PolyWord(u); } static PolyWord FromSigned(POLYSIGNED s) { return PolyWord(s); } POLYUNSIGNED AsUnsigned(void) const { return contents.unsignedInt; } POLYSIGNED AsSigned(void) const { return contents.signedInt; } protected: PolyWord(POLYSIGNED s) { contents.signedInt = s; } PolyWord(POLYUNSIGNED u) { contents.unsignedInt = u; } public: bool operator == (PolyWord b) const { return contents.unsignedInt == b.contents.unsignedInt; } bool operator != (PolyWord b) const { return contents.unsignedInt != b.contents.unsignedInt; } protected: #ifdef POLYML32IN64 PolyWord(PolyWord *sp) { contents.objectPtr = AddressToObjectPtr(sp); } PolyWord(POLYCODEPTR p) { contents.objectPtr = AddressToObjectPtr(p); } #else PolyWord(PolyWord *sp) { contents.objectPtr = (PolyObject*)sp; } PolyWord(POLYCODEPTR p) { contents.objectPtr = (PolyObject*)p; } #endif union { POLYSIGNED signedInt; // A tagged integer - lowest bit set POLYUNSIGNED unsignedInt; // A tagged integer - lowest bit set POLYOBJECTPTR objectPtr; // Object pointer - lowest bit clear. } contents; }; //typedef PolyWord POLYWORD; inline bool OBJ_IS_AN_INTEGER(const PolyWord & a) { return a.IsTagged(); } inline bool OBJ_IS_DATAPTR(const PolyWord & a) { return a.IsDataPtr(); } // The maximum tagged signed number is one less than 0x80 shifted into the top byte then shifted down // by the tag shift. #define MAXTAGGED (((POLYSIGNED)0x80 << (POLYSIGNED)(8*(sizeof(PolyWord)-1) -POLY_TAGSHIFT)) -1) inline PolyWord TAGGED(POLYSIGNED a) { return PolyWord::TaggedInt(a); } inline POLYSIGNED UNTAGGED(PolyWord a) { return a.UnTagged(); } inline POLYUNSIGNED UNTAGGED_UNSIGNED(PolyWord a) { return a.UnTaggedUnsigned(); } #define IS_INT(x) ((x).IsTagged()) /* length word flags */ #define OBJ_PRIVATE_FLAGS_SHIFT (8 * (sizeof(PolyWord) - 1)) #define _TOP_BYTE(x) ((POLYUNSIGNED)(x) << OBJ_PRIVATE_FLAGS_SHIFT) // Bottom two bits define the content format. // Zero bits mean ordinary word object containing addresses or tagged integers. #define F_BYTE_OBJ 0x01 /* byte object (contains no pointers) */ #define F_CODE_OBJ 0x02 /* code object (mixed bytes and words) */ #define F_CLOSURE_OBJ 0x03 /* closure (32-in-64 only). First word is code addr. */ #define F_GC_MARK 0x04 // Used during the GC marking phase #define F_NO_OVERWRITE 0x08 /* don't overwrite when loading - mutables only. */ // This bit is overloaded and has different meanings depending on what other bits are set. // For byte objects it is the sign bit for arbitrary precision ints. // For other data it indicates either that the object is a profile block or contains // information for allocation profiling. #define F_NEGATIVE_BIT 0x10 // Sign bit for arbitrary precision ints (byte segs only) #define F_PROFILE_BIT 0x10 // Object has a profile pointer (word segs only) #define F_WEAK_BIT 0x20 /* object contains weak references to option values. */ // The Weak bit is only used on mutables. The data sharing (sharedata.cpp) uses this with // immutables to indicate that the length field is being used to store the "depth". #define F_MUTABLE_BIT 0x40 /* object is mutable */ #define F_TOMBSTONE_BIT 0x80 // Object is a forwarding pointer #define F_PRIVATE_FLAGS_MASK 0xFF // Shifted bits #define _OBJ_BYTE_OBJ _TOP_BYTE(F_BYTE_OBJ) /* byte object (contains no pointers) */ #define _OBJ_CODE_OBJ _TOP_BYTE(F_CODE_OBJ) /* code object (mixed bytes and words) */ #define _OBJ_CLOSURE_OBJ _TOP_BYTE(F_CLOSURE_OBJ) // closure (32-in-64 only). First word is code addr. #define _OBJ_GC_MARK _TOP_BYTE(F_GC_MARK) // Mark bit #define _OBJ_NO_OVERWRITE _TOP_BYTE(F_NO_OVERWRITE) /* don't overwrite when loading - mutables only. */ #define _OBJ_NEGATIVE_BIT _TOP_BYTE(F_NEGATIVE_BIT) /* sign bit for arbitrary precision ints */ #define _OBJ_PROFILE_BIT _TOP_BYTE(F_PROFILE_BIT) /* sign bit for arbitrary precision ints */ #define _OBJ_WEAK_BIT _TOP_BYTE(F_WEAK_BIT) #define _OBJ_MUTABLE_BIT _TOP_BYTE(F_MUTABLE_BIT) /* object is mutable */ #define _OBJ_TOMBSTONE_BIT _TOP_BYTE(F_TOMBSTONE_BIT) // object is a tombstone. #define _OBJ_PRIVATE_FLAGS_MASK _TOP_BYTE(F_PRIVATE_FLAGS_MASK) #define _OBJ_PRIVATE_LENGTH_MASK ((-1) ^ _OBJ_PRIVATE_FLAGS_MASK) #define MAX_OBJECT_SIZE _OBJ_PRIVATE_LENGTH_MASK // inline bool OBJ_IS_LENGTH(POLYUNSIGNED L) { return ((L & _OBJ_TOMBSTONE_BIT) == 0); } /* these should only be applied to proper length words */ /* discards GC flag, mutable bit and weak bit. */ inline byte GetTypeBits(POLYUNSIGNED L) { return (byte)(L >> OBJ_PRIVATE_FLAGS_SHIFT) & 0x03; } inline POLYUNSIGNED OBJ_OBJECT_LENGTH(POLYUNSIGNED L) { return L & _OBJ_PRIVATE_LENGTH_MASK; } inline bool OBJ_IS_BYTE_OBJECT(POLYUNSIGNED L) { return (GetTypeBits(L) == F_BYTE_OBJ); } inline bool OBJ_IS_CODE_OBJECT(POLYUNSIGNED L) { return (GetTypeBits(L) == F_CODE_OBJ); } inline bool OBJ_IS_CLOSURE_OBJECT(POLYUNSIGNED L) { return (GetTypeBits(L) == F_CLOSURE_OBJ); } inline bool OBJ_IS_NO_OVERWRITE(POLYUNSIGNED L) { return ((L & _OBJ_NO_OVERWRITE) != 0); } inline bool OBJ_IS_NEGATIVE(POLYUNSIGNED L) { return ((L & _OBJ_NEGATIVE_BIT) != 0); } inline bool OBJ_HAS_PROFILE(POLYUNSIGNED L) { return ((L & _OBJ_PROFILE_BIT) != 0); } inline bool OBJ_IS_MUTABLE_OBJECT(POLYUNSIGNED L) { return ((L & _OBJ_MUTABLE_BIT) != 0); } inline bool OBJ_IS_WEAKREF_OBJECT(POLYUNSIGNED L) { return ((L & _OBJ_WEAK_BIT) != 0); } /* Don't need to worry about whether shift is signed, because OBJ_PRIVATE_USER_FLAGS_MASK removes the sign bit. We don't want the GC bit (which should be 0) anyway. */ #define OBJ_PRIVATE_USER_FLAGS_MASK _TOP_BYTE(0x7F) #define OBJ_IS_WORD_OBJECT(L) (GetTypeBits(L) == 0) /* case 2 - forwarding pointer */ inline bool OBJ_IS_POINTER(POLYUNSIGNED L) { return (L & _OBJ_TOMBSTONE_BIT) != 0; } #ifdef POLYML32IN64 inline PolyObject *OBJ_GET_POINTER(POLYUNSIGNED L) { return (PolyObject*)(globalHeapBase + ((L & ~_OBJ_TOMBSTONE_BIT) << 1)); } inline POLYUNSIGNED OBJ_SET_POINTER(PolyObject *pt) { return PolyWord::AddressToObjectPtr(pt) >> 1 | _OBJ_TOMBSTONE_BIT; } #else inline PolyObject *OBJ_GET_POINTER(POLYUNSIGNED L) { return (PolyObject*)(( L & ~_OBJ_TOMBSTONE_BIT) <<2); } inline POLYUNSIGNED OBJ_SET_POINTER(PolyObject *pt) { return ((POLYUNSIGNED)pt >> 2) | _OBJ_TOMBSTONE_BIT; } #endif // An object i.e. a piece of allocated memory in the heap. In the simplest case this is a // tuple, a list cons cell, a string or a ref. Every object has a length word in the word before // where its address points. The top byte of this contains flags. class PolyObject { public: byte *AsBytePtr(void)const { return (byte*)this; } PolyWord *AsWordPtr(void)const { return (PolyWord*)this; } POLYUNSIGNED LengthWord(void)const { return ((PolyWord*)this)[-1].AsUnsigned(); } POLYUNSIGNED Length(void)const { return OBJ_OBJECT_LENGTH(LengthWord()); } // Get and set a word PolyWord Get(POLYUNSIGNED i) const { return ((PolyWord*)this)[i]; } void Set(POLYUNSIGNED i, PolyWord v) { ((PolyWord*)this)[i] = v; } PolyWord *Offset(POLYUNSIGNED i) const { return ((PolyWord*)this)+i; } // Create a length word from a length and the flags in the top byte. void SetLengthWord(POLYUNSIGNED l, byte f) { ((POLYUNSIGNED*)this)[-1] = l | ((POLYUNSIGNED)f << OBJ_PRIVATE_FLAGS_SHIFT); } void SetLengthWord(POLYUNSIGNED l) { ((PolyWord*)this)[-1] = PolyWord::FromUnsigned(l); } bool IsByteObject(void) const { return OBJ_IS_BYTE_OBJECT(LengthWord()); } bool IsCodeObject(void) const { return OBJ_IS_CODE_OBJECT(LengthWord()); } bool IsClosureObject(void) const { return OBJ_IS_CLOSURE_OBJECT(LengthWord()); } bool IsWordObject(void) const { return OBJ_IS_WORD_OBJECT(LengthWord()); } bool IsMutable(void) const { return OBJ_IS_MUTABLE_OBJECT(LengthWord()); } bool IsWeakRefObject(void) const { return OBJ_IS_WEAKREF_OBJECT(LengthWord()); } bool IsNoOverwriteObject(void) const { return OBJ_IS_NO_OVERWRITE(LengthWord()); } bool ContainsForwardingPtr(void) const { return OBJ_IS_POINTER(LengthWord()); } PolyObject *GetForwardingPtr(void) const { return OBJ_GET_POINTER(LengthWord()); } void SetForwardingPtr(PolyObject *newp) { ((PolyWord*)this)[-1] = PolyWord::FromUnsigned(OBJ_SET_POINTER(newp)); } bool ContainsNormalLengthWord(void) const { return OBJ_IS_LENGTH(LengthWord()); } // Find the start of the constant section for a piece of code. // The first of these is really only needed because we may have objects whose length // words have been overwritten. void GetConstSegmentForCode(POLYUNSIGNED obj_length, PolyWord * &cp, POLYUNSIGNED &count) const { PolyWord *last_word = Offset(obj_length - 1); // Last word in the code count = last_word->AsUnsigned(); // This is the number of consts cp = last_word - count; } void GetConstSegmentForCode(PolyWord * &cp, POLYUNSIGNED &count) const { GetConstSegmentForCode(Length(), cp, count); } PolyWord *ConstPtrForCode(void) const { PolyWord *cp; POLYUNSIGNED count; GetConstSegmentForCode(cp, count); return cp; } // Follow a chain of forwarding pointers PolyObject *FollowForwardingChain(void) { if (ContainsForwardingPtr()) return GetForwardingPtr()->FollowForwardingChain(); else return this; } }; +// Stacks are native-words size even in 32-in-64. +union stackItem +{ + stackItem(PolyWord v) { argValue = v.AsUnsigned(); } + stackItem() { argValue = TAGGED(0).AsUnsigned(); } + + // These return the low order word. + PolyWord w()const { return PolyWord::FromUnsigned((POLYUNSIGNED)argValue); } + operator PolyWord () { return PolyWord::FromUnsigned((POLYUNSIGNED)argValue); } + POLYCODEPTR codeAddr; // Return addresses + stackItem* stackAddr; // Stack addresses + uintptr_t argValue; // Treat an address as an int +}; + + /* There was a problem with version 2.95 on Sparc/Solaris at least. The PolyObject class has no members so classes derived from it e.g. ML_Cons_Cell should begin at the beginning of the object. Later versions of GCC get this right. */ #if defined(__GNUC__) && (__GNUC__ <= 2) #error Poly/ML requires GCC version 3 or newer #endif inline POLYUNSIGNED GetLengthWord(PolyWord p) { return p.AsObjPtr()->LengthWord(); } // Get the length of an object. inline POLYUNSIGNED OBJECT_LENGTH(PolyWord p) { return OBJ_OBJECT_LENGTH(GetLengthWord(p)); } // A list cell. This can be passed to or returned from certain RTS functions. class ML_Cons_Cell: public PolyObject { public: PolyWord h; PolyWord t; #define ListNull (TAGGED(0)) static bool IsNull(PolyWord p) { return p == ListNull; } }; /* An exception packet. This contains an identifier (either a tagged integer for RTS exceptions or the address of a mutable for those created within ML), a string name for printing and an exception argument value. */ class PolyException: public PolyObject { public: PolyWord ex_id; /* Exc identifier */ PolyWord ex_name;/* Exc name */ PolyWord arg; /* Exc arguments */ PolyWord ex_location; // Location of "raise". Always zero for RTS exceptions. }; typedef PolyException poly_exn; /* Macro to round a number of bytes up to a number of words. */ #define WORDS(s) ((s+sizeof(PolyWord)-1)/sizeof(PolyWord)) /********************************************************************** * * Representation of option type. * **********************************************************************/ #define NONE_VALUE (TAGGED(0)) /* SOME x is represented by a single word cell containing x. */ #if (defined(_WIN32)) /* Windows doesn't include 0x in %p format. */ #define ZERO_X "0x" #else #define ZERO_X "" #endif #endif diff --git a/libpolyml/int_opcodes.h b/libpolyml/int_opcodes.h index 36c4611c..91342fb9 100644 --- a/libpolyml/int_opcodes.h +++ b/libpolyml/int_opcodes.h @@ -1,280 +1,282 @@ /* Title: Definitions for the code-tree instructions. Author: Dave Matthews, Cambridge University Computer Laboratory Copyright (c) 2000 Cambridge University Technical Services Limited Further development Copyright David C.J. Matthews 2015-18, 2020. 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 */ #define INSTR_jump8 0x02 #define INSTR_jump8false 0x03 #define INSTR_loadMLWord 0x04 #define INSTR_storeMLWord 0x05 #define INSTR_alloc_ref 0x06 #define INSTR_blockMoveWord 0x07 #define INSTR_loadUntagged 0x08 #define INSTR_storeUntagged 0x09 #define INSTR_case16 0x0a #define INSTR_call_closure 0x0c #define INSTR_return_w 0x0d #define INSTR_stack_containerB 0x0e #define INSTR_raise_ex 0x10 #define INSTR_callConstAddr16 0x11 #define INSTR_callConstAddr8 0x12 #define INSTR_local_w 0x13 #define INSTR_callLocalB 0x16 #define INSTR_constAddr16 0x1a #define INSTR_const_int_w 0x1b #define INSTR_jump_back8 0x1e #define INSTR_return_b 0x1f #define INSTR_jump_back16 0x20 #define INSTR_indirectLocalBB 0x21 #define INSTR_local_b 0x22 #define INSTR_indirect_b 0x23 #define INSTR_moveToContainerB 0x24 #define INSTR_set_stack_val_b 0x25 #define INSTR_reset_b 0x26 #define INSTR_reset_r_b 0x27 #define INSTR_const_int_b 0x28 #define INSTR_local_0 0x29 #define INSTR_local_1 0x2a #define INSTR_local_2 0x2b #define INSTR_local_3 0x2c #define INSTR_local_4 0x2d #define INSTR_local_5 0x2e #define INSTR_local_6 0x2f #define INSTR_local_7 0x30 #define INSTR_local_8 0x31 #define INSTR_local_9 0x32 #define INSTR_local_10 0x33 #define INSTR_local_11 0x34 #define INSTR_indirect_0 0x35 #define INSTR_indirect_1 0x36 #define INSTR_indirect_2 0x37 #define INSTR_indirect_3 0x38 #define INSTR_indirect_4 0x39 #define INSTR_indirect_5 0x3a #define INSTR_const_0 0x3b #define INSTR_const_1 0x3c #define INSTR_const_2 0x3d #define INSTR_const_3 0x3e #define INSTR_const_4 0x3f #define INSTR_const_10 0x40 #define INSTR_return_0Legacy 0x41 #define INSTR_return_1 0x42 #define INSTR_return_2 0x43 #define INSTR_return_3 0x44 #define INSTR_local_12 0x45 #define INSTR_jump8True 0x46 #define INSTR_jump16True 0x47 #define INSTR_local_13 0x49 #define INSTR_local_14 0x4a #define INSTR_local_15 0x4b #define INSTR_reset_1 0x50 #define INSTR_reset_2 0x51 #define INSTR_indirectClosureBB 0x54 #define INSTR_tuple_containerLegacy 0x55 #define INSTR_reset_r_1 0x64 #define INSTR_reset_r_2 0x65 #define INSTR_reset_r_3 0x66 #define INSTR_tuple_b 0x68 #define INSTR_tuple_2 0x69 #define INSTR_tuple_3 0x6a #define INSTR_tuple_4 0x6b #define INSTR_lock 0x6c #define INSTR_ldexc 0x6d #define INSTR_indirectContainerB 0x74 #define INSTR_moveToMutClosureB 0x75 #define INSTR_allocMutClosureB 0x76 #define INSTR_indirectClosureB0 0x77 #define INSTR_push_handler 0x78 #define INSTR_indirectClosureB1 0x7a #define INSTR_tail_b_b 0x7b #define INSTR_indirectClosureB2 0x7c #define INSTR_tail_3_bLegacy 0x7d #define INSTR_tail_4_bLegacy 0x7e #define INSTR_tail_3_2Legacy 0x7f #define INSTR_tail_3_3Legacy 0x80 #define INSTR_setHandler8 0x81 #define INSTR_callFastRTS0 0x83 #define INSTR_callFastRTS1 0x84 #define INSTR_callFastRTS2 0x85 #define INSTR_callFastRTS3 0x86 #define INSTR_callFastRTS4 0x87 #define INSTR_callFastRTS5 0x88 #define INSTR_callFullRTS0 0x89 // Legacy #define INSTR_callFullRTS1 0x8a // Legacy #define INSTR_callFullRTS2 0x8b // Legacy #define INSTR_callFullRTS3 0x8c // Legacy #define INSTR_callFullRTS4 0x8d // Legacy #define INSTR_callFullRTS5 0x8e // Legacy #define INSTR_notBoolean 0x91 #define INSTR_isTagged 0x92 #define INSTR_cellLength 0x93 #define INSTR_cellFlags 0x94 #define INSTR_clearMutable 0x95 #define INSTR_atomicIncr 0x97 #define INSTR_atomicDecr 0x98 #define INSTR_equalWord 0xa0 #define INSTR_lessSigned 0xa2 #define INSTR_lessUnsigned 0xa3 #define INSTR_lessEqSigned 0xa4 #define INSTR_lessEqUnsigned 0xa5 #define INSTR_greaterSigned 0xa6 #define INSTR_greaterUnsigned 0xa7 #define INSTR_greaterEqSigned 0xa8 #define INSTR_greaterEqUnsigned 0xa9 #define INSTR_fixedAdd 0xaa #define INSTR_fixedSub 0xab #define INSTR_fixedMult 0xac #define INSTR_fixedQuot 0xad #define INSTR_fixedRem 0xae #define INSTR_wordAdd 0xb1 #define INSTR_wordSub 0xb2 #define INSTR_wordMult 0xb3 #define INSTR_wordDiv 0xb4 #define INSTR_wordMod 0xb5 #define INSTR_wordAnd 0xb7 #define INSTR_wordOr 0xb8 #define INSTR_wordXor 0xb9 #define INSTR_wordShiftLeft 0xba #define INSTR_wordShiftRLog 0xbb #define INSTR_allocByteMem 0xbd #define INSTR_indirectLocalB1 0xc1 #define INSTR_isTaggedLocalB 0xc2 #define INSTR_jumpNEqLocalInd 0xc3 #define INSTR_jumpTaggedLocal 0xc4 #define INSTR_jumpNEqLocal 0xc5 #define INSTR_indirect0Local0 0xc6 #define INSTR_indirectLocalB0 0xc7 +#define INSTR_closureB 0xd0 #define INSTR_getThreadId 0xd9 #define INSTR_allocWordMemory 0xda #define INSTR_loadMLWordLegacy 0xdb #define INSTR_loadMLByte 0xdc #define INSTR_storeMLWordLegacy 0xe3 #define INSTR_storeMLByte 0xe4 #define INSTR_blockMoveWordLegacy 0xeb #define INSTR_blockMoveByte 0xec #define INSTR_blockEqualByte 0xed #define INSTR_blockCompareByte 0xee #define INSTR_loadUntaggedLegacy 0xef #define INSTR_storeUntaggedLegacy 0xf0 #define INSTR_deleteHandler 0xf1 #define INSTR_jump16 0xf7 #define INSTR_jump16false 0xf8 #define INSTR_setHandler16 0xf9 #define INSTR_constAddr8 0xfa #define INSTR_stackSize8Legacy 0xfb #define INSTR_stackSize16 0xfc #define INSTR_escape 0xfe #define INSTR_enterIntX86 0xff // Extended opcodes - preceded by escape #define EXTINSTR_stack_containerW 0x0b #define EXTINSTR_allocMutClosureW 0x0f #define EXTINSTR_indirectClosureW 0x10 #define EXTINSTR_indirectContainerW 0x11 #define EXTINSTR_indirect_w 0x14 #define EXTINSTR_moveToContainerW 0x15 #define EXTINSTR_moveToMutClosureW 0x16 #define EXTINSTR_set_stack_val_w 0x17 #define EXTINSTR_reset_w 0x18 #define EXTINSTR_reset_r_w 0x19 #define EXTINSTR_callFastRRtoR 0x1c #define EXTINSTR_callFastRGtoR 0x1d #define EXTINSTR_jump32True 0x48 #define EXTINSTR_floatAbs 0x56 #define EXTINSTR_floatNeg 0x57 #define EXTINSTR_fixedIntToFloat 0x58 #define EXTINSTR_floatToReal 0x59 #define EXTINSTR_realToFloat 0x5a #define EXTINSTR_floatEqual 0x5b #define EXTINSTR_floatLess 0x5c #define EXTINSTR_floatLessEq 0x5d #define EXTINSTR_floatGreater 0x5e #define EXTINSTR_floatGreaterEq 0x5f #define EXTINSTR_floatAdd 0x60 #define EXTINSTR_floatSub 0x61 #define EXTINSTR_floatMult 0x62 #define EXTINSTR_floatDiv 0x63 #define EXTINSTR_realToInt 0x6e #define EXTINSTR_tuple_w 0x67 #define EXTINSTR_floatToInt 0x6f #define EXTINSTR_callFastFtoF 0x70 #define EXTINSTR_callFastGtoF 0x71 #define EXTINSTR_callFastFFtoF 0x72 #define EXTINSTR_callFastFGtoF 0x73 #define EXTINSTR_realUnordered 0x79 #define EXTINSTR_floatUnordered 0x7a #define EXTINSTR_tail 0x7c #define EXTINSTR_callFastRtoR 0x8f #define EXTINSTR_callFastGtoR 0x90 #define EXTINSTR_atomicReset 0x99 #define EXTINSTR_longWToTagged 0x9a #define EXTINSTR_signedToLongW 0x9b #define EXTINSTR_unsignedToLongW 0x9c #define EXTINSTR_realAbs 0x9d #define EXTINSTR_realNeg 0x9e #define EXTINSTR_fixedIntToReal 0x9f #define EXTINSTR_fixedDiv 0xaf #define EXTINSTR_fixedMod 0xb0 #define EXTINSTR_wordShiftRArith 0xbc #define EXTINSTR_lgWordEqual 0xbe #define EXTINSTR_lgWordLess 0xc0 #define EXTINSTR_lgWordLessEq 0xc1 #define EXTINSTR_lgWordGreater 0xc2 #define EXTINSTR_lgWordGreaterEq 0xc3 #define EXTINSTR_lgWordAdd 0xc4 #define EXTINSTR_lgWordSub 0xc5 #define EXTINSTR_lgWordMult 0xc6 #define EXTINSTR_lgWordDiv 0xc7 #define EXTINSTR_lgWordMod 0xc8 #define EXTINSTR_lgWordAnd 0xc9 #define EXTINSTR_lgWordOr 0xca #define EXTINSTR_lgWordXor 0xcb #define EXTINSTR_lgWordShiftLeft 0xcc #define EXTINSTR_lgWordShiftRLog 0xcd #define EXTINSTR_lgWordShiftRArith 0xce #define EXTINSTR_realEqual 0xcf +#define EXTINSTR_closureW 0xd0 #define EXTINSTR_realLess 0xd1 #define EXTINSTR_realLessEq 0xd2 #define EXTINSTR_realGreater 0xd3 #define EXTINSTR_realGreaterEq 0xd4 #define EXTINSTR_realAdd 0xd5 #define EXTINSTR_realSub 0xd6 #define EXTINSTR_realMult 0xd7 #define EXTINSTR_realDiv 0xd8 #define EXTINSTR_loadC8 0xdd #define EXTINSTR_loadC16 0xde #define EXTINSTR_loadC32 0xdf #define EXTINSTR_loadC64 0xe0 #define EXTINSTR_loadCFloat 0xe1 #define EXTINSTR_loadCDouble 0xe2 #define EXTINSTR_storeC8 0xe5 #define EXTINSTR_storeC16 0xe6 #define EXTINSTR_storeC32 0xe7 #define EXTINSTR_storeC64 0xe8 #define EXTINSTR_storeCFloat 0xe9 #define EXTINSTR_storeCDouble 0xea #define EXTINSTR_jump32 0xf2 #define EXTINSTR_jump32False 0xf3 #define EXTINSTR_constAddr32 0xf4 #define EXTINSTR_setHandler32 0xf5 #define EXTINSTR_case32 0xf6 #define EXTINSTR_allocCSpace 0xfd #define EXTINSTR_freeCSpace 0xfe diff --git a/libpolyml/interpret.cpp b/libpolyml/interpret.cpp index 537e1402..5342e425 100644 --- a/libpolyml/interpret.cpp +++ b/libpolyml/interpret.cpp @@ -1,2960 +1,3033 @@ /* Title: An interpreter for a compact instruction set. Author: Dave Matthews, Cambridge University Computer Laboratory Copyright (c) 2000-7 Cambridge University Technical Services Limited Further development Copyright David C.J. Matthews 2015-18, 2020. 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_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) 0 #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_FLOAT_H #include #endif #ifdef HAVE_MATH_H #include #endif #include // Currently just for isnan. #include "globals.h" #include "int_opcodes.h" #include "machine_dep.h" #include "sys.h" #include "profiling.h" #include "arb.h" #include "reals.h" #include "processes.h" #include "run_time.h" #include "gc.h" #include "diagnostics.h" #include "polystring.h" #include "save_vec.h" #include "memmgr.h" #include "scanaddrs.h" #include "rtsentry.h" -#if (SIZEOF_VOIDP == 8) +#if (SIZEOF_VOIDP == 8 && !defined(POLYML32IN64)) #define IS64BITS 1 #endif #define arg1 (pc[0] + pc[1]*256) #define arg2 (pc[2] + pc[3]*256) const PolyWord True = TAGGED(1); const PolyWord False = TAGGED(0); const PolyWord Zero = TAGGED(0); #define CHECKED_REGS 2 #define UNCHECKED_REGS 0 #define EXTRA_STACK 0 // Don't need any extra - signals aren't handled on the Poly stack. /* the amount of ML stack space to reserve for registers, C exception handling etc. The compiler requires us to reserve 2 stack-frames worth (2 * 20 words) plus whatever we require for the register save area. We actually reserve slightly more than this. SPF 3/3/97 */ #define OVERFLOW_STACK_SIZE \ (50 + \ CHECKED_REGS + \ UNCHECKED_REGS + \ EXTRA_STACK) // This duplicates some code in reals.cpp but is now updated. #define DOUBLESIZE (sizeof(double)/sizeof(POLYUNSIGNED)) union realdb { double dble; POLYUNSIGNED puns[DOUBLESIZE]; }; #define LGWORDSIZE (sizeof(uintptr_t) / sizeof(PolyWord)) // We're using float for Real32 so it needs to be 32-bits. // Assume that's true for the moment. #if (SIZEOF_FLOAT != 4) #error "Float is not 32-bits. Please report this" #endif union flt { float fl; int32_t i; }; class IntTaskData: public TaskData { public: IntTaskData(); ~IntTaskData(); virtual void GarbageCollect(ScanAddress *process); - void ScanStackAddress(ScanAddress *process, PolyWord &val, StackSpace *stack); + void ScanStackAddress(ScanAddress *process, stackItem& val, StackSpace *stack); virtual void EnterPolyCode(); // Start running ML // Switch to Poly and return with the io function to call. int SwitchToPoly(); virtual void SetException(poly_exn *exc); virtual void InterruptCode(); // AddTimeProfileCount is used in time profiling. virtual bool AddTimeProfileCount(SIGNALCONTEXT *context); virtual void InitStackFrame(TaskData *newTask, Handle proc, Handle arg); // Increment or decrement the first word of the object pointed to by the // mutex argument and return the new value. virtual Handle AtomicDecrement(Handle mutexp); // Set a mutex to zero. virtual void AtomicReset(Handle mutexp); // Return the minimum space occupied by the stack. Used when setting a limit. - virtual uintptr_t currentStackSpace(void) const { return (this->stack->top - this->taskSp) + OVERFLOW_STACK_SIZE; } + virtual uintptr_t currentStackSpace(void) const { return ((stackItem*)this->stack->top - this->taskSp) + OVERFLOW_STACK_SIZE; } virtual void addProfileCount(POLYUNSIGNED words) { addSynchronousCount(taskPc, words); } virtual void CopyStackFrame(StackObject *old_stack, uintptr_t old_length, StackObject *new_stack, uintptr_t new_length); bool interrupt_requested; // Allocate memory on the heap. Returns with the address of the cell. Does not set the // length word or any of the data. - PolyObject *allocateMemory(POLYUNSIGNED words, POLYCODEPTR &pc, PolyWord *&sp) + PolyObject *allocateMemory(POLYUNSIGNED words, POLYCODEPTR &pc, stackItem *&sp) { words++; // Add the size of the length word. // N.B. The allocation area may be empty so that both of these are zero. - if (this->allocPointer >= this->allocLimit + words) + if (this->allocPointer >= this->allocLimit + words + 1) { +#ifdef POLYML32IN64 + if (words & 1) words++; +#endif this->allocPointer -= words; return (PolyObject *)(this->allocPointer+1); } // Insufficient space. SaveInterpreterState(pc, sp); // Find some space to allocate in. Returns a pointer to the newly allocated space. // N.B. This may return zero if the heap is exhausted and it has set this // up for an exception. Generally it allocates by decrementing allocPointer // but if the required memory is large it may allocate in a separate area. PolyWord *space = processes->FindAllocationSpace(this, words, true); LoadInterpreterState(pc, sp); if (space == 0) return 0; return (PolyObject *)(space+1); } // Put a real result in a "box" - PolyObject *boxDouble(double d, POLYCODEPTR &pc, PolyWord *&sp) + PolyObject *boxDouble(double d, POLYCODEPTR &pc, stackItem*&sp) { PolyObject *mem = this->allocateMemory(DOUBLESIZE, pc, sp); if (mem == 0) return 0; mem->SetLengthWord(DOUBLESIZE, F_BYTE_OBJ); union realdb uniondb; uniondb.dble = d; // Copy the words. Depending on the word length this may copy one or more words. for (unsigned i = 0; i < DOUBLESIZE; i++) mem->Set(i, PolyWord::FromUnsigned(uniondb.puns[i])); return mem; } // Extract a double value from a box. double unboxDouble(PolyWord p) { union realdb uniondb; for (unsigned i = 0; i < DOUBLESIZE; i++) uniondb.puns[i] = p.AsObjPtr()->Get(i).AsUnsigned(); return uniondb.dble; } // Largely copied from reals.cpp #if (SIZEOF_FLOAT < SIZEOF_POLYWORD) // Typically for 64-bit mode. Use a tagged representation. // The code-generator on the X86/64 assumes the float is in the // high order word. #define FLT_SHIFT ((SIZEOF_POLYWORD-SIZEOF_FLOAT)*8) float unboxFloat(PolyWord p) { union flt argx; argx.i = p.AsSigned() >> FLT_SHIFT; return argx.fl; } - PolyObject *boxFloat(float f, POLYCODEPTR &pc, PolyWord *&sp) + PolyObject *boxFloat(float f, POLYCODEPTR &pc, stackItem*&sp) { union flt argx; argx.fl = f; PolyWord p = PolyWord::FromSigned(((POLYSIGNED)argx.i << FLT_SHIFT) + 1); return p.AsObjPtr(); // Temporarily cast it to this even though it isn't really } #else // Typically for 32-bit mode. Use a boxed representation. - PolyObject *boxFloat(float f, POLYCODEPTR &pc, PolyWord *&sp) + PolyObject *boxFloat(float f, POLYCODEPTR &pc, stackItem*&sp) { PolyObject *mem = this->allocateMemory(1, pc, sp); if (mem == 0) return 0; mem->SetLengthWord(1, F_BYTE_OBJ); union flt argx; argx.fl = f; mem->Set(0, PolyWord::FromSigned(argx.i)); return mem; } // Extract a double value from a box. float unboxFloat(PolyWord p) { union flt argx; argx.i = (int32_t)p.AsObjPtr()->Get(0).AsSigned(); return argx.fl; } #endif // Update the copies in the task object - void SaveInterpreterState(POLYCODEPTR pc, PolyWord *sp) + void SaveInterpreterState(POLYCODEPTR pc, stackItem*sp) { taskPc = pc; taskSp = sp; } // Update the local state - void LoadInterpreterState(POLYCODEPTR &pc, PolyWord *&sp) + void LoadInterpreterState(POLYCODEPTR &pc, stackItem*&sp) { pc = taskPc; sp = taskSp; } POLYCODEPTR taskPc; /* Program counter. */ - PolyWord *taskSp; /* Stack pointer. */ - PolyWord *hr; - PolyWord exception_arg; + stackItem *taskSp; /* Stack pointer. */ + stackItem *hr; + stackItem exception_arg; bool raiseException; - PolyWord *sl; /* Stack limit register. */ + stackItem *sl; /* Stack limit register. */ PolyObject *overflowPacket, *dividePacket; #ifdef PROFILEOPCODES unsigned frequency[256], arg1Value[256], arg2Value[256]; #endif }; IntTaskData::IntTaskData() : interrupt_requested(false), overflowPacket(0), dividePacket(0) { #ifdef PROFILEOPCODES memset(frequency, 0, sizeof(frequency)); memset(arg1Value, 0, sizeof(arg1Value)); memset(arg2Value, 0, sizeof(arg2Value)); #endif } IntTaskData::~IntTaskData() { #ifdef PROFILEOPCODES OutputDebugStringA("Frequency\n"); for (unsigned i = 0; i < 256; i++) { if (frequency[i] != 0) { char buffer[100]; sprintf(buffer, "%02X: %u\n", i, frequency[i]); OutputDebugStringA(buffer); } } OutputDebugStringA("Arg1\n"); for (unsigned i = 0; i < 256; i++) { if (arg1Value[i] != 0) { char buffer[100]; sprintf(buffer, "%02X: %u\n", i, arg1Value[i]); OutputDebugStringA(buffer); } } OutputDebugStringA("Arg2\n"); for (unsigned i = 0; i < 256; i++) { if (arg2Value[i] != 0) { char buffer[100]; sprintf(buffer, "%02X: %u\n", i, arg2Value[i]); OutputDebugStringA(buffer); } } #endif } // This lock is used to synchronise all atomic operations. // It is not needed in the X86 version because that can use a global // memory lock. static PLock mutexLock; // Special value for return address. -#define SPECIAL_PC_END_THREAD TAGGED(1) +#define SPECIAL_PC_END_THREAD ((POLYCODEPTR)0) class Interpreter : public MachineDependent { public: Interpreter() {} // Create a task data object. virtual TaskData *CreateTaskData(void) { return new IntTaskData(); } virtual Architectures MachineArchitecture(void) { return MA_Interpreted; } }; void IntTaskData::InitStackFrame(TaskData *parentTask, Handle proc, Handle arg) /* Initialise stack frame. */ { StackSpace *space = this->stack; StackObject *stack = (StackObject *)space->stack(); PolyObject *closure = DEREFWORDHANDLE(proc); - uintptr_t stack_size = space->spaceSize(); - this->taskPc = closure->Get(0).AsCodePtr(); + uintptr_t stack_size = space->spaceSize() * sizeof(PolyWord) / sizeof(stackItem); + this->taskPc = *(POLYCODEPTR*)closure; this->exception_arg = TAGGED(0); /* Used for exception argument. */ - this->taskSp = (PolyWord*)stack + stack_size; + this->taskSp = (stackItem*)stack + stack_size; this->raiseException = false; /* Set up exception handler */ /* No previous handler so point it at itself. */ this->taskSp--; - *(this->taskSp) = PolyWord::FromStackAddr(this->taskSp); - *(--this->taskSp) = SPECIAL_PC_END_THREAD; /* Default return address. */ + this->taskSp->stackAddr = this->taskSp; + (--this->taskSp)->codeAddr = SPECIAL_PC_END_THREAD; /* Default return address. */ this->hr = this->taskSp; /* If this function takes an argument store it on the stack. */ if (arg != 0) *(--this->taskSp) = DEREFWORD(arg); - *(--this->taskSp) = SPECIAL_PC_END_THREAD; /* Return address. */ - *(--this->taskSp) = closure; /* Closure address */ + (*(--this->taskSp)).codeAddr = SPECIAL_PC_END_THREAD; /* Return address. */ + *(--this->taskSp) = (PolyWord)closure; /* Closure address */ // Make packets for exceptions. overflowPacket = makeExceptionPacket(parentTask, EXC_overflow); dividePacket = makeExceptionPacket(parentTask, EXC_divide); } extern "C" { typedef POLYUNSIGNED(*callFastRts0)(); typedef POLYUNSIGNED(*callFastRts1)(intptr_t); typedef POLYUNSIGNED(*callFastRts2)(intptr_t, intptr_t); typedef POLYUNSIGNED(*callFastRts3)(intptr_t, intptr_t, intptr_t); typedef POLYUNSIGNED(*callFastRts4)(intptr_t, intptr_t, intptr_t, intptr_t); typedef POLYUNSIGNED(*callFastRts5)(intptr_t, intptr_t, intptr_t, intptr_t, intptr_t); typedef POLYUNSIGNED(*callFullRts0)(PolyObject *); typedef POLYUNSIGNED(*callFullRts1)(PolyObject *, intptr_t); typedef POLYUNSIGNED(*callFullRts2)(PolyObject *, intptr_t, intptr_t); typedef POLYUNSIGNED(*callFullRts3)(PolyObject *, intptr_t, intptr_t, intptr_t); typedef double (*callRTSRtoR) (double); typedef double (*callRTSRRtoR) (double, double); typedef double (*callRTSGtoR) (intptr_t); typedef double (*callRTSRGtoR) (double, intptr_t); typedef float(*callRTSFtoF) (float); typedef float(*callRTSFFtoF) (float, float); typedef float(*callRTSGtoF) (intptr_t); typedef float(*callRTSFGtoF) (float, intptr_t); } void IntTaskData::InterruptCode() /* Stop the Poly code at a suitable place. */ /* We may get an asynchronous interrupt at any time. */ { IntTaskData *itd = (IntTaskData *)this; itd->interrupt_requested = true; } void IntTaskData::SetException(poly_exn *exc) /* Set up the stack of a process to raise an exception. */ { this->raiseException = true; *(--this->taskSp) = (PolyWord)exc; /* push exception data */ } int IntTaskData::SwitchToPoly() /* (Re)-enter the Poly code from C. */ { // Local values. These are copies of member variables but are used so frequently that // it is important that access should be fast. POLYCODEPTR pc; - PolyWord *sp; + stackItem*sp; LoadInterpreterState(pc, sp); - sl = (PolyWord*)this->stack->stack() + OVERFLOW_STACK_SIZE; + sl = (stackItem*)((PolyWord*)this->stack->stack() + OVERFLOW_STACK_SIZE); // We may have taken an interrupt which has set an exception. if (this->raiseException) goto RAISE_EXCEPTION; for(;;){ /* Each instruction */ -// char buff[1000]; -// sprintf(buff, "addr = %p sp=%p instr=%02x *sp=%p\n", pc, sp, *pc, (*sp).AsStackAddr()); -// OutputDebugStringA(buff); - +#if (0) + char buff[1000]; + sprintf(buff, "addr = %p sp=%p instr=%02x *sp=%p\n", pc, sp, *pc, (*sp).stackAddr); + OutputDebugStringA(buff); +#endif // These are temporary values used where one instruction jumps to // common code. POLYUNSIGNED tailCount; - PolyWord* tailPtr; + stackItem* tailPtr; POLYUNSIGNED returnCount; POLYUNSIGNED storeWords; POLYUNSIGNED stackCheck; PolyObject *closure; double dv; #ifdef PROFILEOPCODES frequency[*pc]++; #endif switch(*pc++) { case INSTR_jump8false: { PolyWord u = *sp++; if (u == True) pc += 1; else pc += *pc + 1; break; } case INSTR_jump8: pc += *pc + 1; break; case INSTR_jump8True: { PolyWord u = *sp++; if (u == False) pc += 1; else pc += *pc + 1; break; } case INSTR_jump16True: // Invert the sense of the test and fall through. - *sp = ((*sp) == True) ? False : True; + *sp = ((*sp).w() == True) ? False : True; case INSTR_jump16false: { PolyWord u = *sp++; /* Pop argument */ if (u == True) { pc += 2; break; } /* else - false - take the jump */ } case INSTR_jump16: pc += arg1 + 2; break; - case INSTR_push_handler: /* Save the old handler value. */ - *(--sp) = PolyWord::FromStackAddr(this->hr); /* Push old handler */ + (*(--sp)).stackAddr = this->hr; /* Push old handler */ break; case INSTR_setHandler8: /* Set up a handler */ - *(--sp) = PolyWord::FromCodePtr(pc + *pc + 1); /* Address of handler */ + (*(--sp)).codeAddr = pc + *pc + 1; /* Address of handler */ this->hr = sp; pc += 1; break; case INSTR_setHandler16: /* Set up a handler */ - *(--sp) = PolyWord::FromCodePtr(pc + arg1 + 2); /* Address of handler */ + (*(--sp)).codeAddr = pc + arg1 + 2; /* Address of handler */ this->hr = sp; pc += 2; break; case INSTR_deleteHandler: /* Delete handler retaining the result. */ { - PolyWord u = *sp++; + stackItem u = *sp++; sp = this->hr; sp++; // Remove handler entry point - this->hr = (*sp).AsStackAddr(); // Restore old handler + this->hr = (*sp).stackAddr; // Restore old handler *sp = u; // Put back the result break; } case INSTR_case16: { // arg1 is the largest value that is in the range POLYSIGNED u = UNTAGGED(*sp++); /* Get the value */ if (u >= arg1 || u < 0) pc += 2 + arg1*2; /* Out of range */ else { pc += 2; pc += /* Index */pc[u*2]+pc[u*2 + 1]*256; } break; } case INSTR_tail_3_bLegacy: tailCount = 3; tailPtr = sp + tailCount; sp = tailPtr + *pc; goto TAIL_CALL; case INSTR_tail_3_2Legacy: tailCount = 3; tailPtr = sp + tailCount; sp = tailPtr + 2; goto TAIL_CALL; case INSTR_tail_3_3Legacy: tailCount = 3; tailPtr = sp + tailCount; sp = tailPtr + 3; goto TAIL_CALL; case INSTR_tail_4_bLegacy: tailCount = 4; tailPtr = sp + tailCount; sp = tailPtr + *pc; goto TAIL_CALL; case INSTR_tail_b_b: tailCount = *pc; tailPtr = sp + tailCount; sp = tailPtr + pc[1]; TAIL_CALL: /* For general case. */ if (tailCount < 2) Crash("Invalid argument\n"); for (; tailCount > 0; tailCount--) *(--sp) = *(--tailPtr); - pc = (*sp++).AsCodePtr(); /* Pop the original return address. */ - closure = (*sp++).AsObjPtr(); + pc = (*sp++).codeAddr; /* Pop the original return address. */ + closure = (*sp++).w().AsObjPtr(); goto CALL_CLOSURE; /* And drop through. */ case INSTR_call_closure: /* Closure call. */ { - closure = (*sp++).AsObjPtr(); + closure = (*sp++).w().AsObjPtr(); CALL_CLOSURE: - *(--sp) = PolyWord::FromCodePtr(pc); /* Save return address. */ - *(--sp) = closure; - pc = closure->Get(0).AsCodePtr(); /* Get entry point. */ + (--sp)->codeAddr = pc; /* Save return address. */ + *(--sp) = (PolyWord)closure; + pc = *(POLYCODEPTR*)closure; /* Get entry point. */ this->taskPc = pc; // Update in case we're profiling // Check that there at least 128 words on the stack stackCheck = 128; goto STACKCHECK; } case INSTR_callConstAddr8: closure = (*(PolyWord*)(pc + pc[0] + 1)).AsObjPtr(); pc += 1; goto CALL_CLOSURE; case INSTR_callConstAddr16: closure = (*(PolyWord*)(pc + arg1 + 2)).AsObjPtr(); pc += 2; goto CALL_CLOSURE; - case INSTR_callLocalB: { - closure = (sp[*pc++]).AsObjPtr(); + closure = (sp[*pc++]).w().AsObjPtr(); goto CALL_CLOSURE; } case INSTR_return_w: returnCount = arg1; /* Get no. of args to remove. */ RETURN: /* Common code for return. */ { - PolyWord result = *sp++; /* Result */ + stackItem result = *sp++; /* Result */ sp++; /* Remove the link/closure */ - pc = (*sp++).AsCodePtr(); /* Return address */ + pc = (*sp++).codeAddr; /* Return address */ sp += returnCount; /* Add on number of args. */ - if (pc == SPECIAL_PC_END_THREAD.AsCodePtr()) + if (pc == SPECIAL_PC_END_THREAD) exitThread(this); // This thread is exiting. *(--sp) = result; /* Result */ this->taskPc = pc; // Update in case we're profiling } break; case INSTR_return_b: returnCount = *pc; goto RETURN; case INSTR_return_0Legacy: returnCount = 0; goto RETURN; case INSTR_return_1: returnCount = 1; goto RETURN; case INSTR_return_2: returnCount = 2; goto RETURN; case INSTR_return_3: returnCount = 3; goto RETURN; case INSTR_stackSize8Legacy: stackCheck = *pc++; goto STACKCHECK; case INSTR_stackSize16: { stackCheck = arg1; pc += 2; STACKCHECK: // Check there is space on the stack if (sp - stackCheck < sl) { uintptr_t min_size = (this->stack->top - (PolyWord*)sp) + OVERFLOW_STACK_SIZE + stackCheck; SaveInterpreterState(pc, sp); CheckAndGrowStack(this, min_size); LoadInterpreterState(pc, sp); - sl = (PolyWord*)this->stack->stack() + OVERFLOW_STACK_SIZE; + sl = (stackItem*)this->stack->stack() + OVERFLOW_STACK_SIZE; } // Also check for interrupts if (this->interrupt_requested) { // Check for interrupts this->interrupt_requested = false; SaveInterpreterState(pc, sp); return -1; } break; } case INSTR_raise_ex: { RAISE_EXCEPTION: this->raiseException = false; - PolyException *exn = (PolyException*)((*sp).AsObjPtr()); - this->exception_arg = exn; /* Get exception data */ + PolyException *exn = (PolyException*)((*sp).w().AsObjPtr()); + this->exception_arg = (PolyWord)exn; /* Get exception data */ sp = this->hr; - if (*sp == SPECIAL_PC_END_THREAD) + pc = (*sp++).codeAddr; + if (pc == SPECIAL_PC_END_THREAD) exitThread(this); // Default handler for thread. - pc = (*sp++).AsCodePtr(); - this->hr = (*sp++).AsStackAddr(); + this->hr = (*sp++).stackAddr; break; } case INSTR_tuple_2: storeWords = 2; goto TUPLE; case INSTR_tuple_3: storeWords = 3; goto TUPLE; case INSTR_tuple_4: storeWords = 4; goto TUPLE; case INSTR_tuple_b: storeWords = *pc; pc++; goto TUPLE; + case INSTR_closureB: + storeWords = *pc++; + goto CREATE_CLOSURE; + break; + case INSTR_local_w: { - PolyWord u = sp[arg1]; + stackItem u = sp[arg1]; *(--sp) = u; pc += 2; break; } case INSTR_constAddr8: *(--sp) = *(PolyWord*)(pc + pc[0] + 1); pc += 1; break; case INSTR_constAddr16: *(--sp) = *(PolyWord*)(pc + arg1 + 2); pc += 2; break; case INSTR_const_int_w: *(--sp) = TAGGED(arg1); pc += 2; break; case INSTR_jump_back8: pc -= *pc + 1; if (this->interrupt_requested) { // Check for interrupt in case we're in a loop this->interrupt_requested = false; SaveInterpreterState(pc, sp); return -1; } break; case INSTR_jump_back16: pc -= arg1 + 1; if (this->interrupt_requested) { // Check for interrupt in case we're in a loop this->interrupt_requested = false; SaveInterpreterState(pc, sp); return -1; } break; case INSTR_lock: { - PolyObject *obj = (*sp).AsObjPtr(); + PolyObject *obj = (*sp).w().AsObjPtr(); obj->SetLengthWord(obj->LengthWord() & ~_OBJ_MUTABLE_BIT); break; } case INSTR_ldexc: *(--sp) = this->exception_arg; break; - case INSTR_local_b: { PolyWord u = sp[*pc]; *(--sp) = u; pc += 1; break; } + case INSTR_local_b: { stackItem u = sp[*pc]; *(--sp) = u; pc += 1; break; } case INSTR_indirect_b: - *sp = (*sp).AsObjPtr()->Get(*pc); pc += 1; break; + *sp = (*sp).w().AsObjPtr()->Get(*pc); pc += 1; break; case INSTR_indirectLocalBB: { PolyWord u = sp[*pc++]; *(--sp) = u.AsObjPtr()->Get(*pc++); break; } case INSTR_indirectLocalB0: { PolyWord u = sp[*pc++]; *(--sp) = u.AsObjPtr()->Get(0); break; } case INSTR_indirect0Local0: { PolyWord u = sp[0]; *(--sp) = u.AsObjPtr()->Get(0); break; } case INSTR_indirectLocalB1: { PolyWord u = sp[*pc++]; *(--sp) = u.AsObjPtr()->Get(1); break; } case INSTR_moveToContainerB: - { PolyWord u = *sp++; (*sp).AsObjPtr()->Set(*pc, u); pc += 1; break; } + { PolyWord u = *sp++; (*sp).stackAddr[*pc] = u; pc += 1; break; } case INSTR_moveToMutClosureB: { PolyWord u = *sp++; - (*sp).AsObjPtr()->Set(*pc++ + sizeof(uintptr_t) / sizeof(PolyWord), u); + (*sp).w().AsObjPtr()->Set(*pc++ + sizeof(uintptr_t) / sizeof(PolyWord), u); break; } case INSTR_indirectContainerB: - *sp = (*sp).AsObjPtr()->Get(*pc); pc += 1; break; + *sp = (*sp).stackAddr[*pc]; pc += 1; break; case INSTR_indirectClosureBB: { PolyWord u = sp[*pc++]; *(--sp) = u.AsObjPtr()->Get(*pc++ + sizeof(uintptr_t) / sizeof(PolyWord)); break; } case INSTR_indirectClosureB0: { PolyWord u = sp[*pc++]; *(--sp) = u.AsObjPtr()->Get(sizeof(uintptr_t) / sizeof(PolyWord)); break; } case INSTR_indirectClosureB1: { PolyWord u = sp[*pc++]; *(--sp) = u.AsObjPtr()->Get(sizeof(uintptr_t) / sizeof(PolyWord) + 1); break; } case INSTR_indirectClosureB2: { PolyWord u = sp[*pc++]; *(--sp) = u.AsObjPtr()->Get(sizeof(uintptr_t) / sizeof(PolyWord) + 2); break; } case INSTR_set_stack_val_b: { PolyWord u = *sp++; sp[*pc-1] = u; pc += 1; break; } case INSTR_reset_b: sp += *pc; pc += 1; break; case INSTR_reset_r_b: { PolyWord u = *sp; sp += *pc; *sp = u; pc += 1; break; } case INSTR_const_int_b: *(--sp) = TAGGED(*pc); pc += 1; break; - case INSTR_local_0: { PolyWord u = sp[0]; *(--sp) = u; break; } - case INSTR_local_1: { PolyWord u = sp[1]; *(--sp) = u; break; } - case INSTR_local_2: { PolyWord u = sp[2]; *(--sp) = u; break; } - case INSTR_local_3: { PolyWord u = sp[3]; *(--sp) = u; break; } - case INSTR_local_4: { PolyWord u = sp[4]; *(--sp) = u; break; } - case INSTR_local_5: { PolyWord u = sp[5]; *(--sp) = u; break; } - case INSTR_local_6: { PolyWord u = sp[6]; *(--sp) = u; break; } - case INSTR_local_7: { PolyWord u = sp[7]; *(--sp) = u; break; } - case INSTR_local_8: { PolyWord u = sp[8]; *(--sp) = u; break; } - case INSTR_local_9: { PolyWord u = sp[9]; *(--sp) = u; break; } - case INSTR_local_10: { PolyWord u = sp[10]; *(--sp) = u; break; } - case INSTR_local_11: { PolyWord u = sp[11]; *(--sp) = u; break; } - case INSTR_local_12: { PolyWord u = sp[12]; *(--sp) = u; break; } - case INSTR_local_13: { PolyWord u = sp[13]; *(--sp) = u; break; } - case INSTR_local_14: { PolyWord u = sp[14]; *(--sp) = u; break; } - case INSTR_local_15: { PolyWord u = sp[15]; *(--sp) = u; break; } + case INSTR_local_0: { stackItem u = sp[0]; *(--sp) = u; break; } + case INSTR_local_1: { stackItem u = sp[1]; *(--sp) = u; break; } + case INSTR_local_2: { stackItem u = sp[2]; *(--sp) = u; break; } + case INSTR_local_3: { stackItem u = sp[3]; *(--sp) = u; break; } + case INSTR_local_4: { stackItem u = sp[4]; *(--sp) = u; break; } + case INSTR_local_5: { stackItem u = sp[5]; *(--sp) = u; break; } + case INSTR_local_6: { stackItem u = sp[6]; *(--sp) = u; break; } + case INSTR_local_7: { stackItem u = sp[7]; *(--sp) = u; break; } + case INSTR_local_8: { stackItem u = sp[8]; *(--sp) = u; break; } + case INSTR_local_9: { stackItem u = sp[9]; *(--sp) = u; break; } + case INSTR_local_10: { stackItem u = sp[10]; *(--sp) = u; break; } + case INSTR_local_11: { stackItem u = sp[11]; *(--sp) = u; break; } + case INSTR_local_12: { stackItem u = sp[12]; *(--sp) = u; break; } + case INSTR_local_13: { stackItem u = sp[13]; *(--sp) = u; break; } + case INSTR_local_14: { stackItem u = sp[14]; *(--sp) = u; break; } + case INSTR_local_15: { stackItem u = sp[15]; *(--sp) = u; break; } case INSTR_indirect_0: - *sp = (*sp).AsObjPtr()->Get(0); break; + *sp = (*sp).w().AsObjPtr()->Get(0); break; case INSTR_indirect_1: - *sp = (*sp).AsObjPtr()->Get(1); break; + *sp = (*sp).w().AsObjPtr()->Get(1); break; case INSTR_indirect_2: - *sp = (*sp).AsObjPtr()->Get(2); break; + *sp = (*sp).w().AsObjPtr()->Get(2); break; case INSTR_indirect_3: - *sp = (*sp).AsObjPtr()->Get(3); break; + *sp = (*sp).w().AsObjPtr()->Get(3); break; case INSTR_indirect_4: - *sp = (*sp).AsObjPtr()->Get(4); break; + *sp = (*sp).w().AsObjPtr()->Get(4); break; case INSTR_indirect_5: - *sp = (*sp).AsObjPtr()->Get(5); break; + *sp = (*sp).w().AsObjPtr()->Get(5); break; case INSTR_const_0: *(--sp) = Zero; break; case INSTR_const_1: *(--sp) = TAGGED(1); break; case INSTR_const_2: *(--sp) = TAGGED(2); break; case INSTR_const_3: *(--sp) = TAGGED(3); break; case INSTR_const_4: *(--sp) = TAGGED(4); break; case INSTR_const_10: *(--sp) = TAGGED(10); break; case INSTR_reset_r_1: { PolyWord u = *sp; sp += 1; *sp = u; break; } case INSTR_reset_r_2: { PolyWord u = *sp; sp += 2; *sp = u; break; } case INSTR_reset_r_3: { PolyWord u = *sp; sp += 3; *sp = u; break; } case INSTR_reset_1: sp += 1; break; case INSTR_reset_2: sp += 2; break; case INSTR_stack_containerB: { POLYUNSIGNED words = *pc++; while (words-- > 0) *(--sp) = Zero; sp--; - *sp = PolyWord::FromStackAddr(sp + 1); + (*sp).stackAddr = sp + 1; break; } case INSTR_tuple_containerLegacy: /* Create a tuple from a container. */ { storeWords = arg1; PolyObject *t = this->allocateMemory(storeWords, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(storeWords, 0); for(; storeWords > 0; ) { storeWords--; - t->Set(storeWords, (*sp).AsObjPtr()->Get(storeWords)); + t->Set(storeWords, (*sp).stackAddr[storeWords]); } - *sp = t; + *sp = (PolyWord)t; pc += 2; break; } case INSTR_callFastRTS0: { - callFastRts0 doCall = *(callFastRts0*)(*sp++).AsObjPtr(); + callFastRts0 doCall = *(callFastRts0*)(*sp++).w().AsObjPtr(); this->raiseException = false; SaveInterpreterState(pc, sp); POLYUNSIGNED result = doCall(); LoadInterpreterState(pc, sp); // If this raised an exception if (this->raiseException) goto RAISE_EXCEPTION; *(--sp) = PolyWord::FromUnsigned(result); break; } case INSTR_callFastRTS1: { - callFastRts1 doCall = *(callFastRts1*)(*sp++).AsObjPtr(); - intptr_t rtsArg1 = (*sp++).AsSigned(); + callFastRts1 doCall = *(callFastRts1*)(*sp++).w().AsObjPtr(); + intptr_t rtsArg1 = (*sp++).argValue; this->raiseException = false; SaveInterpreterState(pc, sp); POLYUNSIGNED result = doCall(rtsArg1); LoadInterpreterState(pc, sp); // If this raised an exception if (this->raiseException) goto RAISE_EXCEPTION; *(--sp) = PolyWord::FromUnsigned(result); break; } case INSTR_callFastRTS2: { - callFastRts2 doCall = *(callFastRts2*)(*sp++).AsObjPtr(); - intptr_t rtsArg2 = (*sp++).AsSigned(); // Pop off the args, last arg first. - intptr_t rtsArg1 = (*sp++).AsSigned(); + callFastRts2 doCall = *(callFastRts2*)(*sp++).w().AsObjPtr(); + intptr_t rtsArg2 = (*sp++).argValue; // Pop off the args, last arg first. + intptr_t rtsArg1 = (*sp++).argValue; this->raiseException = false; SaveInterpreterState(pc, sp); POLYUNSIGNED result = doCall(rtsArg1, rtsArg2); LoadInterpreterState(pc, sp); // If this raised an exception if (this->raiseException) goto RAISE_EXCEPTION; *(--sp) = PolyWord::FromUnsigned(result); break; } case INSTR_callFastRTS3: { - callFastRts3 doCall = *(callFastRts3*)(*sp++).AsObjPtr(); - intptr_t rtsArg3 = (*sp++).AsSigned(); // Pop off the args, last arg first. - intptr_t rtsArg2 = (*sp++).AsSigned(); - intptr_t rtsArg1 = (*sp++).AsSigned(); + callFastRts3 doCall = *(callFastRts3*)(*sp++).w().AsObjPtr(); + intptr_t rtsArg3 = (*sp++).argValue; // Pop off the args, last arg first. + intptr_t rtsArg2 = (*sp++).argValue; + intptr_t rtsArg1 = (*sp++).argValue; this->raiseException = false; SaveInterpreterState(pc, sp); POLYUNSIGNED result = doCall(rtsArg1, rtsArg2, rtsArg3); LoadInterpreterState(pc, sp); // If this raised an exception if (this->raiseException) goto RAISE_EXCEPTION; *(--sp) = PolyWord::FromUnsigned(result); break; } case INSTR_callFastRTS4: { - callFastRts4 doCall = *(callFastRts4*)(*sp++).AsObjPtr(); - intptr_t rtsArg4 = (*sp++).AsSigned(); // Pop off the args, last arg first. - intptr_t rtsArg3 = (*sp++).AsSigned(); - intptr_t rtsArg2 = (*sp++).AsSigned(); - intptr_t rtsArg1 = (*sp++).AsSigned(); + callFastRts4 doCall = *(callFastRts4*)(*sp++).w().AsObjPtr(); + intptr_t rtsArg4 = (*sp++).argValue; // Pop off the args, last arg first. + intptr_t rtsArg3 = (*sp++).argValue; + intptr_t rtsArg2 = (*sp++).argValue; + intptr_t rtsArg1 = (*sp++).argValue; this->raiseException = false; SaveInterpreterState(pc, sp); POLYUNSIGNED result = doCall(rtsArg1, rtsArg2, rtsArg3, rtsArg4); LoadInterpreterState(pc, sp); // If this raised an exception if (this->raiseException) goto RAISE_EXCEPTION; *(--sp) = PolyWord::FromUnsigned(result); break; } case INSTR_callFastRTS5: { - callFastRts5 doCall = *(callFastRts5*)(*sp++).AsObjPtr(); - intptr_t rtsArg5 = (*sp++).AsSigned(); // Pop off the args, last arg first. - intptr_t rtsArg4 = (*sp++).AsSigned(); - intptr_t rtsArg3 = (*sp++).AsSigned(); - intptr_t rtsArg2 = (*sp++).AsSigned(); - intptr_t rtsArg1 = (*sp++).AsSigned(); + callFastRts5 doCall = *(callFastRts5*)(*sp++).w().AsObjPtr(); + intptr_t rtsArg5 = (*sp++).argValue; // Pop off the args, last arg first. + intptr_t rtsArg4 = (*sp++).argValue; + intptr_t rtsArg3 = (*sp++).argValue; + intptr_t rtsArg2 = (*sp++).argValue; + intptr_t rtsArg1 = (*sp++).argValue; this->raiseException = false; SaveInterpreterState(pc, sp); POLYUNSIGNED result = doCall(rtsArg1, rtsArg2, rtsArg3, rtsArg4, rtsArg5); LoadInterpreterState(pc, sp); // If this raised an exception if (this->raiseException) goto RAISE_EXCEPTION; *(--sp) = PolyWord::FromUnsigned(result); break; } case INSTR_callFullRTS0: { - callFullRts0 doCall = *(callFullRts0*)(*sp++).AsObjPtr(); + callFullRts0 doCall = *(callFullRts0*)(*sp++).w().AsObjPtr(); this->raiseException = false; SaveInterpreterState(pc, sp); POLYUNSIGNED result = doCall(this->threadObject); LoadInterpreterState(pc, sp); // If this raised an exception if (this->raiseException) goto RAISE_EXCEPTION; *(--sp)= PolyWord::FromUnsigned(result); break; } case INSTR_callFullRTS1: { - callFullRts1 doCall = *(callFullRts1*)(*sp++).AsObjPtr(); - intptr_t rtsArg1 = (*sp++).AsSigned(); + callFullRts1 doCall = *(callFullRts1*)(*sp++).w().AsObjPtr(); + intptr_t rtsArg1 = (*sp++).argValue; this->raiseException = false; SaveInterpreterState(pc, sp); POLYUNSIGNED result = doCall(this->threadObject, rtsArg1); LoadInterpreterState(pc, sp); // If this raised an exception if (this->raiseException) goto RAISE_EXCEPTION; *(--sp) = PolyWord::FromUnsigned(result); break; } case INSTR_callFullRTS2: { - callFullRts2 doCall = *(callFullRts2*)(*sp++).AsObjPtr(); - intptr_t rtsArg2 = (*sp++).AsSigned(); // Pop off the args, last arg first. - intptr_t rtsArg1 = (*sp++).AsSigned(); + callFullRts2 doCall = *(callFullRts2*)(*sp++).w().AsObjPtr(); + intptr_t rtsArg2 = (*sp++).argValue; // Pop off the args, last arg first. + intptr_t rtsArg1 = (*sp++).argValue; this->raiseException = false; SaveInterpreterState(pc, sp); POLYUNSIGNED result = doCall(this->threadObject, rtsArg1, rtsArg2); LoadInterpreterState(pc, sp); // If this raised an exception if (this->raiseException) goto RAISE_EXCEPTION; *(--sp) = PolyWord::FromUnsigned(result); break; } case INSTR_callFullRTS3: { - callFullRts3 doCall = *(callFullRts3*)(*sp++).AsObjPtr(); - intptr_t rtsArg3 = (*sp++).AsSigned(); // Pop off the args, last arg first. - intptr_t rtsArg2 = (*sp++).AsSigned(); - intptr_t rtsArg1 = (*sp++).AsSigned(); + callFullRts3 doCall = *(callFullRts3*)(*sp++).w().AsObjPtr(); + intptr_t rtsArg3 = (*sp++).argValue; // Pop off the args, last arg first. + intptr_t rtsArg2 = (*sp++).argValue; + intptr_t rtsArg1 = (*sp++).argValue; this->raiseException = false; SaveInterpreterState(pc, sp); POLYUNSIGNED result = doCall(this->threadObject, rtsArg1, rtsArg2, rtsArg3); LoadInterpreterState(pc, sp); // If this raised an exception if (this->raiseException) goto RAISE_EXCEPTION; *(--sp) = PolyWord::FromUnsigned(result); break; } case INSTR_notBoolean: - *sp = ((*sp) == True) ? False : True; break; + *sp = ((*sp).w() == True) ? False : True; break; case INSTR_isTagged: - *sp = (*sp).IsTagged() ? True : False; break; + *sp = (*sp).w().IsTagged() ? True : False; break; case INSTR_cellLength: /* Return the length word. */ - *sp = TAGGED((*sp).AsObjPtr()->Length()); + *sp = TAGGED((*sp).w().AsObjPtr()->Length()); break; case INSTR_cellFlags: { - PolyObject *p = (*sp).AsObjPtr(); + PolyObject *p = (*sp).w().AsObjPtr(); POLYUNSIGNED f = (p->LengthWord()) >> OBJ_PRIVATE_FLAGS_SHIFT; *sp = TAGGED(f); break; } case INSTR_clearMutable: { - PolyObject *obj = (*sp).AsObjPtr(); + PolyObject *obj = (*sp).w().AsObjPtr(); POLYUNSIGNED lengthW = obj->LengthWord(); /* Clear the mutable bit. */ obj->SetLengthWord(lengthW & ~_OBJ_MUTABLE_BIT); *sp = Zero; break; } // case INSTR_stringLength: // Now replaced by loadUntagged // *sp = TAGGED(((PolyStringObject*)(*sp).AsObjPtr())->length); // break; case INSTR_atomicIncr: { PLocker l(&mutexLock); - PolyObject *p = (*sp).AsObjPtr(); + PolyObject *p = (*sp).w().AsObjPtr(); PolyWord newValue = TAGGED(UNTAGGED(p->Get(0))+1); p->Set(0, newValue); *sp = newValue; break; } case INSTR_atomicDecr: { PLocker l(&mutexLock); - PolyObject *p = (*sp).AsObjPtr(); + PolyObject *p = (*sp).w().AsObjPtr(); PolyWord newValue = TAGGED(UNTAGGED(p->Get(0))-1); p->Set(0, newValue); *sp = newValue; break; } case INSTR_equalWord: { PolyWord u = *sp++; *sp = u == (*sp) ? True : False; break; } case INSTR_jumpNEqLocal: { // Compare a local with a constant and jump if not equal. PolyWord u = sp[pc[0]]; if (u.IsTagged() && u.UnTagged() == pc[1]) pc += 3; else pc += pc[2] + 3; break; } case INSTR_jumpNEqLocalInd: { // Test the union tag value in the first word of a tuple. PolyWord u = sp[pc[0]]; u = u.AsObjPtr()->Get(0); if (u.IsTagged() && u.UnTagged() == pc[1]) pc += 3; else pc += pc[2] + 3; break; } case INSTR_isTaggedLocalB: { PolyWord u = sp[*pc++]; *(--sp) = u.IsTagged() ? True : False; break; } case INSTR_jumpTaggedLocal: { PolyWord u = sp[*pc]; // Jump if the value is tagged. if (u.IsTagged()) pc += pc[1] + 2; else pc += 2; break; } case INSTR_lessSigned: { PolyWord u = *sp++; - *sp = ((*sp).AsSigned() < u.AsSigned()) ? True : False; + *sp = ((*sp).w().AsSigned() < u.AsSigned()) ? True : False; break; } case INSTR_lessUnsigned: { PolyWord u = *sp++; - *sp = ((*sp).AsUnsigned() < u.AsUnsigned()) ? True : False; + *sp = ((*sp).w().AsUnsigned() < u.AsUnsigned()) ? True : False; break; } case INSTR_lessEqSigned: { PolyWord u = *sp++; - *sp = ((*sp).AsSigned() <= u.AsSigned()) ? True : False; + *sp = ((*sp).w().AsSigned() <= u.AsSigned()) ? True : False; break; } case INSTR_lessEqUnsigned: { PolyWord u = *sp++; - *sp = ((*sp).AsUnsigned() <= u.AsUnsigned()) ? True : False; + *sp = ((*sp).w().AsUnsigned() <= u.AsUnsigned()) ? True : False; break; } case INSTR_greaterSigned: { PolyWord u = *sp++; - *sp = ((*sp).AsSigned() > u.AsSigned()) ? True : False; + *sp = ((*sp).w().AsSigned() > u.AsSigned()) ? True : False; break; } case INSTR_greaterUnsigned: { PolyWord u = *sp++; - *sp = ((*sp).AsUnsigned() > u.AsUnsigned()) ? True : False; + *sp = ((*sp).w().AsUnsigned() > u.AsUnsigned()) ? True : False; break; } case INSTR_greaterEqSigned: { PolyWord u = *sp++; - *sp = ((*sp).AsSigned() >= u.AsSigned()) ? True : False; + *sp = ((*sp).w().AsSigned() >= u.AsSigned()) ? True : False; break; } case INSTR_greaterEqUnsigned: { PolyWord u = *sp++; - *sp = ((*sp).AsUnsigned() >= u.AsUnsigned()) ? True : False; + *sp = ((*sp).w().AsUnsigned() >= u.AsUnsigned()) ? True : False; break; } case INSTR_fixedAdd: { PolyWord x = *sp++; PolyWord y = (*sp); POLYSIGNED t = UNTAGGED(x) + UNTAGGED(y); if (t <= MAXTAGGED && t >= -MAXTAGGED-1) *sp = TAGGED(t); else { *(--sp) = (PolyWord)overflowPacket; goto RAISE_EXCEPTION; } break; } case INSTR_fixedSub: { PolyWord x = *sp++; PolyWord y = (*sp); POLYSIGNED t = UNTAGGED(y) - UNTAGGED(x); if (t <= MAXTAGGED && t >= -MAXTAGGED-1) *sp = TAGGED(t); else { *(--sp) = (PolyWord)overflowPacket; goto RAISE_EXCEPTION; } break; } case INSTR_fixedMult: { POLYSIGNED x = UNTAGGED(*sp++); - POLYSIGNED y = (*sp).AsSigned() - 1; // Just remove the tag + POLYSIGNED y = (*sp).w().AsSigned() - 1; // Just remove the tag POLYSIGNED t = x * y; if (x != 0 && t / x != y) { *(--sp) = (PolyWord)overflowPacket; goto RAISE_EXCEPTION; } *sp = PolyWord::FromSigned(t+1); // Add back the tag break; } case INSTR_fixedQuot: { // Zero and overflow are checked for in ML. POLYSIGNED u = UNTAGGED(*sp++); PolyWord y = (*sp); *sp = TAGGED(UNTAGGED(y) / u); break; } case INSTR_fixedRem: { // Zero and overflow are checked for in ML. POLYSIGNED u = UNTAGGED(*sp++); PolyWord y = (*sp); *sp = TAGGED(UNTAGGED(y) % u); break; } case INSTR_wordAdd: { PolyWord u = *sp++; // Because we're not concerned with overflow we can just add the values and subtract the tag. - *sp = PolyWord::FromUnsigned((*sp).AsUnsigned() + u.AsUnsigned() - TAGGED(0).AsUnsigned()); + *sp = PolyWord::FromUnsigned((*sp).w().AsUnsigned() + u.AsUnsigned() - TAGGED(0).AsUnsigned()); break; } case INSTR_wordSub: { PolyWord u = *sp++; - *sp = PolyWord::FromUnsigned((*sp).AsUnsigned() - u.AsUnsigned() + TAGGED(0).AsUnsigned()); + *sp = PolyWord::FromUnsigned((*sp).w().AsUnsigned() - u.AsUnsigned() + TAGGED(0).AsUnsigned()); break; } case INSTR_wordMult: { PolyWord u = *sp++; *sp = TAGGED(UNTAGGED_UNSIGNED(*sp) * UNTAGGED_UNSIGNED(u)); break; } case INSTR_wordDiv: { POLYUNSIGNED u = UNTAGGED_UNSIGNED(*sp++); // Detection of zero is done in ML *sp = TAGGED(UNTAGGED_UNSIGNED(*sp) / u); break; } case INSTR_wordMod: { POLYUNSIGNED u = UNTAGGED_UNSIGNED(*sp++); *sp = TAGGED(UNTAGGED_UNSIGNED(*sp) % u); break; } case INSTR_wordAnd: { PolyWord u = *sp++; // Since both of these should be tagged the tag bit will be preserved. - *sp = PolyWord::FromUnsigned((*sp).AsUnsigned() & u.AsUnsigned()); + *sp = PolyWord::FromUnsigned((*sp).w().AsUnsigned() & u.AsUnsigned()); break; } case INSTR_wordOr: { PolyWord u = *sp++; // Since both of these should be tagged the tag bit will be preserved. - *sp = PolyWord::FromUnsigned((*sp).AsUnsigned() | u.AsUnsigned()); + *sp = PolyWord::FromUnsigned((*sp).w().AsUnsigned() | u.AsUnsigned()); break; } case INSTR_wordXor: { PolyWord u = *sp++; // This will remove the tag bit so it has to be reinstated. - *sp = PolyWord::FromUnsigned(((*sp).AsUnsigned() ^ u.AsUnsigned()) | TAGGED(0).AsUnsigned()); + *sp = PolyWord::FromUnsigned(((*sp).w().AsUnsigned() ^ u.AsUnsigned()) | TAGGED(0).AsUnsigned()); break; } case INSTR_wordShiftLeft: { // ML requires shifts greater than a word to return zero. // That's dealt with at the higher level. PolyWord u = *sp++; *sp = TAGGED(UNTAGGED_UNSIGNED(*sp) << UNTAGGED_UNSIGNED(u)); break; } case INSTR_wordShiftRLog: { PolyWord u = *sp++; *sp = TAGGED(UNTAGGED_UNSIGNED(*sp) >> UNTAGGED_UNSIGNED(u)); break; } case INSTR_allocByteMem: { // Allocate byte segment. This does not need to be initialised. POLYUNSIGNED flags = UNTAGGED_UNSIGNED(*sp++); POLYUNSIGNED length = UNTAGGED_UNSIGNED(*sp); PolyObject *t = this->allocateMemory(length, pc, sp); if (t == 0) goto RAISE_EXCEPTION; // Exception t->SetLengthWord(length, (byte)flags); *sp = (PolyWord)t; break; } case INSTR_getThreadId: *(--sp) = (PolyWord)this->threadObject; break; case INSTR_allocWordMemory: { // Allocate word segment. This must be initialised. // We mustn't pop the initialiser until after any potential GC. POLYUNSIGNED length = UNTAGGED_UNSIGNED(sp[2]); PolyObject *t = this->allocateMemory(length, pc, sp); if (t == 0) goto RAISE_EXCEPTION; PolyWord initialiser = *sp++; POLYUNSIGNED flags = UNTAGGED_UNSIGNED(*sp++); t->SetLengthWord(length, (byte)flags); *sp = (PolyWord)t; // Have to initialise the data. for (; length > 0; ) t->Set(--length, initialiser); break; } case INSTR_alloc_ref: { // Allocate a single word mutable cell. This is more common than allocWordMemory on its own. PolyObject *t = this->allocateMemory(1, pc, sp); if (t == 0) goto RAISE_EXCEPTION; PolyWord initialiser = (*sp); t->SetLengthWord(1, F_MUTABLE_BIT); t->Set(0, initialiser); *sp = (PolyWord)t; break; } case INSTR_allocMutClosureB: { // Allocate memory for a mutable closure and copy in the code address. POLYUNSIGNED length = *pc++ + sizeof(uintptr_t) / sizeof(PolyWord); PolyObject* t = this->allocateMemory(length, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(length, F_CLOSURE_OBJ | F_MUTABLE_BIT); - PolyObject* srcClosure = (*sp).AsObjPtr(); + PolyObject* srcClosure = (*sp).w().AsObjPtr(); *(uintptr_t*)t = *(uintptr_t*)srcClosure; - *sp = t; + *sp = (PolyWord)t; break; } case INSTR_loadMLWordLegacy: { // The values on the stack are base, index and offset. POLYUNSIGNED offset = UNTAGGED(*sp++); POLYUNSIGNED index = UNTAGGED(*sp++); - PolyObject *p = (PolyObject*)((*sp).AsCodePtr() + offset); + PolyObject *p = (PolyObject*)((*sp).w().AsCodePtr() + offset); *sp = p->Get(index); break; } case INSTR_loadMLWord: { POLYUNSIGNED index = UNTAGGED(*sp++); - PolyObject* p = (PolyObject*)((*sp).AsCodePtr()); + PolyObject* p = (PolyObject*)((*sp).w().AsCodePtr()); *sp = p->Get(index); break; } case INSTR_loadMLByte: { // The values on the stack are base and index. POLYUNSIGNED index = UNTAGGED(*sp++); - POLYCODEPTR p = (*sp).AsCodePtr(); + POLYCODEPTR p = (*sp).w().AsCodePtr(); *sp = TAGGED(p[index]); // Have to tag the result break; } case INSTR_loadUntaggedLegacy: { // The values on the stack are base, index and offset. POLYUNSIGNED offset = UNTAGGED(*sp++); POLYUNSIGNED index = UNTAGGED(*sp++); - PolyObject *p = (PolyObject*)((*sp).AsCodePtr() + offset); + PolyObject *p = (PolyObject*)((*sp).w().AsCodePtr() + offset); *sp = TAGGED(p->Get(index).AsUnsigned()); break; } case INSTR_loadUntagged: { POLYUNSIGNED index = UNTAGGED(*sp++); - PolyObject* p = (PolyObject*)((*sp).AsCodePtr()); + PolyObject* p = (PolyObject*)((*sp).w().AsCodePtr()); *sp = TAGGED(p->Get(index).AsUnsigned()); break; } case INSTR_storeMLWordLegacy: { PolyWord toStore = *sp++; POLYUNSIGNED offset = UNTAGGED(*sp++); POLYUNSIGNED index = UNTAGGED(*sp++); - PolyObject *p = (PolyObject*)((*sp).AsCodePtr() + offset); + PolyObject *p = (PolyObject*)((*sp).w().AsCodePtr() + offset); p->Set(index, toStore); *sp = Zero; break; } case INSTR_storeMLWord: { PolyWord toStore = *sp++; POLYUNSIGNED index = UNTAGGED(*sp++); - PolyObject* p = (PolyObject*)((*sp).AsCodePtr()); + PolyObject* p = (PolyObject*)((*sp).w().AsCodePtr()); p->Set(index, toStore); *sp = Zero; break; } case INSTR_storeMLByte: { POLYUNSIGNED toStore = UNTAGGED(*sp++); POLYUNSIGNED index = UNTAGGED(*sp++); - POLYCODEPTR p = (*sp).AsCodePtr(); + POLYCODEPTR p = (*sp).w().AsCodePtr(); p[index] = (byte)toStore; *sp = Zero; break; } case INSTR_storeUntaggedLegacy: { PolyWord toStore = PolyWord::FromUnsigned(UNTAGGED_UNSIGNED(*sp++)); POLYUNSIGNED offset = UNTAGGED(*sp++); POLYUNSIGNED index = UNTAGGED(*sp++); - PolyObject *p = (PolyObject*)((*sp).AsCodePtr() + offset); + PolyObject *p = (PolyObject*)((*sp).w().AsCodePtr() + offset); p->Set(index, toStore); *sp = Zero; break; } case INSTR_storeUntagged: { PolyWord toStore = PolyWord::FromUnsigned(UNTAGGED_UNSIGNED(*sp++)); POLYUNSIGNED index = UNTAGGED(*sp++); - PolyObject* p = (PolyObject*)((*sp).AsCodePtr()); + PolyObject* p = (PolyObject*)((*sp).w().AsCodePtr()); p->Set(index, toStore); *sp = Zero; break; } case INSTR_blockMoveWordLegacy: { // The offsets are byte counts but the the indexes are in words. POLYUNSIGNED length = UNTAGGED_UNSIGNED(*sp++); POLYUNSIGNED destOffset = UNTAGGED_UNSIGNED(*sp++); POLYUNSIGNED destIndex = UNTAGGED_UNSIGNED(*sp++); - PolyObject *dest = (PolyObject*)((*sp++).AsCodePtr() + destOffset); + PolyObject *dest = (PolyObject*)((*sp++).w().AsCodePtr() + destOffset); POLYUNSIGNED srcOffset = UNTAGGED_UNSIGNED(*sp++); POLYUNSIGNED srcIndex = UNTAGGED_UNSIGNED(*sp++); - PolyObject *src = (PolyObject*)((*sp).AsCodePtr() + srcOffset); + PolyObject *src = (PolyObject*)((*sp).w().AsCodePtr() + srcOffset); for (POLYUNSIGNED u = 0; u < length; u++) dest->Set(destIndex+u, src->Get(srcIndex+u)); *sp = Zero; break; } case INSTR_blockMoveWord: { POLYUNSIGNED length = UNTAGGED_UNSIGNED(*sp++); POLYUNSIGNED destIndex = UNTAGGED_UNSIGNED(*sp++); - PolyObject* dest = (PolyObject*)((*sp++).AsCodePtr()); + PolyObject* dest = (PolyObject*)((*sp++).w().AsCodePtr()); POLYUNSIGNED srcIndex = UNTAGGED_UNSIGNED(*sp++); - PolyObject* src = (PolyObject*)((*sp).AsCodePtr()); + PolyObject* src = (PolyObject*)((*sp).w().AsCodePtr()); for (POLYUNSIGNED u = 0; u < length; u++) dest->Set(destIndex + u, src->Get(srcIndex + u)); *sp = Zero; break; } case INSTR_blockMoveByte: { POLYUNSIGNED length = UNTAGGED_UNSIGNED(*sp++); POLYUNSIGNED destOffset = UNTAGGED_UNSIGNED(*sp++); - POLYCODEPTR dest = (*sp++).AsCodePtr(); + POLYCODEPTR dest = (*sp++).w().AsCodePtr(); POLYUNSIGNED srcOffset = UNTAGGED_UNSIGNED(*sp++); - POLYCODEPTR src = (*sp).AsCodePtr(); + POLYCODEPTR src = (*sp).w().AsCodePtr(); memcpy(dest+destOffset, src+srcOffset, length); *sp = Zero; break; } case INSTR_blockEqualByte: { POLYUNSIGNED length = UNTAGGED_UNSIGNED(*sp++); POLYUNSIGNED arg2Offset = UNTAGGED_UNSIGNED(*sp++); - POLYCODEPTR arg2Ptr = (*sp++).AsCodePtr(); + POLYCODEPTR arg2Ptr = (*sp++).w().AsCodePtr(); POLYUNSIGNED arg1Offset = UNTAGGED_UNSIGNED(*sp++); - POLYCODEPTR arg1Ptr = (*sp).AsCodePtr(); + POLYCODEPTR arg1Ptr = (*sp).w().AsCodePtr(); *sp = memcmp(arg1Ptr+arg1Offset, arg2Ptr+arg2Offset, length) == 0 ? True : False; break; } case INSTR_blockCompareByte: { POLYUNSIGNED length = UNTAGGED_UNSIGNED(*sp++); POLYUNSIGNED arg2Offset = UNTAGGED_UNSIGNED(*sp++); - POLYCODEPTR arg2Ptr = (*sp++).AsCodePtr(); + POLYCODEPTR arg2Ptr = (*sp++).w().AsCodePtr(); POLYUNSIGNED arg1Offset = UNTAGGED_UNSIGNED(*sp++); - POLYCODEPTR arg1Ptr = (*sp).AsCodePtr(); + POLYCODEPTR arg1Ptr = (*sp).w().AsCodePtr(); int result = memcmp(arg1Ptr+arg1Offset, arg2Ptr+arg2Offset, length); *sp = result == 0 ? TAGGED(0) : result < 0 ? TAGGED(-1) : TAGGED(1); break; } // Backwards compatibility. // These are either used in the current compiler or compiled by it // while building the basis library. case EXTINSTR_stack_containerW: case EXTINSTR_reset_r_w: case EXTINSTR_tuple_w: case EXTINSTR_unsignedToLongW: case EXTINSTR_signedToLongW: case EXTINSTR_longWToTagged: case EXTINSTR_lgWordShiftLeft: case EXTINSTR_fixedIntToReal: case EXTINSTR_callFastRtoR: case EXTINSTR_realMult: case EXTINSTR_realDiv: case EXTINSTR_realNeg: case EXTINSTR_realAbs: case EXTINSTR_realToFloat: case EXTINSTR_floatDiv: case EXTINSTR_floatNeg: case EXTINSTR_floatAbs: case EXTINSTR_callFastFtoF: case EXTINSTR_floatMult: case EXTINSTR_callFastGtoR: case EXTINSTR_realUnordered: case EXTINSTR_realEqual: case EXTINSTR_lgWordEqual: case EXTINSTR_lgWordOr: case EXTINSTR_wordShiftRArith: case EXTINSTR_lgWordLess: // Back up and handle them as though they were escaped. pc--; case INSTR_escape: { switch (*pc++) { case EXTINSTR_callFastRRtoR: { // Floating point call. - PolyWord rtsCall = (*sp++).AsObjPtr()->Get(0); // Value holds address. + callRTSRRtoR doCall = *(callRTSRRtoR*)(*sp++).w().AsObjPtr(); PolyWord rtsArg2 = *sp++; PolyWord rtsArg1 = *sp++; - callRTSRRtoR doCall = (callRTSRRtoR)rtsCall.AsCodePtr(); double argument1 = unboxDouble(rtsArg1); double argument2 = unboxDouble(rtsArg2); // Allocate memory for the result. double result = doCall(argument1, argument2); PolyObject* t = boxDouble(result, pc, sp); if (t == 0) goto RAISE_EXCEPTION; - *(--sp) = t; + *(--sp) = (PolyWord)t; break; } case EXTINSTR_callFastRGtoR: { // Call that takes a POLYUNSIGNED argument and returns a double. - PolyWord rtsCall = (*sp++).AsObjPtr()->Get(0); // Value holds address. - intptr_t rtsArg2 = (*sp++).AsSigned(); + callRTSRGtoR doCall = *(callRTSRGtoR*)(*sp++).w().AsObjPtr(); + intptr_t rtsArg2 = (*sp++).w().AsSigned(); PolyWord rtsArg1 = *sp++; - callRTSRGtoR doCall = (callRTSRGtoR)rtsCall.AsCodePtr(); double argument1 = unboxDouble(rtsArg1); // Allocate memory for the result. double result = doCall(argument1, rtsArg2); PolyObject* t = boxDouble(result, pc, sp); if (t == 0) goto RAISE_EXCEPTION; - *(--sp) = t; + *(--sp) = (PolyWord)t; break; } case EXTINSTR_callFastGtoR: { // Call that takes a POLYUNSIGNED argument and returns a double. - callRTSGtoR doCall = *(callRTSGtoR*)(*sp++).AsObjPtr(); - intptr_t rtsArg1 = (*sp++).AsSigned(); + callRTSGtoR doCall = *(callRTSGtoR*)(*sp++).w().AsObjPtr(); + intptr_t rtsArg1 = (*sp++).w().AsSigned(); // Allocate memory for the result. double result = doCall(rtsArg1); PolyObject* t = boxDouble(result, pc, sp); if (t == 0) goto RAISE_EXCEPTION; *(--sp) = (PolyWord)t; break; } case EXTINSTR_callFastFtoF: { // Floating point call. The call itself does not allocate but we // need to put the result into a "box". - PolyWord rtsCall = (*sp++).AsObjPtr()->Get(0); // Value holds address. + callRTSFtoF doCall = *(callRTSFtoF*)(*sp++).w().AsObjPtr(); PolyWord rtsArg1 = *sp++; - callRTSFtoF doCall = (callRTSFtoF)rtsCall.AsCodePtr(); float argument = unboxFloat(rtsArg1); // Allocate memory for the result. float result = doCall(argument); PolyObject* t = boxFloat(result, pc, sp); if (t == 0) goto RAISE_EXCEPTION; - *(--sp) = t; + *(--sp) = (PolyWord)t; break; } case EXTINSTR_callFastFFtoF: { // Floating point call. - PolyWord rtsCall = (*sp++).AsObjPtr()->Get(0); // Value holds address. + callRTSFFtoF doCall = *(callRTSFFtoF*)(*sp++).w().AsObjPtr(); PolyWord rtsArg2 = *sp++; PolyWord rtsArg1 = *sp++; - callRTSFFtoF doCall = (callRTSFFtoF)rtsCall.AsCodePtr(); float argument1 = unboxFloat(rtsArg1); float argument2 = unboxFloat(rtsArg2); // Allocate memory for the result. float result = doCall(argument1, argument2); PolyObject* t = boxFloat(result, pc, sp); if (t == 0) goto RAISE_EXCEPTION; - *(--sp) = t; + *(--sp) = (PolyWord)t; break; } case EXTINSTR_callFastGtoF: { // Call that takes a POLYUNSIGNED argument and returns a double. - PolyWord rtsCall = (*sp++).AsObjPtr()->Get(0); // Value holds address. - intptr_t rtsArg1 = (*sp++).AsSigned(); - callRTSGtoF doCall = (callRTSGtoF)rtsCall.AsCodePtr(); + callRTSGtoF doCall = *(callRTSGtoF*)(*sp++).w().AsObjPtr(); + intptr_t rtsArg1 = (*sp++).w().AsSigned(); // Allocate memory for the result. float result = doCall(rtsArg1); PolyObject* t = boxFloat(result, pc, sp); if (t == 0) goto RAISE_EXCEPTION; - *(--sp) = t; + *(--sp) = (PolyWord)t; break; } case EXTINSTR_callFastFGtoF: { // Call that takes a POLYUNSIGNED argument and returns a double. - PolyWord rtsCall = (*sp++).AsObjPtr()->Get(0); // Value holds address. - intptr_t rtsArg2 = (*sp++).AsSigned(); + callRTSFGtoF doCall = *(callRTSFGtoF*)(*sp++).w().AsObjPtr(); + intptr_t rtsArg2 = (*sp++).w().AsSigned(); PolyWord rtsArg1 = *sp++; - callRTSFGtoF doCall = (callRTSFGtoF)rtsCall.AsCodePtr(); float argument1 = unboxFloat(rtsArg1); // Allocate memory for the result. float result = doCall(argument1, rtsArg2); PolyObject* t = boxFloat(result, pc, sp); if (t == 0) goto RAISE_EXCEPTION; - *(--sp) = t; + *(--sp) = (PolyWord)t; break; } case EXTINSTR_callFastRtoR: { // Floating point call. The call itself does not allocate but we // need to put the result into a "box". - callRTSRtoR doCall = *(callRTSRtoR*)(*sp++).AsObjPtr(); + callRTSRtoR doCall = *(callRTSRtoR*)(*sp++).w().AsObjPtr(); PolyWord rtsArg1 = *sp++; double argument = unboxDouble(rtsArg1); // Allocate memory for the result. double result = doCall(argument); PolyObject* t = boxDouble(result, pc, sp); if (t == 0) goto RAISE_EXCEPTION; *(--sp) = (PolyWord)t; break; } case EXTINSTR_atomicReset: { // This is needed in the interpreted version otherwise there // is a chance that we could set the value to zero while another // thread is between getting the old value and setting it to the new value. PLocker l(&mutexLock); - PolyObject* p = (*sp).AsObjPtr(); + PolyObject* p = (*sp).w().AsObjPtr(); p->Set(0, TAGGED(0)); // Set this to released. *sp = TAGGED(0); // Push the unit result break; } case EXTINSTR_longWToTagged: { // Extract the first word and return it as a tagged value. This loses the top-bit - POLYUNSIGNED wx = (*sp).AsObjPtr()->Get(0).AsUnsigned(); + POLYUNSIGNED wx = (*sp).w().AsObjPtr()->Get(0).AsUnsigned(); *sp = TAGGED(wx); break; } case EXTINSTR_signedToLongW: { // Shift the tagged value to remove the tag and put it into the first word. // The original sign bit is copied in the shift. - intptr_t wx = (*sp).UnTagged(); + intptr_t wx = (*sp).w().UnTagged(); PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ); *(intptr_t*)t = wx; *sp = (PolyWord)t; break; } case EXTINSTR_unsignedToLongW: { // As with the above except the value is treated as an unsigned // value and the top bit is zero. - uintptr_t wx = (*sp).UnTaggedUnsigned(); + uintptr_t wx = (*sp).w().UnTaggedUnsigned(); PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ); *(uintptr_t*)t = wx; *sp = (PolyWord)t; break; } case EXTINSTR_realAbs: { PolyObject* t = this->boxDouble(fabs(unboxDouble(*sp)), pc, sp); if (t == 0) goto RAISE_EXCEPTION; *sp = (PolyWord)t; break; } case EXTINSTR_realNeg: { PolyObject* t = this->boxDouble(-(unboxDouble(*sp)), pc, sp); if (t == 0) goto RAISE_EXCEPTION; *sp = (PolyWord)t; break; } case EXTINSTR_floatAbs: { PolyObject* t = this->boxFloat(fabs(unboxFloat(*sp)), pc, sp); if (t == 0) goto RAISE_EXCEPTION; - *sp = t; + *sp = (PolyWord)t; break; } case EXTINSTR_floatNeg: { PolyObject* t = this->boxFloat(-(unboxFloat(*sp)), pc, sp); if (t == 0) goto RAISE_EXCEPTION; - *sp = t; + *sp = (PolyWord)t; break; } case EXTINSTR_fixedIntToReal: { POLYSIGNED u = UNTAGGED(*sp); PolyObject* t = this->boxDouble((double)u, pc, sp); if (t == 0) goto RAISE_EXCEPTION; *sp = (PolyWord)t; break; } case EXTINSTR_fixedIntToFloat: { POLYSIGNED u = UNTAGGED(*sp); PolyObject* t = this->boxFloat((float)u, pc, sp); if (t == 0) goto RAISE_EXCEPTION; - *sp = t; + *sp = (PolyWord)t; break; } case EXTINSTR_floatToReal: { float u = unboxFloat(*sp); PolyObject* t = this->boxDouble((double)u, pc, sp); if (t == 0) goto RAISE_EXCEPTION; - *sp = t; + *sp = (PolyWord)t; break; } case EXTINSTR_wordShiftRArith: { PolyWord u = *sp++; // Strictly speaking, C does not require that this uses // arithmetic shifting so we really ought to set the // high-order bits explicitly. *sp = TAGGED(UNTAGGED(*sp) >> UNTAGGED(u)); break; } case EXTINSTR_lgWordEqual: { - uintptr_t wx = *(uintptr_t*)((*sp++).AsObjPtr()); - uintptr_t wy = *(uintptr_t*)((*sp).AsObjPtr()); + uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr()); + uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr()); *sp = wx == wy ? True : False; break; } case EXTINSTR_lgWordLess: { - uintptr_t wx = *(uintptr_t*)((*sp++).AsObjPtr()); - uintptr_t wy = *(uintptr_t*)((*sp).AsObjPtr()); + uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr()); + uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr()); *sp = (wy < wx) ? True : False; break; } case EXTINSTR_lgWordLessEq: { - uintptr_t wx = *(uintptr_t*)((*sp++).AsObjPtr()); - uintptr_t wy = *(uintptr_t*)((*sp).AsObjPtr()); + uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr()); + uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr()); *sp = (wy <= wx) ? True : False; break; } case EXTINSTR_lgWordGreater: { - uintptr_t wx = *(uintptr_t*)((*sp++).AsObjPtr()); - uintptr_t wy = *(uintptr_t*)((*sp).AsObjPtr()); + uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr()); + uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr()); *sp = (wy > wx) ? True : False; break; } case EXTINSTR_lgWordGreaterEq: { - uintptr_t wx = *(uintptr_t*)((*sp++).AsObjPtr()); - uintptr_t wy = *(uintptr_t*)((*sp).AsObjPtr()); + uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr()); + uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr()); *sp = (wy >= wx) ? True : False; break; } case EXTINSTR_lgWordAdd: { - uintptr_t wx = *(uintptr_t*)((*sp++).AsObjPtr()); - uintptr_t wy = *(uintptr_t*)((*sp).AsObjPtr()); + uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr()); + uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr()); PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ); *(uintptr_t*)t = wy + wx; *sp = (PolyWord)t; break; } case EXTINSTR_lgWordSub: { - uintptr_t wx = *(uintptr_t*)((*sp++).AsObjPtr()); - uintptr_t wy = *(uintptr_t*)((*sp).AsObjPtr()); + uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr()); + uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr()); PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ); *(uintptr_t*)t = wy - wx; *sp = (PolyWord)t; break; } case EXTINSTR_lgWordMult: { - uintptr_t wx = *(uintptr_t*)((*sp++).AsObjPtr()); - uintptr_t wy = *(uintptr_t*)((*sp).AsObjPtr()); + uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr()); + uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr()); PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ); *(uintptr_t*)t = wy * wx; *sp = (PolyWord)t; break; } case EXTINSTR_lgWordDiv: { - uintptr_t wx = *(uintptr_t*)((*sp++).AsObjPtr()); - uintptr_t wy = *(uintptr_t*)((*sp).AsObjPtr()); + uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr()); + uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr()); PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ); *(uintptr_t*)t = wy / wx; *sp = (PolyWord)t; break; } case EXTINSTR_lgWordMod: { - uintptr_t wx = *(uintptr_t*)((*sp++).AsObjPtr()); - uintptr_t wy = *(uintptr_t*)((*sp).AsObjPtr()); + uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr()); + uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr()); PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ); *(uintptr_t*)t = wy % wx; *sp = (PolyWord)t; break; } case EXTINSTR_lgWordAnd: { - uintptr_t wx = *(uintptr_t*)((*sp++).AsObjPtr()); - uintptr_t wy = *(uintptr_t*)((*sp).AsObjPtr()); + uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr()); + uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr()); PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ); *(uintptr_t*)t = wy & wx; *sp = (PolyWord)t; break; } case EXTINSTR_lgWordOr: { - uintptr_t wx = *(uintptr_t*)((*sp++).AsObjPtr()); - uintptr_t wy = *(uintptr_t*)((*sp).AsObjPtr()); + uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr()); + uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr()); PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ); *(uintptr_t*)t = wy | wx; *sp = (PolyWord)t; break; } case EXTINSTR_lgWordXor: { - uintptr_t wx = *(uintptr_t*)((*sp++).AsObjPtr()); - uintptr_t wy = *(uintptr_t*)((*sp).AsObjPtr()); + uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr()); + uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr()); PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ); *(uintptr_t*)t = wy ^ wx; *sp = (PolyWord)t; break; } case EXTINSTR_lgWordShiftLeft: { // The shift amount is a tagged word not a boxed large word POLYUNSIGNED wx = UNTAGGED_UNSIGNED(*sp++); - uintptr_t wy = *(uintptr_t*)((*sp).AsObjPtr()); + uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr()); PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ); *(uintptr_t*)t = wy << wx; *sp = (PolyWord)t; break; } case EXTINSTR_lgWordShiftRLog: { // The shift amount is a tagged word not a boxed large word POLYUNSIGNED wx = UNTAGGED_UNSIGNED(*sp++); - uintptr_t wy = *(uintptr_t*)((*sp).AsObjPtr()); + uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr()); PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ); *(uintptr_t*)t = wy >> wx; *sp = (PolyWord)t; break; } case EXTINSTR_lgWordShiftRArith: { // The shift amount is a tagged word not a boxed large word POLYUNSIGNED wx = UNTAGGED_UNSIGNED(*sp++); - intptr_t wy = *(intptr_t*)((*sp).AsObjPtr()); + intptr_t wy = *(intptr_t*)((*sp).w().AsObjPtr()); PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ); *(intptr_t*)t = wy >> wx; *sp = (PolyWord)t; break; } case EXTINSTR_realEqual: { double u = unboxDouble(*sp++); *sp = u == unboxDouble(*sp) ? True : False; break; } case EXTINSTR_realLess: { double u = unboxDouble(*sp++); *sp = unboxDouble(*sp) < u ? True : False; break; } case EXTINSTR_realLessEq: { double u = unboxDouble(*sp++); *sp = unboxDouble(*sp) <= u ? True : False; break; } case EXTINSTR_realGreater: { double u = unboxDouble(*sp++); *sp = unboxDouble(*sp) > u ? True : False; break; } case EXTINSTR_realGreaterEq: { double u = unboxDouble(*sp++); *sp = unboxDouble(*sp) >= u ? True : False; break; } case EXTINSTR_realUnordered: { double u = unboxDouble(*sp++); double v = unboxDouble(*sp); *sp = (std::isnan(u) || std::isnan(v)) ? True : False; break; } case EXTINSTR_realAdd: { double u = unboxDouble(*sp++); double v = unboxDouble(*sp); PolyObject* t = this->boxDouble(v + u, pc, sp); if (t == 0) goto RAISE_EXCEPTION; *sp = (PolyWord)t; break; } case EXTINSTR_realSub: { double u = unboxDouble(*sp++); double v = unboxDouble(*sp); PolyObject* t = this->boxDouble(v - u, pc, sp); if (t == 0) goto RAISE_EXCEPTION; *sp = (PolyWord)t; break; } case EXTINSTR_realMult: { double u = unboxDouble(*sp++); double v = unboxDouble(*sp); PolyObject* t = this->boxDouble(v * u, pc, sp); if (t == 0) goto RAISE_EXCEPTION; *sp = (PolyWord)t; break; } case EXTINSTR_realDiv: { double u = unboxDouble(*sp++); double v = unboxDouble(*sp); PolyObject* t = this->boxDouble(v / u, pc, sp); if (t == 0) goto RAISE_EXCEPTION; *sp = (PolyWord)t; break; } case EXTINSTR_floatEqual: { float u = unboxFloat(*sp++); *sp = u == unboxFloat(*sp) ? True : False; break; } case EXTINSTR_floatLess: { float u = unboxFloat(*sp++); *sp = unboxFloat(*sp) < u ? True : False; break; } case EXTINSTR_floatLessEq: { float u = unboxFloat(*sp++); *sp = unboxFloat(*sp) <= u ? True : False; break; } case EXTINSTR_floatGreater: { float u = unboxFloat(*sp++); *sp = unboxFloat(*sp) > u ? True : False; break; } case EXTINSTR_floatGreaterEq: { float u = unboxFloat(*sp++); *sp = unboxFloat(*sp) >= u ? True : False; break; } case EXTINSTR_floatUnordered: { float u = unboxFloat(*sp++); float v = unboxFloat(*sp); *sp = (std::isnan(u) || std::isnan(v)) ? True : False; break; } case EXTINSTR_floatAdd: { float u = unboxFloat(*sp++); float v = unboxFloat(*sp); PolyObject* t = this->boxFloat(v + u, pc, sp); if (t == 0) goto RAISE_EXCEPTION; - *sp = t; + *sp = (PolyWord)t; break; } case EXTINSTR_floatSub: { float u = unboxFloat(*sp++); float v = unboxFloat(*sp); PolyObject* t = this->boxFloat(v - u, pc, sp); if (t == 0) goto RAISE_EXCEPTION; - *sp = t; + *sp = (PolyWord)t; break; } case EXTINSTR_floatMult: { float u = unboxFloat(*sp++); float v = unboxFloat(*sp); PolyObject* t = this->boxFloat(v * u, pc, sp); if (t == 0) goto RAISE_EXCEPTION; - *sp = t; + *sp = (PolyWord)t; break; } case EXTINSTR_floatDiv: { float u = unboxFloat(*sp++); float v = unboxFloat(*sp); PolyObject* t = this->boxFloat(v / u, pc, sp); if (t == 0) goto RAISE_EXCEPTION; - *sp = t; + *sp = (PolyWord)t; break; } case EXTINSTR_realToFloat: { // Convert a double to a float. It's complicated because it depends on the rounding mode. int rMode = *pc++; int current = getrounding(); // If the rounding is 4 it means "use current rounding". // Don't call unboxDouble until we're set the rounding. GCC seems to convert it // before the actual float cast. if (rMode < 4) setrounding(rMode); double d = unboxDouble(*sp); float v = (float)d; // Convert with the appropriate rounding. setrounding(current); PolyObject* t = this->boxFloat(v, pc, sp); if (t == 0) goto RAISE_EXCEPTION; - *sp = t; + *sp = (PolyWord)t; break; } case EXTINSTR_realToInt: dv = unboxDouble(*sp); goto realtoint; case EXTINSTR_floatToInt: dv = (double)unboxFloat(*sp); realtoint: { // Convert a double or a float to a tagged integer. int rMode = *pc++; // We mustn't try converting a value that will overflow the conversion // but we need to be careful that we don't raise overflow incorrectly due // to rounding. if (dv > (double)(MAXTAGGED + MAXTAGGED / 2) || dv < -(double)(MAXTAGGED + MAXTAGGED / 2)) { - *(--sp) = overflowPacket; + *(--sp) = (PolyWord)overflowPacket; goto RAISE_EXCEPTION; } POLYSIGNED p; switch (rMode) { case POLY_ROUND_TONEAREST: p = (POLYSIGNED)round(dv); break; case POLY_ROUND_DOWNWARD: p = (POLYSIGNED)floor(dv); break; case POLY_ROUND_UPWARD: p = (POLYSIGNED)ceil(dv); break; case POLY_ROUND_TOZERO: default: // Truncation is the default for C. p = (POLYSIGNED)dv; } // Check that the value can be tagged. if (p > MAXTAGGED || p < -MAXTAGGED - 1) { - *(--sp) = overflowPacket; + *(--sp) = (PolyWord)overflowPacket; goto RAISE_EXCEPTION; } *sp = TAGGED(p); break; } case EXTINSTR_loadC8: { // This is similar to loadMLByte except that the base address is a boxed large-word. // Also the index is SIGNED. POLYSIGNED offset = UNTAGGED(*sp++); POLYSIGNED index = UNTAGGED(*sp++); - POLYCODEPTR p = *((byte**)((*sp).AsObjPtr())) + offset; + POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset; *sp = TAGGED(p[index]); // Have to tag the result break; } case EXTINSTR_loadC16: { // This and the other loads are similar to loadMLWord with separate // index and offset values. POLYSIGNED offset = UNTAGGED(*sp++); POLYSIGNED index = UNTAGGED(*sp++); - POLYCODEPTR p = *((byte**)((*sp).AsObjPtr())) + offset; + POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset; POLYUNSIGNED r = ((uint16_t*)p)[index]; *sp = TAGGED(r); break; } case EXTINSTR_loadC32: { POLYSIGNED offset = UNTAGGED(*sp++); POLYSIGNED index = UNTAGGED(*sp++); - POLYCODEPTR p = *((byte**)((*sp).AsObjPtr())) + offset; + POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset; uintptr_t r = ((uint32_t*)p)[index]; #ifdef IS64BITS // This is tagged in 64-bit mode * sp = TAGGED(r); #else // But boxed in 32-bit mode. PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ); *(uintptr_t*)t = r; *sp = (PolyWord)t; #endif break; } -#if (defined(IS64BITS)) +#if (defined(IS64BITS) || defined(POLYML32IN64)) case EXTINSTR_loadC64: { POLYSIGNED offset = UNTAGGED(*sp++); POLYSIGNED index = UNTAGGED(*sp++); - POLYCODEPTR p = *((byte**)((*sp).AsObjPtr())) + offset; + POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset; uintptr_t r = ((uint64_t*)p)[index]; // This must be boxed. PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ); *(uintptr_t*)t = r; *sp = (PolyWord)t; break; } #endif case EXTINSTR_loadCFloat: { POLYSIGNED offset = UNTAGGED(*sp++); POLYSIGNED index = UNTAGGED(*sp++); - POLYCODEPTR p = *((byte**)((*sp).AsObjPtr())) + offset; + POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset; double r = ((float*)p)[index]; // This must be boxed. PolyObject* t = this->boxDouble(r, pc, sp); if (t == 0) goto RAISE_EXCEPTION; *sp = (PolyWord)t; break; } case EXTINSTR_loadCDouble: { POLYSIGNED offset = UNTAGGED(*sp++); POLYSIGNED index = UNTAGGED(*sp++); - POLYCODEPTR p = *((byte**)((*sp).AsObjPtr())) + offset; + POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset; double r = ((double*)p)[index]; // This must be boxed. PolyObject* t = this->boxDouble(r, pc, sp); if (t == 0) goto RAISE_EXCEPTION; *sp = (PolyWord)t; break; } case EXTINSTR_storeC8: { // Similar to storeMLByte except that the base address is a boxed large-word. POLYUNSIGNED toStore = UNTAGGED(*sp++); POLYSIGNED offset = UNTAGGED(*sp++); POLYSIGNED index = UNTAGGED(*sp++); - POLYCODEPTR p = *((byte**)((*sp).AsObjPtr())) + offset; + POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset; p[index] = (byte)toStore; *sp = Zero; break; } case EXTINSTR_storeC16: { uint16_t toStore = (uint16_t)UNTAGGED(*sp++); POLYSIGNED offset = UNTAGGED(*sp++); POLYSIGNED index = UNTAGGED(*sp++); - POLYCODEPTR p = *((byte**)((*sp).AsObjPtr())) + offset; + POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset; ((uint16_t*)p)[index] = toStore; *sp = Zero; break; } case EXTINSTR_storeC32: { #ifdef IS64BITS // This is a tagged value in 64-bit mode. uint32_t toStore = (uint32_t)UNTAGGED(*sp++); #else // but a boxed value in 32-bit mode. - uint32_t toStore = (uint32_t)(*(uintptr_t*)((*sp++).AsObjPtr())); + uint32_t toStore = (uint32_t)(*(uintptr_t*)((*sp++).w().AsObjPtr())); #endif POLYSIGNED offset = UNTAGGED(*sp++); POLYSIGNED index = UNTAGGED(*sp++); - POLYCODEPTR p = *((byte**)((*sp).AsObjPtr())) + offset; + POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset; ((uint32_t*)p)[index] = toStore; *sp = Zero; break; } -#if (defined(IS64BITS)) +#if (defined(IS64BITS) || defined(POLYML32IN64)) case EXTINSTR_storeC64: { // This is a boxed value. - uint64_t toStore = *(uintptr_t*)((*sp++).AsObjPtr()); + uint64_t toStore = *(uintptr_t*)((*sp++).w().AsObjPtr()); POLYSIGNED offset = UNTAGGED(*sp++); POLYSIGNED index = UNTAGGED(*sp++); - POLYCODEPTR p = *((byte**)((*sp).AsObjPtr())) + offset; + POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset; ((uint64_t*)p)[index] = toStore; *sp = Zero; break; } #endif case EXTINSTR_storeCFloat: { // This is a boxed value. float toStore = (float)unboxDouble(*sp++); POLYSIGNED offset = UNTAGGED(*sp++); POLYSIGNED index = UNTAGGED(*sp++); - POLYCODEPTR p = *((byte**)((*sp).AsObjPtr())) + offset; + POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset; ((float*)p)[index] = toStore; *sp = Zero; break; } case EXTINSTR_storeCDouble: { // This is a boxed value. double toStore = unboxDouble(*sp++); POLYSIGNED offset = UNTAGGED(*sp++); POLYSIGNED index = UNTAGGED(*sp++); - POLYCODEPTR p = *((byte**)((*sp).AsObjPtr())) + offset; + POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset; ((double*)p)[index] = toStore; *sp = Zero; break; } case EXTINSTR_jump32True: // Invert the sense of the test and fall through. - *sp = ((*sp) == True) ? False : True; + *sp = ((*sp).w() == True) ? False : True; case EXTINSTR_jump32False: { PolyWord u = *sp++; /* Pop argument */ if (u == True) { pc += 4; break; } /* else - false - take the jump */ } case EXTINSTR_jump32: { // This is a 32-bit signed quantity on both 64-bits and 32-bits. POLYSIGNED offset = pc[3] & 0x80 ? -1 : 0; offset = (offset << 8) | pc[3]; offset = (offset << 8) | pc[2]; offset = (offset << 8) | pc[1]; offset = (offset << 8) | pc[0]; pc += offset + 4; break; } case EXTINSTR_setHandler32: /* Set up a handler */ { POLYUNSIGNED offset = pc[0] + (pc[1] << 8) + (pc[2] << 16) + (pc[3] << 24); - *(--sp) = PolyWord::FromCodePtr(pc + offset + 4); /* Address of handler */ + (--sp)->codeAddr = pc + offset + 4; /* Address of handler */ this->hr = sp; pc += 4; break; } case EXTINSTR_case32: { // arg1 is the number of cases i.e. one more than the largest value // This is followed by that number of 32-bit offsets. // If the value is out of range the default case is immediately after the table. POLYSIGNED u = UNTAGGED(*sp++); /* Get the value */ if (u >= arg1 || u < 0) pc += 2 + arg1 * 4; /* Out of range */ else { pc += 2; pc += /* Index */pc[u * 4] + (pc[u * 4 + 1] << 8) + (pc[u * 4 + 2] << 16) + (pc[u * 4 + 3] << 24); } break; } case EXTINSTR_tuple_w: { storeWords = arg1; pc += 2; TUPLE: /* Common code for tupling. */ PolyObject* p = this->allocateMemory(storeWords, pc, sp); if (p == 0) goto RAISE_EXCEPTION; // Exception p->SetLengthWord(storeWords, 0); for (; storeWords > 0; ) p->Set(--storeWords, *sp++); *(--sp) = (PolyWord)p; break; } case EXTINSTR_indirect_w: - *sp = (*sp).AsObjPtr()->Get(arg1); pc += 2; break; + *sp = (*sp).w().AsObjPtr()->Get(arg1); pc += 2; break; case EXTINSTR_moveToContainerW: { PolyWord u = *sp++; - (*sp).AsObjPtr()->Set(arg1, u); + (*sp).stackAddr[arg1] =u; pc += 2; break; } case EXTINSTR_moveToMutClosureW: { PolyWord u = *sp++; - (*sp).AsObjPtr()->Set(arg1 + sizeof(uintptr_t)/sizeof(PolyWord), u); + (*sp).w().AsObjPtr()->Set(arg1 + sizeof(uintptr_t)/sizeof(PolyWord), u); pc += 2; break; } case EXTINSTR_indirectContainerW: - *sp = (*sp).AsObjPtr()->Get(arg1); pc += 2; break; + *sp = (*sp).stackAddr[arg1]; pc += 2; break; case EXTINSTR_indirectClosureW: - *sp = (*sp).AsObjPtr()->Get(arg1+sizeof(uintptr_t)/sizeof(PolyWord)); pc += 2; break; + *sp = (*sp).w().AsObjPtr()->Get(arg1+sizeof(uintptr_t)/sizeof(PolyWord)); pc += 2; break; case EXTINSTR_set_stack_val_w: { PolyWord u = *sp++; sp[arg1 - 1] = u; pc += 2; break; } case EXTINSTR_reset_w: sp += arg1; pc += 2; break; case EXTINSTR_reset_r_w: { PolyWord u = *sp; sp += arg1; *sp = u; pc += 2; break; } case EXTINSTR_stack_containerW: { POLYUNSIGNED words = arg1; pc += 2; while (words-- > 0) *(--sp) = Zero; sp--; - *sp = PolyWord::FromStackAddr(sp + 1); + (*sp).stackAddr = sp + 1; break; } case EXTINSTR_constAddr32: { POLYUNSIGNED offset = pc[0] + (pc[1] << 8) + (pc[2] << 16) + (pc[3] << 24); *(--sp) = *(PolyWord*)(pc + offset + 4); pc += 4; break; } case EXTINSTR_allocCSpace: { // Allocate this on the C heap. POLYUNSIGNED length = UNTAGGED_UNSIGNED(*sp); void* memory = malloc(length); *sp = Make_sysword(this, (uintptr_t)memory)->Word(); break; } case EXTINSTR_freeCSpace: { // Both the address and the size are passed as arguments. sp++; // Size PolyWord addr = *sp; free(*(void**)(addr.AsObjPtr())); *sp = TAGGED(0); break; } case EXTINSTR_tail: /* Tail recursive call. */ /* Move items up the stack. */ /* There may be an overlap if the function we are calling has more args than this one. */ tailCount = arg1; tailPtr = sp + tailCount; sp = tailPtr + arg2; goto TAIL_CALL; case EXTINSTR_allocMutClosureW: { // Allocate memory for a mutable closure and copy in the code address. POLYUNSIGNED length = arg1 + sizeof(uintptr_t) / sizeof(PolyWord); pc += 2; PolyObject* t = this->allocateMemory(length, pc, sp); if (t == 0) goto RAISE_EXCEPTION; t->SetLengthWord(length, F_CLOSURE_OBJ | F_MUTABLE_BIT); - PolyObject* srcClosure = (*sp).AsObjPtr(); + PolyObject* srcClosure = (*sp).w().AsObjPtr(); + *(uintptr_t*)t = *(uintptr_t*)srcClosure; + *sp = (PolyWord)t; + break; + } + + case EXTINSTR_closureW: + { + storeWords = arg1; + pc += 2; + CREATE_CLOSURE: + // Allocate a closure. storeWords is the number of non-locals. + POLYUNSIGNED length = storeWords + sizeof(uintptr_t) / sizeof(PolyWord); + PolyObject* t = this->allocateMemory(length, pc, sp); + if (t == 0) goto RAISE_EXCEPTION; + t->SetLengthWord(length, F_CLOSURE_OBJ); + for (; storeWords > 0; ) t->Set(--storeWords + sizeof(uintptr_t) / sizeof(PolyWord), *sp++); + PolyObject* srcClosure = (*sp).w().AsObjPtr(); *(uintptr_t*)t = *(uintptr_t*)srcClosure; - *sp = t; + *sp = (PolyWord)t; break; } default: Crash("Unknown extended instruction %x\n", pc[-1]); } break; } case INSTR_enterIntX86: // This is a no-op if we are already interpreting. pc += 3; break; default: Crash("Unknown instruction %x\n", pc[-1]); } /* switch */ } /* for */ return 0; } /* MD_switch_to_poly */ void IntTaskData::GarbageCollect(ScanAddress *process) { TaskData::GarbageCollect(process); overflowPacket = process->ScanObjectAddress(overflowPacket); dividePacket = process->ScanObjectAddress(dividePacket); if (stack != 0) { StackSpace *stackSpace = stack; - PolyWord *stackPtr = this->taskSp; + stackItem*stackPtr = this->taskSp; // The exception arg if any ScanStackAddress(process, this->exception_arg, stackSpace); // Now the values on the stack. - for (PolyWord *q = stackPtr; q < stackSpace->top; q++) - ScanStackAddress(process, *q, stackSpace); + for (stackItem* q = stackPtr; q < (stackItem*)stack->top; q++) + ScanStackAddress(process, *q, stack); } } // Process a value within the stack. -void IntTaskData::ScanStackAddress(ScanAddress *process, PolyWord &val, StackSpace *stack) +void IntTaskData::ScanStackAddress(ScanAddress *process, stackItem& stackItem, StackSpace *stack) { - if (! val.IsDataPtr()) return; + // We may have return addresses on the stack which could look like +// tagged values. Check whether the value is in the code area before +// checking whether it is untagged. + if (stackItem.codeAddr == SPECIAL_PC_END_THREAD/* 0 */) + return; +#ifdef POLYML32IN64 + // In 32-in-64 return addresses always have the top 32 bits non-zero. + if (stackItem.argValue < ((uintptr_t)1 << 32)) + { + // It's either a tagged integer or an object pointer. + if (stackItem.w().IsDataPtr()) + { + PolyWord val = process->ScanObjectAddress(stackItem.w().AsObjPtr()); + stackItem = val; + } + } + else + { + // Could be a code address or a stack address. + MemSpace* space = gMem.SpaceForAddress(stackItem.codeAddr - 1); + if (space == 0 || space->spaceType != ST_CODE) return; + PolyObject* obj = gMem.FindCodeObject(stackItem.codeAddr); + ASSERT(obj != 0); + // Process the address of the start. Don't update anything. + process->ScanObjectAddress(obj); + } +#else + // The -1 here is because we may have a zero-sized cell in the last + // word of a space. + MemSpace* space = gMem.SpaceForAddress(stackItem.codeAddr - 1); + if (space == 0) return; // In particular we may have one of the assembly code addresses. + if (space->spaceType == ST_CODE) + { + PolyObject* obj = gMem.FindCodeObject(stackItem.codeAddr); + // If it is actually an integer it might be outside a valid code object. + if (obj == 0) + { + ASSERT(stackItem.w().IsTagged()); // It must be an integer + } + else // Process the address of the start. Don't update anything. + process->ScanObjectAddress(obj); + } + else if (space->spaceType == ST_LOCAL && stackItem.w().IsDataPtr()) + // Local values must be word addresses. + { + PolyWord val = process->ScanObjectAddress(stackItem.w().AsObjPtr()); + stackItem = val; + } +#endif - MemSpace *space = gMem.LocalSpaceForAddress(val.AsStackAddr()-1); - if (space != 0) - val = process->ScanObjectAddress(val.AsObjPtr()); } // Copy a stack void IntTaskData::CopyStackFrame(StackObject *old_stack, uintptr_t old_length, StackObject *new_stack, uintptr_t new_length) { +#ifdef POLYML32IN64 + old_length = old_length / 2; + new_length = new_length / 2; +#endif /* Moves a stack, updating all references within the stack */ - PolyWord *old_base = (PolyWord *)old_stack; - PolyWord *new_base = (PolyWord*)new_stack; - PolyWord *old_top = old_base + old_length; + stackItem*old_base = (stackItem*)old_stack; + stackItem*new_base = (stackItem*)new_stack; + stackItem*old_top = old_base + old_length; /* Calculate the offset of the new stack from the old. If the frame is being extended objects in the new frame will be further up the stack than in the old one. */ uintptr_t offset = new_base - old_base + new_length - old_length; - PolyWord *oldSp = this->taskSp; + stackItem *oldSp = this->taskSp; this->taskSp = oldSp + offset; this->hr = this->hr + offset; /* Skip the unused part of the stack. */ uintptr_t i = oldSp - old_base; ASSERT(i <= old_length); i = old_length - i; - PolyWord *old = oldSp; - PolyWord *newp = this->taskSp; + stackItem *old = oldSp; + stackItem *newp = this->taskSp; while (i--) { - // ASSERT(old >= old_base && old < old_base+old_length); - // ASSERT(newp >= new_base && newp < new_base+new_length); - PolyWord old_word = *old++; - if (old_word.IsTagged() || old_word.AsStackAddr() < old_base || old_word.AsStackAddr() >= old_top) - *newp++ = old_word; - else - *newp++ = PolyWord::FromStackAddr(old_word.AsStackAddr() + offset); + stackItem old_word = *old++; + if (old_word.w().IsDataPtr() && old_word.stackAddr >= old_base && old_word.stackAddr <= old_top) + old_word.stackAddr = old_word.stackAddr + offset; + else if (old_word.w().IsDataPtr() && IsHeapAddress(old_word.stackAddr)) + { + stackItem* addr = (stackItem*)old_word.w().AsStackAddr(); + if (addr >= old_base && addr <= old_top) + { + addr += offset; + old_word = PolyWord::FromStackAddr((PolyWord*)addr); + } + } + *newp++ = old_word; } - ASSERT(old == ((PolyWord*)old_stack) + old_length); - ASSERT(newp == ((PolyWord*)new_stack) + new_length); + ASSERT(old == ((stackItem*)old_stack) + old_length); + ASSERT(newp == ((stackItem*)new_stack) + new_length); } void IntTaskData::EnterPolyCode() /* Called from "main" to enter the code. */ { Handle hOriginal = this->saveVec.mark(); // Set this up for the IO calls. while (1) { this->saveVec.reset(hOriginal); // Remove old RTS arguments and results. // Run the ML code and return with the function to call. this->inML = true; int ioFunction = SwitchToPoly(); this->inML = false; try { switch (ioFunction) { case -1: // We've been interrupted. This usually involves simulating a // stack overflow so we could come here because of a genuine // stack overflow. // Previously this code was executed on every RTS call but there // were problems on Mac OS X at least with contention on schedLock. // Process any asynchronous events i.e. interrupts or kill processes->ProcessAsynchRequests(this); // Release and re-acquire use of the ML memory to allow another thread // to GC. processes->ThreadReleaseMLMemory(this); processes->ThreadUseMLMemory(this); break; case -2: // A callback has returned. ASSERT(0); // Callbacks aren't implemented default: Crash("Unknown io operation %d\n", ioFunction); } } catch (IOException &) { } } } // As far as possible we want locking and unlocking an ML mutex to be fast so // we try to implement the code in the assembly code using appropriate // interlocked instructions. That does mean that if we need to lock and // unlock an ML mutex in this code we have to use the same, machine-dependent, // code to do it. These are defaults that are used where there is no // machine-specific code. static Handle ProcessAtomicDecrement(TaskData *taskData, Handle mutexp) { PLocker l(&mutexLock); PolyObject *p = DEREFHANDLE(mutexp); // A thread can only call this once so the values will be short PolyWord newValue = TAGGED(UNTAGGED(p->Get(0))-1); p->Set(0, newValue); return taskData->saveVec.push(newValue); } // Release a mutex. We need to lock the mutex to ensure we don't // reset it in the time between one of atomic operations reading // and writing the mutex. static Handle ProcessAtomicReset(TaskData *taskData, Handle mutexp) { PLocker l(&mutexLock); DEREFHANDLE(mutexp)->Set(0, TAGGED(0)); // Set this to released. return taskData->saveVec.push(TAGGED(0)); // Push the unit result } Handle IntTaskData::AtomicDecrement(Handle mutexp) { return ProcessAtomicDecrement(this, mutexp); } void IntTaskData::AtomicReset(Handle mutexp) { (void)ProcessAtomicReset(this, mutexp); } bool IntTaskData::AddTimeProfileCount(SIGNALCONTEXT *context) { if (taskPc != 0) { // See if the PC we've got is an ML code address. MemSpace *space = gMem.SpaceForAddress(taskPc); if (space != 0 && (space->spaceType == ST_CODE || space->spaceType == ST_PERMANENT)) { incrementCountAsynch(taskPc); return true; } } return false; } extern "C" { POLYEXTERNALSYMBOL POLYUNSIGNED PolyInterpretedGetAbiList(FirstArgument threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyInterpretedCreateCIF(FirstArgument threadId, PolyWord abiValue, PolyWord resultType, PolyWord argTypes); POLYEXTERNALSYMBOL POLYUNSIGNED PolyInterpretedCallFunction(FirstArgument threadId, PolyWord cifAddr, PolyWord cFunAddr, PolyWord resAddr, PolyWord argVec); POLYEXTERNALSYMBOL POLYUNSIGNED PolyInterpretedEnterIntMode(); } // FFI #if (defined(HAVE_LIBFFI) && defined(HAVE_FFI_H)) #ifdef HAVE_ERRNO_H #include #endif #include static struct _abiTable { const char* abiName; ffi_abi abiCode; } abiTable[] = { // Unfortunately the ABI entries are enums rather than #defines so we // can't test individual entries. #ifdef X86_WIN32 {"sysv", FFI_SYSV}, {"stdcall", FFI_STDCALL}, {"thiscall", FFI_THISCALL}, {"fastcall", FFI_FASTCALL}, {"ms_cdecl", FFI_MS_CDECL}, #elif defined(X86_WIN64) {"win64", FFI_WIN64}, #elif defined(X86_64) || (defined (__x86_64__) && defined (X86_DARWIN)) {"unix64", FFI_UNIX64}, #elif defined(X86_ANY) {"sysv", FFI_SYSV}, #endif { "default", FFI_DEFAULT_ABI} }; static Handle mkAbitab(TaskData* taskData, void*, char* p); static Handle toSysWord(TaskData* taskData, void* p) { return Make_sysword(taskData, (uintptr_t)p); } // Convert the Poly type info into ffi_type values. /* datatype cTypeForm = CTypeFloatingPt | CTypePointer | CTypeSignedInt | CTypeUnsignedInt | CTypeStruct of cType list | CTypeVoid withtype cType = { typeForm: cTypeForm, align: word, size: word } */ static ffi_type* decodeType(PolyWord pType) { PolyWord typeForm = pType.AsObjPtr()->Get(2); PolyWord typeSize = pType.AsObjPtr()->Get(0); if (typeForm.IsDataPtr()) { // Struct size_t size = typeSize.UnTaggedUnsigned(); unsigned short align = (unsigned short)pType.AsObjPtr()->Get(1).UnTaggedUnsigned(); unsigned nElems = 0; PolyWord listStart = typeForm.AsObjPtr()->Get(0); for (PolyWord p = listStart; !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t) nElems++; size_t space = sizeof(ffi_type); // Add space for the elements plus one extra for the zero terminator. space += (nElems + 1) * sizeof(ffi_type*); ffi_type* result = (ffi_type*)calloc(1, space); // Raise an exception rather than returning zero. if (result == 0) return 0; ffi_type** elem = (ffi_type**)(result + 1); result->size = size; result->alignment = align; result->type = FFI_TYPE_STRUCT; result->elements = elem; if (elem != 0) { for (PolyWord p = listStart; !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t) { PolyWord e = ((ML_Cons_Cell*)p.AsObjPtr())->h; ffi_type* t = decodeType(e); if (t == 0) return 0; *elem++ = t; } *elem = 0; // Null terminator } return result; } else { switch (typeForm.UnTaggedUnsigned()) { case 0: { // Floating point if (typeSize.UnTaggedUnsigned() == ffi_type_float.size) return &ffi_type_float; else if (typeSize.UnTaggedUnsigned() == ffi_type_double.size) return &ffi_type_double; ASSERT(0); } case 1: // FFI type poiner return &ffi_type_pointer; case 2: // Signed integer. { switch (typeSize.UnTaggedUnsigned()) { case 1: return &ffi_type_sint8; case 2: return &ffi_type_sint16; case 4: return &ffi_type_sint32; case 8: return &ffi_type_sint64; default: ASSERT(0); } } case 3: // Unsigned integer. { switch (typeSize.UnTaggedUnsigned()) { case 1: return &ffi_type_uint8; case 2: return &ffi_type_uint16; case 4: return &ffi_type_uint32; case 8: return &ffi_type_uint64; default: ASSERT(0); } } case 4: // Void return &ffi_type_void; } ASSERT(0); } return 0; } // Create a CIF. This contains all the types and some extra information. // The arguments are the raw ML values. That does make this dependent on the // representations used by the compiler. // This mallocs space for the CIF and the types. The space is never freed. // POLYUNSIGNED PolyInterpretedCreateCIF(FirstArgument threadId, PolyWord abiValue, PolyWord resultType, PolyWord argTypes) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; ffi_abi abi = (ffi_abi)get_C_ushort(taskData, abiValue); try { unsigned nArgs = 0; for (PolyWord p = argTypes; !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t) nArgs++; // Allocate space for the cif followed by the argument type vector size_t space = sizeof(ffi_cif) + nArgs * sizeof(ffi_type*); ffi_cif* cif = (ffi_cif*)malloc(space); if (cif == 0) raise_syscall(taskData, "Insufficient memory", ENOMEM); ffi_type* rtype = decodeType(resultType); if (rtype == 0) raise_syscall(taskData, "Insufficient memory", ENOMEM); ffi_type** atypes = (ffi_type**)(cif + 1); // Copy the arguments types. ffi_type** at = atypes; for (PolyWord p = argTypes; !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t) { PolyWord e = ((ML_Cons_Cell*)p.AsObjPtr())->h; ffi_type *atype = decodeType(e); if (atype == 0) raise_syscall(taskData, "Insufficient memory", ENOMEM); *at++ = atype; } ffi_status status = ffi_prep_cif(cif, abi, nArgs, rtype, atypes); if (status == FFI_BAD_TYPEDEF) raise_exception_string(taskData, EXC_foreign, "Bad typedef in ffi_prep_cif"); else if (status == FFI_BAD_ABI) raise_exception_string(taskData, EXC_foreign, "Bad ABI in ffi_prep_cif"); else if (status != FFI_OK) raise_exception_string(taskData, EXC_foreign, "Error in ffi_prep_cif"); result = toSysWord(taskData, cif); } 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(); } // Call a function. POLYUNSIGNED PolyInterpretedCallFunction(FirstArgument threadId, PolyWord cifAddr, PolyWord cFunAddr, PolyWord resAddr, PolyWord argVec) { ffi_cif* cif = *(ffi_cif**)cifAddr.AsAddress(); void* f = *(void**)cFunAddr.AsAddress(); void* res = *(void**)resAddr.AsAddress(); void* arg = *(void**)argVec.AsAddress(); // Poly passes the arguments as values, effectively a single struct. // Libffi wants a vector of addresses. void** argVector = (void**)calloc(cif->nargs + 1, sizeof(void*)); unsigned n = 0; uintptr_t p = (uintptr_t)arg; while (n < cif->nargs) { uintptr_t align = cif->arg_types[n]->alignment; p = (p + align - 1) & (0-align); argVector[n] = (void*)p; p += cif->arg_types[n]->size; n++; } // The result area we have provided is only as big as required. // Libffi may need a larger area. if (cif->rtype->size < FFI_SIZEOF_ARG) { char result[FFI_SIZEOF_ARG]; ffi_call(cif, FFI_FN(f), &result, argVector); if (cif->rtype->type != FFI_TYPE_VOID) memcpy(res, result, cif->rtype->size); } else ffi_call(cif, FFI_FN(f), res, argVector); free(argVector); return TAGGED(0).AsUnsigned(); } #else // Libffi is not present. // A basic table so that the Foreign structure will compile static struct _abiTable { const char* abiName; int abiCode; } abiTable[] = { { "default", 0} }; // Don't raise an exception at this point so we can build calls. POLYUNSIGNED PolyInterpretedCreateCIF(FirstArgument threadId, PolyWord abiValue, PolyWord resultType, PolyWord argTypes) { return TAGGED(0).AsUnsigned(); } POLYUNSIGNED PolyInterpretedCallFunction(FirstArgument threadId, PolyWord cifAddr, PolyWord cFunAddr, PolyWord resAddr, PolyWord argVec) { TaskData* taskData = TaskData::FindTaskForId(threadId); raise_exception_string(taskData, EXC_foreign, "Foreign function calling is not available. Libffi is not installled."); return TAGGED(0).AsUnsigned(); } #endif // Construct an entry in the ABI table. static Handle mkAbitab(TaskData* taskData, void* arg, char* p) { struct _abiTable* ab = (struct _abiTable*)p; // Construct a pair of the string and the code Handle name = taskData->saveVec.push(C_string_to_Poly(taskData, ab->abiName)); Handle code = Make_arbitrary_precision(taskData, ab->abiCode); Handle result = alloc_and_save(taskData, 2); result->WordP()->Set(0, name->Word()); result->WordP()->Set(1, code->Word()); return result; } // Get ABI list. This is called once only before the basis library is built. POLYUNSIGNED PolyInterpretedGetAbiList(FirstArgument threadId) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = makeList(taskData, sizeof(abiTable) / sizeof(abiTable[0]), (char*)abiTable, sizeof(abiTable[0]), 0, mkAbitab); } 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(); } // Do we require EnterInt instructions and if so for which architecture? // 0 = > None; 1 => X86_32, 2 => X86_64. 3 => X86_32_in_64. POLYUNSIGNED PolyInterpretedEnterIntMode() { return TAGGED(0).AsUnsigned(); } static Interpreter interpreterObject; MachineDependent *machineDependent = &interpreterObject; // No machine-specific calls in the interpreter. struct _entrypts machineSpecificEPT[] = { { "PolyInterpretedGetAbiList", (polyRTSFunction)&PolyInterpretedGetAbiList }, { "PolyInterpretedCreateCIF", (polyRTSFunction)&PolyInterpretedCreateCIF }, { "PolyInterpretedCallFunction", (polyRTSFunction)&PolyInterpretedCallFunction }, { "PolyInterpretedEnterIntMode", (polyRTSFunction)&PolyInterpretedEnterIntMode }, { NULL, NULL} // End of list. }; diff --git a/libpolyml/x86_dep.cpp b/libpolyml/x86_dep.cpp index 4fe01a56..852b74e5 100644 --- a/libpolyml/x86_dep.cpp +++ b/libpolyml/x86_dep.cpp @@ -1,1298 +1,1273 @@ /* Title: Machine dependent code for i386 and X64 under Windows and Unix Copyright (c) 2000-7 Cambridge University Technical Services Limited Further work copyright David C. J. Matthews 2011-20 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDLIB_H #include #endif #include #ifdef HAVE_SIGNAL_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #if (defined(_WIN32)) #include #include #endif #include "globals.h" #include "run_time.h" #include "diagnostics.h" #include "processes.h" #include "profiling.h" #include "machine_dep.h" #include "scanaddrs.h" #include "memmgr.h" #include "rtsentry.h" #include "sys.h" // Temporary /********************************************************************** * * Register usage: * * %Reax: First argument to function. Result of function call. * %Rebx: Second argument to function. * %Recx: General register * %Redx: Closure pointer in call. * %Rebp: Points to memory used for extra registers * %Resi: General register. * %Redi: General register. * %Resp: Stack pointer. * The following apply only on the X64 * %R8: Third argument to function * %R9: Fourth argument to function * %R10: Fifth argument to function * %R11: General register * %R12: General register * %R13: General register * %R14: General register * %R15: Memory allocation pointer * **********************************************************************/ #ifdef HOSTARCHITECTURE_X86_64 struct fpSaveArea { double fpregister[7]; // Save area for xmm0-6 }; #else // Structure of floating point save area. // This is dictated by the hardware. typedef byte fpregister[10]; struct fpSaveArea { unsigned short cw; unsigned short _unused0; unsigned short sw; unsigned short _unused1; unsigned short tw; unsigned short _unused2; unsigned fip; unsigned short fcs0; unsigned short _unused3; unsigned foo; unsigned short fcs1; unsigned short _unused4; fpregister registers[8]; }; #endif /* the amount of ML stack space to reserve for registers, C exception handling etc. The compiler requires us to reserve 2 stack-frames worth (2 * 20 words). We actually reserve slightly more than this. */ #if (!defined(_WIN32) && !defined(HAVE_SIGALTSTACK)) // If we can't handle signals on a separate stack make sure there's space // on the Poly stack. #define OVERFLOW_STACK_SIZE (50+1024) #else #define OVERFLOW_STACK_SIZE 50 #endif -union stackItem -{ -/* -#ifndef POLYML32IN64 - stackItem(PolyWord v) { words[0] = v.AsUnsigned(); }; - stackItem() { words[0] = TAGGED(0).AsUnsigned(); } - POLYUNSIGNED words[1]; -#else - // In 32-in-64 we need to clear the second PolyWord. This assumes little-endian. - stackItem(PolyWord v) { words[0] = v.AsUnsigned(); words[1] = 0; }; - stackItem() { words[0] = TAGGED(0).AsUnsigned(); words[1] = 0; } - POLYUNSIGNED words[2]; -#endif - */ - stackItem(PolyWord v) { argValue = v.AsUnsigned(); } - stackItem() { argValue = TAGGED(0).AsUnsigned(); } - - // These return the low order word. - PolyWord w()const { return PolyWord::FromUnsigned((POLYUNSIGNED)argValue); } - operator PolyWord () { return PolyWord::FromUnsigned((POLYUNSIGNED)argValue); } - POLYCODEPTR codeAddr; // Return addresses - stackItem *stackAddr; // Stack addresses - uintptr_t argValue; // Treat an address as an int -}; - class X86TaskData; // This is passed as the argument vector to X86AsmSwitchToPoly. // The offsets are built into the assembly code and the code-generator. // localMpointer and stackPtr are updated before control returns to C. typedef struct _AssemblyArgs { public: PolyWord *localMpointer; // Allocation ptr + 1 word stackItem *handlerRegister; // Current exception handler PolyWord *localMbottom; // Base of memory + 1 word stackItem *stackLimit; // Lower limit of stack stackItem exceptionPacket; // Set if there is an exception byte unusedRequestCode; // No longer used. byte unusedFlag; // No longer used byte returnReason; // Reason for returning from ML. byte unusedRestore; // No longer used. uintptr_t saveCStack; // Saved C stack frame. PolyWord threadId; // My thread id. Saves having to call into RTS for it. stackItem *stackPtr; // Current stack pointer byte *noLongerUsed; // Now removed byte *heapOverFlowCall; // These are filled in with the functions. byte *stackOverFlowCall; byte *stackOverFlowCallEx; // Saved registers, where applicable. stackItem p_rax; stackItem p_rbx; stackItem p_rcx; stackItem p_rdx; stackItem p_rsi; stackItem p_rdi; #ifdef HOSTARCHITECTURE_X86_64 stackItem p_r8; stackItem p_r9; stackItem p_r10; stackItem p_r11; stackItem p_r12; stackItem p_r13; stackItem p_r14; #endif struct fpSaveArea p_fp; } AssemblyArgs; // These next few are temporarily added for the interpreter // This duplicates some code in reals.cpp but is now updated. #define DOUBLESIZE (sizeof(double)/sizeof(POLYUNSIGNED)) union realdb { double dble; POLYUNSIGNED puns[DOUBLESIZE]; }; #define LGWORDSIZE (sizeof(uintptr_t) / sizeof(PolyWord)) class X86TaskData: public TaskData { public: X86TaskData(); unsigned allocReg; // The register to take the allocated space. POLYUNSIGNED allocWords; // The words to allocate. AssemblyArgs assemblyInterface; int saveRegisterMask; // Registers that need to be updated by a GC. virtual void GarbageCollect(ScanAddress *process); void ScanStackAddress(ScanAddress *process, stackItem &val, StackSpace *stack); virtual void EnterPolyCode(); // Start running ML virtual void InterruptCode(); virtual bool AddTimeProfileCount(SIGNALCONTEXT *context); virtual void InitStackFrame(TaskData *parentTask, Handle proc, Handle arg); virtual void SetException(poly_exn *exc); // Release a mutex in exactly the same way as compiler code virtual Handle AtomicDecrement(Handle mutexp); virtual void AtomicReset(Handle mutexp); // Return the minimum space occupied by the stack. Used when setting a limit. // N.B. This is PolyWords not native words. virtual uintptr_t currentStackSpace(void) const { return (this->stack->top - (PolyWord*)assemblyInterface.stackPtr) + OVERFLOW_STACK_SIZE*sizeof(uintptr_t)/sizeof(PolyWord); } // Increment the profile count for an allocation. Also now used for mutex contention. virtual void addProfileCount(POLYUNSIGNED words) { addSynchronousCount(assemblyInterface.stackPtr[0].codeAddr, words); } // PreRTSCall: After calling from ML to the RTS we need to save the current heap pointer virtual void PreRTSCall(void) { TaskData::PreRTSCall(); SaveMemRegisters(); } // PostRTSCall: Before returning we need to restore the heap pointer. // If there has been a GC in the RTS call we need to create a new heap area. virtual void PostRTSCall(void) { SetMemRegisters(); TaskData::PostRTSCall(); } virtual void CopyStackFrame(StackObject *old_stack, uintptr_t old_length, StackObject *new_stack, uintptr_t new_length); void HeapOverflowTrap(byte *pcPtr); void SetMemRegisters(); void SaveMemRegisters(); void SetRegisterMask(); void HandleTrap(); PLock interruptLock; stackItem *get_reg(int n); stackItem *®SP() { return assemblyInterface.stackPtr; } stackItem ®AX() { return assemblyInterface.p_rax; } stackItem ®BX() { return assemblyInterface.p_rbx; } stackItem ®CX() { return assemblyInterface.p_rcx; } stackItem ®DX() { return assemblyInterface.p_rdx; } stackItem ®SI() { return assemblyInterface.p_rsi; } stackItem ®DI() { return assemblyInterface.p_rdi; } #ifdef HOSTARCHITECTURE_X86_64 stackItem ®8() { return assemblyInterface.p_r8; } stackItem ®9() { return assemblyInterface.p_r9; } stackItem ®10() { return assemblyInterface.p_r10; } stackItem ®11() { return assemblyInterface.p_r11; } stackItem ®12() { return assemblyInterface.p_r12; } stackItem ®13() { return assemblyInterface.p_r13; } stackItem ®14() { return assemblyInterface.p_r14; } #endif #if (defined(_WIN32)) DWORD savedErrno; #else int savedErrno; #endif }; class X86Dependent: public MachineDependent { public: X86Dependent() {} // Create a task data object. virtual TaskData *CreateTaskData(void) { return new X86TaskData(); } // Initial size of stack in PolyWords virtual unsigned InitialStackSize(void) { return (128+OVERFLOW_STACK_SIZE) * sizeof(uintptr_t) / sizeof(PolyWord); } virtual void ScanConstantsWithinCode(PolyObject *addr, PolyObject *oldAddr, POLYUNSIGNED length, ScanAddress *process); virtual Architectures MachineArchitecture(void) #ifndef HOSTARCHITECTURE_X86_64 { return MA_I386; } #elif defined(POLYML32IN64) { return MA_X86_64_32; } #else { return MA_X86_64; } #endif }; // Values for the returnReason byte enum RETURN_REASON { RETURN_HEAP_OVERFLOW = 1, RETURN_STACK_OVERFLOW = 2, RETURN_STACK_OVERFLOWEX = 3, }; extern "C" { // These are declared in the assembly code segment. void X86AsmSwitchToPoly(void *); extern int X86AsmCallExtraRETURN_HEAP_OVERFLOW(void); extern int X86AsmCallExtraRETURN_STACK_OVERFLOW(void); extern int X86AsmCallExtraRETURN_STACK_OVERFLOWEX(void); POLYUNSIGNED X86AsmAtomicDecrement(PolyObject*); void X86TrapHandler(PolyWord threadId); }; X86TaskData::X86TaskData(): allocReg(0), allocWords(0), saveRegisterMask(0) { assemblyInterface.heapOverFlowCall = (byte*)X86AsmCallExtraRETURN_HEAP_OVERFLOW; assemblyInterface.stackOverFlowCall = (byte*)X86AsmCallExtraRETURN_STACK_OVERFLOW; assemblyInterface.stackOverFlowCallEx = (byte*)X86AsmCallExtraRETURN_STACK_OVERFLOWEX; savedErrno = 0; } void X86TaskData::GarbageCollect(ScanAddress *process) { TaskData::GarbageCollect(process); // Process the parent first assemblyInterface.threadId = threadObject; if (stack != 0) { ASSERT(assemblyInterface.stackPtr >= (stackItem*)stack->bottom && assemblyInterface.stackPtr <= (stackItem*)stack->top); // Now the values on the stack. for (stackItem *q = assemblyInterface.stackPtr; q < (stackItem*)stack->top; q++) ScanStackAddress(process, *q, stack); } // Register mask for (int i = 0; i < 16; i++) { if (saveRegisterMask & (1 << i)) ScanStackAddress(process, *get_reg(i), stack); } } // Process a value within the stack. void X86TaskData::ScanStackAddress(ScanAddress *process, stackItem &stackItem, StackSpace *stack) { // We may have return addresses on the stack which could look like // tagged values. Check whether the value is in the code area before // checking whether it is untagged. #ifdef POLYML32IN64 // In 32-in-64 return addresses always have the top 32 bits non-zero. if (stackItem.argValue < ((uintptr_t)1 << 32)) { // It's either a tagged integer or an object pointer. if (stackItem.w().IsDataPtr()) { PolyWord val = process->ScanObjectAddress(stackItem.w().AsObjPtr()); stackItem = val; } } else { // Could be a code address or a stack address. MemSpace *space = gMem.SpaceForAddress(stackItem.codeAddr - 1); if (space == 0 || space->spaceType != ST_CODE) return; PolyObject *obj = gMem.FindCodeObject(stackItem.codeAddr); ASSERT(obj != 0); // Process the address of the start. Don't update anything. process->ScanObjectAddress(obj); } #else // The -1 here is because we may have a zero-sized cell in the last // word of a space. MemSpace *space = gMem.SpaceForAddress(stackItem.codeAddr-1); if (space == 0) return; // In particular we may have one of the assembly code addresses. if (space->spaceType == ST_CODE) { PolyObject *obj = gMem.FindCodeObject(stackItem.codeAddr); // If it is actually an integer it might be outside a valid code object. if (obj == 0) { ASSERT(stackItem.w().IsTagged()); // It must be an integer } else // Process the address of the start. Don't update anything. process->ScanObjectAddress(obj); } else if (space->spaceType == ST_LOCAL && stackItem.w().IsDataPtr()) // Local values must be word addresses. { PolyWord val = process->ScanObjectAddress(stackItem.w().AsObjPtr()); stackItem = val; } #endif } // Copy a stack void X86TaskData::CopyStackFrame(StackObject *old_stack, uintptr_t old_length, StackObject *new_stack, uintptr_t new_length) { /* Moves a stack, updating all references within the stack */ #ifdef POLYML32IN64 old_length = old_length / 2; new_length = new_length / 2; #endif stackItem *old_base = (stackItem *)old_stack; stackItem *new_base = (stackItem*)new_stack; stackItem *old_top = old_base + old_length; /* Calculate the offset of the new stack from the old. If the frame is being extended objects in the new frame will be further up the stack than in the old one. */ uintptr_t offset = new_base - old_base + new_length - old_length; stackItem *oldStackPtr = assemblyInterface.stackPtr; // Adjust the stack pointer and handler pointer since these point into the stack. assemblyInterface.stackPtr = assemblyInterface.stackPtr + offset; assemblyInterface.handlerRegister = assemblyInterface.handlerRegister + offset; // We need to adjust any values on the stack that are pointers within the stack. // Skip the unused part of the stack. size_t i = oldStackPtr - old_base; ASSERT (i <= old_length); i = old_length - i; stackItem *old = oldStackPtr; stackItem *newp = assemblyInterface.stackPtr; while (i--) { stackItem old_word = *old++; if (old_word.w().IsDataPtr() && old_word.stackAddr >= old_base && old_word.stackAddr <= old_top) old_word.stackAddr = old_word.stackAddr + offset; else if (old_word.w().IsDataPtr() && IsHeapAddress(old_word.stackAddr)) { stackItem *addr = (stackItem*)old_word.w().AsStackAddr(); if (addr >= old_base && addr <= old_top) { addr += offset; old_word = PolyWord::FromStackAddr((PolyWord*)addr); } } *newp++ = old_word; } ASSERT(old == ((stackItem*)old_stack)+old_length); ASSERT(newp == ((stackItem*)new_stack)+new_length); // And change any registers that pointed into the old stack for (int j = 0; j < 16; j++) { if (saveRegisterMask & (1 << j)) { stackItem *regAddr = get_reg(j); stackItem old_word = *regAddr; if (old_word.w().IsDataPtr() && old_word.stackAddr >= old_base && old_word.stackAddr <= old_top) old_word.stackAddr = old_word.stackAddr + offset; else if (old_word.w().IsDataPtr() && IsHeapAddress(old_word.stackAddr)) { stackItem *addr = (stackItem*)old_word.w().AsStackAddr(); if (addr >= old_base && addr <= old_top) { addr += offset; old_word = PolyWord::FromStackAddr((PolyWord*)addr); } } *regAddr = old_word; } } } void X86TaskData::EnterPolyCode() /* Called from "main" to enter the code. */ { SetMemRegisters(); // Enter the ML code. X86AsmSwitchToPoly(&this->assemblyInterface); // This should never return ASSERT(0); } // Called from the assembly code as a result of a trap i.e. a request for // a GC or to extend the stack. void X86TrapHandler(PolyWord threadId) { X86TaskData* taskData = (X86TaskData*)TaskData::FindTaskForId(threadId); taskData->HandleTrap(); } void X86TaskData::HandleTrap() { SaveMemRegisters(); // Update globals from the memory registers. switch (this->assemblyInterface.returnReason) { case RETURN_HEAP_OVERFLOW: // The heap has overflowed. SetRegisterMask(); this->HeapOverflowTrap(assemblyInterface.stackPtr[0].codeAddr); // Computes a value for allocWords only break; case RETURN_STACK_OVERFLOW: case RETURN_STACK_OVERFLOWEX: { SetRegisterMask(); uintptr_t min_size; // Size in PolyWords if (assemblyInterface.returnReason == RETURN_STACK_OVERFLOW) { min_size = (this->stack->top - (PolyWord*)assemblyInterface.stackPtr) + OVERFLOW_STACK_SIZE * sizeof(uintptr_t) / sizeof(PolyWord); } else { // Stack limit overflow. If the required stack space is larger than // the fixed overflow size the code will calculate the limit in %EDI. stackItem* stackP = regDI().stackAddr; min_size = (this->stack->top - (PolyWord*)stackP) + OVERFLOW_STACK_SIZE * sizeof(uintptr_t) / sizeof(PolyWord); } try { // The stack check has failed. This may either be because we really have // overflowed the stack or because the stack limit value has been adjusted // to result in a call here. CheckAndGrowStack(this, min_size); } catch (IOException&) { // We may get an exception while handling this if we run out of store } { PLocker l(&interruptLock); // Set the stack limit. This clears any interrupt and also sets the // correct value if we've grown the stack. this->assemblyInterface.stackLimit = (stackItem*)this->stack->bottom + OVERFLOW_STACK_SIZE; } // We're in a safe state to handle any interrupts. try { // Process any asynchronous events i.e. interrupts or kill processes->ProcessAsynchRequests(this); // Release and re-acquire use of the ML memory to allow another thread to GC. processes->ThreadReleaseMLMemory(this); processes->ThreadUseMLMemory(this); } catch (IOException&) { // If this resulted in an ML exception it will also raise a C++ exception. } catch (KillException&) { processes->ThreadExit(this); } break; } default: Crash("Unknown return reason code %u", this->assemblyInterface.returnReason); } SetMemRegisters(); } void X86TaskData::InitStackFrame(TaskData *parentTaskData, Handle proc, Handle arg) /* Initialise stack frame. */ { StackSpace *space = this->stack; StackObject * newStack = space->stack(); uintptr_t stack_size = space->spaceSize() * sizeof(PolyWord) / sizeof(stackItem); // Set the top of the stack inside the stack rather than at the end. This wastes // a word but if sp is actually at the end OpenBSD segfaults because it isn't in // a MAP_STACK area. uintptr_t topStack = stack_size - 1; stackItem* stackTop = (stackItem*)newStack + topStack; *stackTop = TAGGED(0); // Set it to non-zero. assemblyInterface.stackPtr = stackTop; assemblyInterface.stackLimit = (stackItem*)space->bottom + OVERFLOW_STACK_SIZE; assemblyInterface.handlerRegister = stackTop; // Floating point save area. memset(&assemblyInterface.p_fp, 0, sizeof(struct fpSaveArea)); #ifndef HOSTARCHITECTURE_X86_64 // Set the control word for 64-bit precision otherwise we get inconsistent results. assemblyInterface.p_fp.cw = 0x027f ; // Control word assemblyInterface.p_fp.tw = 0xffff; // Tag registers - all unused #endif // Store the argument and the closure. assemblyInterface.p_rdx = proc->Word(); // Closure assemblyInterface.p_rax = (arg == 0) ? TAGGED(0) : DEREFWORD(arg); // Argument // Have to set the register mask in case we get a GC before the thread starts. saveRegisterMask = (1 << 2) | 1; // Rdx and rax #ifdef POLYML32IN64 // In 32-in-64 RBX always contains the heap base address. assemblyInterface.p_rbx.stackAddr = (stackItem*)globalHeapBase; #endif } // In Solaris-x86 the registers are named EIP and ESP. #if (!defined(REG_EIP) && defined(EIP)) #define REG_EIP EIP #endif #if (!defined(REG_ESP) && defined(ESP)) #define REG_ESP ESP #endif // Get the PC and SP(stack) from a signal context. This is needed for profiling. // This version gets the actual sp and pc if we are in ML. // N.B. This must not call malloc since we're in a signal handler. bool X86TaskData::AddTimeProfileCount(SIGNALCONTEXT *context) { stackItem * sp = 0; POLYCODEPTR pc = 0; if (context != 0) { // The tests for HAVE_UCONTEXT_T, HAVE_STRUCT_SIGCONTEXT and HAVE_WINDOWS_H need // to follow the tests in processes.h. #if defined(HAVE_WINDOWS_H) #ifdef _WIN64 sp = (stackItem *)context->Rsp; pc = (POLYCODEPTR)context->Rip; #else // Windows 32 including cygwin. sp = (stackItem *)context->Esp; pc = (POLYCODEPTR)context->Eip; #endif #elif defined(HAVE_UCONTEXT_T) #ifdef HAVE_MCONTEXT_T_GREGS // Linux #ifndef HOSTARCHITECTURE_X86_64 pc = (byte*)context->uc_mcontext.gregs[REG_EIP]; sp = (stackItem*)context->uc_mcontext.gregs[REG_ESP]; #else /* HOSTARCHITECTURE_X86_64 */ pc = (byte*)context->uc_mcontext.gregs[REG_RIP]; sp = (stackItem*)context->uc_mcontext.gregs[REG_RSP]; #endif /* HOSTARCHITECTURE_X86_64 */ #elif defined(HAVE_MCONTEXT_T_MC_ESP) // FreeBSD #ifndef HOSTARCHITECTURE_X86_64 pc = (byte*)context->uc_mcontext.mc_eip; sp = (stackItem*)context->uc_mcontext.mc_esp; #else /* HOSTARCHITECTURE_X86_64 */ pc = (byte*)context->uc_mcontext.mc_rip; sp = (stackItem*)context->uc_mcontext.mc_rsp; #endif /* HOSTARCHITECTURE_X86_64 */ #else // Mac OS X #ifndef HOSTARCHITECTURE_X86_64 #if(defined(HAVE_STRUCT_MCONTEXT_SS)||defined(HAVE_STRUCT___DARWIN_MCONTEXT32_SS)) pc = (byte*)context->uc_mcontext->ss.eip; sp = (stackItem*)context->uc_mcontext->ss.esp; #elif(defined(HAVE_STRUCT___DARWIN_MCONTEXT32___SS)) pc = (byte*)context->uc_mcontext->__ss.__eip; sp = (stackItem*)context->uc_mcontext->__ss.__esp; #endif #else /* HOSTARCHITECTURE_X86_64 */ #if(defined(HAVE_STRUCT_MCONTEXT_SS)||defined(HAVE_STRUCT___DARWIN_MCONTEXT64_SS)) pc = (byte*)context->uc_mcontext->ss.rip; sp = (stackItem*)context->uc_mcontext->ss.rsp; #elif(defined(HAVE_STRUCT___DARWIN_MCONTEXT64___SS)) pc = (byte*)context->uc_mcontext->__ss.__rip; sp = (stackItem*)context->uc_mcontext->__ss.__rsp; #endif #endif /* HOSTARCHITECTURE_X86_64 */ #endif #elif defined(HAVE_STRUCT_SIGCONTEXT) #if defined(HOSTARCHITECTURE_X86_64) && defined(__OpenBSD__) // CPP defines missing in amd64/signal.h in OpenBSD pc = (byte*)context->sc_rip; sp = (stackItem*)context->sc_rsp; #else // !HOSTARCHITEXTURE_X86_64 || !defined(__OpenBSD__) pc = (byte*)context->sc_pc; sp = (stackItem*)context->sc_sp; #endif #endif } if (pc != 0) { // See if the PC we've got is an ML code address. MemSpace *space = gMem.SpaceForAddress(pc); if (space != 0 && (space->spaceType == ST_CODE || space->spaceType == ST_PERMANENT)) { incrementCountAsynch(pc); return true; } } // See if the sp value is in the current stack. if (sp >= (stackItem*)this->stack->bottom && sp < (stackItem*)this->stack->top) { // We may be in the assembly code. The top of the stack will be a return address. pc = sp[0].w().AsCodePtr(); MemSpace *space = gMem.SpaceForAddress(pc); if (space != 0 && (space->spaceType == ST_CODE || space->spaceType == ST_PERMANENT)) { incrementCountAsynch(pc); return true; } } // See if the value of regSP is a valid stack pointer. // This works if we happen to be in an RTS call using a "Full" call. // It doesn't work if we've used a "Fast" call because that doesn't save the SP. sp = assemblyInterface.stackPtr; if (sp >= (stackItem*)this->stack->bottom && sp < (stackItem*)this->stack->top) { // We may be in the run-time system. pc = sp[0].w().AsCodePtr(); MemSpace *space = gMem.SpaceForAddress(pc); if (space != 0 && (space->spaceType == ST_CODE || space->spaceType == ST_PERMANENT)) { incrementCountAsynch(pc); return true; } } // None of those worked return false; } // This is called from a different thread so we have to be careful. void X86TaskData::InterruptCode() { PLocker l(&interruptLock); // Set the stack limit pointer to the top of the stack to cause // a trap when we next check for stack overflow. // We use a lock here to ensure that we always use the current value of the // stack. The thread we're interrupting could be growing the stack at this point. if (this->stack != 0) this->assemblyInterface.stackLimit = (stackItem*)(this->stack->top-1); } // This is called from SwitchToPoly before we enter the ML code. void X86TaskData::SetMemRegisters() { // Copy the current store limits into variables before we go into the assembly code. // If we haven't yet set the allocation area or we don't have enough we need // to create one (or a new one). if (this->allocPointer <= this->allocLimit + this->allocWords) { if (this->allocPointer < this->allocLimit) Crash ("Bad length in heap overflow trap"); // Find some space to allocate in. Updates taskData->allocPointer and // returns a pointer to the newly allocated space (if allocWords != 0) PolyWord *space = processes->FindAllocationSpace(this, this->allocWords, true); if (space == 0) { // We will now raise an exception instead of returning. // Set allocWords to zero so we don't set the allocation register // since that could be holding the exception packet. this->allocWords = 0; } // Undo the allocation just now. this->allocPointer += this->allocWords; } if (this->allocWords != 0) { // If we have had a heap trap we actually do the allocation here. // We will have already garbage collected and recovered sufficient space. // This also happens if we have just trapped because of store profiling. this->allocPointer -= this->allocWords; // Now allocate // Set the allocation register to this area. N.B. This is an absolute address. if (this->allocReg < 15) get_reg(this->allocReg)[0].codeAddr = (POLYCODEPTR)(this->allocPointer + 1); /* remember: it's off-by-one */ this->allocWords = 0; } // If we have run out of store, either just above or while allocating in the RTS, // allocPointer and allocLimit will have been set to zero as part of the GC. We will // now be raising an exception which may free some store but we need to come back here // before we allocate anything. The compiled code uses unsigned arithmetic to check for // heap overflow but only after subtracting the space required. We need to make sure // that the values are still non-negative after substracting any object size. if (this->allocPointer == 0) this->allocPointer += MAX_OBJECT_SIZE; if (this->allocLimit == 0) this->allocLimit += MAX_OBJECT_SIZE; this->assemblyInterface.localMbottom = this->allocLimit + 1; this->assemblyInterface.localMpointer = this->allocPointer + 1; // If we are profiling store allocation we set mem_hl so that a trap // will be generated. if (profileMode == kProfileStoreAllocation) this->assemblyInterface.localMbottom = this->assemblyInterface.localMpointer; this->assemblyInterface.threadId = this->threadObject; } // This is called whenever we have returned from ML to C. void X86TaskData::SaveMemRegisters() { this->allocPointer = this->assemblyInterface.localMpointer - 1; this->allocWords = 0; this->assemblyInterface.exceptionPacket = TAGGED(0); this->saveRegisterMask = 0; } // Called on a GC or stack overflow trap. The register mask // is in the bytes after the trap call. void X86TaskData::SetRegisterMask() { byte *pc = assemblyInterface.stackPtr[0].codeAddr; if (*pc == 0xcd) // CD - INT n is used for a single byte { pc++; saveRegisterMask = *pc++; } else if (*pc == 0xca) // CA - FAR RETURN is used for a two byte mask { pc++; saveRegisterMask = pc[0] | (pc[1] << 8); pc += 2; } assemblyInterface.stackPtr[0].codeAddr = pc; } stackItem *X86TaskData::get_reg(int n) /* Returns a pointer to the register given by n. */ { switch (n) { case 0: return &assemblyInterface.p_rax; case 1: return &assemblyInterface.p_rcx; case 2: return &assemblyInterface.p_rdx; case 3: return &assemblyInterface.p_rbx; // Should not have rsp or rbp. case 6: return &assemblyInterface.p_rsi; case 7: return &assemblyInterface.p_rdi; #ifdef HOSTARCHITECTURE_X86_64 case 8: return &assemblyInterface.p_r8; case 9: return &assemblyInterface.p_r9; case 10: return &assemblyInterface.p_r10; case 11: return &assemblyInterface.p_r11; case 12: return &assemblyInterface.p_r12; case 13: return &assemblyInterface.p_r13; case 14: return &assemblyInterface.p_r14; // R15 is the heap pointer so shouldn't occur here. #endif /* HOSTARCHITECTURE_X86_64 */ default: Crash("Unknown register %d\n", n); } } // Called as a result of a heap overflow trap void X86TaskData::HeapOverflowTrap(byte *pcPtr) { X86TaskData *mdTask = this; POLYUNSIGNED wordsNeeded = 0; // The next instruction, after any branches round forwarding pointers or pop // instructions, will be a store of register containing the adjusted heap pointer. // We need to find that register and the value in it in order to find out how big // the area we actually wanted is. N.B. The code-generator and assembly code // must generate the correct instruction sequence. // byte *pcPtr = assemblyInterface.programCtr; while (true) { if (pcPtr[0] == 0xeb) { // Forwarding pointer if (pcPtr[1] >= 128) pcPtr += 256 - pcPtr[1] + 2; else pcPtr += pcPtr[1] + 2; } else if ((pcPtr[0] & 0xf8) == 0x58) // Pop instruction. pcPtr++; else if (pcPtr[0] == 0x41 && ((pcPtr[1] & 0xf8) == 0x58)) // Pop with Rex prefix pcPtr += 2; else break; } #ifndef HOSTARCHITECTURE_X86_64 // This should be movl REG,0[%ebp]. ASSERT(pcPtr[0] == 0x89); mdTask->allocReg = (pcPtr[1] >> 3) & 7; // Remember this until we allocate the memory stackItem *reg = get_reg(mdTask->allocReg); stackItem reg_val = *reg; // The space we need is the difference between this register // and the current value of newptr. // The +1 here is because assemblyInterface.localMpointer is A.M.pointer +1. The reason // is that after the allocation we have the register pointing at the address we will // actually use. wordsNeeded = (this->allocPointer - (PolyWord*)reg_val.stackAddr) + 1; *reg = TAGGED(0); // Clear this - it's not a valid address. /* length in words, including length word */ ASSERT (wordsNeeded <= (1<<24)); /* Max object size including length/flag word is 2^24 words. */ #else /* HOSTARCHITECTURE_X86_64 */ ASSERT(pcPtr[1] == 0x89 || pcPtr[1] == 0x8b); if (pcPtr[1] == 0x89) { // New (5.4) format. This should be movq REG,%r15 ASSERT(pcPtr[0] == 0x49 || pcPtr[0] == 0x4d); mdTask->allocReg = (pcPtr[2] >> 3) & 7; // Remember this until we allocate the memory if (pcPtr[0] & 0x4) mdTask->allocReg += 8; } else { // Alternative form of movq REG,%r15 ASSERT(pcPtr[0] == 0x4c || pcPtr[0] == 0x4d); mdTask->allocReg = pcPtr[2] & 7; // Remember this until we allocate the memory if (pcPtr[0] & 0x1) mdTask->allocReg += 8; } stackItem *reg = get_reg(this->allocReg); stackItem reg_val = *reg; wordsNeeded = (POLYUNSIGNED)((this->allocPointer - (PolyWord*)reg_val.stackAddr) + 1); *reg = TAGGED(0); // Clear this - it's not a valid address. #endif /* HOSTARCHITECTURE_X86_64 */ if (profileMode == kProfileStoreAllocation) addProfileCount(wordsNeeded); mdTask->allocWords = wordsNeeded; // The actual allocation is done in SetMemRegisters. } void X86TaskData::SetException(poly_exn *exc) // The RTS wants to raise an exception packet. Normally this is as the // result of an RTS call in which case the caller will check this. It can // also happen in a trap. { assemblyInterface.exceptionPacket = (PolyWord)exc; // Set for direct calls. } // Decode and process an effective address. There may // be a constant address in here but in any case we need // to decode it to work out where the next instruction starts. // If this is an lea instruction any addresses are just constants // so must not be treated as addresses. static void skipea(PolyObject *base, byte **pt, ScanAddress *process, bool lea) { unsigned int modrm = *((*pt)++); unsigned int md = modrm >> 6; unsigned int rm = modrm & 7; if (md == 3) { } /* Register. */ else if (rm == 4) { /* s-i-b present. */ unsigned int sib = *((*pt)++); if (md == 0) { if ((sib & 7) == 5) { if (! lea) { #ifndef HOSTARCHITECTURE_X86_64 process->ScanConstant(base, *pt, PROCESS_RELOC_DIRECT); #endif /* HOSTARCHITECTURE_X86_64 */ } (*pt) += 4; } } else if (md == 1) (*pt)++; else if (md == 2) (*pt) += 4; } else if (md == 0 && rm == 5) { if (!lea) { #ifndef HOSTARCHITECTURE_X86_64 /* Absolute address. */ process->ScanConstant(base, *pt, PROCESS_RELOC_DIRECT); #endif /* HOSTARCHITECTURE_X86_64 */ } *pt += 4; } else { if (md == 1) *pt += 1; else if (md == 2) *pt += 4; } } /* Added to deal with constants within the code rather than in the constant area. The constant area is still needed for the function name. DCJM 2/1/2001 */ void X86Dependent::ScanConstantsWithinCode(PolyObject *addr, PolyObject *old, POLYUNSIGNED length, ScanAddress *process) { byte *pt = (byte*)addr; PolyWord *end = addr->Offset(length - 1); #ifdef POLYML32IN64 // If this begins with enter-int it's interpreted code - ignore if (pt[0] == 0xff && pt[1] == 0x55 && pt[2] == 0x48) return; #endif while (true) { // Escape prefixes come before any Rex byte if (*pt == 0xf2 || *pt == 0xf3 || *pt == 0x66) pt++; #ifdef HOSTARCHITECTURE_X86_64 // REX prefixes. Set this first. byte lastRex; if (*pt >= 0x40 && *pt <= 0x4f) lastRex = *pt++; else lastRex = 0; //printf("pt=%p *pt=%x\n", pt, *pt); #endif /* HOSTARCHITECTURE_X86_64 */ switch (*pt) { case 0x00: return; // This is actually the first byte of the old "marker" word. case 0xf4: return; // Halt - now used as a marker. case 0x50: case 0x51: case 0x52: case 0x53: case 0x54: case 0x55: case 0x56: case 0x57: /* Push */ case 0x58: case 0x59: case 0x5a: case 0x5b: case 0x5c: case 0x5d: case 0x5e: case 0x5f: /* Pop */ case 0x90: /* nop */ case 0xc3: /* ret */ case 0xf9: /* stc */ case 0xce: /* into */ case 0xf0: /* lock. */ case 0xf3: /* rep/repe */ case 0xa4: case 0xa5: case 0xaa: case 0xab: /* movs/stos */ case 0xa6: /* cmpsb */ case 0x9e: /* sahf */ case 0x99: /* cqo/cdq */ pt++; break; case 0x70: case 0x71: case 0x72: case 0x73: case 0x74: case 0x75: case 0x76: case 0x77: case 0x78: case 0x79: case 0x7a: case 0x7b: case 0x7c: case 0x7d: case 0x7e: case 0x7f: case 0xeb: /* short jumps. */ case 0xcd: /* INT - now used for a register mask */ case 0xa8: /* TEST_ACC8 */ case 0x6a: /* PUSH_8 */ pt += 2; break; case 0xc2: /* RET_16 */ case 0xca: /* FAR RET 16 - used for a register mask */ pt += 3; break; case 0x8d: /* leal. */ pt++; skipea(addr, &pt, process, true); break; case 0x03: case 0x0b: case 0x13: case 0x1b: case 0x23: case 0x2b: case 0x33: case 0x3b: /* Add r,ea etc. */ case 0x88: /* MOVB_R_A */ case 0x89: /* MOVL_R_A */ case 0x8b: /* MOVL_A_R */ case 0x62: /* BOUNDL */ case 0xff: /* Group5 */ case 0xd1: /* Group2_1_A */ case 0x8f: /* POP_A */ case 0xd3: /* Group2_CL_A */ case 0x87: // XCHNG case 0x63: // MOVSXD pt++; skipea(addr, &pt, process, false); break; case 0xf6: /* Group3_a */ { int isTest = 0; pt++; /* The test instruction has an immediate operand. */ if ((*pt & 0x38) == 0) isTest = 1; skipea(addr, &pt, process, false); if (isTest) pt++; break; } case 0xf7: /* Group3_A */ { int isTest = 0; pt++; /* The test instruction has an immediate operand. */ if ((*pt & 0x38) == 0) isTest = 1; skipea(addr, &pt, process, false); if (isTest) pt += 4; break; } case 0xc1: /* Group2_8_A */ case 0xc6: /* MOVB_8_A */ case 0x83: /* Group1_8_A */ case 0x80: /* Group1_8_a */ case 0x6b: // IMUL Ev,Ib pt++; skipea(addr, &pt, process, false); pt++; break; case 0x69: // IMUL Ev,Iv pt++; skipea(addr, &pt, process, false); pt += 4; break; case 0x81: /* Group1_32_A */ { pt ++; #ifndef HOSTARCHITECTURE_X86_64 unsigned opCode = *pt; #endif skipea(addr, &pt, process, false); // Only check the 32 bit constant if this is a comparison. // For other operations this may be untagged and shouldn't be an address. #ifndef HOSTARCHITECTURE_X86_64 if ((opCode & 0x38) == 0x38) process->ScanConstant(addr, pt, PROCESS_RELOC_DIRECT); #endif pt += 4; break; } case 0xe8: case 0xe9: // Long jump and call. These are used to call constant (known) functions // and also long jumps within the function. { pt++; POLYSIGNED disp = (pt[3] & 0x80) ? -1 : 0; // Set the sign just in case. for(unsigned i = 4; i > 0; i--) disp = (disp << 8) | pt[i-1]; byte *absAddr = pt + disp + 4; // The address is relative to AFTER the constant // If the new address is within the current piece of code we don't do anything if (absAddr >= (byte*)addr && absAddr < (byte*)end) {} else { #ifdef HOSTARCHITECTURE_X86_64 ASSERT(sizeof(PolyWord) == 4); // Should only be used internally on x64 #endif /* HOSTARCHITECTURE_X86_64 */ if (addr != old) { // The old value of the displacement was relative to the old address before // we copied this code segment. // We have to correct it back to the original address. absAddr = absAddr - (byte*)addr + (byte*)old; // We have to correct the displacement for the new location and store // that away before we call ScanConstant. size_t newDisp = absAddr - pt - 4; byte* wr = gMem.SpaceForAddress(pt)->writeAble(pt); for (unsigned i = 0; i < 4; i++) { wr[i] = (byte)(newDisp & 0xff); newDisp >>= 8; } } process->ScanConstant(addr, pt, PROCESS_RELOC_I386RELATIVE); } pt += 4; break; } case 0xc7:/* MOVL_32_A */ { pt++; if ((*pt & 0xc0) == 0x40 /* Byte offset or sib present */ && ((*pt & 7) != 4) /* But not sib present */ && pt[1] == 256-sizeof(PolyWord)) { /* We may use a move instruction to set the length word on a new segment. We mustn't try to treat this as a constant. */ pt += 6; /* Skip the modrm byte, the offset and the constant. */ } else { skipea(addr, &pt, process, false); #ifndef HOSTARCHITECTURE_X86_64 // This isn't used for addresses even in 32-in-64 process->ScanConstant(addr, pt, PROCESS_RELOC_DIRECT); #endif /* HOSTARCHITECTURE_X86_64 */ pt += 4; } break; } case 0xb8: case 0xb9: case 0xba: case 0xbb: case 0xbc: case 0xbd: case 0xbe: case 0xbf: /* MOVL_32_64_R */ pt ++; #ifdef HOSTARCHITECTURE_X86_64 if ((lastRex & 8) == 0) pt += 4; // 32-bit mode on 64-bits else #endif /* HOSTARCHITECTURE_X86_64 */ { // This is used in native 32-bit for constants and in // 32-in-64 for the special case of an absolute address. process->ScanConstant(addr, pt, PROCESS_RELOC_DIRECT); pt += sizeof(uintptr_t); } break; case 0x68: /* PUSH_32 */ pt ++; #if (!defined(HOSTARCHITECTURE_X86_64)) process->ScanConstant(addr, pt, PROCESS_RELOC_DIRECT); #endif pt += 4; break; case 0x0f: /* ESCAPE */ { pt++; switch (*pt) { case 0xb6: /* movzl */ case 0xb7: // movzw case 0xbe: // movsx case 0xbf: // movsx case 0xc1: /* xaddl */ case 0xae: // ldmxcsr/stmxcsr case 0xaf: // imul case 0x40: case 0x41: case 0x42: case 0x43: case 0x44: case 0x45: case 0x46: case 0x47: case 0x48: case 0x49: case 0x4a: case 0x4b: case 0x4c: case 0x4d: case 0x4e: case 0x4f: // cmov pt++; skipea(addr, &pt, process, false); break; case 0x80: case 0x81: case 0x82: case 0x83: case 0x84: case 0x85: case 0x86: case 0x87: case 0x88: case 0x89: case 0x8a: case 0x8b: case 0x8c: case 0x8d: case 0x8e: case 0x8f: /* Conditional branches with 32-bit displacement. */ pt += 5; break; case 0x90: case 0x91: case 0x92: case 0x93: case 0x94: case 0x95: case 0x96: case 0x97: case 0x98: case 0x99: case 0x9a: case 0x9b: case 0x9c: case 0x9d: case 0x9e: case 0x9f: /* SetCC. */ pt++; skipea(addr, &pt, process, false); break; // These are SSE2 instructions case 0x10: case 0x11: case 0x58: case 0x5c: case 0x59: case 0x5e: case 0x2e: case 0x2a: case 0x54: case 0x57: case 0x5a: case 0x6e: case 0x7e: case 0x2c: case 0x2d: pt++; skipea(addr, &pt, process, false); break; case 0x73: // PSRLDQ - EA,imm pt++; skipea(addr, &pt, process, false); pt++; break; default: Crash("Unknown opcode %d at %p\n", *pt, pt); } break; } case 0xd8: case 0xd9: case 0xda: case 0xdb: case 0xdc: case 0xdd: case 0xde: case 0xdf: // Floating point escape instructions { pt++; if ((*pt & 0xe0) == 0xe0) pt++; else skipea(addr, &pt, process, false); break; } default: Crash("Unknown opcode %d at %p\n", *pt, pt); } } } // Increment the value contained in the first word of the mutex. Handle X86TaskData::AtomicDecrement(Handle mutexp) { PolyObject *p = DEREFHANDLE(mutexp); POLYUNSIGNED result = X86AsmAtomicDecrement(p); return this->saveVec.push(PolyWord::FromUnsigned(result)); } // Release a mutex. Because the atomic increment and decrement // use the hardware LOCK prefix we can simply set this to zero. void X86TaskData::AtomicReset(Handle mutexp) { DEREFHANDLE(mutexp)->Set(0, TAGGED(0)); } static X86Dependent x86Dependent; MachineDependent *machineDependent = &x86Dependent; extern "C" { POLYEXTERNALSYMBOL void *PolyX86GetThreadData(); } // Return the address of assembly data for the current thread. This is normally in // RBP except if we are in a callback. void *PolyX86GetThreadData() { // We should get the task data for the thread that is running this code. // If this thread has been created by the foreign code we will have to // create a new one here. TaskData* taskData = processes->GetTaskDataForThread(); if (taskData == 0) { try { taskData = processes->CreateNewTaskData(0, 0, 0, TAGGED(0)); } catch (std::bad_alloc&) { ::Exit("Unable to create thread data - insufficient memory"); } catch (MemoryException&) { ::Exit("Unable to create thread data - insufficient memory"); } } return &((X86TaskData*)taskData)->assemblyInterface; } struct _entrypts machineSpecificEPT[] = { { "PolyX86GetThreadData", (polyRTSFunction)& PolyX86GetThreadData }, { NULL, NULL} // End of list. };