├── .clang-format ├── .cppcheck_suppressions ├── .editorconfig ├── .gdbinit ├── .gitignore ├── .gitlab-ci.yml ├── .gitmodules ├── .pir └── configuration.ini.example ├── .valgrind_suppressions ├── .vscode ├── c_cpp_properties.json ├── cmake-variants.yaml ├── launch.json ├── settings.json └── tasks.json ├── .ycm_extra_conf.py ├── CMakeLists.txt ├── Dockerfile ├── LICENSE ├── README.md ├── container ├── benchmark-baseline │ ├── Dockerfile │ └── update.sh ├── benchmark │ └── Dockerfile ├── build-releaseassert.sh ├── cleanup.rb └── install-test-deps.sh ├── demo ├── demo.R ├── demo_rir.R └── demo_rir.txt ├── documentation ├── benchmarking.md ├── debugging.md ├── development.md ├── pir.md ├── recording.md ├── rir.md ├── spec-opt.md └── updating-gnur.md ├── examples ├── mandelbrot_mini.R └── tree_mini.r ├── prototype └── annotation.R ├── replayer.r ├── rir ├── R │ └── rir.R ├── src │ ├── R │ │ ├── BuiltinIds.h │ │ ├── Funtab.h │ │ ├── Preserve.h │ │ ├── Printing.cpp │ │ ├── Printing.h │ │ ├── Protect.h │ │ ├── RList.cpp │ │ ├── RList.h │ │ ├── Serialize.h │ │ ├── Symbols.cpp │ │ ├── Symbols.h │ │ ├── r.h │ │ ├── r_incl.h │ │ └── symbol_list.h │ ├── api.cpp │ ├── api.h │ ├── bc │ │ ├── BC.cpp │ │ ├── BC.h │ │ ├── BC_inc.h │ │ ├── BC_noarg_list.h │ │ ├── CodeStream.h │ │ ├── CodeVerifier.cpp │ │ ├── CodeVerifier.h │ │ ├── Compiler.cpp │ │ ├── Compiler.h │ │ └── insns.h │ ├── common.cpp │ ├── common.h │ ├── compiler │ │ ├── analysis │ │ │ ├── abstract_result.h │ │ │ ├── abstract_value.cpp │ │ │ ├── abstract_value.h │ │ │ ├── available_checkpoints.h │ │ │ ├── cfg.cpp │ │ │ ├── cfg.h │ │ │ ├── context_stack.h │ │ │ ├── dead.cpp │ │ │ ├── dead.h │ │ │ ├── dead_store.h │ │ │ ├── force_dominance.h │ │ │ ├── generic_static_analysis.h │ │ │ ├── last_env.h │ │ │ ├── liveness.cpp │ │ │ ├── liveness.h │ │ │ ├── loop_detection.cpp │ │ │ ├── loop_detection.h │ │ │ ├── query.cpp │ │ │ ├── query.h │ │ │ ├── range.cpp │ │ │ ├── range.h │ │ │ ├── reference_count.h │ │ │ ├── scope.cpp │ │ │ ├── scope.h │ │ │ ├── unnecessary_contexts.h │ │ │ ├── verifier.cpp │ │ │ ├── verifier.h │ │ │ ├── visibility.cpp │ │ │ └── visibility.h │ │ ├── backend.cpp │ │ ├── backend.h │ │ ├── compiler.cpp │ │ ├── compiler.h │ │ ├── log │ │ │ ├── debug.h │ │ │ ├── log.cpp │ │ │ ├── log.h │ │ │ ├── loggers.cpp │ │ │ ├── loggers.h │ │ │ ├── sinks.cpp │ │ │ └── sinks.h │ │ ├── native │ │ │ ├── allocator.cpp │ │ │ ├── allocator.h │ │ │ ├── builtins.cpp │ │ │ ├── builtins.h │ │ │ ├── lower_function_llvm.cpp │ │ │ ├── lower_function_llvm.h │ │ │ ├── lower_function_llvm_variable.cpp │ │ │ ├── pass_schedule_llvm.cpp │ │ │ ├── pass_schedule_llvm.h │ │ │ ├── pir_jit_llvm.cpp │ │ │ ├── pir_jit_llvm.h │ │ │ ├── representation_llvm.cpp │ │ │ ├── representation_llvm.h │ │ │ ├── types_llvm.cpp │ │ │ └── types_llvm.h │ │ ├── opt │ │ │ ├── assumptions.cpp │ │ │ ├── cleanup.cpp │ │ │ ├── cleanup_checkpoints.cpp │ │ │ ├── cleanup_framestate.cpp │ │ │ ├── constantfold.cpp │ │ │ ├── context.cpp │ │ │ ├── dead_store_removal.cpp │ │ │ ├── delay_env.cpp │ │ │ ├── delay_instr.cpp │ │ │ ├── dots.cpp │ │ │ ├── eager_calls.cpp │ │ │ ├── early_constantfold.cpp │ │ │ ├── elide_env.cpp │ │ │ ├── elide_env_spec.cpp │ │ │ ├── force_dominance.cpp │ │ │ ├── gvn.cpp │ │ │ ├── hoist_instruction.cpp │ │ │ ├── inline.cpp │ │ │ ├── inline_force_prom.cpp │ │ │ ├── load_elision.cpp │ │ │ ├── loop_invariant.cpp │ │ │ ├── match_call_args.cpp │ │ │ ├── overflow.cpp │ │ │ ├── pass.cpp │ │ │ ├── pass.h │ │ │ ├── pass_definitions.h │ │ │ ├── pass_scheduler.cpp │ │ │ ├── pass_scheduler.h │ │ │ ├── promise_splitter.cpp │ │ │ ├── scope_resolution.cpp │ │ │ ├── type_speculation.cpp │ │ │ ├── type_test.h │ │ │ ├── typefeedback_cleanup.cpp │ │ │ ├── types.cpp │ │ │ └── visibility.cpp │ │ ├── osr.cpp │ │ ├── osr.h │ │ ├── parameter.h │ │ ├── pir │ │ │ ├── bb.cpp │ │ │ ├── bb.h │ │ │ ├── builder.cpp │ │ │ ├── builder.h │ │ │ ├── closure.cpp │ │ │ ├── closure.h │ │ │ ├── closure_version.cpp │ │ │ ├── closure_version.h │ │ │ ├── code.cpp │ │ │ ├── code.h │ │ │ ├── continuation.cpp │ │ │ ├── continuation.h │ │ │ ├── continuation_context.cpp │ │ │ ├── continuation_context.h │ │ │ ├── deopt_context.cpp │ │ │ ├── deopt_context.h │ │ │ ├── env.cpp │ │ │ ├── env.h │ │ │ ├── instruction.cpp │ │ │ ├── instruction.h │ │ │ ├── instruction_list.h │ │ │ ├── module.cpp │ │ │ ├── module.h │ │ │ ├── pir.h │ │ │ ├── pir_impl.h │ │ │ ├── promise.cpp │ │ │ ├── promise.h │ │ │ ├── singleton_values.h │ │ │ ├── tag.cpp │ │ │ ├── tag.h │ │ │ ├── type.cpp │ │ │ ├── type.h │ │ │ ├── value.cpp │ │ │ ├── value.h │ │ │ ├── value_list.h │ │ │ ├── values.cpp │ │ │ └── values.h │ │ ├── rir2pir │ │ │ ├── insert_cast.cpp │ │ │ ├── insert_cast.h │ │ │ ├── rir2pir.cpp │ │ │ └── rir2pir.h │ │ ├── test │ │ │ ├── PirCheck.cpp │ │ │ ├── PirCheck.h │ │ │ ├── PirTests.cpp │ │ │ └── PirTests.h │ │ └── util │ │ │ ├── arg_match.cpp │ │ │ ├── arg_match.h │ │ │ ├── bb_transform.cpp │ │ │ ├── bb_transform.h │ │ │ ├── env_stub_info.cpp │ │ │ ├── env_stub_info.h │ │ │ ├── phi_placement.cpp │ │ │ ├── phi_placement.h │ │ │ ├── safe_builtins_list.cpp │ │ │ ├── safe_builtins_list.h │ │ │ ├── visitor.cpp │ │ │ └── visitor.h │ ├── config.h │ ├── interpreter │ │ ├── builtins.cpp │ │ ├── builtins.h │ │ ├── cache.h │ │ ├── call_context.h │ │ ├── decompile.cpp │ │ ├── instance.cpp │ │ ├── instance.h │ │ ├── interp.cpp │ │ ├── interp.h │ │ ├── interp_incl.h │ │ ├── profiler.cpp │ │ ├── profiler.h │ │ ├── runtime.cpp │ │ ├── safe_force.cpp │ │ ├── safe_force.h │ │ └── serialize.cpp │ ├── recording.cpp │ ├── recording.h │ ├── recording_hooks.cpp │ ├── recording_hooks.h │ ├── recording_serialization.h │ ├── runtime │ │ ├── ArglistOrder.h │ │ ├── Code.cpp │ │ ├── Code.h │ │ ├── Context.cpp │ │ ├── Context.h │ │ ├── Deoptimization.cpp │ │ ├── Deoptimization.h │ │ ├── DispatchTable.h │ │ ├── Function.cpp │ │ ├── Function.h │ │ ├── FunctionSignature.h │ │ ├── GenericDispatchTable.h │ │ ├── LazyArglist.h │ │ ├── LazyEnvironment.cpp │ │ ├── LazyEnvironment.h │ │ ├── PirTypeFeedback.cpp │ │ ├── PirTypeFeedback.h │ │ ├── RirRuntimeObject.h │ │ ├── TypeFeedback.cpp │ │ ├── TypeFeedback.h │ │ ├── TypeFeedback_inl.h │ │ └── rirPrint.cpp │ ├── simple_instruction_list.h │ └── utils │ │ ├── EnumSet.h │ │ ├── FormalArgs.h │ │ ├── FunctionWriter.h │ │ ├── Map.h │ │ ├── Pool.cpp │ │ ├── Pool.h │ │ ├── Set.h │ │ ├── String.h │ │ ├── Terminal.h │ │ ├── UUID.cpp │ │ ├── UUID.h │ │ ├── escape_string.h │ │ ├── filesystem.cpp │ │ ├── filesystem.h │ │ ├── measuring.cpp │ │ ├── measuring.h │ │ └── random.h └── tests │ ├── S3_regression.R │ ├── active_bindings_regression.r │ ├── all-equal-regression.R │ ├── annotations_depromise.R │ ├── deoptless.R │ ├── empty_loops.r │ ├── fasta_regression.r │ ├── loop_regressions.R │ ├── matrix_regression.r │ ├── methods_regression.R │ ├── nan_regressions.r │ ├── native_mod.r │ ├── nbody_2_regression.r │ ├── nested_loops.R │ ├── pir_binary_arith.R │ ├── pir_check.R │ ├── pir_dispatch.R │ ├── pir_dots.r │ ├── pir_eager_call.R │ ├── pir_extract_obj.r │ ├── pir_isvector.r │ ├── pir_matrix_regression.R │ ├── pir_nargs.r │ ├── pir_regression-reg-S4.R │ ├── pir_regression.R │ ├── pir_regression2.R │ ├── pir_regression3.R │ ├── pir_regression4.R │ ├── pir_regression5.R │ ├── pir_regression6.R │ ├── pir_regression7.R │ ├── pir_regression8.R │ ├── pir_regression9.R │ ├── pir_regression_binding_cache.R │ ├── pir_regression_check_code.R │ ├── pir_regression_cyclic.r │ ├── pir_regression_dead_store.r │ ├── pir_regression_forceAndCall.R │ ├── pir_regression_missing.R │ ├── pir_regression_regaloc.r │ ├── pir_regression_splines.R │ ├── pir_scope_delay_env_regression.r │ ├── pir_simple_range.R │ ├── pir_tests.R │ ├── pir_tests_regression.R │ ├── pir_value_profiler_tests.r │ ├── protect_regression_grid.R │ ├── reg-tests-1c.R │ ├── regression_bounce.r │ ├── regression_ellipsis_builtins.r │ ├── regression_interprocedural_scope.r │ ├── regression_mandelbrot.r │ ├── regression_native_matrix.r │ ├── regression_reg-packages.R │ ├── regression_spModel.matrix.R │ ├── regression_stats.R │ ├── regression_subassign.r │ ├── rir_assign.R │ ├── rir_basics.R │ ├── rir_control.R │ ├── rir_default.R │ ├── rir_deopt.R │ ├── rir_dotdotdot.R │ ├── rir_guard_env.R │ ├── rir_index.R │ ├── rir_inline.R │ ├── rir_lapply.R │ ├── rir_lgl.R │ ├── rir_loops.R │ ├── rir_regression.R │ ├── rir_relop.R │ ├── rir_switch.R │ ├── rlang_missing.r │ ├── runif-regression.R │ ├── sapply_repro.R │ ├── test_mark_function.r │ ├── test_range.r │ ├── type_annotations_usercontext.r │ └── use_method_regression.r └── tools ├── .dropbox_uploader ├── R ├── Rscript ├── build-gnur.sh ├── check-gnur-make-tests-error ├── copy-logs.sh ├── cppcheck ├── creduce ├── fetch-llvm.sh ├── git-clang-format ├── gnur-make ├── gnur-make-tests ├── hook ├── install_hooks.sh ├── pirpp.py ├── pre-commit-hook ├── pre-commit.d └── 10-clang-format.hook ├── pre-push-hook ├── pre-push.d └── 90-tests.hook ├── report_ci_results.rb ├── script_include.sh ├── setup-build-dir └── tests /.clang-format: -------------------------------------------------------------------------------- 1 | BasedOnStyle: LLVM 2 | IndentWidth: 4 3 | DerivePointerAlignment: false 4 | PointerAlignment: Left 5 | AlwaysBreakTemplateDeclarations: true 6 | AlignTrailingComments: true 7 | AllowShortBlocksOnASingleLine: false 8 | -------------------------------------------------------------------------------- /.cppcheck_suppressions: -------------------------------------------------------------------------------- 1 | // cppcheck does not seem to understand the scoping with 2 | // enum classes. This just produces false positives for us 3 | variableHidingEnum 4 | constStatement 5 | // We need to suppress alloca obsolote warnings while we 6 | // use it as a dynamic cache strategy 7 | allocaCalled 8 | // this is annoying 9 | useStlAlgorithm 10 | shadowVariable 11 | shadowFunction 12 | shadowArgument 13 | knownConditionTrueFalse 14 | toomanyconfigs 15 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | [*] 2 | charset = utf-8 3 | indent_style = space 4 | indent_size = 4 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | benchmarks/*.png 2 | benchmarks/*.rds 3 | xml/* 4 | local/* 5 | *.Rprofile 6 | build/* 7 | gnur/* 8 | *.swp 9 | CMakeCache.txt 10 | CMakeLists.txt.user 11 | CMakeFiles/ 12 | Makefile 13 | cmake_install.cmake 14 | librir.so 15 | perf.data 16 | perf.data.old 17 | packages/ 18 | .ninja_deps 19 | .ninja_log 20 | build.ninja 21 | rules.ninja 22 | .gdb_history 23 | .clang_complete 24 | index.db 25 | doxygen_sqlite3.db 26 | Rplots.pdf 27 | .test_results 28 | benchmarks/ 29 | .Rhistory 30 | /tests 31 | *.dylib 32 | .R_HOME 33 | .travis_token 34 | /bin 35 | .bin_create 36 | *.DS_Store 37 | external/* 38 | !external/custom-r 39 | .history 40 | .cache 41 | compile_commands.json 42 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "external/custom-r"] 2 | path = external/custom-r 3 | url = https://github.com/reactorlabs/gnur.git 4 | ignore = untracked 5 | -------------------------------------------------------------------------------- /.pir/configuration.ini.example: -------------------------------------------------------------------------------- 1 | [optimizations] 2 | ;Key is optimization, value is the order in which the optimization is used. 0 means the optimization is disabled 3 | globalValueNumber=1 4 | forceDominance=2 5 | escapeAnalysis=3 6 | delayInstructions=4 7 | elideEnvironments=5 8 | delayEnvironments=6 9 | ;Describes after which optimizations a cleanup must be run. Repeat for more than one cleanup pass. 10 | cleanup=2,2,5 11 | -------------------------------------------------------------------------------- /.valgrind_suppressions: -------------------------------------------------------------------------------- 1 | { 2 | not_our_bug 3 | Memcheck:Cond 4 | fun:__gconv_transform_internal_utf8 5 | fun:wcsrtombs 6 | fun:wcstombs 7 | fun:tre_parse_bracket_items 8 | fun:tre_parse_bracket 9 | fun:tre_parse 10 | fun:tre_compile 11 | fun:tre_regcompb 12 | } 13 | { 14 | not_our_bug_either 15 | Memcheck:Cond 16 | fun:__wcsnlen_avx2 17 | fun:wcsrtombs 18 | fun:wcstombs 19 | fun:tre_parse_bracket_items 20 | fun:tre_parse_bracket 21 | fun:tre_parse 22 | fun:tre_compile 23 | fun:tre_regcompb 24 | } 25 | -------------------------------------------------------------------------------- /.vscode/c_cpp_properties.json: -------------------------------------------------------------------------------- 1 | { 2 | "configurations": [ 3 | { 4 | "name": "Ř @ prl5", 5 | "includePath": [ 6 | "${workspaceFolder}/rir/src/**", 7 | "${workspaceFolder}/external/custom-r/src/**", 8 | "${workspaceFolder}/external/llvm-12/include/**", 9 | "${workspaceFolder}/external/llvm-12.0.0.src/include/**" 10 | ], 11 | "defines": [ 12 | "ENABLE_SLOWASSERT", 13 | "R_NO_REMAP" 14 | ], 15 | "cStandard": "c11", 16 | "cppStandard": "c++14", 17 | "intelliSenseMode": "${default}" 18 | } 19 | ], 20 | "version": 4 21 | } 22 | -------------------------------------------------------------------------------- /.vscode/cmake-variants.yaml: -------------------------------------------------------------------------------- 1 | buildType: 2 | default: debugopt 3 | choices: 4 | debugopt: 5 | short: debugopt 6 | long: Emit debug information, -O2 7 | buildType: debugopt 8 | release: 9 | short: release 10 | long: Optimize generated code 11 | buildType: release 12 | debug: 13 | short: debug 14 | long: Emit debug information, -O0 15 | buildType: debug 16 | fullverifier: 17 | short: fullverifier 18 | long: Verify PIR after every pass (slow) 19 | buildType: fullverifier -------------------------------------------------------------------------------- /.vscode/launch.json: -------------------------------------------------------------------------------- 1 | { 2 | // Use IntelliSense to learn about possible attributes. 3 | // Hover to view descriptions of existing attributes. 4 | // For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387 5 | "version": "0.2.0", 6 | "configurations": [ 7 | { 8 | "preLaunchTask": "compile debug", 9 | "name": "(gdb) R debug", 10 | "type": "cppdbg", 11 | "request": "launch", 12 | "program": "${workspaceFolder}/external/custom-r/bin/exec/R", 13 | "args": [], 14 | "stopAtEntry": false, 15 | "cwd": "${workspaceFolder}", 16 | "environment": [ 17 | {"name": "LD_LIBRARY_PATH", "value": "${workspaceFolder}/external/custom-r/lib:/usr/local/lib:/usr/lib/x86_64-linux-gnu:/usr/lib/jvm/java-11-openjdk-amd64/lib/server"}, 18 | {"name": "R_SHARE_DIR", "value": "${workspaceFolder}/external/custom-r/share"}, 19 | {"name": "R_DOC_DIR", "value": "${workspaceFolder}/external/custom-r/doc"}, 20 | {"name": "R_INCLUDE_DIR", "value": "${workspaceFolder}/external/custom-r/include"}, 21 | {"name": "R_HOME", "value": "${workspaceFolder}/external/custom-r"}, 22 | {"name": "R_ARCH", "value": ""}, 23 | {"name": "EXTRA_LOAD_SO", "value": "${workspaceRoot}/build/debug/librir.so"}, 24 | {"name": "EXTRA_LOAD_R", "value": "${workspaceRoot}/rir/R/rir.R"}, 25 | ], 26 | "externalConsole": false, 27 | "MIMode": "gdb", 28 | "setupCommands": [ 29 | { 30 | "description": "Enable pretty-printing for gdb", 31 | "text": "-enable-pretty-printing", 32 | "ignoreFailures": true 33 | } 34 | ] 35 | }, 36 | ] 37 | } -------------------------------------------------------------------------------- /.vscode/tasks.json: -------------------------------------------------------------------------------- 1 | { 2 | // See https://go.microsoft.com/fwlink/?LinkId=733558 3 | // for the documentation about the tasks.json format 4 | "version": "2.0.0", 5 | "tasks": [ 6 | { 7 | "label": "compile debug", 8 | "type": "shell", 9 | "command": "cmake -DCMAKE_BUILD_TYPE=debug . && ninja", 10 | "options": { 11 | "cwd": "${workspaceRoot}/build/debug" 12 | }, 13 | "group": { 14 | "kind": "build", 15 | "isDefault": true 16 | } 17 | } 18 | ] 19 | } -------------------------------------------------------------------------------- /.ycm_extra_conf.py: -------------------------------------------------------------------------------- 1 | import os 2 | import ycm_core 3 | 4 | def DirectoryOfThisScript(): 5 | return os.path.dirname( os.path.abspath( __file__ ) ) 6 | 7 | def Settings( **kwargs ): 8 | return { 9 | 'flags': [ 10 | '-x', 11 | 'c++', 12 | '-std=c++20', 13 | '-Drir_EXPORTS', 14 | '-DENABLE_SLOWASSERT', 15 | '-I'+DirectoryOfThisScript()+'/rir/src', 16 | '-isystem'+DirectoryOfThisScript()+'/external/custom-r/include', 17 | '-isystem'+DirectoryOfThisScript()+'/external/llvm-12/include', 18 | '-isystem'+DirectoryOfThisScript()+'/external/llvm-12.0.0.src/include', 19 | '-Wall', 20 | '-Wuninitialized', 21 | '-Wundef', 22 | '-Winit-self', 23 | '-Wcast-align', 24 | '-Woverloaded-virtual', 25 | '-Wctor-dtor-privacy', 26 | '-Wmissing-include-dirs', 27 | '-Wstrict-overflow=5', 28 | '-Werror', 29 | '-fno-rtti', 30 | '-fno-exceptions', 31 | '-Wimplicit-fallthrough', 32 | ], 33 | } 34 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM registry.gitlab.com/rirvm/rir_mirror/dockerhub_mirror/ubuntu:20.04 2 | ARG CI_COMMIT_SHA 3 | ADD . /opt/rir 4 | ENV LANG en_US.UTF-8 5 | RUN echo $CI_COMMIT_SHA > /opt/rir_version && \ 6 | apt-get update && \ 7 | DEBIAN_FRONTEND=noninteractive apt-get upgrade -y -qq && \ 8 | DEBIAN_FRONTEND=noninteractive apt-get install -y -qq curl git gcc gfortran g++ libreadline-dev libx11-dev libxt-dev zlib1g-dev libbz2-dev liblzma-dev libpcre3-dev libcurl4-openssl-dev libcairo2-dev make libreadline8 libncurses-dev xz-utils cmake tcl-dev tk-dev locales rsync && \ 9 | locale-gen en_US.UTF-8 && update-locale LANG=en_US.UTF-8 && \ 10 | cd /opt/rir && \ 11 | tools/build-gnur.sh && \ 12 | rm -rf external/custom-r/cache_recommended.tar .git && \ 13 | find external -type f -name '*.o' -exec rm -f {} \; && \ 14 | apt-get clean 15 | RUN mkdir -p /opt/rir/build/release && \ 16 | cd /opt/rir && \ 17 | (curl 10.200.14.25:8080/clang+llvm-12.0.0-x86_64-linux-gnu-ubuntu-20.04.tar.xz > external/clang+llvm-12.0.0-x86_64-linux-gnu-ubuntu-20.04.tar.xz || true) && \ 18 | tools/fetch-llvm.sh && \ 19 | cd /opt/rir/build/release && \ 20 | cmake -DCMAKE_BUILD_TYPE=release ../.. && \ 21 | make -j8 && \ 22 | rm -rf CMakeFiles /opt/rir/external/clang+llvm* 23 | 24 | -------------------------------------------------------------------------------- /container/benchmark-baseline/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM ubuntu:20.04 2 | ARG GRAAL_VERSION=22.1.0 3 | 4 | RUN apt-get update && \ 5 | DEBIAN_FRONTEND=noninteractive apt-get upgrade -y -qq && \ 6 | DEBIAN_FRONTEND=noninteractive apt-get install -y -qq curl git gcc gfortran g++ libreadline-dev libx11-dev libxt-dev zlib1g-dev libbz2-dev liblzma-dev libpcre3-dev libcurl4-openssl-dev libcairo2-dev make libreadline8 libncurses-dev xz-utils cmake python3-pip sudo time && \ 7 | git clone --recursive https://github.com/reactorlabs/rir /opt/rir && cd /opt/rir && \ 8 | DONT_SWITCH_TO_NAMED=1 GNUR_BRANCH=R-4-1-branch tools/build-gnur.sh && \ 9 | rm -rf .git && \ 10 | find external -type f -name '*.o' -exec rm -f {} \; && \ 11 | find external -type f -name '*.tar.gz' -exec rm -f {} \; && \ 12 | find external -type f -name '*.tar.xz' -exec rm -f {} \; && \ 13 | curl --fail --silent --location --retry 3 https://github.com/graalvm/graalvm-ce-builds/releases/download/vm-$GRAAL_VERSION/graalvm-ce-java11-linux-amd64-$GRAAL_VERSION.tar.gz | gunzip | tar x -C /opt/ && \ 14 | cd /opt && ln -s graalvm-ce-java11-$GRAAL_VERSION graal && cd /opt/graal/bin && \ 15 | ./gu install R && \ 16 | git clone https://github.com/smarr/ReBench.git /opt/ReBench && cd /opt/ReBench && git checkout 1aaba13 && pip3 install . && \ 17 | mv /usr/local/bin/rebench-denoise /usr/local/bin/rebench-denoise.bkp && cp /usr/bin/false /usr/local/bin/rebench-denoise && \ 18 | git clone --depth 10 https://github.com/reactorlabs/rbenchmarking /opt/rbenchmarking && cd /opt/rbenchmarking && git checkout a92447b37a03e96f8da1e18eb3cd8ab3b46fbf89 && \ 19 | apt-get clean && rm -rf /var/cache/apt/lists 20 | -------------------------------------------------------------------------------- /container/benchmark-baseline/update.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | docker build --no-cache -t registry.gitlab.com/rirvm/rir_mirror/benchmark-baseline . 4 | docker push registry.gitlab.com/rirvm/rir_mirror/benchmark-baseline 5 | -------------------------------------------------------------------------------- /container/benchmark/Dockerfile: -------------------------------------------------------------------------------- 1 | ARG CI_COMMIT_SHA 2 | FROM registry.gitlab.com/rirvm/rir_mirror:$CI_COMMIT_SHA 3 | RUN apt-get update && \ 4 | DEBIAN_FRONTEND=noninteractive apt-get install -y -qq python3-pip sudo time && \ 5 | apt-get clean && rm -rf /var/cache/apt/lists && \ 6 | git clone https://github.com/smarr/ReBench.git /opt/ReBench && \ 7 | cd /opt/ReBench && \ 8 | git checkout 1aaba13 && \ 9 | pip3 install . && \ 10 | git clone --depth 10 https://github.com/reactorlabs/rbenchmarking /opt/rbenchmarking && cd /opt/rbenchmarking && git checkout a92447b37a03e96f8da1e18eb3cd8ab3b46fbf89 11 | -------------------------------------------------------------------------------- /container/build-releaseassert.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | curl 10.200.14.25:8080/clang+llvm-12.0.0-x86_64-linux-gnu-ubuntu-20.04.tar.xz > /opt/rir/external/clang+llvm-12.0.0-x86_64-linux-gnu-ubuntu-20.04.tar.xz 4 | /opt/rir/tools/fetch-llvm.sh 5 | mkdir /opt/rir/build/releaseassert 6 | cd /opt/rir/build/releaseassert 7 | cmake -DCMAKE_BUILD_TYPE=RELEASESLOWASSERT ../.. && make -j6 8 | -------------------------------------------------------------------------------- /container/cleanup.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'json' 4 | require 'date' 5 | 6 | REPOS = { 7 | '10979413': { # rir_mirror 8 | repos: [ 9 | 560429, # / 10 | 560812 # /benchmarks 11 | ], 12 | keep: [ 13 | `git rev-parse HEAD`.chomp, # current version 14 | `git rev-parse HEAD~1`.chomp, # prev version 15 | 'master', 16 | # dls 19 paper 17 | 'dba88e9bc417325a29c91acb088df7fe8109ca39', 18 | # oopsla 20 19 | 'bc1933dde2673bf830f4505bb2483cd1fdd282ab', 20 | ]}, 21 | # '12325205': {# rir experiments 22 | # repos: [ 23 | # 562769, # scope_resolution 24 | # 576865, # envs_created 25 | # ], 26 | # keep: [ 27 | # 'dba88e9bc417325a29c91acb088df7fe8109ca39-e427e03931114e0715513bfafcd59a267812dcb1', 28 | # ]}, 29 | } 30 | 31 | TOKEN = ARGF.read.chomp 32 | 33 | def curl(what) 34 | JSON.parse(`curl -s --header "JOB-TOKEN: #{TOKEN}" #{what}`) 35 | end 36 | 37 | def fetch(project, repo, what) 38 | curl("https://gitlab.com/api/v4/projects/#{project}/registry/repositories/#{repo}/#{what}") 39 | end 40 | 41 | def delete(project, repo, what) 42 | curl("--request DELETE https://gitlab.com/api/v4/projects/#{project}/registry/repositories/#{repo}/#{what}") 43 | end 44 | 45 | MAX_AGE_DAYS=0.6 46 | 47 | REPOS.each do |project, repos| 48 | repos[:repos].each do |repo| 49 | puts "== #{project} == #{repo} ==" 50 | res = fetch(project, repo, "tags") 51 | res.each do |tag| 52 | if repos[:keep].include? tag['name'] 53 | puts "keeping #{tag['name']} (whitelisted)" 54 | else 55 | info = fetch(project, repo, "tags/#{tag['name']}") 56 | # temporary bypass for a gitlab timestamp bug 57 | # https://gitlab.com/gitlab-org/gitlab/-/issues/352999 58 | timestamp = info['created_at'] 59 | if timestamp.nil? 60 | puts "warning: timestamp missing for #{tag['name']}" 61 | age = 0 62 | else 63 | t = DateTime.parse(timestamp) 64 | age = DateTime.now - t 65 | end 66 | 67 | if age > MAX_AGE_DAYS 68 | puts "delete #{tag['name']} which is #{age.to_f}d old" 69 | puts delete(project, repo, "tags/#{tag['name']}") 70 | else 71 | puts "keeping #{tag['name']} (less than #{MAX_AGE_DAYS}d old)" 72 | end 73 | end 74 | end 75 | end 76 | end 77 | -------------------------------------------------------------------------------- /container/install-test-deps.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | apt-get update 3 | DEBIAN_FRONTEND=noninteractive apt-get -o dir::cache::archives=apt-cache install -y -qq texlive-latex-base xvfb texlive-fonts-extra tcl tk 4 | -------------------------------------------------------------------------------- /demo/demo.R: -------------------------------------------------------------------------------- 1 | # lets define some summation functions running in a nested loop using named args 2 | h <- function(a, b, c, d, e, f) { 3 | 2 * (a + b + c - d - 2) * 4 | 3 * (a + b - c + d - 3) * 5 | 4 * (a - b + c + d - 4) 6 | } 7 | 8 | g <- function(f, e, d, c, b, a) { 9 | res <- 0 10 | for (i in 1:40) { 11 | res <- res + h(a=b, b=c, c=d, d=e, e=f, f=a) 12 | } 13 | res 14 | } 15 | 16 | f <- function() { 17 | res <- 0 18 | for (i in 1:100000) { 19 | res <- res + g(4, 5, 6, a=1, b=2, c=3) 20 | } 21 | res 22 | } 23 | 24 | # R would be quite slow to run these 25 | # Lets instead see how fast the bytecode compiler in R runs them 26 | require(compiler) 27 | f <- cmpfun(f) 28 | h <- cmpfun(h) 29 | print(system.time(f())) 30 | 31 | # Now lets see rjit 32 | source("loadRjit") 33 | 34 | jit.setFlag("recordTypes", FALSE); 35 | jit.setFlag("recompileHot", FALSE); 36 | jit.setFlag("useTypefeedback", FALSE); 37 | jit.setFlag("unsafeOpt", FALSE); 38 | jit.setFlag("staticNamedMatch", FALSE); 39 | 40 | # a helper function 41 | recompile <- function() { 42 | f <<- jit.compile(f) 43 | g <<- jit.compile(g) 44 | h <<- jit.compile(h) 45 | } 46 | 47 | # lets run the example native 48 | recompile() 49 | print(system.time(f())) 50 | 51 | # now lets start recording the types 52 | jit.setFlag("recordTypes", TRUE) 53 | recompile() 54 | print(system.time(f())) 55 | 56 | # uh this is slow, but look we got some useful info 57 | jit.printTypefeedback(h) 58 | jit.printTypefeedback(g) 59 | 60 | # now let put this to use 61 | jit.setFlag("useTypefeedback", TRUE) 62 | jit.setFlag("recompileHot", TRUE) 63 | recompile() 64 | print(system.time(f())) 65 | 66 | # well its, not too exciting yet, since we are really stupid about redundant checks 67 | # let's disable them for a second 68 | jit.setFlag("unsafeOpt", TRUE) 69 | recompile() 70 | print(system.time(f())) 71 | 72 | # now lets do something about the named arguments: 73 | jit.setFlag("staticNamedMatch", TRUE) 74 | recompile() 75 | print(system.time(f())) 76 | -------------------------------------------------------------------------------- /demo/demo_rir.R: -------------------------------------------------------------------------------- 1 | require(compiler) 2 | enableJIT(3) 3 | 4 | j <- function() { 5 | res <- 0 6 | for (k in 1:1000000) { 7 | res <- res + i(a=1, b=2, c=3) 8 | } 9 | res 10 | } 11 | 12 | i <- function(a, b, c) { 13 | id(a + b + c) 14 | } 15 | 16 | id <- function(x) x 17 | 18 | # R would be quite slow to run these 19 | # Lets instead see how fast the bytecode compiler in R runs them 20 | 21 | # Now lets see rjit 22 | source("loadRjit") 23 | 24 | rjit.internal.setFlag("recordTypes", TRUE); 25 | rjit.internal.setFlag("recompileHot", TRUE); 26 | rjit.internal.setFlag("useTypefeedback", TRUE); 27 | rjit.internal.setFlag("unsafeOpt", TRUE); 28 | rjit.internal.setFlag("staticNamedMatch", TRUE); 29 | -------------------------------------------------------------------------------- /demo/demo_rir.txt: -------------------------------------------------------------------------------- 1 | ******************* The functions being demonstrated are ******************* 2 | 3 | j <- function() { 4 | res <- 0 5 | for (k in 1:1000000) { 6 | res <- res + i(a=1, b=2, c=3) 7 | } 8 | res 9 | } 10 | 11 | i <- function(a, b, c) { 12 | id(a + b + c) 13 | } 14 | 15 | id <- function(x) x 16 | 17 | ******************* To demonstrate GNUR ******************* 18 | 19 | run R 20 | 21 | source("demo/demo_rir.R") 22 | 23 | (to print the GNUR bytecode of the id, i, and j functions) 24 | disassemble(cmpfun(id)) 25 | disassemble(cmpfun(i)) 26 | disassemble(cmpfun(j)) 27 | 28 | system.time(j()) - gives the performance of the j function 29 | i(1,2,3) - performance the i function 30 | 31 | ******************* To demonstrate RJIT ******************* 32 | 33 | run R 34 | 35 | source("demo/demo_rir.R") 36 | 37 | (to compile the id, i, and j functions) 38 | 39 | id <- rjit.compile(id) 40 | i <- rjit.compile(i) 41 | j <- rjit.compile(j) 42 | 43 | (to print the llvm bytecode compiled for the id, i, and j functions ) 44 | 45 | rjit.print(id) 46 | rjit.print(i) 47 | rjit.print(j) 48 | 49 | system.time(j()) - gives the performance of the j function in rjit 50 | i(1,2,3) - performance the i function 51 | 52 | ******************* To demonstrate RIR (in a new terminal) ******************* 53 | 54 | run R 55 | 56 | source("demo/demo_rir.R") 57 | 58 | (to compile the id, i, and j functions) 59 | 60 | id <- rir.compile(id) 61 | i <- rir.compile(i) 62 | j <- rir.compile(j) 63 | 64 | (to print the llvm bytecode compiled for the id, i, and j functions ) 65 | 66 | rir.print(id) 67 | rir.print(i) 68 | rir.print(j) 69 | 70 | system.time(j()) - gives the performance of the j function in rir 71 | i(1,2,3) - performance the i function -------------------------------------------------------------------------------- /documentation/development.md: -------------------------------------------------------------------------------- 1 | ## Development Useful Information, Invariants, Assumptions, etc. 2 | 3 | ### General Wisdom (?) 4 | * For almost all pir instruction, an environment argument means that the environment should be set using rir `set_env_` bytecode. 5 | Except `mk_env_`that expects the parent environment as a normal argument on the stack and not as the current environment (value of `*env`) 6 | 7 | ### Speculative Optimizations And Deoptimizations 8 | * The invariant of a deoptimization point is: it is always possible to take it. Soundness relies on that invariant (see "assumption Transparency" in [the sourir paper](https://dl.acm.org/citation.cfm?doid=3177123.3158137)) 9 | 10 | ### SSA And CFG Invariants and Design 11 | ... 12 | -------------------------------------------------------------------------------- /documentation/spec-opt.md: -------------------------------------------------------------------------------- 1 | # Speculative Optimization 2 | 3 | Not all RIR code is converted into PIR, only code which is re-used a lot (currently, when a function is called `PIR_WARMUP` times - defaults to 3 - it gets optimized). This is because, the PIR optimizations themselves take a long time (remember, this is during interpretation) - if an instruction is only run once, it's faster to just run it unoptimized. Furthermore, PIR performs **speculative optimizations**, and it could use the results of previous iterations to formi its assumptions. 4 | 5 | The R programming language is very hard to optimize because you can't make even seemingly-obvious assumptions, there are many "edge-cases". For example, in `a + b`, `a` could be a promise that, when read, modifies `b`. Or, in `x <- 5; f(); print(x)`, `f` could change the value of `x`, or even delete it so that `print` gives a "missing value" error, no matter where `f` was originally defined. 6 | 7 | As a result, PIR's optimizations are speculative. First, PIR makes assumptions - e.g. that `a` doesn't perform any side effects, or `f` doesn't modify variables outside its environment. Then, PIR performs optimizations which would only work under these assumptions, *except* there are checks before the optimizations. The checks are evaluated at runtime, and if they fail, PIR will "deoptimize", and instead of running the (invalid) optimized code, it'll run the original RIR bytecode, or another version with less assumptions. 8 | -------------------------------------------------------------------------------- /documentation/updating-gnur.md: -------------------------------------------------------------------------------- 1 | # Updating GNU R version used by Ř 2 | 3 | Our patched GNU R lives in https://github.com/reactorlabs/gnur. 4 | 5 | It is a mirror of https://github.com/wch/r-source, which in turn mirrors GNU R's official svn (https://svn.r-project.org/R/). 6 | 7 | To update, first set up the `wch/r-source` repo as a remote of our `reactorlabs/gnur` repo. 8 | 9 | Rewrite the history of our patches, such that they are nice and clean. Usually, there will be a couple commits with our patches from the last version update, and then some more commits with the changes we made on the current version (see, eg., https://github.com/reactorlabs/gnur/compare/R-3.5.1...R-3.5.1-rir-patch). 10 | 11 | Check out the branch that we want to target. 12 | 13 | Create a new branch based on it and cherry-pick the cleaned patches into that branch, fixing the merges one by one. 14 | 15 | Update the `custom-r` submodule in the `reactorlabs/rir` repo. 16 | -------------------------------------------------------------------------------- /examples/mandelbrot_mini.R: -------------------------------------------------------------------------------- 1 | mandelbrot_mini <- function() { 2 | n <- 2000L 3 | C <- matrix(0, n, n) 4 | for (y in 0:(n-1)) { 5 | C[, y] <- 2 * 0:(n-1) / n - 1.5 + 1i * (2 * y / n - 1) 6 | } 7 | } 8 | 9 | f <- rir.compile(function() mandelbrot_mini()) 10 | 11 | # Run twice to get realistic type feedback 12 | f() 13 | f() 14 | pir.compile(mandelbrot_mini, debugFlags=pir.debugFlags(PrintPirAfterOpt=TRUE, ShowWarnings=TRUE)) 15 | -------------------------------------------------------------------------------- /examples/tree_mini.r: -------------------------------------------------------------------------------- 1 | test <- function() { 2 | seed <- 74755 3 | 4 | nextRandom <- function() { 5 | seed <<- bitwAnd((seed * 1309) + 13849, 65535) 6 | return (seed) 7 | } 8 | 9 | buildTreeDepth <- function(depth, random) { 10 | if (depth == 1) { 11 | return (c(nextRandom() %% 10 + 1)) 12 | } else { 13 | array <- vector("list", length = 4) 14 | for (i in 1:4) { 15 | array[[i]] <- buildTreeDepth(depth - 1, random) 16 | } 17 | return (array) 18 | } 19 | } 20 | 21 | buildTreeDepth(2, nextRandom()) 22 | } 23 | 24 | f <- rir.compile(function() test()) 25 | 26 | # Run twice to get realistic type feedback 27 | f() 28 | f() 29 | pir.compile(test, debugFlags=pir.debugFlags(PrintPirAfterOpt=TRUE, ShowWarnings=TRUE)) 30 | -------------------------------------------------------------------------------- /prototype/annotation.R: -------------------------------------------------------------------------------- 1 | rir.annotatedFunction <- function(fun_name, fun_obj, annotations) { 2 | parameter_names <- names(annotations$eager)[annotations$eager] 3 | all_parameter_names <- names(formals(fun_obj)) 4 | if (length(setdiff(parameter_names, all_parameter_names)) != 0) { 5 | stop("incorrect parameter names in eager annotation list") 6 | } 7 | force_call_creator <- function(parameter_name) { 8 | if(parameter_name == "...") { 9 | quote(list(...)) 10 | } 11 | else { 12 | substitute(NAME <- NAME, list(NAME = as.name(parameter_name))) 13 | } 14 | } 15 | force_calls <- unname(Map(force_call_creator, parameter_names)) 16 | new_fun_name <- as.symbol(paste0(as.character(fun_name), "_old")) 17 | symbolic_parameter_names <- unname(Map(as.name, all_parameter_names)) 18 | new_body <- bquote({ { ..(force_calls) } 19 | .(new_fun_name) <- .(fun_obj) 20 | .(new_fun_name)(..(symbolic_parameter_names)) 21 | }, 22 | splice = TRUE) 23 | body(fun_obj) <- new_body 24 | fun_obj 25 | } 26 | 27 | f <- function(a, b, c, ...) a + b + c 28 | f <- rir.annotatedFunction("f", f, list(eager = c(a = T, b = F, c = T))) 29 | print(f) 30 | 31 | g <- function(a, b, c, ...) { a + b + c } 32 | g <- rir.annotatedFunction("g", g, list(eager = c(a = T, b = F, c = T, ... = T))) 33 | print(g) 34 | 35 | g(1,2,3, print("hello")) 36 | -------------------------------------------------------------------------------- /rir/src/R/Funtab.h: -------------------------------------------------------------------------------- 1 | #ifndef RIR_FUNTAB_H 2 | #define RIR_FUNTAB_H 3 | 4 | #include "BuiltinIds.h" 5 | #include "R/r.h" 6 | 7 | #include 8 | 9 | static inline int getBuiltinNr(SEXP f) { return f->u.primsxp.offset; } 10 | 11 | static inline CCODE getBuiltin(SEXP f) { 12 | return R_FunTab[getBuiltinNr(f)].cfun; 13 | } 14 | 15 | static inline const char* getBuiltinName(int i) { return R_FunTab[i].name; } 16 | static inline const char* getBuiltinName(SEXP f) { 17 | return getBuiltinName(getBuiltinNr(f)); 18 | } 19 | 20 | static inline int getBuiltinArity(SEXP f) { 21 | return R_FunTab[getBuiltinNr(f)].arity; 22 | } 23 | 24 | static inline int getFlag(int i) { return ((R_FunTab[i].eval) / 100) % 10; } 25 | static inline int getFlag(SEXP f) { return getFlag(getBuiltinNr(f)); } 26 | 27 | static inline SEXP getBuiltinFun(char const* name) { 28 | assert(R_FunTab[rir::blt(name)].eval % 10 == 1 && 29 | "Only use for BUILTINSXP"); 30 | if (R_FunTab[rir::blt(name)].eval % 100 / 10 == 0) 31 | return Rf_install(name)->u.symsxp.value; 32 | else 33 | return Rf_install(name)->u.symsxp.internal; 34 | } 35 | 36 | #endif 37 | -------------------------------------------------------------------------------- /rir/src/R/Preserve.h: -------------------------------------------------------------------------------- 1 | #ifndef RIR_PRESERVE_H 2 | #define RIR_PRESERVE_H 3 | 4 | #include "R/r.h" 5 | #include 6 | 7 | namespace rir { 8 | 9 | class Preserve { 10 | public: 11 | Preserve(const Preserve& other) = delete; 12 | 13 | Preserve() {} 14 | 15 | SEXP operator()(SEXP value) { 16 | R_PreserveObject(value); 17 | p.push_back(value); 18 | return value; 19 | } 20 | 21 | ~Preserve() { 22 | for (auto o : p) 23 | R_ReleaseObject(o); 24 | } 25 | 26 | private: 27 | std::vector p; 28 | }; 29 | 30 | } // namespace rir 31 | 32 | #endif 33 | -------------------------------------------------------------------------------- /rir/src/R/Printing.h: -------------------------------------------------------------------------------- 1 | #ifndef RIR_R_PRINT 2 | #define RIR_R_PRINT 3 | 4 | #include "R/r.h" 5 | 6 | #include 7 | 8 | namespace rir { 9 | 10 | class Print { 11 | public: 12 | // Try to deparse but without triggering eval 13 | static std::string dumpSexp(SEXP s, size_t length = 50); 14 | 15 | private: 16 | static std::string sexptype2char(SEXPTYPE type); 17 | static std::string trim(std::string s, size_t n); 18 | static std::string unsafeTags(SEXP s); 19 | static std::string dumpPROMSXP(SEXP s); 20 | static std::string dumpCLOSXP(SEXP s); 21 | static std::string dumpLISTSXP(SEXP s, size_t limit); 22 | static std::string dumpLANGSXP(SEXP s); 23 | static std::string dumpVector(SEXP s, size_t limit); 24 | static std::string dumpEXTERNALSXP(SEXP s); 25 | }; 26 | 27 | } // namespace rir 28 | 29 | #endif 30 | -------------------------------------------------------------------------------- /rir/src/R/Protect.h: -------------------------------------------------------------------------------- 1 | #ifndef PROTECT_H 2 | #define PROTECT_H 3 | 4 | #include "r.h" 5 | 6 | #include 7 | 8 | namespace rir { 9 | 10 | class Protect { 11 | public: 12 | Protect(const Protect& other) = delete; 13 | 14 | Protect() {} 15 | explicit Protect(SEXP init) { 16 | Rf_protect(init); 17 | ++protectedValues_; 18 | } 19 | 20 | SEXP operator()(SEXP value) { 21 | Rf_protect(value); 22 | ++protectedValues_; 23 | return value; 24 | } 25 | 26 | ~Protect() { Rf_unprotect(protectedValues_); } 27 | 28 | private: 29 | /* Prevents heap allocation. */ 30 | void* operator new(size_t); 31 | void* operator new[](size_t); 32 | void operator delete(void*); 33 | void operator delete[](void*); 34 | 35 | unsigned protectedValues_ = 0; 36 | }; 37 | 38 | } // namespace rir 39 | 40 | #endif // PROTECT_H 41 | -------------------------------------------------------------------------------- /rir/src/R/RList.cpp: -------------------------------------------------------------------------------- 1 | #include "RList.h" 2 | #include "r.h" 3 | #include 4 | 5 | namespace rir { 6 | 7 | RList::RList(SEXP list) : list(list ? list : R_NilValue) { 8 | assert(TYPEOF(list) == LISTSXP || TYPEOF(list) == LANGSXP || 9 | TYPEOF(list) == NILSXP || TYPEOF(list) == DOTSXP); 10 | } 11 | 12 | SEXP RListIter::tag() { return TAG(pos); } 13 | bool RListIter::hasTag() { return tag() != R_NilValue; } 14 | 15 | SEXP RListIter::operator*() { return CAR(pos); } 16 | 17 | void RListIter::operator++() { pos = CDR(pos); } 18 | 19 | RListIter RListIter::operator+(unsigned n) { 20 | RListIter i(pos); 21 | while (n--) 22 | ++i; 23 | return i; 24 | } 25 | 26 | SEXP RList::operator[](size_t idx) { 27 | SEXP pos = list; 28 | while (idx-- > 0) { 29 | assert(pos != R_NilValue); 30 | pos = CDR(pos); 31 | } 32 | return CAR(pos); 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /rir/src/R/RList.h: -------------------------------------------------------------------------------- 1 | #ifndef RLIST_H 2 | #define RLIST_H 3 | 4 | #include "r.h" 5 | 6 | #include 7 | 8 | namespace rir { 9 | 10 | class RListIter { 11 | public: 12 | SEXP pos; 13 | 14 | explicit RListIter(SEXP pos) : pos(pos) {} 15 | 16 | SEXP tag(); 17 | bool hasTag(); 18 | 19 | SEXP operator*(); 20 | 21 | void operator++(); 22 | 23 | RListIter operator+(unsigned n); 24 | 25 | bool operator!=(const RListIter& other) { return pos != other.pos; } 26 | }; 27 | 28 | class RList { 29 | SEXP list; 30 | 31 | public: 32 | explicit RList(SEXP list); 33 | 34 | RListIter begin() const { return RListIter(list); } 35 | 36 | SEXP operator[](size_t idx); 37 | 38 | static RListIter& end() { 39 | static RListIter end(R_NilValue); 40 | return end; 41 | } 42 | 43 | size_t length() const { 44 | size_t len = 0; 45 | for (auto b = begin(); b != end(); ++b) 46 | ++len; 47 | return len; 48 | } 49 | }; 50 | 51 | } // namespace rir 52 | 53 | #endif 54 | -------------------------------------------------------------------------------- /rir/src/R/Serialize.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include 4 | 5 | #define REXPORT extern "C" 6 | 7 | REXPORT SEXP R_serialize(SEXP object, SEXP icon, SEXP ascii, SEXP Sversion, 8 | SEXP fun); 9 | REXPORT SEXP R_unserialize(SEXP icon, SEXP fun); 10 | REXPORT void R_SaveToFile(SEXP, FILE*, int); 11 | REXPORT SEXP R_LoadFromFile(FILE*, int); 12 | REXPORT void WriteItem(SEXP s, SEXP ref_table, R_outpstream_t stream); 13 | REXPORT SEXP ReadItem(SEXP ref_table, R_inpstream_t stream); 14 | REXPORT void HashAdd(SEXP obj, SEXP ht); 15 | REXPORT void AddReadRef(SEXP table, SEXP value); 16 | REXPORT void OutStringVec(R_outpstream_t stream, SEXP s, SEXP ref_table); 17 | REXPORT void WriteBC(SEXP s, SEXP ref_table, R_outpstream_t stream); 18 | REXPORT SEXP ReadBC(SEXP ref_table, R_inpstream_t stream); 19 | REXPORT void OutInteger(R_outpstream_t stream, int i); 20 | REXPORT void OutReal(R_outpstream_t stream, double d); 21 | REXPORT void OutComplex(R_outpstream_t stream, Rcomplex c); 22 | REXPORT void OutByte(R_outpstream_t stream, Rbyte i); 23 | REXPORT void OutString(R_outpstream_t stream, const char* s, int length); 24 | REXPORT void InWord(R_inpstream_t stream, char* buf, int size); 25 | REXPORT int InInteger(R_inpstream_t stream); 26 | REXPORT double InReal(R_inpstream_t stream); 27 | REXPORT Rcomplex InComplex(R_inpstream_t stream); 28 | REXPORT void InString(R_inpstream_t stream, char* buf, int length); 29 | REXPORT void OutRefIndex(R_outpstream_t stream, int i); 30 | REXPORT int InRefIndex(R_inpstream_t stream, int flags); 31 | REXPORT void OutStringVec(R_outpstream_t stream, SEXP s, SEXP ref_table); 32 | 33 | static inline void OutChar(R_outpstream_t stream, int chr) { 34 | stream->OutChar(stream, chr); 35 | } 36 | 37 | static inline int InChar(R_inpstream_t stream) { 38 | return stream->InChar(stream); 39 | } 40 | 41 | static inline void OutBytes(R_outpstream_t stream, const void* buf, 42 | int length) { 43 | stream->OutBytes(stream, (void*)buf, length); 44 | } 45 | 46 | static inline void InBytes(R_inpstream_t stream, void* buf, int length) { 47 | stream->InBytes(stream, buf, length); 48 | } 49 | -------------------------------------------------------------------------------- /rir/src/R/Symbols.cpp: -------------------------------------------------------------------------------- 1 | #include "Symbols.h" 2 | 3 | namespace rir { 4 | namespace symbol { 5 | 6 | #define V(name, txt) SEXP name = Rf_install(txt); 7 | SYMBOLS(V) 8 | #undef V 9 | 10 | } // namespace symbol 11 | } // namespace rir 12 | -------------------------------------------------------------------------------- /rir/src/R/Symbols.h: -------------------------------------------------------------------------------- 1 | #ifndef SYMBOLS_H_ 2 | #define SYMBOLS_H_ 3 | 4 | #include "r.h" 5 | #include "symbol_list.h" 6 | 7 | namespace rir { 8 | namespace symbol { 9 | 10 | #define V(name, txt) extern SEXP name; 11 | SYMBOLS(V) 12 | #undef V 13 | 14 | } // namespace symbol 15 | } // namespace rir 16 | 17 | #endif // SYMBOLS_H_ 18 | -------------------------------------------------------------------------------- /rir/src/R/r_incl.h: -------------------------------------------------------------------------------- 1 | #ifndef RIR_R_INCL_H 2 | #define RIR_R_INCL_H 3 | 4 | typedef unsigned int SEXPTYPE; 5 | struct SEXPREC; 6 | typedef SEXPREC* SEXP; 7 | typedef struct R_inpstream_st* R_inpstream_t; 8 | struct R_inpstream_st; 9 | typedef struct R_outpstream_st* R_outpstream_t; 10 | struct R_outpstream_st; 11 | 12 | #endif 13 | -------------------------------------------------------------------------------- /rir/src/api.h: -------------------------------------------------------------------------------- 1 | #ifndef API_H_ 2 | #define API_H_ 3 | 4 | #include "R/r.h" 5 | #include "compiler/log/debug.h" 6 | #include "runtime/Context.h" 7 | 8 | #include 9 | 10 | #define REXPORT extern "C" 11 | 12 | extern int R_ENABLE_JIT; 13 | 14 | REXPORT SEXP rirInvocationCount(SEXP what); 15 | REXPORT SEXP pirCompileWrapper(SEXP closure, SEXP name, SEXP debugFlags, 16 | SEXP debugStyle); 17 | REXPORT SEXP rirCompile(SEXP what, SEXP env); 18 | REXPORT SEXP pirTests(); 19 | REXPORT SEXP pirCheck(SEXP f, SEXP check, SEXP env); 20 | REXPORT SEXP pirSetDebugFlags(SEXP debugFlags); 21 | SEXP pirCompile(SEXP closure, const rir::Context& assumptions, 22 | const std::string& name, const rir::pir::DebugOptions& debug); 23 | extern SEXP rirOptDefaultOpts(SEXP closure, const rir::Context&, SEXP name); 24 | extern SEXP rirOptDefaultOptsDryrun(SEXP closure, const rir::Context&, 25 | SEXP name); 26 | REXPORT SEXP rirSerialize(SEXP data, SEXP file); 27 | REXPORT SEXP rirDeserialize(SEXP file); 28 | 29 | REXPORT SEXP rirSetUserContext(SEXP f, SEXP udc); 30 | REXPORT SEXP rirCreateSimpleIntContext(); 31 | 32 | // this method is just to have an easy way to play around with the code and get 33 | // feedback by calling .Call('playground') 34 | REXPORT SEXP playground(); 35 | 36 | #endif // API_H_ 37 | -------------------------------------------------------------------------------- /rir/src/bc/CodeVerifier.h: -------------------------------------------------------------------------------- 1 | #ifndef CODE_VERIFIER_H 2 | #define CODE_VERIFIER_H 3 | 4 | #include "interpreter/interp_incl.h" 5 | 6 | namespace rir { 7 | 8 | /** Various verifications of the ::Code and ::Function objects. 9 | */ 10 | class CodeVerifier { 11 | public: 12 | /** Verifies the stack layout of the Code object and updates its ostack and 13 | * istack requirements. 14 | */ 15 | static void calculateAndVerifyStack(Code* code); 16 | 17 | /** Verifies that the given function object is valid. 18 | */ 19 | static void verifyFunctionLayout(SEXP sexp); 20 | }; 21 | 22 | } // namespace rir 23 | 24 | #endif // STACK_VERIFIER_H 25 | -------------------------------------------------------------------------------- /rir/src/common.cpp: -------------------------------------------------------------------------------- 1 | #include "common.h" 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | 10 | #undef assert 11 | 12 | void printCBacktrace() { 13 | std::cerr << "\nC Backtrace\n\n"; 14 | void* array[128]; 15 | 16 | // get void*'s for all entries on the stack 17 | // see `man backtrace` for details 18 | int size = backtrace(array, 128); 19 | 20 | char** messages = backtrace_symbols(array, size); 21 | 22 | /* skip first stack frame (points here) */ 23 | for (int i = 1; i < size && messages != nullptr; ++i) { 24 | // The entries of the backtrace contain the mangled C++ symbols in 25 | // parens. This part extracts the name and demangles it. 26 | std::string msg = messages[i]; 27 | auto namestart = msg.find("("); 28 | auto nameend = msg.find(")"); 29 | if (namestart == std::string::npos || nameend == std::string::npos) { 30 | std::cerr << msg << "\n"; 31 | } else { 32 | auto name = msg.substr(namestart + 1, nameend - namestart - 1); 33 | auto plus = name.rfind("+"); 34 | auto offset = name.substr(plus + 1); 35 | name = name.substr(0, plus); 36 | int status; 37 | auto realname = abi::__cxa_demangle(name.c_str(), 0, 0, &status); 38 | std::cerr << realname << "+" << offset << "\n"; 39 | free(realname); 40 | } 41 | } 42 | 43 | free(messages); 44 | } 45 | -------------------------------------------------------------------------------- /rir/src/common.h: -------------------------------------------------------------------------------- 1 | #ifndef RIR_COMMON_H 2 | #define RIR_COMMON_H 3 | 4 | #include 5 | #include 6 | 7 | extern void printCBacktrace(); 8 | extern void printRBacktrace(); 9 | extern void printBacktrace(); 10 | 11 | #ifdef ENABLE_SLOWASSERT 12 | #define SLOWASSERT(what) assert(what) 13 | #else 14 | #define SLOWASSERT(what) \ 15 | {} 16 | #endif 17 | 18 | // from boost 19 | #include 20 | template 21 | inline std::size_t hash_combine(std::size_t seed, const T& v) { 22 | std::hash hasher; 23 | return hasher(v) + 0x9e3779b9 + (seed << 6) + (seed >> 2); 24 | } 25 | 26 | struct pairhash { 27 | public: 28 | template 29 | std::size_t operator()(const std::pair& x) const { 30 | return hash_combine(hash_combine(0, x.first), x.second); 31 | } 32 | }; 33 | 34 | #endif 35 | -------------------------------------------------------------------------------- /rir/src/compiler/analysis/abstract_result.h: -------------------------------------------------------------------------------- 1 | #ifndef PIR_ABSTRACT_RESULT_H 2 | #define PIR_ABSTRACT_RESULT_H 3 | 4 | namespace rir { 5 | namespace pir { 6 | 7 | struct AbstractResult { 8 | enum Kind { None, Updated, LostPrecision, Tainted }; 9 | Kind kind; 10 | bool keepSnapshot = false; 11 | bool needRecursion = false; 12 | 13 | // cppcheck-suppress noExplicitConstructor 14 | AbstractResult(Kind kind) : kind(kind) {} 15 | AbstractResult() : kind(None) {} 16 | 17 | bool operator>(const AbstractResult& other) const { 18 | return kind > other.kind; 19 | } 20 | bool operator>=(const AbstractResult& other) const { 21 | return kind >= other.kind; 22 | } 23 | bool operator==(const AbstractResult& other) const { 24 | return kind == other.kind; 25 | } 26 | 27 | const AbstractResult& max(const AbstractResult& other) { 28 | if (kind < other.kind) 29 | kind = other.kind; 30 | return *this; 31 | } 32 | 33 | void lostPrecision() { max(LostPrecision); } 34 | 35 | void taint() { max(Tainted); } 36 | 37 | void update() { max(Updated); } 38 | }; 39 | 40 | } // namespace pir 41 | } // namespace rir 42 | 43 | #endif 44 | -------------------------------------------------------------------------------- /rir/src/compiler/analysis/context_stack.h: -------------------------------------------------------------------------------- 1 | #ifndef PIR_UNNECESSARY_CONTEXTS_H 2 | #define PIR_UNNECESSARY_CONTEXTS_H 3 | 4 | #include "abstract_value.h" 5 | #include "compiler/analysis/cfg.h" 6 | #include "generic_static_analysis.h" 7 | 8 | namespace rir { 9 | namespace pir { 10 | 11 | struct ContextStackState { 12 | std::vector contextStack; 13 | void eachLeakedEnvRev(std::function it) const { 14 | for (auto i = contextStack.rbegin(); i != contextStack.rend(); ++i) 15 | if (auto mk = MkEnv::Cast((*i)->env())) 16 | it(mk); 17 | } 18 | size_t numContexts() const { return contextStack.size(); } 19 | AbstractResult merge(const ContextStackState& other) { 20 | assert(contextStack.size() == other.contextStack.size() && 21 | "stack imbalance"); 22 | return AbstractResult::None; 23 | } 24 | AbstractResult mergeExit(const ContextStackState& other) { 25 | return merge(other); 26 | } 27 | void print(std::ostream& out, bool tty) const { 28 | out << "Contexts: "; 29 | for (auto c : contextStack) { 30 | c->printRef(out); 31 | out << " "; 32 | } 33 | out << "\n"; 34 | } 35 | }; 36 | 37 | class ContextStack : public StaticAnalysis { 38 | public: 39 | ContextStack(ClosureVersion* cls, Code* code, AbstractLog& log) 40 | : StaticAnalysis("ContextStack", cls, code, log) {} 41 | 42 | AbstractResult apply(ContextStackState& state, 43 | Instruction* i) const override { 44 | 45 | if (auto push = PushContext::Cast(i)) { 46 | state.contextStack.push_back(push); 47 | return AbstractResult::Updated; 48 | } 49 | 50 | if (auto pop = PopContext::Cast(i)) { 51 | assert(PushContext::Cast(pop->push())); 52 | assert(state.contextStack.back() == pop->push()); 53 | state.contextStack.pop_back(); 54 | return AbstractResult::Updated; 55 | } 56 | 57 | if (Deopt::Cast(i) || Unreachable::Cast(i)) { 58 | state.contextStack.clear(); 59 | return AbstractResult::Updated; 60 | } 61 | 62 | return AbstractResult::None; 63 | } 64 | }; 65 | 66 | } // namespace pir 67 | } // namespace rir 68 | 69 | #endif 70 | -------------------------------------------------------------------------------- /rir/src/compiler/analysis/dead.h: -------------------------------------------------------------------------------- 1 | #ifndef PIR_DEAD_H 2 | #define PIR_DEAD_H 3 | 4 | #include "../pir/instruction.h" 5 | #include "compiler/pir/pir.h" 6 | #include "compiler/pir/tag.h" 7 | #include 8 | 9 | namespace rir { 10 | namespace pir { 11 | 12 | constexpr static std::initializer_list TypecheckInstrsList = { 13 | Tag::IsType, Tag::CastType, Tag::FrameState}; 14 | constexpr static std::initializer_list BoxedUsesInstrsList = { 15 | Tag::MkEnv, Tag::StVar, Tag::UpdatePromise, Tag::Call, Tag::NamedCall, 16 | Tag::MkArg, Tag::DotsList, Tag::FrameState}; 17 | constexpr static std::initializer_list IgnoreIntVsReal = { 18 | Tag::ColonCastLhs, 19 | Tag::ColonCastRhs, 20 | Tag::CastType, 21 | Tag::IsType, 22 | Tag::Lte, 23 | Tag::Lt, 24 | Tag::Gt, 25 | Tag::Gte, 26 | Tag::Eq, 27 | Tag::Neq, 28 | Tag::AsLogical, 29 | Tag::Identical, 30 | Tag::CheckTrueFalse, 31 | Tag::LAnd, 32 | Tag::LOr, 33 | Tag::Not}; 34 | 35 | class DeadInstructions { 36 | std::unordered_set unused_; 37 | 38 | public: 39 | enum DeadInstructionsMode { 40 | CountAll, 41 | IgnoreUpdatePromise, 42 | IgnoreTypeTests, 43 | IgnoreBoxedUses, 44 | IgnoreUsesThatDontObserveIntVsReal, 45 | }; 46 | 47 | DeadInstructions(Code*, uint8_t maxBurstSize, Effects ignoreEffects, 48 | DeadInstructionsMode mode = CountAll); 49 | bool isAlive(Value* v); 50 | bool isAlive(Instruction* v); 51 | bool isDead(Value* v); 52 | bool isDead(Instruction* v); 53 | }; 54 | 55 | } // namespace pir 56 | } // namespace rir 57 | 58 | #endif 59 | -------------------------------------------------------------------------------- /rir/src/compiler/analysis/last_env.h: -------------------------------------------------------------------------------- 1 | #ifndef PIR_LAST_ENV_H 2 | #define PIR_LAST_ENV_H 3 | 4 | #include "abstract_value.h" 5 | #include "generic_static_analysis.h" 6 | 7 | namespace rir { 8 | namespace pir { 9 | 10 | class LastEnv : public StaticAnalysis> { 11 | public: 12 | LastEnv(ClosureVersion* cls, Code* code, AbstractLog& log) 13 | : StaticAnalysis("Last Env", cls, code, log) {} 14 | 15 | static bool explicitEnvValue(Instruction* instr) { 16 | return MkEnv::Cast(instr) || IsEnvStub::Cast(instr); 17 | } 18 | 19 | AbstractResult apply(AbstractUnique& state, 20 | Instruction* i) const override { 21 | Value* env = nullptr; 22 | if (i->mayHaveEnv()) 23 | env = i->env(); 24 | if (CallSafeBuiltin::Cast(i)) 25 | env = Env::elided(); 26 | if (env && !explicitEnvValue(i) && env != state.get()) { 27 | state.set(env); 28 | return AbstractResult::Updated; 29 | } 30 | // pop_context_ does not restore env 31 | if (state.get() && PopContext::Cast(i)) { 32 | state.clear(); 33 | return AbstractResult::Updated; 34 | } 35 | return AbstractResult::None; 36 | } 37 | 38 | bool envStillValid(Instruction* i) { return currentEnv(i) == i->env(); } 39 | 40 | Value* currentEnv(Instruction* i) { return before(i).get(); } 41 | }; 42 | 43 | } // namespace pir 44 | } // namespace rir 45 | 46 | #endif 47 | -------------------------------------------------------------------------------- /rir/src/compiler/analysis/query.cpp: -------------------------------------------------------------------------------- 1 | #include "query.h" 2 | #include "../pir/pir_impl.h" 3 | #include "../util/visitor.h" 4 | #include "R/Symbols.h" 5 | #include "utils/Pool.h" 6 | 7 | namespace rir { 8 | namespace pir { 9 | 10 | bool Query::noDeopt(Code* c) { 11 | return Visitor::check(c->entry, 12 | [](Instruction* i) { return !Deopt::Cast(i); }); 13 | } 14 | 15 | bool Query::noEnv(Code* c) { 16 | return Visitor::check(c->entry, 17 | [](Instruction* i) { return !MkEnv::Cast(i); }); 18 | } 19 | 20 | bool Query::noParentEnv(Code* c) { 21 | return Visitor::check(c->entry, 22 | [](Instruction* i) { 23 | return !i->hasEnv() || i->env() != Env::notClosed(); 24 | }); 25 | } 26 | 27 | bool Query::noEnvSpec(Code* c) { 28 | return Visitor::check(c->entry, [](Instruction* i) { 29 | if (MkEnv::Cast(i) && !MkEnv::Cast(i)->stub) { 30 | auto env = MkEnv::Cast(i); 31 | return env->bb()->isDeopt(); 32 | } 33 | return true; 34 | }); 35 | } 36 | 37 | bool Query::pure(Code* c) { 38 | return Visitor::check( 39 | c->entry, [&](Instruction* i) { return !i->hasStrongEffects(); }); 40 | } 41 | 42 | bool Query::pureExceptDeopt(Code* c) { 43 | return Visitor::check(c->entry, [&](Instruction* i) { 44 | return !i->hasStrongEffects() || Deopt::Cast(i); 45 | }); 46 | } 47 | 48 | PirType Query::returnType(Code* c) { 49 | struct { 50 | PirType t = PirType::bottom(); 51 | bool seen = false; 52 | } ret; 53 | Visitor::run(c->entry, [&](BB* bb) { 54 | if (bb->isExit()) { 55 | if (auto r = Return::Cast(bb->last())) { 56 | auto t = r->arg(0).val()->type; 57 | if (!ret.seen) { 58 | ret.seen = true; 59 | ret.t = t; 60 | } else { 61 | ret.t = ret.t | t; 62 | } 63 | } 64 | } 65 | }); 66 | return ret.t; 67 | } 68 | 69 | std::unordered_set Query::returned(Code* c) { 70 | std::unordered_set returned; 71 | Visitor::run(c->entry, [&](BB* bb) { 72 | if (!bb->isEmpty() && Return::Cast(bb->last())) 73 | returned.insert(bb->last()->arg(0).val()); 74 | }); 75 | return returned; 76 | } 77 | 78 | } // namespace pir 79 | } // namespace rir 80 | -------------------------------------------------------------------------------- /rir/src/compiler/analysis/query.h: -------------------------------------------------------------------------------- 1 | #ifndef COMPILER_PIR_QUERY_H 2 | #define COMPILER_PIR_QUERY_H 3 | 4 | #include "../pir/pir.h" 5 | 6 | #include 7 | 8 | namespace rir { 9 | struct Code; 10 | struct Function; 11 | namespace pir { 12 | 13 | /* 14 | * Simple queries, that should be O(n) to compute 15 | * 16 | */ 17 | class Query { 18 | public: 19 | static bool pure(Code* c); 20 | static bool pureExceptDeopt(Code* c); 21 | static bool noEnv(Code* c); 22 | static bool noParentEnv(Code* c); 23 | static bool noEnvSpec(Code* c); 24 | static bool noDeopt(Code* c); 25 | static PirType returnType(Code* c); 26 | static std::unordered_set returned(Code* c); 27 | }; 28 | 29 | } // namespace pir 30 | } // namespace rir 31 | 32 | #endif 33 | -------------------------------------------------------------------------------- /rir/src/compiler/analysis/range.cpp: -------------------------------------------------------------------------------- 1 | #include "range.h" 2 | 3 | namespace rir { 4 | namespace pir { 5 | 6 | Range Range::MAX = {INT_MIN, INT_MAX}; 7 | 8 | Range Range::NEG = {INT_MIN, -1}; 9 | Range Range::ABOVE0 = {1, INT_MAX}; 10 | Range Range::POS = {0, INT_MAX}; 11 | 12 | Range Range::ZERO = {0, 0}; 13 | Range Range::ONE = {1, 1}; 14 | 15 | } // namespace pir 16 | } // namespace rir 17 | -------------------------------------------------------------------------------- /rir/src/compiler/analysis/verifier.h: -------------------------------------------------------------------------------- 1 | #ifndef COMPILER_PIR_VERIFIER_H 2 | #define COMPILER_PIR_VERIFIER_H 3 | 4 | #include "../pir/pir.h" 5 | 6 | #include 7 | 8 | namespace rir { 9 | namespace pir { 10 | 11 | class Verify { 12 | public: 13 | static void apply(ClosureVersion*, const std::string& msg, 14 | bool slow = false); 15 | }; 16 | 17 | } // namespace pir 18 | } // namespace rir 19 | 20 | #endif 21 | -------------------------------------------------------------------------------- /rir/src/compiler/analysis/visibility.cpp: -------------------------------------------------------------------------------- 1 | #include "visibility.h" 2 | #include "R/Funtab.h" 3 | 4 | namespace rir { 5 | namespace pir { 6 | 7 | AbstractResult VisibilityAnalysis::apply(LastVisibilityUpdate& vis, 8 | Instruction* i) const { 9 | AbstractResult res; 10 | if (Deopt::Cast(i)) { 11 | // There is a dependency cycle: 12 | // Deopt observes visibility <=> visibility keeps checkpoint alive 13 | // In case of deopt we risk getting visibility wrong, so let's not 14 | // bother here either. 15 | vis.observable.clear(); 16 | res.update(); 17 | } else if (i->effects.contains(Effect::Visibility)) { 18 | switch (i->visibilityFlag()) { 19 | case VisibilityFlag::On: 20 | case VisibilityFlag::Off: 21 | // Always changes visibility, overrides previous changes 22 | if (vis.observable.size() != 1 || *vis.observable.begin() != i) { 23 | vis.observable.clear(); 24 | vis.observable.insert(i); 25 | res.update(); 26 | } 27 | break; 28 | case VisibilityFlag::Unknown: 29 | // Maybe changes visibility, need to keep previous if it doesn't 30 | if (!vis.observable.count(i)) { 31 | vis.observable.insert(i); 32 | res.update(); 33 | } 34 | break; 35 | default: 36 | assert(false); 37 | } 38 | } 39 | return res; 40 | } 41 | 42 | } // namespace rir 43 | } // namespace pir 44 | -------------------------------------------------------------------------------- /rir/src/compiler/analysis/visibility.h: -------------------------------------------------------------------------------- 1 | #ifndef PIR_VISIBILITY_H 2 | #define PIR_VISIBILITY_H 3 | 4 | #include "abstract_value.h" 5 | #include "generic_static_analysis.h" 6 | 7 | namespace rir { 8 | namespace pir { 9 | 10 | class LastVisibilityUpdate { 11 | public: 12 | std::unordered_set observable; 13 | 14 | AbstractResult mergeExit(const LastVisibilityUpdate& other) { 15 | return merge(other); 16 | } 17 | 18 | AbstractResult merge(const LastVisibilityUpdate& other) { 19 | AbstractResult res; 20 | for (auto& v : other.observable) { 21 | if (!observable.count(v)) { 22 | observable.insert(v); 23 | res.update(); 24 | } 25 | } 26 | return res; 27 | } 28 | 29 | void print(std::ostream& out, bool tty) const { 30 | out << "Observable: "; 31 | for (auto& o : observable) { 32 | o->printRef(out); 33 | out << " "; 34 | } 35 | out << "\n"; 36 | } 37 | }; 38 | 39 | class VisibilityAnalysis : public StaticAnalysis { 40 | public: 41 | VisibilityAnalysis(ClosureVersion* cls, Code* code, AbstractLog& log) 42 | : StaticAnalysis("VisibilityAnalysis", cls, code, log) {} 43 | 44 | AbstractResult apply(LastVisibilityUpdate& vis, 45 | Instruction* i) const override final; 46 | 47 | bool observed(Instruction* i) { return result().observable.count(i); } 48 | }; 49 | 50 | } // namespace pir 51 | } // namespace rir 52 | 53 | #endif 54 | -------------------------------------------------------------------------------- /rir/src/compiler/backend.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "R/Preserve.h" 4 | #include "compiler/log/debug.h" 5 | #include "compiler/log/loggers.h" 6 | #include "compiler/native/pir_jit_llvm.h" 7 | #include "compiler/pir/module.h" 8 | #include "compiler/pir/pir.h" 9 | #include "runtime/Function.h" 10 | 11 | #include 12 | #include 13 | 14 | namespace rir { 15 | namespace pir { 16 | 17 | class Backend { 18 | public: 19 | Backend(Module* m, Log& logger, const std::string& name) 20 | : module(m), jit(name), logger(logger) {} 21 | ~Backend() { jit.finalize(); } 22 | Backend(const Backend&) = delete; 23 | Backend& operator=(const Backend&) = delete; 24 | 25 | rir::Function* getOrCompile(ClosureVersion* cls); 26 | 27 | private: 28 | struct LastDestructor { 29 | LastDestructor(); 30 | ~LastDestructor(); 31 | }; 32 | LastDestructor firstMember_; 33 | Preserve preserve; 34 | 35 | Module* module; 36 | PirJitLLVM jit; 37 | std::unordered_map done; 38 | Log& logger; 39 | 40 | rir::Function* doCompile(ClosureVersion* cls, ClosureLog& log); 41 | }; 42 | 43 | } // namespace pir 44 | } // namespace rir 45 | -------------------------------------------------------------------------------- /rir/src/compiler/log/log.h: -------------------------------------------------------------------------------- 1 | #ifndef PIR_LOG_H 2 | #define PIR_LOG_H 3 | 4 | #include "compiler/pir/pir.h" 5 | #include "debug.h" 6 | #include "loggers.h" 7 | 8 | namespace rir { 9 | 10 | struct Function; 11 | 12 | namespace pir { 13 | 14 | class Log { 15 | static size_t logId; 16 | 17 | public: 18 | ~Log(); 19 | 20 | explicit Log(const DebugOptions& options); 21 | Log(const Log&) = delete; 22 | Log& operator=(const Log&) = delete; 23 | 24 | ClosureLog& open(ClosureVersion* cls); 25 | ClosureLog& get(ClosureVersion* cls) { 26 | if (!streams.count(cls)) 27 | open(cls); 28 | return streams.at(cls); 29 | } 30 | 31 | void title(const std::string& msg); 32 | void warn(const std::string& msg); 33 | 34 | void flushAll(); 35 | 36 | void close(ClosureVersion* cls) { 37 | auto it = streams.find(cls); 38 | assert(it != streams.end()); 39 | streams.erase(it); 40 | } 41 | 42 | private: 43 | std::unordered_map streams; 44 | DebugOptions options; 45 | }; 46 | 47 | } // namespace pir 48 | } // namespace rir 49 | 50 | #endif 51 | -------------------------------------------------------------------------------- /rir/src/compiler/log/sinks.cpp: -------------------------------------------------------------------------------- 1 | #include "sinks.h" 2 | 3 | #include "compiler/opt/pass.h" 4 | #include "compiler/pir/closure.h" 5 | #include "compiler/pir/closure_version.h" 6 | #include "runtime/Function.h" 7 | #include "utils/Pool.h" 8 | #include "utils/Terminal.h" 9 | #include "utils/filesystem.h" 10 | 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | 17 | #include 18 | 19 | namespace rir { 20 | namespace pir { 21 | 22 | std::ostream& FileLogStream::out() { 23 | if (fstream_.get()) 24 | return *fstream_; 25 | fstream_.reset(new std::ofstream(fileName)); 26 | if (!fstream_->good()) { 27 | std::cerr << "Warning: FileLogStream(" << fileName 28 | << ") error: " << strerror(errno) << "\n"; 29 | } 30 | return out(); 31 | } 32 | 33 | bool FileLogStream::closeFile() { 34 | if (fstream_.get() && fstream_->is_open()) { 35 | fstream_->flush(); 36 | fstream_->close(); 37 | return true; 38 | } 39 | return false; 40 | } 41 | 42 | FileLogStream::~FileLogStream() { 43 | flush(); 44 | closeFile(); 45 | } 46 | 47 | static void ignore(int m) {} 48 | DotFileLogStream::~DotFileLogStream() { 49 | flush(); 50 | if (closeFile()) 51 | ignore(system(("dot -Tpdf -O '" + fileName + "'&").c_str())); 52 | } 53 | 54 | BufferedLogStream::~BufferedLogStream() { BufferedLogStream::flush(); } 55 | 56 | bool BufferedLogStream::tty() { return ConsoleColor::isTTY(actualOut); } 57 | bool UnbufferedLogStream::tty() { return ConsoleColor::isTTY(out()); } 58 | 59 | } // namespace pir 60 | } // namespace rir 61 | -------------------------------------------------------------------------------- /rir/src/compiler/native/allocator.h: -------------------------------------------------------------------------------- 1 | #ifndef RSH_NATIVE_ALLOCATOR 2 | #define RSH_NATIVE_ALLOCATOR 3 | 4 | #include "compiler/analysis/cfg.h" 5 | #include "compiler/analysis/liveness.h" 6 | #include "compiler/pir/pir.h" 7 | 8 | namespace rir { 9 | namespace pir { 10 | 11 | /* 12 | * NativeAllocator assigns each instruction to a local variable number, or the 13 | * stack. It uses the following algorithm: 14 | * 15 | * 1. Split phis with moves. This translates the IR to CSSA (see toCSSA). 16 | * 2. Compute liveness (see liveness.h): 17 | * 3. For now, just put everything on stack. (step 4 is thus skipped...) 18 | * 4. Assign the remaining Instructions to local RIR variable numbers 19 | * (see computeAllocation): 20 | * 1. Coalesce all remaining phi with their inputs. This is save since we are 21 | * already in CSSA. Directly allocate a register on the fly, such that. 22 | * 2. Traverse the dominance tree and eagerly allocate the remaining ones 23 | * 5. For debugging, verify the assignment with a static analysis that simulates 24 | * the variable and stack usage (see verify). 25 | */ 26 | class NativeAllocator { 27 | private: 28 | typedef unsigned Slot; 29 | 30 | Code* code; 31 | DominanceGraph dom; 32 | 33 | const LivenessIntervals& livenessIntervals; 34 | 35 | const static Slot unassignedSlot = 0; 36 | size_t slots_ = 0; 37 | 38 | std::unordered_map allocation; 39 | std::unordered_map hints; 40 | 41 | bool needsASlot(Instruction* i) const; 42 | void compute(); 43 | void verify(); 44 | 45 | public: 46 | NativeAllocator(Code* code, const LivenessIntervals& livenessIntervals); 47 | bool needsAVariable(Instruction* i) const; 48 | Slot operator[](Instruction* i) const; 49 | size_t slots() const; 50 | }; 51 | 52 | } // namespace pir 53 | } // namespace rir 54 | 55 | #endif 56 | -------------------------------------------------------------------------------- /rir/src/compiler/native/pass_schedule_llvm.h: -------------------------------------------------------------------------------- 1 | #ifndef RIR_COMPILER_PASS_SCHEDULE_LLVM_H 2 | #define RIR_COMPILER_PASS_SCHEDULE_LLVM_H 3 | 4 | #include "llvm/ExecutionEngine/Orc/Core.h" 5 | #include "llvm/ExecutionEngine/Orc/ThreadSafeModule.h" 6 | #include "llvm/IR/LegacyPassManager.h" 7 | #include "llvm/Support/Error.h" 8 | #include "llvm/Transforms/IPO/PassManagerBuilder.h" 9 | 10 | #include 11 | 12 | namespace rir { 13 | namespace pir { 14 | 15 | class PassScheduleLLVM { 16 | public: 17 | llvm::Expected 18 | operator()(llvm::orc::ThreadSafeModule TSM, 19 | llvm::orc::MaterializationResponsibility& R); 20 | 21 | PassScheduleLLVM(); 22 | 23 | private: 24 | static std::unique_ptr PM; 25 | }; 26 | 27 | } // namespace pir 28 | } // namespace rir 29 | 30 | #endif 31 | -------------------------------------------------------------------------------- /rir/src/compiler/native/representation_llvm.cpp: -------------------------------------------------------------------------------- 1 | #include "representation_llvm.h" 2 | #include "compiler/pir/pir_impl.h" 3 | 4 | namespace rir { 5 | namespace pir { 6 | 7 | Rep Rep::Of(PirType t) { 8 | // Combined types like integer|real cannot be unbox, since we do not know 9 | // how to re-box again. 10 | if (!t.maybeMissing() && !t.maybePromiseWrapped()) { 11 | if (t.isA(NativeType::deoptReason)) { 12 | return Rep::DeoptReason; 13 | } 14 | if (t.isA(PirType(RType::logical).simpleScalar().notObject())) { 15 | assert(t.unboxable()); 16 | return Rep::i32; 17 | } 18 | if (t.isA(PirType(RType::integer).simpleScalar().notObject())) { 19 | assert(t.unboxable()); 20 | return Rep::i32; 21 | } 22 | if (t.isA(PirType(RType::real).simpleScalar().notObject())) { 23 | assert(t.unboxable()); 24 | return Rep::f64; 25 | } 26 | } 27 | assert(!t.unboxable()); 28 | return Rep::SEXP; 29 | } 30 | 31 | Rep Rep::Of(Value* v) { return Of(v->type); } 32 | 33 | } // namespace pir 34 | } // namespace rir 35 | -------------------------------------------------------------------------------- /rir/src/compiler/opt/cleanup_checkpoints.cpp: -------------------------------------------------------------------------------- 1 | #include "../pir/pir_impl.h" 2 | #include "../util/visitor.h" 3 | #include "compiler/analysis/cfg.h" 4 | #include "pass_definitions.h" 5 | 6 | namespace rir { 7 | namespace pir { 8 | 9 | bool CleanupCheckpoints::apply(Compiler&, ClosureVersion* cls, Code* code, 10 | AbstractLog&, size_t) const { 11 | bool anyChange = false; 12 | std::unordered_set used; 13 | Visitor::run(code->entry, [&](Instruction* i) { 14 | if (auto a = Assume::Cast(i)) { 15 | used.insert(a->checkpoint()); 16 | } 17 | }); 18 | 19 | std::unordered_set toDelete; 20 | Visitor::run(code->entry, [&](BB* bb) { 21 | if (bb->isEmpty()) 22 | return; 23 | if (auto cp = Checkpoint::Cast(bb->last())) { 24 | if (!used.count(cp)) { 25 | toDelete.insert(bb->deoptBranch()); 26 | assert(bb->deoptBranch()->isExit() && 27 | "deopt blocks should be just one BB"); 28 | bb->remove(bb->end() - 1); 29 | bb->convertBranchToJmp(true); 30 | } 31 | } 32 | }); 33 | if (!toDelete.empty()) 34 | anyChange = true; 35 | // Deopt blocks are exit blocks. They have no other predecessors and 36 | // are not phi inputs. We can delete without further checks. 37 | for (auto bb : toDelete) { 38 | delete bb; 39 | } 40 | return anyChange; 41 | } 42 | } // namespace pir 43 | } // namespace rir 44 | -------------------------------------------------------------------------------- /rir/src/compiler/opt/cleanup_framestate.cpp: -------------------------------------------------------------------------------- 1 | #include "../pir/pir_impl.h" 2 | #include "../util/visitor.h" 3 | #include "compiler/analysis/cfg.h" 4 | #include "pass_definitions.h" 5 | 6 | namespace rir { 7 | namespace pir { 8 | 9 | bool CleanupFramestate::apply(Compiler&, ClosureVersion* function, Code* code, 10 | AbstractLog&, size_t) const { 11 | bool anyChange = false; 12 | Visitor::run(code->entry, [&](Instruction* i) { 13 | if (!Deopt::Cast(i) && i->frameState()) { 14 | anyChange = true; 15 | i->clearFrameState(); 16 | } 17 | }); 18 | return anyChange; 19 | } 20 | } // namespace pir 21 | } // namespace rir 22 | -------------------------------------------------------------------------------- /rir/src/compiler/opt/dead_store_removal.cpp: -------------------------------------------------------------------------------- 1 | #include "../analysis/dead_store.h" 2 | #include "pass_definitions.h" 3 | 4 | namespace rir { 5 | namespace pir { 6 | 7 | bool DeadStoreRemoval::apply(Compiler&, ClosureVersion* cls, Code* code, 8 | AbstractLog& log, size_t) const { 9 | bool noStores = Visitor::check( 10 | code->entry, [&](Instruction* i) { return !StVar::Cast(i); }); 11 | if (noStores) 12 | return false; 13 | 14 | bool anyChange = false; 15 | { 16 | DeadStoreAnalysis analysis(cls, code, log); 17 | 18 | Visitor::run(code->entry, [&](BB* bb) { 19 | auto ip = bb->begin(); 20 | while (ip != bb->end()) { 21 | auto next = ip + 1; 22 | if (auto st = StVar::Cast(*ip)) { 23 | if (analysis.isDead(st)) { 24 | next = bb->remove(ip); 25 | anyChange = true; 26 | } 27 | } 28 | ip = next; 29 | } 30 | if (bb->isDeopt()) { 31 | auto d = Deopt::Cast(bb->last()); 32 | d->escapedEnv = analysis.escapedEnv(d); 33 | } 34 | }); 35 | 36 | VisitorNoDeoptBranch::runBackward(code->entry, [&](BB* bb) { 37 | auto ip = bb->begin(); 38 | while (ip != bb->end()) { 39 | auto next = ip + 1; 40 | if (auto st = StVar::Cast(*ip)) { 41 | if (analysis.onlyObservedByDeopt(st)) { 42 | std::unordered_set copied; 43 | for (auto instruction : analysis.deoptInstructionsFor(st)) { 44 | if (!copied.count(instruction->bb())) { 45 | instruction->bb()->insert( 46 | instruction->bb()->begin(), st->clone()); 47 | copied.insert(instruction->bb()); 48 | } 49 | } 50 | anyChange = true; 51 | next = bb->remove(ip); 52 | continue; 53 | } 54 | } 55 | ip = next; 56 | } 57 | }); 58 | } 59 | return anyChange; 60 | } 61 | 62 | } // namespace pir 63 | } // namespace rir 64 | -------------------------------------------------------------------------------- /rir/src/compiler/opt/pass.cpp: -------------------------------------------------------------------------------- 1 | #include "pass.h" 2 | #include "compiler/pir/closure_version.h" 3 | #include "compiler/pir/promise.h" 4 | 5 | namespace rir { 6 | namespace pir { 7 | 8 | bool Pass::apply(Compiler& cmp, ClosureVersion* function, AbstractLog& log, 9 | size_t iteration) const { 10 | bool res = apply(cmp, function, function, log, iteration); 11 | if (runOnPromises()) { 12 | function->eachPromise([&](Promise* p) { 13 | res = apply(cmp, function, p, log, iteration) || res; 14 | }); 15 | } 16 | changedAnything_ = res; 17 | return res; 18 | } 19 | 20 | } // namespace pir 21 | } // namespace rir 22 | -------------------------------------------------------------------------------- /rir/src/compiler/opt/pass.h: -------------------------------------------------------------------------------- 1 | #ifndef PIR_PASS_H 2 | #define PIR_PASS_H 3 | 4 | #include "../pir/module.h" 5 | #include 6 | 7 | namespace rir { 8 | namespace pir { 9 | 10 | class Compiler; 11 | class AbstractLog; 12 | 13 | class Pass { 14 | public: 15 | explicit Pass(const std::string& name) : name(name) {} 16 | 17 | virtual bool runOnPromises() const { return false; } 18 | virtual bool isSlow() const { return false; } 19 | 20 | bool apply(Compiler& cmp, ClosureVersion* function, AbstractLog& log, 21 | size_t iteration) const; 22 | virtual bool apply(Compiler& cmp, ClosureVersion*, Code*, AbstractLog&, 23 | size_t iteration) const = 0; 24 | 25 | std::string getName() const { return this->name; } 26 | bool changedAnything() const { return changedAnything_; } 27 | virtual ~Pass() {} 28 | virtual bool isPhaseMarker() const { return false; } 29 | virtual unsigned cost() const { return 1; } 30 | 31 | protected: 32 | std::string name; 33 | mutable bool changedAnything_ = false; 34 | }; 35 | 36 | } // namespace pir 37 | } // namespace rir 38 | 39 | #endif 40 | -------------------------------------------------------------------------------- /rir/src/compiler/opt/visibility.cpp: -------------------------------------------------------------------------------- 1 | #include "../analysis/visibility.h" 2 | #include "../pir/pir_impl.h" 3 | #include "../util/visitor.h" 4 | #include "compiler/analysis/cfg.h" 5 | 6 | #include "R/r.h" 7 | #include "pass_definitions.h" 8 | 9 | #include 10 | #include 11 | 12 | namespace rir { 13 | namespace pir { 14 | 15 | bool OptimizeVisibility::apply(Compiler&, ClosureVersion* cls, Code* code, 16 | AbstractLog& log, size_t) const { 17 | VisibilityAnalysis visible(cls, code, log); 18 | 19 | bool anyChange = false; 20 | Visitor::run(code->entry, [&](BB* bb) { 21 | auto ip = bb->begin(); 22 | while (ip != bb->end()) { 23 | auto next = ip + 1; 24 | auto instr = *ip; 25 | 26 | if (auto vis = Visible::Cast(instr)) { 27 | if (!visible.observed(vis)) { 28 | anyChange = true; 29 | next = bb->remove(ip); 30 | } 31 | } else if (auto vis = Invisible::Cast(instr)) { 32 | if (!visible.observed(vis)) { 33 | anyChange = true; 34 | next = bb->remove(ip); 35 | } 36 | } else if (instr->effects.contains(Effect::Visibility)) { 37 | if (!visible.observed(instr)) { 38 | anyChange = true; 39 | instr->effects.reset(Effect::Visibility); 40 | } 41 | } 42 | 43 | ip = next; 44 | } 45 | }); 46 | 47 | return anyChange; 48 | } 49 | 50 | } // namespace pir 51 | } // namespace rir 52 | -------------------------------------------------------------------------------- /rir/src/compiler/osr.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "pir/pir.h" 4 | 5 | #include "runtime/Function.h" 6 | #include "runtime/GenericDispatchTable.h" 7 | 8 | namespace rir { 9 | namespace pir { 10 | 11 | class OSR { 12 | public: 13 | static Function* compile(SEXP closure, rir::Code* c, 14 | const ContinuationContext& ctx); 15 | static Function* deoptlessDispatch(SEXP closure, rir::Code* c, 16 | const DeoptContext& ctx); 17 | }; 18 | 19 | typedef GenericDispatchTable DeoptlessDispatchTable; 20 | 21 | } // namespace pir 22 | } // namespace rir 23 | -------------------------------------------------------------------------------- /rir/src/compiler/parameter.h: -------------------------------------------------------------------------------- 1 | #ifndef PIR_PARAMETER_H 2 | #define PIR_PARAMETER_H 3 | 4 | #include 5 | 6 | namespace rir { 7 | namespace pir { 8 | 9 | struct Parameter { 10 | static bool DEBUG_DEOPTS; 11 | static size_t DEOPT_CHAOS; 12 | static bool DEOPT_CHAOS_NO_RETRIGGER; 13 | static int DEOPT_CHAOS_SEED; 14 | static size_t MAX_INPUT_SIZE; 15 | 16 | static const unsigned PIR_WARMUP; 17 | static const unsigned PIR_OPT_TIME; 18 | static const unsigned PIR_REOPT_TIME; 19 | static const unsigned PIR_OPT_BC_SIZE; 20 | static const unsigned DEOPT_ABANDON; 21 | 22 | static size_t PROMISE_INLINER_MAX_SIZE; 23 | 24 | static size_t INLINER_MAX_SIZE; 25 | static size_t INLINER_MAX_INLINEE_SIZE; 26 | static size_t INLINER_INITIAL_FUEL; 27 | static size_t INLINER_INLINE_UNLIKELY; 28 | 29 | static size_t RECOMPILE_THRESHOLD; 30 | 31 | static bool RIR_PRESERVE; 32 | static unsigned RIR_SERIALIZE_CHAOS; 33 | 34 | static unsigned RIR_CHECK_PIR_TYPES; 35 | 36 | static unsigned PIR_LLVM_OPT_LEVEL; 37 | static unsigned PIR_OPT_LEVEL; 38 | 39 | static bool ENABLE_PIR2RIR; 40 | 41 | static bool ENABLE_OSR; 42 | }; 43 | 44 | } // namespace pir 45 | } // namespace rir 46 | 47 | #endif 48 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/builder.h: -------------------------------------------------------------------------------- 1 | #ifndef COMPILER_BUILDER_H 2 | #define COMPILER_BUILDER_H 3 | 4 | #include "../pir/bb.h" 5 | #include "../pir/pir.h" 6 | #include "../pir/tag.h" 7 | #include "bc/BC_inc.h" 8 | 9 | #include 10 | #include 11 | 12 | namespace rir { 13 | struct Code; 14 | 15 | namespace pir { 16 | 17 | class FrameState; 18 | class Checkpoint; 19 | class CallInstruction; 20 | struct RirStack; 21 | 22 | class Builder { 23 | public: 24 | ClosureVersion* function; 25 | Code* code; 26 | Value* env; 27 | 28 | Builder(ClosureVersion* fun, Promise* prom); 29 | Builder(ClosureVersion* fun, Value* enclos); 30 | Builder(Continuation* fun, Value* enclos); 31 | 32 | Value* buildDefaultEnv(ClosureVersion* fun); 33 | 34 | void add(Instruction* i); 35 | template 36 | T* operator()(T* i) { 37 | add(i); 38 | return i; 39 | } 40 | 41 | BB* createBB(); 42 | void createNextBB(); 43 | void enterBB(BB* bb); 44 | void setNext(BB* bb1); 45 | void setBranch(BB* bb1, BB* bb2); 46 | 47 | FrameState* registerFrameState(rir::Code* srcCode, Opcode* pos, 48 | const RirStack& stack, bool inPromise); 49 | Checkpoint* emitCheckpoint(rir::Code* srcCode, Opcode* pos, 50 | const RirStack& stack, bool inPromise); 51 | Checkpoint* emitCheckpoint(FrameState* fs); 52 | 53 | // Use with care, let the builder keep track of BB. Prefer the highlevel 54 | // api above. 55 | BB* getCurrentBB() const { return bb; } 56 | // Use with even more care, no checks 57 | void reenterBB(BB* bb) { this->bb = bb; } 58 | void clearCurrentBB() { this->bb = nullptr; } 59 | 60 | private: 61 | void markDone(BB*); 62 | bool isDone(BB*) const; 63 | 64 | std::vector done; 65 | BB* bb = nullptr; 66 | }; 67 | 68 | } // namespace pir 69 | } // namespace rir 70 | 71 | #endif 72 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/code.cpp: -------------------------------------------------------------------------------- 1 | #include "code.h" 2 | #include "../util/visitor.h" 3 | #include "pir_impl.h" 4 | 5 | #include 6 | 7 | namespace rir { 8 | namespace pir { 9 | 10 | void Code::printCode(std::ostream& out, bool tty, 11 | bool omitDeoptBranches) const { 12 | BreadthFirstVisitor::run(entry, [&](BB* bb) { 13 | if (omitDeoptBranches && 14 | (bb->isDeopt() || (bb->isJmp() && bb->next()->isDeopt()))) 15 | return; 16 | bb->print(out, tty); 17 | }); 18 | } 19 | 20 | void Code::printGraphCode(std::ostream& out, bool omitDeoptBranches) const { 21 | BreadthFirstVisitor::run(entry, [&](BB* bb) { 22 | if (omitDeoptBranches && 23 | (bb->isDeopt() || (bb->isJmp() && bb->next()->isDeopt()))) 24 | return; 25 | bb->printGraph(out, omitDeoptBranches); 26 | }); 27 | } 28 | 29 | void Code::printBBGraphCode(std::ostream& out, bool omitDeoptBranches) const { 30 | BreadthFirstVisitor::run(entry, [&](BB* bb) { 31 | if (omitDeoptBranches && 32 | (bb->isDeopt() || (bb->isJmp() && bb->next()->isDeopt()))) 33 | return; 34 | bb->printBBGraph(out, omitDeoptBranches); 35 | }); 36 | } 37 | 38 | Code::~Code() { 39 | std::stack toDel; 40 | Visitor::run(entry, [&toDel](BB* bb) { toDel.push(bb); }); 41 | while (!toDel.empty()) { 42 | auto d = toDel.top(); 43 | toDel.pop(); 44 | assert(d->owner == this); 45 | delete d; 46 | } 47 | } 48 | 49 | size_t Code::numInstrs() const { 50 | size_t s = 0; 51 | Visitor::run(entry, [&](BB* bb) { s += bb->size(); }); 52 | return s; 53 | } 54 | 55 | } // namespace pir 56 | } // namespace rir 57 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/code.h: -------------------------------------------------------------------------------- 1 | #ifndef COMPILER_CODE_H 2 | #define COMPILER_CODE_H 3 | 4 | #include "pir.h" 5 | 6 | #include 7 | #include 8 | 9 | namespace rir { 10 | struct Code; 11 | 12 | namespace pir { 13 | 14 | /* 15 | * A piece of code, starting at the BB entry. 16 | * 17 | * Currently: either a Promise or a ClosureVersion. 18 | * 19 | */ 20 | class Code { 21 | public: 22 | BB* entry = nullptr; 23 | 24 | size_t nextBBId = 0; 25 | 26 | Code() {} 27 | void printCode(std::ostream&, bool tty, bool omitDeoptBranches) const; 28 | void printGraphCode(std::ostream&, bool omitDeoptBranches) const; 29 | void printBBGraphCode(std::ostream&, bool omitDeoptBranches) const; 30 | virtual ~Code(); 31 | 32 | size_t numInstrs() const; 33 | 34 | virtual rir::Code* rirSrc() const = 0; 35 | virtual void printName(std::ostream&) const = 0; 36 | 37 | friend std::ostream& operator<<(std::ostream& out, const Code& e) { 38 | e.printName(out); 39 | return out; 40 | } 41 | }; 42 | 43 | } // namespace pir 44 | } // namespace rir 45 | 46 | #endif 47 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/continuation.cpp: -------------------------------------------------------------------------------- 1 | #include "continuation.h" 2 | #include "compiler/compiler.h" 3 | 4 | namespace rir { 5 | namespace pir { 6 | 7 | Continuation::Continuation(Closure* closure, rir::Function* fun, 8 | const ContinuationContext* continuationContext) 9 | : ClosureVersion(closure, fun, true, Compiler::defaultContext, 10 | Properties()), 11 | continuationContext(continuationContext) {} 12 | 13 | } // namespace pir 14 | } // namespace rir 15 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/continuation.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "closure_version.h" 4 | #include "deopt_context.h" 5 | #include "pir.h" 6 | 7 | namespace rir { 8 | namespace pir { 9 | 10 | class Continuation : public ClosureVersion { 11 | public: 12 | const ContinuationContext* continuationContext; 13 | Continuation(Closure* closure, rir::Function* fun, 14 | const ContinuationContext* continuationContext); 15 | Continuation* isContinuation() override final { return this; } 16 | 17 | // we set voyd only one time per version, otherwise the pass doesn't 18 | // converge since it would keep changing forever 19 | bool typeFeedbackCleanupHasRun = false; 20 | }; 21 | 22 | } // namespace pir 23 | } // namespace rir 24 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/continuation_context.cpp: -------------------------------------------------------------------------------- 1 | #include "continuation_context.h" 2 | #include "runtime/LazyEnvironment.h" 3 | #include "utils/Pool.h" 4 | 5 | namespace rir { 6 | namespace pir { 7 | 8 | ContinuationContext::ContinuationContext(Opcode* pc, SEXP env, bool leaked, 9 | R_bcstack_t* base, size_t stackSize) 10 | : pc_(pc), stackSize_(stackSize), leakedEnv_(leaked) { 11 | assert(stackSize <= MAX_STACK); 12 | for (size_t i = 0; i < stackSize; ++i) { 13 | auto v = (base + i)->u.sxpval; 14 | stack_.at(i) = PirType(v); 15 | } 16 | 17 | leakedEnv_ = leaked; 18 | if (env) { 19 | auto l = Rf_length(FRAME(env)); 20 | assert(l <= (int)MAX_ENV); 21 | envSize_ = l; 22 | auto f = FRAME(env); 23 | size_t i = 0; 24 | while (f != R_NilValue) { 25 | auto n = TAG(f); 26 | assert(i < (size_t)l); 27 | env_.at(i) = {n, PirType(CAR(f)), MISSING(f)}; 28 | f = CDR(f); 29 | i++; 30 | } 31 | } 32 | } 33 | } // namespace pir 34 | } // namespace rir 35 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/deopt_context.cpp: -------------------------------------------------------------------------------- 1 | #include "deopt_context.h" 2 | #include "runtime/LazyEnvironment.h" 3 | #include "utils/Pool.h" 4 | 5 | namespace rir { 6 | namespace pir { 7 | 8 | DeoptContext::DeoptContext() 9 | : ContinuationContext(), reason_({}, DeoptReason::Unknown) {} 10 | 11 | DeoptContext::DeoptContext(Opcode* pc, size_t envSize, SEXP actualEnv, 12 | LazyEnvironment* env, bool leaked, R_bcstack_t* base, 13 | size_t stackSize, const DeoptReason& reason, 14 | SEXP deoptTrigger) 15 | : ContinuationContext(pc, actualEnv, leaked, base, stackSize), 16 | reason_(reason) { 17 | switch (reason.reason) { 18 | case DeoptReason::Typecheck: 19 | typeCheckTrigger_ = PirType(deoptTrigger); 20 | break; 21 | case DeoptReason::DeadBranchReached: 22 | if (deoptTrigger == R_TrueValue || deoptTrigger == R_FalseValue) 23 | deadBranchTrigger_ = deoptTrigger; 24 | break; 25 | case DeoptReason::CallTarget: 26 | callTargetTrigger_ = deoptTrigger; 27 | R_PreserveObject(callTargetTrigger_); 28 | break; 29 | case DeoptReason::DeadCall: 30 | case DeoptReason::ForceAndCall: 31 | case DeoptReason::Unknown: 32 | case DeoptReason::EnvStubMaterialized: 33 | break; 34 | } 35 | assert(!(actualEnv && env)); 36 | envSize_ = envSize; 37 | assert(envSize_ <= MAX_ENV); 38 | if (env) { 39 | assert(!leakedEnv_); 40 | for (size_t i = 0; i < envSize_; ++i) { 41 | auto n = Pool::get(env->names[i]); 42 | env_.at(i) = {TYPEOF(n) == LISTSXP ? CAR(n) : n, 43 | PirType(env->getArg(i)), env->missing[i]}; 44 | } 45 | } 46 | } 47 | } // namespace pir 48 | } // namespace rir 49 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/env.cpp: -------------------------------------------------------------------------------- 1 | #include "env.h" 2 | #include "R/Printing.h" 3 | #include "pir_impl.h" 4 | 5 | #include 6 | 7 | namespace rir { 8 | namespace pir { 9 | 10 | void Env::printRef(std::ostream& out) const { 11 | if (this == notClosed()) { 12 | out << "?"; 13 | return; 14 | } else if (this == elided()) { 15 | out << "elided"; 16 | return; 17 | } else if (this == nil()) { 18 | out << "nil"; 19 | return; 20 | } 21 | 22 | assert(rho); 23 | out << Print::dumpSexp(rho); 24 | } 25 | 26 | bool Env::isStaticEnv(Value* v) { 27 | return Env::Cast(v) && v != Env::notClosed() && v != Env::nil() && 28 | v != Env::elided(); 29 | } 30 | 31 | bool Env::isPirEnv(Value* v) { 32 | return MkEnv::Cast(v) || LdFunctionEnv::Cast(v); 33 | } 34 | 35 | bool Env::isAnyEnv(Value* v) { 36 | return Env::Cast(v) || MkEnv::Cast(v) || LdFunctionEnv::Cast(v) || 37 | MaterializeEnv::Cast(v); 38 | } 39 | 40 | Value* Env::parentEnv(Value* e) { 41 | assert(isAnyEnv(e)); 42 | if (Cast(e)) 43 | return Cast(e)->parent; 44 | if (MkEnv::Cast(e)) 45 | return MkEnv::Cast(e)->lexicalEnv(); 46 | assert(false); 47 | return nullptr; 48 | } 49 | 50 | bool Env::isParentEnv(Value* a, Value* b) { 51 | if (a == b) 52 | return false; 53 | b = parentEnv(b); 54 | while (b != nullptr) { 55 | if (a == b) 56 | return true; 57 | b = parentEnv(b); 58 | } 59 | return false; 60 | } 61 | } // namespace pir 62 | } // namespace rir 63 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/env.h: -------------------------------------------------------------------------------- 1 | #ifndef COMPILER_ENV_H 2 | #define COMPILER_ENV_H 3 | 4 | #include "instruction_list.h" 5 | #include "tag.h" 6 | #include "value.h" 7 | 8 | #include 9 | #include 10 | 11 | namespace rir { 12 | namespace pir { 13 | 14 | class Instruction; 15 | 16 | /* 17 | * Statically known envs. 18 | * 19 | */ 20 | class Env : public Value { 21 | Env(SEXP rho, Env* parent) 22 | : Value(PirType::env(), Tag::Env), rho(rho), parent(parent) {} 23 | friend class Module; 24 | 25 | public: 26 | SEXP rho; 27 | Env* parent; 28 | 29 | static Env* nil() { 30 | static Env u(nullptr, nullptr); 31 | return &u; 32 | } 33 | 34 | static Env* global() { 35 | static Env u(R_GlobalEnv, nullptr); 36 | return &u; 37 | } 38 | 39 | static Env* notClosed() { 40 | static Env u(nullptr, nullptr); 41 | return &u; 42 | } 43 | 44 | static Env* elided() { 45 | static Env u(nullptr, nullptr); 46 | return &u; 47 | } 48 | 49 | void printRef(std::ostream& out) const override final; 50 | 51 | static Env* Cast(Value* v) { 52 | return v->tag == Tag::Env ? static_cast(v) : nullptr; 53 | } 54 | 55 | static bool isPirEnv(Value* v); 56 | static bool isStaticEnv(Value* v); 57 | static bool isAnyEnv(Value* v); 58 | 59 | static bool isParentEnv(Value* a, Value* b); 60 | static Value* parentEnv(Value* e); 61 | 62 | virtual ~Env() {} 63 | }; 64 | 65 | } // namespace pir 66 | } // namespace rir 67 | 68 | #endif 69 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/module.h: -------------------------------------------------------------------------------- 1 | #ifndef PIR_MODULE_H 2 | #define PIR_MODULE_H 3 | 4 | #include "R/r.h" 5 | #include "runtime/TypeFeedback.h" 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "pir.h" 13 | #include "runtime/Function.h" 14 | 15 | namespace rir { 16 | namespace pir { 17 | 18 | class DeoptReasonWrapper; 19 | 20 | class Module { 21 | std::unordered_map environments; 22 | 23 | public: 24 | Env* getEnv(SEXP); 25 | 26 | void print(std::ostream& out = std::cout, bool tty = false); 27 | 28 | Closure* getOrDeclareRirFunction(const std::string& name, rir::Function* f, 29 | SEXP formals, SEXP src, 30 | Context userContext); 31 | Closure* getOrDeclareRirClosure(const std::string& name, SEXP closure, 32 | rir::Function* f, Context userContext); 33 | 34 | typedef std::function PirClosureIterator; 35 | typedef std::function PirClosureVersionIterator; 36 | void eachPirClosure(PirClosureIterator it); 37 | void eachPirClosureVersion(PirClosureVersionIterator it); 38 | 39 | DeoptReasonWrapper* deoptReasonValue(const DeoptReason&); 40 | Value* c(SEXP s); 41 | Const* c(int s); 42 | Const* c(double s); 43 | 44 | ~Module(); 45 | private: 46 | typedef std::pair Idx; 47 | std::map closures; 48 | 49 | Const* c(BC::PoolIdx, PirType t); 50 | std::unordered_map deoptReasons; 51 | std::unordered_map constants; 52 | }; 53 | 54 | } 55 | } 56 | 57 | #endif 58 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/pir.h: -------------------------------------------------------------------------------- 1 | #ifndef PIR_PIR_H 2 | #define PIR_PIR_H 3 | 4 | #include 5 | // Forward declaration of PIR types. Use for headers. 6 | 7 | namespace rir { 8 | namespace pir { 9 | 10 | struct PirType; 11 | class Closure; 12 | class ClosureVersion; 13 | class Continuation; 14 | class BB; 15 | class Promise; 16 | class Value; 17 | class Code; 18 | class Env; 19 | class Instruction; 20 | class LazyEnv; 21 | class Module; 22 | class MkEnv; 23 | class MkArg; 24 | class LogStream; 25 | class Const; 26 | 27 | struct ContinuationContext; 28 | struct DeoptContext; 29 | } 30 | } 31 | 32 | #endif 33 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/pir_impl.h: -------------------------------------------------------------------------------- 1 | #ifndef PIR_PIR_IMPL_H 2 | #define PIR_PIR_IMPL_H 3 | 4 | // PIR includes. Please only include in .cpp! 5 | // 6 | // contains all the headers from the /pir subdir 7 | 8 | #include "bb.h" 9 | #include "closure.h" 10 | #include "closure_version.h" 11 | #include "continuation.h" 12 | #include "env.h" 13 | #include "instruction.h" 14 | #include "module.h" 15 | #include "pir.h" 16 | #include "promise.h" 17 | #include "singleton_values.h" 18 | #include "type.h" 19 | #include "values.h" 20 | 21 | #endif 22 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/promise.cpp: -------------------------------------------------------------------------------- 1 | #include "promise.h" 2 | #include "bc/BC.h" 3 | #include "closure_version.h" 4 | #include "compiler/pir/bb.h" 5 | #include "compiler/pir/instruction.h" 6 | #include "compiler/util/visitor.h" 7 | #include "interpreter/instance.h" 8 | 9 | namespace rir { 10 | namespace pir { 11 | 12 | Promise::Promise(ClosureVersion* owner, unsigned id, rir::Code* rirSrc) 13 | : id(id), owner(owner), rirSrc_(rirSrc), srcPoolIdx_(rirSrc->src) { 14 | assert(src_pool_at(srcPoolIdx_)); 15 | } 16 | 17 | unsigned Promise::srcPoolIdx() const { return srcPoolIdx_; } 18 | 19 | LdFunctionEnv* Promise::env() const { 20 | LdFunctionEnv* e = nullptr; 21 | Visitor::run(entry, [&](Instruction* i) { 22 | if (auto ld = LdFunctionEnv::Cast(i)) { 23 | assert(!e); 24 | e = ld; 25 | } 26 | }); 27 | return e; 28 | } 29 | 30 | bool Promise::trivial() const { 31 | auto bb = entry; 32 | if (bb->isEmpty()) 33 | bb = bb->next(); 34 | for (auto i : *bb) { 35 | switch (i->tag) { 36 | case Tag::Visible: 37 | case Tag::Return: 38 | break; 39 | default: 40 | return false; 41 | } 42 | } 43 | return true; 44 | } 45 | 46 | void Promise::printName(std::ostream& out) const { 47 | out << owner->name() << "_p" << id; 48 | } 49 | 50 | } // namespace pir 51 | } // namespace rir 52 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/promise.h: -------------------------------------------------------------------------------- 1 | #ifndef COMPILER_PROMISE_H 2 | #define COMPILER_PROMISE_H 3 | 4 | #include "code.h" 5 | 6 | namespace rir { 7 | namespace pir { 8 | 9 | class LdFunctionEnv; 10 | 11 | class Promise : public Code { 12 | public: 13 | const unsigned id; 14 | ClosureVersion* owner; 15 | 16 | unsigned srcPoolIdx() const; 17 | rir::Code* rirSrc() const override final { return rirSrc_; } 18 | 19 | LdFunctionEnv* env() const; 20 | 21 | bool trivial() const; 22 | 23 | void printName(std::ostream& out) const override; 24 | 25 | private: 26 | rir::Code* rirSrc_; 27 | const unsigned srcPoolIdx_; 28 | friend class ClosureVersion; 29 | Promise(ClosureVersion* owner, unsigned id, rir::Code* rirSrc); 30 | }; 31 | 32 | } // namespace pir 33 | } // namespace rir 34 | 35 | #endif 36 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/tag.cpp: -------------------------------------------------------------------------------- 1 | #include "tag.h" 2 | 3 | #include 4 | 5 | namespace rir { 6 | namespace pir { 7 | 8 | const char* tagToStr(Tag tag) { 9 | switch (tag) { 10 | #define V(I) \ 11 | case Tag::I: \ 12 | return #I; 13 | COMPILER_INSTRUCTIONS(V) 14 | #undef V 15 | #define V(I) \ 16 | case Tag::I: \ 17 | return #I; 18 | COMPILER_VALUES(V) 19 | #undef V 20 | case Tag::_UNUSED_: 21 | assert(false); 22 | } 23 | assert(false); 24 | return ""; 25 | } 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/tag.h: -------------------------------------------------------------------------------- 1 | #ifndef COMPILER_TAG_H 2 | #define COMPILER_TAG_H 3 | 4 | #include "instruction_list.h" 5 | #include "value_list.h" 6 | 7 | #include 8 | 9 | namespace rir { 10 | namespace pir { 11 | 12 | /* 13 | * Every Value has a unique tag, to be able to safely downcast values and 14 | * instructions (without relying on RTTI). Instructions are values too. 15 | * 16 | */ 17 | enum class Tag : uint8_t { 18 | _UNUSED_, 19 | #define V(I) I, 20 | COMPILER_INSTRUCTIONS(V) 21 | #undef V 22 | #define V(I) I, 23 | COMPILER_VALUES(V) 24 | #undef V 25 | }; 26 | 27 | const char* tagToStr(Tag t); 28 | 29 | } // namespace pir 30 | } // namespace rir 31 | 32 | #endif 33 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/value.h: -------------------------------------------------------------------------------- 1 | #ifndef COMPILER_VALUE_H 2 | #define COMPILER_VALUE_H 3 | 4 | #include "type.h" 5 | 6 | #include 7 | #include 8 | 9 | namespace rir { 10 | namespace pir { 11 | 12 | enum class Tag : uint8_t; 13 | 14 | class BB; 15 | class Code; 16 | class Instruction; 17 | 18 | /* 19 | * A typed PIR value. 20 | * 21 | * Has a tag from either value_list.h or instruction_list.h 22 | * 23 | */ 24 | class Value { 25 | public: 26 | Tag tag; 27 | PirType type; 28 | 29 | Value(PirType type, Tag tag) : tag(tag), type(type) {} 30 | virtual void printRef(std::ostream& out) const = 0; 31 | void printRef() const { printRef(std::cerr); } 32 | virtual const Value* cFollowCasts() const { return this; } 33 | virtual const Value* cFollowCastsAndForce() const { return this; } 34 | virtual const Value* cFollowDownCastsAndForce() const { return this; } 35 | Value* followCasts() { 36 | return const_cast( 37 | const_cast(this)->cFollowCasts()); 38 | } 39 | Value* followCastsAndForce() { 40 | return const_cast( 41 | const_cast(this)->cFollowCastsAndForce()); 42 | } 43 | Value* followDownCastsAndForce() { 44 | return const_cast( 45 | const_cast(this)->cFollowDownCastsAndForce()); 46 | } 47 | virtual bool validIn(Code* code) const { return true; } 48 | virtual SEXP asRValue() const { 49 | return nullptr; 50 | } 51 | 52 | static constexpr int MAX_REFCOUNT = 2; 53 | 54 | virtual int minReferenceCount() const { 55 | return type.maybeReferenceCounted() ? 0 : MAX_REFCOUNT; 56 | } 57 | 58 | void callArgTypeToContext(Context&, unsigned arg) const; 59 | 60 | void checkReplace(Value* replace) const; 61 | 62 | virtual void replaceUsesIn( 63 | Value* val, BB* target, 64 | const std::function& postAction = 65 | [](Instruction*, size_t) {}, 66 | const std::function& replaceOnly = 67 | [](Instruction*) { return true; }); 68 | }; 69 | static_assert(sizeof(Value) <= 16, ""); 70 | 71 | } // namespace pir 72 | } // namespace rir 73 | 74 | #endif 75 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/value_list.h: -------------------------------------------------------------------------------- 1 | #ifndef COMPILER_VALUE_LIST_H 2 | #define COMPILER_VALUE_LIST_H 3 | 4 | #define COMPILER_VALUES(V) \ 5 | V(Constant) \ 6 | V(True) \ 7 | V(False) \ 8 | V(OpaqueTrue) \ 9 | V(NaLogical) \ 10 | V(UnknownDeoptTrigger) \ 11 | V(Tombstone) \ 12 | V(MissingArg) \ 13 | V(UnboundValue) \ 14 | V(Env) \ 15 | V(Nil) \ 16 | V(DeoptReason) 17 | 18 | #endif 19 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/values.cpp: -------------------------------------------------------------------------------- 1 | #include "values.h" 2 | 3 | #include "tag.h" 4 | 5 | #include "R/Printing.h" 6 | #include "utils/Pool.h" 7 | 8 | namespace rir { 9 | namespace pir { 10 | 11 | DeoptReasonWrapper::DeoptReasonWrapper(const DeoptReason& r) 12 | : ValueImpl(NativeType::deoptReason), reason(r) {} 13 | 14 | void DeoptReasonWrapper::printRef(std::ostream& out) const { out << reason; } 15 | 16 | DeoptReasonWrapper* DeoptReasonWrapper::unknown() { 17 | static DeoptReasonWrapper instance(DeoptReason::unknown()); 18 | return &instance; 19 | } 20 | 21 | Const::Const(BC::PoolIdx idx, PirType type) : ValueImpl(type), idx(idx) {} 22 | 23 | SEXP Const::c() const { return Pool::get(idx); } 24 | 25 | void Const::printRef(std::ostream& out) const { out << Print::dumpSexp(c()); } 26 | 27 | } // namespace pir 28 | } // namespace rir 29 | -------------------------------------------------------------------------------- /rir/src/compiler/pir/values.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "bc/BC_inc.h" 4 | #include "runtime/TypeFeedback.h" 5 | #include "tag.h" 6 | #include "value.h" 7 | 8 | namespace rir { 9 | namespace pir { 10 | 11 | class Instruction; 12 | 13 | template 14 | class ValueImpl : public Value { 15 | public: 16 | explicit ValueImpl(PirType type) : Value(type, TAG) {} 17 | virtual ~ValueImpl() {} 18 | 19 | static const Base* Cast(const Instruction* i) { 20 | assert(false && "Non-sensical down-cast from instruction to value"); 21 | return nullptr; 22 | } 23 | 24 | static Base* Cast(Instruction* i) { 25 | assert(false && "Non-sensical down-cast from instruction to value"); 26 | return nullptr; 27 | } 28 | 29 | static const Base* Cast(const Value* i) { 30 | if (i->tag == TAG) 31 | return static_cast(i); 32 | return nullptr; 33 | } 34 | 35 | static Base* Cast(Value* i) { 36 | if (i->tag == TAG) 37 | return static_cast(i); 38 | return nullptr; 39 | } 40 | }; 41 | 42 | class DeoptReasonWrapper 43 | : public ValueImpl { 44 | private: 45 | explicit DeoptReasonWrapper(const DeoptReason&); 46 | 47 | public: 48 | const DeoptReason reason; 49 | static DeoptReasonWrapper* unknown(); 50 | void printRef(std::ostream& out) const override final; 51 | 52 | friend class Module; 53 | }; 54 | 55 | class Const : public ValueImpl { 56 | private: 57 | explicit Const(BC::PoolIdx idx, PirType type); 58 | BC::PoolIdx idx; 59 | 60 | public: 61 | void printRef(std::ostream& out) const override final; 62 | 63 | SEXP c() const; 64 | SEXP operator()() const { return c(); } 65 | SEXP asRValue() const override final { return c(); } 66 | 67 | friend class Module; 68 | }; 69 | 70 | } // namespace pir 71 | } // namespace rir 72 | -------------------------------------------------------------------------------- /rir/src/compiler/rir2pir/insert_cast.cpp: -------------------------------------------------------------------------------- 1 | #include "insert_cast.h" 2 | #include "../pir/pir_impl.h" 3 | #include "../util/visitor.h" 4 | 5 | namespace rir { 6 | namespace pir { 7 | 8 | Instruction* InsertCast::cast(Value* v, PirType t, Value* env) { 9 | if (v->type.maybePromiseWrapped() && !t.maybePromiseWrapped()) { 10 | return new Force(v, env, Tombstone::framestate()); 11 | } 12 | if (!v->type.isA(PirType::function()) && t.isA(PirType::function())) { 13 | return new ChkFunction(v); 14 | } 15 | 16 | std::cerr << "Cannot cast " << v->type << " to " << t; 17 | std::cerr << " at "; 18 | v->printRef(std::cerr); 19 | std::cerr << "\n"; 20 | return nullptr; 21 | } 22 | 23 | void InsertCast::operator()() { 24 | AvailableCheckpoints checkpoint(nullptr, code, log); 25 | Visitor::run(code->entry, [&](BB* bb) { apply(bb, checkpoint); }); 26 | } 27 | 28 | void InsertCast::apply(BB* bb, AvailableCheckpoints& cp) { 29 | auto ip = bb->begin(); 30 | while (ip != bb->end()) { 31 | Instruction* instr = *ip; 32 | if (auto p = Phi::Cast(instr)) 33 | p->updateTypeAndEffects(); 34 | if (auto f = Force::Cast(instr)) 35 | f->updateTypeAndEffects(); 36 | instr->eachArg([&](InstrArg& arg) { 37 | while (!arg.type().isSuper(arg.val()->type)) { 38 | 39 | // When compiling for OSR it can happen that we are not sure 40 | // that the inc_ input is really an integer. But it has to be, 41 | // since in the rir compiler we only use it that way. 42 | if (Inc::Cast(instr)) { 43 | arg.val()->type = arg.val()->type & arg.type(); 44 | break; 45 | } 46 | auto c = cast(arg.val(), arg.type(), env); 47 | if (!c) { 48 | bb->owner->printCode(std::cerr, false, false); 49 | assert(false); 50 | } 51 | ip = bb->insert(ip, c) + 1; 52 | arg.val() = c; 53 | } 54 | }); 55 | ip++; 56 | } 57 | } 58 | 59 | } // namespace pir 60 | } // namespace rir 61 | -------------------------------------------------------------------------------- /rir/src/compiler/rir2pir/insert_cast.h: -------------------------------------------------------------------------------- 1 | #ifndef COMPILER_PIR_INSERT_CAST_H 2 | #define COMPILER_PIR_INSERT_CAST_H 3 | 4 | #include "../analysis/available_checkpoints.h" 5 | #include "../pir/pir.h" 6 | 7 | namespace rir { 8 | namespace pir { 9 | 10 | /* This pass inserts casts to adjust input types, to argument types of 11 | * instructions. 12 | * 13 | * For example if we get a potentially lazy value from a load, that flows into 14 | * an eager instruction, then it inserts a force instruction. 15 | * 16 | */ 17 | class InsertCast { 18 | Code* code; 19 | Value* env; 20 | AbstractLog& log; 21 | 22 | void apply(BB* b, AvailableCheckpoints& cp); 23 | 24 | public: 25 | static pir::Instruction* cast(pir::Value* v, PirType t, Value* env); 26 | 27 | InsertCast(Code* s, Value* e, AbstractLog& log) 28 | : code(s), env(e), log(log) {} 29 | void operator()(); 30 | }; 31 | 32 | } // namespace pir 33 | } // namespace rir 34 | 35 | #endif 36 | -------------------------------------------------------------------------------- /rir/src/compiler/test/PirTests.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | namespace rir { 4 | 5 | class PirTests { 6 | public: 7 | static void run(); 8 | }; 9 | 10 | } // namespace rir 11 | -------------------------------------------------------------------------------- /rir/src/compiler/util/arg_match.h: -------------------------------------------------------------------------------- 1 | #ifndef PIR_ARGUMENT_MATCHER_H 2 | #define PIR_ARGUMENT_MATCHER_H 3 | 4 | #include "../pir/pir.h" 5 | #include "runtime/ArglistOrder.h" 6 | 7 | namespace rir { 8 | namespace pir { 9 | 10 | class DotsList; 11 | struct ArgumentMatcher { 12 | struct Arg { 13 | SEXP name; 14 | Value* value; 15 | size_t index; 16 | int8_t used; 17 | }; 18 | struct ActualArg { 19 | enum { Missing, Index, Dotslist } kind; 20 | Arg arg; 21 | // cppcheck-suppress uninitMemberVar 22 | ActualArg() : kind(Missing) {} 23 | // cppcheck-suppress uninitMemberVar 24 | explicit ActualArg(const Arg& a) : kind(Index), arg(a) {} 25 | static ActualArg Dots() { 26 | ActualArg a; 27 | a.kind = Dotslist; 28 | return a; 29 | } 30 | }; 31 | struct GivenArglistAccessor { 32 | std::function size; 33 | std::function getArg; 34 | std::function getName; 35 | }; 36 | using MaybeDots = std::function; 37 | static bool reorder(MaybeDots maybeDots, SEXP formals, 38 | GivenArglistAccessor given, 39 | std::vector& matchedArgs, 40 | ArglistOrder::CallArglistOrder& argOrderOrig); 41 | }; 42 | 43 | } // namespace pir 44 | } // namespace rir 45 | 46 | #endif 47 | -------------------------------------------------------------------------------- /rir/src/compiler/util/env_stub_info.cpp: -------------------------------------------------------------------------------- 1 | #include "env_stub_info.h" 2 | 3 | #include 4 | #include 5 | 6 | namespace rir { 7 | namespace pir { 8 | 9 | // If we only see these (and call instructions) then we stub an environment, 10 | // since it can only be accessed reflectively. 11 | static constexpr auto allowed = { 12 | Tag::Force, Tag::PushContext, Tag::LdVar, Tag::LdVarSuper, 13 | Tag::LdFun, Tag::StVar, Tag::StVarSuper, Tag::Call, 14 | Tag::FrameState, Tag::CallBuiltin, Tag::StaticCall, Tag::LdDots, 15 | Tag::Missing, Tag::IsEnvStub, Tag::MaterializeEnv, Tag::MkEnv}; 16 | 17 | // These are only stubbed on the second try, since they seem to be better 18 | // covered by type speculation pass. 19 | static constexpr auto allowedExtra = { 20 | Tag::Add, Tag::Sub, Tag::Mul, Tag::IDiv, Tag::Div, Tag::Eq, 21 | Tag::Neq, Tag::Gt, Tag::Lt, Tag::Lte, Tag::Gte, Tag::LAnd, 22 | Tag::LOr, Tag::Colon, Tag::Mod, Tag::Pow, Tag::Minus, Tag::Plus, 23 | }; 24 | 25 | // Those do not materialize the stub in any case. PushContext doesn't 26 | // materialize itself but it makes the environment accessible, so it's 27 | // not on this list. 28 | static constexpr auto dontMaterialize = { 29 | Tag::LdVar, Tag::LdVarSuper, Tag::StVar, Tag::StVarSuper, 30 | Tag::FrameState, Tag::IsEnvStub, Tag::LdDots, Tag::Missing}; 31 | 32 | EnvStubInfo::Status EnvStubInfo::of(Tag t) { 33 | auto a1 = std::find(allowed.begin(), allowed.end(), t) != allowed.end(); 34 | auto a2 = std::find(allowedExtra.begin(), allowedExtra.end(), t) != 35 | allowedExtra.end(); 36 | auto m = std::find(dontMaterialize.begin(), dontMaterialize.end(), t) != 37 | dontMaterialize.end(); 38 | assert(!m || (a1 || a2)); 39 | return {a1 || a2, (unsigned)(a1 ? 0 : (a2 ? 1 : 2)), m}; 40 | } 41 | 42 | } // namespace pir 43 | } // namespace rir 44 | -------------------------------------------------------------------------------- /rir/src/compiler/util/env_stub_info.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "compiler/pir/tag.h" 4 | 5 | #include 6 | 7 | namespace rir { 8 | namespace pir { 9 | 10 | struct EnvStubInfo { 11 | public: 12 | struct Status { 13 | bool allowed; 14 | unsigned priority; 15 | bool allowedNotMaterializing; 16 | }; 17 | static Status of(Tag); 18 | }; 19 | 20 | } // namespace pir 21 | } // namespace rir 22 | -------------------------------------------------------------------------------- /rir/src/compiler/util/phi_placement.h: -------------------------------------------------------------------------------- 1 | #ifndef PIR_PHI_PLACEMENT 2 | #define PIR_PHI_PLACEMENT 3 | 4 | #include "../pir/pir.h" 5 | #include "compiler/analysis/cfg.h" 6 | #include "utils/Set.h" 7 | 8 | #include 9 | 10 | namespace rir { 11 | namespace pir { 12 | 13 | class Phi; 14 | class PhiPlacement { 15 | public: 16 | struct PhiInput { 17 | BB* inputBlock; 18 | BB* otherPhi; 19 | Value* aValue; 20 | bool operator==(const PhiInput& other) const { 21 | return inputBlock == other.inputBlock && 22 | otherPhi == other.otherPhi && aValue == other.aValue; 23 | } 24 | }; 25 | 26 | PhiPlacement(Code* code, const std::unordered_map& inputs, 27 | const DominanceGraph& dom, const DominanceFrontier&); 28 | 29 | typedef std::unordered_map> Phis; 30 | 31 | Phis placement; 32 | std::unordered_map dominatingPhi; 33 | }; 34 | 35 | } // namespace pir 36 | } // namespace rir 37 | 38 | #endif 39 | -------------------------------------------------------------------------------- /rir/src/compiler/util/safe_builtins_list.h: -------------------------------------------------------------------------------- 1 | #ifndef SAFE_BUILTINS_LIST_H 2 | #define SAFE_BUILTINS_LIST_H 3 | 4 | #include "R/r.h" 5 | 6 | namespace rir { 7 | namespace pir { 8 | 9 | class SafeBuiltinsList { 10 | public: 11 | static bool always(SEXP builtin); 12 | static bool idempotent(SEXP builtin); 13 | static bool nonObject(SEXP builtin); 14 | static bool nonObjectIdempotent(SEXP builtin); 15 | static bool always(int builtin); 16 | static bool returnsObj(int builtin); 17 | static bool idempotent(int builtin); 18 | static bool nonObject(int builtin); 19 | static bool nonObjectIdempotent(int builtin); 20 | static bool forInline(int builtin); 21 | static bool forInlineByName(SEXP name); 22 | static bool assumeStableInBaseEnv(SEXP name); 23 | }; 24 | 25 | } // namespace pir 26 | } // namespace rir 27 | 28 | #endif 29 | -------------------------------------------------------------------------------- /rir/src/compiler/util/visitor.cpp: -------------------------------------------------------------------------------- 1 | #include "visitor.h" 2 | #include "compiler/analysis/cfg.h" 3 | #include "utils/Set.h" 4 | #include 5 | 6 | namespace rir { 7 | namespace pir { 8 | 9 | template <> 10 | void DominatorTreeVisitor::run( 11 | BB* entry, BBAction action) const { 12 | VisitorHelpers::IDMarker done(entry->owner->nextBBId); 13 | std::deque todo; 14 | todo.push_back(entry); 15 | 16 | while (!todo.empty()) { 17 | BB* cur = todo.front(); 18 | todo.pop_front(); 19 | if (!done.check(cur)) { 20 | done.set(cur); 21 | std::vector temp; 22 | dom.dominatorTreeNext(cur, [&](BB* bb) { temp.push_back(bb); }); 23 | todo.insert(todo.begin(), temp.begin(), temp.end()); 24 | action(cur); 25 | } 26 | } 27 | } 28 | 29 | template <> 30 | void DominatorTreeVisitor::run( 31 | BB* entry, BBAction action) const { 32 | // DominanceGraph assumes stable BB ids. For pointer marker strategy (which 33 | // allows renumbering) we need to cache the dominator tree first. 34 | std::unordered_map> cache; 35 | { 36 | VisitorHelpers::IDMarker done(entry->owner->nextBBId); 37 | std::stack todo; 38 | todo.push(entry); 39 | 40 | while (!todo.empty()) { 41 | BB* cur = todo.top(); 42 | todo.pop(); 43 | if (!done.check(cur)) { 44 | done.set(cur); 45 | dom.dominatorTreeNext(cur, [&](BB* bb) { 46 | cache[cur].insert(bb); 47 | todo.push(bb); 48 | }); 49 | } 50 | } 51 | } 52 | { 53 | VisitorHelpers::PointerMarker done(entry->owner->nextBBId); 54 | std::deque todo; 55 | todo.push_back(entry); 56 | 57 | while (!todo.empty()) { 58 | BB* cur = todo.front(); 59 | todo.pop_front(); 60 | if (!done.check(cur)) { 61 | done.set(cur); 62 | // Relies on SmallSet maintaining insertion order 63 | todo.insert(todo.begin(), cache[cur].begin(), cache[cur].end()); 64 | action(cur); 65 | } 66 | } 67 | } 68 | } 69 | 70 | } // namespace pir 71 | } // namespace rir 72 | -------------------------------------------------------------------------------- /rir/src/config.h: -------------------------------------------------------------------------------- 1 | #ifndef RIR_CONFIG_H 2 | #define RIR_CONFIG_H 3 | 4 | /** Everyone wants R */ 5 | #include "R/r.h" 6 | 7 | /** C/C++ interoperability layer for declarations and common data types 8 | */ 9 | #ifndef __cplusplus 10 | 11 | #define bool int 12 | #define nullptr NULL 13 | #define true 1 14 | #define false 0 15 | 16 | #endif 17 | 18 | #endif // RIR_CONFIG_H 19 | -------------------------------------------------------------------------------- /rir/src/interpreter/builtins.h: -------------------------------------------------------------------------------- 1 | #ifndef RIR_INTERP_BUILTINS_H 2 | #define RIR_INTERP_BUILTINS_H 3 | 4 | #include "interp_incl.h" 5 | 6 | namespace rir { 7 | 8 | SEXP tryFastSpecialCall(CallContext& call); 9 | SEXP tryFastBuiltinCall(CallContext& call); 10 | bool supportsFastBuiltinCall(SEXP blt, size_t nargs); 11 | 12 | } // namespace rir 13 | 14 | #endif 15 | -------------------------------------------------------------------------------- /rir/src/interpreter/decompile.cpp: -------------------------------------------------------------------------------- 1 | #include "interpreter/instance.h" 2 | #include "runtime/DispatchTable.h" 3 | 4 | namespace rir { 5 | 6 | SEXP rirDecompile(SEXP s) { 7 | if (auto c = Code::check(s)) { 8 | return src_pool_at(c->src); 9 | } 10 | if (auto f = Function::check(s)) { 11 | return src_pool_at(f->body()->src); 12 | } 13 | if (auto t = DispatchTable::check(s)) { 14 | // Default is the source of the first function in the dispatch table 15 | auto f = t->baseline(); 16 | return src_pool_at(f->body()->src); 17 | } 18 | return s; 19 | } 20 | 21 | } // namespace rir 22 | -------------------------------------------------------------------------------- /rir/src/interpreter/interp_incl.h: -------------------------------------------------------------------------------- 1 | #ifndef RIR_INTERPRETER_INCL_C_H 2 | #define RIR_INTERPRETER_INCL_C_H 3 | 4 | #include "R/r.h" 5 | #include "bc/BC_inc.h" 6 | #include "runtime/ArglistOrder.h" 7 | 8 | const static uint32_t NO_DEOPT_INFO = (uint32_t)-1; 9 | 10 | namespace rir { 11 | 12 | struct InterpreterInstance; 13 | struct Code; 14 | struct CallContext; 15 | class Configurations; 16 | 17 | bool isValidClosureSEXP(SEXP closure); 18 | 19 | void initializeRuntime(); 20 | 21 | /** Returns the global context for the interpreter - important to get access to 22 | the shared constant and source pools. 23 | 24 | TODO Even in multithreaded mode we probably want to have cp and src pools 25 | shared - it is not that we add stuff to them often. 26 | */ 27 | InterpreterInstance* globalContext(); 28 | Configurations* pirConfigurations(); 29 | 30 | SEXP evalRirCodeExtCaller(Code* c, SEXP env); 31 | 32 | SEXP rirEval(SEXP f, SEXP env); 33 | SEXP rirApplyClosure(SEXP, SEXP, SEXP, SEXP, SEXP); 34 | SEXP rirForcePromise(SEXP); 35 | 36 | SEXP createLegacyArglist(ArglistOrder::CallId id, size_t length, 37 | const R_bcstack_t* stackArgs, SEXP* heapArgs, 38 | const Immediate* names, SEXP ast, 39 | ArglistOrder* reordering, bool eagerCallee, 40 | bool recreateOriginalPromargs); 41 | 42 | SEXP createEnvironment(std::vector* args, const SEXP parent, 43 | const Opcode* pc, SEXP stub); 44 | 45 | SEXP rirDecompile(SEXP s); 46 | 47 | void rirPrint(SEXP s); 48 | 49 | void serializeRir(SEXP s, SEXP refTable, R_outpstream_t out); 50 | SEXP deserializeRir(SEXP refTable, R_inpstream_t inp); 51 | // Will serialize and deserialize the SEXP, returning a deep copy. 52 | SEXP copyBySerial(SEXP x); 53 | 54 | SEXP materialize(SEXP rirDataWrapper); 55 | 56 | SEXP evaluatePromise(SEXP e, Opcode* pc, bool delayNamed = false); 57 | inline SEXP evaluatePromise(SEXP e) { return evaluatePromise(e, nullptr); } 58 | 59 | } // namespace rir 60 | 61 | #endif 62 | -------------------------------------------------------------------------------- /rir/src/interpreter/profiler.h: -------------------------------------------------------------------------------- 1 | #ifndef interpreter_profiler_h 2 | #define interpreter_profiler_h 3 | 4 | namespace rir { 5 | 6 | class RuntimeProfiler { 7 | public: 8 | RuntimeProfiler(); 9 | ~RuntimeProfiler(); 10 | static void initProfiler(); 11 | static bool enabled(); 12 | void sample(int); 13 | }; 14 | 15 | } // namespace rir 16 | 17 | #endif 18 | -------------------------------------------------------------------------------- /rir/src/interpreter/runtime.cpp: -------------------------------------------------------------------------------- 1 | #include "api.h" 2 | #include "interp.h" 3 | #include "profiler.h" 4 | 5 | #include 6 | 7 | namespace rir { 8 | 9 | InterpreterInstance* globalContext_; 10 | 11 | /** Checks if given closure should be executed using RIR. 12 | 13 | If the given closure is RIR function, returns its Function object, otherwise 14 | returns nullptr. 15 | */ 16 | bool isValidClosureSEXP(SEXP closure) { 17 | if (TYPEOF(closure) != CLOSXP) { 18 | return false; 19 | } 20 | if (DispatchTable::check(BODY(closure))) { 21 | return true; 22 | } 23 | return false; 24 | } 25 | 26 | void initializeRuntime() { 27 | // initialize the global context 28 | globalContext_ = new InterpreterInstance; 29 | context_init(); 30 | registerExternalCode(rirEval, rirApplyClosure, rirForcePromise, rirCompile, 31 | rirDecompile, rirPrint, deserializeRir, serializeRir, 32 | materialize); 33 | RuntimeProfiler::initProfiler(); 34 | } 35 | 36 | InterpreterInstance* globalContext() { return globalContext_; } 37 | 38 | } // namespace rir 39 | -------------------------------------------------------------------------------- /rir/src/interpreter/safe_force.cpp: -------------------------------------------------------------------------------- 1 | #include "safe_force.h" 2 | #include "R/RList.h" 3 | #include "R/Symbols.h" 4 | #include "R/r.h" 5 | 6 | #include 7 | 8 | namespace rir { 9 | 10 | SEXP safeEval(SEXP e) { 11 | SEXPTYPE t = TYPEOF(e); 12 | if (t == LANGSXP || t == SYMSXP || t == PROMSXP || t == BCODESXP || 13 | t == EXTERNALSXP) { 14 | return R_UnboundValue; 15 | } else { 16 | // Constant 17 | return e; 18 | } 19 | } 20 | 21 | SEXP safeForcePromise(SEXP e) { 22 | if (PRVALUE(e) == R_UnboundValue) { 23 | SEXP val = safeEval(PRCODE(e)); 24 | if (val != R_UnboundValue) { 25 | SET_PRVALUE(e, val); 26 | ENSURE_NAMEDMAX(val); 27 | SET_PRENV(e, R_NilValue); 28 | } 29 | return val; 30 | } else { 31 | return PRVALUE(e); 32 | } 33 | } 34 | 35 | } // namespace rir 36 | -------------------------------------------------------------------------------- /rir/src/interpreter/safe_force.h: -------------------------------------------------------------------------------- 1 | #ifndef RIR_SAFE_FORCE_H 2 | #define RIR_SAFE_FORCE_H 3 | 4 | #include 5 | 6 | namespace rir { 7 | 8 | // Will try to evaluate the SEXP if it definitely doesn't cause side effects, 9 | // rho can be nullptr if the environment is unknown 10 | SEXP safeEval(SEXP e); 11 | // Will try to evaluate the promise if it definitely doesn't cause side effects 12 | SEXP safeForcePromise(SEXP e); 13 | 14 | } // namespace rir 15 | 16 | #endif 17 | -------------------------------------------------------------------------------- /rir/src/runtime/Deoptimization.cpp: -------------------------------------------------------------------------------- 1 | #include "Deoptimization.h" 2 | #include "R/Serialize.h" 3 | #include "runtime/Code.h" 4 | 5 | namespace rir { 6 | 7 | void DeoptMetadata::print(std::ostream& out) const { 8 | for (size_t i = 0; i < numFrames; ++i) { 9 | auto f = frames[i]; 10 | out << f.code << "+" << f.pc - f.code->code() << " s" << f.stackSize; 11 | if (i < numFrames - 1) 12 | out << ", "; 13 | } 14 | } 15 | 16 | } // namespace rir 17 | -------------------------------------------------------------------------------- /rir/src/runtime/Deoptimization.h: -------------------------------------------------------------------------------- 1 | #ifndef RIR_DEOPTIMIZATION_H 2 | #define RIR_DEOPTIMIZATION_H 3 | 4 | #include 5 | #include 6 | 7 | namespace rir { 8 | #pragma pack(push) 9 | #pragma pack(1) 10 | 11 | enum class Opcode : uint8_t; 12 | struct Code; 13 | 14 | struct FrameInfo { 15 | Opcode* pc; 16 | Code* code; 17 | size_t stackSize; 18 | bool inPromise; 19 | 20 | FrameInfo() {} 21 | FrameInfo(Opcode* pc, Code* code, size_t stackSize, bool promise) 22 | : pc(pc), code(code), stackSize(stackSize), inPromise(promise) {} 23 | }; 24 | 25 | struct DeoptMetadata { 26 | void print(std::ostream& out) const; 27 | size_t numFrames; 28 | FrameInfo frames[]; 29 | }; 30 | 31 | #pragma pack(pop) 32 | 33 | } // namespace rir 34 | 35 | #endif 36 | -------------------------------------------------------------------------------- /rir/src/runtime/FunctionSignature.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "R/Serialize.h" 4 | #include "R/r.h" 5 | 6 | #include 7 | #include 8 | #include 9 | 10 | namespace rir { 11 | 12 | struct FunctionSignature { 13 | enum class Environment { 14 | CallerProvided, 15 | CalleeCreated, 16 | }; 17 | 18 | enum class OptimizationLevel { 19 | Baseline, 20 | Optimized, 21 | Contextual, 22 | }; 23 | 24 | static FunctionSignature deserialize(SEXP refTable, R_inpstream_t inp) { 25 | Environment envc = (Environment)InInteger(inp); 26 | OptimizationLevel opt = (OptimizationLevel)InInteger(inp); 27 | unsigned numArgs = InInteger(inp); 28 | FunctionSignature sig(envc, opt); 29 | sig.numArguments = numArgs; 30 | sig.dotsPosition = InInteger(inp); 31 | sig.hasDotsFormals = InInteger(inp); 32 | sig.hasDefaultArgs = InInteger(inp); 33 | return sig; 34 | } 35 | 36 | void serialize(SEXP refTable, R_outpstream_t out) const { 37 | OutInteger(out, (int)envCreation); 38 | OutInteger(out, (int)optimization); 39 | OutInteger(out, numArguments); 40 | OutInteger(out, dotsPosition); 41 | OutInteger(out, hasDotsFormals); 42 | OutInteger(out, hasDefaultArgs); 43 | } 44 | 45 | void pushFormal(SEXP arg, SEXP name) { 46 | if (arg != R_MissingArg) 47 | hasDefaultArgs = true; 48 | if (name == R_DotsSymbol) { 49 | hasDotsFormals = true; 50 | dotsPosition = numArguments; 51 | } 52 | numArguments++; 53 | } 54 | 55 | void print(std::ostream& out = std::cout) const { 56 | if (optimization != OptimizationLevel::Baseline) 57 | out << "optimized code "; 58 | if (envCreation == Environment::CallerProvided) 59 | out << "needsEnv "; 60 | } 61 | 62 | public: 63 | FunctionSignature() = delete; 64 | FunctionSignature(Environment envCreation, OptimizationLevel optimization) 65 | : envCreation(envCreation), optimization(optimization) {} 66 | 67 | size_t formalNargs() const { return numArguments; } 68 | 69 | const Environment envCreation; 70 | const OptimizationLevel optimization; 71 | unsigned numArguments = 0; 72 | bool hasDotsFormals = false; 73 | bool hasDefaultArgs = false; 74 | size_t dotsPosition = -1; 75 | }; 76 | 77 | } // namespace rir 78 | -------------------------------------------------------------------------------- /rir/src/runtime/LazyEnvironment.cpp: -------------------------------------------------------------------------------- 1 | #include "LazyEnvironment.h" 2 | #include "utils/Pool.h" 3 | 4 | namespace rir { 5 | 6 | size_t LazyEnvironment::getArgIdx(SEXP n) { 7 | size_t i = 0; 8 | while (i < nargs) { 9 | auto name = Pool::get(names[i]); 10 | if (TYPEOF(name) == LISTSXP) 11 | name = CAR(name); 12 | if (name == n) 13 | break; 14 | i++; 15 | } 16 | return i; 17 | } 18 | 19 | SEXP LazyEnvironment::getArg(SEXP n) { 20 | auto i = getArgIdx(n); 21 | if (i == nargs) 22 | return R_UnboundValue; 23 | return getArg(i); 24 | } 25 | 26 | bool LazyEnvironment::isMissing(SEXP n) { 27 | auto i = getArgIdx(n); 28 | if (i == nargs) 29 | return false; 30 | return isMissing(i); 31 | } 32 | 33 | bool LazyEnvironment::isMissing(size_t i) { 34 | assert(i < nargs); 35 | return missing[i] || getArg(i) == R_MissingArg; 36 | } 37 | 38 | } // namespace rir 39 | -------------------------------------------------------------------------------- /rir/src/runtime/TypeFeedback_inl.h: -------------------------------------------------------------------------------- 1 | #ifndef RIR_RUNTIME_FEEDBACK_INL_H 2 | #define RIR_RUNTIME_FEEDBACK_INL_H 3 | 4 | #include "Code.h" 5 | #include "TypeFeedback.h" 6 | 7 | namespace rir { 8 | 9 | 10 | 11 | } // namespace rir 12 | 13 | #endif 14 | -------------------------------------------------------------------------------- /rir/src/runtime/rirPrint.cpp: -------------------------------------------------------------------------------- 1 | #include "R/Printing.h" 2 | #include "R/r.h" 3 | 4 | #include 5 | 6 | namespace rir { 7 | 8 | // Print the representation of s to std::cout 9 | void rirPrint(SEXP s) { 10 | assert(TYPEOF(s) == EXTERNALSXP); 11 | Rprintf(Print::dumpSexp(s).c_str()); 12 | Rprintf("\n"); 13 | } 14 | 15 | } // namespace rir 16 | -------------------------------------------------------------------------------- /rir/src/simple_instruction_list.h: -------------------------------------------------------------------------------- 1 | #ifndef SIMPLE_INSTRUCTION_LIST_H 2 | #define SIMPLE_INSTRUCTION_LIST_H 3 | 4 | // A "simple instruction" is a bytecode instruction which is created with 5 | // "rir.()". It doesn't take any arguments or do anything 6 | // unique ("fancy" or different than other simple instructions), except that 7 | // it's interpreted differently. For example, `int3` creates a breakpoint, and 8 | // `printInvocation` prints the calling function's invocation count. Instead 9 | // of modifying a lot of files, to add a simple instruction: 10 | // 11 | // - Add a statement here - V(NESTED, , ): 12 | // this declares the instruction 13 | // - Add an INSTRUCTION(_) { ... } to interp.cpp: 14 | // this defines how to interpret the instruction 15 | 16 | #define SIMPLE_INSTRUCTIONS(V, NESTED) V(NESTED, int3, Int3) 17 | 18 | #endif 19 | -------------------------------------------------------------------------------- /rir/src/utils/FormalArgs.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "R/RList.h" 4 | #include "runtime/Function.h" 5 | 6 | #include 7 | 8 | namespace rir { 9 | 10 | class FormalArgs { 11 | std::vector names_; 12 | std::vector defaultArgs_; 13 | bool hasDefaultArgs_, hasDots_; 14 | SEXP original_; 15 | 16 | public: 17 | FormalArgs(const FormalArgs&) = delete; 18 | FormalArgs& operator=(const FormalArgs&) = delete; 19 | 20 | FormalArgs(rir::Function* function, SEXP formals) 21 | : hasDefaultArgs_(false), hasDots_(false), original_(formals) { 22 | unsigned i = 0; 23 | for (auto it = RList(formals).begin(); it != RList::end(); ++it, ++i) { 24 | names_.push_back(it.tag()); 25 | 26 | if (it.tag() == R_DotsSymbol) 27 | hasDots_ = true; 28 | 29 | auto arg = function->defaultArg(i); 30 | if (*it != R_MissingArg) { 31 | assert(arg != nullptr && "Rir compiled function is missing a " 32 | "compiled default argument"); 33 | hasDefaultArgs_ = true; 34 | defaultArgs_.push_back(arg->container()); 35 | } else { 36 | assert(arg == nullptr && 37 | "Rir compiled function has a default argument that is " 38 | "not in the formals list"); 39 | defaultArgs_.push_back(R_MissingArg); 40 | } 41 | } 42 | } 43 | 44 | const std::vector& names() const { return names_; } 45 | 46 | const std::vector& defaultArgs() const { return defaultArgs_; } 47 | 48 | bool hasDefaultArgs() const { return hasDefaultArgs_; } 49 | 50 | bool hasDots() const { return hasDots_; } 51 | 52 | size_t nargs() const { return names_.size(); } 53 | 54 | SEXP original() const { return original_; } 55 | }; 56 | 57 | } // namespace rir 58 | -------------------------------------------------------------------------------- /rir/src/utils/Pool.cpp: -------------------------------------------------------------------------------- 1 | #include "utils/Pool.h" 2 | #include "R/Protect.h" 3 | 4 | namespace rir { 5 | 6 | std::unordered_map Pool::numbers; 7 | std::unordered_map Pool::ints; 8 | std::unordered_map Pool::contents; 9 | std::unordered_set Pool::patchable; 10 | 11 | BC::PoolIdx Pool::getNum(double n) { 12 | if (numbers.count(n)) 13 | return numbers.at(n); 14 | 15 | SEXP s = Rf_allocVector(REALSXP, 1); 16 | Protect p(s); 17 | 18 | REAL(s)[0] = n; 19 | SET_NAMED(s, 2); 20 | 21 | size_t i = cp_pool_add(s); 22 | assert(i < BC::MAX_POOL_IDX); 23 | 24 | numbers[n] = i; 25 | return i; 26 | } 27 | 28 | BC::PoolIdx Pool::getInt(int n) { 29 | if (ints.count(n)) 30 | return ints.at(n); 31 | 32 | SEXP s = Rf_allocVector(INTSXP, 1); 33 | Protect p(s); 34 | 35 | INTEGER(s)[0] = n; 36 | SET_NAMED(s, 2); 37 | 38 | size_t i = cp_pool_add(s); 39 | assert(i < BC::MAX_POOL_IDX); 40 | 41 | ints[n] = i; 42 | return i; 43 | } 44 | 45 | } // namespace rir 46 | -------------------------------------------------------------------------------- /rir/src/utils/Pool.h: -------------------------------------------------------------------------------- 1 | 2 | #ifndef RJIT_RIR_POOL 3 | #define RJIT_RIR_POOL 4 | 5 | #include "R/r.h" 6 | #include "bc/BC_inc.h" 7 | #include "interpreter/instance.h" 8 | 9 | #include 10 | #include 11 | 12 | namespace rir { 13 | 14 | class Pool { 15 | static std::unordered_map numbers; 16 | static std::unordered_map ints; 17 | static std::unordered_map contents; 18 | static std::unordered_set patchable; 19 | 20 | public: 21 | static BC::PoolIdx insert(SEXP e) { 22 | if (contents.count(e)) 23 | return contents.at(e); 24 | 25 | SET_NAMED(e, 2); 26 | size_t i = cp_pool_add(e); 27 | contents[e] = i; 28 | return i; 29 | } 30 | 31 | static BC::PoolIdx makeSpace() { 32 | size_t i = cp_pool_add(R_NilValue); 33 | patchable.insert(i); 34 | return i; 35 | } 36 | 37 | static void patch(BC::PoolIdx idx, SEXP e) { 38 | // Patching must not write to contents, otherwise nasty bugs can occur! 39 | // Eg.: we makeSpace 42, patch X into 42, then patch Y into 42, X gets 40 | // garbage collected, Z gets allocated to where X used to be, and now 41 | // insert of Z finds X in contents and returns 42, which, first, returns 42 | // Y when looked up in the constant pool, and, second, doesn't store Z 43 | // which may get collected.. 44 | SET_NAMED(e, 2); 45 | // Also make sure we are not randomly patching a location that doesn't 46 | // come from makeSpace 47 | assert(patchable.count(idx)); 48 | cp_pool_set(idx, e); 49 | } 50 | 51 | static BC::PoolIdx getNum(double n); 52 | static BC::PoolIdx getInt(int n); 53 | 54 | static SEXP get(BC::PoolIdx i) { return cp_pool_at(i); } 55 | }; 56 | 57 | } // namespace rir 58 | 59 | #endif 60 | -------------------------------------------------------------------------------- /rir/src/utils/Set.h: -------------------------------------------------------------------------------- 1 | #ifndef RIR_SET_H 2 | #define RIR_SET_H 3 | 4 | #include 5 | #include 6 | 7 | namespace rir { 8 | 9 | template 10 | class SmallSet { 11 | std::vector container; 12 | 13 | public: 14 | typedef typename std::vector::iterator iterator; 15 | typedef typename std::vector::const_iterator const_iterator; 16 | 17 | SmallSet() {} 18 | explicit SmallSet(std::initializer_list in) : container(in) {} 19 | 20 | void insert(T t) { 21 | for (const auto& e : container) 22 | if (e == t) 23 | return; 24 | container.push_back(t); 25 | } 26 | 27 | void clear() { container.clear(); } 28 | 29 | size_t count(const T t) const { return includes(t) ? 1 : 0; } 30 | 31 | bool includes(const T t) const { 32 | for (const auto& e : container) 33 | if (e == t) 34 | return true; 35 | return false; 36 | } 37 | 38 | bool empty() const { return container.empty(); } 39 | 40 | bool operator!=(const SmallSet& other) const { return !(*this == other); } 41 | 42 | bool operator==(const SmallSet& other) const { 43 | if (container.size() != other.size()) 44 | return false; 45 | 46 | for (const auto& e1 : container) { 47 | for (const auto& e2 : other.container) { 48 | if (e1 == e2) 49 | goto op_equal_found_element; 50 | } 51 | return false; 52 | op_equal_found_element : {} 53 | } 54 | return true; 55 | } 56 | 57 | size_t size() const { return container.size(); } 58 | 59 | iterator find(const T& t) { 60 | return std::find(container.begin(), container.end(), t); 61 | } 62 | 63 | iterator erase(iterator e) { return container.erase(e); } 64 | void erase(T e) { erase(find(e)); } 65 | const_iterator erase(const_iterator e) { return container.erase(e); } 66 | 67 | iterator begin() { return container.begin(); } 68 | iterator end() { return container.end(); } 69 | const_iterator cbegin() const { return container.cbegin(); } 70 | const_iterator cend() const { return container.cend(); } 71 | const_iterator begin() const { return container.cbegin(); } 72 | const_iterator end() const { return container.cend(); } 73 | }; 74 | 75 | } // namespace rir 76 | 77 | #endif 78 | -------------------------------------------------------------------------------- /rir/src/utils/String.h: -------------------------------------------------------------------------------- 1 | #ifndef RIR_STRING_H 2 | #define RIR_STRING_H 3 | 4 | namespace rir { 5 | 6 | static constexpr bool inline staticStringEqual(char const* a, char const* b) { 7 | return *a == *b && (*a == '\0' || staticStringEqual(a + 1, b + 1)); 8 | } 9 | 10 | } // namespace rir 11 | 12 | #endif 13 | -------------------------------------------------------------------------------- /rir/src/utils/Terminal.h: -------------------------------------------------------------------------------- 1 | #ifndef RIR_TERMINAL_ 2 | #define RIR_TERMINAL_ 3 | 4 | #include 5 | #include 6 | 7 | struct ConsoleColor { 8 | static bool isTTY(std::ostream& out) { 9 | if (out.rdbuf() == std::cout.rdbuf() && isatty(fileno(stdout))) { 10 | return true; 11 | } else if (out.rdbuf() == std::cerr.rdbuf() && isatty(fileno(stderr))) { 12 | return true; 13 | } 14 | return false; 15 | } 16 | static void red(std::ostream& out) { out << "\033[1;31m"; } 17 | static void yellow(std::ostream& out) { out << "\033[1;33m"; } 18 | static void blue(std::ostream& out) { out << "\033[1;34m"; } 19 | static void magenta(std::ostream& out) { out << "\033[1;35m"; } 20 | static void clear(std::ostream& out) { out << "\033[0m"; } 21 | }; 22 | 23 | #endif 24 | -------------------------------------------------------------------------------- /rir/src/utils/UUID.cpp: -------------------------------------------------------------------------------- 1 | #include "UUID.h" 2 | #include "R/Serialize.h" 3 | 4 | #include 5 | 6 | namespace rir { 7 | 8 | static size_t nextUuid = 0; 9 | 10 | // Generates a random UUID 11 | UUID UUID::random() { return UUID(++nextUuid); } 12 | 13 | UUID UUID::deserialize(SEXP refTable, R_inpstream_t inp) { 14 | UUID uuid; 15 | InBytes(inp, &uuid.uuid, sizeof(uuid.uuid)); 16 | return uuid; 17 | } 18 | 19 | void UUID::serialize(SEXP refTable, R_outpstream_t out) const { 20 | OutBytes(out, &uuid, sizeof(uuid)); 21 | } 22 | 23 | std::string UUID::str() { 24 | std::ostringstream str; 25 | str << uuid; 26 | return str.str(); 27 | } 28 | 29 | bool UUID::operator==(const UUID& other) const { return uuid == other.uuid; } 30 | 31 | } // namespace rir 32 | -------------------------------------------------------------------------------- /rir/src/utils/UUID.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include 4 | 5 | #include 6 | 7 | namespace rir { 8 | 9 | class UUID { 10 | size_t uuid; 11 | 12 | UUID() {} 13 | explicit UUID(size_t v) : uuid(v) {} 14 | 15 | public: 16 | // Generates a random UUID 17 | static UUID random(); 18 | static UUID deserialize(SEXP refTable, R_inpstream_t inp); 19 | void serialize(SEXP refTable, R_outpstream_t out) const; 20 | std::string str(); 21 | 22 | bool operator==(const UUID& other) const; 23 | friend struct std::hash; 24 | }; 25 | 26 | } // namespace rir 27 | 28 | namespace std { 29 | template <> 30 | struct hash { 31 | std::size_t operator()(const rir::UUID& v) const { return v.uuid; } 32 | }; 33 | } // namespace std 34 | -------------------------------------------------------------------------------- /rir/src/utils/escape_string.h: -------------------------------------------------------------------------------- 1 | #ifndef ESCAPE_STRING 2 | #define ESCAPE_STRING 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | namespace rir { 13 | 14 | static std::string escapeString(std::string str) { 15 | std::string res = ""; 16 | for (char c : str) { 17 | if (c >= ' ' && c <= '~' && c != '\\' && c != '"') { 18 | res += c; 19 | } else { 20 | res += '\\'; 21 | switch (c) { 22 | case '"': 23 | case '\\': 24 | res += c; 25 | break; 26 | case '\n': 27 | res += 'n'; 28 | break; 29 | case '\r': 30 | res += 'r'; 31 | break; 32 | case '\t': 33 | res += 't'; 34 | break; 35 | default: 36 | const char* hexs = "0123456789ABCDEF"; 37 | res += 'x'; 38 | res += hexs[c >> 4]; 39 | res += hexs[c & 0xF]; 40 | break; 41 | } 42 | } 43 | } 44 | return res; 45 | } 46 | 47 | } // namespace rir 48 | 49 | #endif 50 | -------------------------------------------------------------------------------- /rir/src/utils/filesystem.cpp: -------------------------------------------------------------------------------- 1 | #include "filesystem.h" 2 | #include 3 | #include 4 | #include 5 | #include 6 | 7 | // From 8 | // https://stackoverflow.com/questions/5467725/how-to-delete-a-directory-and-its-contents-in-posix-c 9 | static int unlinkCb(const char* fpath, const struct stat* sb, int typeflag, 10 | struct FTW* ftwbuf) { 11 | int rv = remove(fpath); 12 | 13 | if (rv) 14 | perror(fpath); 15 | 16 | return rv; 17 | } 18 | 19 | int removeDirectory(const char* path) { 20 | return nftw(path, unlinkCb, 64, FTW_DEPTH | FTW_PHYS); 21 | } 22 | 23 | int clearOrCreateDirectory(const char* path) { 24 | int rv = removeDirectory(path); 25 | if (rv != 0 && errno != ENOENT) 26 | return rv; 27 | return mkdir(path, 0777); 28 | } 29 | 30 | // From 31 | // https://stackoverflow.com/questions/18792489/how-to-create-a-temporary-directory-in-c 32 | std::string createTmpDirectory(const std::string& pattern) { 33 | char* p = new char[pattern.size() + 1]; 34 | size_t i = 0; 35 | for (auto c : pattern) 36 | p[i++] = c; 37 | p[i] = 0; 38 | auto dir = mkdtemp(p); 39 | if (dir == nullptr) 40 | perror("mkdtemp failed: "); 41 | std::string res = dir; 42 | delete[] p; 43 | return res; 44 | } 45 | -------------------------------------------------------------------------------- /rir/src/utils/filesystem.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include 4 | 5 | // Clear directory contents, create it if missing 6 | int clearOrCreateDirectory(const char* path); 7 | 8 | std::string createTmpDirectory(const std::string& pattern = "/tmp/rsh.XXXXXX"); 9 | -------------------------------------------------------------------------------- /rir/src/utils/measuring.h: -------------------------------------------------------------------------------- 1 | #ifndef MEASURING_H 2 | #define MEASURING_H 3 | 4 | #include 5 | 6 | namespace rir { 7 | 8 | class Measuring { 9 | public: 10 | static void startTimer(const std::string& name); 11 | static void countTimer(const std::string& name); 12 | static void addTime(const std::string& name, double time); 13 | static void setEventThreshold(size_t n); 14 | static void countEvent(const std::string& name, size_t n = 1); 15 | static void reset(bool outputOld = false); 16 | }; 17 | 18 | } // namespace rir 19 | 20 | #endif 21 | -------------------------------------------------------------------------------- /rir/src/utils/random.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | namespace rir { 4 | 5 | // low-quality but fast PRNG 6 | class Random { 7 | 8 | unsigned long x = 123456789, y = 362436069, z = 521288629; 9 | 10 | public: 11 | unsigned long operator()() { // period 2^96-1 12 | unsigned long t; 13 | x ^= x << 16; 14 | x ^= x >> 5; 15 | x ^= x << 1; 16 | 17 | t = x; 18 | x = y; 19 | y = z; 20 | z = t ^ x ^ y; 21 | 22 | return z; 23 | } 24 | 25 | static Random& singleton() { 26 | static Random r; 27 | return r; 28 | } 29 | }; 30 | 31 | } // namespace rir 32 | -------------------------------------------------------------------------------- /rir/tests/S3_regression.R: -------------------------------------------------------------------------------- 1 | setClass("a", slots=c(myint="numeric")) 2 | 3 | myfun.a <- function(x) { 4 | print(.Generic) 5 | } 6 | 7 | myfun <- function(x) { 8 | # dispatch on the class of x 9 | UseMethod("myfun") 10 | } 11 | 12 | x <- new("a") 13 | myfun(x) 14 | myfun(x) 15 | myfun(x) 16 | myfun(x) 17 | myfun(x) 18 | myfun(x) 19 | -------------------------------------------------------------------------------- /rir/tests/active_bindings_regression.r: -------------------------------------------------------------------------------- 1 | f = function() { 2 | makeActiveBinding("foo", identity, environment()) 3 | rm(foo) 4 | TRUE 5 | } 6 | for (i in 1:10) 7 | stopifnot(tryCatch(f(), error=function(e) FALSE)) 8 | -------------------------------------------------------------------------------- /rir/tests/all-equal-regression.R: -------------------------------------------------------------------------------- 1 | x = quote({1}) 2 | f = function() all.equal(x,x) 3 | stopifnot(f()) 4 | stopifnot(f()) 5 | stopifnot(f()) 6 | stopifnot(f()) 7 | -------------------------------------------------------------------------------- /rir/tests/annotations_depromise.R: -------------------------------------------------------------------------------- 1 | if (Sys.getenv("PIR_DISABLE_ANNOTATIONS") == "1") { 2 | print("test only works with annotations enabled") 3 | q() 4 | } 5 | 6 | 7 | f <- function(a) { 8 | 9 | #a is supposed to be an unwrapped value 10 | performStep(3) 11 | 12 | a # this makes sure a's evaluation is not causing any further effects. 13 | # this should be a Force(value) -> value 14 | 15 | performStep(4) 16 | a + 1L 17 | 18 | } 19 | f <- rir.annotateDepromised(f) 20 | 21 | 22 | performStep <- function(n) { 23 | steps <<- c(steps, n) 24 | } 25 | 26 | g <- function() { 27 | 28 | steps <<- integer(); 29 | performStep(1) 30 | 31 | result <- f({ performStep(2); 6L }) 32 | stopifnot(result == 7L) 33 | print(steps) 34 | stopifnot(steps == c(1, 2, 3,4)) 35 | 36 | } 37 | 38 | g() # call to f will be interpreted 39 | rir.compile(g) 40 | g() 41 | g() 42 | g() 43 | g() 44 | g() 45 | -------------------------------------------------------------------------------- /rir/tests/deoptless.R: -------------------------------------------------------------------------------- 1 | q = 1L 2 | f = function(x) { 3 | s = 0L 4 | for (i in 1:x) 5 | s = s+q 6 | s 7 | } 8 | 9 | for (i in 1:5) 10 | print(system.time(print(f(10000000L)))) 11 | 12 | q=1.1 13 | 14 | for (i in 1:5) 15 | print(system.time(print(f(10000000L)))) 16 | -------------------------------------------------------------------------------- /rir/tests/empty_loops.r: -------------------------------------------------------------------------------- 1 | f = function(a) { 2 | while(TRUE) {} 3 | } 4 | pir.compile(rir.compile(f)) 5 | f = function(a) { 6 | while(FALSE) {} 7 | } 8 | pir.compile(rir.compile(f)) 9 | f <- function() { 10 | qq <- 3 > 2 11 | while (qq) { 12 | } 13 | } 14 | pir.compile(rir.compile(f)) 15 | -------------------------------------------------------------------------------- /rir/tests/loop_regressions.R: -------------------------------------------------------------------------------- 1 | count = 0 2 | 3 | a <- 3 4 | 5 | f <- rir.compile(function() 6 | for (i in 1:a) { 7 | count <<- count+1; 8 | i[[1]] <- 10L 9 | }); 10 | 11 | f() 12 | f() 13 | f() 14 | f() 15 | 16 | stopifnot(count == 12) 17 | -------------------------------------------------------------------------------- /rir/tests/matrix_regression.r: -------------------------------------------------------------------------------- 1 | library(Matrix) 2 | source(system.file("test-tools.R", package = "Matrix")) 3 | 4 | testxyz <- function() { 5 | I <- i1 <- I1 <- Diagonal(1) 6 | I1[1,1] <- i1[1, ] <- I [ ,1] <- NA 7 | print(I) 8 | print(i1) 9 | print(I1) 10 | stopifnot(identical3(I,i1,I1)) 11 | } 12 | 13 | testxyz() 14 | 15 | (tr <- Matrix(cbind(1,0:1))) 16 | testxyz() 17 | sL <- Matrix(, 3,4, sparse=TRUE)# -> "lgC" 18 | testxyz() 19 | trS <- Matrix(tr, sparse=TRUE)# failed in 0.9975-11 20 | testxyz() 21 | stopifnotValid(tr, "triangularMatrix"); stopifnotValid(trS, "triangularMatrix") 22 | testxyz() 23 | stopifnot(all(is.na(sL@x)), ## not yet: all(is.na(sL)), 24 | !any(sL, na.rm=TRUE), all(!sL, na.rm=TRUE), 25 | validObject(Matrix(c(NA,0), 4, 3, byrow = TRUE)), 26 | validObject(Matrix(c(NA,0), 4, 4))) 27 | testxyz() 28 | stopifnotValid(Matrix(c(NA,0,0,0), 4, 4), "sparseMatrix") 29 | testxyz() 30 | 31 | I <- i1 <- I1 <- Diagonal(1) 32 | I1[1,1] <- i1[1, ] <- I [ ,1] <- NA 33 | print(I) 34 | print(i1) 35 | print(I1) 36 | stopifnot(identical3(I,i1,I1)) 37 | -------------------------------------------------------------------------------- /rir/tests/methods_regression.R: -------------------------------------------------------------------------------- 1 | ## test (non-conditional) explicit inheritance 2 | setClass("xy", representation(x="numeric", y="numeric")) 3 | 4 | setIs("xy", "complex", 5 | coerce = function(from) complex(real = from@x, imaginary = from@y), 6 | replace = function(from, value) { 7 | from@x <- Re(value) 8 | from@y <- Im(value) 9 | from 10 | }) 11 | 12 | set.seed(124) 13 | x1 <- rnorm(10) 14 | y1 <- rnorm(10) 15 | cc <- complex(real = x1, imaginary=y1) 16 | xyc <- new("xy", x = x1, y = y1) 17 | stopifnot(identical(cc, as(xyc, "complex"))) 18 | as(xyc, "complex") <- cc * 1i 19 | stopifnot(identical(xyc, new("xy", x = -y1, y = x1))) 20 | 21 | setGeneric("size", function(x)standardGeneric("size")) 22 | ## check that generic for size() was created w/o a default method 23 | stopifnot(is(size, "standardGeneric"), 24 | is.null(selectMethod("size", "ANY",optional=TRUE))) 25 | 26 | setMethod("size", "vector", function(x)length(x)) 27 | 28 | ## class "xy" should inherit the vector method through complex 29 | stopifnot(identical(size(xyc), length(x1))) 30 | removeClass("xy") 31 | removeGeneric("size") 32 | 33 | 34 | ### Related to numeric <-> double <-> integer proposals, end of 2015, on R-devel 35 | myN <- setClass("myN", contains="numeric") 36 | myNid <- setClass("myNid", contains="numeric", representation(id="character")) 37 | NN <- setClass("NN", representation(x="numeric")) 38 | 39 | (m1 <- myN (1:3)) 40 | (m2 <- myNid(1:3, id = "i3")) 41 | -------------------------------------------------------------------------------- /rir/tests/nan_regressions.r: -------------------------------------------------------------------------------- 1 | f <- function(x, y) x == y 2 | 3 | regA <- c(1, 2, 3) 4 | regB <- c(1, 4, 3) 5 | nanA <- c(1, 2, NaN) 6 | nanB <- c(1, 4, NaN) 7 | 8 | # Get the type feedback to a non-NaN vector 9 | f(regA, regB) 10 | f(regA, regB) 11 | f(regA, regB) 12 | f(regA, regB) 13 | # Try with a NaN vector 14 | f(nanA, nanB) 15 | 16 | f <- function(x, y) x == y 17 | 18 | regA <- 1 19 | names(regA) <- "foo" 20 | regB <- 4 21 | names(regB) <- "bar" 22 | nanA <- NaN 23 | names(nanA) <- "foo" 24 | nanB <- NaN 25 | names(nanB) <- "bar" 26 | 27 | # Get the type feedback to a non-NaN attrib scalar 28 | f(regA, regB) 29 | f(regA, regB) 30 | f(regA, regB) 31 | f(regA, regB) 32 | # Try with a NaN attrib scalar 33 | f(nanA, nanB) -------------------------------------------------------------------------------- /rir/tests/native_mod.r: -------------------------------------------------------------------------------- 1 | g = function() { 2 | f = function(a,b) { 3 | r = a %% b 4 | print(paste(a,b,r)) 5 | r 6 | } 7 | stopifnot(f(1L,2L) == 1L) 8 | stopifnot(f(-1L,2L) == 1L) 9 | stopifnot(f(1L,-2L) == -1L) 10 | stopifnot(f(-1L,-2L) == -1L) 11 | stopifnot(f(1L,2L) == 1L) 12 | stopifnot(f(3L,-2L) == -1L) 13 | stopifnot(f(0L,-2L) == 0L) 14 | stopifnot(is.na(f(0L,-0L))) 15 | stopifnot(is.na(f(0L,0L))) 16 | } 17 | 18 | for (i in 1:10) 19 | g() 20 | 21 | g = function() { 22 | f = function(a,b) { 23 | r = a %% b 24 | print(paste(a,b,r)) 25 | r 26 | } 27 | stopifnot(f(1,2) == 1) 28 | stopifnot(f(-1,2) == 1) 29 | stopifnot(f(1,-2) == -1) 30 | stopifnot(f(-1,-2) == -1) 31 | stopifnot(f(1,2) == 1) 32 | stopifnot(f(3,-2) == -1) 33 | stopifnot(f(0,-2) == 0) 34 | stopifnot(is.na(f(0,-0))) 35 | stopifnot(is.na(f(0,0))) 36 | } 37 | 38 | for (i in 1:10) 39 | g() 40 | -------------------------------------------------------------------------------- /rir/tests/nested_loops.R: -------------------------------------------------------------------------------- 1 | if (Sys.getenv("PIR_ENABLE") != "" || 2 | Sys.getenv("RIR_SERIALIZE_CHAOS") != "") { 3 | q() 4 | } 5 | 6 | f <- function(x) { 7 | for (i in 1:x) 8 | for (j in 1:x) 9 | for (k in 1:x) 10 | break 11 | } 12 | rir.compile(f) 13 | for (i in 1:100) 14 | f(10) 15 | stopifnot(length(rir.functionVersions(f)) == 2) 16 | -------------------------------------------------------------------------------- /rir/tests/pir_dispatch.R: -------------------------------------------------------------------------------- 1 | options(error=expression(NULL)) # don't stop on error in batch 2 | 3 | ## cacheMethod : 4 | c0 <- character(0) 5 | l0 <- logical(0) 6 | m0 <- matrix(1,0,0) 7 | df0 <- as.data.frame(c0) 8 | f <- rir.compile(get("cacheMethod", pos = 'package:methods')) 9 | f() 10 | f(NULL) 11 | f(,NULL) 12 | f(NULL,NULL) 13 | f(list()) 14 | f(l0) 15 | f(c0) 16 | f(m0) 17 | f(df0) 18 | f(FALSE) 19 | f(list(),list()) 20 | f(l0,l0) 21 | f(c0,c0) 22 | f(df0,df0) 23 | f(FALSE,FALSE) 24 | -------------------------------------------------------------------------------- /rir/tests/pir_dots.r: -------------------------------------------------------------------------------- 1 | f <- function() quote(...) 2 | for (i in 1:5) 3 | stopifnot(identical(f(), quote(...))) 4 | -------------------------------------------------------------------------------- /rir/tests/pir_eager_call.R: -------------------------------------------------------------------------------- 1 | eagerInnerFun = function(b) { 2 | f = function(a) { 3 | if (a) 4 | 1 5 | eval("dont inline") 6 | } 7 | f(b) 8 | } 9 | a=1 10 | stopifnot( 11 | pir.check(eagerInnerFun, EagerCallArgs, warmup=function(f) {f(a)}) 12 | ) 13 | 14 | eagerInnerFun = function(b) { 15 | f = function(a) { 16 | if (a) 17 | 1 18 | eval("dont inline") 19 | } 20 | # potentially reflective promise cannot be eagerly forced 21 | f(b()) 22 | } 23 | a=function() {eval("1");TRUE} 24 | stopifnot( 25 | pir.check(eagerInnerFun, LazyCallArgs, warmup=function(f) {f(a)}) 26 | ) 27 | -------------------------------------------------------------------------------- /rir/tests/pir_extract_obj.r: -------------------------------------------------------------------------------- 1 | x <- structure(as.list(7:8), class = "foo") 2 | `[[.foo` <- function(x, i) if (i == 1) i else 100 3 | f <- function(x) x[[2]] 4 | 5 | for (i in 1:100) 6 | stopifnot(f(x) == 100) 7 | -------------------------------------------------------------------------------- /rir/tests/pir_isvector.r: -------------------------------------------------------------------------------- 1 | x <- 1:4 2 | dim(x) <- c(2, 2) 3 | f <- function(x) is.vector(x) 4 | for (i in 1:10) 5 | stopifnot(f(x) == FALSE) 6 | -------------------------------------------------------------------------------- /rir/tests/pir_matrix_regression.R: -------------------------------------------------------------------------------- 1 | if (Sys.getenv("LSAN_OPTIONS") != "") 2 | q() 3 | 4 | require("Matrix") 5 | D5. <- Diagonal(x = 5:1) 6 | D5N <- D5.; D5N[5,5] <- NA 7 | f = function() identical(pmin(1, D5.), pmin(1, as.matrix(D5.))) 8 | stopifnot(f()) 9 | stopifnot(f()) 10 | stopifnot(f()) 11 | stopifnot(f()) 12 | stopifnot(f()) 13 | stopifnot(f()) 14 | stopifnot(f()) 15 | stopifnot(f()) 16 | stopifnot(f()) 17 | -------------------------------------------------------------------------------- /rir/tests/pir_nargs.r: -------------------------------------------------------------------------------- 1 | f <- function(...) nargs() 2 | g <- function() f(1, 2, 3) 3 | for (i in 1:10) 4 | stopifnot(g() == 3) 5 | -------------------------------------------------------------------------------- /rir/tests/pir_regression-reg-S4.R: -------------------------------------------------------------------------------- 1 | options(useFancyQuotes=c) 2 | require("Matrix") 3 | a <- c("", "", "tsp") 4 | b <- function(d) { 5 | setClass("foo" ) 6 | } 7 | e <- sapply(a, b) 8 | str(e) # 9 | setOldClass(c("foo", "numeric")) 10 | setClass("A", representation(slot1="numeric", slot2="logical")) 11 | setClass("D1", "A" ) 12 | -------------------------------------------------------------------------------- /rir/tests/pir_regression2.R: -------------------------------------------------------------------------------- 1 | print(callCC) 2 | callCC <- rir.compile(callCC) 3 | rir.disassemble(callCC) 4 | callCC(function(k) 1) 5 | callCC(function(k) k(1)) 6 | callCC(function(k) {k(1); 2}) 7 | callCC(function(k) repeat k(1)) 8 | 9 | 10 | # dealing with objects with no attributes 11 | f12 <- function() { 12 | df <- data.frame(x=ts(c(41,42,43)), y=c(61,62,63)) 13 | mf <- model.frame(df) 14 | # mf[["a"]] is an object without attributes 15 | } 16 | 17 | for (i in 1:10) { 18 | f12() 19 | } 20 | -------------------------------------------------------------------------------- /rir/tests/pir_regression3.R: -------------------------------------------------------------------------------- 1 | 2 | f <- rir.compile(function() { 3 | f1 <- factor(c(1, 2, NA), exclude = NA_real_) 4 | f2 <- factor(c(1, 2, NA), exclude = NULL) 5 | 6 | print(f1) 7 | print(f2) 8 | print(nlevels(f1)) 9 | print(nlevels(f1)) 10 | print(nlevels(f2)) 11 | print(nlevels(f2)) 12 | stopifnot(identical(f1, factor(c(1,2,NA))), 13 | nlevels(f1) == 2, nlevels(f2) == 3, 14 | all(f2 == f2), !any(f2 != f2), 15 | identical(f1 == f1, c(TRUE,TRUE,NA))) 16 | }) 17 | 18 | # pir.setDebugFlags(pir.debugFlags(PrintFinalPir=TRUE, ShowWarnings=TRUE, PrintEarlyPir=TRUE, PrintOriginal=TRUE)) 19 | 20 | f() 21 | print(".") 22 | f() 23 | print(".") 24 | f() 25 | -------------------------------------------------------------------------------- /rir/tests/pir_regression4.R: -------------------------------------------------------------------------------- 1 | curve(sin, -2*pi, 3*pi); pu1 <- par("usr")[1:2] 2 | curve(cos, add = NA) # add = NA new in 2.14.0 3 | 4 | 5 | { 6 | # dead store elimination regression 7 | test <- pir.compile(rir.compile(function() { 8 | a <- 1 9 | id <- function(x) x 10 | id(a) 11 | })) 12 | 13 | t <- rir.compile(function() test()) 14 | stopifnot(t() == 1); 15 | } 16 | -------------------------------------------------------------------------------- /rir/tests/pir_regression5.R: -------------------------------------------------------------------------------- 1 | cc <- function(...)c(...) 2 | setGeneric("cc") 3 | setMethod("cc", "character", function(...)paste(...)) 4 | setClassUnion("Number", c("numeric", "complex")) 5 | setMethod("cc", "Number", function(...) sum(...)) 6 | stopifnot(identical(cc(1:10, 1+1i), sum(1:10, 1+1i))) 7 | stopifnot(identical(cc(1:10, 1+1i), sum(1:10, 1+1i))) 8 | stopifnot(identical(cc(1:10, 1+1i), sum(1:10, 1+1i))) 9 | stopifnot(identical(cc(1:10, 1+1i), sum(1:10, 1+1i))) 10 | -------------------------------------------------------------------------------- /rir/tests/pir_regression6.R: -------------------------------------------------------------------------------- 1 | f <- function(a=1) {print(a); missing(a)} 2 | 3 | for (i in 1:10) 4 | stopifnot(f() == TRUE) 5 | 6 | 7 | lsNamespaceInfo <- function(ns, ...) { 8 | ns <- asNamespace(ns, base.OK = FALSE) 9 | ls(..., envir = get(".__NAMESPACE__.", envir = ns, inherits = FALSE)) 10 | } 11 | allinfoNS <- function(ns) sapply(lsNamespaceInfo(ns), getNamespaceInfo, ns=ns) 12 | utils::str(allinfoNS("stats")) 13 | utils::str(allinfoNS("stats4")) 14 | -------------------------------------------------------------------------------- /rir/tests/pir_regression7.R: -------------------------------------------------------------------------------- 1 | require("Matrix") 2 | print(cS. <- contr.SAS(5, sparse = TRUE)) 3 | x1 <- x2 <- c('a','b','a','b','c') 4 | print(xtabs(~ x1 + x2, sparse= TRUE, exclude = 'c')) 5 | M <- Matrix(diag(1:10), sparse=TRUE) 6 | as.matrix(pmax(M, 7)) 7 | -------------------------------------------------------------------------------- /rir/tests/pir_regression8.R: -------------------------------------------------------------------------------- 1 | foo <- function() { 2 | size = 10L 3 | sum = 0 4 | y = 0 5 | while (y < size) { 6 | x = 0 7 | while (x < size) { 8 | sum = 10 9 | x = x + 1 10 | } 11 | y = y + 1 12 | } 13 | sum 14 | } 15 | 16 | ex <- function() foo() 17 | 18 | ex() 19 | ex() 20 | ex() 21 | ex() 22 | ex() 23 | -------------------------------------------------------------------------------- /rir/tests/pir_regression9.R: -------------------------------------------------------------------------------- 1 | f <- function() { 2 | f <- function(q) { 3 | e <<- environment() 4 | a <- TRUE 5 | q 6 | } 7 | 8 | stopifnot(f(ls(envir=e)) == c("a", "q")) 9 | stopifnot(f(ls(envir=e)) == c("a", "q")) 10 | stopifnot(f(ls(envir=e)) == c("a", "q")) 11 | stopifnot(f(ls(envir=e)) == c("a", "q")) 12 | } 13 | for(i in 1:10) 14 | f() 15 | 16 | f <- function() { 17 | f <- function(i) { 18 | g(i) 19 | } 20 | g <- function(i) { 21 | ls(envir=sys.frame(-i)) 22 | } 23 | r2 = f(2) 24 | r1 = f(1) 25 | stopifnot(r1 == c("i")) 26 | stopifnot(r2 == c("f", "g")) 27 | r2 = f(2) 28 | r1 = f(1) 29 | stopifnot(r1 == c("i")) 30 | stopifnot(r2 == c("f", "g", "r1", "r2")) 31 | r2 = f(2) 32 | r1 = f(1) 33 | stopifnot(r1 == c("i")) 34 | stopifnot(r2 == c("f", "g", "r1", "r2")) 35 | } 36 | for(i in 1:10) 37 | f() 38 | 39 | 40 | # Here we slightly depart from gnur semantics. 41 | # See Instruction::mayObserveContext exception for Force 42 | # stopifnot(f(bad()) == "a") 43 | g <- function(a) a 44 | f <- function(b) g(b) 45 | bad = function() {e = sys.frame(-1); ls(envir=e)} 46 | f(bad()) 47 | f(bad()) 48 | f(bad()) 49 | f(bad()) 50 | f(bad()) 51 | 52 | f0 <- function() { 53 | for (i in 1:10) 54 | last <- i; 55 | last 56 | } 57 | stopifnot(f0() == 10) 58 | stopifnot(f0() == 10) 59 | stopifnot(f0() == 10) 60 | stopifnot(f0() == 10) 61 | stopifnot(f0() == 10) 62 | stopifnot(f0() == 10) 63 | 64 | 65 | 66 | 67 | f <- function() g(1,2) 68 | g <- function(a,b) h(a,b,1) 69 | h <- function(...) { 70 | x <- function(...) c(...) 71 | forceAndCall(3, x, ...) 72 | } 73 | stopifnot(identical(f(), c(1,2,1))) 74 | stopifnot(identical(f(), c(1,2,1))) 75 | stopifnot(identical(f(), c(1,2,1))) 76 | stopifnot(identical(f(), c(1,2,1))) 77 | stopifnot(identical(f(), c(1,2,1))) 78 | stopifnot(identical(f(), c(1,2,1))) 79 | -------------------------------------------------------------------------------- /rir/tests/pir_regression_binding_cache.R: -------------------------------------------------------------------------------- 1 | test <- function() { 2 | f <- function(x) x 3 | g <- function(x) repeat if (x) f(return(1)) else return(2) 4 | gc <- rir.compile(g) 5 | stopifnot(identical(g(TRUE), gc(TRUE))) 6 | stopifnot(identical(g(FALSE), gc(FALSE))) 7 | h <- function(x) { repeat if (x) f(return(1)) else break; 2 } 8 | hc <- rir.compile(h) 9 | stopifnot(identical(h(TRUE), hc(TRUE))) 10 | stopifnot(identical(h(FALSE), hc(FALSE))) 11 | k <- function(x) { repeat if (x) return(1) else f(break); 2 } 12 | kc <- rir.compile(k) 13 | stopifnot(identical(k(TRUE), kc(TRUE))) 14 | stopifnot(identical(k(FALSE), kc(FALSE))) 15 | ## **** need more variations on this. 16 | ## this would give an error prior to fixing a binding cache bug 17 | f <- function(x) { for (y in x) { z <- y; g(break) } ; z } 18 | g <- function(x) x 19 | rir.compile(f)(c(1,2,3)) 20 | } 21 | 22 | test2 <- function() test() 23 | 24 | test2() 25 | test() 26 | test2() 27 | test() 28 | test2() 29 | -------------------------------------------------------------------------------- /rir/tests/pir_regression_check_code.R: -------------------------------------------------------------------------------- 1 | if (as.numeric(Sys.getenv("FAST_TESTS", unset="0"))) 2 | quit() 3 | 4 | tools:::.check_code_usage_in_package(package = "compiler") 5 | -------------------------------------------------------------------------------- /rir/tests/pir_regression_cyclic.r: -------------------------------------------------------------------------------- 1 | f <- function() { 2 | x <- c("a", "b") 3 | names(x) <- x 4 | } 5 | x <- f() 6 | x <- f() 7 | x <- f() 8 | x <- f() 9 | y <- 1:5 10 | y[x] 11 | print(x) 12 | print(attributes(x)) 13 | 14 | 15 | f <- function() { 16 | y <- data.frame(a = 1:5) 17 | x <- c("a", "b") 18 | names(x) <- x 19 | y[, x] <- 0 20 | y 21 | } 22 | f() 23 | f() 24 | f() 25 | f() 26 | 27 | y <- data.frame(a = 1:2) 28 | f <- function() { 29 | x <- c("a", "b") 30 | names(x) <- x 31 | y[, x] <- 0 32 | y 33 | } 34 | f() 35 | f() 36 | f() 37 | f() 38 | -------------------------------------------------------------------------------- /rir/tests/pir_regression_dead_store.r: -------------------------------------------------------------------------------- 1 | foo <- function() { 2 | n <- 5 3 | function() n 4 | } 5 | 6 | f <- foo() 7 | f <- foo() 8 | f <- foo() 9 | f <- foo() 10 | f <- foo() 11 | f <- foo() 12 | f <- foo() 13 | f() 14 | 15 | 16 | foo <- function() { 17 | n_default <- 5 18 | function(n = n_default) n 19 | } 20 | 21 | f <- foo() 22 | f <- foo() 23 | f <- foo() 24 | f <- foo() 25 | f <- foo() 26 | f <- foo() 27 | f <- foo() 28 | f() 29 | 30 | 31 | foo <- function() { 32 | n_default <- 5 33 | delayedAssign("n", n_default, assign.env = globalenv()) 34 | } 35 | 36 | foo() 37 | foo() 38 | foo() 39 | foo() 40 | foo() 41 | foo() 42 | foo() 43 | f <- function() n 44 | f() 45 | -------------------------------------------------------------------------------- /rir/tests/pir_regression_forceAndCall.R: -------------------------------------------------------------------------------- 1 | # missing 2 | f <- function() forceAndCall(1, function(zzz) missing(zzz), quote(expr=)) 3 | for (i in 1:10) 4 | stopifnot(f() == FALSE) 5 | 6 | f <- function() forceAndCall(1, function(zzz) zzz, quote(expr=)) 7 | for (i in 1:10) 8 | stopifnot(identical(f(), quote(expr=))) 9 | 10 | x <- as.list(function(y) 42) 11 | f <- function() forceAndCall(1, function(zzz) missing(zzz), x[[1]]) 12 | for (i in 1:10) 13 | stopifnot(f() == FALSE) 14 | 15 | f <- function() forceAndCall(1, function(zzz) zzz, x[[1]]) 16 | for (i in 1:10) 17 | stopifnot(identical(f(), quote(expr=))) 18 | 19 | 20 | # specials 21 | x <- 0L 22 | f <- function() forceAndCall(1, `if`, TRUE, {x <<- x + 1L; 1}, {x <<- x + 1L; 2}) 23 | f(); f(); f(); f() 24 | stopifnot(x == 4L) 25 | x <- 0L 26 | f <- function() forceAndCall(1, `if`, FALSE, {x <<- x + 1L; 1}, {x <<- x + 1L; 2}) 27 | f(); f(); f(); f() 28 | stopifnot(x == 4L) 29 | x <- 0L 30 | f <- function() forceAndCall(2, `if`, FALSE, {x <<- x + 1L; 1}, {x <<- x + 1L; 2}) 31 | f(); f(); f(); f() 32 | stopifnot(x == 4L) 33 | x <- 0L 34 | f <- function() forceAndCall(3, `if`, FALSE, {x <<- x + 1L; 1}, {x <<- x + 1L; 2}) 35 | f(); f(); f(); f() 36 | stopifnot(x == 4L) 37 | 38 | 39 | # builtins 40 | x <- 0L 41 | f <- function() forceAndCall(2, sum, {x <<- x + 1L; 1}, {x <<- x + 1L; 1}, {x <<- x + 1L; 1}, {x <<- x + 1L; 1}) 42 | f(); f(); f(); f() 43 | stopifnot(x == 16L) 44 | 45 | 46 | # closures 47 | x <- 0L 48 | foo <- function(x, y, z) {} 49 | f <- function() forceAndCall(2, foo, {x <<- x + 1L; 1}, {x <<- x + 1L; 1}, {x <<- x + 1L; 1}) 50 | f(); f(); f(); f() 51 | stopifnot(x == 8L) 52 | x <- 0L 53 | f <- function() forceAndCall(1, function(x, y, z) x + z, {x <<- x + 1L; 1}, {x <<- x + 1L; 1}, {x <<- x + 1L; 1}) 54 | f(); f(); f(); f() 55 | stopifnot(x == 8L) 56 | x <- 0L 57 | foo <- function(x, y, z) x + z 58 | f <- function() forceAndCall(1, foo, {x <<- x + 1L; 1}, {x <<- x + 1L; 1}, {x <<- x + 1L; 1}) 59 | f(); f(); f(); f() 60 | stopifnot(x == 8L) 61 | -------------------------------------------------------------------------------- /rir/tests/pir_regression_missing.R: -------------------------------------------------------------------------------- 1 | f <- function(a,b,c) nargs() 2 | g <- function() { 3 | f() 4 | f(1) 5 | f(1,2) 6 | f(1,2,3) 7 | } 8 | h <- function() g() 9 | 10 | f <- pir.compile(rir.compile(f)) 11 | g <- pir.compile(rir.compile(g)) 12 | h <- pir.compile(rir.compile(h)) 13 | 14 | stopifnot(h()==3) 15 | stopifnot(h()==3) 16 | stopifnot(h()==3) 17 | stopifnot(h()==3) 18 | stopifnot(h()==3) 19 | stopifnot(h()==3) 20 | stopifnot(h()==3) 21 | 22 | 23 | 24 | 25 | f <- function(a,b,c) nargs() + (if (!missing(a)) a else 1) 26 | g <- function() { 27 | stopifnot(f() == 1) 28 | stopifnot(f(1) == 2) 29 | stopifnot(f(1,2) == 3) 30 | stopifnot(f(1,2,3) == 4) 31 | f(1,2) 32 | } 33 | h <- function() g() 34 | 35 | f <- pir.compile(rir.compile(f)) 36 | g <- pir.compile(rir.compile(g)) 37 | h <- pir.compile(rir.compile(h)) 38 | 39 | stopifnot(h()==3) 40 | stopifnot(h()==3) 41 | stopifnot(h()==3) 42 | stopifnot(h()==3) 43 | stopifnot(h()==3) 44 | stopifnot(h()==3) 45 | stopifnot(h()==3) 46 | 47 | 48 | 49 | 50 | f <- function(a,b,c) nargs() + a 51 | g <- function(q) { 52 | stopifnot(f(q) == 2) 53 | print (f(q,2)) 54 | stopifnot(f(q,2) == 3) 55 | stopifnot(f(q,2,3) == 4) 56 | f(q,2) 57 | } 58 | h <- function() g(1) 59 | 60 | f <- pir.compile(rir.compile(f)) 61 | g <- pir.compile(rir.compile(g)) 62 | h <- rir.compile(h) 63 | 64 | stopifnot(h()==3) 65 | stopifnot(h()==3) 66 | stopifnot(h()==3) 67 | stopifnot(h()==3) 68 | stopifnot(h()==3) 69 | stopifnot(h()==3) 70 | stopifnot(h()==3) 71 | 72 | xx1 <- function() { 73 | ok = 0 74 | 75 | # returning a missing arg is supposed to error 76 | f <- function(a,b) 77 | a 78 | 79 | tryCatch(f(), error=function(e) ok <<- 1) 80 | stopifnot(ok == 1); 81 | } 82 | 83 | xx2 <- function() { 84 | ok = 0 85 | # forcing it too, the `(` function forces 86 | q <- function(a) (a) 87 | tryCatch(q(), error=function(e) ok <<- 1) 88 | stopifnot(ok == 1); 89 | } 90 | 91 | xx3 <- function() { 92 | # but passing on without forcing should not error 93 | h <- function(a) 1 94 | g <- function(a) h(a) 95 | g() 96 | } 97 | 98 | for (i in 1:10) 99 | {xx1(); xx2(); xx3()} 100 | 101 | 102 | 103 | f <- pir.compile(rir.compile(function(a,b,c) a)) 104 | g <- rir.compile(function() { 105 | f(1) 106 | f(1,2) 107 | f(1,2,3) 108 | }) 109 | 110 | stopifnot(g()==1) 111 | pir.compile(g) 112 | stopifnot(g()==1) 113 | 114 | -------------------------------------------------------------------------------- /rir/tests/pir_regression_regaloc.r: -------------------------------------------------------------------------------- 1 | f <- function() { 2 | if ("") 3 | x <- 1 4 | else 5 | x <- 2 6 | 7 | if ("") 8 | y <- 3 9 | else 10 | y <- 5 11 | 12 | while("") { 13 | x && y 14 | x <- 10 15 | } 16 | } 17 | pir.compile(rir.compile(f)) 18 | -------------------------------------------------------------------------------- /rir/tests/pir_regression_splines.R: -------------------------------------------------------------------------------- 1 | if (Sys.getenv("LSAN_OPTIONS") != "") 2 | q() 3 | 4 | options(continue=" ", width=60) 5 | options(SweaveHooks=list(fig=function() par(mar=c(4.1, 4.1, .3, 1.1)))) 6 | pdf.options(pointsize=8) #text in graph about the same as regular text 7 | options(contrasts=c("contr.treatment", "contr.poly")) #reset default 8 | require(survival) 9 | mfit <- coxph(Surv(futime, death) ~ sex + pspline(age, df=4), data=mgus) 10 | mfit 11 | termplot(mfit, term=2, se=TRUE, col.term=1, col.se=1) 12 | ptemp <- termplot(mfit, se=TRUE, plot=FALSE) 13 | attributes(ptemp) 14 | ptemp$age[1:4,] 15 | ageterm <- ptemp$age # this will be a data frame 16 | center <- with(ageterm, y[x==50]) 17 | ytemp <- ageterm$y + outer(ageterm$se, c(0, -1.96, 1.96), '*') 18 | matplot(ageterm$x, exp(ytemp - center), log='y', 19 | type='l', lty=c(1,2,2), col=1, 20 | xlab="Age at diagnosis", ylab="Relative death rate") 21 | fit <- coxph(Surv(futime, death) ~ age + pspline(hgb, 4), mgus2) 22 | fit 23 | termplot(fit, se=TRUE, term=2, col.term=1, col.se=1, 24 | xlab="Hemoglobin level") 25 | termplot(fit, se=TRUE, col.term=1, col.se=1, term=2, 26 | xlab="Hemoglobin level", ylim=c(-.4, 1.3)) 27 | df <- c(3, 2.5, 2) 28 | for (i in 1:3) { 29 | tfit <- coxph(Surv(futime, death) ~ age + 30 | pspline(hgb, df[i], nterm=8), mgus2) 31 | temp <- termplot(tfit, se=FALSE, plot=FALSE, term=2) 32 | lines(temp$hgb$x, temp$hgb$y, col=i+1, lwd=2) 33 | } 34 | -------------------------------------------------------------------------------- /rir/tests/pir_scope_delay_env_regression.r: -------------------------------------------------------------------------------- 1 | # In this regression the diagonal function was primed with 2 | # the first else branch being dead. Then we compile with 3 | # the assumption that n is not missing, which will kill 4 | # the then branch. 5 | # this leads to a function that directly deoptimizes (which 6 | # is intended to pick up typefeedback). But scope analysis 7 | # environment delay optimization would create an environment 8 | # with a fudged missing tag on the binding, since it did not 9 | # consider the difference between stvar and starg (the later 10 | # preserves missing flag. 11 | 12 | Diagonal = function (n, x = NULL) 13 | { 14 | n <- if (missing(n)) 15 | length(x) 16 | else { 17 | stopifnot(length(n) == 1, n == as.integer(n), n >= 0) 18 | as.integer(n) 19 | } 20 | if (missing(x)) 21 | c(1,2,3) 22 | else { 23 | lx <- length(x) 24 | lx.1 <- lx == 1L 25 | stopifnot(lx.1 || lx == n) 26 | if (is.logical(x)) 27 | cl <- "ldiMatrix" 28 | else if (is.numeric(x)) { 29 | cl <- "ddiMatrix" 30 | x <- as.numeric(x) 31 | } 32 | else if (is.complex(x)) { 33 | cl <- "zdiMatrix" 34 | } 35 | else stop("'x' has invalid data type") 36 | if (lx.1 && !is.na(x) && x == 1) 37 | new(cl, Dim = c(n, n), diag = "U") 38 | else new(cl, Dim = c(n, n), diag = "N", x = if (lx.1) 39 | rep.int(x, n) 40 | else x) 41 | } 42 | } 43 | 44 | t <- function() { 45 | Diagonal() 46 | Diagonal() 47 | Diagonal(1) 48 | } 49 | 50 | pir.compile(rir.compile(t)) 51 | t() 52 | -------------------------------------------------------------------------------- /rir/tests/pir_tests.R: -------------------------------------------------------------------------------- 1 | .Call("pirTests") 2 | -------------------------------------------------------------------------------- /rir/tests/pir_tests_regression.R: -------------------------------------------------------------------------------- 1 | test <- function(x, tests) { 2 | t1 <- rir.compile(x) 3 | t2 <- pir.compile(t1) 4 | for (t in tests) 5 | stopifnot(t1(t) == t2(t)) 6 | } 7 | 8 | test(function(x) { 9 | s <- 0 10 | for (i in x) 11 | s <- s+i 12 | s 13 | }, c(1:10)) 14 | 15 | test(function(x) { 16 | s <- "" 17 | for (i in 1:x) 18 | s <- cat(i, " ", s) 19 | s 20 | }, c(1, 0, 100)) 21 | -------------------------------------------------------------------------------- /rir/tests/pir_value_profiler_tests.r: -------------------------------------------------------------------------------- 1 | if (Sys.getenv("PIR_ENABLE_PROFILER") != "1") { 2 | print("test only works with profiler enabled") 3 | q() 4 | } 5 | 6 | f = function() a+a+a+a+a+1L 7 | rir.compile(f) 8 | a = 1 9 | f() 10 | a = 1L 11 | f() 12 | rir.disassemble(f) 13 | rir.markFunction(f, Reopt=TRUE) 14 | f() 15 | rir.disassemble(f) 16 | for (i in 1:1000000) 17 | f() 18 | rir.disassemble(f) 19 | 20 | # assert f was reoptimized, ie. we expect to see not all of the 21 | # invocations counted, since the optimized code object was replaced 22 | stopifnot(sum(rir.functionInvocations(f)) < 1000000) 23 | -------------------------------------------------------------------------------- /rir/tests/reg-tests-1c.R: -------------------------------------------------------------------------------- 1 | ## merge.dendrogram(), PR#15648 2 | mkDend <- function(n, lab, method = "complete", 3 | ## gives *ties* often: 4 | rGen = function(n) 1+round(16*abs(rnorm(n)))) { 5 | stopifnot(is.numeric(n), length(n) == 1, n >= 1, is.character(lab)) 6 | a <- matrix(rGen(n*n), n, n) 7 | colnames(a) <- rownames(a) <- paste0(lab, 1:n) 8 | .HC. <<- hclust(as.dist(a + t(a)), method=method) 9 | as.dendrogram(.HC.) 10 | } 11 | 12 | ## recursive dendrogram methods and deeply nested dendrograms 13 | op <- options(expressions = 999)# , verbose = 2) # -> max. depth= 961 14 | set.seed(11); d <- mkDend(1500, "A", method="single") 15 | rd <- reorder(d, nobs(d):1) 16 | ## Error: evaluation nested too deeply: infinite recursion .. in R <= 3.2.3 17 | stopifnot(is.leaf(r1 <- rd[[1]]), is.leaf(r2 <- rd[[2:1]]), 18 | attr(r1, "label") == "A1458", attr(r2, "label") == "A1317") 19 | options(op)# revert 20 | 21 | ## recursive dendrogram methods and deeply nested dendrograms 22 | op <- options(expressions = 999)# , verbose = 2) # -> max. depth= 961 23 | set.seed(11); d <- mkDend(1500, "A", method="single") 24 | print(d[[1]]) 25 | rd <- reorder(d, nobs(d):1) 26 | print(rd[[1]]) 27 | ## Error: evaluation nested too deeply: infinite recursion .. in R <= 3.2.3 28 | stopifnot(is.leaf(r1 <- rd[[1]]), is.leaf(r2 <- rd[[2:1]]), 29 | attr(r1, "label") == "A1458", attr(r2, "label") == "A1317") 30 | options(op)# revert 31 | 32 | ## recursive dendrogram methods and deeply nested dendrograms 33 | op <- options(expressions = 999)# , verbose = 2) # -> max. depth= 961 34 | set.seed(11); d <- mkDend(1500, "A", method="single") 35 | print(d[[1]]) 36 | rd <- reorder(d, nobs(d):1) 37 | print(rd[[1]]) 38 | ## Error: evaluation nested too deeply: infinite recursion .. in R <= 3.2.3 39 | stopifnot(is.leaf(r1 <- rd[[1]]), is.leaf(r2 <- rd[[2:1]]), 40 | attr(r1, "label") == "A1458", attr(r2, "label") == "A1317") 41 | options(op)# revert 42 | 43 | ## recursive dendrogram methods and deeply nested dendrograms 44 | op <- options(expressions = 999)# , verbose = 2) # -> max. depth= 961 45 | set.seed(11); d <- mkDend(1500, "A", method="single") 46 | print(d[[1]]) 47 | rd <- reorder(d, nobs(d):1) 48 | print(rd[[1]]) 49 | ## Error: evaluation nested too deeply: infinite recursion .. in R <= 3.2.3 50 | stopifnot(is.leaf(r1 <- rd[[1]]), is.leaf(r2 <- rd[[2:1]]), 51 | attr(r1, "label") == "A1458", attr(r2, "label") == "A1317") 52 | options(op)# revert 53 | -------------------------------------------------------------------------------- /rir/tests/regression_bounce.r: -------------------------------------------------------------------------------- 1 | execute <- function () { 2 | seed <- NaN 3 | 4 | resetSeed <- function() seed <<- 74755 5 | 6 | nextRandom <- function() { 7 | seed <<- bitwAnd((seed * 1309) + 13849, 65535) 8 | return (seed) 9 | } 10 | 11 | ballCount <- 100 12 | bounces <- 0 13 | balls = vector("list", length = ballCount) 14 | resetSeed() 15 | 16 | for (i in 1:ballCount) { 17 | random1 <- nextRandom() 18 | random2 <- nextRandom() 19 | random3 <- nextRandom() 20 | random4 <- nextRandom() 21 | balls[[i]] = c(random1 %% 500, random2 %% 500, 22 | (random3 %% 300) - 150, (random4 %% 300) - 150) 23 | } 24 | 25 | ball <- function(ball) { 26 | results <- bounce(ball) 27 | if (results[[2]]) bounces <<- bounces + 1 28 | return (results[[1]]) 29 | } 30 | 31 | for (i in 1:50) { 32 | balls <- lapply(balls, ball) 33 | } 34 | 35 | return (bounces) 36 | } 37 | 38 | verifyResult <- function(result) { 39 | print (result) 40 | return (result == 1331); 41 | } 42 | 43 | bounce <- function(ball) { 44 | xLimit <- 500 45 | yLimit <- 500 46 | bounced <- FALSE 47 | 48 | ball[1] <- ball[1] + ball[3]; 49 | ball[2] <- ball[2] + ball[4]; 50 | 51 | if (ball[1] > xLimit) { 52 | ball[1] <- xLimit 53 | ball[3] <- 0 - abs(ball[3]) 54 | bounced <- TRUE 55 | } 56 | if (ball[1] < 0) { 57 | ball[1] <- 0 58 | ball[3] <- abs(ball[3]) 59 | bounced <- TRUE 60 | } 61 | if (ball[2] > yLimit) { 62 | ball[2] <- yLimit 63 | ball[4] <- 0 - abs(ball[4]) 64 | bounced <- TRUE 65 | } 66 | if (ball[2] < 0) { 67 | ball[2] <- 0 68 | ball[4] <- abs(ball[4]) 69 | bounced <- TRUE 70 | } 71 | return (list(ball, bounced)) 72 | } 73 | 74 | for (i in 1:4) { 75 | r=execute() 76 | stopifnot(verifyResult(r)) 77 | } 78 | -------------------------------------------------------------------------------- /rir/tests/regression_ellipsis_builtins.r: -------------------------------------------------------------------------------- 1 | pkgname <- "stats" 2 | source(file.path(R.home("share"), "R", "examples-header.R")) 3 | acf(lh) 4 | acf(lh) 5 | example(glm, echo = FALSE) 6 | example(glm, echo = FALSE) 7 | -------------------------------------------------------------------------------- /rir/tests/regression_interprocedural_scope.r: -------------------------------------------------------------------------------- 1 | a <- function(b, c = nchar(b)) 2 | 3 | utils:::.win32consoleCompletion(b, c) 4 | 5 | a("") 6 | a("") 7 | a("data(") 8 | a("") 9 | -------------------------------------------------------------------------------- /rir/tests/regression_native_matrix.r: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # ------------------------------------------------------------------ 7 | 8 | spectralnorm_alt_4 <- function(args) { 9 | n = if (length(args)) as.integer(args[[1]]) else 100L 10 | options(digits=10) 11 | 12 | eval_A <- function(i, j) 13 | return(if (eval_A_cache[[i, j]] != 0) eval_A_cache[[i, j]] else 14 | eval_A_cache[[i, j]] <<- 1 / ((i + j - 2) * (i + j - 1) / 2 + i)) 15 | eval_A_times_u <- function(u) { 16 | # eval_A_mat <- outer(seq(n), seq(n), FUN=eval_A) 17 | eval_A_mat <- matrix(0, n, n) 18 | for (i in 1:n) 19 | for (j in 1:n) 20 | eval_A_mat[[i, j]] <- eval_A(i, j) 21 | return(u %*% eval_A_mat) 22 | } 23 | eval_At_times_u <- function(u) { 24 | # eval_A_mat <- t(outer(seq(n), seq(n), FUN=eval_A)) 25 | eval_A_mat <- matrix(0, n, n) 26 | for (i in 1:n) 27 | for (j in 1:n) 28 | eval_A_mat[[i, j]] <- eval_A(i, j) 29 | return(u %*% t(eval_A_mat)) 30 | } 31 | eval_AtA_times_u <- function(u) 32 | eval_At_times_u(eval_A_times_u(u)) 33 | 34 | eval_A_cache <- matrix(0, n, n) 35 | u <- rep(1, n) 36 | v <- rep(0, n) 37 | for (itr in seq(10)) { 38 | v <- eval_AtA_times_u(u) 39 | u <- eval_AtA_times_u(v) 40 | } 41 | 42 | sqrt(sum(u * v) / sum(v * v)) 43 | } 44 | 45 | execute <- function(n) { 46 | spectralnorm_alt_4(n) 47 | } 48 | 49 | stopifnot(execute(10) - 1.274219866 < 0.00000001) 50 | stopifnot(execute(10) - 1.274219866 < 0.00000001) 51 | stopifnot(execute(10) - 1.274219866 < 0.00000001) 52 | -------------------------------------------------------------------------------- /rir/tests/regression_reg-packages.R: -------------------------------------------------------------------------------- 1 | unlockBinding(".make_numeric_version", .BaseNamespaceEnv) 2 | .BaseNamespaceEnv$.make_numeric_version <- 3 | function(x, strict = TRUE, regexp, classes = NULL) 4 | { 5 | ## Internal creator for numeric version objects. 6 | 7 | nms <- names(x) 8 | x <- as.character(x) 9 | y <- rep.int(list(integer()), length(x)) 10 | valid_numeric_version_regexp <- sprintf("^%s$", regexp) 11 | if(length(x)) { 12 | ok <- grepl(valid_numeric_version_regexp, x) 13 | if(!all(ok) && strict) 14 | stop(gettextf("invalid version specification %s", 15 | paste(sQuote(unique(x[!ok])), collapse = ", ")), 16 | call. = FALSE, domain = NA) 17 | y[ok] <- lapply(strsplit(x[ok], "[.-]"), as.integer) 18 | } 19 | names(y) <- nms 20 | class(y) <- unique(c(classes, "numeric_version")) 21 | y 22 | } 23 | 24 | 25 | 26 | test3 <- function() { 27 | library(tools) 28 | detach("package:tools") 29 | } 30 | 31 | test3() 32 | test3() 33 | test3() 34 | test3() 35 | test3() 36 | -------------------------------------------------------------------------------- /rir/tests/regression_stats.R: -------------------------------------------------------------------------------- 1 | a <- b <- 0 2 | plot(a, b 3 | ) 4 | example(glm ) 5 | d <- c(1,3.8,4.4,5.1, 4,4.2,5, 2.6,5.3, 5.4) 6 | attributes(d) <- list(Size = 5) 7 | str(hclust(d )) 8 | dhc <- as.dendrogram(hclust(dist(USArrests) )) 9 | e <- dhc 10 | dendrapply(e, function(f) str(attributes(f))) 11 | df <- data.frame(id = 4, 12 | visit = I(c("","") )) 13 | reshape(df, timevar = "visit" , direction = "wide") 14 | -------------------------------------------------------------------------------- /rir/tests/regression_subassign.r: -------------------------------------------------------------------------------- 1 | f = function() { 2 | a = c(1,2,3,4) 3 | a[[1L]] = 4 4 | a 5 | } 6 | 7 | for (i in 1:5) 8 | stopifnot(f() == c(4,2,3,4)) 9 | 10 | 11 | 12 | f = function() { 13 | a = c(1L,2L,3L,4L) 14 | a[[1L]] = 4L 15 | a 16 | } 17 | 18 | for (i in 1:5) 19 | stopifnot(f() == c(4L,2L,3L,4L)) 20 | 21 | 22 | f = function() { 23 | a = c(1L,2L,3L,4L) 24 | a[[1L]] = 4 25 | a 26 | } 27 | 28 | for (i in 1:5) 29 | stopifnot(f() == c(4,2,3,4)) 30 | 31 | 32 | f = function() { 33 | a = c(1,2,3,4) 34 | a[[1.999]] = 4 35 | a 36 | } 37 | 38 | for (i in 1:5) 39 | stopifnot(f() == c(4,2,3,4)) 40 | 41 | 42 | f = function() { 43 | a = 1 44 | a[[1L]] = 4 45 | a 46 | } 47 | 48 | for (i in 1:5) 49 | stopifnot(f() == 4) 50 | 51 | 52 | 53 | f = function() { 54 | a = 1L 55 | a[[1L]] = 4L 56 | a 57 | } 58 | 59 | for (i in 1:5) 60 | stopifnot(f() == 4L) 61 | 62 | 63 | 64 | f = function() { 65 | a = 1 66 | a[[1L]] = 4L 67 | a 68 | } 69 | 70 | for (i in 1:5) 71 | stopifnot(f() == 4L) 72 | 73 | 74 | 75 | f = function() { 76 | a = 1L 77 | a[[1L]] = 4 78 | a 79 | } 80 | 81 | for (i in 1:5) 82 | stopifnot(f() == 4) 83 | 84 | 85 | f = function() { 86 | a = 1L 87 | a[[1L]] = TRUE 88 | a 89 | } 90 | 91 | for (i in 1:5) 92 | stopifnot(f() == TRUE) 93 | 94 | 95 | f = function() { 96 | a = TRUE 97 | a[[1L]] = 1L 98 | a 99 | } 100 | 101 | for (i in 1:5) 102 | stopifnot(f() == 1L) 103 | 104 | 105 | 106 | f = function() { 107 | a = TRUE 108 | a[[1L]] = 1 109 | a 110 | } 111 | 112 | for (i in 1:5) 113 | stopifnot(f() == 1) 114 | 115 | 116 | f = function() { 117 | a = 1L 118 | a[[1L]] = NA_real_ 119 | a 120 | } 121 | 122 | for (i in 1:5) 123 | stopifnot(is.na(f())) 124 | 125 | f = function() { 126 | a = c(1,2,3,4) 127 | a[[1L]] = NA_integer_ 128 | a 129 | } 130 | 131 | for (i in 1:5) 132 | stopifnot(is.na(f()[[1]])) 133 | 134 | 135 | -------------------------------------------------------------------------------- /rir/tests/rir_basics.R: -------------------------------------------------------------------------------- 1 | a <<- 3 2 | b <<- 10 3 | g <<- function(a, b) a + b 4 | f <<- function(x) g(10, 78) 5 | fc <<- rir.compile(f) 6 | stopifnot(fc(1) == 88) 7 | 8 | f <- function(n) if (n < 2) 1 else fc(n-1) + fc(n-2) 9 | fc <- rir.compile(f) 10 | x <- 3 11 | fc(x) 12 | fc(x) 13 | fc(x) 14 | fc(x) 15 | rir.disassemble(fc) 16 | stopifnot(fc(n=4) == 5) 17 | 18 | f <- rir.compile(function(a, b, c, x, d=44) c(d, c, b, a)) 19 | print(f(1,2,3)) 20 | stopifnot(f(1,2,3) == c(44,3,2,1)) 21 | stopifnot(f(1,2,3,4) == c(44,3,2,1)) 22 | stopifnot(f(d=1,2,3,4) == c(1,4,3,2)) 23 | 24 | f <- rir.compile(function(x) +x) 25 | stopifnot(f(10L) == 10L) 26 | stopifnot(f(-3.14) == -3.14) 27 | stopifnot(f(-1:3) == c(-1, 0, 1, 2, 3)) 28 | stopifnot(f(0) == 0) 29 | stopifnot(is.na(f(NA))) 30 | 31 | f <- rir.compile(function(x) -x) 32 | stopifnot(f(10L) == -10L) 33 | stopifnot(f(-3.14) == 3.14) 34 | stopifnot(f(-1:3) == c(1, 0, -1, -2, -3)) 35 | stopifnot(f(0) == 0) 36 | stopifnot(is.na(f(NA))) 37 | -------------------------------------------------------------------------------- /rir/tests/rir_default.R: -------------------------------------------------------------------------------- 1 | f <- rir.compile(function(a=2) a) 2 | stopifnot(f() == 2) 3 | 4 | f <- rir.compile(function(a, b=a+2) b) 5 | stopifnot(f(3) == 5) 6 | 7 | g <- rir.compile(function(a, b=1) a+b) 8 | f <- rir.compile(function(b = 123) g(b)) 9 | stopifnot(f() == 124) 10 | 11 | f <- rir.compile(function(b = 123) typeof(b)) 12 | stopifnot(f() == "double") 13 | 14 | f <- rir.compile(function(b = 123) cat(b)) 15 | stopifnot(f() == "123") 16 | rir.compile(function() { 17 | stopifnot(f() == "123") 18 | })() 19 | 20 | 21 | f <- rir.compile(function(a = 1, b = 2) c(a, b)) 22 | stopifnot(f() == c(1,2)) 23 | stopifnot(f(2) == c(2,2)) 24 | stopifnot(f(,1) == c(1,1)) 25 | rir.compile(function() { 26 | stopifnot(f() == c(1,2)) 27 | stopifnot(f(2) == c(2,2)) 28 | stopifnot(f(,1) == c(1,1)) 29 | })() 30 | 31 | 32 | f <- function(a=1,b=2,c=3) c(a,b,c,missing(a), missing(b), missing(c), nargs()) 33 | g <- function(a=1) c(missing(a), nargs(), a) 34 | h <- function(a) g(a) 35 | 36 | test <- function() { 37 | stopifnot(f() == c(1,2,3,TRUE,TRUE,TRUE,0)) 38 | stopifnot(f(2) == c(2,2,3,FALSE,TRUE,TRUE,1)) 39 | stopifnot(f(,3) == c(1,3,3,TRUE,FALSE,TRUE,2)) 40 | stopifnot(f(,) == c(1,2,3,TRUE,TRUE,TRUE,2)) 41 | stopifnot(f(b=1) == c(1,1,3,TRUE,FALSE,TRUE,1)) 42 | stopifnot(g() == c(TRUE,0,1)) 43 | stopifnot(g(2) == c(FALSE,1,2)) 44 | stopifnot(h(2) == c(FALSE,1,2)) 45 | ok <- 0 46 | tryCatch(h(), error=function(e) {ok <<- 1}) 47 | stopifnot(ok == 1) 48 | } 49 | 50 | test() 51 | for (i in 1:10) 52 | test() 53 | 54 | 55 | f <- function(a = 1, b = 2) nargs() 56 | test <- function() f(b = 1) 57 | 58 | test() 59 | for (i in 1:10) 60 | stopifnot(test() == 1) 61 | -------------------------------------------------------------------------------- /rir/tests/rir_deopt.R: -------------------------------------------------------------------------------- 1 | # === modify env 2 | 3 | f <- rir.compile( 4 | function(a) { 5 | localVar <- "local" 6 | a() 7 | localVar 8 | }) 9 | rir.disassemble(f) 10 | 11 | rir.compile(function() 12 | for (i in 1:400) f(function()1) 13 | )() 14 | rir.disassemble(f) 15 | 16 | localVar <- 42 17 | stopifnot(42 == f(function() rm("localVar", envir=sys.frame(-1)))) 18 | 19 | ## === leak env 20 | 21 | f <- rir.compile( 22 | function(a, b) { 23 | localVar <- "local" 24 | a() 25 | b 26 | localVar 27 | }) 28 | rir.disassemble(f) 29 | 30 | f(function()1, 2) 31 | rir.disassemble(f) 32 | 33 | rir.compile(function() 34 | for (i in 1:400) f(function()1, 2) 35 | )() 36 | rir.disassemble(f) 37 | 38 | stopifnot(42 == f(function() leak <<- sys.frame(-1), assign("localVar", 42, leak))) 39 | rir.disassemble(f) 40 | 41 | 42 | { 43 | f <- function(x,y) x-y 44 | g <- rir.compile(function() f(44,2)); 45 | h <- function() g(); 46 | h(); 47 | rir.markFunction(g, Reopt=TRUE); 48 | h(); 49 | stopifnot(h() == 42); 50 | rir.disassemble(g); 51 | h(); 52 | f <- function(x,y) y-x; 53 | stopifnot(h() == -42); 54 | h() 55 | } 56 | -------------------------------------------------------------------------------- /rir/tests/rir_dotdotdot.R: -------------------------------------------------------------------------------- 1 | f <- rir.compile(function(...) ..1) 2 | stopifnot(f(1,2,3) == 1) 3 | 4 | f <- rir.compile(function(a,b,c,d) c(a,b,c,d)) 5 | g <- rir.compile(function(a, ..., b) f(..., a, b)) 6 | h <- rir.compile(function() g(b=4, 1,2,3)) 7 | stopifnot(h() == c(2,3,1,4)) 8 | -------------------------------------------------------------------------------- /rir/tests/rir_guard_env.R: -------------------------------------------------------------------------------- 1 | loc <- 42 2 | f <- rir.compile(function(x) { 3 | loc <- 1 4 | delayedAssign("x", rm("loc")) 5 | x 6 | loc 7 | }) 8 | 9 | tramp <- rir.compile(function(fun) fun()) 10 | 11 | rir.markFunction(f, Reopt=TRUE) 12 | stopifnot(tramp(f) == 42) 13 | -------------------------------------------------------------------------------- /rir/tests/rir_index.R: -------------------------------------------------------------------------------- 1 | 2 | # [[ 3 | 4 | l = c(33L, 33.2, "asdf", c(123), c(1, 1L, "asdF"), 'd', NULL, list(1,2,3), TRUE, c(FALSE, TRUE)) 5 | 6 | f <- rir.compile(function(a, b) a[[b]]) 7 | for (v in l) { 8 | stopifnot(f(v, 1) == v[[1]]) 9 | stopifnot(f(v, 1L) == v[[1]]) 10 | stopifnot(f(v, 1.1) == v[[1]]) 11 | stopifnot(f(v, TRUE) == v[[1]]) 12 | for (i in 1:length(v)) 13 | stopifnot(f(v, i) == v[[i]]) 14 | } 15 | 16 | `[[.foo` <- function(...) 33 17 | o <- 1 18 | class(o) <- "foo" 19 | stopifnot(f(o, 1234) == 33) 20 | 21 | setClass("Bar", representation(a = "numeric")) 22 | setMethod("[[", signature(x="Bar"), function(x, i) 333) 23 | o <- new("Bar", a=1) 24 | stopifnot(f(o, 1234) == 333) 25 | stopifnot(f(o, 1234) == 333) 26 | 27 | f3 <- rir.compile(function() { 28 | a <- c(1,2) 29 | a[[i=2]] 30 | }) 31 | stopifnot(f3() == 2) 32 | 33 | `[[.foo` <- function(o, i) o 34 | o <- 1 35 | class(o) <- "foo" 36 | f2 <- rir.compile(function(a, b) { 37 | (a <- a + 1)[[b]]; 38 | stopifnot(a == 2); 39 | }) 40 | f2(o, 1) 41 | 42 | o <- 1 43 | class(o) <- "foo2" 44 | f2 <- rir.compile(function(a, b) { 45 | (a <- a + 1)[[b]]; 46 | stopifnot(a == 2); 47 | }) 48 | f2(o, 1) 49 | 50 | o <- 1 51 | class(o) <- "foo" 52 | f2 <- rir.compile(function(a) { 53 | a[[stop("should not be evaled")]]; 54 | }) 55 | f2(o) 56 | 57 | o <- 123 58 | class(o) <- "Bar" 59 | stopifnot(f(o, 1) == 123) 60 | 61 | stopifnot(f(NULL,1) == NULL) 62 | stopifnot(f(NULL,13) == NULL) 63 | stopifnot(rir.compile(function() NULL[[1]])() == NULL) 64 | stopifnot(rir.compile(function() NULL[[12]])() == NULL) 65 | -------------------------------------------------------------------------------- /rir/tests/rir_inline.R: -------------------------------------------------------------------------------- 1 | 2 | f <- rir.compile(function(a=1) a) 3 | g <- rir.compile(function() f(2)) 4 | h <- rir.compile(function() f()) 5 | 6 | l1 <- rir.compile(function() for (i in 1:10000) g()) 7 | l2 <- rir.compile(function() for (i in 1:10000) h()) 8 | 9 | l1() 10 | l2() 11 | 12 | rir.disassemble(h) 13 | -------------------------------------------------------------------------------- /rir/tests/rir_lapply.R: -------------------------------------------------------------------------------- 1 | rref <- bibentry( 2 | bibtype = "Manual", 3 | title = "R: A Language and Environment for Statistical Computing", 4 | author = person("R Core Team"), 5 | organization = "R Foundation for Statistical Computing", 6 | address = "Vienna, Austria", 7 | year = 2014, 8 | url = "http://www.R-project.org/") 9 | compiler:::enableJIT(2) 10 | (function() print(rref, style = "Bibtex"))() 11 | compiler:::enableJIT(0) 12 | 13 | 14 | a = bquote(a == a) 15 | b = bquote(function(a=1)1) 16 | c = bquote(function(a)1) 17 | stopifnot(identical(rir.compile(function() bquote(a == a))(), a)) 18 | stopifnot(identical(rir.compile(function() bquote(function(a=1)1))(), b)) 19 | stopifnot(identical(rir.compile(function() bquote(function(a)1))(), c)) 20 | -------------------------------------------------------------------------------- /rir/tests/rir_lgl.R: -------------------------------------------------------------------------------- 1 | f <- rir.compile(function() { 2 | a1 <- TRUE && TRUE 3 | stopifnot(a1 == TRUE) 4 | a2 <- TRUE && FALSE 5 | stopifnot(a2 == FALSE) 6 | a3 <- TRUE && NA 7 | stopifnot(is.na(a3)) 8 | a4 <- FALSE && TRUE 9 | stopifnot(a4 == FALSE) 10 | a5 <- FALSE && FALSE 11 | stopifnot(a5 == FALSE) 12 | a6 <- FALSE && NA 13 | stopifnot(a6 == FALSE) 14 | a7 <- NA && TRUE 15 | stopifnot(is.na(a7)) 16 | a8 <- NA && FALSE 17 | stopifnot(a8 == FALSE) 18 | a9 <- NA && NA 19 | stopifnot(is.na(a9)) 20 | a10 <- TRUE || TRUE 21 | stopifnot(a10 == TRUE) 22 | a11 <- TRUE || FALSE 23 | stopifnot(a11 == TRUE) 24 | a12 <- TRUE || NA 25 | stopifnot(a12 == TRUE) 26 | a13 <- FALSE || TRUE 27 | stopifnot(a13 == TRUE) 28 | a14 <- FALSE || FALSE 29 | stopifnot(a14 == FALSE) 30 | a15 <- FALSE || NA 31 | stopifnot(is.na(a15)) 32 | a16 <- NA || TRUE 33 | stopifnot(a16 == TRUE) 34 | a17 <- NA || FALSE 35 | stopifnot(is.na(a17)) 36 | a18 <- NA || NA 37 | stopifnot(is.na(a18)) 38 | a19 <- !TRUE 39 | stopifnot(a19 == FALSE) 40 | a20 <- !FALSE 41 | stopifnot(a20 == TRUE) 42 | a21 <- !NA 43 | stopifnot(is.na(a21)) 44 | a22 <- !((1:5 %% 2) == 0) 45 | stopifnot(a22 == c(TRUE, FALSE, TRUE, FALSE, TRUE)) 46 | 47 | fail <- function(expr) { 48 | msg <- "argument has the wrong type for && or ||" 49 | tryCatch(expr, error=function(e) { stopifnot(e[1] == msg) }) 50 | } 51 | fail("foo" || -42) 52 | fail(c("one", "two") || 1) 53 | fail(42 && "") 54 | fail(TRUE && "bad") 55 | 56 | # short circuit could prevent error from occurring 57 | a23 <- TRUE || "bad" 58 | stopifnot(a23 == TRUE) 59 | a24 <- FALSE && c("one", "two") 60 | stopifnot(a24 == FALSE) 61 | }) 62 | 63 | f() 64 | -------------------------------------------------------------------------------- /rir/tests/rir_regression.R: -------------------------------------------------------------------------------- 1 | f1 <- rir.compile(function() { 2 | a <- 1 3 | class(a) <- "asdf" 4 | b <- a 5 | class(b) <- NULL 6 | class(a) 7 | }) 8 | 9 | stopifnot(f1() == "asdf") 10 | 11 | f <- rir.compile(function() { 12 | b0 <- gl(3,4, labels=letters[1:3]) 13 | bf <- setNames(b0, paste0("o", seq_along(b0))) 14 | df <- data.frame(a = 1, B = b0, f = gl(4,3)) 15 | }) 16 | f() 17 | 18 | f <- rir.compile(function() { 19 | a <- list( 1 ); b <- (a[[1]] <- a); stopifnot(identical(b, list( 1 ))) 20 | a <- list(x=1); b <- ( a$x <- a); stopifnot(identical(b, list(x=1))) 21 | }) 22 | 23 | rir.disassemble(f) 24 | f() 25 | 26 | f <- rir.compile(function() { 27 | x <- seq(0, 4, length.out = 501) 28 | }) 29 | f() 30 | 31 | 32 | f <- rir.compile(function() { 33 | sessionInfo() 34 | }) 35 | f() 36 | 37 | elem_max <- 2 38 | 39 | f <- rir.compile( 40 | function (x) 41 | { 42 | x_len <- length(x) 43 | if (x_len == 1L) 44 | return(x%/%2L) 45 | borrow <- (x[[1]] == 1) 46 | x_start <- borrow + 1L 47 | x_end <- x_len 48 | result_index <- 1L 49 | result <- integer(x_end - x_start + 1L) 50 | for (x_index in x_start:x_end) { 51 | d = x[[x_index]] + elem_max * borrow 52 | result[[result_index]] <- d%/%2 53 | borrow <- d%%2 54 | result_index <- result_index + 1L 55 | } 56 | return(result) 57 | }) 58 | for (i in 1:5000) f(c(1,2,3)) 59 | 60 | (rir.compile(function(a) {a;a}))(1) 61 | -------------------------------------------------------------------------------- /rir/tests/rir_relop.R: -------------------------------------------------------------------------------- 1 | f <- rir.compile(function() { 2 | stopifnot(1+2 == 3); 3 | a <- 22; 4 | b <- 44; 5 | stopifnot(a+b == 66); 6 | stopifnot(-1:3 == c(-1, 0, 1, 2, 3)); 7 | stopifnot((c(1,2,3) < c(3,2,1)) == c(TRUE, FALSE, FALSE)); 8 | 9 | stopifnot((c(1,2,3) <= c(3,2,1)) == c(TRUE, TRUE, FALSE)); 10 | stopifnot((c(1,2,3) > c(3,2,1)) == c(FALSE, FALSE, TRUE)); 11 | stopifnot((c(1,2,3) >= c(3,2,1)) == c(FALSE, TRUE, TRUE)); 12 | stopifnot((c(1,2,3) == c(3,2,1)) == c(FALSE, TRUE, FALSE)); 13 | stopifnot((c(1,2,3) != c(3,2,1)) == c(TRUE, FALSE, TRUE)); 14 | }) 15 | f() 16 | -------------------------------------------------------------------------------- /rir/tests/rir_switch.R: -------------------------------------------------------------------------------- 1 | # helpers for testing error/warning 2 | checkError <- function(expr, msg) { 3 | caught <- FALSE 4 | env <- environment() 5 | tryCatch(expr, error=function(e) { assign("caught", TRUE, envir=env); stopifnot(msg == e[1]) }) 6 | stopifnot(caught) 7 | } 8 | checkWarning <- function(expr, msg) { 9 | caught <- FALSE 10 | env <- environment() 11 | tryCatch(expr, warning=function(e) { assign("caught", TRUE, envir=env); stopifnot(msg == e[1]) }) 12 | stopifnot(caught) 13 | } 14 | 15 | 16 | f1 <- rir.compile(function() { 17 | switch() 18 | }) 19 | checkError(f1(), "'EXPR' is missing") 20 | 21 | 22 | f2 <- rir.compile(function(x) { 23 | switch(x) 24 | }) 25 | checkWarning(f2(1), "'switch' with no alternatives") 26 | res <- f2(1) 27 | stopifnot(res == NULL) 28 | checkWarning(f2("one"), "'switch' with no alternatives") 29 | stopifnot(f2("one") == NULL) 30 | checkError(f2(NULL), "EXPR must be a length 1 vector") 31 | checkError(f2(c(1, 2)), "EXPR must be a length 1 vector") 32 | 33 | 34 | f3 <- rir.compile(function(x) { 35 | switch(x, a=, b=17, 42, "foo") 36 | }) 37 | checkError(f3(1), "empty alternative in numeric switch") 38 | checkError(f3("b"), "duplicate 'switch' defaults") 39 | checkError(f3(NULL), "EXPR must be a length 1 vector") 40 | checkError(f3(c(1, 2)), "EXPR must be a length 1 vector") 41 | stopifnot(f3(0) == NULL) 42 | stopifnot(f3(2) == 17) 43 | stopifnot(f3(3) == 42) 44 | stopifnot(f3(4) == "foo") 45 | stopifnot(f3(5) == NULL) 46 | 47 | 48 | f4 <- rir.compile(function(x) { 49 | switch(x, a=, b=17, 42, c=, d=, e=20) 50 | }) 51 | stopifnot(f4("a") == 17) 52 | stopifnot(f4("b") == 17) 53 | stopifnot(f4("c") == 20) 54 | stopifnot(f4("d") == 20) 55 | stopifnot(f4("e") == 20) 56 | stopifnot(f4("dft") == 42) 57 | 58 | 59 | f5 <- rir.compile(function(x) { 60 | switch(x, a=17, "42", b=c(1, 2)) 61 | }) 62 | stopifnot(f5(1) == 17) 63 | stopifnot(f5(1.2) == 17) 64 | stopifnot(f5(2) == "42") 65 | stopifnot(f5(3) == c(1, 2)) 66 | stopifnot(f5(3.002) == c(1, 2)) 67 | stopifnot(f5(42) == NULL) 68 | 69 | 70 | f6 <- rir.compile(function(x) { 71 | switch(x, a=17, 42) 72 | }) 73 | f7 <- rir.compile(function(x) { 74 | switch(x, "NA"=17, 42) 75 | }) 76 | stopifnot(f6(NA_character_) == 42) 77 | stopifnot(f7(NA_character_) == 17) 78 | -------------------------------------------------------------------------------- /rir/tests/rlang_missing.r: -------------------------------------------------------------------------------- 1 | # regression test for https://github.com/reactorlabs/rir/issues/998 2 | # see https://github.com/r-lib/rlang/blob/6dbcae3fc9af9e75b27053b28e7ae81e0717a387/R/arg.R 3 | # (is_missing in particular) 4 | 5 | is_reference <- function(x, y) { 6 | # .Call("rlang_is_reference", x, y) # tests pointer equality 7 | FALSE 8 | } 9 | is_missing <- function(x) missing(x) || is_reference(x, quote(expr = )) 10 | f <- function(x) is_missing(x) 11 | 12 | stopifnot(f()) 13 | stopifnot(f()) 14 | stopifnot(f()) 15 | stopifnot(f()) 16 | 17 | 18 | 19 | #' The missing argument is an object that triggers an error if and 20 | #' only if it is the result of evaluating a symbol. No error is 21 | #' produced when a function call evaluates to the missing argument 22 | #' object. For instance, it is possible to bind the missing argument 23 | #' to a variable with an expression like `x[[1]] <- missing_arg()`. 24 | #' Likewise, `x[[1]]` is safe to use as argument, e.g. `list(x[[1]])` 25 | #' even when the result is the missing object. 26 | #' However, as soon as the missing argument is passed down between 27 | #' functions through a bare variable, it is likely to cause a missing 28 | #' argument error. 29 | 30 | test <- function() { 31 | a <- quote(expr = ) 32 | b <- 3 33 | x <- list() 34 | x[[1]] <- quote(expr = ) 35 | miss <- NULL 36 | f <- function(x = quote(expr = )) { miss <<- missing(x); x } 37 | ok <- list() 38 | 39 | f() 40 | ok[[1]] <- miss 41 | 42 | f(quote(expr = )) 43 | ok[[2]] <- miss 44 | 45 | threw <- FALSE 46 | tryCatch(f(a), error = function(e) { threw <<- TRUE }) 47 | ok[[3]] <- miss 48 | ok[[4]] <- threw 49 | ## Error in print(x) : argument "a" is missing, with no default 50 | 51 | f(3) 52 | ok[[5]] <- miss 53 | 54 | f(b) 55 | ok[[6]] <- miss 56 | 57 | f(x[[1]]) 58 | ok[[7]] <- miss 59 | 60 | ok 61 | } 62 | for (i in 1:1000) test() 63 | stopifnot(test() == c(TRUE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE)) 64 | 65 | 66 | f <- function(x) 67 | missing(x) || identical(x, quote(expr = )) 68 | 69 | f(i) 70 | f() 71 | f(quote(expr = )) 72 | for (i in 1:1000) { 73 | f(i) 74 | f() 75 | f(quote(expr = )) 76 | } 77 | 78 | stopifnot(f(1) == FALSE) 79 | stopifnot(f() == TRUE) 80 | stopifnot(f(quote(expr = )) == TRUE) 81 | stopifnot((function(x) f(x))() == TRUE) 82 | -------------------------------------------------------------------------------- /rir/tests/runif-regression.R: -------------------------------------------------------------------------------- 1 | s = 42 2 | 3 | for(type in c("Wichmann-Hill", "Marsaglia-Multicarry", "Super-Duper", 4 | "Mersenne-Twister", 5 | "Knuth-TAOCP", "Knuth-TAOCP-2002")) 6 | { 7 | set.seed(123, type) 8 | print(RNGkind()) 9 | runif(100); print(runif(4)) 10 | s = s * runif(1) 11 | set.seed(1000, type) 12 | runif(100); print(runif(4)) 13 | s = s / runif(1) 14 | set.seed(77, type) 15 | runif(100); print(runif(4)) 16 | s = s / runif(1) 17 | } 18 | print(s) 19 | stopifnot(abs(s - 60127) < 0.1) 20 | -------------------------------------------------------------------------------- /rir/tests/sapply_repro.R: -------------------------------------------------------------------------------- 1 | a <- c( "", "", "", "formals(lm)[[2]]") 2 | b <- sapply(a, function(d) eval(parse(text = d))) 3 | print(b) 4 | t(sapply(b, function(d) c(typeof(d)))) 5 | 6 | cex3 <- c("NULL", "1", "1:1", "1i", "list(1)", "data.frame(x = 1)", 7 | "pairlist(pi)", "c", "lm", "formals(lm)[[1]]", "formals(lm)[[2]]", 8 | "y ~ x","expression((1))[[1]]", "(y ~ x)[[1]]", 9 | "expression(x <- pi)[[1]][[1]]") 10 | lex3 <- sapply(cex3, function(x) eval(parse(text = x))) 11 | mex3 <- t(sapply(lex3, 12 | function(x) c(typeof(x), storage.mode(x), mode(x)))) 13 | -------------------------------------------------------------------------------- /rir/tests/test_mark_function.r: -------------------------------------------------------------------------------- 1 | if (Sys.getenv("R_ENABLE_JIT") == 0 || Sys.getenv("PIR_ENABLE") == "force" || Sys.getenv("PIR_ENABLE") == "off" || Sys.getenv("RIR_SERIALIZE_CHAOS") == "1" || Sys.getenv("PIR_GLOBAL_SPECIALIZATION_LEVEL") != "") 2 | quit() 3 | 4 | add_noinline1 <- rir.compile(function(a,b) a+b) 5 | rir.markFunction(add_noinline1, DisableInline=TRUE) 6 | 7 | add_noinline2 <- rir.compile(function(a,b) a+b) 8 | rir.markFunction(add_noinline2, DisableInline=TRUE) 9 | 10 | add_forceinline <- rir.compile(function(a,b) a+b) 11 | rir.markFunction(add_forceinline, ForceInline=TRUE) 12 | 13 | add_nospecial <- rir.compile(function(a,b) a+b) 14 | rir.markFunction(add_nospecial, DisableInline=TRUE, DisableAllSpecialization=TRUE) 15 | 16 | f1 <- function() add_noinline1(1,2) 17 | f2 <- function() add_forceinline(1,2) 18 | f3 <- function(b) { 19 | add_nospecial(1,2L) 20 | add_nospecial(1,2.2) 21 | a=2 22 | add_nospecial(1L,a) 23 | add_nospecial(1L,b) 24 | } 25 | f4 <- function(b) { 26 | add_noinline2(1,2L) 27 | add_noinline2(1,2.2) 28 | a=2 29 | add_noinline2(1L,a) 30 | add_noinline2(1,b) 31 | } 32 | 33 | x=1L 34 | for (i in 1:1000) 35 | f1() 36 | for (i in 1:1000) 37 | f2() 38 | for (i in 1:1000) 39 | f3(x) 40 | for (i in 1:1000) 41 | f4(x) 42 | 43 | stopifnot(sum(rir.functionInvocations(add_noinline1)) == 1000) 44 | stopifnot(sum(rir.functionInvocations(add_nospecial)) > 100) 45 | stopifnot(sum(rir.functionInvocations(add_forceinline)) <= 800) 46 | stopifnot(length(rir.functionInvocations(add_nospecial)) == 2) 47 | stopifnot(length(rir.functionInvocations(add_noinline2)) >= 4) 48 | -------------------------------------------------------------------------------- /rir/tests/test_range.r: -------------------------------------------------------------------------------- 1 | a = c(1L, 2L) 2 | 3 | t1 = function() {i=0; a[i]} 4 | stopifnot(length(t1()) == 0) 5 | stopifnot(length(t1()) == 0) 6 | stopifnot(length(t1()) == 0) 7 | stopifnot(length(t1()) == 0) 8 | 9 | t1 = function (i) if (i > 0) a[i] 10 | 11 | stopifnot(is.null(t1(0))) 12 | stopifnot(t1(1) == 1L) 13 | stopifnot(is.null(t1(0))) 14 | stopifnot(t1(1) == 1L) 15 | stopifnot(is.null(t1(0))) 16 | stopifnot(t1(1) == 1L) 17 | 18 | t1 = function (i) if (i >= 0) a[i] 19 | 20 | stopifnot(length(t1(0)) == 0) 21 | stopifnot(t1(1) == 1L) 22 | stopifnot(length(t1(0)) == 0) 23 | stopifnot(t1(1) == 1L) 24 | stopifnot(length(t1(0)) == 0) 25 | stopifnot(t1(1) == 1L) 26 | 27 | 28 | t1 = function (i) if (i < 1) 1 else a[i] 29 | 30 | stopifnot(t1(1) == 1L) 31 | stopifnot(t1(0) == 1L) 32 | stopifnot(t1(1) == 1L) 33 | stopifnot(t1(0) == 1L) 34 | stopifnot(t1(1) == 1L) 35 | stopifnot(t1(0) == 1L) 36 | 37 | t1 = function (i) if (i < 0) 1 else a[i] 38 | 39 | stopifnot(t1(1) == 1L) 40 | stopifnot(length(t1(0)) == 0) 41 | stopifnot(t1(1) == 1L) 42 | stopifnot(length(t1(0)) == 0) 43 | stopifnot(t1(1) == 1L) 44 | stopifnot(length(t1(0)) == 0) 45 | 46 | t1 = function (i) if (i <= 0) 1 else a[i] 47 | 48 | stopifnot(t1(1) == 1L) 49 | stopifnot(t1(0) == 1L) 50 | stopifnot(t1(1) == 1L) 51 | stopifnot(t1(0) == 1L) 52 | stopifnot(t1(1) == 1L) 53 | stopifnot(t1(0) == 1L) 54 | -------------------------------------------------------------------------------- /rir/tests/type_annotations_usercontext.r: -------------------------------------------------------------------------------- 1 | f <- function(x) x + 1 2 | 3 | c <- .Call("rirCreateSimpleIntContext") 4 | rir.setUserContext(f, c) 5 | 6 | stopifnot(f(2L) == 3) # should run 7 | 8 | hasRaisedError <- FALSE 9 | tryCatch({ 10 | f(2) #should fail 11 | }, error = function(error_condition) { 12 | hasRaisedError <- TRUE 13 | }) 14 | stopifnot(!hasRaisedError) 15 | -------------------------------------------------------------------------------- /rir/tests/use_method_regression.r: -------------------------------------------------------------------------------- 1 | for(nm in c(1)) { 2 | y7 <- function(L) 1/8 + c(9:4, L) 3 | w1 <- lapply(c(1000, Inf), function(L) wilcox.test( y7(L) )) 4 | print(w1) 5 | stopifnot( 6 | identical(w1 [[1]], w1 [[2]]) # was FALSE .. 7 | ) 8 | } 9 | -------------------------------------------------------------------------------- /tools/.dropbox_uploader: -------------------------------------------------------------------------------- 1 | APPKEY=s8ws65eokk3tnx2 2 | APPSECRET=t3x19ds29fy0hrs 3 | ACCESS_LEVEL=sandbox 4 | OAUTH_ACCESS_TOKEN=2nc2np3in5pyp16n 5 | OAUTH_ACCESS_TOKEN_SECRET=6yhlkkoiftv2lf4 6 | -------------------------------------------------------------------------------- /tools/R: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | SCRIPTPATH=`cd $(dirname "$0") && pwd` 4 | 5 | if [ -z "$RIR_BUILD" ]; then 6 | RIR_BUILD=`pwd` 7 | fi 8 | 9 | R_HOME=`cat $RIR_BUILD/.R_HOME` 10 | CHK=$1 11 | 12 | PKG="$SCRIPTPATH/../rir/" 13 | 14 | export EXTRA_LOAD_SO="`ls $RIR_BUILD/librir.*`" 15 | export EXTRA_LOAD_R="$PKG/R/rir.R" 16 | 17 | $R_HOME/bin/`basename "$0"` "$@" 18 | -------------------------------------------------------------------------------- /tools/Rscript: -------------------------------------------------------------------------------- 1 | R -------------------------------------------------------------------------------- /tools/check-gnur-make-tests-error: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | SCRIPTPATH=`cd $(dirname "$0") && pwd` 4 | 5 | ERRORS=`grep -lE '(Status.*ERROR|Assertion.*failed|caught segfault)' $SCRIPTPATH/../external/custom-r/tests/*/*check.log` 6 | RESULT=$? 7 | 8 | echo $ERRORS 9 | if [[ $RESULT -eq 0 ]]; then 10 | echo "================= LOGS OF FAILED TESTS ====================" 11 | for f in $ERRORS; do 12 | echo 13 | echo 14 | echo "----------------- $f" 15 | echo 16 | cat $f 17 | done 18 | exit 1 19 | fi 20 | -------------------------------------------------------------------------------- /tools/copy-logs.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | TARGET=$2 4 | FILES=$(find $1 -iname '*.rout.fail' -o -iname '*.log') 5 | 6 | mkdir -p $TARGET 7 | for f in $FILES; do 8 | T="${TARGET}/$(echo $f | sed 's/\//-/g')" 9 | cp $f $T 10 | done 11 | 12 | # This collects errors on failure and CI should fail afterwards 13 | exit 1 14 | -------------------------------------------------------------------------------- /tools/cppcheck: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | SCRIPTPATH=`cd $(dirname "$0") && pwd` 4 | ROOT="$SCRIPTPATH/.." 5 | SRC="$ROOT/rir/src/" 6 | 7 | . "${SCRIPTPATH}/script_include.sh" 8 | 9 | trap 'echo " skipping" && exit 0' INT 10 | 11 | cppcheck --version 12 | cppcheck -q -j `ncores` --inline-suppr -I $SRC --suppressions-list=$ROOT/.cppcheck_suppressions --enable=portability,warning,performance,style --suppress=unusedLabel:$SRC/interpreter/interp.cpp --suppress=unusedStructMember:$SRC/interpreter/interp.cpp $SRC --suppress=cstyleCast --error-exitcode=2 "$@" 13 | -------------------------------------------------------------------------------- /tools/creduce: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | VM=$1 4 | FILE=$2 5 | EXPECTED=$3 6 | 7 | if [ -z "$VM" ] || [ -z "$FILE" ] || [ -z "$EXPECTED" ]; then 8 | echo "usage: $0 bin/R file.r \"expected string in output\"" 9 | echo 10 | echo "This script quickly allows you to reduce a failing test." 11 | echo "As arguments pass an R binary, a failing test file and" 12 | echo "an error string that occurs in the failing output." 13 | echo "Ensure that the error string does not contain \" chars" 14 | echo "and has all bash special chars escaped." 15 | echo 16 | echo "The result is a reduced R script in /tmp (see output)" 17 | echo "that exhibits the same error" 18 | exit 1 19 | fi 20 | 21 | shift 22 | shift 23 | shift 24 | 25 | VM=`readlink -f $VM` 26 | tmpfile=$(mktemp /tmp/creduce-test.XXXXXX) 27 | 28 | F=`basename $FILE` 29 | reduce=$(mktemp /tmp/$F.XXXXXX) 30 | cp $FILE $reduce 31 | 32 | echo "Trying to reduce $reduce running with $VM" 33 | 34 | reduce=`basename $reduce` 35 | 36 | cat - > $tmpfile < \$tmpfile 40 | grep "$EXPECTED" \$tmpfile 41 | RES=\$? 42 | rm \$tmpfile 43 | exit \$RES 44 | EOF 45 | chmod +x $tmpfile 46 | 47 | cd /tmp 48 | creduce --timeout 300 --not-c $tmpfile $reduce "$@" 49 | 50 | rm $tmpfile 51 | -------------------------------------------------------------------------------- /tools/fetch-llvm.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | set -e 4 | 5 | CURRENT_DIR=`pwd` 6 | SCRIPTPATH=`cd $(dirname "$0") && pwd` 7 | if [ ! -d $SCRIPTPATH ]; then 8 | echo "Could not determine absolute dir of $0" 9 | echo "Maybe accessed with symlink" 10 | fi 11 | SRC_DIR=`cd ${SCRIPTPATH}/.. && pwd` 12 | . "${SCRIPTPATH}/script_include.sh" 13 | 14 | 15 | if [[ "$OSTYPE" == "darwin"* ]]; then 16 | USING_OSX=1 17 | fi 18 | 19 | LLVM_DIR="${SRC_DIR}/external/llvm-12" 20 | if [ ! -d $LLVM_DIR ]; then 21 | echo "-> unpacking LLVM" 22 | cd "${SRC_DIR}/external" 23 | if [ $USING_OSX -eq 1 ]; then 24 | F="clang+llvm-12.0.0-x86_64-apple-darwin" 25 | if [ ! -f "$F.tar.xz" ]; then 26 | curl -L https://github.com/llvm/llvm-project/releases/download/llvmorg-12.0.0/$F.tar.xz > $F.tar.xz 27 | fi 28 | tar xf $F.tar.xz 29 | ln -s $F llvm-12 30 | else 31 | V=`grep DISTRIB_RELEASE /etc/lsb-release | cut -d= -f2` 32 | if [ "$V" == "18.04" ]; then 33 | V="16.04" 34 | fi 35 | if [ "$V" == "20.10" ]; then 36 | V="20.04" 37 | fi 38 | if [ "$V" == "22.04" ]; then 39 | V="20.04" 40 | fi 41 | if [ "$BUILD_LLVM_FROM_SRC" == "1" ]; then 42 | V="" 43 | fi 44 | if [ "$V" == "20.10" ] || [ "$V" == "20.04" ] || [ "$V" == "16.04" ]; then 45 | MINOR="0" 46 | F="clang+llvm-12.0.$MINOR-x86_64-linux-gnu-ubuntu-$V" 47 | if [ ! -f "$F.tar.xz" ]; then 48 | curl -L https://github.com/llvm/llvm-project/releases/download/llvmorg-12.0.$MINOR/$F.tar.xz > $F.tar.xz 49 | fi 50 | tar xf $F.tar.xz 51 | ln -s $F llvm-12 52 | else 53 | F="llvm-12.0.0.src" 54 | if [ ! -f "$F.tar.xz" ]; then 55 | curl -L https://github.com/llvm/llvm-project/releases/download/llvmorg-12.0.0/$F.tar.xz > $F.tar.xz 56 | fi 57 | tar xf $F.tar.xz 58 | mkdir llvm-12-build && cd llvm-12-build 59 | cmake -GNinja -DCMAKE_BUILD_TYPE=RelWithDebInfo -DLLVM_ENABLE_ASSERTIONS=1 -DLLVM_OPTIMIZED_TABLEGEN=1 -DLLVM_USE_PERF=1 -DLLVM_TARGETS_TO_BUILD="X86" ../$F 60 | ninja 61 | cd .. 62 | ln -s llvm-12-build llvm-12 63 | fi 64 | fi 65 | fi 66 | -------------------------------------------------------------------------------- /tools/gnur-make: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | SCRIPTPATH=`cd $(dirname "$0") && pwd` 4 | 5 | if [ -z "$RIR_BUILD" ]; then 6 | RIR_BUILD=`pwd` 7 | fi 8 | 9 | R_HOME=`cat $RIR_BUILD/.R_HOME` 10 | CHK=$1 11 | 12 | PKG="$SCRIPTPATH/../rir/" 13 | 14 | export EXTRA_LOAD_SO="`ls $RIR_BUILD/librir.*`" 15 | export EXTRA_LOAD_R="$PKG/R/rir.R" 16 | 17 | export R_ENABLE_JIT=2 18 | cd $R_HOME 19 | 20 | make $CHK 21 | -------------------------------------------------------------------------------- /tools/gnur-make-tests: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | SCRIPTPATH=`cd $(dirname "$0") && pwd` 4 | 5 | if [ -z "$RIR_BUILD" ]; then 6 | RIR_BUILD=`pwd` 7 | fi 8 | 9 | R_HOME=`cat $RIR_BUILD/.R_HOME` 10 | CHK=$1 11 | 12 | PKG="$SCRIPTPATH/../rir/" 13 | 14 | export EXTRA_LOAD_SO="`ls $RIR_BUILD/librir.*`" 15 | export EXTRA_LOAD_R="$PKG/R/rir.R" 16 | 17 | cd $R_HOME 18 | 19 | git clean -dfx -e Makefile tests/ 20 | 21 | cd tests 22 | 23 | XVFB=`which Xvfb 2> /dev/null` 24 | 25 | if [[ "$DISPLAY" == "" && "$XVFB" != "" ]]; then 26 | # Some tests fail without display 27 | echo "Starting virtual FB display" 28 | # for some reason noreset prevents XOpenDisplay to fail under high load 29 | Xvfb :1 -ac -noreset -screen 0 800x166x16& 30 | export DISPLAY=:1 31 | USING_XVFB=true 32 | fi 33 | 34 | CORES=`nproc 2> /dev/null || echo 1` 35 | let CORES=$CORES*2 36 | TEST_MC_CORES=$CORES make $CHK 37 | 38 | RESULT=$? 39 | 40 | if [[ "$USING_XVFB" != "" ]]; then 41 | #Kill virtual fb 42 | kill %1 43 | fi 44 | 45 | exit $RESULT 46 | -------------------------------------------------------------------------------- /tools/hook: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | TYPE=$1 6 | 7 | SCRIPTPATH=`cd $(dirname "$0") && pwd` 8 | if [ ! -d $SCRIPTPATH ]; then 9 | echo "Could not determine absolute dir of $0" 10 | echo "Maybe accessed with symlink" 11 | fi 12 | 13 | # Run install script to deploy new hooks 14 | $SCRIPTPATH/install_hooks.sh 15 | 16 | HOOKS_PATH="${SCRIPTPATH}/${TYPE}.d" 17 | 18 | for script in `ls -v ${HOOKS_PATH}/*.hook`; do 19 | name=`basename $script | sed 's/[0-9][0-9]-//' | sed 's/\.hook$//'` 20 | echo "-> $name" 21 | $script $SCRIPTPATH/.. 22 | done 23 | -------------------------------------------------------------------------------- /tools/install_hooks.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | SCRIPTPATH=`cd $(dirname "$0") && pwd` 4 | if [ ! -d $SCRIPTPATH ]; then 5 | echo "Could not determine absolute dir of $0" 6 | echo "Maybe accessed with symlink" 7 | fi 8 | 9 | cd $SCRIPTPATH/.. 10 | 11 | if [ -d .git/hooks ]; then 12 | rm -f .git/hooks/pre-commit 13 | ln -s $SCRIPTPATH/../tools/pre-commit-hook .git/hooks/pre-commit 14 | 15 | rm -f .git/hooks/pre-push 16 | ln -s $SCRIPTPATH/../tools/pre-push-hook .git/hooks/pre-push 17 | fi 18 | -------------------------------------------------------------------------------- /tools/pirpp.py: -------------------------------------------------------------------------------- 1 | # source: http://bazaar.launchpad.net/~maria-captains/mariadb-tools/trunk/view/head:/serg/gdb.py 2 | 3 | import gdb.printing 4 | 5 | # in python2 gdb.Value can only be converted to long(), python3 only has int() 6 | try: 7 | a=long(1) 8 | except: 9 | long=int 10 | 11 | def PrettyPrinter(arg): 12 | 13 | name = getattr(arg, '__name__', arg) 14 | 15 | def PrettyPrinterWrapperWrapperWrapper(func): 16 | 17 | class PrettyPrinterWrapperWrapper: 18 | 19 | class PrettyPrinterWrapper: 20 | def __init__(self, prefix, val, cb): 21 | self.prefix = prefix 22 | self.val = val 23 | self.cb = cb 24 | def to_string(self): 25 | return self.prefix + self.cb(self.val) 26 | 27 | def __init__(self, name, cb): 28 | self.name = name 29 | self.enabled = True 30 | self.cb = cb 31 | 32 | def __call__(self, val): 33 | prefix = '' 34 | if val.type.code == gdb.TYPE_CODE_PTR: 35 | prefix = '({}) {:#08x} '.format(str(val.type), long(val)) 36 | try: val = val.dereference() 37 | except: return None 38 | valtype=val.type.unqualified() 39 | if valtype.name == self.name: 40 | return self.PrettyPrinterWrapper(prefix, val, self.cb) 41 | if valtype.strip_typedefs().name == self.name: 42 | return self.PrettyPrinterWrapper(prefix, val, self.cb) 43 | return None 44 | 45 | pp=PrettyPrinterWrapperWrapper(name, func) 46 | gdb.printing.register_pretty_printer(None, pp, True) 47 | return func 48 | 49 | if callable(arg): 50 | return PrettyPrinterWrapperWrapperWrapper(arg) 51 | 52 | return PrettyPrinterWrapperWrapperWrapper 53 | 54 | @PrettyPrinter('rir::pir::BB') 55 | def BB(val): 56 | return "BB" + str(val['id']) 57 | 58 | @PrettyPrinter('rir::pir::Value') 59 | def Value(val): 60 | return '' 61 | 62 | @PrettyPrinter('rir::pir::Instruction') 63 | def Instruction(val): 64 | return '' 65 | -------------------------------------------------------------------------------- /tools/pre-commit-hook: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Reference: http://stackoverflow.com/questions/1055671/how-can-i-get-the-behavior-of-gnus-readlink-f-on-a-mac 4 | canonicalize_filename () { 5 | local target_file=$1 6 | local physical_directory="" 7 | local result="" 8 | 9 | # Need to restore the working directory after work. 10 | pushd `pwd` > /dev/null 11 | 12 | cd "$(dirname "$target_file")" 13 | target_file=`basename $target_file` 14 | 15 | # Iterate down a (possible) chain of symlinks 16 | while [ -L "$target_file" ] 17 | do 18 | target_file=$(readlink "$target_file") 19 | cd "$(dirname "$target_file")" 20 | target_file=$(basename "$target_file") 21 | done 22 | 23 | # Compute the canonicalized name by finding the physical path 24 | # for the directory we're in and appending the target file. 25 | physical_directory=`pwd -P` 26 | result="$physical_directory"/"$target_file" 27 | 28 | # restore the working directory after work. 29 | popd > /dev/null 30 | 31 | echo "$result" 32 | } 33 | 34 | SCRIPTPATH=`dirname $(canonicalize_filename "$0")` 35 | 36 | $SCRIPTPATH/hook pre-commit 37 | -------------------------------------------------------------------------------- /tools/pre-commit.d/10-clang-format.hook: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ROOT=$1 4 | CF="$ROOT/tools/git-clang-format" 5 | 6 | which clang-format &> /dev/null 7 | 8 | if [[ $? -ne 0 ]]; then 9 | echo "clang-format not found!" 10 | echo "Please, please, consider installing it." 11 | sleep 2 12 | exit 13 | fi 14 | 15 | if [[ `$CF --diff | wc -l` -gt 1 ]]; then 16 | 17 | echo "Your changes do not match clang format" 18 | 19 | $CF --diff 20 | 21 | exec < /dev/tty 22 | read -p "Do you wish to apply this patch? [Yn]" yn 23 | case $yn in 24 | [Nn]* ) printf ":(\n" 25 | exit 0;; 26 | * ) echo "applying patch..." 27 | $CF 28 | printf "\nYou can now commit again.\n" 29 | exit 2;; 30 | esac 31 | 32 | fi 33 | -------------------------------------------------------------------------------- /tools/pre-push-hook: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Reference: http://stackoverflow.com/questions/1055671/how-can-i-get-the-behavior-of-gnus-readlink-f-on-a-mac 4 | canonicalize_filename () { 5 | local target_file=$1 6 | local physical_directory="" 7 | local result="" 8 | 9 | # Need to restore the working directory after work. 10 | pushd `pwd` > /dev/null 11 | 12 | cd "$(dirname "$target_file")" 13 | target_file=`basename $target_file` 14 | 15 | # Iterate down a (possible) chain of symlinks 16 | while [ -L "$target_file" ] 17 | do 18 | target_file=$(readlink "$target_file") 19 | cd "$(dirname "$target_file")" 20 | target_file=$(basename "$target_file") 21 | done 22 | 23 | # Compute the canonicalized name by finding the physical path 24 | # for the directory we're in and appending the target file. 25 | physical_directory=`pwd -P` 26 | result="$physical_directory"/"$target_file" 27 | 28 | # restore the working directory after work. 29 | popd > /dev/null 30 | 31 | echo "$result" 32 | } 33 | 34 | SCRIPTPATH=`dirname $(canonicalize_filename "$0")` 35 | 36 | $SCRIPTPATH/hook pre-push 37 | -------------------------------------------------------------------------------- /tools/pre-push.d/90-tests.hook: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ROOT=$1 4 | 5 | git diff --exit-code > /dev/null && git diff --cached --exit-code > /dev/null 6 | if test "$?" -ne 0; then 7 | echo "warning: repository is dirty" 8 | git status -s 9 | sleep 2 10 | fi 11 | 12 | . "${ROOT}/tools/script_include.sh" 13 | 14 | build ${ROOT}/tests/build_push_hook ${ROOT} release 15 | 16 | if test "$?" -ne 0; then 17 | echo "build failed. Please fix first." 18 | exit 1 19 | fi 20 | 21 | cd ${ROOT}/tests/build_push_hook 22 | 23 | PIR_LLVM_OPT_LEVEL=0 ${ROOT}/tools/tests 24 | 25 | if test "$?" -ne 0; then 26 | echo "make tests failed. Please fix first." 27 | exit 1 28 | fi 29 | -------------------------------------------------------------------------------- /tools/script_include.sh: -------------------------------------------------------------------------------- 1 | USING_OSX=0 2 | if [[ "$OSTYPE" == "darwin"* ]]; then 3 | USING_OSX=1 4 | fi 5 | 6 | function ncores { 7 | if [[ "$OSTYPE" == "darwin"* ]]; then 8 | CORES=`sysctl -n hw.ncpu || echo 8` 9 | else 10 | CORES=`nproc || echo 8` 11 | fi 12 | echo $CORES 13 | } 14 | 15 | function build { 16 | ( 17 | DIR=$1 18 | ROOT_DIR=$2 19 | TYPE=$3 20 | 21 | # Cmake being stupid cannot build out of tree, when there is already an in-tree build :( 22 | if [ -f $ROOT_DIR/CMakeCache.txt ]; then 23 | mv $ROOT_DIR/CMakeCache.txt $ROOT_DIR/CMakeCache.txt.disabled 24 | trap "mv $ROOT_DIR/CMakeCache.txt.disabled $ROOT_DIR/CMakeCache.txt" EXIT 25 | fi 26 | 27 | mkdir -p $DIR 28 | cd $DIR 29 | cmake $ROOT_DIR -DCMAKE_BUILD_TYPE=$TYPE -DNO_LOCAL_CONFIG=1 30 | cmake --build . -- -j `ncores` 31 | ) 32 | } 33 | -------------------------------------------------------------------------------- /tools/setup-build-dir: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ROOT_DIR=$1 4 | R_HOME=$2 5 | BUILD_DIR=`pwd` 6 | 7 | echo $R_HOME > .R_HOME 8 | 9 | if [ $ROOT_DIR != $BUILD_DIR ]; then 10 | if [ ! -f .gdbinit ]; then 11 | ln -s $ROOT_DIR/.gdbinit 12 | ln -s $ROOT_DIR/tools/pirpp.py .pirpp.py 13 | fi 14 | fi 15 | --------------------------------------------------------------------------------