From dce109ad536a5e5f5da016f5f8216215fc77f5ff Mon Sep 17 00:00:00 2001 From: soulofmischief <30357883+soulofmischief@users.noreply.github.com> Date: Sun, 7 Dec 2025 15:16:52 -0600 Subject: [PATCH 01/14] Bump minimum required CMake version to v3.19 3.5 support has been removed from CMake 4, and 3.10 support is slated for removal. Bumping to 3.19 also lets us remove the explicit CMP0114 OLD policy. --- CMakeLists.txt | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index ef81ee85..76fd2650 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,8 +1,9 @@ -cmake_minimum_required(VERSION 3.1) # we use target_sources() +cmake_minimum_required(VERSION 3.19) # we use target_sources() project(Extempore VERSION 0.8.9) -# for backwards compatibility with CMake older than 3.19 -cmake_policy(SET CMP0114 OLD) +if(POLICY CMP0135) + cmake_policy(SET CMP0135 NEW) +endif() option(ASSETS "download multimedia assets (approx 500MB)" OFF) option(BUILD_TESTS "build test targets (including examples)" ON) From 02e1665526a943fe44036c449fdf4cd1410be29a Mon Sep 17 00:00:00 2001 From: soulofmischief <30357883+soulofmischief@users.noreply.github.com> Date: Sun, 7 Dec 2025 15:50:00 -0600 Subject: [PATCH 02/14] Set the minimum macOS deployment target for ARM64 to macOS 11.0 (Big Sur) --- CMakeLists.txt | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 76fd2650..60ef5812 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -40,9 +40,20 @@ endif() # packaging (binary distribution) +# ARM64 requires macOS 11.0 (Big Sur) minimum +if(APPLE) + if(NOT DEFINED CMAKE_OSX_DEPLOYMENT_TARGET) + if(CMAKE_SYSTEM_PROCESSOR MATCHES "arm64" OR CMAKE_HOST_SYSTEM_PROCESSOR MATCHES "arm64") + set(CMAKE_OSX_DEPLOYMENT_TARGET 11.0) + endif() + endif() +endif() + if(PACKAGE) - # this needs to be set before project() is called - set(CMAKE_OSX_DEPLOYMENT_TARGET 10.12) + # For packaged binaries on Intel, enforce a 10.12 floor if still unset + if(NOT DEFINED CMAKE_OSX_DEPLOYMENT_TARGET) + set(CMAKE_OSX_DEPLOYMENT_TARGET 10.12) + endif() set(ASSETS ON) # necessary for packaging message(STATUS "Building Extempore for binary distribution (assets directory will be downloaded)") endif() From dc39204373eb4320f565890f6d5ddacc0c18e28b Mon Sep 17 00:00:00 2001 From: soulofmischief <30357883+soulofmischief@users.noreply.github.com> Date: Sun, 7 Dec 2025 16:28:25 -0600 Subject: [PATCH 03/14] Use native tuning for ARM64 --- CMakeLists.txt | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 60ef5812..ec9934fc 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -78,8 +78,15 @@ if(EXTERNAL_SHLIBS) set(EXT_DEPS_INSTALL_DIR ${CMAKE_BINARY_DIR}/deps-install) set(EXT_PLATFORM_SHLIBS_DIR ${CMAKE_SOURCE_DIR}/libs/platform-shlibs) if(PACKAGE) + # Use generic tuning for x86_64 packages, but native tuning for ARM64 + if(CMAKE_SYSTEM_PROCESSOR MATCHES "arm64|aarch64|ARM64") + set(EXT_DEPS_C_FLAGS "${CMAKE_C_FLAGS_RELEASE}") + set(EXT_DEPS_CXX_FLAGS "${CMAKE_CXX_FLAGS_RELEASE}") + message(STATUS "ARM64 detected: using native CPU tuning") + else() set(EXT_DEPS_C_FLAGS "${CMAKE_C_FLAGS_RELEASE} -mtune=generic") set(EXT_DEPS_CXX_FLAGS "${CMAKE_CXX_FLAGS_RELEASE} -mtune=generic") + endif() message(STATUS "compiler flags for packaging:\nC ${EXT_DEPS_C_FLAGS}\nCXX ${EXT_DEPS_CXX_FLAGS}") endif() endif() @@ -183,8 +190,10 @@ target_compile_definitions(pcre ) if(PACKAGE) + if(NOT CMAKE_SYSTEM_PROCESSOR MATCHES "arm64|aarch64|ARM64") target_compile_options(pcre PRIVATE -mtune=generic) + endif() endif() ############# @@ -373,8 +382,10 @@ endif() if(PACKAGE) target_compile_definitions(extempore PRIVATE -DEXT_SHARE_DIR=".") + if(NOT CMAKE_SYSTEM_PROCESSOR MATCHES "arm64|aarch64|ARM64") target_compile_options(extempore PRIVATE -mtune=generic) + endif() elseif(EXT_SHARE_DIR) target_compile_definitions(extempore PRIVATE -DEXT_SHARE_DIR="${EXT_SHARE_DIR}") From f7affc90b4a00ebbfd6e66542c71b9927b317f18 Mon Sep 17 00:00:00 2001 From: soulofmischief <30357883+soulofmischief@users.noreply.github.com> Date: Wed, 17 Dec 2025 11:48:40 -0600 Subject: [PATCH 04/14] Correctly match modern macOS system versions --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index ec9934fc..f58a876c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -138,7 +138,7 @@ if(APPLE) execute_process(COMMAND sw_vers -productVersion OUTPUT_VARIABLE EXTEMPORE_SYSTEM_VERSION OUTPUT_STRIP_TRAILING_WHITESPACE) - string(REGEX MATCH "^10.[0-9]+" EXTEMPORE_SYSTEM_VERSION ${EXTEMPORE_SYSTEM_VERSION}) + string(REGEX MATCH "^[0-9]+\\.?[0-9]*" EXTEMPORE_SYSTEM_VERSION ${EXTEMPORE_SYSTEM_VERSION}) set(EXTEMPORE_SYSTEM_ARCHITECTURE ${UNAME_MACHINE_NAME}) elseif(UNIX) # try lsb_release first - better at giving the distro name From b6edb97f0b0f1903a4ed4aa8f149273070f3e904 Mon Sep 17 00:00:00 2001 From: soulofmischief <30357883+soulofmischief@users.noreply.github.com> Date: Wed, 17 Dec 2025 11:49:10 -0600 Subject: [PATCH 05/14] Build all core AOT libs with aot_core target --- CMakeLists.txt | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index f58a876c..a21388d0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -558,6 +558,8 @@ else(WIN32) if(NOT ${group} STREQUAL "core") add_dependencies(${targetname} external_shlibs_${group}) add_dependencies(aot_external_${group} ${targetname}) + else() + add_dependencies(aot_core ${targetname}) endif() foreach(dep ${ARGN}) add_dependencies(${targetname} aot_${dep}) From c620c64dd1a64bfed0a9a4bc86b1d6837e598d9f Mon Sep 17 00:00:00 2001 From: soulofmischief <30357883+soulofmischief@users.noreply.github.com> Date: Wed, 17 Dec 2025 12:09:09 -0600 Subject: [PATCH 06/14] Build with c++17 --- CMakeLists.txt | 10 ++-------- src/SchemeFFI.cpp | 2 +- src/ffi/sys.inc | 10 +++++----- 3 files changed, 8 insertions(+), 14 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index a21388d0..7306fbec 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -408,7 +408,7 @@ if(UNIX) PRIVATE -D__STDC_FORMAT_MACROS PRIVATE -D__STDC_LIMIT_MACROS) target_compile_options(extempore - PRIVATE -std=c++11 + PRIVATE -std=c++17 PRIVATE -fvisibility-inlines-hidden # PRIVATE -fno-exceptions PRIVATE -fno-rtti @@ -422,13 +422,7 @@ endif() if(WIN32) target_compile_definitions(extempore PRIVATE -DPCRE_STATIC - PRIVATE -D_CRT_SECURE_NO_WARNINGS - # NOTE: this next define is necessary because VS2019 deprecated the std::tr2 - # namespace, but setting CXX_STANDARD to c++17 (required for "normal" - # std::filesystem) breaks a bunch of LLVM 3.8. So, when we finally upgrade - # LLVM, we should switch to std::filesystem, but for now let's just hold our - # nose and do this. - PRIVATE -D_SILENCE_EXPERIMENTAL_FILESYSTEM_DEPRECATION_WARNING) + PRIVATE -D_CRT_SECURE_NO_WARNINGS) set_source_files_properties( PROPERTIES COMPILE_FLAGS "/EHsc") diff --git a/src/SchemeFFI.cpp b/src/SchemeFFI.cpp index f2828161..87377c5f 100644 --- a/src/SchemeFFI.cpp +++ b/src/SchemeFFI.cpp @@ -75,7 +75,7 @@ #ifdef _WIN32 #include #include -#include +#include #include #else #include diff --git a/src/ffi/sys.inc b/src/ffi/sys.inc index 56ca6738..a83fc87a 100644 --- a/src/ffi/sys.inc +++ b/src/ffi/sys.inc @@ -133,16 +133,16 @@ static pointer dirlist(scheme* Scheme, pointer Args) { #ifdef _WIN32 char* path = string_value(pair_car(Args)); - std::experimental::filesystem::path bpath(path); - if (!std::experimental::filesystem::exists(bpath)) { + std::filesystem::path bpath(path); + if (!std::filesystem::exists(bpath)) { return Scheme->NIL; } - if (!std::experimental::filesystem::is_directory(bpath)) { + if (!std::filesystem::is_directory(bpath)) { return Scheme->NIL; } - std::experimental::filesystem::directory_iterator end_it; + std::filesystem::directory_iterator end_it; pointer list = Scheme->NIL; - for (std::experimental::filesystem::directory_iterator it(bpath); it != end_it; ++it) { + for (std::filesystem::directory_iterator it(bpath); it != end_it; ++it) { EnvInjector injector(Scheme, list); pointer tlist = cons(Scheme, mk_string(Scheme, it->path().string().c_str()), list); list = tlist; From 23668dea3e6ab0f3a5e9fa5b2bcd7873c8764f69 Mon Sep 17 00:00:00 2001 From: soulofmischief <30357883+soulofmischief@users.noreply.github.com> Date: Wed, 17 Dec 2025 12:19:43 -0600 Subject: [PATCH 07/14] Upgrade LLVM to 21.1.7 --- CMakeLists.txt | 91 +++++++++++++++++++++++++++++++------------------- 1 file changed, 57 insertions(+), 34 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 7306fbec..303e7f6f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -216,67 +216,90 @@ ExternalProject_Add(portaudio_static -DCMAKE_CXX_FLAGS=${EXT_DEPS_CXX_FLAGS} -DCMAKE_INSTALL_PREFIX=${CMAKE_BINARY_DIR}/portaudio) -############## -# LLVM 3.8.0 # -############## +############### +# LLVM 21.1.7 # +############### # if you need to build LLVM by hand, the command will be something like -# cmake .. -DLLVM_TARGETS_TO_BUILD=X86 -DCMAKE_BUILD_TYPE=Release -DLLVM_ENABLE_TERMINFO=OFF -DLLVM_ENABLE_ZLIB=OFF -DCMAKE_INSTALL_PREFIX=c:/Users/ben/Code/extempore/llvm-3.8.0-release +# cmake .. -DLLVM_TARGETS_TO_BUILD=X86 -DCMAKE_BUILD_TYPE=Release -DLLVM_ENABLE_TERMINFO=OFF -DLLVM_ENABLE_ZLIB=OFF -DCMAKE_INSTALL_PREFIX=c:/Users/ben/Code/extempore/llvm-21.1.7-release + +# Detect target architecture for LLVM. +if(APPLE) + if(UNAME_MACHINE_NAME STREQUAL "arm64") + set(LLVM_TARGET_ARCH "AArch64") + set(LLVM_ARCH_PREFIX "AArch64") + else() + set(LLVM_TARGET_ARCH "X86") + set(LLVM_ARCH_PREFIX "X86") + endif() +elseif(UNIX) + if(CMAKE_SYSTEM_PROCESSOR MATCHES "aarch64|arm64") + set(LLVM_TARGET_ARCH "AArch64") + set(LLVM_ARCH_PREFIX "AArch64") + else() + set(LLVM_TARGET_ARCH "X86") + set(LLVM_ARCH_PREFIX "X86") + endif() +else() + # Only x86_64 currently supported for Windows. + set(LLVM_TARGET_ARCH "X86") + set(LLVM_ARCH_PREFIX "X86") +endif() + +message(STATUS "LLVM target architecture: ${LLVM_TARGET_ARCH}") + +set(CMAKE_CXX_STANDARD 17) +set(CMAKE_CXX_STANDARD_REQUIRED ON) if(NOT BUILD_LLVM) add_custom_target(LLVM) else() include(ExternalProject) - if(PACKAGE) ExternalProject_Add(LLVM PREFIX llvm - URL https://github.com/digego/extempore/releases/download/v0.8.9/llvm-3.8.0.src-patched-for-extempore.tar.xz - URL_MD5 600ee9a94d2e104f53be739568f3508e + URL https://github.com/llvm/llvm-project/releases/download/llvmorg-21.1.7/llvm-project-21.1.7.src.tar.xz + SOURCE_SUBDIR llvm CMAKE_ARGS - -DLLVM_TARGETS_TO_BUILD=X86 + -DLLVM_TARGETS_TO_BUILD=${LLVM_TARGET_ARCH} -DCMAKE_BUILD_TYPE=${CMAKE_BUILD_TYPE} -DLLVM_ENABLE_TERMINFO=OFF -DLLVM_ENABLE_ZLIB=OFF + -DLLVM_ENABLE_ZSTD=OFF + -DLLVM_ENABLE_LIBXML2=OFF -DLLVM_INCLUDE_TOOLS=ON -DLLVM_BUILD_TOOLS=ON -DLLVM_INCLUDE_UTILS=OFF -DLLVM_BUILD_RUNTIME=OFF -DLLVM_INCLUDE_EXAMPLES=OFF -DLLVM_INCLUDE_TESTS=OFF - -DLLVM_INCLUDE_GO_TESTS=OFF - -DLLVM_INCLUDE_GO_TESTS=OFF + -DLLVM_INCLUDE_BENCHMARKS=OFF -DLLVM_INCLUDE_DOCS=OFF + -DLLVM_ENABLE_BINDINGS=OFF + -DLLVM_ENABLE_OCAMLDOC=OFF -DCMAKE_C_FLAGS=${EXT_DEPS_C_FLAGS} -DCMAKE_CXX_FLAGS=${EXT_DEPS_CXX_FLAGS} -DCMAKE_INSTALL_PREFIX=${EXT_LLVM_DIR}) - else() - ExternalProject_Add(LLVM - PREFIX llvm - URL https://github.com/digego/extempore/releases/download/v0.8.9/llvm-3.8.0.src-patched-for-extempore.tar.xz - URL_MD5 600ee9a94d2e104f53be739568f3508e - CMAKE_ARGS - -DLLVM_TARGETS_TO_BUILD=X86 - -DCMAKE_BUILD_TYPE=${CMAKE_BUILD_TYPE} - -DLLVM_ENABLE_TERMINFO=OFF - -DLLVM_ENABLE_ZLIB=OFF - -DLLVM_INCLUDE_TOOLS=ON - -DLLVM_BUILD_TOOLS=ON - -DLLVM_INCLUDE_UTILS=OFF - -DLLVM_BUILD_RUNTIME=OFF - -DLLVM_INCLUDE_EXAMPLES=OFF - -DLLVM_INCLUDE_TESTS=OFF - -DLLVM_INCLUDE_GO_TESTS=OFF - -DLLVM_INCLUDE_GO_TESTS=OFF - -DLLVM_INCLUDE_DOCS=OFF - -DCMAKE_INSTALL_PREFIX=${EXT_LLVM_DIR}) - endif() ExternalProject_Add_StepTargets(LLVM install) endif() -# the ordering of these libs matters, especially with the gcc linker. -# Check the output of "llvm-config --libnames" to be sure -set(EXT_LLVM_LIBRARIES "LLVMLTO;LLVMObjCARCOpts;LLVMSymbolize;LLVMDebugInfoPDB;LLVMDebugInfoDWARF;LLVMMIRParser;LLVMLibDriver;LLVMOption;LLVMTableGen;LLVMOrcJIT;LLVMPasses;LLVMipo;LLVMVectorize;LLVMLinker;LLVMIRReader;LLVMAsmParser;LLVMX86Disassembler;LLVMX86AsmParser;LLVMX86CodeGen;LLVMSelectionDAG;LLVMAsmPrinter;LLVMX86Desc;LLVMMCDisassembler;LLVMX86Info;LLVMX86AsmPrinter;LLVMX86Utils;LLVMMCJIT;LLVMLineEditor;LLVMDebugInfoCodeView;LLVMInterpreter;LLVMExecutionEngine;LLVMRuntimeDyld;LLVMCodeGen;LLVMTarget;LLVMScalarOpts;LLVMInstCombine;LLVMInstrumentation;LLVMProfileData;LLVMObject;LLVMMCParser;LLVMTransformUtils;LLVMMC;LLVMBitWriter;LLVMBitReader;LLVMAnalysis;LLVMCore;LLVMSupport") +# Architecture-independent libraries (order matters for linker!) +set(EXT_LLVM_LIBRARIES_COMMON + "LLVMWindowsManifest;LLVMXRay;LLVMLibDriver;LLVMDlltoolDriver;LLVMTextAPIBinaryReader;LLVMCoverage;LLVMLineEditor;LLVMSandboxIR;LLVMOrcDebugging;LLVMOrcJIT;LLVMWindowsDriver;LLVMMCJIT;LLVMJITLink;LLVMInterpreter;LLVMExecutionEngine;LLVMRuntimeDyld;LLVMOrcTargetProcess;LLVMOrcShared;LLVMDWP;LLVMDebugInfoLogicalView;LLVMDebugInfoGSYM;LLVMOption;LLVMObjectYAML;LLVMObjCopy;LLVMMCA;LLVMMCDisassembler;LLVMLTO;LLVMCFGuard;LLVMCFIVerify;LLVMFrontendOpenACC;LLVMFrontendHLSL;LLVMFrontendDriver;LLVMFrontendDirective;LLVMExtensions;LLVMPasses;LLVMHipStdPar;LLVMCoroutines;LLVMipo;LLVMInstrumentation;LLVMVectorize;LLVMLinker;LLVMFrontendOpenMP;LLVMFrontendOffloading;LLVMDWARFLinkerParallel;LLVMDWARFLinkerClassic;LLVMDWARFLinker;LLVMDWARFCFIChecker;LLVMGlobalISel;LLVMMIRParser;LLVMAsmPrinter;LLVMSelectionDAG;LLVMCodeGen;LLVMCGData;LLVMTarget;LLVMObjCARCOpts;LLVMCodeGenTypes;LLVMIRPrinter;LLVMInterfaceStub;LLVMFileCheck;LLVMFuzzMutate;LLVMFuzzerCLI;LLVMScalarOpts;LLVMInstCombine;LLVMAggressiveInstCombine;LLVMTransformUtils;LLVMBitWriter;LLVMAnalysis;LLVMProfileData;LLVMDebuginfod;LLVMSymbolize;LLVMDebugInfoBTF;LLVMDebugInfoPDB;LLVMDebugInfoMSF;LLVMDebugInfoDWARF;LLVMDebugInfoDWARFLowLevel;LLVMObject;LLVMTextAPI;LLVMMCParser;LLVMIRReader;LLVMAsmParser;LLVMMC;LLVMDebugInfoCodeView;LLVMBitReader;LLVMFrontendAtomic;LLVMCore;LLVMRemarks;LLVMBitstreamReader;LLVMBinaryFormat;LLVMTargetParser;LLVMTableGen;LLVMTableGenBasic;LLVMTableGenCommon;LLVMTelemetry;LLVMSupport;LLVMDemangle") + +# Architecture-specific libraries +set(EXT_LLVM_LIBRARIES_X86 "LLVMX86Disassembler;LLVMX86AsmParser;LLVMX86CodeGen;LLVMX86Desc;LLVMX86Info") +set(EXT_LLVM_LIBRARIES_AARCH64 "LLVMAArch64Disassembler;LLVMAArch64AsmParser;LLVMAArch64CodeGen;LLVMAArch64Desc;LLVMAArch64Info;LLVMAArch64Utils") + +# Select the appropriate libraries. +if(LLVM_TARGET_ARCH STREQUAL "AArch64") + set(EXT_LLVM_LIBRARIES_ARCH ${EXT_LLVM_LIBRARIES_AARCH64}) +else() + set(EXT_LLVM_LIBRARIES_ARCH ${EXT_LLVM_LIBRARIES_X86}) +endif() + +# Combine into final list (arch-specific libs need to come before common libs for linker) +set(EXT_LLVM_LIBRARIES "${EXT_LLVM_LIBRARIES_ARCH};${EXT_LLVM_LIBRARIES_COMMON}") foreach(llvm_lib ${EXT_LLVM_LIBRARIES}) get_filename_component(LLVM_LIB_FULLPATH "${EXT_LLVM_DIR}/lib/${CMAKE_STATIC_LIBRARY_PREFIX}${llvm_lib}${CMAKE_STATIC_LIBRARY_SUFFIX}" ABSOLUTE) list(APPEND LLVM_LIBRARIES ${LLVM_LIB_FULLPATH}) From 84ab3c61e920e45d59a48ba656a538f86ef5790f Mon Sep 17 00:00:00 2001 From: soulofmischief <30357883+soulofmischief@users.noreply.github.com> Date: Wed, 17 Dec 2025 14:38:07 -0600 Subject: [PATCH 08/14] Shim __hash_memory when building on macOS Build fails otherwise due to XCode toolchain differences --- CMakeLists.txt | 2 ++ src/shims/__hash_memory.cpp | 57 +++++++++++++++++++++++++++++++++++++ 2 files changed, 59 insertions(+) create mode 100644 src/shims/__hash_memory.cpp diff --git a/CMakeLists.txt b/CMakeLists.txt index 303e7f6f..e8b2d2b0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -333,6 +333,7 @@ if (EXT_DYLIB) src/EXTLLVM.cpp src/EXTThread.cpp src/Extempore.cpp + src/shims/__hash_memory.cpp src/OSC.cpp src/Scheme.cpp src/SchemeFFI.cpp @@ -350,6 +351,7 @@ else() src/EXTLLVM.cpp src/EXTThread.cpp src/Extempore.cpp + src/shims/__hash_memory.cpp src/OSC.cpp src/Scheme.cpp src/SchemeFFI.cpp diff --git a/src/shims/__hash_memory.cpp b/src/shims/__hash_memory.cpp new file mode 100644 index 00000000..daa51519 --- /dev/null +++ b/src/shims/__hash_memory.cpp @@ -0,0 +1,57 @@ +// hash_compat.cpp - Compatibility shim for libc++ ABI differences +// +// When LLVM is built with a different version of libc++ than the host compiler, +// the __hash_memory symbol may not be found. This provides the implementation. + +#include +#include + +// Only needed on Apple platforms where libc++ ABI version can differ +#if defined(__APPLE__) + +namespace std { +inline namespace __1 { + +// MurmurHash2 implementation matching libc++'s __hash_memory +// Marked weak so a libc++ that already exports this symbol wins. +__attribute__((visibility("default"), weak)) +size_t __hash_memory(const void* ptr, size_t len) noexcept { + static_assert(__SIZE_WIDTH__ == 64, "__hash_memory only needed on 64-bit macOS"); + const size_t m = 0xc6a4a7935bd1e995ULL; + const int r = 47; + size_t h = len * m; + const unsigned char* data = static_cast(ptr); + const unsigned char* end = data + (len & ~7ULL); + + while (data != end) { + size_t k; + __builtin_memcpy(&k, data, sizeof(k)); + k *= m; + k ^= k >> r; + k *= m; + h ^= k; + h *= m; + data += 8; + } + + switch (len & 7) { + case 7: h ^= static_cast(data[6]) << 48; [[fallthrough]]; + case 6: h ^= static_cast(data[5]) << 40; [[fallthrough]]; + case 5: h ^= static_cast(data[4]) << 32; [[fallthrough]]; + case 4: h ^= static_cast(data[3]) << 24; [[fallthrough]]; + case 3: h ^= static_cast(data[2]) << 16; [[fallthrough]]; + case 2: h ^= static_cast(data[1]) << 8; [[fallthrough]]; + case 1: h ^= static_cast(data[0]); + h *= m; + } + + h ^= h >> r; + h *= m; + h ^= h >> r; + return h; +} + +} // namespace __1 +} // namespace std + +#endif // __APPLE__ From dca1504c0b41bb734e3939169e3d9d86bedb10bd Mon Sep 17 00:00:00 2001 From: soulofmischief <30357883+soulofmischief@users.noreply.github.com> Date: Thu, 18 Dec 2025 18:15:33 -0600 Subject: [PATCH 09/14] Migrate to LLVM 21 and ARM 64 --- include/EXTClosureAddressTable.h | 3 + include/EXTLLVM.h | 31 +- include/EXTZones.h | 10 + libs/base/base.xtm | 38 ++- libs/core/xthread.xtm | 2 + libs/external/glfw3.xtm | 38 +-- runtime/bitcode.ll | 168 ++++++++++- runtime/init.ll | 2 +- runtime/inline.ll | 10 + runtime/llvmir.xtm | 25 +- runtime/llvmti.xtm | 145 ++++++--- src/AudioDevice.cpp | 13 +- src/EXTLLVM.cpp | 500 +++++++++++++++++++------------ src/SchemeFFI.cpp | 483 ++++++++++++++++++++++++----- src/ffi/llvm.inc | 381 ++++++++++++++++------- 15 files changed, 1349 insertions(+), 500 deletions(-) diff --git a/include/EXTClosureAddressTable.h b/include/EXTClosureAddressTable.h index 662193e1..27aa9d52 100644 --- a/include/EXTClosureAddressTable.h +++ b/include/EXTClosureAddressTable.h @@ -4,6 +4,8 @@ #include +struct llvm_zone_t; + namespace extemp { namespace ClosureAddressTable { /////////////////////////////////////////////////////////////////////// @@ -19,6 +21,7 @@ namespace ClosureAddressTable { }; EXPORT closure_address_table* get_address_table(const char *name, extemp::ClosureAddressTable::closure_address_table *table); + EXPORT closure_address_table* add_address_table(llvm_zone_t* zone, char* name, uint32_t offset, char* type, int alloctype, closure_address_table* table); EXPORT uint32_t get_address_offset(uint64_t id, closure_address_table* table); EXPORT bool check_address_exists(uint64_t id, closure_address_table* table); diff --git a/include/EXTLLVM.h b/include/EXTLLVM.h index 2cc2736c..4773a1d5 100644 --- a/include/EXTLLVM.h +++ b/include/EXTLLVM.h @@ -45,6 +45,9 @@ #include #include +#include "llvm/ExecutionEngine/Orc/ThreadSafeModule.h" +#include "llvm/Support/Error.h" + struct _llvm_callback_struct_ { void(*fptr)(void*,llvm_zone_t*); @@ -94,15 +97,11 @@ class GlobalVariable; class GlobalValue; class Function; class StructType; -class ModuleProvider; -class SectionMemoryManager; -class ExecutionEngine; - -namespace legacy -{ - -class PassManager; +class LLVMContext; +namespace orc { +class LLJIT; +class ThreadSafeContext; } } // end llvm namespace @@ -113,16 +112,22 @@ namespace extemp namespace EXTLLVM { -uint64_t getSymbolAddress(const std::string&); +uint64_t getFunctionAddress(const std::string&); void addModule(llvm::Module* m); -extern llvm::ExecutionEngine* EE; // TODO: nobody should need this (?) -extern llvm::Module* M; +extern std::unique_ptr JIT; + +extern std::unique_ptr TSC; + +llvm::orc::ThreadSafeContext& getThreadSafeContext(); +bool removeSymbol(const std::string& name); +void removeFromGlobalMap(const std::string& name); + +llvm::Error addTrackedModule(llvm::orc::ThreadSafeModule TSM, const std::vector& symbolNames); + extern int64_t LLVM_COUNT; extern bool OPTIMIZE_COMPILES; extern bool VERIFY_COMPILES; -extern llvm::legacy::PassManager* PM; -extern llvm::legacy::PassManager* PM_NO; extern std::vector Ms; void initLLVM(); diff --git a/include/EXTZones.h b/include/EXTZones.h index ae262f89..563a8fa1 100644 --- a/include/EXTZones.h +++ b/include/EXTZones.h @@ -41,11 +41,21 @@ namespace EXTZones { EXPORT void llvm_zone_destroy(llvm_zone_t* Zone); llvm_zone_t* llvm_zone_reset(llvm_zone_t* Zone); EXPORT void* llvm_zone_malloc(llvm_zone_t* zone, uint64_t size); + EXPORT void* llvm_zone_malloc_from_current_zone(uint64_t size); + EXPORT void llvm_zone_print(llvm_zone_t* zone); + EXPORT uint64_t llvm_zone_ptr_size(void* ptr); + EXPORT bool llvm_zone_copy_ptr(void* ptr1, void* ptr2); + EXPORT bool llvm_ptr_in_zone(llvm_zone_t* zone, void* ptr); + EXPORT bool llvm_ptr_in_current_zone(void* ptr); llvm_zone_stack* llvm_threads_get_zone_stack(); void llvm_threads_set_zone_stack(llvm_zone_stack* Stack); void llvm_push_zone_stack(llvm_zone_t* Zone); llvm_zone_t* llvm_peek_zone_stack(); EXPORT llvm_zone_t* llvm_pop_zone_stack(); + EXPORT llvm_zone_t* llvm_peek_zone_stack_extern(); + EXPORT void llvm_push_zone_stack_extern(llvm_zone_t* Zone); + EXPORT llvm_zone_t* llvm_zone_create_extern(uint64_t Size); + EXPORT llvm_zone_t* llvm_zone_callback_setup(); void llvm_threads_inc_zone_stacksize(); void llvm_threads_dec_zone_stacksize(); uint64_t llvm_threads_get_zone_stacksize(); diff --git a/libs/base/base.xtm b/libs/base/base.xtm index 6c4b404f..6a38a437 100644 --- a/libs/base/base.xtm +++ b/libs/base/base.xtm @@ -346,20 +346,30 @@ (if (null? type) (if (and (impc:ti:polyfunc-exists? closure-name) (= (length (impc:ti:get-polyfunc-candidate-types closure-name)) 1)) - (let* ((t (impc:ir:pretty-print-type (car (impc:ti:get-polyfunc-candidate-types closure-name)))) - (bt (impc:ir:get-base-type t)) - (fullname (string-append closure-name - "_adhoc_" - (cname-encode bt) - "_native"))) - fullname) - (impc:compiler:print-compiler-error "Try forcing a type? Ambiguous call to get_native_fptr" (string->symbol closure-name))) - (let* ((bt (impc:ir:get-base-type (symbol->string (car type)))) - (fullname (string-append closure-name - "_adhoc_" - (cname-encode bt) - "_native"))) - fullname))))) + ;; It's a polyfunc, so look up actual name from adhoc-name-cache. + (let* ((target-type (car (impc:ti:get-polyfunc-candidate-types closure-name))) + (cache-key (cons closure-name target-type)) + (cached (assoc cache-key *impc:ti:adhoc-name-cache*))) + (if cached + (string-append (cdr cached) "_native") + ;; Cache miss, so construct the traditional name for AOT-loaded functions. + (let* ((t (impc:ir:pretty-print-type target-type)) + (bt (impc:ir:get-base-type t))) + (string-append closure-name "_adhoc_" (cname-encode bt) "_native")))) + ;; Not a polyfunc, so must be a regular closure, just append _native. + (if (impc:ti:closure-exists? closure-name) + (string-append closure-name "_native") + (impc:compiler:print-compiler-error "Try forcing a type? Ambiguous call to get_native_fptr" (string->symbol closure-name)))) + ;; When type is provided, look up the cached name. + (let* ((target-type (impc:ir:get-type-from-pretty-str (symbol->string (car type)))) + (cache-key (cons closure-name target-type)) + (cached (assoc cache-key *impc:ti:adhoc-name-cache*))) + (if cached + (string-append (cdr cached) "_native") + ;; Cache miss, so construct the traditional name for AOT-loaded functions. + (let* ((t (impc:ir:pretty-print-type target-type)) + (bt (impc:ir:get-base-type t))) + (string-append closure-name "_adhoc_" (cname-encode bt) "_native")))))))) ;; the same functionality, but for use in xtlang code (bind-macro diff --git a/libs/core/xthread.xtm b/libs/core/xthread.xtm index 981be03c..8dc35b07 100644 --- a/libs/core/xthread.xtm +++ b/libs/core/xthread.xtm @@ -25,7 +25,9 @@ (let ((t:<[void]*,mzone*>* (cast arg)) (f (tref t 0)) (z (tref t 1))) + (push_zone z) (f) + (pop_zone) (llvm_zone_destroy z) (cast null i8*)))) diff --git a/libs/external/glfw3.xtm b/libs/external/glfw3.xtm index e5955729..b36abddb 100644 --- a/libs/external/glfw3.xtm +++ b/libs/external/glfw3.xtm @@ -318,7 +318,7 @@ @param minor - index 1 @param rev - index 2") (bind-lib libglfw glfwGetVersionString [i8*]*) -(bind-lib libglfw glfwSetErrorCallback [GLFWerrorfun,GLFWerrorfun]* +(bind-lib libglfw glfwSetErrorCallback [i8*,i8*]* "@param cbfun - index 0") (bind-lib libglfw glfwGetMonitors [GLFWmonitor**,i32*]* "@param count - index 0") @@ -333,7 +333,7 @@ @param heightMM - index 2") (bind-lib libglfw glfwGetMonitorName [i8*,GLFWmonitor*]* "@param monitor - index 0") -(bind-lib libglfw glfwSetMonitorCallback [GLFWmonitorfun,GLFWmonitorfun]* +(bind-lib libglfw glfwSetMonitorCallback [i8*,i8*]* "@param cbfun - index 0") (bind-lib libglfw glfwGetVideoModes [GLFWvidmode*,GLFWmonitor*,i32*]* "@param monitor - index 0 @@ -438,25 +438,25 @@ @param pointer - index 1") (bind-lib libglfw glfwGetWindowUserPointer [void,GLFWwindow*]* "@param window - index 0") -(bind-lib libglfw glfwSetWindowPosCallback [GLFWwindowposfun,GLFWwindow*,GLFWwindowposfun]* +(bind-lib libglfw glfwSetWindowPosCallback [i8*,GLFWwindow*,i8*]* "@param window - index 0 @param cbfun - index 1") -(bind-lib libglfw glfwSetWindowSizeCallback [GLFWwindowsizefun,GLFWwindow*,GLFWwindowsizefun]* +(bind-lib libglfw glfwSetWindowSizeCallback [i8*,GLFWwindow*,i8*]* "@param window - index 0 @param cbfun - index 1") -(bind-lib libglfw glfwSetWindowCloseCallback [GLFWwindowclosefun,GLFWwindow*,GLFWwindowclosefun]* +(bind-lib libglfw glfwSetWindowCloseCallback [i8*,GLFWwindow*,i8*]* "@param window - index 0 @param cbfun - index 1") -(bind-lib libglfw glfwSetWindowRefreshCallback [GLFWwindowrefreshfun,GLFWwindow*,GLFWwindowrefreshfun]* +(bind-lib libglfw glfwSetWindowRefreshCallback [i8*,GLFWwindow*,i8*]* "@param window - index 0 @param cbfun - index 1") -(bind-lib libglfw glfwSetWindowFocusCallback [GLFWwindowfocusfun,GLFWwindow*,GLFWwindowfocusfun]* +(bind-lib libglfw glfwSetWindowFocusCallback [i8*,GLFWwindow*,i8*]* "@param window - index 0 @param cbfun - index 1") -(bind-lib libglfw glfwSetWindowIconifyCallback [GLFWwindowiconifyfun,GLFWwindow*,GLFWwindowiconifyfun]* +(bind-lib libglfw glfwSetWindowIconifyCallback [i8*,GLFWwindow*,i8*]* "@param window - index 0 @param cbfun - index 1") -(bind-lib libglfw glfwSetFramebufferSizeCallback [GLFWframebuffersizefun,GLFWwindow*,GLFWframebuffersizefun]* +(bind-lib libglfw glfwSetFramebufferSizeCallback [i8*,GLFWwindow*,i8*]* "@param window - index 0 @param cbfun - index 1") (bind-lib libglfw glfwPollEvents [void]*) @@ -499,28 +499,28 @@ (bind-lib libglfw glfwSetCursor [void,GLFWwindow*,GLFWcursor*]* "@param window - index 0 @param cursor - index 1") -(bind-lib libglfw glfwSetKeyCallback [GLFWkeyfun,GLFWwindow*,GLFWkeyfun]* +(bind-lib libglfw glfwSetKeyCallback [i8*,GLFWwindow*,i8*]* "@param window - index 0 @param cbfun - index 1") -(bind-lib libglfw glfwSetCharCallback [GLFWcharfun,GLFWwindow*,GLFWcharfun]* +(bind-lib libglfw glfwSetCharCallback [i8*,GLFWwindow*,i8*]* "@param window - index 0 @param cbfun - index 1") -(bind-lib libglfw glfwSetCharModsCallback [GLFWcharmodsfun,GLFWwindow*,GLFWcharmodsfun]* +(bind-lib libglfw glfwSetCharModsCallback [i8*,GLFWwindow*,i8*]* "@param window - index 0 @param cbfun - index 1") -(bind-lib libglfw glfwSetMouseButtonCallback [GLFWmousebuttonfun,GLFWwindow*,GLFWmousebuttonfun]* +(bind-lib libglfw glfwSetMouseButtonCallback [i8*,GLFWwindow*,i8*]* "@param window - index 0 @param cbfun - index 1") -(bind-lib libglfw glfwSetCursorPosCallback [GLFWcursorposfun,GLFWwindow*,GLFWcursorposfun]* +(bind-lib libglfw glfwSetCursorPosCallback [i8*,GLFWwindow*,i8*]* "@param window - index 0 @param cbfun - index 1") -(bind-lib libglfw glfwSetCursorEnterCallback [GLFWcursorenterfun,GLFWwindow*,GLFWcursorenterfun]* +(bind-lib libglfw glfwSetCursorEnterCallback [i8*,GLFWwindow*,i8*]* "@param window - index 0 @param cbfun - index 1") -(bind-lib libglfw glfwSetScrollCallback [GLFWscrollfun,GLFWwindow*,GLFWscrollfun]* +(bind-lib libglfw glfwSetScrollCallback [i8*,GLFWwindow*,i8*]* "@param window - index 0 @param cbfun - index 1") -(bind-lib libglfw glfwSetDropCallback [GLFWdropfun,GLFWwindow*,GLFWdropfun]* +(bind-lib libglfw glfwSetDropCallback [i8*,GLFWwindow*,i8*]* "@param window - index 0 @param cbfun - index 1") (bind-lib libglfw glfwJoystickPresent [i32,i32]* @@ -533,7 +533,7 @@ @param count - index 1") (bind-lib libglfw glfwGetJoystickName [i8*,i32]* "@param joy - index 0") -(bind-lib libglfw glfwSetJoystickCallback [GLFWjoystickfun,GLFWjoystickfun]* +(bind-lib libglfw glfwSetJoystickCallback [i8*,i8*]* "@param cbfun - index 0") (bind-lib libglfw glfwSetClipboardString [void,GLFWwindow*,i8*]* "@param window - index 0 @@ -574,7 +574,7 @@ (let ((res (glfwInit))) (if (= res 1) (begin - (glfwSetErrorCallback (convert (get_native_fptr glfw_error_callback))) + (glfwSetErrorCallback (cast (get_native_fptr glfw_error_callback) i8*)) res) res)))) diff --git a/runtime/bitcode.ll b/runtime/bitcode.ll index 769308da..711ba90f 100644 --- a/runtime/bitcode.ll +++ b/runtime/bitcode.ll @@ -1,3 +1,153 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; TYPE DEFINITIONS + +; Zone and closure variable table types +%mzone = type {i8*, i64, i64, i64, i8*, %mzone*} +%clsvar = type {i8*, i32, i8*, %clsvar*} + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; EXTERNAL RUNTIME FUNCTION DECLARATIONS + +; Closure address table functions (implemented in C++) +declare %clsvar* @add_address_table(%mzone*, i8*, i32, i8*, i32, %clsvar*) nounwind +declare %clsvar* @get_address_table(i8*, %clsvar*) nounwind +declare i32 @get_address_offset(i64, %clsvar*) nounwind +declare i1 @check_address_type(i64, %clsvar*, i8*) nounwind +declare i1 @check_address_exists(i64, %clsvar*) nounwind + +; Zone memory management functions (implemented in C++) +declare %mzone* @llvm_zone_callback_setup() nounwind +declare %mzone* @llvm_pop_zone_stack() nounwind +declare void @llvm_zone_destroy(%mzone*) nounwind +declare void @llvm_zone_print(%mzone*) nounwind +declare i8* @llvm_zone_malloc(%mzone*, i64) nounwind +declare i8* @llvm_zone_malloc_from_current_zone(i64) nounwind +declare i1 @llvm_ptr_in_zone(%mzone*, i8*) nounwind +declare i1 @llvm_zone_copy_ptr(i8*, i8*) nounwind +declare i64 @llvm_zone_ptr_size(i8*) nounwind +declare i1 @llvm_ptr_in_current_zone(i8*) nounwind +declare void @llvm_destroy_zone_after_delay(%mzone*, i64) + +; Scheme value constructor functions (implemented in C++) +declare i8* @mk_i64(i8*, i64) +declare i8* @mk_i32(i8*, i32) +declare i8* @mk_i16(i8*, i16) +declare i8* @mk_i8(i8*, i8) +declare i8* @mk_i1(i8*, i1) +declare i8* @mk_double(i8*, double) +declare i8* @mk_float(i8*, float) +declare i8* @mk_string(i8*, i8*) +declare i8* @mk_cptr(i8*, i8*) + +; Scheme value accessor functions (implemented in C++) +declare i64 @i64value(i8*) +declare i32 @i32value(i8*) +declare i16 @i16value(i8*) +declare i8 @i8value(i8*) +declare i1 @i1value(i8*) +declare double @r64value(i8*) +declare float @r32value(i8*) +declare i8* @string_value(i8*) +declare i8* @cptr_value(i8*) + +; Encoding/decoding utility functions (implemented in C++) +declare i8* @base64_encode(i8*, i64, i64*) nounwind +declare i8* @base64_decode(i8*, i64, i64*) nounwind +declare i8* @cname_encode(i8*, i64, i64*) nounwind +declare i8* @cname_decode(i8*, i64, i64*) nounwind + +; Standard C library math functions +declare i64 @llabs(i64) nounwind +declare float @sinhf(float) nounwind +declare float @tanf(float) nounwind +declare float @tanhf(float) nounwind + +; Standard C library file I/O functions +declare i32 @remove(i8*) nounwind + +declare i8* @list_ref(i8*, i32, i8*) + +; System functions +declare i8* @sys_sharedir() nounwind +declare i8* @sys_slurp_file(i8*) nounwind + +; Standard C library functions +declare i8* @malloc(i64) nounwind +declare i8* @realloc(i8*, i64) nounwind +declare void @free(i8*) nounwind +declare i8* @memset(i8*, i32, i64) nounwind +declare i8* @memcpy(i8*, i8*, i64) nounwind +declare i32 @memcmp(i8*, i8*, i64) nounwind +declare i32 @putchar(i32) nounwind +declare i64 @strlen(i8*) nounwind +declare i8* @strcpy(i8*, i8*) nounwind +declare i8* @strncpy(i8*, i8*, i64) nounwind +declare i8* @strcat(i8*, i8*) nounwind +declare i8* @strncat(i8*, i8*, i64) nounwind +declare i32 @strcmp(i8*, i8*) nounwind +declare i32 @strncmp(i8*, i8*, i64) nounwind +declare i8* @strchr(i8*, i32) nounwind +declare i8* @strstr(i8*, i8*) nounwind + +; Extempore runtime functions (implemented in C++) +declare i1 @rmatch(i8*, i8*) nounwind +declare i64 @rmatches(i8*, i8*, i8**, i64) nounwind +declare i8** @rsplit(i8*, i8*, i8**, i64) nounwind +declare i8* @rreplace(i8*, i8*, i8*) nounwind + +; Random number generators (implemented in C++) +declare double @imp_randd() nounwind +declare float @imp_randf() nounwind +declare i64 @imp_rand1_i64(i64) nounwind +declare i64 @imp_rand2_i64(i64, i64) nounwind +declare i32 @imp_rand1_i32(i32) nounwind +declare i32 @imp_rand2_i32(i32, i32) nounwind +declare double @imp_rand1_d(double) nounwind +declare double @imp_rand2_d(double, double) nounwind +declare float @imp_rand1_f(float) nounwind +declare float @imp_rand2_f(float, float) nounwind + +; Standard math library functions +declare double @atan2(double, double) nounwind +declare float @atan2f(float, float) nounwind + +; Additional Extempore runtime functions (implemented in C++) +; Note: Many zone/inline functions are defined in inline.ll or later in this file +declare i8* @llvm_get_function_ptr(i8*) nounwind +declare void @llvm_runtime_error(i64, i8*) nounwind +declare void @llvm_print_pointer(i8*) nounwind +declare void @llvm_print_i32(i32) nounwind +declare void @llvm_print_i64(i64) nounwind +declare void @llvm_print_f32(float) nounwind +declare void @llvm_print_f64(double) nounwind +declare i8* @extitoa(i64) nounwind +declare i64 @string_hash(i8*) nounwind +declare void @llvm_schedule_callback(i64, i8*) nounwind +declare void @llvm_send_udp(i8*, i32, i8*, i32) nounwind +declare i64 @next_prime(i64) nounwind +declare void @free_after_delay(i8*, double) nounwind +declare i8* @llvm_disassemble(i8*, i32) nounwind + +; Thread functions +declare i8* @thread_fork(i8*, i8*) nounwind +declare void @thread_destroy(i8*) nounwind +declare i32 @thread_join(i8*) nounwind +declare i32 @thread_kill(i8*) nounwind +declare i8* @thread_self() nounwind +declare i32 @thread_equal_self(i8*) nounwind +declare i32 @thread_equal(i8*, i8*) nounwind +declare i64 @thread_sleep(i64, i64) nounwind +declare i8* @mutex_create() nounwind +declare i32 @mutex_destroy(i8*) nounwind +declare i32 @mutex_lock(i8*) nounwind +declare i32 @mutex_unlock(i8*) nounwind +declare i32 @mutex_trylock(i8*) nounwind + +; Clock functions +declare double @clock_clock() nounwind +declare double @audio_clock_base() nounwind +declare double @audio_clock_now() nounwind + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; SCHEME STUFF @@ -484,15 +634,17 @@ define private i8* @i16toptr(i16 %a) alwaysinline ret i8* %return } +; Portable 80-bit extended precision to double conversion +; Works on both x86_64 and ARM64 by manually parsing IEEE 754 extended format +; The 80-bit format is: 1 sign bit, 15 exponent bits, 64 mantissa bits (explicit integer bit) +; Input is big-endian (as used in AIFF files) +declare double @fp80_to_double_portable(i8*) nounwind + define private double @fp80ptrtod(i8* %fp80ptr) { - %1 = alloca i8*, align 8 - store i8* %fp80ptr, i8** %1, align 8 - %2 = load i8*, i8** %1, align 8 - %3 = bitcast i8* %2 to x86_fp80* - %4 = load x86_fp80, x86_fp80* %3, align 16 - %5 = fptrunc x86_fp80 %4 to double - ret double %5 +entry: + %result = call double @fp80_to_double_portable(i8* %fp80ptr) + ret double %result } declare i32 @printf(i8* noalias nocapture, ...) @@ -559,4 +711,4 @@ define private void @ascii_text_color(i32 %bold, i32 %fg, i32 %bg) nounwind alwa { call void @ascii_text_color_extern(i32 %bold, i32 %fg, i32 %bg) ret void -} \ No newline at end of file +} diff --git a/runtime/init.ll b/runtime/init.ll index 2941d21e..73f7d4a7 100644 --- a/runtime/init.ll +++ b/runtime/init.ll @@ -557,7 +557,7 @@ entry: declare i8* @memset(i8* %dest, i32 %val, i64 %len) -declare void @llvm.memcpy.p0i8.p0i8.i64(i8*, i8*, i64, i32, i1) +declare void @llvm.memcpy.p0.p0.i64(ptr, ptr, i64, i1) declare %mzone* @llvm_zone_callback_setup() nounwind declare %mzone* @llvm_pop_zone_stack() nounwind diff --git a/runtime/inline.ll b/runtime/inline.ll index 1257996c..3b121805 100644 --- a/runtime/inline.ll +++ b/runtime/inline.ll @@ -1,3 +1,7 @@ +; Type definitions required for LLVM 21+ (types must be sized before GEP) +%mzone = type {i8*, i64, i64, i64, i8*, %mzone*} +%clsvar = type {i8*, i32, i8*, %clsvar*} + define private %clsvar* @new_address_table() nounwind alwaysinline { ret %clsvar* null @@ -56,3 +60,9 @@ define private i32 @is_integer(i8* %ptr) nounwind alwaysinline %res = call i32 @is_integer_extern(i8* %ptr) ret i32 %res } + +; Main callback for XTLang code (defined in Extempore.cpp) +declare void @xtm_set_main_callback(i8*) + +; Window event registration (defined in UNIV.cpp) +declare i32 @register_for_window_events() diff --git a/runtime/llvmir.xtm b/runtime/llvmir.xtm index 63fa22b7..176ce1c9 100644 --- a/runtime/llvmir.xtm +++ b/runtime/llvmir.xtm @@ -55,10 +55,15 @@ (if *impc:compiler:print-raw-llvm* (print-full-nq *impc:compiler:queued-llvm-ir-string*)) (if (not (string=? *impc:compiler:queued-llvm-ir-string* "")) - (let ((res (llvm:jit-compile-ir-string *impc:compiler:queued-llvm-ir-string*))) + (let* ((ir-to-compile *impc:compiler:queued-llvm-ir-string*) + (res (llvm:jit-compile-ir-string ir-to-compile))) (impc:compiler:reset-jit-compilation-queue) - ;; (print "Flushed IR compilation queue with result: " res "\n") - res)))) + ;; (if (not res) + ;; (begin + ;; (print "FLUSH FAILED. IR was:\n") + ;; (print-full-nq ir-to-compile))) + res) + #t))) ;; JIT-compile the IR string, or queue it for AOT-compilation (define llvm:compile-ir @@ -1681,16 +1686,16 @@ ;; (println 'symstr: symstr 'symtype: symtype) ;; (println 'typestr: typestr) (if (and (number? (cadr p)) ;; if numeric constant force to type of symbol - (impc:ir:number? (cdr (assoc-strcmp (caar p) types))) + (impc:ir:number? symtype) (impc:ir:number? (impc:ir:get-type-from-str typestr))) - (set! typestr (impc:ir:get-type-str (cdr (assoc-strcmp (caar p) types))))) + (set! typestr (impc:ir:get-type-str symtype))) ;; type check - ;; (println 'tt1: (impc:ir:get-type-from-str typestr) 'tt2: (cdr (assoc-strcmp (caar p) types))) + ;; (println 'tt1: (impc:ir:get-type-from-str typestr) 'tt2: symtype) (if (not (equal? (impc:ir:get-type-from-str typestr) ;; check to see if the two types are equal? - (cdr (assoc-strcmp (caar p) types)))) + symtype)) (impc:compiler:print-type-mismatch-error (impc:ir:pretty-print-type typestr) - (impc:ir:pretty-print-type (cdr (assoc-strcmp (caar p) types))) + (impc:ir:pretty-print-type symtype) (caar p))) ;(println 'value: value 'typestr: typestr) ;'cadrp (cadr p)) ;(emit (impc:ir:gname "zone" "%mzone*") " = call %mzone* @llvm_peek_zone_stack()\n" os) @@ -4122,13 +4127,13 @@ (define impc:ir:intrinsic-substitution (lambda (name) (cond - ((string=? name "memcpy") "llvm.memcpy.p0i8.p0i8.i64") + ((string=? name "memcpy") "llvm.memcpy.p0.p0.i64") (else name)))) (define impc:ir:function-fixup-args (lambda (name) (cond - ((string=? name "memcpy") ", i32 1, i1 0") + ((string=? name "memcpy") ", i1 0") (else "")))) (define impc:ir:compiler:native-call diff --git a/runtime/llvmti.xtm b/runtime/llvmti.xtm index 222822fe..9eb7f5ce 100644 --- a/runtime/llvmti.xtm +++ b/runtime/llvmti.xtm @@ -1122,6 +1122,9 @@ ;; -------- ;; (define *impc:ti:closure-cache* '()) + +;; Map from (polyfunc-name . type) to adhoc name with counter. +(define *impc:ti:adhoc-name-cache* '()) ;; ;; each element of the list is of the form ;; @@ -2666,6 +2669,7 @@ (define *impc:aot:current-output-port* #f) (define *impc:aot:current-lib-name* "xtmdylib") +(define *impc:aot:owning-lib-name* "xtmdylib") (define *impc:aot:win-link-libraries* '(".\\libs\\platform-shlibs\\extempore.lib")) (define *impc:aot:win-link-libraries-exe* '(".\\libs\\platform-shlibs\\extempore.lib")) (define *impc:aot:unix-link-libraries* '("-lextempore -lm")) @@ -2765,7 +2769,9 @@ (define impc:aot:insert-static-binding-details (lambda (name type) - (if (output-port? *impc:aot:current-output-port*) + ;; Only emit binding details if we're compiling the owning library. + (if (and (output-port? *impc:aot:current-output-port*) + (equal? *impc:aot:owning-lib-name* *impc:aot:current-lib-name*)) (begin (write (list 'bind-lib (string->symbol *impc:aot:current-lib-name*) name type) *impc:aot:current-output-port*) @@ -3090,7 +3096,9 @@ (define impc:aot:insert-header (lambda (libname) - (if (output-port? *impc:aot:current-output-port*) + (set! *impc:aot:owning-lib-name* libname) + (if (and (output-port? *impc:aot:current-output-port*) + (equal? libname *impc:aot:current-lib-name*)) (begin (display (string-append "(sys:load-preload-check '" (substring libname 3) ")\n") *impc:aot:current-output-port*) @@ -3125,7 +3133,8 @@ (define impc:aot:import-ll (lambda (libname) (if (and (output-port? *impc:aot:current-output-port*) - (not *impc:compiler:aot:dll*)) + (not *impc:compiler:aot:dll*) + (equal? libname *impc:aot:current-lib-name*)) (begin (write `(llvm:compile-ir (sys:slurp-file ,(string-append "libs/aot-cache/" libname ".ll"))) *impc:aot:current-output-port*) @@ -3135,7 +3144,8 @@ (define impc:aot:insert-footer (lambda (libname) - (if (output-port? *impc:aot:current-output-port*) + (if (and (output-port? *impc:aot:current-output-port*) + (equal? libname *impc:aot:current-lib-name*)) (begin (display (string-append "(print-with-colors 'green 'default #t (print \"done\"))") *impc:aot:current-output-port*) @@ -5901,6 +5911,12 @@ Continue executing `body' forms until `test-expression' returns #f" (list (impc:ir:pointer-- (impc:ti:get-globalvar-type (symbol->string ast))))) ((impc:ti:nativefunc-exists? (symbol->string ast)) (list (impc:ti:get-nativefunc-type (symbol->string ast)))) + ;; Check for closures before falling through to polyfunc handling. + ;; This prevents closures that are also registered as polyfuncs + ;; from being incorrectly treated as polymorphic references. + ((impc:ti:closure-exists? (symbol->string ast)) + (list (cons (+ *impc:ir:closure* *impc:ir:pointer* *impc:ir:pointer*) + (map impc:ir:get-type-from-str (impc:ti:get-closure-arg-types (symbol->string ast)))))) (else (if (and (symbol? ast) (impc:ti:genericfunc-exists? (string->symbol (impc:ir:get-base-type (symbol->string ast))))) @@ -8377,10 +8393,12 @@ xtlang's `let' syntax is the same as Scheme" ;; (println 'cls 'ref 'check: ast 'request? request?) (if (<> (length ast) 4) (impc:compiler:print-bad-arity-error ast)) - (let* (;; a should be a closure of some kind + (let* (;; a should be a closure or a single-candidate polyfunc. (a (if (and (symbol? (cadr ast)) - (impc:ti:closure-exists? (symbol->string (cadr ast)))) - #t ; // yes (cadr ast) is a globally defined closure + (or (impc:ti:closure-exists? (symbol->string (cadr ast))) + (and (impc:ti:polyfunc-exists? (symbol->string (cadr ast))) + (= 1 (length (impc:ti:get-polyfunc-candidate-names (symbol->string (cadr ast)))))))) + ; #t ; // yes (cadr ast) is a globally defined closure or single-candidate polyfunc. (impc:ti:type-check (cadr ast) vars kts #f))) ;; do NOT check against request! ;; b should be a string (the var's name) (b (impc:ti:type-check (caddr ast) vars kts (impc:ir:pointer++ (list *impc:ir:si8*))))) @@ -8396,10 +8414,12 @@ xtlang's `let' syntax is the same as Scheme" ;; (println 'cls2 'ref 'check: ast 'request? request?) (if (<> (length ast) 3) (impc:compiler:print-bad-arity-error ast)) - (let* (;; a should be a closure of some kind + (let* (;; a should be a closure or a single-candidate polyfunc. (a (if (and (symbol? (cadr ast)) - (impc:ti:closure-exists? (symbol->string (cadr ast)))) - #t ; // yes (cadr ast) is a globally defined closure + (or (impc:ti:closure-exists? (symbol->string (cadr ast))) + (and (impc:ti:polyfunc-exists? (symbol->string (cadr ast))) + (= 1 (length (impc:ti:get-polyfunc-candidate-names (symbol->string (cadr ast)))))))) + #t ; // yes (cadr ast) is a globally defined closure or single-candidate polyfunc. (impc:ti:type-check (cadr ast) vars kts #f))) ;; request?))) ;; b should be a string (the var's name) (b (impc:ti:type-check (caddr ast) vars kts (list *impc:ir:si8*)))) @@ -9136,19 +9156,27 @@ xtlang's `let' syntax is the same as Scheme" (not (string-contains? (symbol->string ast) ":")) (impc:ti:polyfunc-exists? (symbol->string ast))) (let* ((pname (symbol->string ast)) - (ts (impc:ti:get-polyfunc-candidate-types pname))) - (if (= (length ts) 1) - (string->symbol (string-append pname "_adhoc_" (cname-encode (impc:ir:get-base-type (impc:ir:pretty-print-type (car ts)))))) + (names (impc:ti:get-polyfunc-candidate-names pname))) + (if (and names (= (length names) 1)) + ;; Use actual implementation name from cache. + (string->symbol (car names)) (impc:compiler:print-compiler-error "Try forcing a type. Ambiguous polymorphic function" ast)))) ((and (symbol? ast) (string-contains? (symbol->string ast) ":") (impc:ti:polyfunc-exists? (car (regex:type-split (symbol->string ast) ":")))) (let* ((res (regex:type-split (symbol->string ast) ":")) (pname (car res)) - (ptype (if (impc:ti:typealias-exists? (cadr res)) - (impc:ir:get-base-type (impc:ir:pretty-print-type (impc:ti:get-typealias-type (cadr res)))) - (impc:ir:get-base-type (cadr res))))) - (string->symbol (string-append pname "_adhoc_" (cname-encode ptype))))) + (ptype-str (cadr res)) + (ptype (impc:ir:get-type-from-pretty-str + (if (impc:ti:typealias-exists? ptype-str) + (impc:ir:pretty-print-type (impc:ti:get-typealias-type ptype-str)) + ptype-str))) + ;; Look up actual implementation name. + (candidate (impc:ti:get-polyfunc-candidate pname ptype))) + (if candidate + candidate + ;; Fallback to manual construction if not found. + (string->symbol (string-append pname "_adhoc_" (cname-encode (impc:ir:get-base-type ptype-str))))))) ((and (symbol? ast) (string-contains? (symbol->string ast) ":")) (let* ((p (regex:type-split (symbol->string ast) ":")) @@ -9194,12 +9222,11 @@ xtlang's `let' syntax is the same as Scheme" (let* ((nm (regex:split (symbol->string ast) "##")) (n1 (car nm)) (type (cdr (assoc-strcmp ast types))) - (ptype (impc:ir:pretty-print-type type)) - (cn (cname-encode (impc:ir:get-base-type ptype))) - (newn (string-append n1 "_adhoc_" cn))) - (if (not (impc:ti:closure-exists? newn)) - (impc:compiler:print-compiler-error (string-append "Bad type: " ptype " for polymorphic function " (car nm)) ast)) - (string->symbol newn))) + ;; Use polyfunc cache to find the implementation. + (candidate (impc:ti:get-polyfunc-candidate n1 type))) + (if (not candidate) + (impc:compiler:print-compiler-error (string-append "Bad type: " (impc:ir:pretty-print-type type) " for polymorphic function " (car nm)) ast)) + candidate)) ((and (symbol? ast) (string-contains? (symbol->string ast) "##") (assoc-strcmp ast types)) @@ -9976,11 +10003,6 @@ xtlang's `let' syntax is the same as Scheme" (if (not (null? args)) (set! args (replace-all args (list (cons adhoc-poly-name symname))))) (set! code (replace-all code (list (cons adhoc-poly-name symname)))))) - ;; don't want type checking to find existing native versions! - (if (and *impc:compile* (not static)) - (begin - (llvm:erase-function (string-append (symbol->string symname) "_setter")) - (llvm:erase-function (string-append (symbol->string symname) "_maker")))) (let* ((symname-string (symbol->string symname)) (oldsymname-string symname-string) ;(c code) @@ -10060,21 +10082,24 @@ xtlang's `let' syntax is the same as Scheme" (f (cdr lst))))))) (f t5)) - (if (and poly ;;*impc:ti:implicit-adhoc-compiles* - (not (regex:match? adhoc-poly-name-string "(_poly_|_adhoc_)"))) - (let* ((p (assoc-strcmp symname types)) - (n (car p)) - (t (impc:ir:pretty-print-type (cdr p))) + ;; Append type encoding to adhoc name for global uniqueness. + (if (and poly (regex:match? symname-string "_adhoc_[0-9]+$")) + (let* ((p (assoc-strcmp symname types))) + (if p + (let* ((t (impc:ir:pretty-print-type (cdr p))) (base (impc:ir:get-base-type t)) - (depth (impc:ir:get-ptr-depth t)) - (new (string-append adhoc-poly-name-string "_adhoc_" (cname-encode base))) - (tt (assoc-strcmp symname types)) - (t6 (replace-all t5 (list (cons symname (string->symbol new)))))) - (set-car! tt (string->symbol new)) - (set! symname (string->symbol new)) - (set! symname-string new) - (set! newast (impc:ti:add-types-to-source symname t6 (cl:tree-copy types) (list)))) - (set! newast (impc:ti:add-types-to-source symname t5 (cl:tree-copy types) (list)))) + (final-name (string-append symname-string "_" (cname-encode base))) + (final-sym (string->symbol final-name)) + (old-sym symname)) + ;; Update symname in types list. + (set-car! p final-sym) + ;; Replace old name with new name in AST. + (set! t5 (replace-all t5 (list (cons old-sym final-sym)))) + ;; Update symname variable. + (set! symname final-sym) + (set! symname-string final-name))))) + + (set! newast (impc:ti:add-types-to-source symname t5 (cl:tree-copy types) (list))) ;; ;; modify code for static functions @@ -10160,7 +10185,22 @@ xtlang's `let' syntax is the same as Scheme" 0 "[static]")) (let* ((closure-type (cadr (impc:ir:gname))) ;; normal closure (closure-type-- (impc:ir:get-type-str (impc:ir:pointer-- (impc:ir:get-type-from-str closure-type)))) - (compile-stub? (not (impc:ti:closure-exists? symname-string))) + (existing-type (impc:ti:get-closure-type symname-string)) + ;; Compile stubs if first compilation or type has changed. + (compile-stub? (or (not (impc:ti:closure-exists? symname-string)) + (null? existing-type) + (not (equal? (impc:ir:get-type-from-str closure-type) existing-type)))) + ;; Erase old definitions only when recompiling stubs. + (_ (if (and *impc:compile* (not static) compile-stub?) + (begin + (llvm:erase-function symname-string) + (llvm:erase-function (string-append symname-string "_native")) + (llvm:erase-function (string-append symname-string "_setter")) + (llvm:erase-function (string-append symname-string "_maker")) + (llvm:erase-function (string-append symname-string "_getter")) + (llvm:remove-globalvar (string-append symname-string "_var")) + (llvm:remove-globalvar (string-append symname-string "_var_zone"))) + #f)) (maker-ir (string-append "define dllexport ccc " closure-type " @" symname-string "_maker" "(i8* %_impz) nounwind {\nentry:\n" ;; "%_zone = bitcast i8* %_impz to %mzone*\n" @@ -10456,12 +10496,12 @@ xtlang's `let' syntax is the same as Scheme" (if *impc:compiler:print* (println '------------------------------compiling 'maker----------------------------------->)) (if *impc:compiler:print* (print-full-nq maker-ir)) - (if *impc:compile* + (if (and *impc:compile* compile-stub?) (impc:compiler:queue-ir-for-compilation maker-ir)) (if *impc:compiler:print* (println '--------------------------------compiling 'setter----------------------------------->)) (if *impc:compiler:print* (print-full-nq setter-ir)) - (if *impc:compile* + (if (and *impc:compile* compile-stub?) (impc:compiler:queue-ir-for-compilation setter-ir)) (if *impc:compiler:print* (println '--------------------------------compiling 'getter----------------------------------->)) @@ -10503,12 +10543,23 @@ xtlang's `let' syntax is the same as Scheme" (impc:ti:update-closure-name adhoc-poly-name-string symname-string) (impc:ti:set-closure-type symname-string closure-type-list) (impc:ti:set-closure-body symname-string code) + ;; Store mapping for get_native_fptr lookup. + (set! *impc:ti:adhoc-name-cache* + (cons (cons (cons adhoc-poly-name-string closure-type-list) symname-string) + *impc:ti:adhoc-name-cache*)) ;; add to the AOT-header if we're precompiling (impc:aot:insert-closure-binding-details symname-string closure-type-list (impc:ti:get-closure-zone-size symname-string) (impc:ti:get-closure-docstring symname-string) (impc:ti:get-closure-body symname-string)) + ;; Clear old polyfunc candidates of same type before adding new one + ;; This prevents accumulation of candidates that causes "ambiguous wrapper" errors. + (let ((pfdata (assoc-strcmp adhoc-poly-name-string *impc:ti:polyfunc-cache*))) + (if pfdata + (vector-set! (cdr pfdata) 0 + (cl:remove-if (lambda (x) (equal? (vector-ref x 1) closure-type-list)) + (vector-ref (cdr pfdata) 0))))) (eval `(bind-poly ,adhoc-poly-name ,symname) (interaction-environment))) (begin (impc:ti:set-closure-type symname-string closure-type-list) @@ -11643,9 +11694,7 @@ e.g. (llvm:run setter) ;; don't destroy - this happens in _setter func (sys:pop-memzone)) - (begin - (error) - (impc:compiler:print-missing-identifier-error (string->symbol (string-append func-name "_setter")) 'closure-setter))))))) + (impc:compiler:print-missing-identifier-error (string->symbol (string-append func-name "_setter")) 'closure-setter)))))) (define impc:ti:create-scm-wrapper? (lambda (func-name) diff --git a/src/AudioDevice.cpp b/src/AudioDevice.cpp index 70dd624f..46beb695 100644 --- a/src/AudioDevice.cpp +++ b/src/AudioDevice.cpp @@ -37,9 +37,14 @@ #include #include #include -#include #include +// x86 SSE intrinsics for audio_sanity_f optimization +#if defined(__x86_64__) || defined(_M_X64) || defined(__i386__) || defined(_M_IX86) +#include +#define USE_SSE_AUDIO_SANITY 1 +#endif + #include "AudioDevice.h" #include "TaskScheduler.h" #include "EXTMonitor.h" @@ -136,7 +141,13 @@ static inline SAMPLE audio_sanity(SAMPLE x) static inline float audio_sanity_f(float x) { if (likely(isfinite(x))) { +#if USE_SSE_AUDIO_SANITY _mm_store_ss(&x, _mm_min_ss(_mm_max_ss(_mm_set_ss(x), _mm_set_ss(-0.99f)), _mm_set_ss(0.99f))); +#else + // Portable branchless clamp for ARM64 and other architectures + if (x < -0.99f) x = -0.99f; + else if (x > 0.99f) x = 0.99f; +#endif return x; } return 0.0; diff --git a/src/EXTLLVM.cpp b/src/EXTLLVM.cpp index 64518447..362ca768 100644 --- a/src/EXTLLVM.cpp +++ b/src/EXTLLVM.cpp @@ -40,33 +40,43 @@ // must be included before anything which pulls in #include "llvm/AsmParser/Parser.h" #include "llvm/Config/llvm-config.h" // for LLVM_VERSION_STRING -#include "llvm/ExecutionEngine/GenericValue.h" -#include "llvm/ExecutionEngine/Interpreter.h" -#include "llvm/ExecutionEngine/MCJIT.h" -#include "llvm/ExecutionEngine/SectionMemoryManager.h" +#include "llvm/ExecutionEngine/Orc/LLJIT.h" +#include "llvm/ExecutionEngine/Orc/ThreadSafeModule.h" + #include "llvm/IR/CallingConv.h" #include "llvm/IR/Constants.h" #include "llvm/IR/DataLayout.h" #include "llvm/IR/DerivedTypes.h" #include "llvm/IR/Instructions.h" #include "llvm/IR/LLVMContext.h" -#include "llvm/IR/LegacyPassManager.h" #include "llvm/IR/Module.h" -#include "llvm/LinkAllPasses.h" +#include "llvm/IR/Verifier.h" + +#include "llvm/Passes/PassBuilder.h" #include "llvm/Support/SourceMgr.h" #include "llvm/Support/TargetSelect.h" -#include "llvm/Support/TargetRegistry.h" #include "llvm/Support/raw_ostream.h" -#include "llvm/Target/TargetOptions.h" -#include "llvm/Support/MemoryObject.h" +#include "llvm/Support/Error.h" +#include "llvm/TargetParser/Host.h" + #include "llvm/MC/MCAsmInfo.h" -#include "llvm/MC/MCDisassembler.h" +#include "llvm/MC/MCDisassembler/MCDisassembler.h" #include "llvm/MC/MCInst.h" #include "llvm/MC/MCInstPrinter.h" #include "llvm/MC/MCContext.h" +#include "llvm/MC/MCSubtargetInfo.h" +#include "llvm/MC/MCRegisterInfo.h" +#include "llvm/MC/MCInstrInfo.h" +#include "llvm/MC/TargetRegistry.h" +#include "llvm/Target/TargetMachine.h" +#include "llvm/Target/TargetOptions.h" #include #include +#include +#include +#include +#include #include "stdarg.h" #include @@ -144,6 +154,63 @@ EXPORT void free16(void* Ptr) { #endif } +// Portable conversion from 80-bit extended precision (big-endian) to double. +// Used for reading AIFF audio files, which store sample rate in this format. +// Format: 1 sign bit, 15 exponent bits, 64 mantissa bits (with explicit integer bit) +EXPORT double fp80_to_double_portable(const unsigned char* bytes) +{ + // Read big-endian 80-bit value + unsigned int exponent = (unsigned(bytes[0]) << 8) | bytes[1]; + uint64_t mantissa = (uint64_t(bytes[2]) << 56) | (uint64_t(bytes[3]) << 48) | + (uint64_t(bytes[4]) << 40) | (uint64_t(bytes[5]) << 32) | + (uint64_t(bytes[6]) << 24) | (uint64_t(bytes[7]) << 16) | + (uint64_t(bytes[8]) << 8) | uint64_t(bytes[9]); + + // Extract sign bit. + int sign = (exponent >> 15) & 1; + exponent &= 0x7FFF; + + // Handle special cases. + if (exponent == 0 && mantissa == 0) { + return sign ? -0.0 : 0.0; + } + if (exponent == 0x7FFF) { + // Infinity or NaN - for audio sample rates, this shouldn't happen. + return sign ? -1.0/0.0 : 1.0/0.0; + } + + // Convert to double. + // x86_fp80 exponent bias is 16383, double bias is 1023. + int64_t exp_unbiased = int64_t(exponent) - 16383; + + // The mantissa has an explicit integer bit (bit 63). + // Double has implicit integer bit, so we need to handle this. + union { uint64_t i; double d; } result; + + if (mantissa & (1ULL << 63)) { + // Normal number - integer bit is set. + // Remove the integer bit and shift mantissa to fit in double's 52-bit mantissa. + uint64_t double_mantissa = (mantissa & 0x7FFFFFFFFFFFFFFFULL) >> 11; + int64_t double_exp = exp_unbiased + 1023; + + if (double_exp >= 2047) { + // Overflow to infinity. + return sign ? -1.0/0.0 : 1.0/0.0; + } else if (double_exp <= 0) { + // Underflow - denormalized or zero. + return sign ? -0.0 : 0.0; + } else { + // Pack into IEEE 754 double format. + result.i = (uint64_t(sign) << 63) | (uint64_t(double_exp) << 52) | double_mantissa; + } + } else { + // Denormalized or pseudo-denormalized - rare for audio sample rates. + return sign ? -0.0 : 0.0; + } + + return result.d; +} + const char* llvm_scheme_ff_get_name(foreign_func ff) { return LLVM_SCHEME_FF_MAP[ff].c_str(); @@ -183,7 +250,7 @@ EXPORT void llvm_schedule_callback(long long time, void* dat) EXPORT void* llvm_get_function_ptr(char* fname) { - return reinterpret_cast(extemp::EXTLLVM::EE->getFunctionAddress(fname)); + return reinterpret_cast(extemp::EXTLLVM::getFunctionAddress(fname)); } EXPORT char* extitoa(int64_t val) @@ -247,7 +314,7 @@ EXPORT void llvm_send_udp(char* host, int port, void* message, int message_lengt int ret = setsockopt(fd, SOL_SOCKET, SO_BROADCAST, &broadcastEnable, sizeof(broadcastEnable)); if (ret) { printf("Error: Could not open set socket to broadcast mode\n"); } ////////////////////////////////////// - + int err = sendto(fd, message, length, 0, (struct sockaddr*)&sa, sizeof(sa)); close(fd); #endif @@ -437,7 +504,7 @@ pointer llvm_scheme_env_set(scheme* _sc, char* sym) // Module* M = extemp::EXTLLVM::M; std::string funcname(xtlang_name); std::string getter("_getter"); - void*(*p)() = (void*(*)()) extemp::EXTLLVM::EE->getFunctionAddress(funcname + getter); + void*(*p)() = (void*(*)()) extemp::EXTLLVM::getFunctionAddress(funcname + getter); if (!p) { printf("Error attempting to set environment variable in closure %s.%s\n",fname,vname); return _sc->F; @@ -524,40 +591,94 @@ pointer llvm_scheme_env_set(scheme* _sc, char* sym) namespace extemp { namespace EXTLLVM { -llvm::ExecutionEngine* EE = nullptr; -llvm::legacy::PassManager* PM; -llvm::legacy::PassManager* PM_NO; -llvm::Module* M = nullptr; // TODO: obsolete? +std::unique_ptr JIT = nullptr; +std::unique_ptr TSC = nullptr; + +llvm::orc::ThreadSafeContext& getThreadSafeContext() { + if (!TSC) { + TSC = std::make_unique( + std::make_unique()); + } + return *TSC; +} + std::vector Ms; int64_t LLVM_COUNT = 0l; bool OPTIMIZE_COMPILES = true; bool VERIFY_COMPILES = true; -static llvm::SectionMemoryManager* MM = nullptr; +uint64_t getFunctionAddress(const std::string& name) { + if (!JIT) return 0; + auto sym = JIT->lookup(name); + if (!sym) { + llvm::consumeError(sym.takeError()); + return 0; + } + return sym->getValue(); +} + +bool removeSymbol(const std::string& name) { + if (!JIT) return false; + + auto& ES = JIT->getExecutionSession(); + auto& JD = JIT->getMainJITDylib(); + + for (const auto& tryName : {name, "_" + name}) { + llvm::orc::SymbolNameSet toRemove; + toRemove.insert(ES.intern(tryName)); + if (auto err = JD.remove(toRemove)) { + llvm::consumeError(std::move(err)); + } + } + return true; +} + +llvm::Error addTrackedModule(llvm::orc::ThreadSafeModule TSM, const std::vector& symbolNames) { + if (!JIT) return llvm::make_error("JIT not initialized", llvm::inconvertibleErrorCode()); + + if (auto err = JIT->addIRModule(std::move(TSM))) { + return err; + } -uint64_t getSymbolAddress(const std::string& name) { - return MM->getSymbolAddress(name); + return llvm::Error::success(); } EXPORT const char* llvm_disassemble(const unsigned char* Code, int syntax) { size_t code_size = 1024 * 100; std::string Error; - llvm::TargetMachine *TM = extemp::EXTLLVM::EE->getTargetMachine(); - llvm::Triple Triple = TM->getTargetTriple(); - const llvm::Target TheTarget = TM->getTarget(); - std::string TripleName = Triple.getTriple(); - //const llvm::Target* TheTarget = llvm::TargetRegistry::lookupTarget(ArchName,Triple,Error); - const llvm::MCRegisterInfo* MRI(TheTarget.createMCRegInfo(TripleName)); - const llvm::MCAsmInfo* AsmInfo(TheTarget.createMCAsmInfo(*MRI,TripleName)); - const llvm::MCSubtargetInfo* STI(TheTarget.createMCSubtargetInfo(TripleName,"","")); - const llvm::MCInstrInfo* MII(TheTarget.createMCInstrInfo()); - //const llvm::MCInstrAnalysis* MIA(TheTarget->createMCInstrAnalysis(MII->get())); - llvm::MCContext Ctx(AsmInfo, MRI, nullptr); - llvm::MCDisassembler* DisAsm(TheTarget.createMCDisassembler(*STI, Ctx)); - llvm::MCInstPrinter* IP(TheTarget.createMCInstPrinter(Triple,syntax,*AsmInfo,*MII,*MRI)); //,*STI)); + + std::string TripleName = llvm::sys::getProcessTriple(); + llvm::Triple Triple(TripleName); + + const llvm::Target* TheTarget = llvm::TargetRegistry::lookupTarget(TripleName, Error); + if (!TheTarget) { + std::string errMsg = "Disassembler error: " + Error; + return strdup(errMsg.c_str()); + } + + std::unique_ptr MRI(TheTarget->createMCRegInfo(TripleName)); + if (!MRI) return strdup("Failed to create MCRegisterInfo"); + + llvm::MCTargetOptions MCOptions; + std::unique_ptr AsmInfo(TheTarget->createMCAsmInfo(*MRI, TripleName, MCOptions)); + if (!AsmInfo) return strdup("Failed to create MCAsmInfo"); + + std::unique_ptr STI(TheTarget->createMCSubtargetInfo(TripleName, "", "")); + if (!STI) return strdup("Failed to create MCSubtargetInfo"); + + std::unique_ptr MII(TheTarget->createMCInstrInfo()); + if (!MII) return strdup("Failed to create MCInstrInfo"); + + llvm::MCContext Ctx(Triple, AsmInfo.get(), MRI.get(), STI.get()); + std::unique_ptr DisAsm(TheTarget->createMCDisassembler(*STI, Ctx)); + if (!DisAsm) return strdup("Failed to create MCDisassembler"); + + std::unique_ptr IP(TheTarget->createMCInstPrinter(Triple, syntax, *AsmInfo, *MII, *MRI)); + if (!IP) return strdup("Failed to create MCInstPrinter"); + IP->setPrintImmHex(true); - IP->setUseMarkup(true); + std::string out_str; llvm::raw_string_ostream OS(out_str); llvm::ArrayRef mem(Code, code_size); @@ -566,7 +687,7 @@ EXPORT const char* llvm_disassemble(const unsigned char* Code, int syntax) OS << "\n"; for (index = 0; index < code_size; index += size) { llvm::MCInst Inst; - if (DisAsm->getInstruction(Inst, size, mem.slice(index), index, llvm::nulls(), llvm::nulls())) { + if (DisAsm->getInstruction(Inst, size, mem.slice(index), index, llvm::nulls())) { auto instSize(*reinterpret_cast(Code + index)); if (instSize <= 0) { break; @@ -576,7 +697,7 @@ EXPORT const char* llvm_disassemble(const unsigned char* Code, int syntax) OS.write_hex(size_t(Code) + index); OS.write(": ", 2); OS.write_hex(instSize); - IP->printInst(&Inst, OS, "", *STI); + IP->printInst(&Inst, 0, "", *STI, OS); OS << "\n"; } else if (!size) { size = 1; @@ -754,187 +875,183 @@ EXPORT int64_t thread_sleep(int64_t Secs, int64_t Nanosecs) #endif } +static void registerSymbol(const char* name, void* addr) { + if (!JIT) return; + auto& ES = JIT->getExecutionSession(); + auto& JD = JIT->getMainJITDylib(); + + llvm::orc::SymbolMap Symbols; + Symbols[ES.intern(name)] = { + llvm::orc::ExecutorAddr::fromPtr(addr), + llvm::JITSymbolFlags::Exported + }; + + auto err = JD.define(llvm::orc::absoluteSymbols(std::move(Symbols))); + if (err) { + llvm::consumeError(std::move(err)); + } +} void initLLVM() { - if (unlikely(EE)) { + if (unlikely(JIT)) { return; } - llvm::TargetOptions Opts; - Opts.GuaranteedTailCallOpt = true; - Opts.UnsafeFPMath = false; + llvm::InitializeNativeTarget(); llvm::InitializeNativeTargetAsmPrinter(); - LLVMInitializeX86Disassembler(); - auto& context(llvm::getGlobalContext()); - auto module(llvm::make_unique("xtmmodule_0", context)); - M = module.get(); - addModule(M); - if (!extemp::UNIV::ARCH.empty()) { - M->setTargetTriple(extemp::UNIV::ARCH); - } - // Build engine with JIT - llvm::EngineBuilder factory(std::move(module)); - factory.setEngineKind(llvm::EngineKind::JIT); - factory.setTargetOptions(Opts); - auto mm(llvm::make_unique()); - MM = mm.get(); - factory.setMCJITMemoryManager(std::move(mm)); -#ifdef _WIN32 - if (!extemp::UNIV::ATTRS.empty()) { - factory.setMAttrs(extemp::UNIV::ATTRS); - } - if (!extemp::UNIV::CPU.empty()) { - factory.setMCPU(extemp::UNIV::CPU); - } - llvm::TargetMachine* tm = factory.selectTarget(); -#else - factory.setOptLevel(llvm::CodeGenOpt::Aggressive); - llvm::Triple triple(llvm::sys::getProcessTriple()); - std::string cpu; - if (!extemp::UNIV::CPU.empty()) { - cpu = extemp::UNIV::CPU.front(); - } else { - cpu = llvm::sys::getHostCPUName(); - } - llvm::SmallVector lattrs; - if (!extemp::UNIV::ATTRS.empty()) { - for (const auto& attr : extemp::UNIV::ATTRS) { - lattrs.append(1, attr); - } - } else { - llvm::StringMap HostFeatures; - llvm::sys::getHostCPUFeatures(HostFeatures); + llvm::InitializeNativeTargetAsmParser(); + llvm::InitializeNativeTargetDisassembler(); + + // Create thread-safe context. + TSC = std::make_unique(std::make_unique()); + + // Build LLJIT. + auto JITBuilder = llvm::orc::LLJITBuilder(); + + // Configure target machine. + std::string triple = llvm::sys::getProcessTriple(); + std::string cpu = extemp::UNIV::CPU.empty() ? + std::string(llvm::sys::getHostCPUName()) : extemp::UNIV::CPU; + + auto HostFeatures = llvm::sys::getHostCPUFeatures(); + std::vector featureVec; + std::string featureString; for (auto& feature : HostFeatures) { - std::string featureName = feature.getKey().str(); - // temporarily disable all AVX512-related codegen because it - // causes crashes on this old version of LLVM - see GH #378 for - // more details. - if (feature.getValue() && featureName.compare(0, 6, "avx512")){ - lattrs.append(1, featureName); - }else{ - lattrs.append(1, std::string("-") + featureName); + std::string featureStr; + featureStr += (feature.getValue() ? "+" : "-"); + featureStr += feature.getKey().str(); + featureVec.push_back(featureStr); + if (!featureString.empty()) featureString += ","; + featureString += featureStr; + } + + if (extemp::UNIV::ARCH.empty()) { + extemp::UNIV::ARCH = triple; } - } + + JITBuilder.setJITTargetMachineBuilder( + llvm::orc::JITTargetMachineBuilder(llvm::Triple(triple)) + .setCPU(cpu) + .addFeatures(featureVec) + .setCodeGenOptLevel(llvm::CodeGenOptLevel::Aggressive)); + + // Create the JIT. + auto JITResult = JITBuilder.create(); + if (!JITResult) { + std::cerr << "ERROR: Failed to create LLJIT: " + << llvm::toString(JITResult.takeError()) << std::endl; + exit(1); + } + JIT = std::move(*JITResult); + + // Add DynamicLibrarySearchGenerator to make all process symbols available. + auto& MainJD = JIT->getMainJITDylib(); + auto DLSGOrErr = llvm::orc::DynamicLibrarySearchGenerator::GetForCurrentProcess( + JIT->getDataLayout().getGlobalPrefix()); + if (!DLSGOrErr) { + std::cerr << "ERROR: Failed to create DynamicLibrarySearchGenerator: " + << llvm::toString(DLSGOrErr.takeError()) << std::endl; + exit(1); } - llvm::TargetMachine* tm = factory.selectTarget(triple, "", cpu, lattrs); -#endif // _WIN32 - EE = factory.create(tm); - EE->DisableLazyCompilation(true); + MainJD.addGenerator(std::move(*DLSGOrErr)); + + // Print configuration. ascii_normal(); std::cout << "ARCH : " << std::flush; ascii_info(); - std::cout << std::string(tm->getTargetTriple().normalize()) << std::endl; -#ifdef _WIN32 - if (!std::string(tm->getTargetFeatureString()).empty()) { -#else - if (!std::string(tm->getTargetCPU()).empty()) { -#endif + std::cout << triple << std::endl; + + if (!cpu.empty()) { ascii_normal(); std::cout << "CPU : " << std::flush; ascii_info(); - std::cout << std::string(tm->getTargetCPU()) << std::endl; - } - if (!std::string(tm->getTargetFeatureString()).empty()) { - ascii_normal(); - std::cout << "ATTRS : " << std::flush; - auto data(tm->getTargetFeatureString().data()); - for (; *data; ++data) { - switch (*data) { - case '+': - ascii_info(); - break; - case '-': - ascii_error(); - break; - case ',': - ascii_normal(); - break; - } - putchar(*data); - } - putchar('\n'); + std::cout << cpu << std::endl; } + ascii_normal(); std::cout << "LLVM : " << std::flush; ascii_info(); std::cout << LLVM_VERSION_STRING; - std::cout << " MCJIT" << std::endl; + std::cout << " ORC JIT" << std::endl; ascii_normal(); - PM_NO = new llvm::legacy::PassManager(); - PM_NO->add(llvm::createAlwaysInlinerPass()); - PM = new llvm::legacy::PassManager(); - PM->add(llvm::createAggressiveDCEPass()); - PM->add(llvm::createAlwaysInlinerPass()); - PM->add(llvm::createArgumentPromotionPass()); - PM->add(llvm::createCFGSimplificationPass()); - PM->add(llvm::createDeadStoreEliminationPass()); - PM->add(llvm::createFunctionInliningPass()); - PM->add(llvm::createGVNPass(true)); - PM->add(llvm::createIndVarSimplifyPass()); - PM->add(llvm::createInstructionCombiningPass()); - PM->add(llvm::createJumpThreadingPass()); - PM->add(llvm::createLICMPass()); - PM->add(llvm::createLoopDeletionPass()); - PM->add(llvm::createLoopRotatePass()); - PM->add(llvm::createLoopUnrollPass()); - PM->add(llvm::createMemCpyOptPass()); - PM->add(llvm::createPromoteMemoryToRegisterPass()); - PM->add(llvm::createReassociatePass()); - PM->add(llvm::createScalarReplAggregatesPass()); - PM->add(llvm::createSCCPPass()); - PM->add(llvm::createTailCallEliminationPass()); - - static struct { - const char* name; - uintptr_t address; - } mappingTable[] = { - { "llvm_zone_destroy", uintptr_t(&extemp::EXTZones::llvm_zone_destroy) }, - }; - for (auto& elem : mappingTable) { - EE->updateGlobalMapping(elem.name, elem.address); - } - - // tell LLVM about some built-in functions - EE->updateGlobalMapping("get_address_offset", (uint64_t)&extemp::ClosureAddressTable::get_address_offset); - EE->updateGlobalMapping("string_hash", (uint64_t)&string_hash); - EE->updateGlobalMapping("swap64i", (uint64_t)&swap64i); - EE->updateGlobalMapping("swap64f", (uint64_t)&swap64f); - EE->updateGlobalMapping("swap32i", (uint64_t)&swap32i); - EE->updateGlobalMapping("swap32f", (uint64_t)&swap32f); - EE->updateGlobalMapping("unswap64i", (uint64_t)&unswap64i); - EE->updateGlobalMapping("unswap64f", (uint64_t)&unswap64f); - EE->updateGlobalMapping("unswap32i", (uint64_t)&unswap32i); - EE->updateGlobalMapping("unswap32f", (uint64_t)&unswap32f); - EE->updateGlobalMapping("rsplit", (uint64_t)&rsplit); - EE->updateGlobalMapping("rmatch", (uint64_t)&rmatch); - EE->updateGlobalMapping("rreplace", (uint64_t)&rreplace); - EE->updateGlobalMapping("r64value", (uint64_t)&r64value); - EE->updateGlobalMapping("mk_double", (uint64_t)&mk_double); - EE->updateGlobalMapping("r32value", (uint64_t)&r32value); - EE->updateGlobalMapping("mk_float", (uint64_t)&mk_float); - EE->updateGlobalMapping("mk_i64", (uint64_t)&mk_i64); - EE->updateGlobalMapping("mk_i32", (uint64_t)&mk_i32); - EE->updateGlobalMapping("mk_i16", (uint64_t)&mk_i16); - EE->updateGlobalMapping("mk_i8", (uint64_t)&mk_i8); - EE->updateGlobalMapping("mk_i1", (uint64_t)&mk_i1); - EE->updateGlobalMapping("string_value", (uint64_t)&string_value); - EE->updateGlobalMapping("mk_string", (uint64_t)&mk_string); - EE->updateGlobalMapping("cptr_value", (uint64_t)&cptr_value); - EE->updateGlobalMapping("mk_cptr", (uint64_t)&mk_cptr); - EE->updateGlobalMapping("sys_sharedir", (uint64_t)&sys_sharedir); - EE->updateGlobalMapping("sys_slurp_file", (uint64_t)&sys_slurp_file); - extemp::EXTLLVM::EE->finalizeObject(); + + // Register built-in symbols with the JIT. + + // Zone memory management functions + registerSymbol("llvm_zone_destroy", (void*)&extemp::EXTZones::llvm_zone_destroy); + registerSymbol("llvm_zone_malloc", (void*)&extemp::EXTZones::llvm_zone_malloc); + registerSymbol("llvm_zone_malloc_from_current_zone", (void*)&extemp::EXTZones::llvm_zone_malloc_from_current_zone); + registerSymbol("llvm_zone_print", (void*)&extemp::EXTZones::llvm_zone_print); + registerSymbol("llvm_zone_ptr_size", (void*)&extemp::EXTZones::llvm_zone_ptr_size); + registerSymbol("llvm_zone_copy_ptr", (void*)&extemp::EXTZones::llvm_zone_copy_ptr); + registerSymbol("llvm_ptr_in_zone", (void*)&extemp::EXTZones::llvm_ptr_in_zone); + registerSymbol("llvm_ptr_in_current_zone", (void*)&extemp::EXTZones::llvm_ptr_in_current_zone); + registerSymbol("llvm_pop_zone_stack", (void*)&extemp::EXTZones::llvm_pop_zone_stack); + registerSymbol("llvm_zone_callback_setup", (void*)&extemp::EXTZones::llvm_zone_callback_setup); + registerSymbol("llvm_peek_zone_stack_extern", (void*)&extemp::EXTZones::llvm_peek_zone_stack_extern); + registerSymbol("llvm_push_zone_stack_extern", (void*)&extemp::EXTZones::llvm_push_zone_stack_extern); + registerSymbol("llvm_zone_create_extern", (void*)&extemp::EXTZones::llvm_zone_create_extern); + registerSymbol("llvm_destroy_zone_after_delay", (void*)&llvm_destroy_zone_after_delay); + + // Closure address table functions + registerSymbol("get_address_offset", (void*)&extemp::ClosureAddressTable::get_address_offset); + registerSymbol("add_address_table", (void*)&extemp::ClosureAddressTable::add_address_table); + registerSymbol("get_address_table", (void*)&extemp::ClosureAddressTable::get_address_table); + registerSymbol("check_address_exists", (void*)&extemp::ClosureAddressTable::check_address_exists); + registerSymbol("check_address_type", (void*)&extemp::ClosureAddressTable::check_address_type); + registerSymbol("string_hash", (void*)&string_hash); + registerSymbol("swap64i", (void*)&swap64i); + registerSymbol("swap64f", (void*)&swap64f); + registerSymbol("swap32i", (void*)&swap32i); + registerSymbol("swap32f", (void*)&swap32f); + registerSymbol("unswap64i", (void*)&unswap64i); + registerSymbol("unswap64f", (void*)&unswap64f); + registerSymbol("unswap32i", (void*)&unswap32i); + registerSymbol("unswap32f", (void*)&unswap32f); + registerSymbol("rsplit", (void*)&rsplit); + registerSymbol("rmatch", (void*)&rmatch); + registerSymbol("rreplace", (void*)&rreplace); + registerSymbol("r64value", (void*)&r64value); + registerSymbol("mk_double", (void*)&mk_double); + registerSymbol("r32value", (void*)&r32value); + registerSymbol("mk_float", (void*)&mk_float); + registerSymbol("mk_i64", (void*)&mk_i64); + registerSymbol("mk_i32", (void*)&mk_i32); + registerSymbol("mk_i16", (void*)&mk_i16); + registerSymbol("mk_i8", (void*)&mk_i8); + registerSymbol("mk_i1", (void*)&mk_i1); + registerSymbol("string_value", (void*)&string_value); + registerSymbol("mk_string", (void*)&mk_string); + registerSymbol("cptr_value", (void*)&cptr_value); + registerSymbol("mk_cptr", (void*)&mk_cptr); + registerSymbol("sys_sharedir", (void*)&sys_sharedir); + registerSymbol("sys_slurp_file", (void*)&sys_slurp_file); + registerSymbol("fp80_to_double_portable", (void*)&fp80_to_double_portable); + return; } } // namespace EXTLLVM } // namespace extemp -#include - static std::unordered_map sGlobalMap; +static void cleanupLLVM() { + sGlobalMap.clear(); + extemp::EXTLLVM::Ms.clear(); + + if (extemp::EXTLLVM::JIT) { + extemp::EXTLLVM::JIT.reset(); + } +} + +static struct EXTLLVMCleanupRegistrar { + EXTLLVMCleanupRegistrar() { + std::atexit(cleanupLLVM); + } +} sCleanupRegistrar; + namespace extemp { void EXTLLVM::addModule(llvm::Module* Module) @@ -943,12 +1060,13 @@ void EXTLLVM::addModule(llvm::Module* Module) std::string str; llvm::raw_string_ostream stream(str); function.printAsOperand(stream, false); - auto result(sGlobalMap.insert(std::make_pair(stream.str().substr(1), &function))); + std::string funcName = stream.str().substr(1); + auto result(sGlobalMap.insert(std::make_pair(funcName, &function))); if (!result.second) { result.first->second = &function; } } - for (const auto& global : Module->getGlobalList()) { + for (const auto& global : Module->globals()) { std::string str; llvm::raw_string_ostream stream(str); global.printAsOperand(stream, false); @@ -960,6 +1078,10 @@ void EXTLLVM::addModule(llvm::Module* Module) Ms.push_back(Module); } +void EXTLLVM::removeFromGlobalMap(const std::string& name) { + sGlobalMap.erase(name); +} + const llvm::GlobalValue* EXTLLVM::getGlobalValue(const char* Name) { auto iter(sGlobalMap.find(Name)); diff --git a/src/SchemeFFI.cpp b/src/SchemeFFI.cpp index 87377c5f..2c9cf200 100644 --- a/src/SchemeFFI.cpp +++ b/src/SchemeFFI.cpp @@ -37,31 +37,37 @@ /////////////////// #include +#include +#include // must be included before anything which pulls in #include "llvm/ADT/StringExtras.h" #include "llvm/AsmParser/Parser.h" #include "llvm-c/Core.h" -#include "llvm/Bitcode/ReaderWriter.h" -#include "llvm/ExecutionEngine/ExecutionEngine.h" -#include "llvm/ExecutionEngine/GenericValue.h" -#include "llvm/ExecutionEngine/Interpreter.h" +#include "llvm/Bitcode/BitcodeWriter.h" +#include "llvm/Bitcode/BitcodeReader.h" + +#include "llvm/ExecutionEngine/Orc/LLJIT.h" +#include "llvm/ExecutionEngine/Orc/ThreadSafeModule.h" + +#include "llvm/Passes/PassBuilder.h" + #include "llvm/IR/CallingConv.h" #include "llvm/IR/Constants.h" #include "llvm/IR/DataLayout.h" #include "llvm/IR/DerivedTypes.h" +#include "llvm/IR/IRBuilder.h" #include "llvm/IR/Instructions.h" #include "llvm/IR/LLVMContext.h" #include "llvm/IR/Module.h" -#include "llvm/LinkAllPasses.h" +#include "llvm/Transforms/Utils/Cloning.h" #include "llvm/Support/ManagedStatic.h" -#include "llvm/Support/MutexGuard.h" #include "llvm/Support/SourceMgr.h" #include "llvm/Support/raw_ostream.h" #include "llvm/Support/raw_os_ostream.h" #include "llvm/Target/TargetOptions.h" -#include "llvm/IR/LegacyPassManager.h" #include "llvm/IR/Verifier.h" +#include "llvm/Support/Error.h" #include "SchemeFFI.h" #include "AudioDevice.h" @@ -71,6 +77,8 @@ #include "SchemeREPL.h" #include #include +#include +#include #ifdef _WIN32 #include @@ -149,6 +157,59 @@ namespace SchemeFFI { #include "ffi/llvm.inc" #include "ffi/clock.inc" +// LLVM identifier patterns +namespace LLVMPatterns { + // Identifier + constexpr const char* IDENT = R"([-a-zA-Z$._][-a-zA-Z$._0-9]*)"; + // Type identifier + constexpr const char* TYPE_IDENT = R"([a-zA-Z_$][a-zA-Z0-9_$-]*)"; + // Start of line + @symbol + constexpr const char* AT_SYMBOL_START = R"(^@()"; + // Whitespace + @symbol + constexpr const char* AT_SYMBOL_REF = R"([ \t]@()"; + // %symbol + constexpr const char* PERCENT_SYMBOL = R"(%()"; +} + +// define ... @symbol_name +static std::regex sDefineSymRegex( + std::string(R"(define[^\n]+@()") + LLVMPatterns::IDENT + ")", + std::regex::optimize | std::regex::ECMAScript); + +// declare ... @symbol_name +static std::regex sDeclareSymRegex( + std::string(R"(declare[^\n]+@()") + LLVMPatterns::IDENT + ")", + std::regex::optimize | std::regex::ECMAScript); + +// @name = external global type +static std::regex sExternalGlobalRegex( + std::string(LLVMPatterns::AT_SYMBOL_START) + LLVMPatterns::IDENT + R"()\s*=\s*external\s+global\s+(\S+))", + std::regex::optimize | std::regex::multiline); + +// declare cc 0 return_type @func_name(params) [nounwind] +static std::regex sExternalDeclareRegex( + R"(^\s*declare\s+cc\s+0\s+([^@]+)\s+@([^(]+)\(([^)]*)\)(?:\s+nounwind)?\s*$)", + std::regex::optimize | std::regex::multiline); + +// whitespace followed by @symbol (for references in code) +static std::regex sGlobalSymRegex( + std::string(LLVMPatterns::AT_SYMBOL_REF) + LLVMPatterns::IDENT + ")", + std::regex::optimize); + +// @symbol = ... (global variable definitions) +static std::regex sGlobalVarDefRegex( + std::string(LLVMPatterns::AT_SYMBOL_START) + LLVMPatterns::IDENT + R"()\s*=)", + std::regex::optimize | std::regex::multiline); + +// %type_name = type ... +static std::regex sTypeDefRegex( + std::string(R"(^\s*(%[-a-zA-Z$._0-9]+)\s*=\s*type\s+(.+)$)"), + std::regex::multiline); + +// %name.123 (numbered type suffixes) +static std::regex sTypeSuffixRegex( + std::string(LLVMPatterns::PERCENT_SYMBOL) + LLVMPatterns::TYPE_IDENT + R"()\.[0-9]+)"); + void initSchemeFFI(scheme* sc) { static struct { @@ -196,21 +257,142 @@ static std::string SanitizeType(llvm::Type* Type) if (pos != std::string::npos) { str.erase(pos - 1); } + // Strip numeric suffixes from named types. + str = std::regex_replace(str, sTypeSuffixRegex, "%$1"); return str; } -static std::regex sGlobalSymRegex("[ \t]@([-a-zA-Z$._][-a-zA-Z$._0-9]*)", std::regex::optimize); -static std::regex sDefineSymRegex("define[^\\n]+@([-a-zA-Z$._][-a-zA-Z$._0-9]*)", std::regex::optimize | std::regex::ECMAScript); + +// Track user-defined type definitions for LLVM 21's opaque pointers. +// Each new type definition needs to be included in subsequent compilations. +static std::unordered_map sUserTypeDefs; +static std::mutex sUserTypeDefsMutex; + +// Track external global variables for declaration in subsequent compilations. +// Maps global name to its type string (e.g., "SAMPLE_RATE" -> "i32"). +static std::unordered_map sExternalGlobals; +static std::mutex sExternalGlobalsMutex; + +// Track external library function declarations (from bind-lib) for inclusion in subsequent compilations. +// Maps function name to its full declaration string (e.g., "sf_close" -> "declare i32 @sf_close(i8*)"). +static std::unordered_map sExternalLibFunctions; +static std::mutex sExternalLibFunctionsMutex; +static std::unordered_map sFuncDeclRegexCache; + +// Cache generated declaration strings to avoid regenerating them on every JIT compilation. +// Maps symbol name to its full declaration string. +static std::unordered_map sCachedDeclarations; +static std::mutex sCachedDeclarationsMutex; + +// Track built-in types from the base runtime (bitcode.ll) to avoid duplicate definitions. +static std::unordered_set sBuiltinTypes; + +// Get user type definitions, filtered to exclude those already in the IR. +static std::string getUserTypeDefsStringFiltered(const std::string& existingIR) { + std::lock_guard lock(sUserTypeDefsMutex); + std::string result; + for (const auto& kv : sUserTypeDefs) { + std::string typeDef = kv.first + " = type " + kv.second; + // Check if this type is already defined. + if (existingIR.find(typeDef) == std::string::npos) { + result += typeDef + "\n"; + } + } + return result; +} + +// Get external globals, filtered to exclude those already in the IR. +static std::string getExternalGlobalsStringFiltered(const std::string& existingIR) { + std::lock_guard lock(sExternalGlobalsMutex); + std::string result; + for (const auto& kv : sExternalGlobals) { + std::string globalDecl = "@" + kv.first + " = external global " + kv.second; + // Check if this global is already declared. + if (existingIR.find(globalDecl) == std::string::npos) { + result += globalDecl + "\n"; + } + } + return result; +} + +static void extractAndStoreExternalGlobals(const std::string& ir) { + std::lock_guard lock(sExternalGlobalsMutex); + std::sregex_iterator it(ir.begin(), ir.end(), sExternalGlobalRegex); + std::sregex_iterator end; + for (; it != end; ++it) { + std::string globalName = (*it)[1].str(); + std::string globalType = (*it)[2].str(); + sExternalGlobals[globalName] = globalType; + } +} + +static void extractAndStoreExternalLibFunctions(const std::string& ir) { + std::lock_guard lock(sExternalLibFunctionsMutex); + std::sregex_iterator it(ir.begin(), ir.end(), sExternalDeclareRegex); + std::sregex_iterator end; + for (; it != end; ++it) { + std::string returnType = (*it)[1].str(); + std::string funcName = (*it)[2].str(); + std::string params = (*it)[3].str(); + + // Reconstruct the full declaration (simplified form without calling convention). + std::string fullDecl = "declare " + returnType + " @" + funcName + "(" + params + ") nounwind\n"; + sExternalLibFunctions[funcName] = fullDecl; + } +} + +// Get external lib functions, filtered to exclude those already declared in the IR. +static std::string getExternalLibFunctionsStringFiltered(const std::string& existingIR) { + std::lock_guard lock(sExternalLibFunctionsMutex); + std::string result; + constexpr std::string_view kRegexSpecials = R"(.+*?^$[](){}|\\)"; + // Check if each function is already declared. + for (const auto& kv : sExternalLibFunctions) { + const std::string& funcName = kv.first; + // Escape special regex characters in function name. + std::string escapedName; + for (char c : funcName) { + if (kRegexSpecials.find(c) != std::string_view::npos) { + escapedName += '\\'; + } + escapedName += c; + } + // Check if the function is already declared. + auto cacheIt = sFuncDeclRegexCache.find(funcName); + if (cacheIt == sFuncDeclRegexCache.end()) { + cacheIt = sFuncDeclRegexCache.emplace( + funcName, + std::regex("declare\\s+(?:cc\\s+\\d+\\s+)?[^@]*@" + escapedName + "\\s*\\(", std::regex::optimize) + ).first; + } + if (!std::regex_search(existingIR, cacheIt->second)) { + result += kv.second; + } + } + return result; +} + +static void extractAndStoreTypeDefs(const std::string& ir) { + std::lock_guard lock(sUserTypeDefsMutex); + std::sregex_iterator it(ir.begin(), ir.end(), sTypeDefRegex); + std::sregex_iterator end; + for (; it != end; ++it) { + std::string typeName = (*it)[1].str(); + std::string typeDef = (*it)[2].str(); + // Store types not present in the base runtime. + if (sBuiltinTypes.find(typeName) == sBuiltinTypes.end()) { + sUserTypeDefs[typeName] = typeDef; + } + } +} static llvm::Module* jitCompile(const std::string& String) { // Create some module to put our function into it. using namespace llvm; - legacy::PassManager* PM = extemp::EXTLLVM::PM; - legacy::PassManager* PM_NO = extemp::EXTLLVM::PM_NO; char modname[256]; - sprintf(modname, "xtmmodule_%lld", ++llvm_emitcounter); + snprintf(modname, sizeof(modname), "xtmmodule_%lld", ++llvm_emitcounter); std::string asmcode(String); SMDiagnostic pa; @@ -235,8 +417,22 @@ static llvm::Module* jitCompile(const std::string& String) sInlineString = inString.str(); #endif } + // Collect symbol references. std::copy(std::sregex_token_iterator(sInlineString.begin(), sInlineString.end(), sGlobalSymRegex, 1), std::sregex_token_iterator(), std::inserter(sInlineSyms, sInlineSyms.begin())); + + // Collect global variable definitions. + std::copy(std::sregex_token_iterator(sInlineString.begin(), sInlineString.end(), sGlobalVarDefRegex, 1), + std::sregex_token_iterator(), std::inserter(sInlineSyms, sInlineSyms.begin())); + + // Extract built-in type names from base runtime to avoid duplicate definitions. + if (sBuiltinTypes.empty()) { + std::sregex_iterator it(sInlineString.begin(), sInlineString.end(), sTypeDefRegex); + std::sregex_iterator end; + for (; it != end; ++it) { + sBuiltinTypes.insert((*it)[1].str()); + } + } { #ifdef DYLIB auto data = fs.open("runtime/inline.ll"); @@ -249,117 +445,242 @@ static llvm::Module* jitCompile(const std::string& String) #endif std::copy(std::sregex_token_iterator(tString.begin(), tString.end(), sGlobalSymRegex, 1), std::sregex_token_iterator(), std::inserter(sInlineSyms, sInlineSyms.begin())); + std::copy(std::sregex_token_iterator(tString.begin(), tString.end(), sGlobalVarDefRegex, 1), + std::sregex_token_iterator(), std::inserter(sInlineSyms, sInlineSyms.begin())); } } - if (sInlineBitcode.empty()) { - // need to avoid parsing the types twice - static bool first(true); - if (!first) { - auto newModule(parseAssemblyString(sInlineString, pa, getGlobalContext())); - if (newModule) { - std::string bitcode; - llvm::raw_string_ostream bitstream(sInlineBitcode); - llvm::WriteBitcodeToFile(newModule.get(), bitstream); -#ifdef DYLIB - auto data = fs.open("runtime/inline.ll"); - sInlineString = std::string(data.begin(), data.end()); -#else - std::ifstream inStream(UNIV::SHARE_DIR + "/runtime/inline.ll"); - std::stringstream inString; - inString << inStream.rdbuf(); - sInlineString = inString.str(); -#endif - } else { -std::cout << pa.getMessage().str() << std::endl; - abort(); - } - } else { - first = false; - } - } - std::unique_ptr newModule; + + // Detect if this is a bind-lib declaration. + // These should not have external lib functions prepended, to avoid duplicates. + bool isBindLibDeclaration = (asmcode.find("declare") == 0 && asmcode.size() < 500); + + // Build declarations string. std::vector symbols; std::copy(std::sregex_token_iterator(asmcode.begin(), asmcode.end(), sGlobalSymRegex, 1), std::sregex_token_iterator(), std::inserter(symbols, symbols.begin())); std::sort(symbols.begin(), symbols.end()); auto end(std::unique(symbols.begin(), symbols.end())); std::unordered_set ignoreSyms; + + // Ignore symbols defined as functions. std::copy(std::sregex_token_iterator(asmcode.begin(), asmcode.end(), sDefineSymRegex, 1), std::sregex_token_iterator(), std::inserter(ignoreSyms, ignoreSyms.begin())); + + // Ignore already declared symbols. + std::copy(std::sregex_token_iterator(asmcode.begin(), asmcode.end(), sDeclareSymRegex, 1), + std::sregex_token_iterator(), std::inserter(ignoreSyms, ignoreSyms.begin())); + + // Ignore symbols defined/declared as global variables. + std::copy(std::sregex_token_iterator(asmcode.begin(), asmcode.end(), sGlobalVarDefRegex, 1), + std::sregex_token_iterator(), std::inserter(ignoreSyms, ignoreSyms.begin())); std::string declarations; llvm::raw_string_ostream dstream(declarations); for (auto iter = symbols.begin(); iter != end; ++iter) { const char* sym(iter->c_str()); + // Skip symbols in sInlineSyms or ignoreSyms. if (sInlineSyms.find(sym) != sInlineSyms.end() || ignoreSyms.find(sym) != ignoreSyms.end()) { continue; } + // Skip symbols already in sExternalGlobals. + { + std::lock_guard lock(sExternalGlobalsMutex); + if (sExternalGlobals.find(sym) != sExternalGlobals.end()) { + continue; + } + } + // Skip symbols already in sExternalLibFunctions, unless this is a bind-lib declaration. + if (!isBindLibDeclaration) { + std::lock_guard lock(sExternalLibFunctionsMutex); + if (sExternalLibFunctions.find(sym) != sExternalLibFunctions.end()) { + continue; + } + } + + // Check if we've already cached this declaration. + { + std::lock_guard lock(sCachedDeclarationsMutex); + auto cachedIter = sCachedDeclarations.find(sym); + if (cachedIter != sCachedDeclarations.end()) { + dstream << cachedIter->second; + continue; + } + } + auto gv = extemp::EXTLLVM::getGlobalValue(sym); if (!gv) { continue; } + + std::string decl; auto func(llvm::dyn_cast(gv)); if (func) { - dstream << "declare " << SanitizeType(func->getReturnType()) << " @" << sym << " ("; + llvm::raw_string_ostream declStream(decl); + declStream << "declare " << SanitizeType(func->getReturnType()) << " @" << sym << " ("; bool first(true); - for (const auto& arg : func->getArgumentList()) { + for (const auto& arg : func->args()) { if (!first) { - dstream << ", "; + declStream << ", "; } else { first = false; } - dstream << SanitizeType(arg.getType()); + declStream << SanitizeType(arg.getType()); } if (func->isVarArg()) { - dstream << ", ..."; + declStream << ", ..."; } - dstream << ")\n"; + declStream << ")\n"; + decl = declStream.str(); } else { - auto str(SanitizeType(gv->getType())); - dstream << '@' << sym << " = external global " << str.substr(0, str.length() - 1) << '\n'; + auto globalVar = llvm::dyn_cast(gv); + if (globalVar) { + auto str(SanitizeType(globalVar->getValueType())); + decl = "@" + std::string(sym) + " = external global " + str + "\n"; + } else { + decl = "@" + std::string(sym) + " = external global ptr\n"; + } + } + + // Cache the declaration for future use. + { + std::lock_guard lock(sCachedDeclarationsMutex); + sCachedDeclarations[sym] = decl; } + dstream << decl; } -// std::cout << "**** DECL ****\n" << dstream.str() << "**** ENDDECL ****\n" << std::endl; - if (!sInlineBitcode.empty()) { - auto modOrErr(parseBitcodeFile(llvm::MemoryBufferRef(sInlineBitcode, ""), getGlobalContext())); - if (likely(modOrErr)) { - newModule = std::move(modOrErr.get()); - asmcode = sInlineString + dstream.str() + asmcode; - if (parseAssemblyInto(llvm::MemoryBufferRef(asmcode, ""), *newModule, pa)) { -std::cout << "**** DECL ****\n" << dstream.str() << "**** ENDDECL ****\n" << std::endl; - newModule.reset(); + + llvm::Module* modulePtr = nullptr; + + EXTLLVM::getThreadSafeContext().withContextDo([&](LLVMContext* ctx) { + // Initialize inline bitcode. + if (sInlineBitcode.empty()) { + static bool first(true); + if (!first) { + auto newModule(parseAssemblyString(sInlineString, pa, *ctx)); + if (newModule) { + llvm::raw_string_ostream bitstream(sInlineBitcode); + llvm::WriteBitcodeToFile(*newModule, bitstream); +#ifdef DYLIB + auto data = fs.open("runtime/inline.ll"); + sInlineString = std::string(data.begin(), data.end()); +#else + std::ifstream inStream(UNIV::SHARE_DIR + "/runtime/inline.ll"); + std::stringstream inString; + inString << inStream.rdbuf(); + sInlineString = inString.str(); +#endif + } else { + std::cout << pa.getMessage().str() << std::endl; + abort(); + } + } else { + first = false; } } - } else { - newModule = parseAssemblyString(asmcode, pa, getGlobalContext()); - } - if (newModule) { + + std::unique_ptr newModule; + + // Get user-defined type definitions and external globals. + std::string userTypeDefs = getUserTypeDefsStringFiltered(asmcode); + std::string externalGlobals = getExternalGlobalsStringFiltered(asmcode); + + if (!sInlineBitcode.empty()) { + auto modOrErr(parseBitcodeFile(llvm::MemoryBufferRef(sInlineBitcode, ""), *ctx)); + if (likely(modOrErr)) { + newModule = std::move(modOrErr.get()); + std::string externalLibFunctions = isBindLibDeclaration ? "" : + getExternalLibFunctionsStringFiltered(asmcode); + asmcode = sInlineString + userTypeDefs + externalGlobals + externalLibFunctions + dstream.str() + asmcode; + if (parseAssemblyInto(llvm::MemoryBufferRef(asmcode, ""), newModule.get(), nullptr, pa)) { + std::cout << "**** DECL ****\n" << dstream.str() << "**** ENDDECL ****\n" << std::endl; + newModule.reset(); + } + } + } else { + // First compilation - include user type definitions and external lib functions. + std::string externalLibFunctions = getExternalLibFunctionsStringFiltered(asmcode); + asmcode = userTypeDefs + externalLibFunctions + asmcode; + newModule = parseAssemblyString(asmcode, pa, *ctx); + } + + if (!newModule) { + std::string errstr; + llvm::raw_string_ostream ss(errstr); + pa.print("LLVM IR", ss); + printf("%s\n", ss.str().c_str()); + return; + } + + // Extract and store any new type definitions. + extractAndStoreTypeDefs(String); + + // Extract and store external global declarations. + extractAndStoreExternalGlobals(String); + + // Extract and store external library function declarations. + extractAndStoreExternalLibFunctions(String); + + // Set target triple. if (unlikely(!extemp::UNIV::ARCH.empty())) { - newModule->setTargetTriple(extemp::UNIV::ARCH); + newModule->setTargetTriple(llvm::Triple(extemp::UNIV::ARCH)); } + + // Optimize if (EXTLLVM::OPTIMIZE_COMPILES) { - PM->run(*newModule); - } else { - PM_NO->run(*newModule); + llvm::LoopAnalysisManager LAM; + llvm::FunctionAnalysisManager FAM; + llvm::CGSCCAnalysisManager CGAM; + llvm::ModuleAnalysisManager MAM; + + llvm::PassBuilder PB; + PB.registerModuleAnalyses(MAM); + PB.registerCGSCCAnalyses(CGAM); + PB.registerFunctionAnalyses(FAM); + PB.registerLoopAnalyses(LAM); + PB.crossRegisterProxies(LAM, FAM, CGAM, MAM); } - } - //std::stringstream ss; - if (unlikely(!newModule)) - { -// std::cout << "**** CODE ****\n" << asmcode << " **** ENDCODE ****" << std::endl; -// std::cout << pa.getMessage().str() << std::endl << pa.getLineNo() << std::endl; - std::string errstr; - llvm::raw_string_ostream ss(errstr); - pa.print("LLVM IR",ss); - printf("%s\n",ss.str().c_str()); - return nullptr; - } else if (extemp::EXTLLVM::VERIFY_COMPILES && verifyModule(*newModule)) { + + // Verify the module. + if (extemp::EXTLLVM::VERIFY_COMPILES && verifyModule(*newModule)) { std::cout << "\nInvalid LLVM IR\n"; - return nullptr; - } + return; + } + + modulePtr = newModule.get(); + + // Extract symbol names from the module. + std::vector symbolNames; + + for (const auto& func : newModule->getFunctionList()) { + if (!func.isDeclaration()) { + symbolNames.push_back(func.getName().str()); + } + } + for (const auto& glob : newModule->globals()) { + if (!glob.isDeclaration()) { + symbolNames.push_back(glob.getName().str()); + } + } + + // Clone the module for metadata. + auto metadataModule = llvm::CloneModule(*newModule); + + // Add module to ORC JIT with symbol tracking. + auto TSM = llvm::orc::ThreadSafeModule(std::move(newModule), EXTLLVM::getThreadSafeContext()); + auto err = EXTLLVM::addTrackedModule(std::move(TSM), symbolNames); + + // Register cloned module metadata. + if (err) { + std::cerr << "Failed to add module to JIT: " + << llvm::toString(std::move(err)) << std::endl; + modulePtr = nullptr; + } else { + modulePtr = metadataModule.get(); + EXTLLVM::addModule(metadataModule.get()); + // Transfer ownership to Ms vector. + metadataModule.release(); + } + }); - llvm::Module *modulePtr = newModule.get(); - extemp::EXTLLVM::EE->addModule(std::move(newModule)); - extemp::EXTLLVM::EE->finalizeObject(); return modulePtr; } diff --git a/src/ffi/llvm.inc b/src/ffi/llvm.inc index abd7f3b5..66d81751 100644 --- a/src/ffi/llvm.inc +++ b/src/ffi/llvm.inc @@ -10,7 +10,6 @@ static pointer jitCompileIRString(scheme* Scheme, pointer Args) if (!modulePtr) { return Scheme->F; } - extemp::EXTLLVM::addModule(modulePtr); return mk_cptr(Scheme, modulePtr); } @@ -54,39 +53,47 @@ static pointer get_struct_size(scheme* Scheme, pointer Args) char* struct_type_str = string_value(pair_car(Args)); unsigned long long hash = string_hash(struct_type_str); char name[128]; - sprintf(name,"_xtmT%lld",hash); + snprintf(name, sizeof(name), "_xtmT%llu", hash); char assm[1024]; - sprintf(assm,"%%%s = type %s",name,struct_type_str); + snprintf(assm, sizeof(assm), "%%%s = type %s", name, struct_type_str); + long size = -1; + EXTLLVM::getThreadSafeContext().withContextDo([&](llvm::LLVMContext* ctx) { llvm::SMDiagnostic pa; - auto newM(llvm::parseAssemblyString(assm, pa, llvm::getGlobalContext())); + auto newM(llvm::parseAssemblyString(assm, pa, *ctx)); if (!newM) { - return Scheme->F; + return; } - auto type(newM->getTypeByName(name)); + auto type(llvm::StructType::getTypeByName(*ctx, name)); if (!type) { + return; + } + const auto& layout = newM->getDataLayout(); + size = layout.getStructLayout(type)->getSizeInBytes(); + }); + + if (size < 0) { return Scheme->F; } - auto layout(new llvm::DataLayout(newM.get())); - long size = layout->getStructLayout(type)->getSizeInBytes(); - delete layout; return mk_integer(Scheme, size); } static llvm::StructType* getNamedType(const char* name) { - return EXTLLVM::M->getTypeByName(name); + llvm::StructType* result = nullptr; + EXTLLVM::getThreadSafeContext().withContextDo([&](llvm::LLVMContext* ctx) { + result = llvm::StructType::getTypeByName(*ctx, name); + }); + return result; } static pointer get_named_struct_size(scheme* Scheme, pointer Args) { - llvm::Module* M = EXTLLVM::M; auto type(getNamedType(string_value(pair_car(Args)))); if (!type) { return Scheme->F; } - auto layout(new llvm::DataLayout(M)); - long size = layout->getStructLayout(type)->getSizeInBytes(); - delete layout; + auto& DL = EXTLLVM::JIT->getDataLayout(); + long size = DL.getStructLayout(type)->getSizeInBytes(); return mk_integer(Scheme, size); } @@ -110,7 +117,7 @@ static pointer get_function_args(scheme* Scheme, pointer Args) } pointer str = mk_string(Scheme, tmp_name); pointer p = cons(Scheme, str, Scheme->NIL); - for (const auto& arg : func->getArgumentList()) { + for (const auto& arg : func->args()) { { EnvInjector injector(Scheme, p); std::string typestr2; @@ -171,53 +178,41 @@ static pointer get_global_variable_type(scheme* Scheme, pointer Args) static pointer get_function_pointer(scheme* Scheme, pointer Args) { auto name(string_value(pair_car(Args))); - void* p = EXTLLVM::EE->getPointerToGlobalIfAvailable(name); - if (!p) { // look for it as a JIT-compiled function - p = reinterpret_cast(EXTLLVM::EE->getFunctionAddress(name)); - if (!p) { + auto addr = EXTLLVM::getFunctionAddress(name); + if (!addr) { return Scheme->F; - } } - return mk_cptr(Scheme, p); + return mk_cptr(Scheme, reinterpret_cast(addr)); } static pointer remove_function(scheme* Scheme, pointer Args) { - auto func(EXTLLVM::EE->FindFunctionNamed(string_value(pair_car(Args)))); - if (!func) { - return Scheme->F; - } - if (func->mayBeOverridden()) { - func->dropAllReferences(); - func->removeFromParent(); + const char* name = string_value(pair_car(Args)); + if (EXTLLVM::removeSymbol(name)) { + EXTLLVM::removeFromGlobalMap(name); return Scheme->T; } - printf("Cannot remove function with dependencies\n"); return Scheme->F; } static pointer remove_global_var(scheme* Scheme, pointer Args) { - auto var(EXTLLVM::EE->FindGlobalVariableNamed(string_value(pair_car(Args)))); - if (!var) { - return Scheme->F; - } - var->dropAllReferences(); - var->removeFromParent(); + const char* name = string_value(pair_car(Args)); + if (EXTLLVM::removeSymbol(name)) { + EXTLLVM::removeFromGlobalMap(name); return Scheme->T; + } + return Scheme->F; } static pointer erase_function(scheme* Scheme, pointer Args) { - auto func(EXTLLVM::EE->FindFunctionNamed(string_value(pair_car(Args)))); - if (!func) { - return Scheme->F; - } - func->dropAllReferences(); - func->removeFromParent(); - //func->deleteBody(); - //func->eraseFromParent(); + const char* name = string_value(pair_car(Args)); + if (EXTLLVM::removeSymbol(name)) { + EXTLLVM::removeFromGlobalMap(name); return Scheme->T; + } + return Scheme->F; } static pointer llvm_call_void_native(scheme* Scheme, pointer Args) @@ -225,91 +220,222 @@ static pointer llvm_call_void_native(scheme* Scheme, pointer Args) char name[1024]; strcpy(name, string_value(pair_car(Args))); strcat(name, "_native"); - auto func(EXTLLVM::EE->FindFunctionNamed(string_value(pair_car(Args)))); - if (!func) { + + auto addr = EXTLLVM::getFunctionAddress(name); + if (!addr) { + addr = EXTLLVM::getFunctionAddress(string_value(pair_car(Args))); + if (!addr) { return Scheme->F; } - void* p = EXTLLVM::EE->getPointerToFunction(func); - if (!p) { - return Scheme->F; } - ((void(*)(void)) p)(); + auto p = reinterpret_cast(addr); + p(); return Scheme->T; } +static std::atomic CALL_STUB_COUNTER{0}; + static pointer call_compiled(scheme* Scheme, pointer Args) { - llvm::ExecutionEngine* EE = EXTLLVM::EE; -#ifdef LLVM_EE_LOCK - llvm::MutexGuard locked(EE->lock); -#endif - auto func(reinterpret_cast(cptr_value(pair_car(Args)))); + auto func = reinterpret_cast(cptr_value(pair_car(Args))); if (unlikely(!func)) { printf("No such function\n"); return Scheme->F; } - func->getArgumentList(); + + auto funcType = func->getFunctionType(); Args = pair_cdr(Args); + unsigned lgth = list_length(Scheme, Args); - if (unlikely(lgth != func->getArgumentList().size())) { + if (unlikely(lgth != funcType->getNumParams())) { printf("Wrong number of arguments for function!\n"); return Scheme->F; } - int i = 0; - std::vector fargs; - fargs.reserve(lgth); - for (const auto& arg : func->getArgumentList()) { - pointer p = car(Args); - Args = cdr(Args); - if (is_integer(p)) { - if (unlikely(arg.getType()->getTypeID() != llvm::Type::IntegerTyID)) { - printf("Bad argument type %i\n",i); + + if (!extemp::EXTLLVM::JIT) { + printf("LLVM JIT not initialized\n"); + return Scheme->F; + } + + // Resolve the compiled function address. + std::string name = func->getName().str(); + auto addr = EXTLLVM::getFunctionAddress(name); + if (!addr) { + addr = EXTLLVM::getFunctionAddress(name + "_native"); + if (!addr) { + return Scheme->F; + } + } + + // Marshal arguments into raw values. + struct ArgValue { + enum Kind { Int, Float, Double, Ptr } kind; + llvm::Type* ty; + uint64_t intVal; + double doubleVal; + float floatVal; + void* ptrVal; + }; + + std::vector argValues; + argValues.reserve(lgth); + + pointer argList = Args; + for (unsigned i = 0; i < lgth; ++i) { + auto argTy = funcType->getParamType(i); + pointer p = car(argList); + argList = cdr(argList); + + switch (argTy->getTypeID()) { + case llvm::Type::IntegerTyID: { + if (unlikely(!is_integer(p))) { + printf("Bad argument type %u\n", i); return Scheme->F; } - int width = arg.getType()->getPrimitiveSizeInBits(); - fargs[i].IntVal = llvm::APInt(width, ivalue(p)); - } else if (is_real(p)) { - if (arg.getType()->getTypeID() == llvm::Type::FloatTyID) { - fargs[i].FloatVal = rvalue(p); - } else if (arg.getType()->getTypeID() == llvm::Type::DoubleTyID) { - fargs[i].DoubleVal = rvalue(p); - } else { - printf("Bad argument type %i\n",i); + argValues.push_back({ArgValue::Int, argTy, static_cast(ivalue(p)), 0.0, 0.0f, nullptr}); + break; + } + case llvm::Type::FloatTyID: { + if (unlikely(!is_real(p))) { + printf("Bad argument type %u\n", i); return Scheme->F; } - } else if (is_string(p)) { - if (unlikely(arg.getType()->getTypeID() != llvm::Type::PointerTyID)) { - printf("Bad argument type %i\n",i); + float f = static_cast(rvalue(p)); + argValues.push_back({ArgValue::Float, argTy, 0u, 0.0, f, nullptr}); + break; + } + case llvm::Type::DoubleTyID: { + if (unlikely(!is_real(p))) { + printf("Bad argument type %u\n", i); return Scheme->F; } - fargs[i].PointerVal = string_value(p); - } else if (is_cptr(p)) { - if (unlikely(arg.getType()->getTypeID() != llvm::Type::PointerTyID)) { - printf("Bad argument type %i\n",i); + argValues.push_back({ArgValue::Double, argTy, 0u, rvalue(p), 0.0f, nullptr}); + break; + } + case llvm::Type::PointerTyID: { + void* rawPtr = nullptr; + if (is_string(p)) { + rawPtr = static_cast(string_value(p)); + } else if (is_cptr(p)) { + rawPtr = cptr_value(p); + } else { + printf("Bad argument type %u\n", i); return Scheme->F; } - fargs[i].PointerVal = cptr_value(p); - } else if (unlikely(is_closure(p))) { - printf("Bad argument at index %i you can't pass in a scheme closure.\n",i); + argValues.push_back({ArgValue::Ptr, argTy, 0u, 0.0, 0.0f, rawPtr}); + break; + } + default: + printf("Unsupported argument type at index %u\n", i); return Scheme->F; + } + } + + const auto& DL = extemp::EXTLLVM::JIT->getDataLayout(); + std::string stubName = "__extemp_call_stub_" + std::to_string(CALL_STUB_COUNTER.fetch_add(1)); + std::unique_ptr module; + + // Build a tiny stub inside the thread-safe context. + extemp::EXTLLVM::getThreadSafeContext().withContextDo([&](llvm::LLVMContext* ctx) { + auto ptrIntTy = llvm::Type::getIntNTy(*ctx, DL.getPointerSizeInBits()); + + std::vector argConsts; + argConsts.reserve(lgth); + + for (const auto& av : argValues) { + switch (av.kind) { + case ArgValue::Int: + argConsts.push_back(llvm::ConstantInt::get(av.ty, av.intVal)); + break; + case ArgValue::Float: + argConsts.push_back(llvm::ConstantFP::get(av.ty, av.floatVal)); + break; + case ArgValue::Double: + argConsts.push_back(llvm::ConstantFP::get(av.ty, av.doubleVal)); + break; + case ArgValue::Ptr: { + auto ptrAsInt = llvm::ConstantInt::get(ptrIntTy, reinterpret_cast(av.ptrVal)); + argConsts.push_back(llvm::ConstantExpr::getIntToPtr(ptrAsInt, av.ty)); + break; + } + } + } + + module = std::make_unique(stubName + "_module", *ctx); + module->setDataLayout(DL); + + auto stubType = llvm::FunctionType::get(funcType->getReturnType(), false); + auto stubFunc = llvm::Function::Create(stubType, llvm::Function::ExternalLinkage, stubName, module.get()); + stubFunc->setCallingConv(func->getCallingConv()); + + auto entryBB = llvm::BasicBlock::Create(*ctx, "entry", stubFunc); + llvm::IRBuilder<> builder(entryBB); + + auto targetAddrConst = llvm::ConstantInt::get(ptrIntTy, addr); + auto targetPtr = llvm::ConstantExpr::getIntToPtr(targetAddrConst, funcType->getPointerTo()); + llvm::FunctionCallee callee(funcType, targetPtr); + + auto callInst = builder.CreateCall(callee, argConsts); + callInst->setCallingConv(func->getCallingConv()); + + if (funcType->getReturnType()->isVoidTy()) { + builder.CreateRetVoid(); } else { - printf("Bad argument at index %i\n",i); - return Scheme->F; + builder.CreateRet(callInst); } + }); + + if (!module) { + return Scheme->F; + } + + // JIT the stub + auto TSM = llvm::orc::ThreadSafeModule(std::move(module), extemp::EXTLLVM::getThreadSafeContext()); + if (auto err = extemp::EXTLLVM::addTrackedModule(std::move(TSM), {stubName})) { + std::cerr << "Failed to JIT call stub: " << llvm::toString(std::move(err)) << std::endl; + return Scheme->F; } - llvm::GenericValue gv = EE->runFunction(func, fargs); - switch(func->getReturnType()->getTypeID()) { - case llvm::Type::FloatTyID: - return mk_real(Scheme, gv.FloatVal); - case llvm::Type::DoubleTyID: - return mk_real(Scheme, gv.DoubleVal); - case llvm::Type::IntegerTyID: - return mk_integer(Scheme, gv.IntVal.getZExtValue()); // getRawData()); - case llvm::Type::PointerTyID: - return mk_cptr(Scheme, gv.PointerVal); - case llvm::Type::VoidTyID: + + auto stubAddr = EXTLLVM::getFunctionAddress(stubName); + if (!stubAddr) { + printf("Failed to resolve call stub\n"); + return Scheme->F; + } + + // Call the stub and marshal the result back to Scheme. + auto retTy = funcType->getReturnType(); + switch (retTy->getTypeID()) { + case llvm::Type::FloatTyID: { + using StubFn = float(*)(); + float res = reinterpret_cast(stubAddr)(); + return mk_real(Scheme, res); + } + case llvm::Type::DoubleTyID: { + using StubFn = double(*)(); + double res = reinterpret_cast(stubAddr)(); + return mk_real(Scheme, res); + } + case llvm::Type::IntegerTyID: { + auto intTy = llvm::cast(retTy); + unsigned width = intTy->getBitWidth(); + uint64_t mask = (width >= 64) ? ~uint64_t(0) : ((uint64_t(1) << width) - 1); + + using StubFn = uint64_t(*)(); + uint64_t res = reinterpret_cast(stubAddr)() & mask; + return mk_integer(Scheme, res); + } + case llvm::Type::PointerTyID: { + using StubFn = void*(*)(); + void* res = reinterpret_cast(stubAddr)(); + return mk_cptr(Scheme, res); + } + case llvm::Type::VoidTyID: { + using StubFn = void(*)(); + reinterpret_cast(stubAddr)(); return Scheme->T; + } default: + printf("Unsupported return type for compiled call\n"); return Scheme->F; } } @@ -320,7 +446,7 @@ static pointer llvm_convert_float_constant(scheme* Scheme, pointer Args) if (floatin[1] == 'x') { return pair_car(Args); } - llvm::APFloat apf(llvm::APFloat::IEEEsingle, llvm::StringRef(floatin)); + llvm::APFloat apf(llvm::APFloat::IEEEsingle(), llvm::StringRef(floatin)); // TODO: if necessary, checks for inf/nan can be done here auto ival(llvm::APInt::doubleToBits(apf.convertToFloat())); return mk_string(Scheme, (std::string("0x") + llvm::utohexstr(ival.getLimitedValue(), true)).c_str()); @@ -333,7 +459,7 @@ static pointer llvm_convert_double_constant(scheme* Scheme, pointer Args) if (floatin[1] == 'x') { return pair_car(Args); } - llvm::APFloat apf(llvm::APFloat::IEEEdouble, llvm::StringRef(floatin)); + llvm::APFloat apf(llvm::APFloat::IEEEdouble(), llvm::StringRef(floatin)); // TODO: if necessary, checks for inf/nan can be done here auto ival(llvm::APInt::doubleToBits(apf.convertToFloat())); return mk_string(Scheme, (std::string("0x") + llvm::utohexstr(ival.getLimitedValue(), true)).c_str()); @@ -376,7 +502,10 @@ static pointer printLLVMModule(scheme* Scheme, pointer Args) // TODO: This isn't ss << *val; printf("At address: %p\n%s\n",val, ss.str().c_str()); } else { - ss << *extemp::EXTLLVM::M; + // Print all modules. + for (auto module : EXTLLVM::getModules()) { + ss << *module; + } } printf("%s", ss.str().c_str()); return Scheme->T; @@ -475,20 +604,35 @@ static pointer llvm_disasm(scheme* Scheme, pointer Args) return mk_string(Scheme, extemp::EXTLLVM::llvm_disassemble(fptr, syntax)); } +static void registerJITSymbol(const char* name, void* addr) { + if (!EXTLLVM::JIT) return; + auto& ES = EXTLLVM::JIT->getExecutionSession(); + auto& JD = EXTLLVM::JIT->getMainJITDylib(); + + llvm::orc::SymbolMap Symbols; + Symbols[ES.intern(name)] = { + llvm::orc::ExecutorAddr::fromPtr(addr), + llvm::JITSymbolFlags::Exported + }; + + auto err = JD.define(llvm::orc::absoluteSymbols(std::move(Symbols))); + if (err) { + llvm::consumeError(std::move(err)); + } +} + static pointer bind_symbol(scheme* Scheme, pointer Args) { auto library(cptr_value(pair_car(Args))); auto sym(string_value(pair_cadr(Args))); - llvm::ExecutionEngine* EE = EXTLLVM::EE; - llvm::MutexGuard locked(EE->lock); #ifdef _WIN32 auto ptr(reinterpret_cast(GetProcAddress(reinterpret_cast(library), sym))); #else auto ptr(dlsym(library, sym)); #endif if (likely(ptr)) { - EE->updateGlobalMapping(sym, reinterpret_cast(ptr)); + registerJITSymbol(sym, ptr); return Scheme->T; } return Scheme->F; @@ -498,11 +642,14 @@ static pointer update_mapping(scheme* Scheme, pointer Args) { auto sym(string_value(pair_car(Args))); auto ptr(cptr_value(pair_cadr(Args))); - llvm::ExecutionEngine* EE = EXTLLVM::EE; - llvm::MutexGuard locked(EE->lock); - // returns previous value of the mapping, or NULL if not set - auto oldval(EE->updateGlobalMapping(sym, reinterpret_cast(ptr))); - return mk_cptr(Scheme, reinterpret_cast(oldval)); + + // Extempore doesn't track arbitrary symbol addresses under ORC. + // Return 0 for "old". + uint64_t oldaddr = 0; + + registerJITSymbol(sym, ptr); + + return mk_cptr(Scheme, reinterpret_cast(oldaddr)); } static std::unordered_map LLVM_ALIAS_TABLE; @@ -548,13 +695,15 @@ static pointer get_named_type(scheme* Scheme, pointer Args) return Scheme->NIL; } -static pointer get_global_module(scheme* Scheme, pointer Args) +static pointer list_modules(scheme* Scheme, pointer Args) { - auto m(EXTLLVM::M); - if (!m) { - return Scheme->F; + pointer p = Scheme->NIL; + + for (auto module : EXTLLVM::getModules()) { + EnvInjector injector(Scheme, p); + p = cons(Scheme, mk_cptr(Scheme, module), p); } - return mk_cptr(Scheme, m); + return reverse_in_place(Scheme, Scheme->NIL, p); } static pointer export_llvmmodule_bitcode(scheme* Scheme, pointer Args) @@ -590,12 +739,12 @@ static pointer export_llvmmodule_bitcode(scheme* Scheme, pointer Args) fout.close(); #else std::error_code errcode; - llvm::raw_fd_ostream ss(filename, errcode, llvm::sys::fs::F_RW); + llvm::raw_fd_ostream ss(filename, errcode, llvm::sys::fs::OF_None); if (errcode) { std::cout << errcode.message() << std::endl; return Scheme->F; } - llvm::WriteBitcodeToFile(m,ss); + llvm::WriteBitcodeToFile(*m, ss); #endif return Scheme->T; } @@ -622,6 +771,7 @@ static pointer export_llvmmodule_bitcode(scheme* Scheme, pointer Args) { "llvm:run", &call_compiled }, \ { "llvm:convert-float", &llvm_convert_float_constant }, \ { "llvm:convert-double", &llvm_convert_double_constant }, \ + { "llvm:list-modules", &list_modules }, \ { "llvm:count", &llvm_count }, \ { "llvm:count-set", &llvm_count_set }, \ { "llvm:count++", &llvm_count_inc }, \ @@ -637,5 +787,4 @@ static pointer export_llvmmodule_bitcode(scheme* Scheme, pointer Args) { "llvm:add-llvm-alias", &add_llvm_alias }, \ { "llvm:get-llvm-alias", &get_llvm_alias }, \ { "llvm:get-named-type", &get_named_type }, \ - { "llvm:get-global-module", &get_global_module }, \ { "llvm:export-module", &export_llvmmodule_bitcode } From f5f17e62ccb008334251970233506de795023f55 Mon Sep 17 00:00:00 2001 From: soulofmischief <30357883+soulofmischief@users.noreply.github.com> Date: Thu, 18 Dec 2025 18:43:59 -0600 Subject: [PATCH 10/14] Support optimization configuration --- include/EXTLLVM.h | 1 + src/EXTLLVM.cpp | 3 +++ src/Extempore.cpp | 7 ++++++- src/SchemeFFI.cpp | 13 +++++++++++++ src/ffi/llvm.inc | 19 ++++++++++++++++++- 5 files changed, 41 insertions(+), 2 deletions(-) diff --git a/include/EXTLLVM.h b/include/EXTLLVM.h index 4773a1d5..3c66484a 100644 --- a/include/EXTLLVM.h +++ b/include/EXTLLVM.h @@ -128,6 +128,7 @@ llvm::Error addTrackedModule(llvm::orc::ThreadSafeModule TSM, const std::vector< extern int64_t LLVM_COUNT; extern bool OPTIMIZE_COMPILES; extern bool VERIFY_COMPILES; +extern int OPTIMIZATION_LEVEL; // 0=O0, 1=O1, 2=O2, 3=O3 extern std::vector Ms; void initLLVM(); diff --git a/src/EXTLLVM.cpp b/src/EXTLLVM.cpp index 362ca768..1641c081 100644 --- a/src/EXTLLVM.cpp +++ b/src/EXTLLVM.cpp @@ -53,6 +53,8 @@ #include "llvm/IR/Verifier.h" #include "llvm/Passes/PassBuilder.h" +#include "llvm/Passes/OptimizationLevel.h" + #include "llvm/Support/SourceMgr.h" #include "llvm/Support/TargetSelect.h" #include "llvm/Support/raw_ostream.h" @@ -606,6 +608,7 @@ std::vector Ms; int64_t LLVM_COUNT = 0l; bool OPTIMIZE_COMPILES = true; bool VERIFY_COMPILES = true; +int OPTIMIZATION_LEVEL = 2; uint64_t getFunctionAddress(const std::string& name) { if (!JIT) return 0; diff --git a/src/Extempore.cpp b/src/Extempore.cpp index ec5842b8..293ddd2c 100644 --- a/src/Extempore.cpp +++ b/src/Extempore.cpp @@ -125,7 +125,7 @@ enum { OPT_COMPILE_STR, OPT_SHAREDIR, OPT_NOBASE, OPT_SAMPLERATE, OPT_FRAMES, OPT_PORT, OPT_TERM, OPT_NO_AUDIO, OPT_TIME_DIV, OPT_DEVICE, OPT_IN_DEVICE, OPT_DEVICE_NAME, OPT_IN_DEVICE_NAME, OPT_PRT_DEVICES, OPT_REALTIME, OPT_ARCH, OPT_CPU, OPT_ATTR, - OPT_LATENCY, + OPT_LATENCY, OPT_LEVEL, OPT_HELP }; @@ -155,6 +155,7 @@ CSimpleOptA::SOption g_rgOptions[] = { { OPT_ARCH, "--arch", SO_REQ_SEP }, { OPT_CPU, "--cpu", SO_REQ_SEP }, { OPT_ATTR, "--attr", SO_MULTI }, + { OPT_LEVEL, "--opt-level", SO_REQ_SEP }, { OPT_HELP, "--help", SO_NONE }, SO_END_OF_OPTIONS }; @@ -300,6 +301,9 @@ EXPORT int extempore_init(int argc, char** argv) case OPT_ATTR: extemp::UNIV::ATTRS.push_back(args.OptionArg()); break; + case OPT_LEVEL: + extemp::EXTLLVM::OPTIMIZATION_LEVEL = atoi(args.OptionArg()); + break; case OPT_HELP: default: std::cout << "Extempore's command line options: " << std::endl; @@ -310,6 +314,7 @@ EXPORT int extempore_init(int argc, char** argv) std::cout << " --sharedir: location of the Extempore share dir (which contains runtime/, libs/, examples/, etc.)" << std::endl; std::cout << " --runtime: [deprecated] use --sharedir instead" << std::endl; std::cout << " --nobase: don't load base lib on startup" << std::endl; + std::cout << " --opt-level: LLVM optimization level 0-3" << std::endl; std::cout << " --samplerate: audio samplerate" << std::endl; std::cout << " --frames: attempts to force frames [1024]" << std::endl; std::cout << " --channels: attempts to force num of output audio channels" << std::endl; diff --git a/src/SchemeFFI.cpp b/src/SchemeFFI.cpp index 2c9cf200..d0d50641 100644 --- a/src/SchemeFFI.cpp +++ b/src/SchemeFFI.cpp @@ -51,6 +51,7 @@ #include "llvm/ExecutionEngine/Orc/ThreadSafeModule.h" #include "llvm/Passes/PassBuilder.h" +#include "llvm/Passes/OptimizationLevel.h" #include "llvm/IR/CallingConv.h" #include "llvm/IR/Constants.h" @@ -637,6 +638,18 @@ static llvm::Module* jitCompile(const std::string& String) PB.registerFunctionAnalyses(FAM); PB.registerLoopAnalyses(LAM); PB.crossRegisterProxies(LAM, FAM, CGAM, MAM); + + // Use configurable optimization level. + llvm::OptimizationLevel optLevel; + switch (EXTLLVM::OPTIMIZATION_LEVEL) { + case 0: optLevel = llvm::OptimizationLevel::O0; break; + case 1: optLevel = llvm::OptimizationLevel::O1; break; + case 3: optLevel = llvm::OptimizationLevel::O3; break; + case 2: + default: optLevel = llvm::OptimizationLevel::O2; break; + } + llvm::ModulePassManager MPM = PB.buildPerModuleDefaultPipeline(optLevel); + MPM.run(*newModule, MAM); } // Verify the module. diff --git a/src/ffi/llvm.inc b/src/ffi/llvm.inc index 66d81751..ee1d5e47 100644 --- a/src/ffi/llvm.inc +++ b/src/ffi/llvm.inc @@ -1,7 +1,23 @@ static pointer optimizeCompiles(scheme* Scheme, pointer Args) { + if (Args == Scheme->NIL) { + return EXTLLVM::OPTIMIZE_COMPILES ? Scheme->T : Scheme->F; + } EXTLLVM::OPTIMIZE_COMPILES = (pair_car(Args) == Scheme->T); - return Scheme->T; + return EXTLLVM::OPTIMIZE_COMPILES ? Scheme->T : Scheme->F; +} + +static pointer optimizationLevel(scheme* Scheme, pointer Args) +{ + if (Args == Scheme->NIL) { + return mk_integer(Scheme, EXTLLVM::OPTIMIZATION_LEVEL); + } + // Set optimization level (0-3) + int level = ivalue(pair_car(Args)); + if (level < 0) level = 0; + if (level > 3) level = 3; + EXTLLVM::OPTIMIZATION_LEVEL = level; + return mk_integer(Scheme, level); } static pointer jitCompileIRString(scheme* Scheme, pointer Args) @@ -751,6 +767,7 @@ static pointer export_llvmmodule_bitcode(scheme* Scheme, pointer Args) #define LLVM_DEFS \ { "llvm:optimize", &optimizeCompiles }, \ + { "llvm:optimization-level", &optimizationLevel }, \ { "llvm:jit-compile-ir-string", &jitCompileIRString}, \ { "llvm:ffi-set-name", &ff_set_name }, \ { "llvm:ffi-get-name", &ff_get_name }, \ From 8a86a53426820739405904ab57baf45795dacffe Mon Sep 17 00:00:00 2001 From: soulofmischief <30357883+soulofmischief@users.noreply.github.com> Date: Thu, 18 Dec 2025 18:45:45 -0600 Subject: [PATCH 11/14] Use optimization level 3 for AOT compilation --- runtime/llvmti.xtm | 31 +++++++++++++++++++++++-------- 1 file changed, 23 insertions(+), 8 deletions(-) diff --git a/runtime/llvmti.xtm b/runtime/llvmti.xtm index 9eb7f5ce..49220ee0 100644 --- a/runtime/llvmti.xtm +++ b/runtime/llvmti.xtm @@ -3198,12 +3198,13 @@ (asdll? (if (sys:cmdarg "dll") #t #f)) (file-no-extension (filename-strip-extension (filename-from-path file-path))) (aot-compilation-file (string-append file-no-extension ".exe")) - (in-file-port (open-input-file (sanitize-platform-path file-path)))) + (in-file-port (open-input-file (sanitize-platform-path file-path))) + (original-optimize-flag (llvm:optimize))) (set! *impc:aot:current-output-port* #t) ;;(open-output-file aot-compilation-file)) (set! *impc:aot:func-defs-in-mod* '()) (if (impc:aot:currently-compiling?) (begin - (llvm:optimize #t); // should this be restored later? + (llvm:optimize #t) ;; this is the 'success' branch (set! *impc:aot:current-lib-name* file-no-extension) ;; (impc:aot:insert-header libname-no-extension) @@ -3254,10 +3255,13 @@ (impc:compiler:print-compiler-error "Failed compiling LLVM IR")) (impc:aot:compile-exe file-no-extension module libs asdll?)) (set! *impc:aot:current-output-port* #f) + ;; Restore original optimization flag + (llvm:optimize original-optimize-flag) ;; (close-port *impc:aot:current-output-port*) (quit 0)) (begin (begin (print-with-colors 'black 'red #t (print " Error ")) + (llvm:optimize original-optimize-flag) (print "\n\ncannot write AOT-compilation file at " aot-compilation-file-path "\n") (quit 2))))))) @@ -3282,7 +3286,8 @@ (llas-path (sanitize-platform-path (string-append (get-llvm-path) "/bin/llvm-as"))) (in-file-port (or (open-input-file (sanitize-platform-path lib-path)) - (open-input-file (sanitize-platform-path (string-append (sys:share-dir) "/" lib-path)))))) + (open-input-file (sanitize-platform-path (string-append (sys:share-dir) "/" lib-path))))) + (original-optimize-flag (llvm:optimize))) (if (not in-file-port) (begin (print-with-colors 'black 'red #t (print "Error:")) @@ -3313,7 +3318,7 @@ (set! *impc:aot:func-defs-in-mod* '()) (if (impc:aot:currently-compiling?) (begin - (llvm:optimize #t); // should this be restored later? + (llvm:optimize #t) ;; this is the 'success' branch (set! *impc:aot:current-lib-name* libname-no-extension) ;; module name for globals @@ -3334,13 +3339,16 @@ (print "Successfully wrote file to ") (print-with-colors 'green 'default #f (print aot-compilation-file-path "\n\n")) (impc:aot:print-compilation-details start-time) + (llvm:optimize original-optimize-flag) (quit 0)) (begin (print-with-colors 'black 'red #t (print " Error ")) (print "\n\nsomething went wrong in writing the output file ") (print-with-colors 'red 'faultde #t (print aot-compilation-file-path "\n")) + (llvm:optimize original-optimize-flag) (quit 1)))) (begin (print-with-colors 'black 'red #t (print " Error ")) (print "\n\ncannot write file at " aot-compilation-file-path "\n") + (llvm:optimize original-optimize-flag) (quit 2)))))))))) @@ -3359,7 +3367,9 @@ (libname (sanitize-platform-path (filename-from-path lib-path))) (libname-no-extension (string-append "xtm" (filename-strip-extension libname))) (output-dir (sanitize-platform-path (string-append (sys:share-dir) "/libs/aot-cache"))) - (aot-compilation-file-path (sanitize-platform-path (string-append output-dir "/" libname)))) + (aot-compilation-file-path (sanitize-platform-path (string-append output-dir "/" libname))) + (original-opt-level (llvm:optimization-level)) + (original-optimize-flag (llvm:optimize))) (if (not (sys:load-preload-check (string->symbol libname-no-extension))) (begin (print "AOT-compilation file not written ") (close-port *impc:aot:current-output-port*) @@ -3376,7 +3386,9 @@ (set! *impc:aot:func-defs-in-mod* '()) (if (impc:aot:currently-compiling?) (begin - (llvm:optimize #t); // should this be restored later? + (llvm:optimize #t) + ;; Use O3 optimization for AOT compilation. + (llvm:optimization-level 3) ;; this is the 'success' branch (set! *impc:aot:current-lib-name* libname-no-extension) ;; (impc:aot:insert-header libname-no-extension) @@ -3394,8 +3406,11 @@ (print "\n")) (let ((module (impc:compiler:flush-jit-compilation-queue))) (if (not module) - (impc:compiler:print-compiler-error "Failed compiling LLVM IR")) - (impc:aot:compile-module libname-no-extension module)) + (impc:compiler:print-compiler-error "Failed compiling LLVM IR") + (impc:aot:compile-module libname-no-extension module))) + ;; Restore configured optimization level and flag after AOT completes + (llvm:optimization-level original-opt-level) + (llvm:optimize original-optimize-flag) ;; (impc:aot:insert-footer libname-no-extension) (close-port *impc:aot:current-output-port*) (set! *impc:aot:current-lib-name* "xtmdylib") From 42d4e852e7e52e6b1f204165b15140487ad44216 Mon Sep 17 00:00:00 2001 From: soulofmischief <30357883+soulofmischief@users.noreply.github.com> Date: Thu, 18 Dec 2025 18:46:04 -0600 Subject: [PATCH 12/14] Include homebrew directories --- runtime/llvmti.xtm | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/runtime/llvmti.xtm b/runtime/llvmti.xtm index 49220ee0..38ac1b79 100644 --- a/runtime/llvmti.xtm +++ b/runtime/llvmti.xtm @@ -11432,7 +11432,16 @@ xtlang's `let' syntax is the same as Scheme" (sys:command-output "echo $LD_LIBRARY_PATH") ":") - '("/usr/local/lib/" "/usr/lib/" "/opt/local/lib/" "/usr/lib/x86_64-linux-gnu"))) + '("/usr/local/lib/" + "/usr/lib/" + "/opt/local/lib/" + ;; Linux + "/usr/lib/x86_64-linux-gnu" + "/usr/lib/aarch64-linux-gnu" + ;; macOS + "/opt/homebrew/lib/" + "/usr/local/Cellar/" + "/opt/homebrew/Cellar/"))) (list (sanitize-platform-path (string-append "C:/Windows/System32/" path))))))) (if (null? candidate-paths) #f From 368006c8b5ce0fa6376d2ee1409ebffc8415a47f Mon Sep 17 00:00:00 2001 From: soulofmischief <30357883+soulofmischief@users.noreply.github.com> Date: Thu, 18 Dec 2025 22:44:49 -0600 Subject: [PATCH 13/14] Optimize performance --- runtime/llvmir.xtm | 86 ++++++++++++++--------- runtime/llvmti.xtm | 171 +++++++++++++++++++++++---------------------- 2 files changed, 138 insertions(+), 119 deletions(-) diff --git a/runtime/llvmir.xtm b/runtime/llvmir.xtm index 176ce1c9..9cee1bd7 100644 --- a/runtime/llvmir.xtm +++ b/runtime/llvmir.xtm @@ -1202,11 +1202,14 @@ ", ")) os) (emit (impc:ir:get-type-str (car t)) " (" os)) - (dotimes (i (length args)) - (if (> i 0) (emit ", " os)) - (if (symbol? (list-ref args i)) - (impc:compiler:print-could-not-resolve-type-error (list-ref args i))) - (emit (impc:ir:get-type-str (list-ref args i)) os)) + (let loop ((args-remaining args) (first? #t)) + (if (not (null? args-remaining)) + (let ((arg (car args-remaining))) + (if (not first?) (emit ", " os)) + (if (symbol? arg) + (impc:compiler:print-could-not-resolve-type-error arg)) + (emit (impc:ir:get-type-str arg) os) + (loop (cdr args-remaining) #f)))) (emit ")" os) (impc:ir:strip-space os)))) @@ -1216,9 +1219,12 @@ (let* ((os (make-string 0)) (args t)) (emit "{"os) - (dotimes (i (length args)) - (if (> i 0) (emit ", " os)) - (emit (impc:ir:get-type-str (cdr (list-ref args i))) os)) + (let loop ((args-remaining args) (first? #t)) + (if (not (null? args-remaining)) + (let ((arg (car args-remaining))) + (if (not first?) (emit ", " os)) + (emit (impc:ir:get-type-str (cdr arg)) os) + (loop (cdr args-remaining) #f)))) (emit "}" os) (impc:ir:strip-space os)))) @@ -1228,9 +1234,12 @@ (let* ((os (make-string 0)) (args t)) (emit "{"os) - (dotimes (i (length args)) - (if (> i 0) (emit ", " os)) - (emit (impc:ir:get-type-str (cdr (list-ref args i))) "*" os)) + (let loop ((args-remaining args) (first? #t)) + (if (not (null? args-remaining)) + (let ((arg (car args-remaining))) + (if (not first?) (emit ", " os)) + (emit (impc:ir:get-type-str (cdr arg)) "*" os) + (loop (cdr args-remaining) #f)))) (emit "}" os) (impc:ir:strip-space os)))) @@ -1238,13 +1247,14 @@ (define impc:ir:make-arglist-str (lambda (args . with-symbol?) (let* ((os (make-string 0))) - (dotimes (i (length args)) - (if (> i 0) (emit ", " os)) - (let ((arg (list-ref args i))) - ;(print 'arg: arg) + (let loop ((args-remaining args) (first? #t)) + (if (not (null? args-remaining)) + (let ((arg (car args-remaining))) + (if (not first?) (emit ", " os)) (emit (impc:ir:get-type-str (cdr arg)) os) (if (car with-symbol?) - (emit " %" (symbol->string (car arg)) os)))) + (emit " %" (symbol->string (car arg)) os)) + (loop (cdr args-remaining) #f)))) (impc:ir:strip-space os)))) @@ -1362,9 +1372,9 @@ (emit "\n; malloc closure address table\n" os2) (emit (impc:ir:gname "addytable" "%clsvar*") " = call %clsvar* @new_address_table()\n" os2) (define table (impc:ir:gname)) - (define ptridx 0) - (dotimes (i (length env)) - (let* ((e (list-ref env i)) + (let loop ((env-remaining env) (ptridx 0)) + (if (not (null? env-remaining)) + (let* ((e (car env-remaining)) (varname (if (regex:match? (symbol->string (car e)) "__sub$") (cadr (regex:matched (symbol->string (car e)) "(.*)__sub$")) (symbol->string (car e)))) @@ -1388,12 +1398,13 @@ "%clsvar* " (car table) ")\n" os2) (set! table (impc:ir:gname)) - (set! ptridx (+ ptridx (/ (sys:pointer-size) 8))))) ; need it as bytes + (loop (cdr env-remaining) (+ ptridx (/ (sys:pointer-size) 8)))))) ; need it as bytes (emit (impc:ir:gname "address-table" "i8*") " = bitcast %clsvar* " (car table) " to i8*\n" os2) ;; add data to environment structure (emit "; add data to environment\n" os1) - (dotimes (i (length env)) - (let* ((e (list-ref env i)) + (let loop ((env-remaining env) (i 0)) + (if (not (null? env-remaining)) + (let* ((e (car env-remaining)) (alloc? (not (regex:match? (symbol->string (car e)) "__sub$")))) ;; first fixup mangled name if not allocing (if (not alloc?) (set! e (cons (string->symbol (car (regex:split (symbol->string (car e)) "__sub$"))) @@ -1411,7 +1422,8 @@ ;;(emit "call ccc void @llvm_print_pointer(i8* " (car (impc:ir:gname)) ")\n" os1) (emit "store " (cadr t) " %" (symbol->string (car e)) "Ptr" ", " - (cadr t) "* " (car (impc:ir:gname "tmp_envptr")) "\n\n" os1))) + (cadr t) "* " (car (impc:ir:gname "tmp_envptr")) "\n\n" os1) + (loop (cdr env-remaining) (+ i 1))))) (emit "\n" os1) @@ -1501,8 +1513,9 @@ (begin (emit "; setup environment\n" os) (emit (string-append "%impenv = bitcast i8* %_impenv to " (impc:ir:make-struct-str-env env) "*\n") os) - (dotimes (i (length env)) - (let ((e (list-ref env i))) + (let loop ((env-remaining env) (i 0)) + (if (not (null? env-remaining)) + (let ((e (car env-remaining))) ;; need to strip __sub's (if (regex:match? (symbol->string (car e)) "__sub$") (set! e (cons (string->symbol (car (regex:split (symbol->string (car e)) "__sub$"))) @@ -1514,11 +1527,13 @@ (emit (string-append "%" (symbol->string (car e)) "Ptr = load " (impc:ir:get-type-str (cdr e)) "*, " (impc:ir:get-type-str (cdr e)) "** %" - (symbol->string (car e)) "Ptr_\n") os))))) + (symbol->string (car e)) "Ptr_\n") os) + (loop (cdr env-remaining) (+ i 1))))))) ;; next we pull the function arguments (emit "\n; setup arguments\n" os) - (dotimes (i (length args)) - (let* ((a (list-ref args i))) + (let loop ((args-remaining args)) + (if (not (null? args-remaining)) + (let* ((a (car args-remaining))) (set! *impc:ir:sym-name-stack* (cons (car a) *impc:ir:sym-name-stack*)) (if (> allocate-mem? 0) (begin ;; (println 'yes: allocate-mem? 'mem: ast) @@ -1536,7 +1551,8 @@ (emit "%" (symbol->string (car a)) "Ptr = bitcast i8* %dat_" (symbol->string (car a)) " to " (impc:ir:get-type-str (cdr a)) "*\n" os)) (emit "%" (symbol->string (car a)) "Ptr = alloca " (impc:ir:get-type-str (cdr a)) "\n" os)) (emit (string-append "store " (impc:ir:get-type-str (cdr a)) " %" (symbol->string (car a)) - ", " (impc:ir:get-type-str (cdr a)) "* %" (symbol->string (car a)) "Ptr\n") os))) + ", " (impc:ir:get-type-str (cdr a)) "* %" (symbol->string (car a)) "Ptr\n") os) + (loop (cdr args-remaining))))) (emit "\n" os) ;; compile body ;; (println '_compin: *impc:ir:sym-name-stack*) @@ -1611,8 +1627,9 @@ ;; next we pull the function arguments (emit "\n; setup arguments\n" os) - (dotimes (i (length args)) - (let* ((a (list-ref args i))) + (let loop ((args-remaining args)) + (if (not (null? args-remaining)) + (let* ((a (car args-remaining))) (set! *impc:ir:sym-name-stack* (cons (car a) *impc:ir:sym-name-stack*)) (if (> allocate-mem? 0) (begin ;; (println 'yes: allocate-mem? 'mem: ast) @@ -1630,7 +1647,8 @@ (emit "%" (symbol->string (car a)) "Ptr = bitcast i8* %dat_" (symbol->string (car a)) " to " (impc:ir:get-type-str (cdr a)) "*\n" os)) (emit "%" (symbol->string (car a)) "Ptr = alloca " (impc:ir:get-type-str (cdr a)) "\n" os)) (emit (string-append "store " (impc:ir:get-type-str (cdr a)) " %" (symbol->string (car a)) - ", " (impc:ir:get-type-str (cdr a)) "* %" (symbol->string (car a)) "Ptr\n") os))) + ", " (impc:ir:get-type-str (cdr a)) "* %" (symbol->string (car a)) "Ptr\n") os) + (loop (cdr args-remaining))))) (emit "\n" os) ;; compile body ;; (println '_compin: *impc:ir:sym-name-stack*) @@ -2314,7 +2332,7 @@ (impc:compiler:print-bad-type-error (car ast) "remember that closures must be pointers") (impc:compiler:print-bad-type-error (car ast) "bad type for closure"))))) ;;(recursive-call (if (eq? (car ast) (car *impc:ir:sym-name-stack*)) #t #f)) - (recursive-call (if (member (car ast) *impc:ir:sym-name-stack*) #t #f)) + (recursive-call (if (memq (car ast) *impc:ir:sym-name-stack*) #t #f)) (os (make-string 0)) (ftype (impc:ir:make-function-str functiontype #t)) (clstype (string-append "{i8*, i8*, " ftype "*}*")) @@ -2591,7 +2609,7 @@ (if global? ;; (impc:ti:globalvar-exists? (symbol->string (cadr ast))) ;; are we are setting a global variable? (emit (string-append "store " (cadr vv) " " (car vv) ", " (cadr vv) "* @" (symbol->string (cadr ast)) "\n") os) - (if (member (cadr ast) *impc:ir:sym-name-stack*) + (if (memq (cadr ast) *impc:ir:sym-name-stack*) ;; memq for symbols (emit (string-append "store " (cadr vv) " " (car vv) ", " (cadr vv) "* %" (symbol->string (cadr ast)) "Ptr\n") os) (impc:compiler:print-missing-identifier-error (cadr ast) 'variable))) diff --git a/runtime/llvmti.xtm b/runtime/llvmti.xtm index 38ac1b79..44df46b1 100644 --- a/runtime/llvmti.xtm +++ b/runtime/llvmti.xtm @@ -3497,7 +3497,7 @@ ;;(print 'ast: ast 'types: types) (cond ((null? ast) '()) ((atom? ast) ast) - ((member (car ast) *impc:lambdaslist*) + ((memq (car ast) *impc:lambdaslist*) (list* (car ast) ;; 'lambda (map (lambda (a) (if (and (list? a) @@ -3513,7 +3513,7 @@ a)) (cadr ast)) (f (cddr ast)))) - ((member (car ast) *impc:letslist*) + ((memq (car ast) *impc:letslist*) (list* (car ast) (map (lambda (a) (if (or (atom? a) @@ -3658,7 +3658,7 @@ (cond ((atom? ast) ast) ((null? ast) ast) ((list? ast) - (cond ((member (car ast) *impc:letslist*) + (cond ((memq (car ast) *impc:letslist*) ;; first find and replace all shadow vars (let* ((replace-pairs (cl:remove @@ -3694,7 +3694,7 @@ (cons (car newast) (cons (map (lambda (x) (cons (car x) (f (cdr x) fname))) (cadr newast)) (f (cddr newast) fname))))) - ((member (car ast) *impc:lambdaslist*) + ((memq (car ast) *impc:lambdaslist*) (let* ((replace-pairs (cl:remove #f @@ -4342,28 +4342,28 @@ Continue executing `body' forms until `test-expression' returns #f" ((eq? (car ast) 'free) (list 'free (list 'bitcast (impc:ti:first-transform (cadr ast) inbody?) 'i8*))) - ((member (car ast) '(vector_ref)) + ((memq (car ast) '(vector_ref)) (impc:ti:first-transform `(let ((v1 (alloc)) (v2 (vector ,@(cdr ast)))) (pset! v1 0 v2) v1) inbody?)) - ((member (car ast) '(array_ref)) + ((memq (car ast) '(array_ref)) (impc:ti:first-transform `(let ((a1 (alloc)) (a2 (array ,@(cdr ast)))) (pset! a1 0 a2) a1) inbody?)) - ((member (car ast) '(tuple_ref)) + ((memq (car ast) '(tuple_ref)) (impc:ti:first-transform `(let ((t1 (alloc)) (t2 (tuple ,@(cdr ast)))) (pset! t1 0 t2) t1) inbody?)) - ((member (car ast) '(vector)) + ((memq (car ast) '(vector)) `(make-vector ,@(map (lambda (x) (impc:ti:first-transform x inbody?)) (cdr ast)))) - ((member (car ast) '(array)) + ((memq (car ast) '(array)) `(make-array ,@(map (lambda (x) (impc:ti:first-transform x inbody?)) (cdr ast)))) - ((member (car ast) '(tuple)) + ((memq (car ast) '(tuple)) `(make-tuple ,@(map (lambda (x) (impc:ti:first-transform x inbody?)) (cdr ast)))) ((eq? (car ast) 'not) (impc:ti:first-transform (impc:ti:not (cadr ast)) inbody?)) - ((member (car ast) '(callback schedule)) + ((memq (car ast) '(callback schedule)) (impc:ti:first-transform (impc:ti:callback (impc:ti:first-transform (cdr ast) inbody?)) inbody?)) - ((and (member (car ast) *impc:mathbinaryaritylist*) + ((and (memq (car ast) *impc:mathbinaryaritylist*) (<> (length ast) 3)) (impc:ti:first-transform (impc:ti:binary-arity ast inbody?) inbody?)) - ((member (car ast) '(bitwise-not ~)) + ((memq (car ast) '(bitwise-not ~)) (impc:ti:bitwise-not-to-eor ast inbody?)) - ((member (car ast) *impc:lambdaslist*) + ((memq (car ast) *impc:lambdaslist*) (if inbody? (impc:ti:lambda ast) (cons (impc:ti:first-transform (car ast) inbody?) @@ -4388,7 +4388,7 @@ Continue executing `body' forms until `test-expression' returns #f" (list 'closure-refcheck (impc:ti:first-transform (cadr ast) inbody?) (symbol->string (caddr ast)))) - ((member (car ast) '(cast convert)) + ((memq (car ast) '(cast convert)) (if (= (length ast) 2) (impc:ti:first-transform (list (if (eq? (car ast) 'cast) 'bitcast @@ -4412,7 +4412,7 @@ Continue executing `body' forms until `test-expression' returns #f" ((eq? (car ast) 'doloop) (impc:ti:doloop ast inbody?)) ((eq? (car ast) 'dotimes) (impc:ti:dotimes ast inbody?)) ((eq? (car ast) 'while) (impc:ti:while ast inbody?)) - ((member (car ast) *impc:letslist*) + ((memq (car ast) *impc:letslist*) (cons (impc:ti:first-transform (car ast) inbody?) (cons (map (lambda (p) (list (impc:ti:first-transform (car p) #f) @@ -5649,7 +5649,7 @@ Continue executing `body' forms until `test-expression' returns #f" (equal? sym t)) 'exit (begin ;; (println 'update-var:> sym 'in: vars 'with: t 'kts: kts) - (if (member sym kts) ;; if in known types don't do anything + (if (memq sym kts) ;; if in known types don't do anything '() (if (and (not (assoc-strcmp sym vars)) (not (regex:match? (symbol->string sym) ":\\[")) @@ -5983,9 +5983,9 @@ Continue executing `body' forms until `test-expression' returns #f" (if (impc:ti:closure-exists? (symbol->string ast)) (list (cons (+ *impc:ir:closure* *impc:ir:pointer* *impc:ir:pointer*) (map impc:ir:get-type-from-str (impc:ti:get-closure-arg-types (symbol->string ast))))) (list (impc:ir:pointer-- (impc:ti:get-globalvar-type (symbol->string ast))))))))) - ;; (println '---------- (member ast kts) 'type: type (impc:ir:type? type)) + ;; (println '---------- (memq ast kts) 'type: type (impc:ir:type? type)) (if (and request? - (not (member ast kts)) ;; if we're in KTS then we should ignore requests! + (not (memq ast kts)) ;; if we're in KTS then we should ignore requests! (not (null? request?))) (if (null? type) (begin @@ -6014,8 +6014,8 @@ Continue executing `body' forms until `test-expression' returns #f" (if (equal? request? *impc:ir:notype*) (set! request? #f)) ;; if request is false (if (not request?) - (begin (if (member (cadr ast) kts) (set! request? (cdr (assoc-strcmp (cadr ast) vars)))) - (if (member (caddr ast) kts) (set! request? (cdr (assoc-strcmp (caddr ast) vars)))))) + (begin (if (memq (cadr ast) kts) (set! request? (cdr (assoc-strcmp (cadr ast) vars)))) + (if (memq (caddr ast) kts) (set! request? (cdr (assoc-strcmp (caddr ast) vars)))))) ;; now start type checking (let* ((n1 (cadr ast)) (n2 (caddr ast)) @@ -6923,7 +6923,7 @@ Continue executing `body' forms until `test-expression' returns #f" ;; (impc:compiler:print-compiler-error "no valid generic options available for: " ast))))) (impc:compiler:print-compiler-error (string-append "Return type mismatch for generic function which expected return type '" (cadr gen) "' and got named type '" (cadr req) "'") ast))))) ;; (println 'update 'return 'var 'with (impc:ti:update-var (cadr gpoly-type) vars kts (list request?))) - (if (not (member (cadr gpoly-type) vars)) + (if (not (assoc-strcmp (cadr gpoly-type) vars)) (set-cdr! vars (cons (list (cadr gpoly-type)) (cdr vars)))) (impc:ti:update-var (cadr gpoly-type) vars kts (list request?)))) (set! gpoly-type (cons (car gpoly-type) (cons request? (cddr gpoly-type)))))) @@ -8701,7 +8701,7 @@ xtlang's `let' syntax is the same as Scheme" (set! a (car a))) (if (and (impc:ir:type? a) (list? b) - (member a b)) + (memq a b)) (set! b a)) ;; (car (cadr ast)) should be a symbol that we want to update with a (if (not (symbol? (car (cadr ast)))) @@ -8855,13 +8855,13 @@ xtlang's `let' syntax is the same as Scheme" ((and (atom? ast) (symbol? ast)) (impc:ti:symbol-check ast vars kts request?)) ((and (atom? ast) (string? ast)) (impc:ti:string-check ast vars kts request?)) ((atom? ast) (impc:compiler:print-compiler-error "internal error unhandled atom" ast)) - ((and (list? ast) (member (car ast) *impc:letslist*)) (impc:ti:let-check ast vars kts request?)) - ((and (list? ast) (member (car ast) *impc:lambdaslist*)) (impc:ti:lambda-check ast vars kts request?)) - ((and (list? ast) (equal? (car ast) 't:)) + ((and (list? ast) (memq (car ast) *impc:letslist*)) (impc:ti:let-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) *impc:lambdaslist*)) (impc:ti:lambda-check ast vars kts request?)) + ((and (list? ast) (eq? (car ast) 't:)) (impc:ti:type-check (cadr ast) vars kts (impc:ir:get-type-from-pretty-str (symbol->string (caddr ast))))) - ((and (list? ast) (member (car ast) *impc:mathbinaryaritylist*)) + ((and (list? ast) (memq (car ast) *impc:mathbinaryaritylist*)) ;; '(* / + - % modulo bitwise-and bitwise-or bitwise-eor bitwise-shift-left bitwise-shift-right bitwise-not))) (let ((r (impc:ti:math-check ast vars kts request?))) (if (impc:ir:tuple? r) @@ -8893,52 +8893,52 @@ xtlang's `let' syntax is the same as Scheme" (set-car! ast m) (set! r (impc:ti:type-check ast vars kts request?))))) *impc:ir:i1*)) - ((and (list? ast) (member (car ast) *impc:mathintrinsicslist*)) (impc:ti:math-intrinsic-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(dotimes))) (impc:ti:dotimes-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(while))) (impc:ti:while-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(printf))) (impc:ti:printf-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(sprintf))) (impc:ti:sprintf-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(fprintf))) (impc:ti:fprintf-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(sscanf))) (impc:ti:sscanf-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(fscanf))) (impc:ti:fscanf-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(push_zone))) (impc:ti:push_zone-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(pop_zone))) (impc:ti:pop_zone-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(push_new_zone))) (impc:ti:push_new_zone-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(create_zone))) (impc:ti:create_zone-check ast vars kts request?)) - ;;((and (list? ast) (member (car ast) '(memzone))) (impc:ti:memzone-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(llvm_callback))) (impc:ti:callback-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(make-vector))) (impc:ti:make-vector-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(vector-set!))) (impc:ti:vector-set-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(vector-ref))) (impc:ti:vector-ref-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(vector-shuffle))) (impc:ti:vector-shuffle-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(make-array))) (impc:ti:make-array-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(array-set!))) (impc:ti:array-set-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(array-ref))) (impc:ti:array-ref-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(array-ref-ptr))) (impc:ti:array-ref-ptr-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(pointer-set!))) (impc:ti:pointer-set-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(pointer-ref))) (impc:ti:pointer-ref-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(pointer-ref-ptr))) (impc:ti:pointer-ref-ptr-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(stack-alloc))) (impc:ti:stack-alloc-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(heap-alloc))) (impc:ti:heap-alloc-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(zone-alloc))) (impc:ti:zone-alloc-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(make-tuple))) (impc:ti:make-tuple-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(num-of-elts))) (impc:ti:num-of-elts-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(obj-size))) (impc:ti:obj-size-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(ref))) (impc:ti:ref-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(tuple-set!))) (impc:ti:tuple-set-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(tuple-ref))) (impc:ti:tuple-ref-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(tuple-ref-ptr))) (impc:ti:tuple-ref-ptr-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(closure-set!))) (impc:ti:closure-set-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(closure-ref))) (impc:ti:closure-ref-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(closure-refcheck))) (impc:ti:closure-refcheck-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(pref))) (impc:ti:pref-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(pdref))) (impc:ti:pdref-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(null?))) (impc:ti:null?-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(impc_null))) (impc:ti:null-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(bitcast))) (impc:ti:bitcast-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(bitconvert))) (impc:ti:bitconvert-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(void))) (impc:ti:void-check ast vars kts request?)) - ((and (list? ast) (member (car ast) '(fptrcall))) (impc:ti:fptrcall-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) *impc:mathintrinsicslist*)) (impc:ti:math-intrinsic-check ast vars kts request?)) + ((and (list? ast) (eq? (car ast) 'dotimes)) (impc:ti:dotimes-check ast vars kts request?)) + ((and (list? ast) (eq? (car ast) 'while)) (impc:ti:while-check ast vars kts request?)) + ((and (list? ast) (eq? (car ast) 'printf)) (impc:ti:printf-check ast vars kts request?)) + ((and (list? ast) (eq? (car ast) 'sprintf)) (impc:ti:sprintf-check ast vars kts request?)) + ((and (list? ast) (eq? (car ast) 'fprintf)) (impc:ti:fprintf-check ast vars kts request?)) + ((and (list? ast) (eq? (car ast) 'sscanf)) (impc:ti:sscanf-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(fscanf))) (impc:ti:fscanf-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(push_zone))) (impc:ti:push_zone-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(pop_zone))) (impc:ti:pop_zone-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(push_new_zone))) (impc:ti:push_new_zone-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(create_zone))) (impc:ti:create_zone-check ast vars kts request?)) + ;;((and (list? ast) (memq (car ast) '(memzone))) (impc:ti:memzone-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(llvm_callback))) (impc:ti:callback-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(make-vector))) (impc:ti:make-vector-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(vector-set!))) (impc:ti:vector-set-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(vector-ref))) (impc:ti:vector-ref-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(vector-shuffle))) (impc:ti:vector-shuffle-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(make-array))) (impc:ti:make-array-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(array-set!))) (impc:ti:array-set-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(array-ref))) (impc:ti:array-ref-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(array-ref-ptr))) (impc:ti:array-ref-ptr-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(pointer-set!))) (impc:ti:pointer-set-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(pointer-ref))) (impc:ti:pointer-ref-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(pointer-ref-ptr))) (impc:ti:pointer-ref-ptr-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(stack-alloc))) (impc:ti:stack-alloc-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(heap-alloc))) (impc:ti:heap-alloc-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(zone-alloc))) (impc:ti:zone-alloc-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(make-tuple))) (impc:ti:make-tuple-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(num-of-elts))) (impc:ti:num-of-elts-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(obj-size))) (impc:ti:obj-size-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(ref))) (impc:ti:ref-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(tuple-set!))) (impc:ti:tuple-set-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(tuple-ref))) (impc:ti:tuple-ref-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(tuple-ref-ptr))) (impc:ti:tuple-ref-ptr-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(closure-set!))) (impc:ti:closure-set-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(closure-ref))) (impc:ti:closure-ref-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(closure-refcheck))) (impc:ti:closure-refcheck-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(pref))) (impc:ti:pref-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(pdref))) (impc:ti:pdref-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(null?))) (impc:ti:null?-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(impc_null))) (impc:ti:null-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(bitcast))) (impc:ti:bitcast-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(bitconvert))) (impc:ti:bitconvert-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(void))) (impc:ti:void-check ast vars kts request?)) + ((and (list? ast) (memq (car ast) '(fptrcall))) (impc:ti:fptrcall-check ast vars kts request?)) ((and (list? ast) ;; poly func (specific match) (symbol? (car ast)) request? @@ -9463,20 +9463,20 @@ xtlang's `let' syntax is the same as Scheme" (list (impc:ti:mark-returns (caddr ast) name in-body? last-pair? blocked?)) (if (not (null? (cdddr ast))) (list (impc:ti:mark-returns (cadddr ast) name in-body? last-pair? blocked?))))) - ((member (car ast) *impc:letslist*) + ((memq (car ast) *impc:letslist*) (append (list (car ast)) (list (map (lambda (a) ;; let assigns always block (lambda can override but nothing else) (list (car a) (impc:ti:mark-returns (cadr a) (car a) #f #f #t))) (cadr ast))) (impc:ti:mark-returns (cddr ast) name #t #f blocked?))) - ((member (car ast) *impc:lambdaslist*) + ((memq (car ast) *impc:lambdaslist*) (append (list (car ast)) (list (cadr ast)) ;; lambda always unblocks because lambdas always need a return (impc:ti:mark-returns (cddr ast) name #t #f #f))) ;((equal? (car ast) 'dotimes) ; (append '(dotimes) (list (cadr ast)) (impc:ti:mark-returns (cddr ast) name #t #f blocked?))) - ((equal? (car ast) 'begin) + ((eq? (car ast) 'begin) (if (null? (cdr ast)) (impc:compiler:print-no-retval-error ast)) (let* ((rev (reverse (cdr ast))) @@ -9608,7 +9608,7 @@ xtlang's `let' syntax is the same as Scheme" (define impc:ti:allocate-var? (lambda (ast) (cond ((null? ast) #f) - ((member ast *impc:lambdaslist*) #t) + ((memq ast *impc:lambdaslist*) #t) ((pair? ast) (or (impc:ti:allocate-var? (car ast)) (impc:ti:allocate-var? (cdr ast)))) @@ -9617,20 +9617,21 @@ xtlang's `let' syntax is the same as Scheme" (define impc:ti:allocate-var? (lambda (ast) (cond ((null? ast) 0) - ((member ast '(lambda lambdaz)) 3) + ((memq ast '(lambda lambdaz)) 3) ((eq? ast 'lambdah) 1) ((eq? ast 'lambdas) 2) ((pair? ast) - (let ((a (impc:ti:allocate-var? (car ast))) - (b (impc:ti:allocate-var? (cdr ast)))) - (if (> a b) a b))) + (let ((a (impc:ti:allocate-var? (car ast)))) + (if (= a 3) 3 + (let ((b (impc:ti:allocate-var? (cdr ast)))) + (if (> a b) a b))))) (else 0)))) ;; adds make-closure and make-env tags (define impc:ti:closure:convert (lambda (ast esyms) (cond ((pair? ast) - (if (member (car ast) *impc:lambdaslist*) + (if (memq (car ast) *impc:lambdaslist*) (let (;(env (impc:ti:block:check-for-free-syms ast esyms)) (allocate-mem-for-vars? (impc:ti:allocate-var? (cdr ast)))) (list (cond ((eq? (car ast) 'lambdah) '__make-closure-h) @@ -9642,7 +9643,7 @@ xtlang's `let' syntax is the same as Scheme" (cdr (reverse (cl:remove-duplicates esyms))) ;env (cadr ast) (impc:ti:closure:convert (caddr ast) (append (cadr ast) esyms)))) - (if (member (car ast) *impc:letslist*) + (if (memq (car ast) *impc:letslist*) (let* ((allocate-mem-for-vars? (impc:ti:allocate-var? ast)) (bindings (map (lambda (binding) (car binding)) @@ -9669,7 +9670,7 @@ xtlang's `let' syntax is the same as Scheme" (eq? (car ast) closure-sym)) (if (and (not (null? (cdr ast))) (list? (cadr ast)) - (member (caadr ast) *impc:lambdaslist*)) + (memq (caadr ast) *impc:lambdaslist*)) (cadr (cadr ast)) '())) (else (append (impc:ti:get-closure-arg-symbols closure-sym (car ast)) @@ -9800,7 +9801,7 @@ xtlang's `let' syntax is the same as Scheme" (lambda (ast forced-types) ;; (println 'ast: ast) (if (pair? ast) - (cond ((member (car ast) '(< > * / = + - <>)) + (cond ((memq (car ast) '(< > * / = + - <>)) (let ((a (assoc-strcmp (cadr ast) forced-types)) (b (assoc-strcmp (caddr ast) forced-types))) (if (and (and a b) From 5657575588cad3f7c1d5b867fe37c5ba26fa7f6c Mon Sep 17 00:00:00 2001 From: soulofmischief <30357883+soulofmischief@users.noreply.github.com> Date: Thu, 18 Dec 2025 22:49:11 -0600 Subject: [PATCH 14/14] Format --- .gitignore | 2 +- CMakeLists.txt | 4 ++-- include/UNIV.h | 2 +- libs/base/base.xtm | 22 +++++++++++----------- runtime/llvmti.xtm | 14 +++++++------- src/AudioDevice.cpp | 6 +++--- src/Extempore.cpp | 8 ++++---- 7 files changed, 29 insertions(+), 29 deletions(-) diff --git a/.gitignore b/.gitignore index 3cf675dc..b7f4e6c1 100644 --- a/.gitignore +++ b/.gitignore @@ -115,4 +115,4 @@ CMakeSettings.json .ccls-cache/* # ignore config -config.txt \ No newline at end of file +config.txt diff --git a/CMakeLists.txt b/CMakeLists.txt index e8b2d2b0..980b2dc1 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -325,7 +325,7 @@ if (EXT_DYLIB) runtime/scheme.xtm ) - add_library(extempore SHARED + add_library(extempore SHARED src/Extempore.cpp src/AudioDevice.cpp src/EXTZones.cpp @@ -416,7 +416,7 @@ elseif(EXT_SHARE_DIR) PRIVATE -DEXT_SHARE_DIR="${EXT_SHARE_DIR}") elseif(EXT_DYLIB) target_compile_definitions(extempore - PRIVATE -DEXT_DYLIB=1 + PRIVATE -DEXT_DYLIB=1 PRIVATE -DEXT_SHARE_DIR="." ) else() diff --git a/include/UNIV.h b/include/UNIV.h index 1cfebd11..985409d7 100644 --- a/include/UNIV.h +++ b/include/UNIV.h @@ -187,7 +187,7 @@ inline void ascii_text_color(bool Bold, unsigned Foreground, unsigned Background } #ifdef _WIN32 extern int WINDOWS_COLORS[]; - extern int WINDOWS_BGCOLORS[]; + extern int WINDOWS_BGCOLORS[]; if (unlikely(extemp::UNIV::EXT_TERM == 1)) { Foreground = (Foreground > 7) ? 7 : Foreground; Background = (Background > 7) ? 0 : Background; diff --git a/libs/base/base.xtm b/libs/base/base.xtm index 6a38a437..f16af909 100644 --- a/libs/base/base.xtm +++ b/libs/base/base.xtm @@ -538,7 +538,7 @@ Second item in tuple is a char* c-style string ") ;; easy String dataconstructors from c strings ;; zone alloc'ed versions - + (bind-func String "Create an xtlang String type from a c string (char array) @@ -560,18 +560,18 @@ Allocation size will be (+ (strlen cstr) 1) (lambda (cstr:i8*) (String cstr))) -;; strings need dedicated zcopy +;; strings need dedicated zcopy ;; so need to override default (bind-func zcopy:[String*,String*,mzone*,mzone*]* (lambda (x fromz toz) (if (llvm_ptr_in_zone fromz (cast x i8*)) (begin (push_zone toz) (let ((obj (zalloc))) - (begin + (begin (tset! obj 0 (tref x 0))) - (if (llvm_ptr_in_zone fromz (cast (tref x 1) i8*)) + (if (llvm_ptr_in_zone fromz (cast (tref x 1) i8*)) (let ((newptr:i8* (zalloc (+ 1 (tref x 0))))) - (strcpy newptr (cast (tref x 1) i8*)) ; (+ (tref x 0) 1)) + (strcpy newptr (cast (tref x 1) i8*)) ; (+ (tref x 0) 1)) (tset! obj 1 newptr)) (tset! obj 1 (tref x 1))) (pop_zone) @@ -591,7 +591,7 @@ Allocation size will be (+ (strlen cstr) 1) (lambda (x) (free (tref x 1)) (free x) - void)) + void)) (bind-func String_h "Create an xtlang String type from a c string (char array) @@ -1167,18 +1167,18 @@ Use via the polymorphic Str function (new_str (Symbol_z len (cstring str)))) new_str))) -;; symbols need dedicated zcopy +;; symbols need dedicated zcopy ;; so need to override default (bind-func zcopy:[Symbol*,Symbol*,mzone*,mzone*]* (lambda (x fromz toz) (if (llvm_ptr_in_zone fromz (cast x i8*)) (begin (push_zone toz) (let ((obj (zalloc))) - (begin + (begin (tset! obj 0 (tref x 0))) - (if (llvm_ptr_in_zone fromz (cast (tref x 1) i8*)) + (if (llvm_ptr_in_zone fromz (cast (tref x 1) i8*)) (let ((newptr:i8* (zalloc (+ 1 (tref x 0))))) - (strcpy newptr (cast (tref x 1) i8*)) ; (+ (tref x 0) 1)) + (strcpy newptr (cast (tref x 1) i8*)) ; (+ (tref x 0) 1)) (tset! obj 1 newptr)) (tset! obj 1 (tref x 1))) (pop_zone) @@ -1198,7 +1198,7 @@ Use via the polymorphic Str function (lambda (x) (free (tref x 1)) (free x) - void)) + void)) (bind-func equal "Equality test for Symbol diff --git a/runtime/llvmti.xtm b/runtime/llvmti.xtm index 44df46b1..1df0c087 100644 --- a/runtime/llvmti.xtm +++ b/runtime/llvmti.xtm @@ -6807,7 +6807,7 @@ Continue executing `body' forms until `test-expression' returns #f" (arity (- (length ast) 1)) ;; (lll (println 'gname gname arity (if request? (cons request? args) args))) (gpt (impc:ti:genericfunc-types gname arity (if request? (cons request? args) args))) - (gpt-valid (if (equal? #f gpt) + (gpt-valid (if (equal? #f gpt) (impc:compiler:print-compiler-error "no valid generic options available for: " ast) #t)) ;; request? request? args))) @@ -6916,12 +6916,12 @@ Continue executing `body' forms until `test-expression' returns #f" (let ((req (regex:matched request? "^%([^_]*).*")) (gen (regex:matched (symbol->string (cadr gpoly-type)) "^([A-Za-z][^{:]*).*"))) ;; (println 'req req 'gen gen) - (if (and (= (length req) 2) + (if (and (= (length req) 2) (= (length gen) 2)) (if (and (not (equal? (cadr req) (cadr gen))) #t) ;; (not (equal? (cadr gen) "_"))) ;; (impc:compiler:print-compiler-error "no valid generic options available for: " ast))))) - (impc:compiler:print-compiler-error (string-append "Return type mismatch for generic function which expected return type '" (cadr gen) "' and got named type '" (cadr req) "'") ast))))) + (impc:compiler:print-compiler-error (string-append "Return type mismatch for generic function which expected return type '" (cadr gen) "' and got named type '" (cadr req) "'") ast))))) ;; (println 'update 'return 'var 'with (impc:ti:update-var (cadr gpoly-type) vars kts (list request?))) (if (not (assoc-strcmp (cadr gpoly-type) vars)) (set-cdr! vars (cons (list (cadr gpoly-type)) (cdr vars)))) @@ -7863,7 +7863,7 @@ xtlang's `let' syntax is the same as Scheme" (regex:match? request? "^%.*") (regex:match? a "^%.*") (not (equal? request? a))) - (impc:compiler:print-compiler-error (string-append "type error calculating return type - expected named type '" a "' got '" request? "'") ast)) + (impc:compiler:print-compiler-error (string-append "type error calculating return type - expected named type '" a "' got '" request? "'") ast)) (if *impc:ti:print-sub-checks* (println 'ret:> 'ast: ast 'a: a 'sym: sym)) (if (and (impc:ir:type? t) (impc:ir:closure? t)) @@ -11084,7 +11084,7 @@ xtlang's `let' syntax is the same as Scheme" (tfill! obj ,@argslist) (pref obj 0)))) (interaction-environment)) - (if copy? + (if copy? (begin (eval `(bind-func ,(string->symbol (string-append "hcopy:[" namestr "*," namestr "*]*")) (lambda (,(string->symbol (string-append "x:" namestr "*"))) @@ -11587,13 +11587,13 @@ e.g. (impc:compiler:print-compiler-error "bind-lib-type failed" ,name))))) (define-macro (register-lib-type library name type docstring) - (if (impc:aot:currently-compiling?) + (if (impc:aot:currently-compiling?) (set! *impc:ti:suppress-ir-generation* #t) (set! *impc:ti:suppress-ir-generation* #f)) (let* ((a (impc:ir:get-pretty-tuple-arg-strings (symbol->string type))) (namestr (symbol->string name)) (typestr (symbol->string type))) - `(begin + `(begin (impc:ti:register-new-namedtype ,namestr ',(impc:ir:get-type-from-pretty-str typestr namestr) ,docstring) diff --git a/src/AudioDevice.cpp b/src/AudioDevice.cpp index 46beb695..3536f5a6 100644 --- a/src/AudioDevice.cpp +++ b/src/AudioDevice.cpp @@ -212,7 +212,7 @@ void* audioCallbackMT(void* Args) set_thread_realtime(pthread_mach_thread_np(pthread_self()), clockFrequency*.01,clockFrequency*.007,clockFrequency*.007); #elif __linux__ set_thread_realtime(pthread_self(), SCHED_RR, 20); -#elif _WIN32 +#elif _WIN32 SetThreadPriority(GetCurrentThread(), 15); // 15 = THREAD_PRIORITY_TIME_CRITICAL #endif //printf("Starting RT Audio Process\n"); @@ -282,7 +282,7 @@ void* audioCallbackMTBuf(void* dat) { set_thread_realtime(pthread_mach_thread_np(pthread_self()), clockFrequency*.01,clockFrequency*.007,clockFrequency*.007); #elif __linux__ set_thread_realtime(pthread_self(), SCHED_RR, 20); -#elif _WIN32 +#elif _WIN32 SetThreadPriority(GetCurrentThread(),15); // 15 = THREAD_PRIORITY_TIME_CRITICAL #endif unsigned idx = uintptr_t(dat); @@ -381,7 +381,7 @@ int audioCallback(const void* InputBuffer, void* OutputBuffer, unsigned long Fra extemp::EXTZones::llvm_zone_reset(zone); } ++in; - } + } } else { // for when in channels & out channels don't match //SAMPLE* indata = alloc(UNIV::IN_CHANNELS); // auto //indata(in); diff --git a/src/Extempore.cpp b/src/Extempore.cpp index 293ddd2c..c8c090c9 100644 --- a/src/Extempore.cpp +++ b/src/Extempore.cpp @@ -254,9 +254,9 @@ EXPORT int extempore_init(int argc, char** argv) } else { #ifdef _WIN32 extemp::UNIV::EXT_TERM = 1; -#else +#else extemp::UNIV::EXT_TERM = 0; -#endif +#endif } break; case OPT_NO_AUDIO: @@ -406,7 +406,7 @@ EXPORT int extempore_init(int argc, char** argv) startup_ok &= primary->start(); extemp::SchemeREPL* primary_repl = new extemp::SchemeREPL(primary_name, primary); primary_repl->connectToProcessAtHostname(host, primary_port); - //std::cout << "primary started:" << std::endl << std::flush; + //std::cout << "primary started:" << std::endl << std::flush; if (!startup_ok) { ascii_error(); printf("ERROR:"); @@ -423,7 +423,7 @@ EXPORT int extempore_init(int argc, char** argv) #else sleep(2000); #endif - } + } #else primary = new extemp::SchemeProcess(extemp::UNIV::SHARE_DIR, primary_name, primary_port, 0, initexpr);