mirror of
				https://github.com/janet-lang/janet
				synced 2025-10-29 06:37:41 +00:00 
			
		
		
		
	Compare commits
	
		
			237 Commits
		
	
	
		
			locales
			...
			undo-deep-
		
	
	| Author | SHA1 | Date | |
|---|---|---|---|
|   | 5adfb75a25 | ||
|   | 611b2a6c3a | ||
|   | 8043caf581 | ||
|   | b2d2690eb9 | ||
|   | 7f745a34c3 | ||
|   | b16cf17246 | ||
|   | 67e8518ba6 | ||
|   | e94e8dc484 | ||
|   | 1a24d4fc86 | ||
|   | 6ee05785d1 | ||
|   | 268ff666d2 | ||
|   | 91bb34c3bf | ||
|   | 17d5fb3210 | ||
|   | 687b987f7e | ||
|   | 4daecc9a41 | ||
|   | a85eacadda | ||
|   | ed63987fd1 | ||
|   | ff173047f4 | ||
|   | 83e8aab289 | ||
|   | 85cb35e68f | ||
|   | 5b79b48ae0 | ||
|   | 7c44127bcb | ||
|   | 9338312103 | ||
|   | a0eeb630e7 | ||
|   | 6535d72bd4 | ||
|   | a7d424bc81 | ||
|   | 2bceba4a7a | ||
|   | e3159bb0f5 | ||
|   | 5d1bd8a932 | ||
|   | bafa6bfff0 | ||
|   | e2eb7ab4b2 | ||
|   | 9f4497a5ae | ||
|   | 70de8bf092 | ||
|   | e52575e23a | ||
|   | 10994cbc6a | ||
|   | abad9d7db9 | ||
|   | 5e443cd29d | ||
|   | 7bf3a9d24c | ||
|   | d80a7094ae | ||
|   | ad77bc391c | ||
|   | 2b84fb14b4 | ||
|   | 07155ce657 | ||
|   | 046d28662d | ||
|   | 84dd3db620 | ||
|   | 282f2671ea | ||
|   | 3fc2be3e6e | ||
|   | d10c1fe759 | ||
|   | d18472b07d | ||
|   | 43a68dcd2a | ||
|   | 3d93028088 | ||
|   | 99f0af92bd | ||
|   | 71d81b14a2 | ||
|   | 3894f4021a | ||
|   | 72c659d1ee | ||
|   | 8f879b4adc | ||
|   | 18f2847dc1 | ||
|   | 89b7ff9daf | ||
|   | 26c263d6be | ||
|   | 2570e0f7a0 | ||
|   | 8084e4c728 | ||
|   | ee90f9df62 | ||
|   | 906a982ace | ||
|   | 88e60c309c | ||
|   | 9694aee819 | ||
|   | 2697b0e425 | ||
|   | c0d7a49b19 | ||
|   | f9a6f52d9c | ||
|   | c02c2e3f02 | ||
|   | 1fcd47dd7b | ||
|   | 384ee4f6a9 | ||
|   | e9deec8231 | ||
|   | 2fc77a1b63 | ||
|   | 442fe8209d | ||
|   | 968a0dc4ac | ||
|   | 40c93d0786 | ||
|   | 83b0bc688c | ||
|   | 6185b253be | ||
|   | 17da53d0d9 | ||
|   | 9ffec43d2b | ||
|   | e4f4a42751 | ||
|   | 4f65c2707e | ||
|   | 75bdea5155 | ||
|   | f553c5da47 | ||
|   | 5f70a85f7e | ||
|   | c82fd106a7 | ||
|   | 0e9b866b98 | ||
|   | 67a8c6df09 | ||
|   | 86cf8127b6 | ||
|   | 828e0a07cd | ||
|   | 90018b35c0 | ||
|   | 5a199716cb | ||
|   | 43ecd4f2d8 | ||
|   | c5a9602be9 | ||
|   | e88aab6d68 | ||
|   | ce528251d5 | ||
|   | 9e334da2d6 | ||
|   | c0e508e334 | ||
|   | b63b3bef74 | ||
|   | 05d0b5ac05 | ||
|   | c56d6e8fc1 | ||
|   | 33d2f9a522 | ||
|   | e53d22fad2 | ||
|   | 33f55dc32f | ||
|   | 7e6aad2221 | ||
|   | 3c0c22259c | ||
|   | 42f6af4bf1 | ||
|   | f274b02653 | ||
|   | 70c29b4e5d | ||
|   | 84d43d1039 | ||
|   | 5c67c1165d | ||
|   | 85028967d8 | ||
|   | 6ceff6ecc9 | ||
|   | 06eec06ff0 | ||
|   | 2dcc0adc0e | ||
|   | 8ca1e44af1 | ||
|   | 2aedc6beff | ||
|   | af2eb06298 | ||
|   | 7ff545bd2e | ||
|   | a59b5765b6 | ||
|   | 6bd58dd4c0 | ||
|   | e3406cd922 | ||
|   | ab70524d85 | ||
|   | ce36c4c0d6 | ||
|   | 2b01b780da | ||
|   | f3048a3d6b | ||
|   | accac6c662 | ||
|   | 631622aa48 | ||
|   | aaeaa3a944 | ||
|   | d1104b5a65 | ||
|   | 1f074671ce | ||
|   | 872b39cc32 | ||
|   | 9eab57d194 | ||
|   | 8edd873c3e | ||
|   | 771956b5b6 | ||
|   | ecc4da5113 | ||
|   | f5555d21b9 | ||
|   | 342a29c7be | ||
|   | 368b891499 | ||
|   | f62539ad55 | ||
|   | 4835ecb950 | ||
|   | 31f0ff0d84 | ||
|   | b7b594205c | ||
|   | 190056b863 | ||
|   | ae6b359109 | ||
|   | 3078686f8f | ||
|   | 0f4ecd93ab | ||
|   | 4af187d0ca | ||
|   | a5d6b22838 | ||
|   | fda0a081f5 | ||
|   | 94b7a69741 | ||
|   | 6518257129 | ||
|   | dc325188d0 | ||
|   | 0b51ab157d | ||
|   | f95de25b15 | ||
|   | f424f2936b | ||
|   | 2d6c2ee7c0 | ||
|   | 7cd106a10c | ||
|   | 0d9e999113 | ||
|   | 75710ccabd | ||
|   | 0f60115f27 | ||
|   | 16a3c85baa | ||
|   | 92ff1d3be4 | ||
|   | 58441dc49f | ||
|   | dbc5d688e2 | ||
|   | e2a8951f68 | ||
|   | f0f03ad519 | ||
|   | e37575e763 | ||
|   | f4fd481415 | ||
|   | 8fca6b7af4 | ||
|   | 600e822933 | ||
|   | 2028ac8a20 | ||
|   | 7bae7d9efd | ||
|   | cb54fb02c1 | ||
|   | 7529abb542 | ||
|   | 16ac681ed9 | ||
|   | 74560ff805 | ||
|   | fe348187cc | ||
|   | fd5315793c | ||
|   | 87db463f4e | ||
|   | 1225cd31c8 | ||
|   | 6998865d7b | ||
|   | b8aec50763 | ||
|   | 7efb39d608 | ||
|   | f7c90bc1ff | ||
|   | aee077c1bd | ||
|   | 6968275ddf | ||
|   | 074ae4fc0d | ||
|   | 6cd35ed9c8 | ||
|   | 7911e74222 | ||
|   | 2fafe2b5d1 | ||
|   | de977819ce | ||
|   | 1844beecc3 | ||
|   | cb529bbd63 | ||
|   | 25990867e2 | ||
|   | 4fbc71c70d | ||
|   | eb21d4fff4 | ||
|   | 6d5fc1d743 | ||
|   | e88042b2fa | ||
|   | 750b448f75 | ||
|   | 14d1dc8749 | ||
|   | 8e0340252b | ||
|   | 641a16c133 | ||
|   | 533d78bffe | ||
|   | ae2c5820a1 | ||
|   | 8334504f4e | ||
|   | 2260a593bd | ||
|   | 7d8af2f99a | ||
|   | 46bdcece4d | ||
|   | 7387a1d91e | ||
|   | ae4b8078df | ||
|   | 60e0c8ea92 | ||
|   | 7d3acc0ed6 | ||
|   | 2637b33957 | ||
|   | 58ccb66659 | ||
|   | 634429cf61 | ||
|   | 6ac65e603d | ||
|   | 03166a745a | ||
|   | 4d61ba20ce | ||
|   | 751ff677fe | ||
|   | ace60e1898 | ||
|   | dc5cc630ff | ||
|   | 258ebb9145 | ||
|   | f0092ef69b | ||
|   | a88ae7e1d9 | ||
|   | 980981c9ee | ||
|   | 3c8346f24e | ||
|   | 42bd27c24b | ||
|   | 4a0f67f3bd | ||
|   | 09b6fc4670 | ||
|   | 4d9bcd6bcc | ||
|   | cd34b89977 | ||
|   | 3151fa3988 | ||
|   | 5e58110e19 | ||
|   | e1cdd0f8cc | ||
|   | 1f39a0f180 | ||
|   | 367c4b14f5 | ||
|   | 9c437796d3 | 
| @@ -19,3 +19,8 @@ tasks: | ||||
|     ninja | ||||
|     ninja test | ||||
|     sudo ninja install | ||||
| - meson_min: | | ||||
|     cd janet | ||||
|     meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dreduced_os=true -Dffi=false | ||||
|     cd build_meson_min | ||||
|     ninja | ||||
|   | ||||
							
								
								
									
										31
									
								
								.github/workflows/release.yml
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										31
									
								
								.github/workflows/release.yml
									
									
									
									
										vendored
									
									
								
							| @@ -17,7 +17,7 @@ jobs: | ||||
|     runs-on: ${{ matrix.os }} | ||||
|     strategy: | ||||
|       matrix: | ||||
|         os: [ ubuntu-latest, macos-latest ] | ||||
|         os: [ ubuntu-latest, macos-13 ] | ||||
|     steps: | ||||
|       - name: Checkout the repository | ||||
|         uses: actions/checkout@master | ||||
| @@ -39,6 +39,35 @@ jobs: | ||||
|             build/c/janet.c | ||||
|             build/c/shell.c | ||||
|  | ||||
|   release-arm: | ||||
|     permissions: | ||||
|       contents: write  # for softprops/action-gh-release to create GitHub release | ||||
|     name: Build release binaries | ||||
|     runs-on: ${{ matrix.os }} | ||||
|     strategy: | ||||
|       matrix: | ||||
|         os: [ macos-latest ] | ||||
|     steps: | ||||
|       - name: Checkout the repository | ||||
|         uses: actions/checkout@master | ||||
|       - name: Set the version | ||||
|         run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV | ||||
|       - name: Set the platform | ||||
|         run: echo "platform=$(tr '[A-Z]' '[a-z]' <<< $RUNNER_OS)" >> $GITHUB_ENV | ||||
|       - name: Compile the project | ||||
|         run: make clean && make | ||||
|       - name: Build the artifact | ||||
|         run: JANET_DIST_DIR=janet-${{ env.version }}-${{ env.platform }} make build/janet-${{ env.version }}-${{ env.platform }}-aarch64.tar.gz | ||||
|       - name: Draft the release | ||||
|         uses: softprops/action-gh-release@v1 | ||||
|         with: | ||||
|           draft: true | ||||
|           files: | | ||||
|             build/*.gz | ||||
|             build/janet.h | ||||
|             build/c/janet.c | ||||
|             build/c/shell.c | ||||
|  | ||||
|   release-windows: | ||||
|     permissions: | ||||
|       contents: write  # for softprops/action-gh-release to create GitHub release | ||||
|   | ||||
							
								
								
									
										65
									
								
								.github/workflows/test.yml
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										65
									
								
								.github/workflows/test.yml
									
									
									
									
										vendored
									
									
								
							| @@ -12,7 +12,7 @@ jobs: | ||||
|     runs-on: ${{ matrix.os }} | ||||
|     strategy: | ||||
|       matrix: | ||||
|         os: [ ubuntu-latest, macos-latest ] | ||||
|         os: [ ubuntu-latest, macos-latest, macos-13 ] | ||||
|     steps: | ||||
|       - name: Checkout the repository | ||||
|         uses: actions/checkout@master | ||||
| @@ -23,7 +23,10 @@ jobs: | ||||
|  | ||||
|   test-windows: | ||||
|     name: Build and test on Windows | ||||
|     runs-on: windows-latest | ||||
|     strategy: | ||||
|       matrix: | ||||
|         os: [ windows-latest, windows-2019 ] | ||||
|     runs-on: ${{ matrix.os }} | ||||
|     steps: | ||||
|       - name: Checkout the repository | ||||
|         uses: actions/checkout@master | ||||
| @@ -35,28 +38,61 @@ jobs: | ||||
|       - name: Test the project | ||||
|         shell: cmd | ||||
|         run: build_win test | ||||
|       - name: Test installer build | ||||
|         shell: cmd | ||||
|         run: build_win dist | ||||
|  | ||||
|   test-windows-min: | ||||
|     name: Build and test on Windows Minimal build | ||||
|     strategy: | ||||
|       matrix: | ||||
|         os: [ windows-2019 ] | ||||
|     runs-on: ${{ matrix.os }} | ||||
|     steps: | ||||
|       - name: Checkout the repository | ||||
|         uses: actions/checkout@master | ||||
|       - name: Setup MSVC | ||||
|         uses: ilammy/msvc-dev-cmd@v1 | ||||
|       - name: Setup Python | ||||
|         uses: actions/setup-python@v2 | ||||
|         with: | ||||
|           python-version: '3.x' | ||||
|       - name: Install Python Dependencies | ||||
|         run: pip install meson ninja | ||||
|       - name: Build | ||||
|         shell: cmd | ||||
|         run: | | ||||
|           meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dreduced_os=true -Dffi=false | ||||
|           cd build_meson_min | ||||
|           ninja | ||||
|  | ||||
|   test-mingw: | ||||
|     name: Build on Windows with Mingw (no test yet) | ||||
|     name: Build on Windows with Mingw | ||||
|     runs-on: windows-latest | ||||
|     defaults: | ||||
|       run: | ||||
|         shell: msys2 {0} | ||||
|     strategy: | ||||
|       matrix: | ||||
|         msystem: [ UCRT64, CLANG64 ] | ||||
|     steps: | ||||
|       - name: Checkout the repository | ||||
|         uses: actions/checkout@master | ||||
|       - name: Setup Mingw | ||||
|         uses: msys2/setup-msys2@v2 | ||||
|         with: | ||||
|           msystem: UCRT64 | ||||
|           msystem: ${{ matrix.msystem }} | ||||
|           update: true | ||||
|           install: >- | ||||
|             base-devel | ||||
|             git | ||||
|             gcc | ||||
|       - name: Build the project | ||||
|       - name: Build | ||||
|         shell: cmd | ||||
|         run: make -j4 CC=gcc JANET_NO_AMALG=1 | ||||
|         run: make -j4 CC=gcc | ||||
|       - name: Test | ||||
|         shell: cmd | ||||
|         run: make -j4 CC=gcc test | ||||
|  | ||||
|   test-mingw-linux: | ||||
|     name: Build and test with Mingw on Linux + Wine | ||||
| @@ -73,7 +109,7 @@ jobs: | ||||
|       - name: Compile the project | ||||
|         run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine | ||||
|       - name: Test the project | ||||
|         run: make test UNAME=MINGW RUN=wine | ||||
|         run: make test UNAME=MINGW RUN=wine VERBOSE=1 | ||||
|  | ||||
|   test-arm-linux: | ||||
|     name: Build and test ARM32 cross compilation | ||||
| @@ -86,6 +122,17 @@ jobs: | ||||
|           sudo apt-get update | ||||
|           sudo apt-get install gcc-arm-linux-gnueabi qemu-user | ||||
|       - name: Compile the project | ||||
|         run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc  | ||||
|         run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc | ||||
|       - name: Test the project | ||||
|         run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test | ||||
|         run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test VERBOSE=1 | ||||
|  | ||||
|   test-s390x-linux: | ||||
|     name: Build and test s390x in qemu | ||||
|     runs-on: ubuntu-latest | ||||
|     steps: | ||||
|     - name: Checkout the repository | ||||
|       uses: actions/checkout@master | ||||
|     - name: Do Qemu build and test | ||||
|       run: | | ||||
|         docker run --rm --privileged multiarch/qemu-user-static --reset -p yes | ||||
|         docker run --rm -v .:/janet --platform linux/s390x ubuntu bash -c "apt-get -y update && apt-get -y install git build-essential && cd /janet && make -j3 && make test" | ||||
|   | ||||
							
								
								
									
										5
									
								
								.gitignore
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										5
									
								
								.gitignore
									
									
									
									
										vendored
									
									
								
							| @@ -48,6 +48,8 @@ janet.wasm | ||||
| # Generated files | ||||
| *.gen.h | ||||
| *.gen.c | ||||
| *.tmp | ||||
| temp.* | ||||
|  | ||||
| # Generate test files | ||||
| *.out | ||||
| @@ -126,6 +128,9 @@ vgcore.* | ||||
| *.idb | ||||
| *.pdb | ||||
|  | ||||
| # GGov | ||||
| *.gcov | ||||
|  | ||||
| # Kernel Module Compile Results | ||||
| *.mod* | ||||
| *.cmd | ||||
|   | ||||
							
								
								
									
										61
									
								
								CHANGELOG.md
									
									
									
									
									
								
							
							
						
						
									
										61
									
								
								CHANGELOG.md
									
									
									
									
									
								
							| @@ -1,7 +1,56 @@ | ||||
| # Changelog | ||||
| All notable changes to this project will be documented in this file. | ||||
|  | ||||
| ## Unreleased - ??? | ||||
| ## ??? - Unreleased | ||||
| - Add `struct/rawget` to get values from a struct without a prototype. | ||||
| - Fix `deep=` and `deep-not=` to better handle degenerate cases with mutable table keys. Keys are now compared by value rather than | ||||
|   structure to avoid degenerate cases. | ||||
| - Long strings will now dedent on `\r\n` instead of just `\n`. | ||||
| - Add `ev/to-file` for synchronous resource operations | ||||
|  | ||||
| ## 1.37.1 - 2024-12-05 | ||||
| - Fix meson cross compilation | ||||
| - Update timeout documentation for networking APIs: timeouts raise errors and do not return nil. | ||||
| - Add `janet_addtimeout_nil(double sec);` to the C API. | ||||
| - Change string hashing. | ||||
| - Fix string equality bug. | ||||
| - Add `assertf` | ||||
| - Change how JANET_PROFILE is loaded to allow more easily customizing the environment. | ||||
| - Add `*repl-prompt*` dynamic binding to allow customizing the built in repl. | ||||
| - Add multiple path support in the `JANET_PATH` environment variables. This lets | ||||
|   user more easily import modules from many directories. | ||||
| - Add `nth` and `only-tags` PEG specials to select from sub-captures while | ||||
|   dropping the rest. | ||||
|  | ||||
| ## 1.36.0 - 2024-09-07 | ||||
| - Improve error messages in `bundle/add*` functions. | ||||
| - Add CI testing and verify tests pass on the s390x architecture. | ||||
| - Save `:source-form` in environment entries when `*debug*` is set. | ||||
| - Add experimental `filewatch/` module for listening to file system changes on Linux and Windows. | ||||
| - Add `bundle/who-is` to query which bundle a file on disk was installed by. | ||||
| - Add `geomean` function | ||||
| - Add `:R` and `:W` flags to `os/pipe` to create blocking pipes on Posix and Windows systems. | ||||
|   These streams cannot be directly read to and written from, but can be passed to subprocesses. | ||||
| - Add `array/join` | ||||
| - Add `tuple/join` | ||||
| - Add `bundle/add-bin` to make installing scripts easier. This also establishes a packaging convention for it. | ||||
| - Fix marshalling weak tables and weak arrays. | ||||
| - Fix bug in `ev/` module that could accidentally close sockets on accident. | ||||
| - Expose C functions for constructing weak tables in janet.h | ||||
| - Let range take non-integer values. | ||||
|  | ||||
| ## 1.35.2 - 2024-06-16 | ||||
| - Fix some documentation typos. | ||||
| - Allow using `:only` in import without quoting. | ||||
|  | ||||
| ## 1.35.0 - 2024-06-15 | ||||
| - Add `:only` argument to `import` to allow for easier control over imported bindings. | ||||
| - Add extra optional `env` argument to `eval` and `eval-string`. | ||||
| - Allow naming function literals with a keyword. This allows better stacktraces for macros without | ||||
|   accidentally adding new bindings. | ||||
| - Add `bundle/` module for managing packages within Janet. This should replace the jpm packaging | ||||
|   format eventually and is much simpler and amenable to more complicated builds. | ||||
| - Add macros `ev/with-lock`, `ev/with-rlock`, and `ev/with-wlock` for using mutexes and rwlocks. | ||||
| - Add `with-env` | ||||
| - Add *module-make-env* dynamic binding | ||||
| - Add buffer/format-at | ||||
| @@ -107,7 +156,7 @@ All notable changes to this project will be documented in this file. | ||||
|   See http://no-color.org/ | ||||
| - Disallow using `(splice x)` in contexts where it doesn't make sense rather than silently coercing to `x`. | ||||
|   Instead, raise a compiler error. | ||||
| - Change the names of `:user8` and `:user9` sigals to `:interrupt` and `:await` | ||||
| - Change the names of `:user8` and `:user9` signals to `:interrupt` and `:await` | ||||
| - Change the names of `:user8` and `:user9` fiber statuses to `:interrupted` and `:suspended`. | ||||
| - Add `ev/all-tasks` to see all currently suspended fibers. | ||||
| - Add `keep-syntax` and `keep-syntax!` functions to make writing macros easier. | ||||
| @@ -278,7 +327,7 @@ All notable changes to this project will be documented in this file. | ||||
| - Add the ability to close channels with `ev/chan-close` (or `:close`). | ||||
| - Add threaded channels with `ev/thread-chan`. | ||||
| - Add `JANET_FN` and `JANET_REG` macros to more easily define C functions that export their source mapping information. | ||||
| - Add `janet_interpreter_interupt` and `janet_loop1_interrupt` to interrupt the interpreter while running. | ||||
| - Add `janet_interpreter_interrupt` and `janet_loop1_interrupt` to interrupt the interpreter while running. | ||||
| - Add `table/clear` | ||||
| - Add build option to disable the threading library without disabling all threads. | ||||
| - Remove JPM from the main Janet distribution. Instead, JPM must be installed | ||||
| @@ -332,7 +381,7 @@ saving and restoring the entire VM state. | ||||
| - Sort keys in pretty printing output. | ||||
|  | ||||
| ## 1.15.3 - 2021-02-28 | ||||
| - Fix a fiber bug that occured in deeply nested fibers | ||||
| - Fix a fiber bug that occurred in deeply nested fibers | ||||
| - Add `unref` combinator to pegs. | ||||
| - Small docstring changes. | ||||
|  | ||||
| @@ -482,13 +531,13 @@ saving and restoring the entire VM state. | ||||
| - Add `symbol/slice` | ||||
| - Add `keyword/slice` | ||||
| - Allow cross compilation with Makefile. | ||||
| - Change `compare-primitve` to `cmp` and make it more efficient. | ||||
| - Change `compare-primitive` to `cmp` and make it more efficient. | ||||
| - Add `reverse!` for reversing an array or buffer in place. | ||||
| - `janet_dobytes` and `janet_dostring` return parse errors in \*out | ||||
| - Add `repeat` macro for iterating something n times. | ||||
| - Add `eachy` (each yield) macro for iterating a fiber. | ||||
| - Fix `:generate` verb in loop macro to accept non symbols as bindings. | ||||
| - Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexidecimal digits. | ||||
| - Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexadecimal digits. | ||||
| - Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf). | ||||
|  | ||||
| ## 1.10.1 - 2020-06-18 | ||||
|   | ||||
							
								
								
									
										14
									
								
								Makefile
									
									
									
									
									
								
							
							
						
						
									
										14
									
								
								Makefile
									
									
									
									
									
								
							| @@ -1,4 +1,4 @@ | ||||
| # Copyright (c) 2023 Calvin Rose | ||||
| # Copyright (c) 2024 Calvin Rose | ||||
| # | ||||
| # Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| # of this software and associated documentation files (the "Software"), to | ||||
| @@ -43,6 +43,7 @@ JANET_DIST_DIR?=janet-dist | ||||
| JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)' | ||||
| JANET_TARGET_OBJECTS=build/janet.o build/shell.o | ||||
| JPM_TAG?=master | ||||
| SPORK_TAG?=master | ||||
| HAS_SHARED?=1 | ||||
| DEBUGGER=gdb | ||||
| SONAME_SETTER=-Wl,-soname, | ||||
| @@ -139,6 +140,7 @@ JANET_CORE_SOURCES=src/core/abstract.c \ | ||||
| 				   src/core/ev.c \ | ||||
| 				   src/core/ffi.c \ | ||||
| 				   src/core/fiber.c \ | ||||
| 				   src/core/filewatch.c \ | ||||
| 				   src/core/gc.c \ | ||||
| 				   src/core/inttypes.c \ | ||||
| 				   src/core/io.c \ | ||||
| @@ -204,9 +206,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile | ||||
| ######################## | ||||
|  | ||||
| ifeq ($(UNAME), Darwin) | ||||
| SONAME=libjanet.1.34.dylib | ||||
| SONAME=libjanet.1.37.dylib | ||||
| else | ||||
| SONAME=libjanet.so.1.34 | ||||
| SONAME=libjanet.so.1.37 | ||||
| endif | ||||
|  | ||||
| build/c/shell.c: src/mainclient/shell.c | ||||
| @@ -358,6 +360,12 @@ install-jpm-git: $(JANET_TARGET) | ||||
| 		JANET_LIBPATH='$(LIBDIR)' \ | ||||
| 		$(RUN) ../../$(JANET_TARGET) ./bootstrap.janet | ||||
|  | ||||
| install-spork-git: $(JANET_TARGET) | ||||
| 	mkdir -p build | ||||
| 	rm -rf build/spork | ||||
| 	git clone --depth=1 --branch='$(SPORK_TAG)' https://github.com/janet-lang/spork.git build/spork | ||||
| 	$(JANET_TARGET) -e '(bundle/install "build/spork")' | ||||
|  | ||||
| uninstall: | ||||
| 	-rm '$(DESTDIR)$(BINDIR)/janet' | ||||
| 	-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet' | ||||
|   | ||||
							
								
								
									
										11
									
								
								README.md
									
									
									
									
									
								
							
							
						
						
									
										11
									
								
								README.md
									
									
									
									
									
								
							| @@ -1,4 +1,4 @@ | ||||
| [](https://gitter.im/janet-language/community) | ||||
| [](https://janet.zulipchat.com) | ||||
|   | ||||
| [](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml?) | ||||
| [](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml?) | ||||
| @@ -18,9 +18,6 @@ to run script files. This client program is separate from the core runtime, so | ||||
| Janet can be embedded in other programs. Try Janet in your browser at | ||||
| <https://janet-lang.org>. | ||||
|  | ||||
| If you'd like to financially support the ongoing development of Janet, consider | ||||
| [sponsoring its primary author](https://github.com/sponsors/bakpakin) through GitHub. | ||||
|  | ||||
| <br> | ||||
|  | ||||
| ## Examples | ||||
| @@ -253,8 +250,10 @@ Emacs, and Atom each have syntax packages for the Janet language, though. | ||||
|  | ||||
| ## Installation | ||||
|  | ||||
| See the [Introduction](https://janet-lang.org/docs/index.html) for more details. If you just want | ||||
| to try out the language, you don't need to install anything. You can also move the `janet` executable wherever you want on your system and run it. | ||||
| If you just want to try out the language, you don't need to install anything. | ||||
| In this case you can also move the `janet` executable wherever you want on | ||||
| your system and run it.  However, for a fuller setup, please see the | ||||
| [Introduction](https://janet-lang.org/docs/index.html) for more details. | ||||
|  | ||||
| ## Usage | ||||
|  | ||||
|   | ||||
| @@ -50,6 +50,7 @@ for %%f in (src\boot\*.c) do ( | ||||
| %JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj | ||||
| @if not errorlevel 0 goto :BUILDFAIL | ||||
| build\janet_boot . > build\c\janet.c | ||||
| @if not errorlevel 0 goto :BUILDFAIL | ||||
|  | ||||
| @rem Build the sources | ||||
| %JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c | ||||
| @@ -59,6 +60,7 @@ build\janet_boot . > build\c\janet.c | ||||
|  | ||||
| @rem Build the resources | ||||
| rc /nologo /fobuild\janet_win.res janet_win.rc | ||||
| @if not errorlevel 0 goto :BUILDFAIL | ||||
|  | ||||
| @rem Link everything to main client | ||||
| %JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res | ||||
| @@ -119,7 +121,6 @@ copy README.md dist\README.md | ||||
|  | ||||
| copy janet.lib dist\janet.lib | ||||
| copy janet.exp dist\janet.exp | ||||
| copy janet.def dist\janet.def | ||||
|  | ||||
| janet.exe tools\patch-header.janet src\include\janet.h src\conf\janetconf.h build\janet.h | ||||
| copy build\janet.h dist\janet.h | ||||
| @@ -137,7 +138,8 @@ if defined APPVEYOR_REPO_TAG_NAME ( | ||||
|     set RELEASE_VERSION=%JANET_VERSION% | ||||
| ) | ||||
| if defined CI ( | ||||
|     set WIXBIN="c:\Program Files (x86)\WiX Toolset v3.11\bin\" | ||||
|     set WIXBIN="%WIX%bin\" | ||||
|     echo WIXBIN = %WIXBIN% | ||||
| ) else ( | ||||
|     set WIXBIN= | ||||
| ) | ||||
|   | ||||
							
								
								
									
										35
									
								
								examples/chatserver.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										35
									
								
								examples/chatserver.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,35 @@ | ||||
| (def conmap @{}) | ||||
|  | ||||
| (defn broadcast [em msg] | ||||
|   (eachk par conmap | ||||
|          (if (not= par em) | ||||
|            (if-let [tar (get conmap par)] | ||||
|              (net/write tar (string/format "[%s]:%s" em msg)))))) | ||||
|  | ||||
| (defn handler | ||||
|   [connection] | ||||
|   (print "connection: " connection) | ||||
|   (net/write connection "Whats your name?\n") | ||||
|   (def name (string/trim (string (ev/read connection 100)))) | ||||
|   (print name " connected") | ||||
|   (if (get conmap name) | ||||
|     (do | ||||
|       (net/write connection "Name already taken!") | ||||
|       (:close connection)) | ||||
|     (do | ||||
|       (put conmap name connection) | ||||
|       (net/write connection (string/format "Welcome %s\n" name)) | ||||
|       (defer (do | ||||
|                (put conmap name nil) | ||||
|                (:close connection)) | ||||
|         (while (def msg (ev/read connection 100)) | ||||
|           (broadcast name (string msg))) | ||||
|         (print name " disconnected"))))) | ||||
|  | ||||
| (defn main [& args] | ||||
|   (printf "STARTING SERVER...") | ||||
|   (flush) | ||||
|   (def my-server (net/listen "127.0.0.1" "8000")) | ||||
|   (forever | ||||
|    (def connection (net/accept my-server)) | ||||
|    (ev/call handler connection))) | ||||
| @@ -35,6 +35,11 @@ typedef struct { | ||||
|     int c; | ||||
| } intintint; | ||||
|  | ||||
| typedef struct { | ||||
|     uint64_t a; | ||||
|     uint64_t b; | ||||
| } uint64pair; | ||||
|  | ||||
| typedef struct { | ||||
|     int64_t a; | ||||
|     int64_t b; | ||||
| @@ -203,3 +208,20 @@ EXPORTER | ||||
| int sixints_fn_3(SixInts s, int x) { | ||||
|     return x + s.u + s.v + s.w + s.x + s.y + s.z; | ||||
| } | ||||
|  | ||||
| EXPORTER | ||||
| intint stack_spill_fn(uint8_t a, uint8_t b, uint8_t c, uint8_t d, | ||||
|                       uint8_t e, uint8_t f, uint8_t g, uint8_t h, | ||||
|                       float i, float j, float k, float l, | ||||
|                       float m, float n, float o, float p, | ||||
|                       float s1, int8_t s2, uint8_t s3, double s4, uint8_t s5, intint s6) { | ||||
|     return (intint) { | ||||
|         (a | b | c | d | e | f | g | h) + (i + j + k + l + m + n + o + p), | ||||
|         s1 *s6.a + s2 *s6.b + s3 *s4 *s5 | ||||
|     }; | ||||
| } | ||||
|  | ||||
| EXPORTER | ||||
| double stack_spill_fn_2(uint64pair a, uint64pair b, uint64pair c, int8_t d, uint64pair e, int8_t f) { | ||||
|     return (double)(a.a * c.a + a.b * c.b + b.a * e.a) * f - (double)(b.b * e.b) + d; | ||||
| } | ||||
|   | ||||
| @@ -8,11 +8,13 @@ | ||||
|  | ||||
| (if is-windows | ||||
|   (os/execute ["cl.exe" "/nologo" "/LD" ffi/source-loc "/link" "/DLL" (string "/OUT:" ffi/loc)] :px) | ||||
|   (os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px)) | ||||
|   (os/execute ["cc" ffi/source-loc "-g" "-shared" "-o" ffi/loc] :px)) | ||||
|  | ||||
| (ffi/context ffi/loc) | ||||
|  | ||||
| (def intint (ffi/struct :int :int)) | ||||
| (def intintint (ffi/struct :int :int :int)) | ||||
| (def uint64pair (ffi/struct :u64 :u64)) | ||||
| (def big (ffi/struct :s64 :s64 :s64)) | ||||
| (def split (ffi/struct :int :int :float :float)) | ||||
| (def split-flip (ffi/struct :float :float :int :int)) | ||||
| @@ -55,6 +57,13 @@ | ||||
| (ffi/defbind sixints-fn six-ints []) | ||||
| (ffi/defbind sixints-fn-2 :int [x :int s six-ints]) | ||||
| (ffi/defbind sixints-fn-3 :int [s six-ints x :int]) | ||||
| (ffi/defbind stack-spill-fn intint | ||||
|              [a :u8 b :u8 c :u8 d :u8 | ||||
|               e :u8 f :u8 g :u8 h :u8 | ||||
|               i :float j :float k :float l :float | ||||
|               m :float n :float o :float p :float | ||||
|               s1 :float s2 :s8 s3 :u8 s4 :double s5 :u8 s6 intint]) | ||||
| (ffi/defbind stack-spill-fn-2 :double [a uint64pair b uint64pair c uint64pair d :s8 e uint64pair f :s8]) | ||||
| (ffi/defbind-alias int-fn int-fn-aliased :int [a :int b :int]) | ||||
|  | ||||
| # | ||||
| @@ -132,5 +141,10 @@ | ||||
| (assert (= 21 (math/round (double-many 1 2 3 4 5 6.01)))) | ||||
| (assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10))) | ||||
| (assert (= 204 (float-fn 8 4 17))) | ||||
| (assert (= [0 38534415] (stack-spill-fn | ||||
|                           0 0 0 0 0 0 0 0 | ||||
|                           0 0 0 0 0 0 0 0 | ||||
|                           1.5 -32 196 65536.5 3 [-15 32]))) | ||||
| (assert (= -2806 (stack-spill-fn-2 [2 3] [5 7] [9 11] -19 [13 17] -23))) | ||||
|  | ||||
| (print "Done.") | ||||
|   | ||||
							
								
								
									
										1
									
								
								examples/sample-bad-bundle/badmod.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										1
									
								
								examples/sample-bad-bundle/badmod.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1 @@ | ||||
| (def abc 123) | ||||
							
								
								
									
										7
									
								
								examples/sample-bad-bundle/bundle.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										7
									
								
								examples/sample-bad-bundle/bundle.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,7 @@ | ||||
| (defn install | ||||
|   [manifest &] | ||||
|   (bundle/add-file manifest "badmod.janet")) | ||||
|  | ||||
| (defn check | ||||
|   [&] | ||||
|   (error "Check failed!")) | ||||
							
								
								
									
										1
									
								
								examples/sample-bundle-aliases/aliases-mod.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										1
									
								
								examples/sample-bundle-aliases/aliases-mod.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1 @@ | ||||
| (defn fun [x] (range x)) | ||||
							
								
								
									
										3
									
								
								examples/sample-bundle-aliases/bundle.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										3
									
								
								examples/sample-bundle-aliases/bundle.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,3 @@ | ||||
| (defn install | ||||
|   [manifest &] | ||||
|   (bundle/add-file manifest "aliases-mod.janet")) | ||||
							
								
								
									
										4
									
								
								examples/sample-bundle-aliases/info.jdn
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										4
									
								
								examples/sample-bundle-aliases/info.jdn
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,4 @@ | ||||
| @{ | ||||
|   :name "sample-bundle-aliases" | ||||
|   :dependencies ["sample-dep1" "sample-dep2"] | ||||
| } | ||||
							
								
								
									
										4
									
								
								examples/sample-bundle/bundle/info.jdn
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										4
									
								
								examples/sample-bundle/bundle/info.jdn
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,4 @@ | ||||
| @{ | ||||
|   :name "sample-bundle" | ||||
|   :dependencies ["sample-dep1" "sample-dep2"] | ||||
| } | ||||
							
								
								
									
										3
									
								
								examples/sample-bundle/bundle/init.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										3
									
								
								examples/sample-bundle/bundle/init.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,3 @@ | ||||
| (defn install | ||||
|   [manifest &] | ||||
|   (bundle/add-file manifest "mymod.janet")) | ||||
							
								
								
									
										7
									
								
								examples/sample-bundle/mymod.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										7
									
								
								examples/sample-bundle/mymod.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,7 @@ | ||||
| (import dep1) | ||||
| (import dep2) | ||||
|  | ||||
| (defn myfn | ||||
|   [x] | ||||
|   (def y (dep2/function x)) | ||||
|   (dep1/function y)) | ||||
							
								
								
									
										4
									
								
								examples/sample-dep1/bundle/info.jdn
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										4
									
								
								examples/sample-dep1/bundle/info.jdn
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,4 @@ | ||||
| @{ | ||||
|   :name "sample-dep1" | ||||
|   :dependencies ["sample-dep2"] | ||||
| } | ||||
							
								
								
									
										3
									
								
								examples/sample-dep1/bundle/init.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										3
									
								
								examples/sample-dep1/bundle/init.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,3 @@ | ||||
| (defn install | ||||
|   [manifest &] | ||||
|   (bundle/add-file manifest "dep1.janet")) | ||||
							
								
								
									
										3
									
								
								examples/sample-dep1/dep1.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										3
									
								
								examples/sample-dep1/dep1.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,3 @@ | ||||
| (defn function | ||||
|   [x] | ||||
|   (+ x x)) | ||||
							
								
								
									
										3
									
								
								examples/sample-dep2/bundle/info.jdn
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										3
									
								
								examples/sample-dep2/bundle/info.jdn
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,3 @@ | ||||
| @{ | ||||
|   :name "sample-dep2" | ||||
| } | ||||
							
								
								
									
										3
									
								
								examples/sample-dep2/bundle/init.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										3
									
								
								examples/sample-dep2/bundle/init.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,3 @@ | ||||
| (defn install | ||||
|   [manifest &] | ||||
|   (bundle/add-file manifest "dep2.janet")) | ||||
							
								
								
									
										3
									
								
								examples/sample-dep2/dep2.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										3
									
								
								examples/sample-dep2/dep2.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,3 @@ | ||||
| (defn function | ||||
|   [x] | ||||
|   (* x x)) | ||||
							
								
								
									
										3
									
								
								janet.1
									
									
									
									
									
								
							
							
						
						
									
										3
									
								
								janet.1
									
									
									
									
									
								
							| @@ -255,7 +255,8 @@ and then arguments to the script. | ||||
| .RS | ||||
| The location to look for Janet libraries. This is the only environment variable Janet needs to | ||||
| find native and source code modules. If no JANET_PATH is set, Janet will look in | ||||
| the default location set at compile time. | ||||
| the default location set at compile time. This should be a list of as well as a colon | ||||
| separate list of such directories. | ||||
| .RE | ||||
|  | ||||
| .B JANET_PROFILE | ||||
|   | ||||
							
								
								
									
										36
									
								
								meson.build
									
									
									
									
									
								
							
							
						
						
									
										36
									
								
								meson.build
									
									
									
									
									
								
							| @@ -1,4 +1,4 @@ | ||||
| # Copyright (c) 2023 Calvin Rose and contributors | ||||
| # Copyright (c) 2024 Calvin Rose and contributors | ||||
| # | ||||
| # Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| # of this software and associated documentation files (the "Software"), to | ||||
| @@ -20,14 +20,23 @@ | ||||
|  | ||||
| project('janet', 'c', | ||||
|   default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'], | ||||
|   version : '1.34.0') | ||||
|   version : '1.37.1') | ||||
|  | ||||
| # Global settings | ||||
| janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') | ||||
| header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet') | ||||
|  | ||||
| # Link math library on all systems | ||||
| # Compilers | ||||
| cc = meson.get_compiler('c') | ||||
| native_cc = meson.get_compiler('c', native : true) | ||||
|  | ||||
| # Native deps | ||||
| native_m_dep = native_cc.find_library('m', required : false) | ||||
| native_dl_dep = native_cc.find_library('dl', required : false) | ||||
| native_android_spawn_dep = native_cc.find_library('android-spawn', required : false) | ||||
| native_thread_dep = dependency('threads', native : true) | ||||
|  | ||||
| # Deps | ||||
| m_dep = cc.find_library('m', required : false) | ||||
| dl_dep = cc.find_library('dl', required : false) | ||||
| android_spawn_dep = cc.find_library('android-spawn', required : false) | ||||
| @@ -79,6 +88,7 @@ conf.set('JANET_EV_NO_KQUEUE', not get_option('kqueue')) | ||||
| conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt')) | ||||
| conf.set('JANET_NO_FFI', not get_option('ffi')) | ||||
| conf.set('JANET_NO_FFI_JIT', not get_option('ffi_jit')) | ||||
| conf.set('JANET_NO_FILEWATCH', not get_option('filewatch')) | ||||
| conf.set('JANET_NO_CRYPTORAND', not get_option('cryptorand')) | ||||
| if get_option('os_name') != '' | ||||
|   conf.set('JANET_OS_NAME', get_option('os_name')) | ||||
| @@ -122,6 +132,7 @@ core_src = [ | ||||
|   'src/core/ev.c', | ||||
|   'src/core/ffi.c', | ||||
|   'src/core/fiber.c', | ||||
|   'src/core/filewatch.c', | ||||
|   'src/core/gc.c', | ||||
|   'src/core/inttypes.c', | ||||
|   'src/core/io.c', | ||||
| @@ -162,11 +173,18 @@ mainclient_src = [ | ||||
|   'src/mainclient/shell.c' | ||||
| ] | ||||
|  | ||||
| janet_dependencies = [m_dep, dl_dep, android_spawn_dep] | ||||
| janet_native_dependencies = [native_m_dep, native_dl_dep, native_android_spawn_dep] | ||||
| if not get_option('single_threaded') | ||||
|   janet_dependencies += thread_dep | ||||
|   janet_native_dependencies += native_thread_dep | ||||
| endif | ||||
|  | ||||
| # Build boot binary | ||||
| janet_boot = executable('janet-boot', core_src, boot_src, | ||||
|   include_directories : incdir, | ||||
|   c_args : '-DJANET_BOOTSTRAP', | ||||
|   dependencies : [m_dep, dl_dep, thread_dep, android_spawn_dep], | ||||
|   dependencies : janet_native_dependencies, | ||||
|   native : true) | ||||
|  | ||||
| # Build janet.c | ||||
| @@ -179,11 +197,6 @@ janetc = custom_target('janetc', | ||||
|     'JANET_PATH', janet_path | ||||
|   ]) | ||||
|  | ||||
| janet_dependencies = [m_dep, dl_dep, android_spawn_dep] | ||||
| if not get_option('single_threaded') | ||||
|   janet_dependencies += thread_dep | ||||
| endif | ||||
|  | ||||
| # Allow building with no shared library | ||||
| if cc.has_argument('-fvisibility=hidden') | ||||
|   lib_cflags = ['-fvisibility=hidden'] | ||||
| @@ -229,7 +242,7 @@ if meson.is_cross_build() | ||||
|   endif | ||||
|   janet_nativeclient = executable('janet-native', janetc, mainclient_src, | ||||
|     include_directories : incdir, | ||||
|     dependencies : janet_dependencies, | ||||
|     dependencies : janet_native_dependencies, | ||||
|     c_args : extra_native_cflags, | ||||
|     native : true) | ||||
| else | ||||
| @@ -249,6 +262,7 @@ test_files = [ | ||||
|   'test/suite-asm.janet', | ||||
|   'test/suite-boot.janet', | ||||
|   'test/suite-buffer.janet', | ||||
|   'test/suite-bundle.janet', | ||||
|   'test/suite-capi.janet', | ||||
|   'test/suite-cfuns.janet', | ||||
|   'test/suite-compile.janet', | ||||
| @@ -256,6 +270,7 @@ test_files = [ | ||||
|   'test/suite-debug.janet', | ||||
|   'test/suite-ev.janet', | ||||
|   'test/suite-ffi.janet', | ||||
|   'test/suite-filewatch.janet', | ||||
|   'test/suite-inttypes.janet', | ||||
|   'test/suite-io.janet', | ||||
|   'test/suite-marsh.janet', | ||||
| @@ -270,6 +285,7 @@ test_files = [ | ||||
|   'test/suite-struct.janet', | ||||
|   'test/suite-symcache.janet', | ||||
|   'test/suite-table.janet', | ||||
|   'test/suite-tuple.janet', | ||||
|   'test/suite-unknown.janet', | ||||
|   'test/suite-value.janet', | ||||
|   'test/suite-vm.janet' | ||||
|   | ||||
| @@ -22,6 +22,7 @@ option('kqueue', type : 'boolean', value : true) | ||||
| option('interpreter_interrupt', type : 'boolean', value : true) | ||||
| option('ffi', type : 'boolean', value : true) | ||||
| option('ffi_jit', type : 'boolean', value : true) | ||||
| option('filewatch', type : 'boolean', value : true) | ||||
|  | ||||
| option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024) | ||||
| option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200) | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -22,7 +22,7 @@ | ||||
|  | ||||
| #include <janet.h> | ||||
| #include <assert.h> | ||||
| #include <stdio.h> | ||||
| #include <string.h> | ||||
| #include <math.h> | ||||
|  | ||||
| #include "tests.h" | ||||
| @@ -35,6 +35,11 @@ int system_test() { | ||||
|     assert(sizeof(void *) == 8); | ||||
| #endif | ||||
|  | ||||
|     /* Check the version defines are self consistent */ | ||||
|     char version_combined[256]; | ||||
|     sprintf(version_combined, "%d.%d.%d%s", JANET_VERSION_MAJOR, JANET_VERSION_MINOR, JANET_VERSION_PATCH, JANET_VERSION_EXTRA); | ||||
|     assert(!strcmp(JANET_VERSION, version_combined)); | ||||
|  | ||||
|     /* Reflexive testing and nanbox testing */ | ||||
|     assert(janet_equals(janet_wrap_nil(), janet_wrap_nil())); | ||||
|     assert(janet_equals(janet_wrap_false(), janet_wrap_false())); | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -4,10 +4,10 @@ | ||||
| #define JANETCONF_H | ||||
|  | ||||
| #define JANET_VERSION_MAJOR 1 | ||||
| #define JANET_VERSION_MINOR 34 | ||||
| #define JANET_VERSION_PATCH 0 | ||||
| #define JANET_VERSION_MINOR 37 | ||||
| #define JANET_VERSION_PATCH 1 | ||||
| #define JANET_VERSION_EXTRA "" | ||||
| #define JANET_VERSION "1.34.0" | ||||
| #define JANET_VERSION "1.37.1" | ||||
|  | ||||
| /* #define JANET_BUILD "local" */ | ||||
|  | ||||
| @@ -29,6 +29,7 @@ | ||||
| /* #define JANET_NO_NET */ | ||||
| /* #define JANET_NO_INT_TYPES */ | ||||
| /* #define JANET_NO_EV */ | ||||
| /* #define JANET_NO_FILEWATCH */ | ||||
| /* #define JANET_NO_REALPATH */ | ||||
| /* #define JANET_NO_SYMLINKS */ | ||||
| /* #define JANET_NO_UMASK */ | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -275,6 +275,31 @@ JANET_CORE_FN(cfun_array_concat, | ||||
|     return janet_wrap_array(array); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_array_join, | ||||
|               "(array/join arr & parts)", | ||||
|               "Join a variable number of arrays and tuples into the first argument, " | ||||
|               "which must be an array. " | ||||
|               "Return the modified array `arr`.") { | ||||
|     int32_t i; | ||||
|     janet_arity(argc, 1, -1); | ||||
|     JanetArray *array = janet_getarray(argv, 0); | ||||
|     for (i = 1; i < argc; i++) { | ||||
|         int32_t j, len = 0; | ||||
|         const Janet *vals = NULL; | ||||
|         if (!janet_indexed_view(argv[i], &vals, &len)) { | ||||
|             janet_panicf("expected indexed type for argument %d, got %v", i, argv[i]); | ||||
|         } | ||||
|         if (array->data == vals) { | ||||
|             int32_t newcount = array->count + len; | ||||
|             janet_array_ensure(array, newcount, 2); | ||||
|             janet_indexed_view(argv[i], &vals, &len); | ||||
|         } | ||||
|         for (j = 0; j < len; j++) | ||||
|             janet_array_push(array, vals[j]); | ||||
|     } | ||||
|     return janet_wrap_array(array); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_array_insert, | ||||
|               "(array/insert arr at & xs)", | ||||
|               "Insert all `xs` into array `arr` at index `at`. `at` should be an integer between " | ||||
| @@ -385,6 +410,7 @@ void janet_lib_array(JanetTable *env) { | ||||
|         JANET_CORE_REG("array/remove", cfun_array_remove), | ||||
|         JANET_CORE_REG("array/trim", cfun_array_trim), | ||||
|         JANET_CORE_REG("array/clear", cfun_array_clear), | ||||
|         JANET_CORE_REG("array/join", cfun_array_join), | ||||
|         JANET_REG_END | ||||
|     }; | ||||
|     janet_core_cfuns_ext(env, NULL, array_cfuns); | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -371,17 +371,15 @@ JANET_CORE_FN(cfun_buffer_push_uint16, | ||||
|     janet_fixarity(argc, 3); | ||||
|     JanetBuffer *buffer = janet_getbuffer(argv, 0); | ||||
|     int reverse = should_reverse_bytes(argv, 1); | ||||
|     union { | ||||
|         uint16_t data; | ||||
|         uint8_t bytes[2]; | ||||
|     } u; | ||||
|     u.data = (uint16_t) janet_getinteger(argv, 2); | ||||
|     uint16_t data = janet_getuinteger16(argv, 2); | ||||
|     uint8_t bytes[sizeof(data)]; | ||||
|     memcpy(bytes, &data, sizeof(bytes)); | ||||
|     if (reverse) { | ||||
|         uint8_t temp = u.bytes[1]; | ||||
|         u.bytes[1] = u.bytes[0]; | ||||
|         u.bytes[0] = temp; | ||||
|         uint8_t temp = bytes[1]; | ||||
|         bytes[1] = bytes[0]; | ||||
|         bytes[0] = temp; | ||||
|     } | ||||
|     janet_buffer_push_u16(buffer, *(uint16_t *) u.bytes); | ||||
|     janet_buffer_push_bytes(buffer, bytes, sizeof(bytes)); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| @@ -392,14 +390,12 @@ JANET_CORE_FN(cfun_buffer_push_uint32, | ||||
|     janet_fixarity(argc, 3); | ||||
|     JanetBuffer *buffer = janet_getbuffer(argv, 0); | ||||
|     int reverse = should_reverse_bytes(argv, 1); | ||||
|     union { | ||||
|         uint32_t data; | ||||
|         uint8_t bytes[4]; | ||||
|     } u; | ||||
|     u.data = (uint32_t) janet_getinteger(argv, 2); | ||||
|     uint32_t data = janet_getuinteger(argv, 2); | ||||
|     uint8_t bytes[sizeof(data)]; | ||||
|     memcpy(bytes, &data, sizeof(bytes)); | ||||
|     if (reverse) | ||||
|         reverse_u32(u.bytes); | ||||
|     janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes); | ||||
|         reverse_u32(bytes); | ||||
|     janet_buffer_push_bytes(buffer, bytes, sizeof(bytes)); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| @@ -410,14 +406,12 @@ JANET_CORE_FN(cfun_buffer_push_uint64, | ||||
|     janet_fixarity(argc, 3); | ||||
|     JanetBuffer *buffer = janet_getbuffer(argv, 0); | ||||
|     int reverse = should_reverse_bytes(argv, 1); | ||||
|     union { | ||||
|         uint64_t data; | ||||
|         uint8_t bytes[8]; | ||||
|     } u; | ||||
|     u.data = (uint64_t) janet_getuinteger64(argv, 2); | ||||
|     uint64_t data = janet_getuinteger64(argv, 2); | ||||
|     uint8_t bytes[sizeof(data)]; | ||||
|     memcpy(bytes, &data, sizeof(bytes)); | ||||
|     if (reverse) | ||||
|         reverse_u64(u.bytes); | ||||
|     janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes); | ||||
|         reverse_u64(bytes); | ||||
|     janet_buffer_push_bytes(buffer, bytes, sizeof(bytes)); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| @@ -428,14 +422,12 @@ JANET_CORE_FN(cfun_buffer_push_float32, | ||||
|     janet_fixarity(argc, 3); | ||||
|     JanetBuffer *buffer = janet_getbuffer(argv, 0); | ||||
|     int reverse = should_reverse_bytes(argv, 1); | ||||
|     union { | ||||
|         float data; | ||||
|         uint8_t bytes[4]; | ||||
|     } u; | ||||
|     u.data = (float) janet_getnumber(argv, 2); | ||||
|     float data = (float) janet_getnumber(argv, 2); | ||||
|     uint8_t bytes[sizeof(data)]; | ||||
|     memcpy(bytes, &data, sizeof(bytes)); | ||||
|     if (reverse) | ||||
|         reverse_u32(u.bytes); | ||||
|     janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes); | ||||
|         reverse_u32(bytes); | ||||
|     janet_buffer_push_bytes(buffer, bytes, sizeof(bytes)); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| @@ -446,14 +438,12 @@ JANET_CORE_FN(cfun_buffer_push_float64, | ||||
|     janet_fixarity(argc, 3); | ||||
|     JanetBuffer *buffer = janet_getbuffer(argv, 0); | ||||
|     int reverse = should_reverse_bytes(argv, 1); | ||||
|     union { | ||||
|         double data; | ||||
|         uint8_t bytes[8]; | ||||
|     } u; | ||||
|     u.data = janet_getnumber(argv, 2); | ||||
|     double data = janet_getnumber(argv, 2); | ||||
|     uint8_t bytes[sizeof(data)]; | ||||
|     memcpy(bytes, &data, sizeof(bytes)); | ||||
|     if (reverse) | ||||
|         reverse_u64(u.bytes); | ||||
|     janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes); | ||||
|         reverse_u64(bytes); | ||||
|     janet_buffer_push_bytes(buffer, bytes, sizeof(bytes)); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -140,7 +140,7 @@ void janet_bytecode_remove_noops(JanetFuncDef *def) { | ||||
|                 /* relative pc is in DS field of instruction */ | ||||
|                 old_jump_target = i + (((int32_t)instr) >> 8); | ||||
|                 new_jump_target = pc_map[old_jump_target]; | ||||
|                 instr += (new_jump_target - old_jump_target + (i - j)) << 8; | ||||
|                 instr += (uint32_t)(new_jump_target - old_jump_target + (i - j)) << 8; | ||||
|                 break; | ||||
|             case JOP_JUMP_IF: | ||||
|             case JOP_JUMP_IF_NIL: | ||||
| @@ -149,7 +149,7 @@ void janet_bytecode_remove_noops(JanetFuncDef *def) { | ||||
|                 /* relative pc is in ES field of instruction */ | ||||
|                 old_jump_target = i + (((int32_t)instr) >> 16); | ||||
|                 new_jump_target = pc_map[old_jump_target]; | ||||
|                 instr += (new_jump_target - old_jump_target + (i - j)) << 16; | ||||
|                 instr += (uint32_t)(new_jump_target - old_jump_target + (i - j)) << 16; | ||||
|                 break; | ||||
|             default: | ||||
|                 break; | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -25,16 +25,19 @@ | ||||
| #include <janet.h> | ||||
| #include "state.h" | ||||
| #include "fiber.h" | ||||
| #include "util.h" | ||||
| #endif | ||||
|  | ||||
| #ifndef JANET_SINGLE_THREADED | ||||
| #ifndef JANET_WINDOWS | ||||
| #include <pthread.h> | ||||
| #else | ||||
| #include <windows.h> | ||||
| #endif | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_WINDOWS | ||||
| #include <windows.h> | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_USE_STDATOMIC | ||||
| #include <stdatomic.h> | ||||
| /* We don't need stdatomic on most compilers since we use compiler builtins for atomic operations. | ||||
| @@ -59,6 +62,13 @@ JANET_NO_RETURN static void janet_top_level_signal(const char *msg) { | ||||
|  | ||||
| void janet_signalv(JanetSignal sig, Janet message) { | ||||
|     if (janet_vm.return_reg != NULL) { | ||||
|         /* Should match logic in janet_call for coercing everything not ok to an error (no awaits, yields, etc.) */ | ||||
|         if (janet_vm.coerce_error && sig != JANET_SIGNAL_OK) { | ||||
|             if (sig != JANET_SIGNAL_ERROR) { | ||||
|                 message = janet_wrap_string(janet_formatc("%v coerced from %s to error", message, janet_signal_names[sig])); | ||||
|             } | ||||
|             sig = JANET_SIGNAL_ERROR; | ||||
|         } | ||||
|         *janet_vm.return_reg = message; | ||||
|         if (NULL != janet_vm.fiber) { | ||||
|             janet_vm.fiber->flags |= JANET_FIBER_DID_LONGJUMP; | ||||
| @@ -303,11 +313,28 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) { | ||||
| uint32_t janet_getuinteger(const Janet *argv, int32_t n) { | ||||
|     Janet x = argv[n]; | ||||
|     if (!janet_checkuint(x)) { | ||||
|         janet_panicf("bad slot #%d, expected 32 bit signed integer, got %v", n, x); | ||||
|         janet_panicf("bad slot #%d, expected 32 bit unsigned integer, got %v", n, x); | ||||
|     } | ||||
|     return janet_unwrap_integer(x); | ||||
|     return (uint32_t) janet_unwrap_number(x); | ||||
| } | ||||
|  | ||||
| int16_t janet_getinteger16(const Janet *argv, int32_t n) { | ||||
|     Janet x = argv[n]; | ||||
|     if (!janet_checkint16(x)) { | ||||
|         janet_panicf("bad slot #%d, expected 16 bit signed integer, got %v", n, x); | ||||
|     } | ||||
|     return (int16_t) janet_unwrap_number(x); | ||||
| } | ||||
|  | ||||
| uint16_t janet_getuinteger16(const Janet *argv, int32_t n) { | ||||
|     Janet x = argv[n]; | ||||
|     if (!janet_checkuint16(x)) { | ||||
|         janet_panicf("bad slot #%d, expected 16 bit unsigned integer, got %v", n, x); | ||||
|     } | ||||
|     return (uint16_t) janet_unwrap_number(x); | ||||
| } | ||||
|  | ||||
|  | ||||
| int64_t janet_getinteger64(const Janet *argv, int32_t n) { | ||||
| #ifdef JANET_INT_TYPES | ||||
|     return janet_unwrap_s64(argv[n]); | ||||
| @@ -446,6 +473,33 @@ void janet_setdyn(const char *name, Janet value) { | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Create a function that when called, returns X. Trivial in Janet, a pain in C. */ | ||||
| JanetFunction *janet_thunk_delay(Janet x) { | ||||
|     static const uint32_t bytecode[] = { | ||||
|         JOP_LOAD_CONSTANT, | ||||
|         JOP_RETURN | ||||
|     }; | ||||
|     JanetFuncDef *def = janet_funcdef_alloc(); | ||||
|     def->arity = 0; | ||||
|     def->min_arity = 0; | ||||
|     def->max_arity = INT32_MAX; | ||||
|     def->flags = JANET_FUNCDEF_FLAG_VARARG; | ||||
|     def->slotcount = 1; | ||||
|     def->bytecode = janet_malloc(sizeof(bytecode)); | ||||
|     def->bytecode_length = (int32_t)(sizeof(bytecode) / sizeof(uint32_t)); | ||||
|     def->constants = janet_malloc(sizeof(Janet)); | ||||
|     def->constants_length = 1; | ||||
|     def->name = NULL; | ||||
|     if (!def->bytecode || !def->constants) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
|     def->constants[0] = x; | ||||
|     memcpy(def->bytecode, bytecode, sizeof(bytecode)); | ||||
|     janet_def_addflags(def); | ||||
|     /* janet_verify(def); */ | ||||
|     return janet_thunk(def); | ||||
| } | ||||
|  | ||||
| uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) { | ||||
|     uint64_t ret = 0; | ||||
|     const uint8_t *keyw = janet_getkeyword(argv, n); | ||||
| @@ -501,8 +555,8 @@ void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetA | ||||
| /* Atomic refcounts */ | ||||
|  | ||||
| JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     return InterlockedIncrement(x); | ||||
| #ifdef _MSC_VER | ||||
|     return _InterlockedIncrement(x); | ||||
| #elif defined(JANET_USE_STDATOMIC) | ||||
|     return atomic_fetch_add_explicit(x, 1, memory_order_relaxed) + 1; | ||||
| #else | ||||
| @@ -511,8 +565,8 @@ JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) { | ||||
| } | ||||
|  | ||||
| JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     return InterlockedDecrement(x); | ||||
| #ifdef _MSC_VER | ||||
|     return _InterlockedDecrement(x); | ||||
| #elif defined(JANET_USE_STDATOMIC) | ||||
|     return atomic_fetch_add_explicit(x, -1, memory_order_acq_rel) - 1; | ||||
| #else | ||||
| @@ -521,8 +575,8 @@ JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) { | ||||
| } | ||||
|  | ||||
| JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     return InterlockedOr(x, 0); | ||||
| #ifdef _MSC_VER | ||||
|     return _InterlockedOr(x, 0); | ||||
| #elif defined(JANET_USE_STDATOMIC) | ||||
|     return atomic_load_explicit(x, memory_order_acquire); | ||||
| #else | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -934,7 +934,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) { | ||||
|         int32_t slotchunks = (def->slotcount + 31) >> 5; | ||||
|         /* numchunks is min of slotchunks and scope->ua.count */ | ||||
|         int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks; | ||||
|         uint32_t *chunks = janet_calloc(1, slotchunks * sizeof(uint32_t)); | ||||
|         uint32_t *chunks = janet_calloc(slotchunks, sizeof(uint32_t)); | ||||
|         if (NULL == chunks) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
| @@ -1056,7 +1056,7 @@ JanetCompileResult janet_compile_lint(Janet source, | ||||
|  | ||||
|     if (c.result.status == JANET_COMPILE_OK) { | ||||
|         JanetFuncDef *def = janetc_pop_funcdef(&c); | ||||
|         def->name = janet_cstring("_thunk"); | ||||
|         def->name = janet_cstring("thunk"); | ||||
|         janet_def_addflags(def); | ||||
|         c.result.funcdef = def; | ||||
|     } else { | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -262,7 +262,7 @@ void janetc_popscope(JanetCompiler *c); | ||||
| void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot); | ||||
| JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c); | ||||
|  | ||||
| /* Create a destory slots */ | ||||
| /* Create a destroy slot */ | ||||
| JanetSlot janetc_cslot(Janet x); | ||||
|  | ||||
| /* Search for a symbol */ | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -432,27 +432,38 @@ JANET_CORE_FN(janet_core_range, | ||||
|               "With one argument, returns a range [0, end). With two arguments, returns " | ||||
|               "a range [start, end). With three, returns a range with optional step size.") { | ||||
|     janet_arity(argc, 1, 3); | ||||
|     int32_t start = 0, stop = 0, step = 1, count = 0; | ||||
|     double start = 0, stop = 0, step = 1, count = 0; | ||||
|     if (argc == 3) { | ||||
|         start = janet_getinteger(argv, 0); | ||||
|         stop = janet_getinteger(argv, 1); | ||||
|         step = janet_getinteger(argv, 2); | ||||
|         count = (step > 0) ? (stop - start - 1) / step + 1 : | ||||
|                 ((step < 0) ? (stop - start + 1) / step + 1 : 0); | ||||
|         start = janet_getnumber(argv, 0); | ||||
|         stop = janet_getnumber(argv, 1); | ||||
|         step = janet_getnumber(argv, 2); | ||||
|         count = (step > 0) ? (stop - start) / step : | ||||
|                 ((step < 0) ? (stop - start) / step : 0); | ||||
|     } else if (argc == 2) { | ||||
|         start = janet_getinteger(argv, 0); | ||||
|         stop = janet_getinteger(argv, 1); | ||||
|         start = janet_getnumber(argv, 0); | ||||
|         stop = janet_getnumber(argv, 1); | ||||
|         count = stop - start; | ||||
|     } else { | ||||
|         stop = janet_getinteger(argv, 0); | ||||
|         stop = janet_getnumber(argv, 0); | ||||
|         count = stop; | ||||
|     } | ||||
|     count = (count > 0) ? count : 0; | ||||
|     JanetArray *array = janet_array(count); | ||||
|     for (int32_t i = 0; i < count; i++) { | ||||
|         array->data[i] = janet_wrap_number(start + i * step); | ||||
|     int32_t int_count; | ||||
|     if (count > (double) INT32_MAX) { | ||||
|         int_count = INT32_MAX; | ||||
|     } else { | ||||
|         int_count = (int32_t) ceil(count); | ||||
|     } | ||||
|     array->count = count; | ||||
|     if (step > 0.0) { | ||||
|         janet_assert(start + int_count * step >= stop, "bad range code"); | ||||
|     } else { | ||||
|         janet_assert(start + int_count * step <= stop, "bad range code"); | ||||
|     } | ||||
|     JanetArray *array = janet_array(int_count); | ||||
|     for (int32_t i = 0; i < int_count; i++) { | ||||
|         array->data[i] = janet_wrap_number((double) start + (double) i * step); | ||||
|     } | ||||
|     array->count = int_count; | ||||
|     return janet_wrap_array(array); | ||||
| } | ||||
|  | ||||
| @@ -689,7 +700,15 @@ JANET_CORE_FN(janet_core_is_lengthable, | ||||
|  | ||||
| JANET_CORE_FN(janet_core_signal, | ||||
|               "(signal what x)", | ||||
|               "Raise a signal with payload x. ") { | ||||
|               "Raise a signal with payload x. `what` can be an integer\n" | ||||
|               "from 0 through 7 indicating user(0-7), or one of:\n\n" | ||||
|               "* :ok\n" | ||||
|               "* :error\n" | ||||
|               "* :debug\n" | ||||
|               "* :yield\n" | ||||
|               "* :user(0-7)\n" | ||||
|               "* :interrupt\n" | ||||
|               "* :await") { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     Janet payload = argc == 2 ? argv[1] : janet_wrap_nil(); | ||||
|     if (janet_checkint(argv[0])) { | ||||
| @@ -976,18 +995,18 @@ static void make_apply(JanetTable *env) { | ||||
|         /* Push the array */ | ||||
|         S(JOP_PUSH_ARRAY, 5), | ||||
|  | ||||
|         /* Call the funciton */ | ||||
|         /* Call the function */ | ||||
|         S(JOP_TAILCALL, 0) | ||||
|     }; | ||||
|     janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG, | ||||
|                     "apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm), | ||||
|                     JDOC("(apply f & args)\n\n" | ||||
|                          "Applies a function to a variable number of arguments. Each element in args " | ||||
|                          "is used as an argument to f, except the last element in args, which is expected to " | ||||
|                          "be an array-like. Each element in this last argument is then also pushed as an argument to " | ||||
|                          "f. For example:\n\n" | ||||
|                          "\t(apply + 1000 (range 10))\n\n" | ||||
|                          "sums the first 10 integers and 1000.")); | ||||
|          "Applies a function to a variable number of arguments. Each element in args " | ||||
|          "is used as an argument to f, except the last element in args, which is expected to " | ||||
|          "be an array-like. Each element in this last argument is then also pushed as an argument to " | ||||
|          "f. For example:\n\n" | ||||
|          "\t(apply + 1000 (range 10))\n\n" | ||||
|          "sums the first 10 integers and 1000.")); | ||||
| } | ||||
|  | ||||
| static const uint32_t error_asm[] = { | ||||
| @@ -1121,6 +1140,9 @@ static void janet_load_libs(JanetTable *env) { | ||||
| #endif | ||||
| #ifdef JANET_EV | ||||
|     janet_lib_ev(env); | ||||
| #ifdef JANET_FILEWATCH | ||||
|     janet_lib_filewatch(env); | ||||
| #endif | ||||
| #endif | ||||
| #ifdef JANET_NET | ||||
|     janet_lib_net(env); | ||||
| @@ -1137,82 +1159,82 @@ JanetTable *janet_core_env(JanetTable *replacements) { | ||||
|     janet_quick_asm(env, JANET_FUN_CMP, | ||||
|                     "cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm), | ||||
|                     JDOC("(cmp x y)\n\n" | ||||
|                          "Returns -1 if x is strictly less than y, 1 if y is strictly greater " | ||||
|                          "than x, and 0 otherwise. To return 0, x and y must be the exact same type.")); | ||||
|          "Returns -1 if x is strictly less than y, 1 if y is strictly greater " | ||||
|          "than x, and 0 otherwise. To return 0, x and y must be the exact same type.")); | ||||
|     janet_quick_asm(env, JANET_FUN_NEXT, | ||||
|                     "next", 2, 1, 2, 2, next_asm, sizeof(next_asm), | ||||
|                     JDOC("(next ds &opt key)\n\n" | ||||
|                          "Gets the next key in a data structure. Can be used to iterate through " | ||||
|                          "the keys of a data structure in an unspecified order. Keys are guaranteed " | ||||
|                          "to be seen only once per iteration if the data structure is not mutated " | ||||
|                          "during iteration. If key is nil, next returns the first key. If next " | ||||
|                          "returns nil, there are no more keys to iterate through.")); | ||||
|          "Gets the next key in a data structure. Can be used to iterate through " | ||||
|          "the keys of a data structure in an unspecified order. Keys are guaranteed " | ||||
|          "to be seen only once per iteration if the data structure is not mutated " | ||||
|          "during iteration. If key is nil, next returns the first key. If next " | ||||
|          "returns nil, there are no more keys to iterate through.")); | ||||
|     janet_quick_asm(env, JANET_FUN_PROP, | ||||
|                     "propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm), | ||||
|                     JDOC("(propagate x fiber)\n\n" | ||||
|                          "Propagate a signal from a fiber to the current fiber and " | ||||
|                          "set the last value of the current fiber to `x`.  The signal " | ||||
|                          "value is then available as the status of the current fiber. " | ||||
|                          "The resulting stack trace from the current fiber will include " | ||||
|                          "frames from fiber. If fiber is in a state that can be resumed, " | ||||
|                          "resuming the current fiber will first resume `fiber`. " | ||||
|                          "This function can be used to re-raise an error without losing " | ||||
|                          "the original stack trace.")); | ||||
|          "Propagate a signal from a fiber to the current fiber and " | ||||
|          "set the last value of the current fiber to `x`.  The signal " | ||||
|          "value is then available as the status of the current fiber. " | ||||
|          "The resulting stack trace from the current fiber will include " | ||||
|          "frames from fiber. If fiber is in a state that can be resumed, " | ||||
|          "resuming the current fiber will first resume `fiber`. " | ||||
|          "This function can be used to re-raise an error without losing " | ||||
|          "the original stack trace.")); | ||||
|     janet_quick_asm(env, JANET_FUN_DEBUG, | ||||
|                     "debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm), | ||||
|                     JDOC("(debug &opt x)\n\n" | ||||
|                          "Throws a debug signal that can be caught by a parent fiber and used to inspect " | ||||
|                          "the running state of the current fiber. Returns the value passed in by resume.")); | ||||
|          "Throws a debug signal that can be caught by a parent fiber and used to inspect " | ||||
|          "the running state of the current fiber. Returns the value passed in by resume.")); | ||||
|     janet_quick_asm(env, JANET_FUN_ERROR, | ||||
|                     "error", 1, 1, 1, 1, error_asm, sizeof(error_asm), | ||||
|                     JDOC("(error e)\n\n" | ||||
|                          "Throws an error e that can be caught and handled by a parent fiber.")); | ||||
|          "Throws an error e that can be caught and handled by a parent fiber.")); | ||||
|     janet_quick_asm(env, JANET_FUN_YIELD, | ||||
|                     "yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm), | ||||
|                     JDOC("(yield &opt x)\n\n" | ||||
|                          "Yield a value to a parent fiber. When a fiber yields, its execution is paused until " | ||||
|                          "another thread resumes it. The fiber will then resume, and the last yield call will " | ||||
|                          "return the value that was passed to resume.")); | ||||
|          "Yield a value to a parent fiber. When a fiber yields, its execution is paused until " | ||||
|          "another thread resumes it. The fiber will then resume, and the last yield call will " | ||||
|          "return the value that was passed to resume.")); | ||||
|     janet_quick_asm(env, JANET_FUN_CANCEL, | ||||
|                     "cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm), | ||||
|                     JDOC("(cancel fiber err)\n\n" | ||||
|                          "Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. " | ||||
|                          "Returns the same result as resume.")); | ||||
|          "Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. " | ||||
|          "Returns the same result as resume.")); | ||||
|     janet_quick_asm(env, JANET_FUN_RESUME, | ||||
|                     "resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm), | ||||
|                     JDOC("(resume fiber &opt x)\n\n" | ||||
|                          "Resume a new or suspended fiber and optionally pass in a value to the fiber that " | ||||
|                          "will be returned to the last yield in the case of a pending fiber, or the argument to " | ||||
|                          "the dispatch function in the case of a new fiber. Returns either the return result of " | ||||
|                          "the fiber's dispatch function, or the value from the next yield call in fiber.")); | ||||
|          "Resume a new or suspended fiber and optionally pass in a value to the fiber that " | ||||
|          "will be returned to the last yield in the case of a pending fiber, or the argument to " | ||||
|          "the dispatch function in the case of a new fiber. Returns either the return result of " | ||||
|          "the fiber's dispatch function, or the value from the next yield call in fiber.")); | ||||
|     janet_quick_asm(env, JANET_FUN_IN, | ||||
|                     "in", 3, 2, 3, 4, in_asm, sizeof(in_asm), | ||||
|                     JDOC("(in ds key &opt dflt)\n\n" | ||||
|                          "Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, " | ||||
|                          "strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, " | ||||
|                          "and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can " | ||||
|                          "take any value as a key except nil and will return nil or dflt if not found.")); | ||||
|          "Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, " | ||||
|          "strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, " | ||||
|          "and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can " | ||||
|          "take any value as a key except nil and will return nil or dflt if not found.")); | ||||
|     janet_quick_asm(env, JANET_FUN_GET, | ||||
|                     "get", 3, 2, 3, 4, get_asm, sizeof(in_asm), | ||||
|                     JDOC("(get ds key &opt dflt)\n\n" | ||||
|                          "Get the value mapped to key in data structure ds, and return dflt or nil if not found. " | ||||
|                          "Similar to in, but will not throw an error if the key is invalid for the data structure " | ||||
|                          "unless the data structure is an abstract type. In that case, the abstract type getter may throw " | ||||
|                          "an error.")); | ||||
|          "Get the value mapped to key in data structure ds, and return dflt or nil if not found. " | ||||
|          "Similar to in, but will not throw an error if the key is invalid for the data structure " | ||||
|          "unless the data structure is an abstract type. In that case, the abstract type getter may throw " | ||||
|          "an error.")); | ||||
|     janet_quick_asm(env, JANET_FUN_PUT, | ||||
|                     "put", 3, 3, 3, 3, put_asm, sizeof(put_asm), | ||||
|                     JDOC("(put ds key value)\n\n" | ||||
|                          "Associate a key with a value in any mutable associative data structure. Indexed data structures " | ||||
|                          "(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds " | ||||
|                          "value is provided. In an array, extra space will be filled with nils, and in a buffer, extra " | ||||
|                          "space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype " | ||||
|                          "will hide the association defined by the prototype, but will not mutate the prototype table. Putting " | ||||
|                          "a value nil into a table will remove the key from the table. Returns the data structure ds.")); | ||||
|          "Associate a key with a value in any mutable associative data structure. Indexed data structures " | ||||
|          "(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds " | ||||
|          "value is provided. In an array, extra space will be filled with nils, and in a buffer, extra " | ||||
|          "space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype " | ||||
|          "will hide the association defined by the prototype, but will not mutate the prototype table. Putting " | ||||
|          "a value nil into a table will remove the key from the table. Returns the data structure ds.")); | ||||
|     janet_quick_asm(env, JANET_FUN_LENGTH, | ||||
|                     "length", 1, 1, 1, 1, length_asm, sizeof(length_asm), | ||||
|                     JDOC("(length ds)\n\n" | ||||
|                          "Returns the length or count of a data structure in constant time as an integer. For " | ||||
|                          "structs and tables, returns the number of key-value pairs in the data structure.")); | ||||
|          "Returns the length or count of a data structure in constant time as an integer. For " | ||||
|          "structs and tables, returns the number of key-value pairs in the data structure.")); | ||||
|     janet_quick_asm(env, JANET_FUN_BNOT, | ||||
|                     "bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm), | ||||
|                     JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x.")); | ||||
| @@ -1221,74 +1243,74 @@ JanetTable *janet_core_env(JanetTable *replacements) { | ||||
|     /* Variadic ops */ | ||||
|     templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD, | ||||
|                      JDOC("(+ & xs)\n\n" | ||||
|                           "Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0.")); | ||||
|          "Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0.")); | ||||
|     templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT, | ||||
|                      JDOC("(- & xs)\n\n" | ||||
|                           "Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the " | ||||
|                           "negative value of that element. Otherwise, returns the first element in xs minus the sum of " | ||||
|                           "the rest of the elements.")); | ||||
|          "Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the " | ||||
|          "negative value of that element. Otherwise, returns the first element in xs minus the sum of " | ||||
|          "the rest of the elements.")); | ||||
|     templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY, | ||||
|                      JDOC("(* & xs)\n\n" | ||||
|                           "Returns the product of all elements in xs. If xs is empty, returns 1.")); | ||||
|          "Returns the product of all elements in xs. If xs is empty, returns 1.")); | ||||
|     templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE, | ||||
|                      JDOC("(/ & xs)\n\n" | ||||
|                           "Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns " | ||||
|                           "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " | ||||
|                           "values.")); | ||||
|          "Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns " | ||||
|          "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " | ||||
|          "values.")); | ||||
|     templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR, | ||||
|                      JDOC("(div & xs)\n\n" | ||||
|                           "Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns " | ||||
|                           "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " | ||||
|                           "values.")); | ||||
|          "Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns " | ||||
|          "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " | ||||
|          "values.")); | ||||
|     templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO, | ||||
|                      JDOC("(mod & xs)\n\n" | ||||
|                           "Returns the result of applying the modulo operator on the first value of xs with each remaining value. " | ||||
|                           "`(mod x 0)` is defined to be `x`.")); | ||||
|          "Returns the result of applying the modulo operator on the first value of xs with each remaining value. " | ||||
|          "`(mod x 0)` is defined to be `x`.")); | ||||
|     templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER, | ||||
|                      JDOC("(% & xs)\n\n" | ||||
|                           "Returns the remainder of dividing the first value of xs by each remaining value.")); | ||||
|          "Returns the remainder of dividing the first value of xs by each remaining value.")); | ||||
|     templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND, | ||||
|                      JDOC("(band & xs)\n\n" | ||||
|                           "Returns the bit-wise and of all values in xs. Each x in xs must be an integer.")); | ||||
|          "Returns the bit-wise and of all values in xs. Each x in xs must be an integer.")); | ||||
|     templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR, | ||||
|                      JDOC("(bor & xs)\n\n" | ||||
|                           "Returns the bit-wise or of all values in xs. Each x in xs must be an integer.")); | ||||
|          "Returns the bit-wise or of all values in xs. Each x in xs must be an integer.")); | ||||
|     templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR, | ||||
|                      JDOC("(bxor & xs)\n\n" | ||||
|                           "Returns the bit-wise xor of all values in xs. Each in xs must be an integer.")); | ||||
|          "Returns the bit-wise xor of all values in xs. Each in xs must be an integer.")); | ||||
|     templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT, | ||||
|                      JDOC("(blshift x & shifts)\n\n" | ||||
|                           "Returns the value of x bit shifted left by the sum of all values in shifts. x " | ||||
|                           "and each element in shift must be an integer.")); | ||||
|          "Returns the value of x bit shifted left by the sum of all values in shifts. x " | ||||
|          "and each element in shift must be an integer.")); | ||||
|     templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT, | ||||
|                      JDOC("(brshift x & shifts)\n\n" | ||||
|                           "Returns the value of x bit shifted right by the sum of all values in shifts. x " | ||||
|                           "and each element in shift must be an integer.")); | ||||
|          "Returns the value of x bit shifted right by the sum of all values in shifts. x " | ||||
|          "and each element in shift must be an integer.")); | ||||
|     templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED, | ||||
|                      JDOC("(brushift x & shifts)\n\n" | ||||
|                           "Returns the value of x bit shifted right by the sum of all values in shifts. x " | ||||
|                           "and each element in shift must be an integer. The sign of x is not preserved, so " | ||||
|                           "for positive shifts the return value will always be positive.")); | ||||
|          "Returns the value of x bit shifted right by the sum of all values in shifts. x " | ||||
|          "and each element in shift must be an integer. The sign of x is not preserved, so " | ||||
|          "for positive shifts the return value will always be positive.")); | ||||
|  | ||||
|     /* Variadic comparators */ | ||||
|     templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN, | ||||
|                           JDOC("(> & xs)\n\n" | ||||
|                                "Check if xs is in descending order. Returns a boolean.")); | ||||
|          "Check if xs is in descending order. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN, | ||||
|                           JDOC("(< & xs)\n\n" | ||||
|                                "Check if xs is in ascending order. Returns a boolean.")); | ||||
|          "Check if xs is in ascending order. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL, | ||||
|                           JDOC("(>= & xs)\n\n" | ||||
|                                "Check if xs is in non-ascending order. Returns a boolean.")); | ||||
|          "Check if xs is in non-ascending order. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL, | ||||
|                           JDOC("(<= & xs)\n\n" | ||||
|                                "Check if xs is in non-descending order. Returns a boolean.")); | ||||
|          "Check if xs is in non-descending order. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS, | ||||
|                           JDOC("(= & xs)\n\n" | ||||
|                                "Check if all values in xs are equal. Returns a boolean.")); | ||||
|          "Check if all values in xs are equal. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS, | ||||
|                           JDOC("(not= & xs)\n\n" | ||||
|                                "Check if any values in xs are not equal. Returns a boolean.")); | ||||
|          "Check if any values in xs are not equal. Returns a boolean.")); | ||||
|  | ||||
|     /* Platform detection */ | ||||
|     janet_def(env, "janet/version", janet_cstringv(JANET_VERSION), | ||||
| @@ -1297,7 +1319,7 @@ JanetTable *janet_core_env(JanetTable *replacements) { | ||||
|               JDOC("The build identifier of the running janet program.")); | ||||
|     janet_def(env, "janet/config-bits", janet_wrap_integer(JANET_CURRENT_CONFIG_BITS), | ||||
|               JDOC("The flag set of config options from janetconf.h which is used to check " | ||||
|                    "if native modules are compatible with the host program.")); | ||||
|          "if native modules are compatible with the host program.")); | ||||
|  | ||||
|     /* Allow references to the environment */ | ||||
|     janet_def(env, "root-env", janet_wrap_table(env), | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -102,7 +102,7 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) { | ||||
| } | ||||
|  | ||||
| /* Error reporting. This can be emulated from within Janet, but for | ||||
|  * consitency with the top level code it is defined once. */ | ||||
|  * consistency with the top level code it is defined once. */ | ||||
| void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) { | ||||
|  | ||||
|     int32_t fi; | ||||
| @@ -164,7 +164,7 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) { | ||||
|                 } | ||||
|             } | ||||
|             if (frame->flags & JANET_STACKFRAME_TAILCALL) | ||||
|                 janet_eprintf(" (tailcall)"); | ||||
|                 janet_eprintf(" (tail call)"); | ||||
|             if (frame->func && frame->pc) { | ||||
|                 int32_t off = (int32_t)(frame->pc - def->bytecode); | ||||
|                 if (def->sourcemap) { | ||||
| @@ -180,6 +180,11 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) { | ||||
|                 } | ||||
|             } | ||||
|             janet_eprintf("\n"); | ||||
|             /* Print fiber points optionally. Clutters traces but provides info | ||||
|             if (i <= 0 && fi > 0) { | ||||
|                 janet_eprintf("  in parent fiber\n"); | ||||
|             } | ||||
|             */ | ||||
|         } | ||||
|     } | ||||
|  | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
							
								
								
									
										167
									
								
								src/core/ev.c
									
									
									
									
									
								
							
							
						
						
									
										167
									
								
								src/core/ev.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -32,9 +32,11 @@ | ||||
| #ifdef JANET_EV | ||||
|  | ||||
| #include <math.h> | ||||
| #include <fcntl.h> | ||||
| #ifdef JANET_WINDOWS | ||||
| #include <winsock2.h> | ||||
| #include <windows.h> | ||||
| #include <io.h> | ||||
| #else | ||||
| #include <pthread.h> | ||||
| #include <limits.h> | ||||
| @@ -43,7 +45,6 @@ | ||||
| #include <signal.h> | ||||
| #include <sys/ioctl.h> | ||||
| #include <sys/types.h> | ||||
| #include <fcntl.h> | ||||
| #include <netinet/in.h> | ||||
| #include <netinet/tcp.h> | ||||
| #include <netdb.h> | ||||
| @@ -74,7 +75,7 @@ typedef struct { | ||||
|     } mode; | ||||
| } JanetChannelPending; | ||||
|  | ||||
| typedef struct { | ||||
| struct JanetChannel { | ||||
|     JanetQueue items; | ||||
|     JanetQueue read_pending; | ||||
|     JanetQueue write_pending; | ||||
| @@ -86,7 +87,7 @@ typedef struct { | ||||
| #else | ||||
|     pthread_mutex_t lock; | ||||
| #endif | ||||
| } JanetChannel; | ||||
| }; | ||||
|  | ||||
| typedef struct { | ||||
|     JanetFiber *fiber; | ||||
| @@ -255,6 +256,12 @@ static void add_timeout(JanetTimeout to) { | ||||
|  | ||||
| void janet_async_end(JanetFiber *fiber) { | ||||
|     if (fiber->ev_callback) { | ||||
|         if (fiber->ev_stream->read_fiber == fiber) { | ||||
|             fiber->ev_stream->read_fiber = NULL; | ||||
|         } | ||||
|         if (fiber->ev_stream->write_fiber == fiber) { | ||||
|             fiber->ev_stream->write_fiber = NULL; | ||||
|         } | ||||
|         fiber->ev_callback(fiber, JANET_ASYNC_EVENT_DEINIT); | ||||
|         janet_gcunroot(janet_wrap_abstract(fiber->ev_stream)); | ||||
|         fiber->ev_callback = NULL; | ||||
| @@ -276,18 +283,13 @@ void janet_async_in_flight(JanetFiber *fiber) { | ||||
| #endif | ||||
| } | ||||
|  | ||||
| void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) { | ||||
|     JanetFiber *fiber = janet_vm.root_fiber; | ||||
| void janet_async_start_fiber(JanetFiber *fiber, JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) { | ||||
|     janet_assert(!fiber->ev_callback, "double async on fiber"); | ||||
|     if (mode & JANET_ASYNC_LISTEN_READ) { | ||||
|         stream->read_fiber = fiber; | ||||
|     } else { | ||||
|         stream->read_fiber = NULL; | ||||
|     } | ||||
|     if (mode & JANET_ASYNC_LISTEN_WRITE) { | ||||
|         stream->write_fiber = fiber; | ||||
|     } else { | ||||
|         stream->write_fiber = NULL; | ||||
|     } | ||||
|     fiber->ev_callback = callback; | ||||
|     fiber->ev_stream = stream; | ||||
| @@ -295,6 +297,10 @@ void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback | ||||
|     janet_gcroot(janet_wrap_abstract(stream)); | ||||
|     fiber->ev_state = state; | ||||
|     callback(fiber, JANET_ASYNC_EVENT_INIT); | ||||
| } | ||||
|  | ||||
| void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) { | ||||
|     janet_async_start_fiber(janet_vm.root_fiber, stream, mode, callback, state); | ||||
|     janet_await(); | ||||
| } | ||||
|  | ||||
| @@ -320,8 +326,9 @@ static const JanetMethod ev_default_stream_methods[] = { | ||||
| }; | ||||
|  | ||||
| /* Create a stream*/ | ||||
| JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods) { | ||||
|     JanetStream *stream = janet_abstract(&janet_stream_type, sizeof(JanetStream)); | ||||
| JanetStream *janet_stream_ext(JanetHandle handle, uint32_t flags, const JanetMethod *methods, size_t size) { | ||||
|     janet_assert(size >= sizeof(JanetStream), "bad size"); | ||||
|     JanetStream *stream = janet_abstract(&janet_stream_type, size); | ||||
|     stream->handle = handle; | ||||
|     stream->flags = flags; | ||||
|     stream->read_fiber = NULL; | ||||
| @@ -333,6 +340,10 @@ JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod | ||||
|     return stream; | ||||
| } | ||||
|  | ||||
| JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods) { | ||||
|     return janet_stream_ext(handle, flags, methods, sizeof(JanetStream)); | ||||
| } | ||||
|  | ||||
| static void janet_stream_close_impl(JanetStream *stream) { | ||||
|     stream->flags |= JANET_STREAM_CLOSED; | ||||
| #ifdef JANET_WINDOWS | ||||
| @@ -437,7 +448,7 @@ static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) { | ||||
|     } | ||||
|     janet_marshal_int64(ctx, (int64_t)(duph)); | ||||
| #else | ||||
|     /* Marshal after dup becuse it is easier than maintaining our own ref counting. */ | ||||
|     /* Marshal after dup because it is easier than maintaining our own ref counting. */ | ||||
|     int duph = dup(s->handle); | ||||
|     if (duph < 0) janet_panicf("failed to duplicate stream handle: %V", janet_ev_lasterr()); | ||||
|     janet_marshal_int(ctx, (int32_t)(duph)); | ||||
| @@ -473,7 +484,7 @@ static Janet janet_stream_next(void *p, Janet key) { | ||||
| static void janet_stream_tostring(void *p, JanetBuffer *buffer) { | ||||
|     JanetStream *stream = p; | ||||
|     /* Let user print the file descriptor for debugging */ | ||||
|     janet_formatb(buffer, "<core/stream handle=%d>", stream->handle); | ||||
|     janet_formatb(buffer, "[fd=%d]", stream->handle); | ||||
| } | ||||
|  | ||||
| const JanetAbstractType janet_stream_type = { | ||||
| @@ -599,7 +610,7 @@ void janet_ev_deinit_common(void) { | ||||
|  | ||||
| /* Shorthand to yield to event loop */ | ||||
| void janet_await(void) { | ||||
|     /* Store the fiber in a gobal table */ | ||||
|     /* Store the fiber in a global table */ | ||||
|     janet_signalv(JANET_SIGNAL_EVENT, janet_wrap_nil()); | ||||
| } | ||||
|  | ||||
| @@ -615,6 +626,18 @@ void janet_addtimeout(double sec) { | ||||
|     add_timeout(to); | ||||
| } | ||||
|  | ||||
| /* Set timeout for the current root fiber but resume with nil instead of raising an error */ | ||||
| void janet_addtimeout_nil(double sec) { | ||||
|     JanetFiber *fiber = janet_vm.root_fiber; | ||||
|     JanetTimeout to; | ||||
|     to.when = ts_delta(ts_now(), sec); | ||||
|     to.fiber = fiber; | ||||
|     to.curr_fiber = NULL; | ||||
|     to.sched_id = fiber->sched_id; | ||||
|     to.is_error = 0; | ||||
|     add_timeout(to); | ||||
| } | ||||
|  | ||||
| void janet_ev_inc_refcount(void) { | ||||
|     janet_atomic_inc(&janet_vm.listener_count); | ||||
| } | ||||
| @@ -870,7 +893,7 @@ static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode | ||||
|             /* No root fiber, we are in completion on a root fiber. Don't block. */ | ||||
|             if (mode == 2) { | ||||
|                 janet_chan_unlock(channel); | ||||
|                 return 0; | ||||
|                 return 1; | ||||
|             } | ||||
|             /* Pushed successfully, but should block. */ | ||||
|             JanetChannelPending pending; | ||||
| @@ -926,6 +949,7 @@ static int janet_channel_pop_with_lock(JanetChannel *channel, Janet *item, int i | ||||
|     int is_threaded = janet_chan_is_threaded(channel); | ||||
|     if (janet_q_pop(&channel->items, item, sizeof(Janet))) { | ||||
|         /* Queue empty */ | ||||
|         if (is_choice == 2) return 0; // Skip pending read | ||||
|         JanetChannelPending pending; | ||||
|         pending.thread = &janet_vm; | ||||
|         pending.fiber = janet_vm.root_fiber, | ||||
| @@ -983,6 +1007,28 @@ JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_t n, Janet | ||||
|     } | ||||
| } | ||||
|  | ||||
| int janet_channel_give(JanetChannel *channel, Janet x) { | ||||
|     return janet_channel_push(channel, x, 2); | ||||
| } | ||||
|  | ||||
| int janet_channel_take(JanetChannel *channel, Janet *out) { | ||||
|     return janet_channel_pop(channel, out, 2); | ||||
| } | ||||
|  | ||||
| JanetChannel *janet_channel_make(uint32_t limit) { | ||||
|     janet_assert(limit <= INT32_MAX, "bad limit"); | ||||
|     JanetChannel *channel = janet_abstract(&janet_channel_type, sizeof(JanetChannel)); | ||||
|     janet_chan_init(channel, (int32_t) limit, 0); | ||||
|     return channel; | ||||
| } | ||||
|  | ||||
| JanetChannel *janet_channel_make_threaded(uint32_t limit) { | ||||
|     janet_assert(limit <= INT32_MAX, "bad limit"); | ||||
|     JanetChannel *channel = janet_abstract_threaded(&janet_channel_type, sizeof(JanetChannel)); | ||||
|     janet_chan_init(channel, (int32_t) limit, 0); | ||||
|     return channel; | ||||
| } | ||||
|  | ||||
| /* Channel Methods */ | ||||
|  | ||||
| JANET_CORE_FN(cfun_channel_push, | ||||
| @@ -1475,13 +1521,16 @@ void janet_ev_deinit(void) { | ||||
|  | ||||
| static void janet_register_stream(JanetStream *stream) { | ||||
|     if (NULL == CreateIoCompletionPort(stream->handle, janet_vm.iocp, (ULONG_PTR) stream, 0)) { | ||||
|         janet_panicf("failed to listen for events: %V", janet_ev_lasterr()); | ||||
|         if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_WRITABLE | JANET_STREAM_ACCEPTABLE)) { | ||||
|             janet_panicf("failed to listen for events: %V", janet_ev_lasterr()); | ||||
|         } | ||||
|         stream->flags |= JANET_STREAM_UNREGISTERED; | ||||
|     } | ||||
| } | ||||
|  | ||||
| void janet_loop1_impl(int has_timeout, JanetTimestamp to) { | ||||
|     ULONG_PTR completionKey = 0; | ||||
|     DWORD num_bytes_transfered = 0; | ||||
|     DWORD num_bytes_transferred = 0; | ||||
|     LPOVERLAPPED overlapped = NULL; | ||||
|  | ||||
|     /* Calculate how long to wait before timeout */ | ||||
| @@ -1496,7 +1545,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) { | ||||
|     } else { | ||||
|         waittime = INFINITE; | ||||
|     } | ||||
|     BOOL result = GetQueuedCompletionStatus(janet_vm.iocp, &num_bytes_transfered, &completionKey, &overlapped, (DWORD) waittime); | ||||
|     BOOL result = GetQueuedCompletionStatus(janet_vm.iocp, &num_bytes_transferred, &completionKey, &overlapped, (DWORD) waittime); | ||||
|  | ||||
|     if (result || overlapped) { | ||||
|         if (0 == completionKey) { | ||||
| @@ -1519,7 +1568,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) { | ||||
|             if (fiber != NULL) { | ||||
|                 fiber->flags &= ~JANET_FIBER_EV_FLAG_IN_FLIGHT; | ||||
|                 /* System is done with this, we can reused this data */ | ||||
|                 overlapped->InternalHigh = (ULONG_PTR) num_bytes_transfered; | ||||
|                 overlapped->InternalHigh = (ULONG_PTR) num_bytes_transferred; | ||||
|                 fiber->ev_callback(fiber, result ? JANET_ASYNC_EVENT_COMPLETE : JANET_ASYNC_EVENT_FAILED); | ||||
|             } else { | ||||
|                 janet_free((void *) overlapped); | ||||
| @@ -2095,7 +2144,7 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar | ||||
|     int err = pthread_create(&waiter_thread, &janet_vm.new_thread_attr, janet_thread_body, init); | ||||
|     if (err) { | ||||
|         janet_free(init); | ||||
|         janet_panicf("%s", strerror(err)); | ||||
|         janet_panicf("%s", janet_strerror(err)); | ||||
|     } | ||||
| #endif | ||||
|  | ||||
| @@ -2204,7 +2253,7 @@ Janet janet_ev_lasterr(void) { | ||||
| } | ||||
| #else | ||||
| Janet janet_ev_lasterr(void) { | ||||
|     return janet_cstringv(strerror(errno)); | ||||
|     return janet_cstringv(janet_strerror(errno)); | ||||
| } | ||||
| #endif | ||||
|  | ||||
| @@ -2331,6 +2380,7 @@ void ev_callback_read(JanetFiber *fiber, JanetAsyncEvent event) { | ||||
|             } else { | ||||
|                 janet_schedule(fiber, janet_wrap_nil()); | ||||
|             } | ||||
|             stream->read_fiber = NULL; | ||||
|             janet_async_end(fiber); | ||||
|             break; | ||||
|         } | ||||
| @@ -2703,6 +2753,7 @@ static volatile long PipeSerialNumber; | ||||
|  * mode = 0: both sides non-blocking. | ||||
|  * mode = 1: only read side non-blocking: write side sent to subprocess | ||||
|  * mode = 2: only write side non-blocking: read side sent to subprocess | ||||
|  * mode = 3: both sides blocking - for use in two subprocesses (making pipeline from external processes) | ||||
|  */ | ||||
| int janet_make_pipe(JanetHandle handles[2], int mode) { | ||||
| #ifdef JANET_WINDOWS | ||||
| @@ -2716,6 +2767,11 @@ int janet_make_pipe(JanetHandle handles[2], int mode) { | ||||
|     memset(&saAttr, 0, sizeof(saAttr)); | ||||
|     saAttr.nLength = sizeof(saAttr); | ||||
|     saAttr.bInheritHandle = TRUE; | ||||
|     if (mode == 3) { | ||||
|         /* No overlapped IO involved, just call CreatePipe */ | ||||
|         if (!CreatePipe(handles, handles + 1, &saAttr, 0)) return -1; | ||||
|         return 0; | ||||
|     } | ||||
|     sprintf(PipeNameBuffer, | ||||
|             "\\\\.\\Pipe\\JanetPipeFile.%08x.%08x", | ||||
|             (unsigned int) GetCurrentProcessId(), | ||||
| @@ -2761,8 +2817,8 @@ int janet_make_pipe(JanetHandle handles[2], int mode) { | ||||
|     if (pipe(handles)) return -1; | ||||
|     if (mode != 2 && fcntl(handles[0], F_SETFD, FD_CLOEXEC)) goto error; | ||||
|     if (mode != 1 && fcntl(handles[1], F_SETFD, FD_CLOEXEC)) goto error; | ||||
|     if (mode != 2 && fcntl(handles[0], F_SETFL, O_NONBLOCK)) goto error; | ||||
|     if (mode != 1 && fcntl(handles[1], F_SETFL, O_NONBLOCK)) goto error; | ||||
|     if (mode != 2 && mode != 3 && fcntl(handles[0], F_SETFL, O_NONBLOCK)) goto error; | ||||
|     if (mode != 1 && mode != 3 && fcntl(handles[1], F_SETFL, O_NONBLOCK)) goto error; | ||||
|     return 0; | ||||
| error: | ||||
|     close(handles[0]); | ||||
| @@ -2836,7 +2892,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) { | ||||
|             janet_gcroot(janet_wrap_table(janet_vm.abstract_registry)); | ||||
|         } | ||||
|  | ||||
|         /* Get supervsior */ | ||||
|         /* Get supervisor */ | ||||
|         if (flags & JANET_THREAD_SUPERVISOR_FLAG) { | ||||
|             Janet sup = | ||||
|                 janet_unmarshal(nextbytes, endbytes - nextbytes, | ||||
| @@ -3220,6 +3276,64 @@ JANET_CORE_FN(janet_cfun_rwlock_write_release, | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static JanetFile *get_file_for_stream(JanetStream *stream) { | ||||
|     int32_t flags = 0; | ||||
|     char fmt[4] = {0}; | ||||
|     int index = 0; | ||||
|     if (stream->flags & JANET_STREAM_READABLE) { | ||||
|         flags |= JANET_FILE_READ; | ||||
|         janet_sandbox_assert(JANET_SANDBOX_FS_READ); | ||||
|         fmt[index++] = 'r'; | ||||
|     } | ||||
|     if (stream->flags & JANET_STREAM_WRITABLE) { | ||||
|         flags |= JANET_FILE_WRITE; | ||||
|         janet_sandbox_assert(JANET_SANDBOX_FS_WRITE); | ||||
|         int currindex = index; | ||||
|         fmt[index++] = (currindex == 0) ? 'w' : '+'; | ||||
|     } | ||||
|     if (index == 0) return NULL; | ||||
|     /* duplicate handle when converting stream to file */ | ||||
| #ifdef JANET_WINDOWS | ||||
|     int htype = 0; | ||||
|     if (fmt[0] == 'r' && fmt[1] == '+') { | ||||
|         htype = _O_RDWR; | ||||
|     } else if (fmt[0] == 'r') { | ||||
|         htype = _O_RDONLY; | ||||
|     } else if (fmt[0] == 'w') { | ||||
|         htype = _O_WRONLY; | ||||
|     } | ||||
|     int fd = _open_osfhandle((intptr_t) stream->handle, htype); | ||||
|     if (fd < 0) return NULL; | ||||
|     int fd_dup = _dup(fd); | ||||
|     if (fd_dup < 0) return NULL; | ||||
|     FILE *f = _fdopen(fd_dup, fmt); | ||||
|     if (NULL == f) { | ||||
|         _close(fd_dup); | ||||
|         return NULL; | ||||
|     } | ||||
| #else | ||||
|     int fd_dup = dup(stream->handle); | ||||
|     if (fd_dup < 0) return NULL; | ||||
|     FILE *f = fdopen(fd_dup, fmt); | ||||
|     if (NULL == f) { | ||||
|         close(fd_dup); | ||||
|         return NULL; | ||||
|     } | ||||
| #endif | ||||
|     return janet_makejfile(f, flags); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(janet_cfun_to_file, | ||||
|               "(ev/to-file)", | ||||
|               "Create core/file copy of the stream. This value can be used " | ||||
|               "when blocking IO behavior is needed.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
|     JanetFile *iof = get_file_for_stream(stream); | ||||
|     if (iof == NULL) janet_panic("cannot make file from stream"); | ||||
|     return janet_wrap_abstract(iof); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(janet_cfun_ev_all_tasks, | ||||
|               "(ev/all-tasks)", | ||||
|               "Get an array of all active fibers that are being used by the scheduler.") { | ||||
| @@ -3264,6 +3378,7 @@ void janet_lib_ev(JanetTable *env) { | ||||
|         JANET_CORE_REG("ev/acquire-wlock", janet_cfun_rwlock_write_lock), | ||||
|         JANET_CORE_REG("ev/release-rlock", janet_cfun_rwlock_read_release), | ||||
|         JANET_CORE_REG("ev/release-wlock", janet_cfun_rwlock_write_release), | ||||
|         JANET_CORE_REG("ev/to-file", janet_cfun_to_file), | ||||
|         JANET_CORE_REG("ev/all-tasks", janet_cfun_ev_all_tasks), | ||||
|         JANET_REG_END | ||||
|     }; | ||||
| @@ -3273,6 +3388,8 @@ void janet_lib_ev(JanetTable *env) { | ||||
|     janet_register_abstract_type(&janet_channel_type); | ||||
|     janet_register_abstract_type(&janet_mutex_type); | ||||
|     janet_register_abstract_type(&janet_rwlock_type); | ||||
|  | ||||
|     janet_lib_filewatch(env); | ||||
| } | ||||
|  | ||||
| #endif | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -76,4 +76,6 @@ | ||||
| #define __BSD_VISIBLE 1 | ||||
| #endif | ||||
|  | ||||
| #define _FILE_OFFSET_BITS 64 | ||||
|  | ||||
| #endif | ||||
|   | ||||
							
								
								
									
										316
									
								
								src/core/ffi.c
									
									
									
									
									
								
							
							
						
						
									
										316
									
								
								src/core/ffi.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -56,6 +56,9 @@ | ||||
| #if (defined(__x86_64__) || defined(_M_X64)) && !defined(JANET_WINDOWS) | ||||
| #define JANET_FFI_SYSV64_ENABLED | ||||
| #endif | ||||
| #if (defined(__aarch64__) || defined(_M_ARM64)) && !defined(JANET_WINDOWS) | ||||
| #define JANET_FFI_AAPCS64_ENABLED | ||||
| #endif | ||||
|  | ||||
| typedef struct JanetFFIType JanetFFIType; | ||||
| typedef struct JanetFFIStruct JanetFFIStruct; | ||||
| @@ -140,7 +143,13 @@ typedef enum { | ||||
|     JANET_WIN64_REGISTER, | ||||
|     JANET_WIN64_STACK, | ||||
|     JANET_WIN64_REGISTER_REF, | ||||
|     JANET_WIN64_STACK_REF | ||||
|     JANET_WIN64_STACK_REF, | ||||
|     JANET_AAPCS64_GENERAL, | ||||
|     JANET_AAPCS64_SSE, | ||||
|     JANET_AAPCS64_GENERAL_REF, | ||||
|     JANET_AAPCS64_STACK, | ||||
|     JANET_AAPCS64_STACK_REF, | ||||
|     JANET_AAPCS64_NONE | ||||
| } JanetFFIWordSpec; | ||||
|  | ||||
| /* Describe how each Janet argument is interpreted in terms of machine words | ||||
| @@ -155,13 +164,16 @@ typedef struct { | ||||
| typedef enum { | ||||
|     JANET_FFI_CC_NONE, | ||||
|     JANET_FFI_CC_SYSV_64, | ||||
|     JANET_FFI_CC_WIN_64 | ||||
|     JANET_FFI_CC_WIN_64, | ||||
|     JANET_FFI_CC_AAPCS64 | ||||
| } JanetFFICallingConvention; | ||||
|  | ||||
| #ifdef JANET_FFI_WIN64_ENABLED | ||||
| #define JANET_FFI_CC_DEFAULT JANET_FFI_CC_WIN_64 | ||||
| #elif defined(JANET_FFI_SYSV64_ENABLED) | ||||
| #define JANET_FFI_CC_DEFAULT JANET_FFI_CC_SYSV_64 | ||||
| #elif defined(JANET_FFI_AAPCS64_ENABLED) | ||||
| #define JANET_FFI_CC_DEFAULT JANET_FFI_CC_AAPCS64 | ||||
| #else | ||||
| #define JANET_FFI_CC_DEFAULT JANET_FFI_CC_NONE | ||||
| #endif | ||||
| @@ -301,6 +313,9 @@ static JanetFFICallingConvention decode_ffi_cc(const uint8_t *name) { | ||||
| #endif | ||||
| #ifdef JANET_FFI_SYSV64_ENABLED | ||||
|     if (!janet_cstrcmp(name, "sysv64")) return JANET_FFI_CC_SYSV_64; | ||||
| #endif | ||||
| #ifdef JANET_FFI_AAPCS64_ENABLED | ||||
|     if (!janet_cstrcmp(name, "aapcs64")) return JANET_FFI_CC_AAPCS64; | ||||
| #endif | ||||
|     if (!janet_cstrcmp(name, "default")) return JANET_FFI_CC_DEFAULT; | ||||
|     janet_panicf("unknown calling convention %s", name); | ||||
| @@ -385,7 +400,7 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) { | ||||
|  | ||||
|     JanetFFIStruct *st = janet_abstract(&janet_struct_type, | ||||
|                                         sizeof(JanetFFIStruct) + argc * sizeof(JanetFFIStructMember)); | ||||
|     st->field_count = member_count; | ||||
|     st->field_count = 0; | ||||
|     st->size = 0; | ||||
|     st->align = 1; | ||||
|     if (argc == 0) { | ||||
| @@ -403,6 +418,7 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) { | ||||
|         st->fields[i].type = decode_ffi_type(argv[j]); | ||||
|         size_t el_size = type_size(st->fields[i].type); | ||||
|         size_t el_align = type_align(st->fields[i].type); | ||||
|         if (el_align <= 0) janet_panicf("bad field type %V", argv[j]); | ||||
|         if (all_packed || pack_one) { | ||||
|             if (st->size % el_align != 0) is_aligned = 0; | ||||
|             st->fields[i].offset = st->size; | ||||
| @@ -418,6 +434,7 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) { | ||||
|     st->size += (st->align - 1); | ||||
|     st->size /= st->align; | ||||
|     st->size *= st->align; | ||||
|     st->field_count = member_count; | ||||
|     return st; | ||||
| } | ||||
|  | ||||
| @@ -475,7 +492,7 @@ JANET_CORE_FN(cfun_ffi_align, | ||||
| static void *janet_ffi_getpointer(const Janet *argv, int32_t n) { | ||||
|     switch (janet_type(argv[n])) { | ||||
|         default: | ||||
|             janet_panicf("bad slot #%d, expected ffi pointer convertable type, got %v", n, argv[n]); | ||||
|             janet_panicf("bad slot #%d, expected ffi pointer convertible type, got %v", n, argv[n]); | ||||
|         case JANET_POINTER: | ||||
|         case JANET_STRING: | ||||
|         case JANET_KEYWORD: | ||||
| @@ -763,6 +780,101 @@ static JanetFFIWordSpec sysv64_classify(JanetFFIType type) { | ||||
| } | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_FFI_AAPCS64_ENABLED | ||||
| /* Procedure Call Standard for the Arm® 64-bit Architecture (AArch64) 2023Q3 – October 6, 2023 | ||||
|  * See section 6.8.2 Parameter passing rules. | ||||
|  * https://github.com/ARM-software/abi-aa/releases/download/2023Q3/aapcs64.pdf | ||||
|  * | ||||
|  * Additional documentation needed for Apple platforms. | ||||
|  * https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms */ | ||||
|  | ||||
| #define JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ptr, alignment) (ptr = ((ptr) + ((alignment) - 1)) & ~((alignment) - 1)) | ||||
| #if !defined(JANET_APPLE) | ||||
| #define JANET_FFI_AAPCS64_STACK_ALIGN(ptr, alignment) ((void) alignment, JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ptr, 8)) | ||||
| #else | ||||
| #define JANET_FFI_AAPCS64_STACK_ALIGN(ptr, alignment) JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ptr, alignment) | ||||
| #endif | ||||
|  | ||||
| typedef struct { | ||||
|     uint64_t a; | ||||
|     uint64_t b; | ||||
| } Aapcs64Variant1ReturnGeneral; | ||||
|  | ||||
| typedef struct { | ||||
|     double a; | ||||
|     double b; | ||||
|     double c; | ||||
|     double d; | ||||
| } Aapcs64Variant2ReturnSse; | ||||
|  | ||||
| /* Workaround for passing a return value pointer through x8. | ||||
|  * Limits struct returns to 128 bytes. */ | ||||
| typedef struct { | ||||
|     uint64_t a; | ||||
|     uint64_t b; | ||||
|     uint64_t c; | ||||
|     uint64_t d; | ||||
|     uint64_t e; | ||||
|     uint64_t f; | ||||
|     uint64_t g; | ||||
|     uint64_t h; | ||||
|     uint64_t i; | ||||
|     uint64_t j; | ||||
|     uint64_t k; | ||||
|     uint64_t l; | ||||
|     uint64_t m; | ||||
|     uint64_t n; | ||||
|     uint64_t o; | ||||
|     uint64_t p; | ||||
| } Aapcs64Variant3ReturnPointer; | ||||
|  | ||||
| static JanetFFIWordSpec aapcs64_classify(JanetFFIType type) { | ||||
|     switch (type.prim) { | ||||
|         case JANET_FFI_TYPE_PTR: | ||||
|         case JANET_FFI_TYPE_STRING: | ||||
|         case JANET_FFI_TYPE_BOOL: | ||||
|         case JANET_FFI_TYPE_INT8: | ||||
|         case JANET_FFI_TYPE_INT16: | ||||
|         case JANET_FFI_TYPE_INT32: | ||||
|         case JANET_FFI_TYPE_INT64: | ||||
|         case JANET_FFI_TYPE_UINT8: | ||||
|         case JANET_FFI_TYPE_UINT16: | ||||
|         case JANET_FFI_TYPE_UINT32: | ||||
|         case JANET_FFI_TYPE_UINT64: | ||||
|             return JANET_AAPCS64_GENERAL; | ||||
|         case JANET_FFI_TYPE_DOUBLE: | ||||
|         case JANET_FFI_TYPE_FLOAT: | ||||
|             return JANET_AAPCS64_SSE; | ||||
|         case JANET_FFI_TYPE_STRUCT: { | ||||
|             JanetFFIStruct *st = type.st; | ||||
|             if (st->field_count <= 4 && aapcs64_classify(st->fields[0].type) == JANET_AAPCS64_SSE) { | ||||
|                 bool is_hfa = true; | ||||
|                 for (uint32_t i = 1; i < st->field_count; i++) { | ||||
|                     if (st->fields[0].type.prim != st->fields[i].type.prim) { | ||||
|                         is_hfa = false; | ||||
|                         break; | ||||
|                     } | ||||
|                 } | ||||
|                 if (is_hfa) { | ||||
|                     return JANET_AAPCS64_SSE; | ||||
|                 } | ||||
|             } | ||||
|  | ||||
|             if (type_size(type) > 16) { | ||||
|                 return JANET_AAPCS64_GENERAL_REF; | ||||
|             } | ||||
|  | ||||
|             return JANET_AAPCS64_GENERAL; | ||||
|         } | ||||
|         case JANET_FFI_TYPE_VOID: | ||||
|             return JANET_AAPCS64_NONE; | ||||
|         default: | ||||
|             janet_panic("nyi"); | ||||
|             return JANET_AAPCS64_NONE; | ||||
|     } | ||||
| } | ||||
| #endif | ||||
|  | ||||
| JANET_CORE_FN(cfun_ffi_signature, | ||||
|               "(ffi/signature calling-convention ret-type & arg-types)", | ||||
|               "Create a function signature object that can be used to make calls " | ||||
| @@ -960,6 +1072,96 @@ JANET_CORE_FN(cfun_ffi_signature, | ||||
|         } | ||||
|         break; | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_FFI_AAPCS64_ENABLED | ||||
|         case JANET_FFI_CC_AAPCS64: { | ||||
|             uint32_t next_general_reg = 0; | ||||
|             uint32_t next_fp_reg = 0; | ||||
|             uint32_t stack_offset = 0; | ||||
|             uint32_t ref_stack_offset = 0; | ||||
|  | ||||
|             JanetFFIWordSpec ret_spec = aapcs64_classify(ret_type); | ||||
|             ret.spec = ret_spec; | ||||
|             if (ret_spec == JANET_AAPCS64_SSE) { | ||||
|                 variant = 1; | ||||
|             } else if (ret_spec == JANET_AAPCS64_GENERAL_REF) { | ||||
|                 if (type_size(ret_type) > sizeof(Aapcs64Variant3ReturnPointer)) { | ||||
|                     janet_panic("return value bigger than supported"); | ||||
|                 } | ||||
|                 variant = 2; | ||||
|             } else { | ||||
|                 variant = 0; | ||||
|             } | ||||
|  | ||||
|             for (uint32_t i = 0; i < arg_count; i++) { | ||||
|                 mappings[i].type = decode_ffi_type(argv[i + 2]); | ||||
|                 mappings[i].spec = aapcs64_classify(mappings[i].type); | ||||
|                 size_t arg_size = type_size(mappings[i].type); | ||||
|  | ||||
|                 switch (mappings[i].spec) { | ||||
|                     case JANET_AAPCS64_GENERAL: { | ||||
|                         bool arg_is_struct = mappings[i].type.prim == JANET_FFI_TYPE_STRUCT; | ||||
|                         uint32_t needed_registers = (arg_size + 7) / 8; | ||||
|                         if (next_general_reg + needed_registers <= 8) { | ||||
|                             mappings[i].offset = next_general_reg; | ||||
|                             next_general_reg += needed_registers; | ||||
|                         } else { | ||||
|                             size_t arg_align = arg_is_struct ? 8 : type_align(mappings[i].type); | ||||
|                             mappings[i].spec = JANET_AAPCS64_STACK; | ||||
|                             mappings[i].offset = JANET_FFI_AAPCS64_STACK_ALIGN(stack_offset, arg_align); | ||||
| #if !defined(JANET_APPLE) | ||||
|                             stack_offset += arg_size > 8 ? arg_size : 8; | ||||
| #else | ||||
|                             stack_offset += arg_size; | ||||
| #endif | ||||
|                             next_general_reg = 8; | ||||
|                         } | ||||
|                         break; | ||||
|                     } | ||||
|                     case JANET_AAPCS64_GENERAL_REF: | ||||
|                         if (next_general_reg < 8) { | ||||
|                             mappings[i].offset = next_general_reg++; | ||||
|                         } else { | ||||
|                             mappings[i].spec = JANET_AAPCS64_STACK_REF; | ||||
|                             mappings[i].offset = JANET_FFI_AAPCS64_STACK_ALIGN(stack_offset, 8); | ||||
|                             stack_offset += 8; | ||||
|                         } | ||||
|                         mappings[i].offset2 = JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ref_stack_offset, 8); | ||||
|                         ref_stack_offset += arg_size; | ||||
|                         break; | ||||
|                     case JANET_AAPCS64_SSE: { | ||||
|                         uint32_t needed_registers = (arg_size + 7) / 8; | ||||
|                         if (next_fp_reg + needed_registers <= 8) { | ||||
|                             mappings[i].offset = next_fp_reg; | ||||
|                             next_fp_reg += needed_registers; | ||||
|                         } else { | ||||
|                             mappings[i].spec = JANET_AAPCS64_STACK; | ||||
|                             mappings[i].offset = JANET_FFI_AAPCS64_STACK_ALIGN(stack_offset, 8); | ||||
| #if !defined(JANET_APPLE) | ||||
|                             stack_offset += 8; | ||||
| #else | ||||
|                             stack_offset += arg_size; | ||||
| #endif | ||||
|                         } | ||||
|                         break; | ||||
|                     } | ||||
|                     default: | ||||
|                         janet_panic("nyi"); | ||||
|                 } | ||||
|             } | ||||
|  | ||||
|             stack_offset = (stack_offset + 15) & ~0xFUL; | ||||
|             ref_stack_offset = (ref_stack_offset + 15) & ~0xFUL; | ||||
|             stack_count = stack_offset + ref_stack_offset; | ||||
|  | ||||
|             for (uint32_t i = 0; i < arg_count; i++) { | ||||
|                 if (mappings[i].spec == JANET_AAPCS64_GENERAL_REF || mappings[i].spec == JANET_AAPCS64_STACK_REF) { | ||||
|                     mappings[i].offset2 = stack_offset + mappings[i].offset2; | ||||
|                 } | ||||
|             } | ||||
|         } | ||||
|         break; | ||||
| #endif | ||||
|     } | ||||
|  | ||||
|     /* Create signature abstract value */ | ||||
| @@ -1294,6 +1496,99 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe | ||||
|  | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_FFI_AAPCS64_ENABLED | ||||
|  | ||||
| static void janet_ffi_aapcs64_standard_callback(void *ctx, void *userdata) { | ||||
|     janet_ffi_trampoline(ctx, userdata); | ||||
| } | ||||
|  | ||||
| typedef Aapcs64Variant1ReturnGeneral janet_aapcs64_variant_1(uint64_t x0, uint64_t x1, uint64_t x2, uint64_t x3, uint64_t x4, uint64_t x5, uint64_t x6, uint64_t x7, | ||||
|         double v0, double v1, double v2, double v3, double v4, double v5, double v6, double v7); | ||||
| typedef Aapcs64Variant2ReturnSse janet_aapcs64_variant_2(uint64_t x0, uint64_t x1, uint64_t x2, uint64_t x3, uint64_t x4, uint64_t x5, uint64_t x6, uint64_t x7, | ||||
|         double v0, double v1, double v2, double v3, double v4, double v5, double v6, double v7); | ||||
| typedef Aapcs64Variant3ReturnPointer janet_aapcs64_variant_3(uint64_t x0, uint64_t x1, uint64_t x2, uint64_t x3, uint64_t x4, uint64_t x5, uint64_t x6, uint64_t x7, | ||||
|         double v0, double v1, double v2, double v3, double v4, double v5, double v6, double v7); | ||||
|  | ||||
|  | ||||
| static Janet janet_ffi_aapcs64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) { | ||||
|     union { | ||||
|         Aapcs64Variant1ReturnGeneral general_return; | ||||
|         Aapcs64Variant2ReturnSse sse_return; | ||||
|         Aapcs64Variant3ReturnPointer pointer_return; | ||||
|     } retu; | ||||
|     uint64_t regs[8]; | ||||
|     double fp_regs[8]; | ||||
|     void *ret_mem = &retu.general_return; | ||||
|  | ||||
|     /* Apple's stack values do not need to be 8-byte aligned, | ||||
|      * thus all stack offsets refer to actual byte positions. */ | ||||
|     uint8_t *stack = alloca(signature->stack_count); | ||||
| #if defined(JANET_APPLE) | ||||
|     /* Values must be zero-extended by the caller instead of the callee. */ | ||||
|     memset(stack, 0, signature->stack_count); | ||||
| #endif | ||||
|     for (uint32_t i = 0; i < signature->arg_count; i++) { | ||||
|         int32_t n = i + 2; | ||||
|         JanetFFIMapping arg = signature->args[i]; | ||||
|         void *to = NULL; | ||||
|  | ||||
|         switch (arg.spec) { | ||||
|             case JANET_AAPCS64_GENERAL: | ||||
|                 to = regs + arg.offset; | ||||
|                 break; | ||||
|             case JANET_AAPCS64_GENERAL_REF: | ||||
|                 to = stack + arg.offset2; | ||||
|                 regs[arg.offset] = (uint64_t) to; | ||||
|                 break; | ||||
|             case JANET_AAPCS64_SSE: | ||||
|                 to = fp_regs + arg.offset; | ||||
|                 break; | ||||
|             case JANET_AAPCS64_STACK: | ||||
|                 to = stack + arg.offset; | ||||
|                 break; | ||||
|             case JANET_AAPCS64_STACK_REF: | ||||
|                 to = stack + arg.offset2; | ||||
|                 uint64_t *ptr = (uint64_t *) stack + arg.offset; | ||||
|                 *ptr = (uint64_t) to; | ||||
|                 break; | ||||
|             default: | ||||
|                 janet_panic("nyi"); | ||||
|         } | ||||
|  | ||||
|         if (to) { | ||||
|             janet_ffi_write_one(to, argv, n, arg.type, JANET_FFI_MAX_RECUR); | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     switch (signature->variant) { | ||||
|         case 0: | ||||
|             retu.general_return = ((janet_aapcs64_variant_1 *)(function_pointer))( | ||||
|                                       regs[0], regs[1], regs[2], regs[3], | ||||
|                                       regs[4], regs[5], regs[6], regs[7], | ||||
|                                       fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3], | ||||
|                                       fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]); | ||||
|             break; | ||||
|         case 1: | ||||
|             retu.sse_return = ((janet_aapcs64_variant_2 *)(function_pointer))( | ||||
|                                   regs[0], regs[1], regs[2], regs[3], | ||||
|                                   regs[4], regs[5], regs[6], regs[7], | ||||
|                                   fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3], | ||||
|                                   fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]); | ||||
|             break; | ||||
|         case 2: { | ||||
|             retu.pointer_return = ((janet_aapcs64_variant_3 *)(function_pointer))( | ||||
|                                       regs[0], regs[1], regs[2], regs[3], | ||||
|                                       regs[4], regs[5], regs[6], regs[7], | ||||
|                                       fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3], | ||||
|                                       fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]); | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     return janet_ffi_read_one(ret_mem, signature->ret.type, JANET_FFI_MAX_RECUR); | ||||
| } | ||||
|  | ||||
| #endif | ||||
|  | ||||
| /* Allocate executable memory chunks in sizes of a page. Ideally we would keep | ||||
|  * an allocator around so that multiple JIT allocations would point to the same | ||||
|  * region but it isn't really worth it. */ | ||||
| @@ -1373,6 +1668,10 @@ JANET_CORE_FN(cfun_ffi_call, | ||||
| #ifdef JANET_FFI_SYSV64_ENABLED | ||||
|         case JANET_FFI_CC_SYSV_64: | ||||
|             return janet_ffi_sysv64(signature, function_pointer, argv); | ||||
| #endif | ||||
| #ifdef JANET_FFI_AAPCS64_ENABLED | ||||
|         case JANET_FFI_CC_AAPCS64: | ||||
|             return janet_ffi_aapcs64(signature, function_pointer, argv); | ||||
| #endif | ||||
|     } | ||||
| } | ||||
| @@ -1442,6 +1741,10 @@ JANET_CORE_FN(cfun_ffi_get_callback_trampoline, | ||||
| #ifdef JANET_FFI_SYSV64_ENABLED | ||||
|         case JANET_FFI_CC_SYSV_64: | ||||
|             return janet_wrap_pointer(janet_ffi_sysv64_standard_callback); | ||||
| #endif | ||||
| #ifdef JANET_FFI_AAPCS64_ENABLED | ||||
|         case JANET_FFI_CC_AAPCS64: | ||||
|             return janet_wrap_pointer(janet_ffi_aapcs64_standard_callback); | ||||
| #endif | ||||
|     } | ||||
| } | ||||
| @@ -1561,6 +1864,9 @@ JANET_CORE_FN(cfun_ffi_supported_calling_conventions, | ||||
| #endif | ||||
| #ifdef JANET_FFI_SYSV64_ENABLED | ||||
|     janet_array_push(array, janet_ckeywordv("sysv64")); | ||||
| #endif | ||||
| #ifdef JANET_FFI_AAPCS64_ENABLED | ||||
|     janet_array_push(array, janet_ckeywordv("aapcs64")); | ||||
| #endif | ||||
|     janet_array_push(array, janet_ckeywordv("none")); | ||||
|     return janet_wrap_array(array); | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
							
								
								
									
										688
									
								
								src/core/filewatch.c
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										688
									
								
								src/core/filewatch.c
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,688 @@ | ||||
| /* | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| * deal in the Software without restriction, including without limitation the | ||||
| * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or | ||||
| * sell copies of the Software, and to permit persons to whom the Software is | ||||
| * furnished to do so, subject to the following conditions: | ||||
| * | ||||
| * The above copyright notice and this permission notice shall be included in | ||||
| * all copies or substantial portions of the Software. | ||||
| * | ||||
| * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | ||||
| * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | ||||
| * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE | ||||
| * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | ||||
| * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | ||||
| * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS | ||||
| * IN THE SOFTWARE. | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "util.h" | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_EV | ||||
| #ifdef JANET_FILEWATCH | ||||
|  | ||||
| #ifdef JANET_LINUX | ||||
| #include <sys/inotify.h> | ||||
| #include <unistd.h> | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_WINDOWS | ||||
| #include <windows.h> | ||||
| #endif | ||||
|  | ||||
| typedef struct { | ||||
|     const char *name; | ||||
|     uint32_t flag; | ||||
| } JanetWatchFlagName; | ||||
|  | ||||
| typedef struct { | ||||
| #ifndef JANET_WINDOWS | ||||
|     JanetStream *stream; | ||||
| #endif | ||||
|     JanetTable *watch_descriptors; | ||||
|     JanetChannel *channel; | ||||
|     uint32_t default_flags; | ||||
|     int is_watching; | ||||
| } JanetWatcher; | ||||
|  | ||||
| #ifdef JANET_LINUX | ||||
|  | ||||
| #include <sys/inotify.h> | ||||
| #include <unistd.h> | ||||
|  | ||||
| static const JanetWatchFlagName watcher_flags_linux[] = { | ||||
|     {"access", IN_ACCESS}, | ||||
|     {"all", IN_ALL_EVENTS}, | ||||
|     {"attrib", IN_ATTRIB}, | ||||
|     {"close-nowrite", IN_CLOSE_NOWRITE}, | ||||
|     {"close-write", IN_CLOSE_WRITE}, | ||||
|     {"create", IN_CREATE}, | ||||
|     {"delete", IN_DELETE}, | ||||
|     {"delete-self", IN_DELETE_SELF}, | ||||
|     {"ignored", IN_IGNORED}, | ||||
|     {"modify", IN_MODIFY}, | ||||
|     {"move-self", IN_MOVE_SELF}, | ||||
|     {"moved-from", IN_MOVED_FROM}, | ||||
|     {"moved-to", IN_MOVED_TO}, | ||||
|     {"open", IN_OPEN}, | ||||
|     {"q-overflow", IN_Q_OVERFLOW}, | ||||
|     {"unmount", IN_UNMOUNT}, | ||||
| }; | ||||
|  | ||||
| static uint32_t decode_watch_flags(const Janet *options, int32_t n) { | ||||
|     uint32_t flags = 0; | ||||
|     for (int32_t i = 0; i < n; i++) { | ||||
|         if (!(janet_checktype(options[i], JANET_KEYWORD))) { | ||||
|             janet_panicf("expected keyword, got %v", options[i]); | ||||
|         } | ||||
|         JanetKeyword keyw = janet_unwrap_keyword(options[i]); | ||||
|         const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_linux, | ||||
|                                            sizeof(watcher_flags_linux) / sizeof(JanetWatchFlagName), | ||||
|                                            sizeof(JanetWatchFlagName), | ||||
|                                            keyw); | ||||
|         if (!result) { | ||||
|             janet_panicf("unknown inotify flag %v", options[i]); | ||||
|         } | ||||
|         flags |= result->flag; | ||||
|     } | ||||
|     return flags; | ||||
| } | ||||
|  | ||||
| static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) { | ||||
|     int fd; | ||||
|     do { | ||||
|         fd = inotify_init1(IN_NONBLOCK | IN_CLOEXEC); | ||||
|     } while (fd == -1 && errno == EINTR); | ||||
|     if (fd == -1) { | ||||
|         janet_panicv(janet_ev_lasterr()); | ||||
|     } | ||||
|     watcher->watch_descriptors = janet_table(0); | ||||
|     watcher->channel = channel; | ||||
|     watcher->default_flags = default_flags; | ||||
|     watcher->is_watching = 0; | ||||
|     watcher->stream = janet_stream(fd, JANET_STREAM_READABLE, NULL); | ||||
| } | ||||
|  | ||||
| static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) { | ||||
|     if (watcher->stream == NULL) janet_panic("watcher closed"); | ||||
|     int result; | ||||
|     do { | ||||
|         result = inotify_add_watch(watcher->stream->handle, path, flags); | ||||
|     } while (result == -1 && errno == EINTR); | ||||
|     if (result == -1) { | ||||
|         janet_panicv(janet_ev_lasterr()); | ||||
|     } | ||||
|     Janet name = janet_cstringv(path); | ||||
|     Janet wd = janet_wrap_integer(result); | ||||
|     janet_table_put(watcher->watch_descriptors, name, wd); | ||||
|     janet_table_put(watcher->watch_descriptors, wd, name); | ||||
| } | ||||
|  | ||||
| static void janet_watcher_remove(JanetWatcher *watcher, const char *path) { | ||||
|     if (watcher->stream == NULL) janet_panic("watcher closed"); | ||||
|     Janet check = janet_table_get(watcher->watch_descriptors, janet_cstringv(path)); | ||||
|     janet_assert(janet_checktype(check, JANET_NUMBER), "bad watch descriptor"); | ||||
|     int watch_handle = janet_unwrap_integer(check); | ||||
|     int result; | ||||
|     do { | ||||
|         result = inotify_rm_watch(watcher->stream->handle, watch_handle); | ||||
|     } while (result != -1 && errno == EINTR); | ||||
|     if (result == -1) { | ||||
|         janet_panicv(janet_ev_lasterr()); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) { | ||||
|     JanetStream *stream = fiber->ev_stream; | ||||
|     JanetWatcher *watcher = *((JanetWatcher **) fiber->ev_state); | ||||
|     char buf[1024]; | ||||
|     switch (event) { | ||||
|         default: | ||||
|             break; | ||||
|         case JANET_ASYNC_EVENT_MARK: | ||||
|             janet_mark(janet_wrap_abstract(watcher)); | ||||
|             break; | ||||
|         case JANET_ASYNC_EVENT_CLOSE: | ||||
|             janet_schedule(fiber, janet_wrap_nil()); | ||||
|             janet_async_end(fiber); | ||||
|             break; | ||||
|         case JANET_ASYNC_EVENT_ERR: { | ||||
|             janet_schedule(fiber, janet_wrap_nil()); | ||||
|             janet_async_end(fiber); | ||||
|             break; | ||||
|         } | ||||
|     read_more: | ||||
|         case JANET_ASYNC_EVENT_HUP: | ||||
|         case JANET_ASYNC_EVENT_INIT: | ||||
|         case JANET_ASYNC_EVENT_READ: { | ||||
|             Janet name = janet_wrap_nil(); | ||||
|  | ||||
|             /* Assumption - read will never return partial events * | ||||
|              * From documentation: | ||||
|              * | ||||
|              * The behavior when the buffer given to read(2) is too small to | ||||
|              * return information about the next event depends on the kernel | ||||
|              * version: before Linux 2.6.21, read(2) returns 0; since Linux | ||||
|              * 2.6.21, read(2) fails with the error EINVAL.  Specifying a buffer | ||||
|              * of size | ||||
|              * | ||||
|              *     sizeof(struct inotify_event) + NAME_MAX + 1 | ||||
|              * | ||||
|              * will be sufficient to read at least one event. */ | ||||
|             ssize_t nread; | ||||
|             do { | ||||
|                 nread = read(stream->handle, buf, sizeof(buf)); | ||||
|             } while (nread == -1 && errno == EINTR); | ||||
|  | ||||
|             /* Check for errors - special case errors that can just be waited on to fix */ | ||||
|             if (nread == -1) { | ||||
|                 if (errno == EAGAIN || errno == EWOULDBLOCK) { | ||||
|                     break; | ||||
|                 } | ||||
|                 janet_cancel(fiber, janet_ev_lasterr()); | ||||
|                 fiber->ev_state = NULL; | ||||
|                 janet_async_end(fiber); | ||||
|                 break; | ||||
|             } | ||||
|             if (nread < (ssize_t) sizeof(struct inotify_event)) break; | ||||
|  | ||||
|             /* Iterate through all events read from the buffer */ | ||||
|             char *cursor = buf; | ||||
|             while (cursor < buf + nread) { | ||||
|                 struct inotify_event inevent; | ||||
|                 memcpy(&inevent, cursor, sizeof(inevent)); | ||||
|                 cursor += sizeof(inevent); | ||||
|                 /* Read path of inevent */ | ||||
|                 if (inevent.len) { | ||||
|                     name = janet_cstringv(cursor); | ||||
|                     cursor += inevent.len; | ||||
|                 } | ||||
|  | ||||
|                 /* Got an event */ | ||||
|                 Janet path = janet_table_get(watcher->watch_descriptors, janet_wrap_integer(inevent.wd)); | ||||
|                 JanetKV *event = janet_struct_begin(6); | ||||
|                 janet_struct_put(event, janet_ckeywordv("wd"), janet_wrap_integer(inevent.wd)); | ||||
|                 janet_struct_put(event, janet_ckeywordv("wd-path"), path); | ||||
|                 if (janet_checktype(name, JANET_NIL)) { | ||||
|                     /* We were watching a file directly, so path is the full path. Split into dirname / basename */ | ||||
|                     JanetString spath = janet_unwrap_string(path); | ||||
|                     const uint8_t *cursor = spath + janet_string_length(spath); | ||||
|                     const uint8_t *cursor_end = cursor; | ||||
|                     while (cursor > spath && cursor[0] != '/') { | ||||
|                         cursor--; | ||||
|                     } | ||||
|                     if (cursor == spath) { | ||||
|                         janet_struct_put(event, janet_ckeywordv("dir-name"), path); | ||||
|                         janet_struct_put(event, janet_ckeywordv("file-name"), name); | ||||
|                     } else { | ||||
|                         janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(janet_string(spath, (cursor - spath)))); | ||||
|                         janet_struct_put(event, janet_ckeywordv("file-name"), janet_wrap_string(janet_string(cursor + 1, (cursor_end - cursor - 1)))); | ||||
|                     } | ||||
|                 } else { | ||||
|                     janet_struct_put(event, janet_ckeywordv("dir-name"), path); | ||||
|                     janet_struct_put(event, janet_ckeywordv("file-name"), name); | ||||
|                 } | ||||
|                 janet_struct_put(event, janet_ckeywordv("cookie"), janet_wrap_integer(inevent.cookie)); | ||||
|                 Janet etype = janet_ckeywordv("type"); | ||||
|                 const JanetWatchFlagName *wfn_end = watcher_flags_linux + sizeof(watcher_flags_linux) / sizeof(watcher_flags_linux[0]); | ||||
|                 for (const JanetWatchFlagName *wfn = watcher_flags_linux; wfn < wfn_end; wfn++) { | ||||
|                     if ((inevent.mask & wfn->flag) == wfn->flag) janet_struct_put(event, etype, janet_ckeywordv(wfn->name)); | ||||
|                 } | ||||
|                 Janet eventv = janet_wrap_struct(janet_struct_end(event)); | ||||
|  | ||||
|                 janet_channel_give(watcher->channel, eventv); | ||||
|             } | ||||
|  | ||||
|             /* Read some more if possible */ | ||||
|             goto read_more; | ||||
|         } | ||||
|         break; | ||||
|     } | ||||
| } | ||||
|  | ||||
| static void janet_watcher_listen(JanetWatcher *watcher) { | ||||
|     if (watcher->is_watching) janet_panic("already watching"); | ||||
|     watcher->is_watching = 1; | ||||
|     JanetFunction *thunk = janet_thunk_delay(janet_wrap_nil()); | ||||
|     JanetFiber *fiber = janet_fiber(thunk, 64, 0, NULL); | ||||
|     JanetWatcher **state = janet_malloc(sizeof(JanetWatcher *)); /* Gross */ | ||||
|     *state = watcher; | ||||
|     janet_async_start_fiber(fiber, watcher->stream, JANET_ASYNC_LISTEN_READ, watcher_callback_read, state); | ||||
|     janet_gcroot(janet_wrap_abstract(watcher)); | ||||
| } | ||||
|  | ||||
| static void janet_watcher_unlisten(JanetWatcher *watcher) { | ||||
|     if (!watcher->is_watching) return; | ||||
|     watcher->is_watching = 0; | ||||
|     janet_stream_close(watcher->stream); | ||||
|     janet_gcunroot(janet_wrap_abstract(watcher)); | ||||
| } | ||||
|  | ||||
| #elif JANET_WINDOWS | ||||
|  | ||||
| #define WATCHFLAG_RECURSIVE 0x100000u | ||||
|  | ||||
| static const JanetWatchFlagName watcher_flags_windows[] = { | ||||
|     { | ||||
|         "all", | ||||
|         FILE_NOTIFY_CHANGE_ATTRIBUTES | | ||||
|         FILE_NOTIFY_CHANGE_CREATION | | ||||
|         FILE_NOTIFY_CHANGE_DIR_NAME | | ||||
|         FILE_NOTIFY_CHANGE_FILE_NAME | | ||||
|         FILE_NOTIFY_CHANGE_LAST_ACCESS | | ||||
|         FILE_NOTIFY_CHANGE_LAST_WRITE | | ||||
|         FILE_NOTIFY_CHANGE_SECURITY | | ||||
|         FILE_NOTIFY_CHANGE_SIZE | | ||||
|         WATCHFLAG_RECURSIVE | ||||
|     }, | ||||
|     {"attributes", FILE_NOTIFY_CHANGE_ATTRIBUTES}, | ||||
|     {"creation", FILE_NOTIFY_CHANGE_CREATION}, | ||||
|     {"dir-name", FILE_NOTIFY_CHANGE_DIR_NAME}, | ||||
|     {"file-name", FILE_NOTIFY_CHANGE_FILE_NAME}, | ||||
|     {"last-access", FILE_NOTIFY_CHANGE_LAST_ACCESS}, | ||||
|     {"last-write", FILE_NOTIFY_CHANGE_LAST_WRITE}, | ||||
|     {"recursive", WATCHFLAG_RECURSIVE}, | ||||
|     {"security", FILE_NOTIFY_CHANGE_SECURITY}, | ||||
|     {"size", FILE_NOTIFY_CHANGE_SIZE}, | ||||
| }; | ||||
|  | ||||
| static uint32_t decode_watch_flags(const Janet *options, int32_t n) { | ||||
|     uint32_t flags = 0; | ||||
|     for (int32_t i = 0; i < n; i++) { | ||||
|         if (!(janet_checktype(options[i], JANET_KEYWORD))) { | ||||
|             janet_panicf("expected keyword, got %v", options[i]); | ||||
|         } | ||||
|         JanetKeyword keyw = janet_unwrap_keyword(options[i]); | ||||
|         const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_windows, | ||||
|                                            sizeof(watcher_flags_windows) / sizeof(JanetWatchFlagName), | ||||
|                                            sizeof(JanetWatchFlagName), | ||||
|                                            keyw); | ||||
|         if (!result) { | ||||
|             janet_panicf("unknown windows filewatch flag %v", options[i]); | ||||
|         } | ||||
|         flags |= result->flag; | ||||
|     } | ||||
|     return flags; | ||||
| } | ||||
|  | ||||
| static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) { | ||||
|     watcher->watch_descriptors = janet_table(0); | ||||
|     watcher->channel = channel; | ||||
|     watcher->default_flags = default_flags; | ||||
|     watcher->is_watching = 0; | ||||
| } | ||||
|  | ||||
| /* Since the file info padding includes embedded file names, we want to include more space for data. | ||||
|  * We also need to handle manually calculating changes if path names are too long, but ideally just avoid | ||||
|  * that scenario as much as possible */ | ||||
| #define FILE_INFO_PADDING (4096 * 4) | ||||
|  | ||||
| typedef struct { | ||||
|     OVERLAPPED overlapped; | ||||
|     JanetStream *stream; | ||||
|     JanetWatcher *watcher; | ||||
|     JanetFiber *fiber; | ||||
|     JanetString dir_path; | ||||
|     uint32_t flags; | ||||
|     uint64_t buf[FILE_INFO_PADDING / sizeof(uint64_t)]; /* Ensure alignment */ | ||||
| } OverlappedWatch; | ||||
|  | ||||
| #define NotifyChange FILE_NOTIFY_INFORMATION | ||||
|  | ||||
| static void read_dir_changes(OverlappedWatch *ow) { | ||||
|     BOOL result = ReadDirectoryChangesW(ow->stream->handle, | ||||
|                                         (NotifyChange *) ow->buf, | ||||
|                                         FILE_INFO_PADDING, | ||||
|                                         (ow->flags & WATCHFLAG_RECURSIVE) ? TRUE : FALSE, | ||||
|                                         ow->flags & ~WATCHFLAG_RECURSIVE, | ||||
|                                         NULL, | ||||
|                                         (OVERLAPPED *) ow, | ||||
|                                         NULL); | ||||
|     if (!result) { | ||||
|         janet_panicv(janet_ev_lasterr()); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static const char *watcher_actions_windows[] = { | ||||
|     "unknown", | ||||
|     "added", | ||||
|     "removed", | ||||
|     "modified", | ||||
|     "renamed-old", | ||||
|     "renamed-new", | ||||
| }; | ||||
|  | ||||
| static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) { | ||||
|     OverlappedWatch *ow = (OverlappedWatch *) fiber->ev_state; | ||||
|     JanetWatcher *watcher = ow->watcher; | ||||
|     switch (event) { | ||||
|         default: | ||||
|             break; | ||||
|         case JANET_ASYNC_EVENT_INIT: | ||||
|             janet_async_in_flight(fiber); | ||||
|             break; | ||||
|         case JANET_ASYNC_EVENT_MARK: | ||||
|             janet_mark(janet_wrap_abstract(ow->stream)); | ||||
|             janet_mark(janet_wrap_fiber(ow->fiber)); | ||||
|             janet_mark(janet_wrap_abstract(watcher)); | ||||
|             janet_mark(janet_wrap_string(ow->dir_path)); | ||||
|             break; | ||||
|         case JANET_ASYNC_EVENT_CLOSE: | ||||
|             janet_table_remove(ow->watcher->watch_descriptors, janet_wrap_string(ow->dir_path)); | ||||
|             break; | ||||
|         case JANET_ASYNC_EVENT_ERR: | ||||
|         case JANET_ASYNC_EVENT_FAILED: | ||||
|             janet_stream_close(ow->stream); | ||||
|             break; | ||||
|         case JANET_ASYNC_EVENT_COMPLETE: { | ||||
|             if (!watcher->is_watching) { | ||||
|                 janet_stream_close(ow->stream); | ||||
|                 break; | ||||
|             } | ||||
|  | ||||
|             NotifyChange *fni = (NotifyChange *) ow->buf; | ||||
|  | ||||
|             while (1) { | ||||
|                 /* Got an event */ | ||||
|  | ||||
|                 /* Extract name */ | ||||
|                 Janet filename; | ||||
|                 if (fni->FileNameLength) { | ||||
|                     int32_t nbytes = (int32_t) WideCharToMultiByte(CP_UTF8, 0, fni->FileName, fni->FileNameLength / sizeof(wchar_t), NULL, 0, NULL, NULL); | ||||
|                     janet_assert(nbytes, "bad utf8 path"); | ||||
|                     uint8_t *into = janet_string_begin(nbytes); | ||||
|                     WideCharToMultiByte(CP_UTF8, 0, fni->FileName, fni->FileNameLength / sizeof(wchar_t), (char *) into, nbytes, NULL, NULL); | ||||
|                     filename = janet_wrap_string(janet_string_end(into)); | ||||
|                 } else { | ||||
|                     filename = janet_cstringv(""); | ||||
|                 } | ||||
|  | ||||
|                 JanetKV *event = janet_struct_begin(3); | ||||
|                 janet_struct_put(event, janet_ckeywordv("type"), janet_ckeywordv(watcher_actions_windows[fni->Action])); | ||||
|                 janet_struct_put(event, janet_ckeywordv("file-name"), filename); | ||||
|                 janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(ow->dir_path)); | ||||
|                 Janet eventv = janet_wrap_struct(janet_struct_end(event)); | ||||
|  | ||||
|                 janet_channel_give(watcher->channel, eventv); | ||||
|  | ||||
|                 /* Next event */ | ||||
|                 if (!fni->NextEntryOffset) break; | ||||
|                 fni = (NotifyChange *)((char *)fni + fni->NextEntryOffset); | ||||
|             } | ||||
|  | ||||
|             /* Make another call to read directory changes */ | ||||
|             read_dir_changes(ow); | ||||
|             janet_async_in_flight(fiber); | ||||
|         } | ||||
|         break; | ||||
|     } | ||||
| } | ||||
|  | ||||
| static void start_listening_ow(OverlappedWatch *ow) { | ||||
|     read_dir_changes(ow); | ||||
|     JanetStream *stream = ow->stream; | ||||
|     JanetFunction *thunk = janet_thunk_delay(janet_wrap_nil()); | ||||
|     JanetFiber *fiber = janet_fiber(thunk, 64, 0, NULL); | ||||
|     fiber->supervisor_channel = janet_root_fiber()->supervisor_channel; | ||||
|     ow->fiber = fiber; | ||||
|     janet_async_start_fiber(fiber, stream, JANET_ASYNC_LISTEN_READ, watcher_callback_read, ow); | ||||
| } | ||||
|  | ||||
| static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) { | ||||
|     HANDLE handle = CreateFileA(path, | ||||
|                                 FILE_LIST_DIRECTORY | GENERIC_READ, | ||||
|                                 FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, | ||||
|                                 NULL, | ||||
|                                 OPEN_EXISTING, | ||||
|                                 FILE_FLAG_OVERLAPPED | FILE_FLAG_BACKUP_SEMANTICS, | ||||
|                                 NULL); | ||||
|     if (handle == INVALID_HANDLE_VALUE) { | ||||
|         janet_panicv(janet_ev_lasterr()); | ||||
|     } | ||||
|     JanetStream *stream = janet_stream(handle, JANET_STREAM_READABLE, NULL); | ||||
|     OverlappedWatch *ow = janet_malloc(sizeof(OverlappedWatch)); | ||||
|     memset(ow, 0, sizeof(OverlappedWatch)); | ||||
|     ow->stream = stream; | ||||
|     ow->dir_path = janet_cstring(path); | ||||
|     ow->fiber = NULL; | ||||
|     Janet pathv = janet_wrap_string(ow->dir_path); | ||||
|     ow->flags = flags | watcher->default_flags; | ||||
|     ow->watcher = watcher; | ||||
|     ow->overlapped.hEvent = CreateEvent(NULL, FALSE, 0, NULL); /* Do we need this */ | ||||
|     Janet streamv = janet_wrap_pointer(ow); | ||||
|     janet_table_put(watcher->watch_descriptors, pathv, streamv); | ||||
|     if (watcher->is_watching) { | ||||
|         start_listening_ow(ow); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static void janet_watcher_remove(JanetWatcher *watcher, const char *path) { | ||||
|     Janet pathv = janet_cstringv(path); | ||||
|     Janet streamv = janet_table_get(watcher->watch_descriptors, pathv); | ||||
|     if (janet_checktype(streamv, JANET_NIL)) { | ||||
|         janet_panicf("path %v is not being watched", pathv); | ||||
|     } | ||||
|     janet_table_remove(watcher->watch_descriptors, pathv); | ||||
|     OverlappedWatch *ow = janet_unwrap_pointer(streamv); | ||||
|     janet_stream_close(ow->stream); | ||||
| } | ||||
|  | ||||
| static void janet_watcher_listen(JanetWatcher *watcher) { | ||||
|     if (watcher->is_watching) janet_panic("already watching"); | ||||
|     watcher->is_watching = 1; | ||||
|     for (int32_t i = 0; i < watcher->watch_descriptors->capacity; i++) { | ||||
|         const JanetKV *kv = watcher->watch_descriptors->data + i; | ||||
|         if (!janet_checktype(kv->value, JANET_POINTER)) continue; | ||||
|         OverlappedWatch *ow = janet_unwrap_pointer(kv->value); | ||||
|         start_listening_ow(ow); | ||||
|     } | ||||
|     janet_gcroot(janet_wrap_abstract(watcher)); | ||||
| } | ||||
|  | ||||
| static void janet_watcher_unlisten(JanetWatcher *watcher) { | ||||
|     if (!watcher->is_watching) return; | ||||
|     watcher->is_watching = 0; | ||||
|     for (int32_t i = 0; i < watcher->watch_descriptors->capacity; i++) { | ||||
|         const JanetKV *kv = watcher->watch_descriptors->data + i; | ||||
|         if (!janet_checktype(kv->value, JANET_POINTER)) continue; | ||||
|         OverlappedWatch *ow = janet_unwrap_pointer(kv->value); | ||||
|         janet_stream_close(ow->stream); | ||||
|     } | ||||
|     janet_table_clear(watcher->watch_descriptors); | ||||
|     janet_gcunroot(janet_wrap_abstract(watcher)); | ||||
| } | ||||
|  | ||||
| #else | ||||
|  | ||||
| /* Default implementation */ | ||||
|  | ||||
| static uint32_t decode_watch_flags(const Janet *options, int32_t n) { | ||||
|     (void) options; | ||||
|     (void) n; | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) { | ||||
|     (void) watcher; | ||||
|     (void) channel; | ||||
|     (void) default_flags; | ||||
|     janet_panic("filewatch not supported on this platform"); | ||||
| } | ||||
|  | ||||
| static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) { | ||||
|     (void) watcher; | ||||
|     (void) flags; | ||||
|     (void) path; | ||||
|     janet_panic("nyi"); | ||||
| } | ||||
|  | ||||
| static void janet_watcher_remove(JanetWatcher *watcher, const char *path) { | ||||
|     (void) watcher; | ||||
|     (void) path; | ||||
|     janet_panic("nyi"); | ||||
| } | ||||
|  | ||||
| static void janet_watcher_listen(JanetWatcher *watcher) { | ||||
|     (void) watcher; | ||||
|     janet_panic("nyi"); | ||||
| } | ||||
|  | ||||
| static void janet_watcher_unlisten(JanetWatcher *watcher) { | ||||
|     (void) watcher; | ||||
|     janet_panic("nyi"); | ||||
| } | ||||
|  | ||||
| #endif | ||||
|  | ||||
| /* C Functions */ | ||||
|  | ||||
| static int janet_filewatch_mark(void *p, size_t s) { | ||||
|     JanetWatcher *watcher = (JanetWatcher *) p; | ||||
|     (void) s; | ||||
|     if (watcher->channel == NULL) return 0; /* Incomplete initialization */ | ||||
| #ifdef JANET_WINDOWS | ||||
|     for (int32_t i = 0; i < watcher->watch_descriptors->capacity; i++) { | ||||
|         const JanetKV *kv = watcher->watch_descriptors->data + i; | ||||
|         if (!janet_checktype(kv->value, JANET_POINTER)) continue; | ||||
|         OverlappedWatch *ow = janet_unwrap_pointer(kv->value); | ||||
|         janet_mark(janet_wrap_fiber(ow->fiber)); | ||||
|         janet_mark(janet_wrap_abstract(ow->stream)); | ||||
|         janet_mark(janet_wrap_string(ow->dir_path)); | ||||
|     } | ||||
| #else | ||||
|     janet_mark(janet_wrap_abstract(watcher->stream)); | ||||
| #endif | ||||
|     janet_mark(janet_wrap_abstract(watcher->channel)); | ||||
|     janet_mark(janet_wrap_table(watcher->watch_descriptors)); | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| static const JanetAbstractType janet_filewatch_at = { | ||||
|     "filewatch/watcher", | ||||
|     NULL, | ||||
|     janet_filewatch_mark, | ||||
|     JANET_ATEND_GCMARK | ||||
| }; | ||||
|  | ||||
| JANET_CORE_FN(cfun_filewatch_make, | ||||
|               "(filewatch/new channel &opt default-flags)", | ||||
|               "Create a new filewatcher that will give events to a channel channel. See `filewatch/add` for available flags.\n\n" | ||||
|               "When an event is triggered by the filewatcher, a struct containing information will be given to channel as with `ev/give`. " | ||||
|               "The contents of the channel depend on the OS, but will contain some common keys:\n\n" | ||||
|               "* `:type` -- the type of the event that was raised.\n\n" | ||||
|               "* `:file-name` -- the base file name of the file that triggered the event.\n\n" | ||||
|               "* `:dir-name` -- the directory name of the file that triggered the event.\n\n" | ||||
|               "Events also will contain keys specific to the host OS.\n\n" | ||||
|               "Windows has no extra properties on events.\n\n" | ||||
|               "Linux has the following extra properties on events:\n\n" | ||||
|               "* `:wd` -- the integer key returned by `filewatch/add` for the path that triggered this.\n\n" | ||||
|               "* `:wd-path` -- the string path for watched directory of file. For files, will be the same as `:file-name`, and for directories, will be the same as `:dir-name`.\n\n" | ||||
|               "* `:cookie` -- a randomized integer used to associate related events, such as :moved-from and :moved-to events.\n\n" | ||||
|               "") { | ||||
|     janet_sandbox_assert(JANET_SANDBOX_FS_READ); | ||||
|     janet_arity(argc, 1, -1); | ||||
|     JanetChannel *channel = janet_getchannel(argv, 0); | ||||
|     JanetWatcher *watcher = janet_abstract(&janet_filewatch_at, sizeof(JanetWatcher)); | ||||
|     uint32_t default_flags = decode_watch_flags(argv + 1, argc - 1); | ||||
|     janet_watcher_init(watcher, channel, default_flags); | ||||
|     return janet_wrap_abstract(watcher); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_filewatch_add, | ||||
|               "(filewatch/add watcher path &opt flags)", | ||||
|               "Add a path to the watcher. Available flags depend on the current OS, and are as follows:\n\n" | ||||
|               "Windows/MINGW (flags correspond to FILE_NOTIFY_CHANGE_* flags in win32 documentation):\n\n" | ||||
|               "* `:all` - trigger an event for all of the below triggers.\n\n" | ||||
|               "* `:attributes` - FILE_NOTIFY_CHANGE_ATTRIBUTES\n\n" | ||||
|               "* `:creation` - FILE_NOTIFY_CHANGE_CREATION\n\n" | ||||
|               "* `:dir-name` - FILE_NOTIFY_CHANGE_DIR_NAME\n\n" | ||||
|               "* `:last-access` - FILE_NOTIFY_CHANGE_LAST_ACCESS\n\n" | ||||
|               "* `:last-write` - FILE_NOTIFY_CHANGE_LAST_WRITE\n\n" | ||||
|               "* `:security` - FILE_NOTIFY_CHANGE_SECURITY\n\n" | ||||
|               "* `:size` - FILE_NOTIFY_CHANGE_SIZE\n\n" | ||||
|               "* `:recursive` - watch subdirectories recursively\n\n" | ||||
|               "Linux (flags correspond to IN_* flags from <sys/inotify.h>):\n\n" | ||||
|               "* `:access` - IN_ACCESS\n\n" | ||||
|               "* `:all` - IN_ALL_EVENTS\n\n" | ||||
|               "* `:attrib` - IN_ATTRIB\n\n" | ||||
|               "* `:close-nowrite` - IN_CLOSE_NOWRITE\n\n" | ||||
|               "* `:close-write` - IN_CLOSE_WRITE\n\n" | ||||
|               "* `:create` - IN_CREATE\n\n" | ||||
|               "* `:delete` - IN_DELETE\n\n" | ||||
|               "* `:delete-self` - IN_DELETE_SELF\n\n" | ||||
|               "* `:ignored` - IN_IGNORED\n\n" | ||||
|               "* `:modify` - IN_MODIFY\n\n" | ||||
|               "* `:move-self` - IN_MOVE_SELF\n\n" | ||||
|               "* `:moved-from` - IN_MOVED_FROM\n\n" | ||||
|               "* `:moved-to` - IN_MOVED_TO\n\n" | ||||
|               "* `:open` - IN_OPEN\n\n" | ||||
|               "* `:q-overflow` - IN_Q_OVERFLOW\n\n" | ||||
|               "* `:unmount` - IN_UNMOUNT\n\n\n" | ||||
|               "On Windows, events will have the following possible types:\n\n" | ||||
|               "* `:unknown`\n\n" | ||||
|               "* `:added`\n\n" | ||||
|               "* `:removed`\n\n" | ||||
|               "* `:modified`\n\n" | ||||
|               "* `:renamed-old`\n\n" | ||||
|               "* `:renamed-new`\n\n" | ||||
|               "On Linux, events will a `:type` corresponding to the possible flags, excluding `:all`.\n" | ||||
|               "") { | ||||
|     janet_arity(argc, 2, -1); | ||||
|     JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at); | ||||
|     const char *path = janet_getcstring(argv, 1); | ||||
|     uint32_t flags = watcher->default_flags | decode_watch_flags(argv + 2, argc - 2); | ||||
|     janet_watcher_add(watcher, path, flags); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_filewatch_remove, | ||||
|               "(filewatch/remove watcher path)", | ||||
|               "Remove a path from the watcher.") { | ||||
|     janet_fixarity(argc, 2); | ||||
|     JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at); | ||||
|     const char *path = janet_getcstring(argv, 1); | ||||
|     janet_watcher_remove(watcher, path); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_filewatch_listen, | ||||
|               "(filewatch/listen watcher)", | ||||
|               "Listen for changes in the watcher.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at); | ||||
|     janet_watcher_listen(watcher); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_filewatch_unlisten, | ||||
|               "(filewatch/unlisten watcher)", | ||||
|               "Stop listening for changes on a given watcher.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at); | ||||
|     janet_watcher_unlisten(watcher); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| /* Module entry point */ | ||||
| void janet_lib_filewatch(JanetTable *env) { | ||||
|     JanetRegExt cfuns[] = { | ||||
|         JANET_CORE_REG("filewatch/new", cfun_filewatch_make), | ||||
|         JANET_CORE_REG("filewatch/add", cfun_filewatch_add), | ||||
|         JANET_CORE_REG("filewatch/remove", cfun_filewatch_remove), | ||||
|         JANET_CORE_REG("filewatch/listen", cfun_filewatch_listen), | ||||
|         JANET_CORE_REG("filewatch/unlisten", cfun_filewatch_unlisten), | ||||
|         JANET_REG_END | ||||
|     }; | ||||
|     janet_core_cfuns_ext(env, NULL, cfuns); | ||||
| } | ||||
|  | ||||
| #endif | ||||
| #endif | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -321,9 +321,13 @@ static void janet_deinit_block(JanetGCObject *mem) { | ||||
|             janet_symbol_deinit(((JanetStringHead *) mem)->data); | ||||
|             break; | ||||
|         case JANET_MEMORY_ARRAY: | ||||
|         case JANET_MEMORY_ARRAY_WEAK: | ||||
|             janet_free(((JanetArray *) mem)->data); | ||||
|             break; | ||||
|         case JANET_MEMORY_TABLE: | ||||
|         case JANET_MEMORY_TABLE_WEAKK: | ||||
|         case JANET_MEMORY_TABLE_WEAKV: | ||||
|         case JANET_MEMORY_TABLE_WEAKKV: | ||||
|             janet_free(((JanetTable *) mem)->data); | ||||
|             break; | ||||
|         case JANET_MEMORY_FIBER: { | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -64,7 +64,7 @@ enum JanetMemoryType { | ||||
| }; | ||||
|  | ||||
| /* To allocate collectable memory, one must call janet_alloc, initialize the memory, | ||||
|  * and then call when janet_enablegc when it is initailize and reachable by the gc (on the JANET stack) */ | ||||
|  * and then call when janet_enablegc when it is initialized and reachable by the gc (on the JANET stack) */ | ||||
| void *janet_gcalloc(enum JanetMemoryType type, size_t size); | ||||
|  | ||||
| #endif | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose & contributors | ||||
| * Copyright (c) 2024 Calvin Rose & contributors | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -31,6 +31,7 @@ | ||||
|  | ||||
| #ifndef JANET_WINDOWS | ||||
| #include <fcntl.h> | ||||
| #include <sys/stat.h> | ||||
| #include <sys/wait.h> | ||||
| #include <unistd.h> | ||||
| #endif | ||||
| @@ -41,6 +42,11 @@ static void io_file_marshal(void *p, JanetMarshalContext *ctx); | ||||
| static void *io_file_unmarshal(JanetMarshalContext *ctx); | ||||
| static Janet io_file_next(void *p, Janet key); | ||||
|  | ||||
| #ifdef JANET_WINDOWS | ||||
| #define ftell _ftelli64 | ||||
| #define fseek _fseeki64 | ||||
| #endif | ||||
|  | ||||
| const JanetAbstractType janet_file_type = { | ||||
|     "core/file", | ||||
|     cfun_io_gc, | ||||
| @@ -126,7 +132,7 @@ JANET_CORE_FN(cfun_io_temp, | ||||
|     // XXX use mkostemp when we can to avoid CLOEXEC race. | ||||
|     FILE *tmp = tmpfile(); | ||||
|     if (!tmp) | ||||
|         janet_panicf("unable to create temporary file - %s", strerror(errno)); | ||||
|         janet_panicf("unable to create temporary file - %s", janet_strerror(errno)); | ||||
|     return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY); | ||||
| } | ||||
|  | ||||
| @@ -159,6 +165,14 @@ JANET_CORE_FN(cfun_io_fopen, | ||||
|     } | ||||
|     FILE *f = fopen((const char *)fname, (const char *)fmode); | ||||
|     if (f != NULL) { | ||||
| #ifndef JANET_WINDOWS | ||||
|         struct stat st; | ||||
|         fstat(fileno(f), &st); | ||||
|         if (S_ISDIR(st.st_mode)) { | ||||
|             fclose(f); | ||||
|             janet_panicf("cannot open directory: %s", fname); | ||||
|         } | ||||
| #endif | ||||
|         size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ); | ||||
|         if (bufsize != BUFSIZ) { | ||||
|             int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize); | ||||
| @@ -168,7 +182,7 @@ JANET_CORE_FN(cfun_io_fopen, | ||||
|         } | ||||
|     } | ||||
|     return f ? janet_makefile(f, flags) | ||||
|            : (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil()) | ||||
|            : (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, janet_strerror(errno)), janet_wrap_nil()) | ||||
|            : janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| @@ -289,7 +303,7 @@ int janet_file_close(JanetFile *file) { | ||||
|     if (!(file->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) { | ||||
|         ret = fclose(file->file); | ||||
|         file->flags |= JANET_FILE_CLOSED; | ||||
|         file->file = NULL; /* NULL derefence is easier to debug then other problems */ | ||||
|         file->file = NULL; /* NULL dereference is easier to debug then other problems */ | ||||
|         return ret; | ||||
|     } | ||||
|     return 0; | ||||
| @@ -337,7 +351,7 @@ JANET_CORE_FN(cfun_io_fseek, | ||||
|     JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type); | ||||
|     if (iof->flags & JANET_FILE_CLOSED) | ||||
|         janet_panic("file is closed"); | ||||
|     long int offset = 0; | ||||
|     int64_t offset = 0; | ||||
|     int whence = SEEK_CUR; | ||||
|     if (argc >= 2) { | ||||
|         const uint8_t *whence_sym = janet_getkeyword(argv, 1); | ||||
| @@ -351,7 +365,7 @@ JANET_CORE_FN(cfun_io_fseek, | ||||
|             janet_panicf("expected one of :cur, :set, :end, got %v", argv[1]); | ||||
|         } | ||||
|         if (argc == 3) { | ||||
|             offset = (long) janet_getinteger64(argv, 2); | ||||
|             offset = (int64_t) janet_getinteger64(argv, 2); | ||||
|         } | ||||
|     } | ||||
|     if (fseek(iof->file, offset, whence)) janet_panic("error seeking file"); | ||||
| @@ -365,7 +379,7 @@ JANET_CORE_FN(cfun_io_ftell, | ||||
|     JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type); | ||||
|     if (iof->flags & JANET_FILE_CLOSED) | ||||
|         janet_panic("file is closed"); | ||||
|     long pos = ftell(iof->file); | ||||
|     int64_t pos = ftell(iof->file); | ||||
|     if (pos == -1) janet_panic("error getting position in file"); | ||||
|     return janet_wrap_number((double)pos); | ||||
| } | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -68,8 +68,15 @@ enum { | ||||
|     LB_STRUCT_PROTO, /* 223 */ | ||||
| #ifdef JANET_EV | ||||
|     LB_THREADED_ABSTRACT, /* 224 */ | ||||
|     LB_POINTER_BUFFER, /* 224 */ | ||||
|     LB_POINTER_BUFFER, /* 225 */ | ||||
| #endif | ||||
|     LB_TABLE_WEAKK, /* 226 */ | ||||
|     LB_TABLE_WEAKV, /* 227 */ | ||||
|     LB_TABLE_WEAKKV, /* 228 */ | ||||
|     LB_TABLE_WEAKK_PROTO, /* 229 */ | ||||
|     LB_TABLE_WEAKV_PROTO, /* 230 */ | ||||
|     LB_TABLE_WEAKKV_PROTO, /* 231 */ | ||||
|     LB_ARRAY_WEAK, /* 232 */ | ||||
| } LeadBytes; | ||||
|  | ||||
| /* Helper to look inside an entry in an environment */ | ||||
| @@ -569,7 +576,8 @@ static void marshal_one(MarshalState *st, Janet x, int flags) { | ||||
|             int32_t i; | ||||
|             JanetArray *a = janet_unwrap_array(x); | ||||
|             MARK_SEEN(); | ||||
|             pushbyte(st, LB_ARRAY); | ||||
|             enum JanetMemoryType memtype = janet_gc_type(a); | ||||
|             pushbyte(st, memtype == JANET_MEMORY_ARRAY_WEAK ? LB_ARRAY_WEAK : LB_ARRAY); | ||||
|             pushint(st, a->count); | ||||
|             for (i = 0; i < a->count; i++) | ||||
|                 marshal_one(st, a->data[i], flags + 1); | ||||
| @@ -592,7 +600,16 @@ static void marshal_one(MarshalState *st, Janet x, int flags) { | ||||
|         case JANET_TABLE: { | ||||
|             JanetTable *t = janet_unwrap_table(x); | ||||
|             MARK_SEEN(); | ||||
|             pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE); | ||||
|             enum JanetMemoryType memtype = janet_gc_type(t); | ||||
|             if (memtype == JANET_MEMORY_TABLE_WEAKK) { | ||||
|                 pushbyte(st, t->proto ? LB_TABLE_WEAKK_PROTO : LB_TABLE_WEAKK); | ||||
|             } else if (memtype == JANET_MEMORY_TABLE_WEAKV) { | ||||
|                 pushbyte(st, t->proto ? LB_TABLE_WEAKV_PROTO : LB_TABLE_WEAKV); | ||||
|             } else if (memtype == JANET_MEMORY_TABLE_WEAKKV) { | ||||
|                 pushbyte(st, t->proto ? LB_TABLE_WEAKKV_PROTO : LB_TABLE_WEAKKV); | ||||
|             } else { | ||||
|                 pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE); | ||||
|             } | ||||
|             pushint(st, t->count); | ||||
|             if (t->proto) | ||||
|                 marshal_one(st, janet_wrap_table(t->proto), flags + 1); | ||||
| @@ -1417,11 +1434,18 @@ static const uint8_t *unmarshal_one( | ||||
|         } | ||||
|         case LB_REFERENCE: | ||||
|         case LB_ARRAY: | ||||
|         case LB_ARRAY_WEAK: | ||||
|         case LB_TUPLE: | ||||
|         case LB_STRUCT: | ||||
|         case LB_STRUCT_PROTO: | ||||
|         case LB_TABLE: | ||||
|         case LB_TABLE_PROTO: | ||||
|         case LB_TABLE_WEAKK: | ||||
|         case LB_TABLE_WEAKV: | ||||
|         case LB_TABLE_WEAKKV: | ||||
|         case LB_TABLE_WEAKK_PROTO: | ||||
|         case LB_TABLE_WEAKV_PROTO: | ||||
|         case LB_TABLE_WEAKKV_PROTO: | ||||
|             /* Things that open with integers */ | ||||
|         { | ||||
|             data++; | ||||
| @@ -1430,9 +1454,9 @@ static const uint8_t *unmarshal_one( | ||||
|             if (lead != LB_REFERENCE) { | ||||
|                 MARSH_EOS(st, data - 1 + len); | ||||
|             } | ||||
|             if (lead == LB_ARRAY) { | ||||
|             if (lead == LB_ARRAY || lead == LB_ARRAY_WEAK) { | ||||
|                 /* Array */ | ||||
|                 JanetArray *array = janet_array(len); | ||||
|                 JanetArray *array = (lead == LB_ARRAY_WEAK) ? janet_array_weak(len) : janet_array(len); | ||||
|                 array->count = len; | ||||
|                 *out = janet_wrap_array(array); | ||||
|                 janet_v_push(st->lookup, *out); | ||||
| @@ -1472,10 +1496,19 @@ static const uint8_t *unmarshal_one( | ||||
|                 *out = st->lookup[len]; | ||||
|             } else { | ||||
|                 /* Table */ | ||||
|                 JanetTable *t = janet_table(len); | ||||
|                 JanetTable *t; | ||||
|                 if (lead == LB_TABLE_WEAKK_PROTO || lead == LB_TABLE_WEAKK) { | ||||
|                     t = janet_table_weakk(len); | ||||
|                 } else if (lead == LB_TABLE_WEAKV_PROTO || lead == LB_TABLE_WEAKV) { | ||||
|                     t = janet_table_weakv(len); | ||||
|                 } else if (lead == LB_TABLE_WEAKKV_PROTO || lead == LB_TABLE_WEAKKV) { | ||||
|                     t = janet_table_weakkv(len); | ||||
|                 } else { | ||||
|                     t = janet_table(len); | ||||
|                 } | ||||
|                 *out = janet_wrap_table(t); | ||||
|                 janet_v_push(st->lookup, *out); | ||||
|                 if (lead == LB_TABLE_PROTO) { | ||||
|                 if (lead == LB_TABLE_PROTO || lead == LB_TABLE_WEAKK_PROTO || lead == LB_TABLE_WEAKV_PROTO || lead == LB_TABLE_WEAKKV_PROTO) { | ||||
|                     Janet proto; | ||||
|                     data = unmarshal_one(st, data, &proto, flags + 1); | ||||
|                     janet_asserttype(proto, JANET_TABLE, st); | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -85,10 +85,10 @@ void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len) { | ||||
|     uint8_t state[16] = {0}; | ||||
|     for (int32_t i = 0; i < len; i++) | ||||
|         state[i & 0xF] ^= bytes[i]; | ||||
|     rng->a = state[0] + (state[1] << 8) + (state[2] << 16) + (state[3] << 24); | ||||
|     rng->b = state[4] + (state[5] << 8) + (state[6] << 16) + (state[7] << 24); | ||||
|     rng->c = state[8] + (state[9] << 8) + (state[10] << 16) + (state[11] << 24); | ||||
|     rng->d = state[12] + (state[13] << 8) + (state[14] << 16) + (state[15] << 24); | ||||
|     rng->a = state[0] + ((uint32_t) state[1] << 8) + ((uint32_t) state[2] << 16) + ((uint32_t) state[3] << 24); | ||||
|     rng->b = state[4] + ((uint32_t) state[5] << 8) + ((uint32_t) state[6] << 16) + ((uint32_t) state[7] << 24); | ||||
|     rng->c = state[8] + ((uint32_t) state[9] << 8) + ((uint32_t) state[10] << 16) + ((uint32_t) state[11] << 24); | ||||
|     rng->d = state[12] + ((uint32_t) state[13] << 8) + ((uint32_t) state[14] << 16) + ((uint32_t) state[15] << 24); | ||||
|     rng->counter = 0u; | ||||
|     /* a, b, c, d can't all be 0 */ | ||||
|     if (rng->a == 0) rng->a = 1u; | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose and contributors. | ||||
| * Copyright (c) 2024 Calvin Rose and contributors. | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -152,7 +152,7 @@ void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) { | ||||
|         if (res == 0) { | ||||
|             janet_schedule(fiber, janet_wrap_abstract(stream)); | ||||
|         } else { | ||||
|             janet_cancel(fiber, janet_cstringv(strerror(res))); | ||||
|             janet_cancel(fiber, janet_cstringv(janet_strerror(res))); | ||||
|             stream->flags |= JANET_STREAM_TOCLOSE; | ||||
|         } | ||||
|     } else { | ||||
| @@ -325,7 +325,7 @@ JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunctio | ||||
|  | ||||
| #endif | ||||
|  | ||||
| /* Adress info */ | ||||
| /* Address info */ | ||||
|  | ||||
| static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) { | ||||
|     JanetKeyword stype = janet_optkeyword(argv, argc, n, NULL); | ||||
| @@ -829,7 +829,7 @@ JANET_CORE_FN(cfun_stream_accept_loop, | ||||
| JANET_CORE_FN(cfun_stream_accept, | ||||
|               "(net/accept stream &opt timeout)", | ||||
|               "Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. " | ||||
|               "Takes an optional timeout in seconds, after which will return nil. " | ||||
|               "Takes an optional timeout in seconds, after which will raise an error. " | ||||
|               "Returns a new duplex stream which represents a connection to the client.") { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
| @@ -844,7 +844,7 @@ JANET_CORE_FN(cfun_stream_read, | ||||
|               "Read up to n bytes from a stream, suspending the current fiber until the bytes are available. " | ||||
|               "`n` can also be the keyword `:all` to read into the buffer until end of stream. " | ||||
|               "If less than n bytes are available (and more than 0), will push those bytes and return early. " | ||||
|               "Takes an optional timeout in seconds, after which will return nil. " | ||||
|               "Takes an optional timeout in seconds, after which will raise an error. " | ||||
|               "Returns a buffer with up to n more bytes in it, or raises an error if the read failed.") { | ||||
|     janet_arity(argc, 2, 4); | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
| @@ -864,7 +864,7 @@ JANET_CORE_FN(cfun_stream_read, | ||||
| JANET_CORE_FN(cfun_stream_chunk, | ||||
|               "(net/chunk stream nbytes &opt buf timeout)", | ||||
|               "Same a net/read, but will wait for all n bytes to arrive rather than return early. " | ||||
|               "Takes an optional timeout in seconds, after which will return nil.") { | ||||
|               "Takes an optional timeout in seconds, after which will raise an error.") { | ||||
|     janet_arity(argc, 2, 4); | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
|     janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET); | ||||
| @@ -878,7 +878,7 @@ JANET_CORE_FN(cfun_stream_chunk, | ||||
| JANET_CORE_FN(cfun_stream_recv_from, | ||||
|               "(net/recv-from stream nbytes buf &opt timeout)", | ||||
|               "Receives data from a server stream and puts it into a buffer. Returns the socket-address the " | ||||
|               "packet came from. Takes an optional timeout in seconds, after which will return nil.") { | ||||
|               "packet came from. Takes an optional timeout in seconds, after which will raise an error.") { | ||||
|     janet_arity(argc, 3, 4); | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
|     janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET); | ||||
| @@ -892,7 +892,7 @@ JANET_CORE_FN(cfun_stream_recv_from, | ||||
| JANET_CORE_FN(cfun_stream_write, | ||||
|               "(net/write stream data &opt timeout)", | ||||
|               "Write data to a stream, suspending the current fiber until the write " | ||||
|               "completes. Takes an optional timeout in seconds, after which will return nil. " | ||||
|               "completes. Takes an optional timeout in seconds, after which will raise an error. " | ||||
|               "Returns nil, or raises an error if the write failed.") { | ||||
|     janet_arity(argc, 2, 3); | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
| @@ -911,7 +911,7 @@ JANET_CORE_FN(cfun_stream_write, | ||||
| JANET_CORE_FN(cfun_stream_send_to, | ||||
|               "(net/send-to stream dest data &opt timeout)", | ||||
|               "Writes a datagram to a server stream. dest is a the destination address of the packet. " | ||||
|               "Takes an optional timeout in seconds, after which will return nil. " | ||||
|               "Takes an optional timeout in seconds, after which will raise an error. " | ||||
|               "Returns stream.") { | ||||
|     janet_arity(argc, 3, 4); | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
| @@ -1035,7 +1035,7 @@ JANET_CORE_FN(cfun_net_setsockopt, | ||||
|  | ||||
|     int r = setsockopt((JSock) stream->handle, st->level, st->optname, optval, optlen); | ||||
|     if (r == -1) { | ||||
|         janet_panicf("setsockopt(%q): %s", argv[1], strerror(errno)); | ||||
|         janet_panicf("setsockopt(%q): %s", argv[1], janet_strerror(errno)); | ||||
|     } | ||||
|  | ||||
|     return janet_wrap_nil(); | ||||
|   | ||||
							
								
								
									
										199
									
								
								src/core/os.c
									
									
									
									
									
								
							
							
						
						
									
										199
									
								
								src/core/os.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose and contributors. | ||||
| * Copyright (c) 2024 Calvin Rose and contributors. | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -27,9 +27,10 @@ | ||||
| #include "gc.h" | ||||
| #endif | ||||
|  | ||||
| #include <stdlib.h> | ||||
|  | ||||
| #ifndef JANET_REDUCED_OS | ||||
|  | ||||
| #include <stdlib.h> | ||||
| #include <time.h> | ||||
| #include <fcntl.h> | ||||
| #include <errno.h> | ||||
| @@ -38,23 +39,14 @@ | ||||
| #include <string.h> | ||||
| #include <sys/stat.h> | ||||
| #include <signal.h> | ||||
|  | ||||
| #include <locale.h> | ||||
|  | ||||
| #ifdef JANET_BSD | ||||
| #include <sys/sysctl.h> | ||||
| #endif | ||||
|  | ||||
| #if defined(__FreeBSD__) || defined(__DragonFly__) || defined(JANET_APPLE) | ||||
| /* It seems only some bsds use this header for xlocale */ | ||||
| #include <xlocale.h> | ||||
| #define JANET_EXTENDED_LOCALE | ||||
| #else | ||||
| #include <locale.h> | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_LINUX | ||||
| #include <sched.h> | ||||
| #define JANET_EXTENDED_LOCALE | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_WINDOWS | ||||
| @@ -183,6 +175,8 @@ JANET_CORE_FN(os_arch, | ||||
|               "* :riscv64\n\n" | ||||
|               "* :sparc\n\n" | ||||
|               "* :wasm\n\n" | ||||
|               "* :s390\n\n" | ||||
|               "* :s390x\n\n" | ||||
|               "* :unknown\n") { | ||||
|     janet_fixarity(argc, 0); | ||||
|     (void) argv; | ||||
| @@ -209,6 +203,10 @@ JANET_CORE_FN(os_arch, | ||||
|     return janet_ckeywordv("ppc"); | ||||
| #elif (defined(__ppc64__) || defined(_ARCH_PPC64) || defined(_M_PPC)) | ||||
|     return janet_ckeywordv("ppc64"); | ||||
| #elif (defined(__s390x__)) | ||||
|     return janet_ckeywordv("s390x"); | ||||
| #elif (defined(__s390__)) | ||||
|     return janet_ckeywordv("s390"); | ||||
| #else | ||||
|     return janet_ckeywordv("unknown"); | ||||
| #endif | ||||
| @@ -254,7 +252,7 @@ JANET_CORE_FN(os_exit, | ||||
|     } | ||||
|     janet_deinit(); | ||||
|     if (argc >= 2 && janet_truthy(argv[1])) { | ||||
|         _exit(status); | ||||
|         _Exit(status); | ||||
|     } else { | ||||
|         exit(status); | ||||
|     } | ||||
| @@ -771,7 +769,7 @@ JANET_CORE_FN(os_proc_kill, | ||||
|     } | ||||
|     int status = kill(proc->pid, signal == -1 ? SIGKILL : signal); | ||||
|     if (status) { | ||||
|         janet_panic(strerror(errno)); | ||||
|         janet_panic(janet_strerror(errno)); | ||||
|     } | ||||
| #endif | ||||
|     /* After killing process we wait on it. */ | ||||
| @@ -1284,7 +1282,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) { | ||||
|                 status = execv(cargv[0], cargv); | ||||
|             } | ||||
|         } while (status == -1 && errno == EINTR); | ||||
|         janet_panicf("%p: %s", cargv[0], strerror(errno ? errno : ENOENT)); | ||||
|         janet_panicf("%p: %s", cargv[0], janet_strerror(errno ? errno : ENOENT)); | ||||
| #endif | ||||
|     } | ||||
|  | ||||
| @@ -1341,7 +1339,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) { | ||||
|     os_execute_cleanup(envp, child_argv); | ||||
|     if (status) { | ||||
|         /* correct for macos bug where errno is not set */ | ||||
|         janet_panicf("%p: %s", argv[0], strerror(errno ? errno : ENOENT)); | ||||
|         janet_panicf("%p: %s", argv[0], janet_strerror(errno ? errno : ENOENT)); | ||||
|     } | ||||
|  | ||||
| #endif | ||||
| @@ -1422,7 +1420,7 @@ JANET_CORE_FN(os_spawn, | ||||
| JANET_CORE_FN(os_posix_exec, | ||||
|               "(os/posix-exec args &opt flags env)", | ||||
|               "Use the execvpe or execve system calls to replace the current process with an interface similar to os/execute. " | ||||
|               "Hoever, instead of creating a subprocess, the current process is replaced. Is not supported on windows, and " | ||||
|               "However, instead of creating a subprocess, the current process is replaced. Is not supported on windows, and " | ||||
|               "does not allow redirection of stdio.") { | ||||
|     return os_execute_impl(argc, argv, JANET_EXECUTE_EXEC); | ||||
| } | ||||
| @@ -1442,7 +1440,7 @@ JANET_CORE_FN(os_posix_fork, | ||||
|         result = fork(); | ||||
|     } while (result == -1 && errno == EINTR); | ||||
|     if (result == -1) { | ||||
|         janet_panic(strerror(errno)); | ||||
|         janet_panic(janet_strerror(errno)); | ||||
|     } | ||||
|     if (result) { | ||||
|         JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc)); | ||||
| @@ -1591,8 +1589,8 @@ JANET_CORE_FN(os_clock, | ||||
|     janet_sandbox_assert(JANET_SANDBOX_HRTIME); | ||||
|     janet_arity(argc, 0, 2); | ||||
|  | ||||
|     JanetKeyword sourcestr = janet_optkeyword(argv, argc, 0, (const uint8_t *) "realtime"); | ||||
|     if (janet_cstrcmp(sourcestr, "realtime") == 0) { | ||||
|     JanetKeyword sourcestr = janet_optkeyword(argv, argc, 0, NULL); | ||||
|     if (sourcestr == NULL || janet_cstrcmp(sourcestr, "realtime") == 0) { | ||||
|         source = JANET_TIME_REALTIME; | ||||
|     } else if (janet_cstrcmp(sourcestr, "monotonic") == 0) { | ||||
|         source = JANET_TIME_MONOTONIC; | ||||
| @@ -1605,8 +1603,8 @@ JANET_CORE_FN(os_clock, | ||||
|     struct timespec tv; | ||||
|     if (janet_gettime(&tv, source)) janet_panic("could not get time"); | ||||
|  | ||||
|     JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, (const uint8_t *) "double"); | ||||
|     if (janet_cstrcmp(formatstr, "double") == 0) { | ||||
|     JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, NULL); | ||||
|     if (formatstr == NULL || janet_cstrcmp(formatstr, "double") == 0) { | ||||
|         double dtime = (double)(tv.tv_sec + (tv.tv_nsec / 1E9)); | ||||
|         return janet_wrap_number(dtime); | ||||
|     } else if (janet_cstrcmp(formatstr, "int") == 0) { | ||||
| @@ -1654,7 +1652,7 @@ JANET_CORE_FN(os_isatty, | ||||
|     return janet_wrap_boolean(_isatty(fd)); | ||||
| #else | ||||
|     int fd = fileno(f); | ||||
|     if (fd == -1) janet_panic(strerror(errno)); | ||||
|     if (fd == -1) janet_panic(janet_strerror(errno)); | ||||
|     return janet_wrap_boolean(isatty(fd)); | ||||
| #endif | ||||
| } | ||||
| @@ -1889,7 +1887,7 @@ JANET_CORE_FN(os_mktime, | ||||
|     } | ||||
|  | ||||
|     if (t == (time_t) -1) { | ||||
|         janet_panicf("%s", strerror(errno)); | ||||
|         janet_panicf("%s", janet_strerror(errno)); | ||||
|     } | ||||
|  | ||||
|     return janet_wrap_number((double)t); | ||||
| @@ -1902,68 +1900,40 @@ JANET_CORE_FN(os_mktime, | ||||
| #endif | ||||
|  | ||||
| JANET_CORE_FN(os_setlocale, | ||||
|               "(os/setlocale category &opt locale)", | ||||
|               "(os/setlocale &opt locale category)", | ||||
|               "Set the system locale, which affects how dates and numbers are formatted. " | ||||
|               "Passing nil to locale will return the current locale.") { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     const char *locale_name = janet_optcstring(argv, argc, 1, NULL); | ||||
|     int category_int = 0; | ||||
| #ifdef JANET_EXTENDED_LOCALE | ||||
|     if (janet_keyeq(argv[0], "all")) { | ||||
|         category_int = LC_ALL_MASK; | ||||
|     } else if (janet_keyeq(argv[0], "collate")) { | ||||
|         category_int = LC_COLLATE_MASK; | ||||
|     } else if (janet_keyeq(argv[0], "ctype")) { | ||||
|         category_int = LC_CTYPE_MASK; | ||||
|     } else if (janet_keyeq(argv[0], "monetary")) { | ||||
|         category_int = LC_MONETARY_MASK; | ||||
|     } else if (janet_keyeq(argv[0], "numeric")) { | ||||
|         category_int = LC_NUMERIC_MASK; | ||||
|     } else if (janet_keyeq(argv[0], "time")) { | ||||
|         category_int = LC_TIME_MASK; | ||||
|     } else { | ||||
|         janet_panicf("expected one of :all, :collate, :ctype, :monetary, :numeric, or :time, got %v", argv[0]); | ||||
|     } | ||||
|     if (locale_name == NULL) { | ||||
|         const char *old = setlocale(category_int, NULL); | ||||
|         if (old == NULL) return janet_wrap_nil(); | ||||
|         return janet_cstringv(old); | ||||
|     } | ||||
|     /* Use newlocale instead of setlocale for per-thread behavior */ | ||||
|     locale_t loc = newlocale(category_int, locale_name, 0); | ||||
|     if (loc == 0) { | ||||
|         janet_panicf("failed to make locale - %s", strerror(errno)); | ||||
|     } | ||||
|     locale_t old_locale = uselocale(loc); | ||||
|     if (old_locale == 0) { | ||||
|         janet_panicf("failed to set locale - %s", strerror(errno)); | ||||
|     } | ||||
|     if (old_locale != LC_GLOBAL_LOCALE) { | ||||
|         freelocale(old_locale); | ||||
|     } | ||||
|     return janet_wrap_nil(); | ||||
| #else | ||||
|     if (janet_keyeq(argv[0], "all")) { | ||||
|         category_int = LC_ALL; | ||||
|     } else if (janet_keyeq(argv[0], "collate")) { | ||||
|         category_int = LC_COLLATE; | ||||
|     } else if (janet_keyeq(argv[0], "ctype")) { | ||||
|         category_int = LC_CTYPE; | ||||
|     } else if (janet_keyeq(argv[0], "monetary")) { | ||||
|         category_int = LC_MONETARY; | ||||
|     } else if (janet_keyeq(argv[0], "numeric")) { | ||||
|         category_int = LC_NUMERIC; | ||||
|     } else if (janet_keyeq(argv[0], "time")) { | ||||
|         category_int = LC_TIME; | ||||
|     } else { | ||||
|         janet_panicf("expected one of :all, :collate, :ctype, :monetary, :numeric, or :time, got %v", argv[0]); | ||||
|               "Passing nil to locale will return the current locale. Category can be one of:\n\n" | ||||
|               " * :all (default)\n" | ||||
|               " * :collate\n" | ||||
|               " * :ctype\n" | ||||
|               " * :monetary\n" | ||||
|               " * :numeric\n" | ||||
|               " * :time\n\n" | ||||
|               "Returns the new locale if set successfully, otherwise nil. Note that this will affect " | ||||
|               "other functions such as `os/strftime` and even `printf`.") { | ||||
|     janet_arity(argc, 0, 2); | ||||
|     const char *locale_name = janet_optcstring(argv, argc, 0, NULL); | ||||
|     int category_int = LC_ALL; | ||||
|     if (argc > 1 && !janet_checktype(argv[1], JANET_NIL)) { | ||||
|         if (janet_keyeq(argv[1], "all")) { | ||||
|             category_int = LC_ALL; | ||||
|         } else if (janet_keyeq(argv[1], "collate")) { | ||||
|             category_int = LC_COLLATE; | ||||
|         } else if (janet_keyeq(argv[1], "ctype")) { | ||||
|             category_int = LC_CTYPE; | ||||
|         } else if (janet_keyeq(argv[1], "monetary")) { | ||||
|             category_int = LC_MONETARY; | ||||
|         } else if (janet_keyeq(argv[1], "numeric")) { | ||||
|             category_int = LC_NUMERIC; | ||||
|         } else if (janet_keyeq(argv[1], "time")) { | ||||
|             category_int = LC_TIME; | ||||
|         } else { | ||||
|             janet_panicf("expected one of :all, :collate, :ctype, :monetary, :numeric, or :time, got %v", argv[1]); | ||||
|         } | ||||
|     } | ||||
|     const char *old = setlocale(category_int, locale_name); | ||||
|     if (old == NULL) { | ||||
|         janet_panicf("failed to set locale - %s", strerror(errno)); | ||||
|     } | ||||
|     return janet_wrap_nil(); | ||||
| #endif | ||||
|     if (old == NULL) return janet_wrap_nil(); | ||||
|     return janet_cstringv(old); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(os_link, | ||||
| @@ -1983,7 +1953,7 @@ JANET_CORE_FN(os_link, | ||||
|     const char *oldpath = janet_getcstring(argv, 0); | ||||
|     const char *newpath = janet_getcstring(argv, 1); | ||||
|     int res = ((argc == 3 && janet_truthy(argv[2])) ? j_symlink : link)(oldpath, newpath); | ||||
|     if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath); | ||||
|     if (-1 == res) janet_panicf("%s: %s -> %s", janet_strerror(errno), oldpath, newpath); | ||||
|     return janet_wrap_nil(); | ||||
| #endif | ||||
| } | ||||
| @@ -2002,7 +1972,7 @@ JANET_CORE_FN(os_symlink, | ||||
|     const char *oldpath = janet_getcstring(argv, 0); | ||||
|     const char *newpath = janet_getcstring(argv, 1); | ||||
|     int res = j_symlink(oldpath, newpath); | ||||
|     if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath); | ||||
|     if (-1 == res) janet_panicf("%s: %s -> %s", janet_strerror(errno), oldpath, newpath); | ||||
|     return janet_wrap_nil(); | ||||
| #endif | ||||
| } | ||||
| @@ -2024,7 +1994,7 @@ JANET_CORE_FN(os_mkdir, | ||||
| #endif | ||||
|     if (res == 0) return janet_wrap_true(); | ||||
|     if (errno == EEXIST) return janet_wrap_false(); | ||||
|     janet_panicf("%s: %s", strerror(errno), path); | ||||
|     janet_panicf("%s: %s", janet_strerror(errno), path); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(os_rmdir, | ||||
| @@ -2038,7 +2008,7 @@ JANET_CORE_FN(os_rmdir, | ||||
| #else | ||||
|     int res = rmdir(path); | ||||
| #endif | ||||
|     if (-1 == res) janet_panicf("%s: %s", strerror(errno), path); | ||||
|     if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| @@ -2053,7 +2023,7 @@ JANET_CORE_FN(os_cd, | ||||
| #else | ||||
|     int res = chdir(path); | ||||
| #endif | ||||
|     if (-1 == res) janet_panicf("%s: %s", strerror(errno), path); | ||||
|     if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| @@ -2077,7 +2047,7 @@ JANET_CORE_FN(os_touch, | ||||
|         bufp = NULL; | ||||
|     } | ||||
|     int res = utime(path, bufp); | ||||
|     if (-1 == res) janet_panic(strerror(errno)); | ||||
|     if (-1 == res) janet_panic(janet_strerror(errno)); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| @@ -2087,7 +2057,7 @@ JANET_CORE_FN(os_remove, | ||||
|     janet_fixarity(argc, 1); | ||||
|     const char *path = janet_getcstring(argv, 0); | ||||
|     int status = remove(path); | ||||
|     if (-1 == status) janet_panicf("%s: %s", strerror(errno), path); | ||||
|     if (-1 == status) janet_panicf("%s: %s", janet_strerror(errno), path); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| @@ -2106,7 +2076,7 @@ JANET_CORE_FN(os_readlink, | ||||
|     const char *path = janet_getcstring(argv, 0); | ||||
|     ssize_t len = readlink(path, buffer, sizeof buffer); | ||||
|     if (len < 0 || (size_t)len >= sizeof buffer) | ||||
|         janet_panicf("%s: %s", strerror(errno), path); | ||||
|         janet_panicf("%s: %s", janet_strerror(errno), path); | ||||
|     return janet_stringv((const uint8_t *)buffer, len); | ||||
| #endif | ||||
| } | ||||
| @@ -2401,7 +2371,7 @@ JANET_CORE_FN(os_chmod, | ||||
| #else | ||||
|     int res = chmod(path, os_getmode(argv, 1)); | ||||
| #endif | ||||
|     if (-1 == res) janet_panicf("%s: %s", strerror(errno), path); | ||||
|     if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| @@ -2437,7 +2407,7 @@ JANET_CORE_FN(os_dir, | ||||
|         janet_panicf("path too long: %s", dir); | ||||
|     sprintf(pattern, "%s/*", dir); | ||||
|     intptr_t res = _findfirst(pattern, &afile); | ||||
|     if (-1 == res) janet_panicv(janet_cstringv(strerror(errno))); | ||||
|     if (-1 == res) janet_panicv(janet_cstringv(janet_strerror(errno))); | ||||
|     do { | ||||
|         if (strcmp(".", afile.name) && strcmp("..", afile.name)) { | ||||
|             janet_array_push(paths, janet_cstringv(afile.name)); | ||||
| @@ -2448,8 +2418,18 @@ JANET_CORE_FN(os_dir, | ||||
|     /* Read directory items with opendir / readdir / closedir */ | ||||
|     struct dirent *dp; | ||||
|     DIR *dfd = opendir(dir); | ||||
|     if (dfd == NULL) janet_panicf("cannot open directory %s", dir); | ||||
|     while ((dp = readdir(dfd)) != NULL) { | ||||
|     if (dfd == NULL) janet_panicf("cannot open directory %s: %s", dir, janet_strerror(errno)); | ||||
|     for (;;) { | ||||
|         errno = 0; | ||||
|         dp = readdir(dfd); | ||||
|         if (dp == NULL) { | ||||
|             if (errno) { | ||||
|                 int olderr = errno; | ||||
|                 closedir(dfd); | ||||
|                 janet_panicf("failed to read directory %s: %s", dir, janet_strerror(olderr)); | ||||
|             } | ||||
|             break; | ||||
|         } | ||||
|         if (!strcmp(dp->d_name, ".") || !strcmp(dp->d_name, "..")) { | ||||
|             continue; | ||||
|         } | ||||
| @@ -2469,7 +2449,7 @@ JANET_CORE_FN(os_rename, | ||||
|     const char *dest = janet_getcstring(argv, 1); | ||||
|     int status = rename(src, dest); | ||||
|     if (status) { | ||||
|         janet_panic(strerror(errno)); | ||||
|         janet_panic(janet_strerror(errno)); | ||||
|     } | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
| @@ -2489,7 +2469,7 @@ JANET_CORE_FN(os_realpath, | ||||
| #else | ||||
|     char *dest = realpath(src, NULL); | ||||
| #endif | ||||
|     if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src); | ||||
|     if (NULL == dest) janet_panicf("%s: %s", janet_strerror(errno), src); | ||||
|     Janet ret = janet_cstringv(dest); | ||||
|     janet_free(dest); | ||||
|     return ret; | ||||
| @@ -2695,7 +2675,7 @@ JANET_CORE_FN(os_open, | ||||
|     } else if (write_flag && !read_flag) { | ||||
|         open_flags |= O_WRONLY; | ||||
|     } else { | ||||
|         open_flags = O_RDWR; | ||||
|         open_flags |= O_RDWR; | ||||
|     } | ||||
|  | ||||
|     do { | ||||
| @@ -2707,16 +2687,24 @@ JANET_CORE_FN(os_open, | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(os_pipe, | ||||
|               "(os/pipe)", | ||||
|               "(os/pipe &opt flags)", | ||||
|               "Create a readable stream and a writable stream that are connected. Returns a two-element " | ||||
|               "tuple where the first element is a readable stream and the second element is the writable " | ||||
|               "stream.") { | ||||
|               "stream. `flags` is a keyword set of flags to disable non-blocking settings on the ends of the pipe. " | ||||
|               "This may be desired if passing the pipe to a subprocess with `os/spawn`.\n\n" | ||||
|               "* :W - sets the writable end of the pipe to a blocking stream.\n" | ||||
|               "* :R - sets the readable end of the pipe to a blocking stream.\n\n" | ||||
|               "By default, both ends of the pipe are non-blocking for use with the `ev` module.") { | ||||
|     (void) argv; | ||||
|     janet_fixarity(argc, 0); | ||||
|     janet_arity(argc, 0, 1); | ||||
|     JanetHandle fds[2]; | ||||
|     if (janet_make_pipe(fds, 0)) janet_panicv(janet_ev_lasterr()); | ||||
|     JanetStream *reader = janet_stream(fds[0], JANET_STREAM_READABLE, NULL); | ||||
|     JanetStream *writer = janet_stream(fds[1], JANET_STREAM_WRITABLE, NULL); | ||||
|     int flags = 0; | ||||
|     if (argc > 0 && !janet_checktype(argv[0], JANET_NIL)) { | ||||
|         flags = (int) janet_getflags(argv, 0, "WR"); | ||||
|     } | ||||
|     if (janet_make_pipe(fds, flags)) janet_panicv(janet_ev_lasterr()); | ||||
|     JanetStream *reader = janet_stream(fds[0], (flags & 2) ? 0 : JANET_STREAM_READABLE, NULL); | ||||
|     JanetStream *writer = janet_stream(fds[1], (flags & 1) ? 0 : JANET_STREAM_WRITABLE, NULL); | ||||
|     Janet tup[2] = {janet_wrap_abstract(reader), janet_wrap_abstract(writer)}; | ||||
|     return janet_wrap_tuple(janet_tuple_n(tup, 2)); | ||||
| } | ||||
| @@ -2820,8 +2808,5 @@ void janet_lib_os(JanetTable *env) { | ||||
| #endif | ||||
|         JANET_REG_END | ||||
|     }; | ||||
| #if defined(JANET_WINDOWS) && !defined(JANET_REDUCED_OS) | ||||
|     _configthreadlocale(_ENABLE_PER_THREAD_LOCALE); | ||||
| #endif | ||||
|     janet_core_cfuns_ext(env, NULL, os_cfuns); | ||||
| } | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -231,7 +231,7 @@ static void delim_error(JanetParser *parser, size_t stack_index, char c, const c | ||||
|                 janet_buffer_push_u8(buffer, '`'); | ||||
|             } | ||||
|         } | ||||
|         janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column); | ||||
|         janet_formatb(buffer, " opened at line %d, column %d", (int32_t) s->line, (int32_t) s->column); | ||||
|     } | ||||
|     parser->error = (const char *) janet_string(buffer->data, buffer->count); | ||||
|     parser->flag |= JANET_PARSER_GENERATED_ERROR; | ||||
| @@ -363,8 +363,7 @@ static int stringend(JanetParser *p, JanetParseState *state) { | ||||
|         JanetParseState top = p->states[p->statecount - 1]; | ||||
|         int32_t indent_col = (int32_t) top.column - 1; | ||||
|         uint8_t *r = bufstart, *end = r + buflen; | ||||
|         /* Check if there are any characters before the start column - | ||||
|          * if so, do not reindent. */ | ||||
|         /* Unless there are only spaces before EOLs, disable reindenting */ | ||||
|         int reindent = 1; | ||||
|         while (reindent && (r < end)) { | ||||
|             if (*r++ == '\n') { | ||||
| @@ -374,34 +373,36 @@ static int stringend(JanetParser *p, JanetParseState *state) { | ||||
|                         break; | ||||
|                     } | ||||
|                 } | ||||
|                 if ((r + 1) < end && *r == '\r' && *(r + 1) == '\n') reindent = 1; | ||||
|             } | ||||
|         } | ||||
|         /* Now reindent if able to, otherwise just drop leading newline. */ | ||||
|         if (!reindent) { | ||||
|             if (buflen > 0 && bufstart[0] == '\n') { | ||||
|                 buflen--; | ||||
|                 bufstart++; | ||||
|             } | ||||
|         } else { | ||||
|         /* Now reindent if able */ | ||||
|         if (reindent) { | ||||
|             uint8_t *w = bufstart; | ||||
|             r = bufstart; | ||||
|             while (r < end) { | ||||
|                 if (*r == '\n') { | ||||
|                     if (r == bufstart) { | ||||
|                         /* Skip leading newline */ | ||||
|                         r++; | ||||
|                     } else { | ||||
|                         *w++ = *r++; | ||||
|                     } | ||||
|                     *w++ = *r++; | ||||
|                     for (int32_t j = 0; (r < end) && (*r != '\n') && (j < indent_col); j++, r++); | ||||
|                     if ((r + 1) < end && *r == '\r' && *(r + 1) == '\n') *w++ = *r++; | ||||
|                 } else { | ||||
|                     *w++ = *r++; | ||||
|                 } | ||||
|             } | ||||
|             buflen = (int32_t)(w - bufstart); | ||||
|         } | ||||
|         /* Check for trailing newline character so we can remove it */ | ||||
|         if (buflen > 0 && bufstart[buflen - 1] == '\n') { | ||||
|         /* Check for leading EOL so we can remove it */ | ||||
|         if (buflen > 1 && bufstart[0] == '\r' && bufstart[1] == '\n') { /* Windows EOL */ | ||||
|             buflen = buflen - 2; | ||||
|             bufstart = bufstart + 2; | ||||
|         } else if (buflen > 0 && bufstart[0] == '\n') { /* Unix EOL */ | ||||
|             buflen--; | ||||
|             bufstart++; | ||||
|         } | ||||
|         /* Check for trailing EOL so we can remove it */ | ||||
|         if (buflen > 1 && bufstart[buflen - 2] == '\r' && bufstart[buflen - 1] == '\n') { /* Windows EOL */ | ||||
|             buflen = buflen - 2; | ||||
|         } else if (buflen > 0 && bufstart[buflen - 1] == '\n') { /* Unix EOL */ | ||||
|             buflen--; | ||||
|         } | ||||
|     } | ||||
| @@ -467,8 +468,13 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) { | ||||
|             return 0; | ||||
|         } | ||||
|         ret = janet_keywordv(p->buf + 1, blen - 1); | ||||
| #ifdef JANET_INT_TYPES | ||||
|     } else if (start_num && !janet_scan_numeric(p->buf, blen, &ret)) { | ||||
|         (void) numval; | ||||
| #else | ||||
|     } else if (start_num && !janet_scan_number(p->buf, blen, &numval)) { | ||||
|         ret = janet_wrap_number(numval); | ||||
| #endif | ||||
|     } else if (!check_str_const("nil", p->buf, blen)) { | ||||
|         ret = janet_wrap_nil(); | ||||
|     } else if (!check_str_const("false", p->buf, blen)) { | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -134,7 +134,7 @@ static LineCol get_linecol_from_position(PegState *s, int32_t position) { | ||||
|      *   a newline character is consider to be on the same line as the character before | ||||
|      *   (\n is line terminator, not line separator). | ||||
|      * - in the not-found case, we still want to find the greatest-indexed newline that | ||||
|      *   is before position. we use that to calcuate the line and column. | ||||
|      *   is before position. we use that to calculate the line and column. | ||||
|      * - in the case that lo = 0 and s->linemap[0] is still greater than position, we | ||||
|      *   are on the first line and our column is position + 1. */ | ||||
|     int32_t hi = s->linemaplen; /* hi is greater than the actual line */ | ||||
| @@ -465,6 +465,16 @@ tail: | ||||
|             return result; | ||||
|         } | ||||
|  | ||||
|         case RULE_ONLY_TAGS: { | ||||
|             CapState cs = cap_save(s); | ||||
|             down1(s); | ||||
|             const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text); | ||||
|             up1(s); | ||||
|             if (!result) return NULL; | ||||
|             cap_load_keept(s, cs); | ||||
|             return result; | ||||
|         } | ||||
|  | ||||
|         case RULE_GROUP: { | ||||
|             uint32_t tag = rule[2]; | ||||
|             int oldmode = s->mode; | ||||
| @@ -486,6 +496,30 @@ tail: | ||||
|             return result; | ||||
|         } | ||||
|  | ||||
|         case RULE_NTH: { | ||||
|             uint32_t nth = rule[1]; | ||||
|             if (nth > INT32_MAX) nth = INT32_MAX; | ||||
|             uint32_t tag = rule[3]; | ||||
|             int oldmode = s->mode; | ||||
|             CapState cs = cap_save(s); | ||||
|             s->mode = PEG_MODE_NORMAL; | ||||
|             down1(s); | ||||
|             const uint8_t *result = peg_rule(s, s->bytecode + rule[2], text); | ||||
|             up1(s); | ||||
|             s->mode = oldmode; | ||||
|             if (!result) return NULL; | ||||
|             int32_t num_sub_captures = s->captures->count - cs.cap; | ||||
|             Janet cap; | ||||
|             if (num_sub_captures > (int32_t) nth) { | ||||
|                 cap = s->captures->data[cs.cap + nth]; | ||||
|             } else { | ||||
|                 return NULL; | ||||
|             } | ||||
|             cap_load_keept(s, cs); | ||||
|             pushcap(s, cap, tag); | ||||
|             return result; | ||||
|         } | ||||
|  | ||||
|         case RULE_SUB: { | ||||
|             const uint8_t *text_start = text; | ||||
|             const uint32_t *rule_window = s->bytecode + rule[1]; | ||||
| @@ -667,11 +701,11 @@ tail: | ||||
|         case RULE_READINT: { | ||||
|             uint32_t tag = rule[2]; | ||||
|             uint32_t signedness = rule[1] & 0x10; | ||||
|             uint32_t endianess = rule[1] & 0x20; | ||||
|             uint32_t endianness = rule[1] & 0x20; | ||||
|             int width = (int)(rule[1] & 0xF); | ||||
|             if (text + width > s->text_end) return NULL; | ||||
|             uint64_t accum = 0; | ||||
|             if (endianess) { | ||||
|             if (endianness) { | ||||
|                 /* BE */ | ||||
|                 for (int i = 0; i < width; i++) accum = (accum << 8) | text[i]; | ||||
|             } else { | ||||
| @@ -1061,6 +1095,9 @@ static void spec_thru(Builder *b, int32_t argc, const Janet *argv) { | ||||
| static void spec_drop(Builder *b, int32_t argc, const Janet *argv) { | ||||
|     spec_onerule(b, argc, argv, RULE_DROP); | ||||
| } | ||||
| static void spec_only_tags(Builder *b, int32_t argc, const Janet *argv) { | ||||
|     spec_onerule(b, argc, argv, RULE_ONLY_TAGS); | ||||
| } | ||||
|  | ||||
| /* Rule of the form [rule, tag] */ | ||||
| static void spec_cap1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) { | ||||
| @@ -1084,6 +1121,15 @@ static void spec_unref(Builder *b, int32_t argc, const Janet *argv) { | ||||
|     spec_cap1(b, argc, argv, RULE_UNREF); | ||||
| } | ||||
|  | ||||
| static void spec_nth(Builder *b, int32_t argc, const Janet *argv) { | ||||
|     peg_arity(b, argc, 2, 3); | ||||
|     Reserve r = reserve(b, 4); | ||||
|     uint32_t nth = peg_getnat(b, argv[0]); | ||||
|     uint32_t rule = peg_compile1(b, argv[1]); | ||||
|     uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0; | ||||
|     emit_3(r, RULE_NTH, nth, rule, tag); | ||||
| } | ||||
|  | ||||
| static void spec_capture_number(Builder *b, int32_t argc, const Janet *argv) { | ||||
|     peg_arity(b, argc, 1, 3); | ||||
|     Reserve r = reserve(b, 4); | ||||
| @@ -1262,7 +1308,9 @@ static const SpecialPair peg_specials[] = { | ||||
|     {"line", spec_line}, | ||||
|     {"look", spec_look}, | ||||
|     {"not", spec_not}, | ||||
|     {"nth", spec_nth}, | ||||
|     {"number", spec_capture_number}, | ||||
|     {"only-tags", spec_only_tags}, | ||||
|     {"opt", spec_opt}, | ||||
|     {"position", spec_position}, | ||||
|     {"quote", spec_capture}, | ||||
| @@ -1619,6 +1667,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) { | ||||
|                 break; | ||||
|             case RULE_ERROR: | ||||
|             case RULE_DROP: | ||||
|             case RULE_ONLY_TAGS: | ||||
|             case RULE_NOT: | ||||
|             case RULE_TO: | ||||
|             case RULE_THRU: | ||||
| @@ -1628,10 +1677,16 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) { | ||||
|                 i += 2; | ||||
|                 break; | ||||
|             case RULE_READINT: | ||||
|                 /* [ width | (endianess << 5) | (signedness << 6), tag ] */ | ||||
|                 /* [ width | (endianness << 5) | (signedness << 6), tag ] */ | ||||
|                 if (rule[1] > JANET_MAX_READINT_WIDTH) goto bad; | ||||
|                 i += 3; | ||||
|                 break; | ||||
|             case RULE_NTH: | ||||
|                 /* [nth, rule, tag] */ | ||||
|                 if (rule[2] >= blen) goto bad; | ||||
|                 op_flags[rule[2]] |= 0x01; | ||||
|                 i += 4; | ||||
|                 break; | ||||
|             default: | ||||
|                 goto bad; | ||||
|         } | ||||
| @@ -1725,7 +1780,7 @@ static JanetPeg *compile_peg(Janet x) { | ||||
| JANET_CORE_FN(cfun_peg_compile, | ||||
|               "(peg/compile peg)", | ||||
|               "Compiles a peg source data structure into a <core/peg>. This will speed up matching " | ||||
|               "if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to suppliment " | ||||
|               "if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to supplement " | ||||
|               "the grammar of the peg for otherwise undefined peg keywords.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetPeg *peg = compile_peg(argv[0]); | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -379,15 +379,10 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) { | ||||
|             break; | ||||
|         case JANET_NUMBER: | ||||
|             janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2); | ||||
|             int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x)); | ||||
|             /* fix locale issues with commas */ | ||||
|             for (int i = 0; i < count; i++) { | ||||
|                 char c = S->buffer->data[S->buffer->count + i]; | ||||
|                 if (c == ',' || c == '\'') { | ||||
|                     S->buffer->data[S->buffer->count + i] = '.'; | ||||
|                 } | ||||
|             } | ||||
|             S->buffer->count += count; | ||||
|             double num = janet_unwrap_number(x); | ||||
|             if (isnan(num)) return 1; | ||||
|             if (isinf(num)) return 1; | ||||
|             janet_buffer_dtostr(S->buffer, num); | ||||
|             break; | ||||
|         case JANET_SYMBOL: | ||||
|         case JANET_KEYWORD: | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -925,6 +925,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|     int structarg = 0; | ||||
|     int allow_extra = 0; | ||||
|     int selfref = 0; | ||||
|     int hasname = 0; | ||||
|     int seenamp = 0; | ||||
|     int seenopt = 0; | ||||
|     int namedargs = 0; | ||||
| @@ -943,6 +944,10 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|     head = argv[0]; | ||||
|     if (janet_checktype(head, JANET_SYMBOL)) { | ||||
|         selfref = 1; | ||||
|         hasname = 1; | ||||
|         parami = 1; | ||||
|     } else if (janet_checktype(head, JANET_KEYWORD)) { | ||||
|         hasname = 1; | ||||
|         parami = 1; | ||||
|     } | ||||
|     if (parami >= argn || !janet_checktype(argv[parami], JANET_TUPLE)) { | ||||
| @@ -1103,7 +1108,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|     if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG; | ||||
|     if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG; | ||||
|  | ||||
|     if (selfref) def->name = janet_unwrap_symbol(head); | ||||
|     if (hasname) def->name = janet_unwrap_symbol(head); /* Also correctly unwraps keyword */ | ||||
|     janet_def_addflags(def); | ||||
|     defindex = janetc_addfuncdef(c, def); | ||||
|  | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -58,7 +58,7 @@ void janet_vm_load(JanetVM *from) { | ||||
| } | ||||
|  | ||||
| /* Trigger suspension of the Janet vm by trying to | ||||
|  * exit the interpeter loop when convenient. You can optionally | ||||
|  * exit the interpreter loop when convenient. You can optionally | ||||
|  * use NULL to interrupt the current VM when convenient */ | ||||
| void janet_interpreter_interrupt(JanetVM *vm) { | ||||
|     vm = vm ? vm : &janet_vm; | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -100,6 +100,7 @@ struct JanetVM { | ||||
|      * return point for panics. */ | ||||
|     jmp_buf *signal_buf; | ||||
|     Janet *return_reg; | ||||
|     int coerce_error; | ||||
|  | ||||
|     /* The global registry for c functions. Used to store meta-data | ||||
|      * along with otherwise bare c function pointers. */ | ||||
| @@ -149,6 +150,11 @@ struct JanetVM { | ||||
|     JanetTraversalNode *traversal_top; | ||||
|     JanetTraversalNode *traversal_base; | ||||
|  | ||||
|     /* Thread safe strerror error buffer - for janet_strerror */ | ||||
| #ifndef JANET_WINDOWS | ||||
|     char strerror_buf[256]; | ||||
| #endif | ||||
|  | ||||
|     /* Event loop and scheduler globals */ | ||||
| #ifdef JANET_EV | ||||
|     size_t tq_count; | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -71,10 +71,10 @@ int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs) { | ||||
| int janet_string_equalconst(const uint8_t *lhs, const uint8_t *rhs, int32_t rlen, int32_t rhash) { | ||||
|     int32_t lhash = janet_string_hash(lhs); | ||||
|     int32_t llen = janet_string_length(lhs); | ||||
|     if (lhs == rhs) | ||||
|         return 1; | ||||
|     if (lhash != rhash || llen != rlen) | ||||
|         return 0; | ||||
|     if (lhs == rhs) | ||||
|         return 1; | ||||
|     return !memcmp(lhs, rhs, rlen); | ||||
| } | ||||
|  | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -34,9 +34,9 @@ | ||||
|  * because E is a valid digit in bases 15 or greater. For bases greater than | ||||
|  * 10, the letters are used as digits. A through Z correspond to the digits 10 | ||||
|  * through 35, and the lowercase letters have the same values. The radix number | ||||
|  * is always in base 10. For example, a hexidecimal number could be written | ||||
|  * is always in base 10. For example, a hexadecimal number could be written | ||||
|  * '16rdeadbeef'. janet_scan_number also supports some c style syntax for | ||||
|  * hexidecimal literals. The previous number could also be written | ||||
|  * hexadecimal literals. The previous number could also be written | ||||
|  * '0xdeadbeef'. | ||||
|  */ | ||||
|  | ||||
| @@ -489,4 +489,53 @@ int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out) { | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| /* Similar to janet_scan_number but allows for | ||||
|  * more numeric types with a given suffix. */ | ||||
| int janet_scan_numeric( | ||||
|     const uint8_t *str, | ||||
|     int32_t len, | ||||
|     Janet *out) { | ||||
|     int result; | ||||
|     double num; | ||||
|     int64_t i64 = 0; | ||||
|     uint64_t u64 = 0; | ||||
|     if (len < 2 || str[len - 2] != ':') { | ||||
|         result = janet_scan_number_base(str, len, 0, &num); | ||||
|         *out = janet_wrap_number(num); | ||||
|         return result; | ||||
|     } | ||||
|     switch (str[len - 1]) { | ||||
|         default: | ||||
|             return 1; | ||||
|         case 'n': | ||||
|             result = janet_scan_number_base(str, len - 2, 0, &num); | ||||
|             *out = janet_wrap_number(num); | ||||
|             return result; | ||||
|         /* Condition is inverted janet_scan_int64 and janet_scan_uint64 */ | ||||
|         case 's': | ||||
|             result = !janet_scan_int64(str, len - 2, &i64); | ||||
|             *out = janet_wrap_s64(i64); | ||||
|             return result; | ||||
|         case 'u': | ||||
|             result = !janet_scan_uint64(str, len - 2, &u64); | ||||
|             *out = janet_wrap_u64(u64); | ||||
|             return result; | ||||
|     } | ||||
| } | ||||
|  | ||||
| #endif | ||||
|  | ||||
| void janet_buffer_dtostr(JanetBuffer *buffer, double x) { | ||||
| #define BUFSIZE 32 | ||||
|     janet_buffer_extra(buffer, BUFSIZE); | ||||
|     int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, "%.17g", x); | ||||
| #undef BUFSIZE | ||||
|     /* fix locale issues with commas */ | ||||
|     for (int i = 0; i < count; i++) { | ||||
|         char c = buffer->data[buffer->count + i]; | ||||
|         if (c == ',') { | ||||
|             buffer->data[buffer->count + i] = '.'; | ||||
|         } | ||||
|     } | ||||
|     buffer->count += count; | ||||
| } | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -294,6 +294,16 @@ JANET_CORE_FN(cfun_struct_to_table, | ||||
|     return janet_wrap_table(tab); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_struct_rawget, | ||||
|               "(struct/rawget st key)", | ||||
|               "Gets a value from a struct `st` without looking at the prototype struct. " | ||||
|               "If `st` does not contain the key directly, the function will return " | ||||
|               "nil without checking the prototype. Returns the value in the struct.") { | ||||
|     janet_fixarity(argc, 2); | ||||
|     JanetStruct st = janet_getstruct(argv, 0); | ||||
|     return janet_struct_rawget(st, argv[1]); | ||||
| } | ||||
|  | ||||
| /* Load the struct module */ | ||||
| void janet_lib_struct(JanetTable *env) { | ||||
|     JanetRegExt struct_cfuns[] = { | ||||
| @@ -301,6 +311,7 @@ void janet_lib_struct(JanetTable *env) { | ||||
|         JANET_CORE_REG("struct/getproto", cfun_struct_getproto), | ||||
|         JANET_CORE_REG("struct/proto-flatten", cfun_struct_flatten), | ||||
|         JANET_CORE_REG("struct/to-table", cfun_struct_to_table), | ||||
|         JANET_CORE_REG("struct/rawget", cfun_struct_rawget), | ||||
|         JANET_REG_END | ||||
|     }; | ||||
|     janet_core_cfuns_ext(env, NULL, struct_cfuns); | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -67,7 +67,7 @@ static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, in | ||||
|     return table; | ||||
| } | ||||
|  | ||||
| /* Initialize a table (for use withs scratch memory) */ | ||||
| /* Initialize a table (for use with scratch memory) */ | ||||
| JanetTable *janet_table_init(JanetTable *table, int32_t capacity) { | ||||
|     return janet_table_init_impl(table, capacity, 1); | ||||
| } | ||||
| @@ -319,13 +319,6 @@ JANET_CORE_FN(cfun_table_new, | ||||
|     int32_t cap = janet_getnat(argv, 0); | ||||
|     return janet_wrap_table(janet_table(cap)); | ||||
| } | ||||
| /* | ||||
|     uint32_t flags = janet_getflags(argv, 1, "kv"); | ||||
|     if (flags == 0) return janet_wrap_table(janet_table(cap)); | ||||
|     if (flags == 1) return janet_wrap_table(janet_table_weakk(cap)); | ||||
|     if (flags == 2) return janet_wrap_table(janet_table_weakv(cap)); | ||||
|     return janet_wrap_table(janet_table_weakkv(cap)); | ||||
|     */ | ||||
|  | ||||
| JANET_CORE_FN(cfun_table_weak, | ||||
|               "(table/weak capacity)", | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -116,6 +116,34 @@ JANET_CORE_FN(cfun_tuple_setmap, | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_tuple_join, | ||||
|               "(tuple/join & parts)", | ||||
|               "Create a tuple by joining together other tuples and arrays.") { | ||||
|     janet_arity(argc, 0, -1); | ||||
|     int32_t total_len = 0; | ||||
|     for (int32_t i = 0; i < argc; i++) { | ||||
|         int32_t len = 0; | ||||
|         const Janet *vals = NULL; | ||||
|         if (!janet_indexed_view(argv[i], &vals, &len)) { | ||||
|             janet_panicf("expected indexed type for argument %d, got %v", i, argv[i]); | ||||
|         } | ||||
|         if (INT32_MAX - total_len < len) { | ||||
|             janet_panic("tuple too large"); | ||||
|         } | ||||
|         total_len += len; | ||||
|     } | ||||
|     Janet *tup = janet_tuple_begin(total_len); | ||||
|     Janet *tup_cursor = tup; | ||||
|     for (int32_t i = 0; i < argc; i++) { | ||||
|         int32_t len = 0; | ||||
|         const Janet *vals = NULL; | ||||
|         janet_indexed_view(argv[i], &vals, &len); | ||||
|         memcpy(tup_cursor, vals, len * sizeof(Janet)); | ||||
|         tup_cursor += len; | ||||
|     } | ||||
|     return janet_wrap_tuple(janet_tuple_end(tup)); | ||||
| } | ||||
|  | ||||
| /* Load the tuple module */ | ||||
| void janet_lib_tuple(JanetTable *env) { | ||||
|     JanetRegExt tuple_cfuns[] = { | ||||
| @@ -124,6 +152,7 @@ void janet_lib_tuple(JanetTable *env) { | ||||
|         JANET_CORE_REG("tuple/type", cfun_tuple_type), | ||||
|         JANET_CORE_REG("tuple/sourcemap", cfun_tuple_sourcemap), | ||||
|         JANET_CORE_REG("tuple/setmap", cfun_tuple_setmap), | ||||
|         JANET_CORE_REG("tuple/join", cfun_tuple_join), | ||||
|         JANET_REG_END | ||||
|     }; | ||||
|     janet_core_cfuns_ext(env, NULL, tuple_cfuns); | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -79,6 +79,7 @@ const char *const janet_type_names[16] = { | ||||
|     "pointer" | ||||
| }; | ||||
|  | ||||
| /* Docstring for signal lists these */ | ||||
| const char *const janet_signal_names[14] = { | ||||
|     "ok", | ||||
|     "error", | ||||
| @@ -96,6 +97,7 @@ const char *const janet_signal_names[14] = { | ||||
|     "await" | ||||
| }; | ||||
|  | ||||
| /* Docstring for fiber/status lists these */ | ||||
| const char *const janet_status_names[16] = { | ||||
|     "dead", | ||||
|     "error", | ||||
| @@ -115,14 +117,20 @@ const char *const janet_status_names[16] = { | ||||
|     "alive" | ||||
| }; | ||||
|  | ||||
| uint32_t janet_hash_mix(uint32_t input, uint32_t more) { | ||||
|     uint32_t mix1 = (more + 0x9e3779b9 + (input << 6) + (input >> 2)); | ||||
|     return input ^ (0x9e3779b9 + (mix1 << 6) + (mix1 >> 2)); | ||||
| } | ||||
|  | ||||
| #ifndef JANET_PRF | ||||
|  | ||||
| int32_t janet_string_calchash(const uint8_t *str, int32_t len) { | ||||
|     if (NULL == str) return 5381; | ||||
|     if (NULL == str || len == 0) return 5381; | ||||
|     const uint8_t *end = str + len; | ||||
|     uint32_t hash = 5381; | ||||
|     while (str < end) | ||||
|         hash = (hash << 5) + hash + *str++; | ||||
|     hash = janet_hash_mix(hash, (uint32_t) len); | ||||
|     return (int32_t) hash; | ||||
| } | ||||
|  | ||||
| @@ -238,11 +246,6 @@ int32_t janet_string_calchash(const uint8_t *str, int32_t len) { | ||||
|  | ||||
| #endif | ||||
|  | ||||
| uint32_t janet_hash_mix(uint32_t input, uint32_t more) { | ||||
|     uint32_t mix1 = (more + 0x9e3779b9 + (input << 6) + (input >> 2)); | ||||
|     return input ^ (0x9e3779b9 + (mix1 << 6) + (mix1 >> 2)); | ||||
| } | ||||
|  | ||||
| /* Computes hash of an array of values */ | ||||
| int32_t janet_array_calchash(const Janet *array, int32_t len) { | ||||
|     const Janet *end = array + len; | ||||
| @@ -826,6 +829,20 @@ int janet_checkuint64(Janet x) { | ||||
|     return janet_checkuint64range(dval); | ||||
| } | ||||
|  | ||||
| int janet_checkint16(Janet x) { | ||||
|     if (!janet_checktype(x, JANET_NUMBER)) | ||||
|         return 0; | ||||
|     double dval = janet_unwrap_number(x); | ||||
|     return janet_checkint16range(dval); | ||||
| } | ||||
|  | ||||
| int janet_checkuint16(Janet x) { | ||||
|     if (!janet_checktype(x, JANET_NUMBER)) | ||||
|         return 0; | ||||
|     double dval = janet_unwrap_number(x); | ||||
|     return janet_checkuint16range(dval); | ||||
| } | ||||
|  | ||||
| int janet_checksize(Janet x) { | ||||
|     if (!janet_checktype(x, JANET_NUMBER)) | ||||
|         return 0; | ||||
| @@ -953,6 +970,20 @@ int janet_gettime(struct timespec *spec, enum JanetTimeSource source) { | ||||
| #endif | ||||
| #endif | ||||
|  | ||||
| /* Better strerror (thread-safe if available) */ | ||||
| const char *janet_strerror(int e) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     /* Microsoft strerror seems sane here and is thread safe by default */ | ||||
|     return strerror(e); | ||||
| #elif defined(__GLIBC__) | ||||
|     /* See https://linux.die.net/man/3/strerror_r */ | ||||
|     return strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf)); | ||||
| #else | ||||
|     strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf)); | ||||
|     return janet_vm.strerror_buf; | ||||
| #endif | ||||
| } | ||||
|  | ||||
| /* Setting C99 standard makes this not available, but it should | ||||
|  * work/link properly if we detect a BSD */ | ||||
| #if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7) | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -33,6 +33,7 @@ | ||||
| #include <errno.h> | ||||
| #include <stddef.h> | ||||
| #include <stdbool.h> | ||||
| #include <math.h> | ||||
|  | ||||
| #ifdef JANET_EV | ||||
| #ifndef JANET_WINDOWS | ||||
| @@ -80,6 +81,8 @@ void janet_memempty(JanetKV *mem, int32_t count); | ||||
| void *janet_memalloc_empty(int32_t count); | ||||
| JanetTable *janet_get_core_table(const char *name); | ||||
| void janet_def_addflags(JanetFuncDef *def); | ||||
| void janet_buffer_dtostr(JanetBuffer *buffer, double x); | ||||
| const char *janet_strerror(int e); | ||||
| const void *janet_strbinsearch( | ||||
|     const void *tab, | ||||
|     size_t tabcount, | ||||
| @@ -139,7 +142,7 @@ int janet_gettime(struct timespec *spec, enum JanetTimeSource source); | ||||
| #define strdup(x) _strdup(x) | ||||
| #endif | ||||
|  | ||||
| /* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries | ||||
| /* Use LoadLibrary on windows or dlopen on posix to load dynamic libraries | ||||
|  * with native code. */ | ||||
| #if defined(JANET_NO_DYNAMIC_MODULES) | ||||
| typedef int Clib; | ||||
| @@ -187,9 +190,6 @@ void janet_lib_debug(JanetTable *env); | ||||
| #ifdef JANET_PEG | ||||
| void janet_lib_peg(JanetTable *env); | ||||
| #endif | ||||
| #ifdef JANET_TYPED_ARRAY | ||||
| void janet_lib_typed_array(JanetTable *env); | ||||
| #endif | ||||
| #ifdef JANET_INT_TYPES | ||||
| void janet_lib_inttypes(JanetTable *env); | ||||
| #endif | ||||
| @@ -200,10 +200,14 @@ extern const JanetAbstractType janet_address_type; | ||||
| #ifdef JANET_EV | ||||
| void janet_lib_ev(JanetTable *env); | ||||
| void janet_ev_mark(void); | ||||
| void janet_async_start_fiber(JanetFiber *fiber, JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state); | ||||
| int janet_make_pipe(JanetHandle handles[2], int mode); | ||||
| #ifdef JANET_FILEWATCH | ||||
| void janet_lib_filewatch(JanetTable *env); | ||||
| #endif | ||||
| #ifdef JANET_FFI | ||||
| void janet_lib_ffi(JanetTable *env); | ||||
| #endif | ||||
| #endif | ||||
|  | ||||
| #endif | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -318,7 +318,7 @@ static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lh | ||||
|         Janet lr = janet_method_lookup(rhs, rmethod); | ||||
|         Janet argv[2] = { rhs, lhs }; | ||||
|         if (janet_checktype(lr, JANET_NIL)) { | ||||
|             janet_panicf("could not find method :%s for %v, or :%s for %v", | ||||
|             janet_panicf("could not find method :%s for %v or :%s for %v", | ||||
|                          lmethod, lhs, | ||||
|                          rmethod, rhs); | ||||
|         } | ||||
| @@ -1268,7 +1268,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { | ||||
| /* | ||||
|  * Execute a single instruction in the fiber. Does this by inspecting | ||||
|  * the fiber, setting a breakpoint at the next instruction, executing, and | ||||
|  * reseting breakpoints to how they were prior. Yes, it's a bit hacky. | ||||
|  * resetting breakpoints to how they were prior. Yes, it's a bit hacky. | ||||
|  */ | ||||
| JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) { | ||||
|     /* No finished or currently alive fibers. */ | ||||
| @@ -1373,7 +1373,10 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) { | ||||
|  | ||||
|     /* Run vm */ | ||||
|     janet_vm.fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP; | ||||
|     int old_coerce_error = janet_vm.coerce_error; | ||||
|     janet_vm.coerce_error = 1; | ||||
|     JanetSignal signal = run_vm(janet_vm.fiber, janet_wrap_nil()); | ||||
|     janet_vm.coerce_error = old_coerce_error; | ||||
|  | ||||
|     /* Teardown */ | ||||
|     janet_vm.stackn = oldn; | ||||
| @@ -1384,6 +1387,10 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) { | ||||
|     } | ||||
|  | ||||
|     if (signal != JANET_SIGNAL_OK) { | ||||
|         /* Should match logic in janet_signalv */ | ||||
|         if (signal != JANET_SIGNAL_ERROR) { | ||||
|             *janet_vm.return_reg = janet_wrap_string(janet_formatc("%v coerced from %s to error", *janet_vm.return_reg, janet_signal_names[signal])); | ||||
|         } | ||||
|         janet_panicv(*janet_vm.return_reg); | ||||
|     } | ||||
|  | ||||
| @@ -1430,8 +1437,10 @@ void janet_try_init(JanetTryState *state) { | ||||
|     state->vm_fiber = janet_vm.fiber; | ||||
|     state->vm_jmp_buf = janet_vm.signal_buf; | ||||
|     state->vm_return_reg = janet_vm.return_reg; | ||||
|     state->coerce_error = janet_vm.coerce_error; | ||||
|     janet_vm.return_reg = &(state->payload); | ||||
|     janet_vm.signal_buf = &(state->buf); | ||||
|     janet_vm.coerce_error = 0; | ||||
| } | ||||
|  | ||||
| void janet_restore(JanetTryState *state) { | ||||
| @@ -1440,6 +1449,7 @@ void janet_restore(JanetTryState *state) { | ||||
|     janet_vm.fiber = state->vm_fiber; | ||||
|     janet_vm.signal_buf = state->vm_jmp_buf; | ||||
|     janet_vm.return_reg = state->vm_return_reg; | ||||
|     janet_vm.coerce_error = state->coerce_error; | ||||
| } | ||||
|  | ||||
| static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) { | ||||
| @@ -1613,7 +1623,7 @@ int janet_init(void) { | ||||
|     janet_vm.registry_count = 0; | ||||
|     janet_vm.registry_dirty = 0; | ||||
|  | ||||
|     /* Intialize abstract registry */ | ||||
|     /* Initialize abstract registry */ | ||||
|     janet_vm.abstract_registry = janet_table(0); | ||||
|     janet_gcroot(janet_wrap_table(janet_vm.abstract_registry)); | ||||
|  | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -46,7 +46,7 @@ extern "C" { | ||||
| #endif | ||||
|  | ||||
| /* | ||||
|  * Detect OS and endianess. | ||||
|  * Detect OS and endianness. | ||||
|  * From webkit source. There is likely some extreneous | ||||
|  * detection for unsupported platforms | ||||
|  */ | ||||
| @@ -210,6 +210,11 @@ extern "C" { | ||||
| #define JANET_EV | ||||
| #endif | ||||
|  | ||||
| /* Enable or disable the filewatch/ module */ | ||||
| #if !defined(JANET_NO_FILEWATCH) | ||||
| #define JANET_FILEWATCH | ||||
| #endif | ||||
|  | ||||
| /* Enable or disable networking */ | ||||
| #if defined(JANET_EV) && !defined(JANET_NO_NET) && !defined(__EMSCRIPTEN__) | ||||
| #define JANET_NET | ||||
| @@ -262,7 +267,7 @@ extern "C" { | ||||
| #endif | ||||
| #endif | ||||
|  | ||||
| /* Tell complier some functions don't return */ | ||||
| /* Tell compiler some functions don't return */ | ||||
| #ifndef JANET_NO_RETURN | ||||
| #ifdef JANET_WINDOWS | ||||
| #define JANET_NO_RETURN __declspec(noreturn) | ||||
| @@ -272,7 +277,7 @@ extern "C" { | ||||
| #endif | ||||
|  | ||||
| /* Prevent some recursive functions from recursing too deeply | ||||
|  * ands crashing (the parser). Instead, error out. */ | ||||
|  * and crashing (the parser). Instead, error out. */ | ||||
| #define JANET_RECURSION_GUARD 1024 | ||||
|  | ||||
| /* Maximum depth to follow table prototypes before giving up and returning nil. */ | ||||
| @@ -354,6 +359,7 @@ typedef struct { | ||||
| #ifdef JANET_EV | ||||
| typedef struct JanetOSMutex JanetOSMutex; | ||||
| typedef struct JanetOSRWLock JanetOSRWLock; | ||||
| typedef struct JanetChannel JanetChannel; | ||||
| #endif | ||||
|  | ||||
| /***** END SECTION CONFIG *****/ | ||||
| @@ -627,7 +633,9 @@ typedef void (*JanetEVCallback)(JanetFiber *fiber, JanetAsyncEvent event); | ||||
|  * call when ever an event is sent from the event loop. state is an optional (can be NULL) | ||||
|  * pointer to data allocated with janet_malloc. This pointer will be passed to callback as | ||||
|  * fiber->ev_state. It will also be freed for you by the runtime when the event loop determines | ||||
|  * it can no longer be referenced. On windows, the contents of state MUST contained an OVERLAPPED struct. */ | ||||
|  * it can no longer be referenced. On windows, the contents of state MUST contained an OVERLAPPED struct at the 0 offset. */ | ||||
|  | ||||
| JANET_API void janet_async_start_fiber(JanetFiber *fiber, JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state); | ||||
| JANET_API JANET_NO_RETURN void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state); | ||||
|  | ||||
| /* Do not send any more events to the given callback. Call this after scheduling fiber to be resume | ||||
| @@ -897,12 +905,16 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer); | ||||
| /* End of tagged union implementation */ | ||||
| #endif | ||||
|  | ||||
| JANET_API int janet_checkint16(Janet x); | ||||
| JANET_API int janet_checkuint16(Janet x); | ||||
| JANET_API int janet_checkint(Janet x); | ||||
| JANET_API int janet_checkuint(Janet x); | ||||
| JANET_API int janet_checkint64(Janet x); | ||||
| JANET_API int janet_checkuint64(Janet x); | ||||
| JANET_API int janet_checksize(Janet x); | ||||
| JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at); | ||||
| #define janet_checkint16range(x) ((x) >= INT16_MIN && (x) <= INT16_MAX && (x) == (int16_t)(x)) | ||||
| #define janet_checkuint16range(x) ((x) >= 0 && (x) <= UINT16_MAX && (x) == (uint16_t)(x)) | ||||
| #define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x)) | ||||
| #define janet_checkuintrange(x) ((x) >= 0 && (x) <= UINT32_MAX && (x) == (uint32_t)(x)) | ||||
| #define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x)) | ||||
| @@ -1249,6 +1261,7 @@ typedef struct { | ||||
|     /* new state */ | ||||
|     jmp_buf buf; | ||||
|     Janet payload; | ||||
|     int coerce_error; | ||||
| } JanetTryState; | ||||
|  | ||||
| /***** END SECTION TYPES *****/ | ||||
| @@ -1409,6 +1422,7 @@ JANET_API void janet_loop1_interrupt(JanetVM *vm); | ||||
|  | ||||
| /* Wrapper around streams */ | ||||
| JANET_API JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods); | ||||
| JANET_API JanetStream *janet_stream_ext(JanetHandle handle, uint32_t flags, const JanetMethod *methods, size_t size); /* Allow for type punning streams */ | ||||
| JANET_API void janet_stream_close(JanetStream *stream); | ||||
| JANET_API Janet janet_cfun_stream_close(int32_t argc, Janet *argv); | ||||
| JANET_API Janet janet_cfun_stream_read(int32_t argc, Janet *argv); | ||||
| @@ -1429,6 +1443,7 @@ JANET_NO_RETURN JANET_API void janet_sleep_await(double sec); | ||||
| /* For use inside listeners - adds a timeout to the current fiber, such that | ||||
|  * it will be resumed after sec seconds if no other event schedules the current fiber. */ | ||||
| JANET_API void janet_addtimeout(double sec); | ||||
| JANET_API void janet_addtimeout_nil(double sec); | ||||
| JANET_API void janet_ev_inc_refcount(void); | ||||
| JANET_API void janet_ev_dec_refcount(void); | ||||
|  | ||||
| @@ -1439,6 +1454,14 @@ JANET_API void *janet_abstract_threaded(const JanetAbstractType *atype, size_t s | ||||
| JANET_API int32_t janet_abstract_incref(void *abst); | ||||
| JANET_API int32_t janet_abstract_decref(void *abst); | ||||
|  | ||||
| /* Expose channel utilities */ | ||||
| JanetChannel *janet_channel_make(uint32_t limit); | ||||
| JanetChannel *janet_channel_make_threaded(uint32_t limit); | ||||
| JanetChannel *janet_getchannel(const Janet *argv, int32_t n); | ||||
| JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_t n, JanetChannel *dflt); | ||||
| JANET_API int janet_channel_give(JanetChannel *channel, Janet x); | ||||
| JANET_API int janet_channel_take(JanetChannel *channel, Janet *out); | ||||
|  | ||||
| /* Expose some OS sync primitives */ | ||||
| JANET_API size_t janet_os_mutex_size(void); | ||||
| JANET_API size_t janet_os_rwlock_size(void); | ||||
| @@ -1594,6 +1617,9 @@ JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out); | ||||
| JANET_API int janet_scan_number_base(const uint8_t *str, int32_t len, int32_t base, double *out); | ||||
| JANET_API int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out); | ||||
| JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out); | ||||
| #ifdef JANET_INT_TYPES | ||||
| JANET_API int janet_scan_numeric(const uint8_t *str, int32_t len, Janet *out); | ||||
| #endif | ||||
|  | ||||
| /* Debugging */ | ||||
| JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc); | ||||
| @@ -1718,6 +1744,9 @@ JANET_API void janet_table_merge_struct(JanetTable *table, JanetStruct other); | ||||
| JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key); | ||||
| JANET_API JanetTable *janet_table_clone(JanetTable *table); | ||||
| JANET_API void janet_table_clear(JanetTable *table); | ||||
| JANET_API JanetTable *janet_table_weakk(int32_t capacity); | ||||
| JANET_API JanetTable *janet_table_weakv(int32_t capacity); | ||||
| JANET_API JanetTable *janet_table_weakkv(int32_t capacity); | ||||
|  | ||||
| /* Fiber */ | ||||
| JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv); | ||||
| @@ -1781,6 +1810,7 @@ JANET_API void janet_gcpressure(size_t s); | ||||
| /* Functions */ | ||||
| JANET_API JanetFuncDef *janet_funcdef_alloc(void); | ||||
| JANET_API JanetFunction *janet_thunk(JanetFuncDef *def); | ||||
| JANET_API JanetFunction *janet_thunk_delay(Janet x); | ||||
| JANET_API int janet_verify(JanetFuncDef *def); | ||||
|  | ||||
| /* Pretty printing */ | ||||
| @@ -2020,7 +2050,10 @@ JANET_API void *janet_getpointer(const Janet *argv, int32_t n); | ||||
|  | ||||
| JANET_API int32_t janet_getnat(const Janet *argv, int32_t n); | ||||
| JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n); | ||||
| JANET_API int16_t janet_getinteger16(const Janet *argv, int32_t n); | ||||
| JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n); | ||||
| JANET_API uint32_t janet_getuinteger(const Janet *argv, int32_t n); | ||||
| JANET_API uint16_t janet_getuinteger16(const Janet *argv, int32_t n); | ||||
| JANET_API uint64_t janet_getuinteger64(const Janet *argv, int32_t n); | ||||
| JANET_API size_t janet_getsize(const Janet *argv, int32_t n); | ||||
| JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n); | ||||
| @@ -2143,13 +2176,15 @@ typedef enum { | ||||
|     RULE_TO,           /* [rule] */ | ||||
|     RULE_THRU,         /* [rule] */ | ||||
|     RULE_LENPREFIX,    /* [rule_a, rule_b (repeat rule_b rule_a times)] */ | ||||
|     RULE_READINT,      /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */ | ||||
|     RULE_READINT,      /* [(signedness << 4) | (endianness << 5) | bytewidth, tag] */ | ||||
|     RULE_LINE,         /* [tag] */ | ||||
|     RULE_COLUMN,       /* [tag] */ | ||||
|     RULE_UNREF,        /* [rule, tag] */ | ||||
|     RULE_CAPTURE_NUM,  /* [rule, tag] */ | ||||
|     RULE_SUB,          /* [rule, rule] */ | ||||
|     RULE_SPLIT         /* [rule, rule] */ | ||||
|     RULE_SPLIT,        /* [rule, rule] */ | ||||
|     RULE_NTH,          /* [nth, rule, tag] */ | ||||
|     RULE_ONLY_TAGS,    /* [rule] */ | ||||
| } JanetPegOpcod; | ||||
|  | ||||
| typedef struct { | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -867,7 +867,7 @@ static int line() { | ||||
|     if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1; | ||||
|     for (;;) { | ||||
|         char c; | ||||
|         char seq[3]; | ||||
|         char seq[5]; | ||||
|  | ||||
|         int rc; | ||||
|         do { | ||||
| @@ -991,6 +991,20 @@ static int line() { | ||||
|                                 default: | ||||
|                                     break; | ||||
|                             } | ||||
|                         } else if (seq[2] == ';') { | ||||
|                             if (read_console(seq + 3, 2) == -1) break; | ||||
|                             if (seq[3] == '5') { | ||||
|                                 switch (seq[4]) { | ||||
|                                     case 'C': /* ctrl-right */ | ||||
|                                         krightw(); | ||||
|                                         break; | ||||
|                                     case 'D': /* ctrl-left */ | ||||
|                                         kleftw(); | ||||
|                                         break; | ||||
|                                     default: | ||||
|                                         break; | ||||
|                                 } | ||||
|                             } | ||||
|                         } | ||||
|                     } else if (seq[0] == 'O') { | ||||
|                         if (read_console(seq + 1, 1) == -1) break; | ||||
| @@ -1163,6 +1177,7 @@ int main(int argc, char **argv) { | ||||
|     janet_resolve(env, janet_csymbol("cli-main"), &mainfun); | ||||
|     Janet mainargs[1] = { janet_wrap_array(args) }; | ||||
|     JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs); | ||||
|     janet_gcroot(janet_wrap_fiber(fiber)); | ||||
|     fiber->env = env; | ||||
|  | ||||
|     /* Run the fiber in an event loop */ | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2023 Calvin Rose | ||||
| * Copyright (c) 2024 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -4,24 +4,47 @@ | ||||
| (var num-tests-run 0) | ||||
| (var suite-name 0) | ||||
| (var start-time 0) | ||||
| (var skip-count 0) | ||||
| (var skip-n 0) | ||||
|  | ||||
| (def is-verbose (os/getenv "VERBOSE")) | ||||
|  | ||||
| (defn assert | ||||
| (defn- assert-no-tail | ||||
|   "Override's the default assert with some nice error handling." | ||||
|   [x &opt e] | ||||
|   (default e "assert error") | ||||
|   (++ num-tests-run) | ||||
|   (when (pos? skip-n) | ||||
|     (-- skip-n) | ||||
|     (++ skip-count) | ||||
|     (break x)) | ||||
|   (default e "assert error") | ||||
|   (when x (++ num-tests-passed)) | ||||
|   (def str (string e)) | ||||
|   (def frame (last (debug/stack (fiber/current)))) | ||||
|   (def stack (debug/stack (fiber/current))) | ||||
|   (def frame (last stack)) | ||||
|   (def line-info (string/format "%s:%d" | ||||
|                               (frame :source) (frame :source-line))) | ||||
|   (if x | ||||
|     (when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x)) | ||||
|     (do (eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush))) | ||||
|     (do | ||||
|       (eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush))) | ||||
|   x) | ||||
|  | ||||
| (defn skip-asserts | ||||
|   "Skip some asserts" | ||||
|   [n] | ||||
|   (+= skip-n n) | ||||
|   nil) | ||||
|  | ||||
| (defmacro assert | ||||
|   [x &opt e] | ||||
|   (def xx (gensym)) | ||||
|   (default e ~',x) | ||||
|   ~(do | ||||
|      (def ,xx ,x) | ||||
|      (,assert-no-tail ,xx ,e) | ||||
|      ,xx)) | ||||
|  | ||||
| (defmacro assert-error | ||||
|   [msg & forms] | ||||
|   (def errsym (keyword (gensym))) | ||||
| @@ -52,5 +75,22 @@ | ||||
| (defn end-suite [] | ||||
|   (def delta (- (os/clock) start-time)) | ||||
|   (eprinf "Finished suite %s in %.3f seconds - " suite-name delta) | ||||
|   (eprint num-tests-passed " of " num-tests-run " tests passed.") | ||||
|   (if (not= num-tests-passed num-tests-run) (os/exit 1))) | ||||
|   (eprint num-tests-passed " of " num-tests-run " tests passed (" skip-count " skipped).") | ||||
|   (if (not= (+ skip-count num-tests-passed) num-tests-run) (os/exit 1))) | ||||
|  | ||||
| (defn rmrf | ||||
|   "rm -rf in janet" | ||||
|   [x] | ||||
|   (case (os/lstat x :mode) | ||||
|     nil nil | ||||
|     :directory (do | ||||
|                  (each y (os/dir x) | ||||
|                    (rmrf (string x "/" y))) | ||||
|                  (os/rmdir x)) | ||||
|     (os/rm x)) | ||||
|   nil) | ||||
|  | ||||
| (defn randdir | ||||
|   "Get a random directory name" | ||||
|   [] | ||||
|   (string "tmp_dir_" (slice (string (math/random) ".tmp") 2))) | ||||
|   | ||||
| @@ -46,7 +46,6 @@ | ||||
| (assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3") | ||||
| (assert (deep= (array/remove @[1 2 3 4 5] -2 200) @[1 2 3]) "array/remove 4") | ||||
|  | ||||
|  | ||||
| # array/peek | ||||
| (assert (nil? (array/peek @[])) "array/peek empty") | ||||
|  | ||||
| @@ -76,6 +75,16 @@ | ||||
| (array/trim a) | ||||
| (array/ensure @[1 1] 6 2) | ||||
|  | ||||
| # array/join | ||||
| (assert (deep= @[1 2 3] (array/join @[] [1] [2] [3])) "array/join 1") | ||||
| (assert (deep= @[] (array/join @[])) "array/join 2") | ||||
| (assert (deep= @[1 :a :b :c] (array/join @[1] @[:a :b] [] [:c])) "array/join 3") | ||||
| (assert (deep= @[:x :y :z "abc123" "def456"] (array/join @[:x :y :z] ["abc123" "def456"])) "array/join 4") | ||||
| (assert-error "array/join error 1" (array/join)) | ||||
| (assert-error "array/join error 2" (array/join [])) | ||||
| (assert-error "array/join error 3" (array/join [] "abc123")) | ||||
| (assert-error "array/join error 4" (array/join @[] "abc123")) | ||||
| (assert-error "array/join error 5" (array/join @[] "abc123")) | ||||
|  | ||||
| (end-suite) | ||||
|  | ||||
|   | ||||
| @@ -754,7 +754,7 @@ | ||||
|     (default name (string "has-key? " (++ test-has-key-auto))) | ||||
|     (assert (= expected (has-key? col key)) name) | ||||
|     (if | ||||
|       # guarenteed by `has-key?` to never fail | ||||
|       # guaranteed by `has-key?` to never fail | ||||
|       expected (in col key) | ||||
|       # if `has-key?` is false, then `in` should fail (for indexed types) | ||||
|       # | ||||
| @@ -979,4 +979,30 @@ | ||||
| (assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn") | ||||
| (assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 2)))) | ||||
|  | ||||
| (setdyn *debug* true) | ||||
| (def source '(defn a [x] (+ x x))) | ||||
| (eval source) | ||||
| (assert (= 20 (a 10))) | ||||
| (assert (deep= (get (dyn 'a) :source-form) source)) | ||||
| (setdyn *debug* nil) | ||||
|  | ||||
| # issue #1516 | ||||
| (assert-error "assertf 1 argument" (macex '(assertf true))) | ||||
| (assert (assertf true "fun message") "assertf 2 arguments") | ||||
| (assert (assertf true "%s message" "mystery") "assertf 3 arguments") | ||||
| (assert (assertf (not nil) "%s message" "ordinary") "assertf not nil") | ||||
| (assert-error "assertf error 2" (assertf false "fun message")) | ||||
| (assert-error "assertf error 3" (assertf false "%s message" "mystery")) | ||||
| (assert-error "assertf error 4" (assertf nil "%s %s" "alice" "bob")) | ||||
|  | ||||
| # issue #1535 | ||||
| (loop [i :range [1 1000]] | ||||
|   (assert (deep-not= @{:key1 "value1" @"key" "value2"} | ||||
|                      @{:key1 "value1" @"key" "value2"}) "deep= mutable keys")) | ||||
| (assert (deep-not= {"abc" 123} {@"abc" 123}) "deep= mutable keys vs immutable key") | ||||
| (assert (deep-not= {@"" 1 @"" 2 @"" 3} {@"" 1 @"" 2 @"" 3}) "deep= duplicate mutable keys") | ||||
| (def k1 @"") | ||||
| (def k2 @"") | ||||
| (assert (deep= {k1 1 k2 2} {k1 1 k2 2}) "deep= duplicate mutable keys 2") | ||||
|  | ||||
| (end-suite) | ||||
|   | ||||
| @@ -1,4 +1,4 @@ | ||||
| # Copyright (c) 2023 Calvin Rose | ||||
| # Copyright (c) 2024 Calvin Rose | ||||
| # | ||||
| # Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| # of this software and associated documentation files (the "Software"), to | ||||
| @@ -85,9 +85,11 @@ | ||||
| (buffer/push-uint16 buffer-uint16-le :le 0x0102) | ||||
| (assert (= "\x02\x01" (string buffer-uint16-le)) "buffer/push-uint16 little endian") | ||||
|  | ||||
| (def buffer-uint16-negative @"") | ||||
| (buffer/push-uint16 buffer-uint16-negative :be -1) | ||||
| (assert (= "\xff\xff" (string buffer-uint16-negative)) "buffer/push-uint16 negative") | ||||
| (def buffer-uint16-max @"") | ||||
| (buffer/push-uint16 buffer-uint16-max :be 0xFFFF) | ||||
| (assert (= "\xff\xff" (string buffer-uint16-max)) "buffer/push-uint16 max") | ||||
| (assert-error "too large" (buffer/push-uint16 @"" 0x1FFFF)) | ||||
| (assert-error "too small" (buffer/push-uint16 @"" -0x1)) | ||||
|  | ||||
| (def buffer-uint32-be @"") | ||||
| (buffer/push-uint32 buffer-uint32-be :be 0x01020304) | ||||
| @@ -97,9 +99,9 @@ | ||||
| (buffer/push-uint32 buffer-uint32-le :le 0x01020304) | ||||
| (assert (= "\x04\x03\x02\x01" (string buffer-uint32-le)) "buffer/push-uint32 little endian") | ||||
|  | ||||
| (def buffer-uint32-negative @"") | ||||
| (buffer/push-uint32 buffer-uint32-negative :be -1) | ||||
| (assert (= "\xff\xff\xff\xff" (string buffer-uint32-negative)) "buffer/push-uint32 negative") | ||||
| (def buffer-uint32-max @"") | ||||
| (buffer/push-uint32 buffer-uint32-max :be 0xFFFFFFFF) | ||||
| (assert (= "\xff\xff\xff\xff" (string buffer-uint32-max)) "buffer/push-uint32 max") | ||||
|  | ||||
| (def buffer-float32-be @"") | ||||
| (buffer/push-float32 buffer-float32-be :be 1.234) | ||||
|   | ||||
							
								
								
									
										127
									
								
								test/suite-bundle.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										127
									
								
								test/suite-bundle.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,127 @@ | ||||
| # Copyright (c) 2024 Calvin Rose | ||||
| # | ||||
| # Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| # of this software and associated documentation files (the "Software"), to | ||||
| # deal in the Software without restriction, including without limitation the | ||||
| # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or | ||||
| # sell copies of the Software, and to permit persons to whom the Software is | ||||
| # furnished to do so, subject to the following conditions: | ||||
| # | ||||
| # The above copyright notice and this permission notice shall be included in | ||||
| # all copies or substantial portions of the Software. | ||||
| # | ||||
| # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | ||||
| # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | ||||
| # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE | ||||
| # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | ||||
| # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | ||||
| # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS | ||||
| # IN THE SOFTWARE. | ||||
|  | ||||
| (import ./helper :prefix "" :exit true) | ||||
| (start-suite) | ||||
|  | ||||
| (assert true) # smoke test | ||||
|  | ||||
| # Testing here is stateful since we are manipulating the filesystem. | ||||
|  | ||||
| # Copy since not exposed in boot.janet | ||||
| (defn- bundle-rpath | ||||
|   [path] | ||||
|   (string/replace-all "\\" "/" (os/realpath path))) | ||||
|  | ||||
| # Test mkdir -> rmdir | ||||
| (assert (os/mkdir "tempdir123")) | ||||
| (rmrf "tempdir123") | ||||
|  | ||||
| # Setup a temporary syspath for manipultation | ||||
| (math/seedrandom (os/cryptorand 16)) | ||||
| (def syspath (randdir)) | ||||
| (rmrf syspath) | ||||
| (assert (os/mkdir syspath)) | ||||
| (put root-env *syspath* (bundle-rpath syspath)) | ||||
| (unless (os/getenv "VERBOSE") | ||||
|   (setdyn *out* @"")) | ||||
| (assert (empty? (bundle/list)) "initial bundle/list") | ||||
| (assert (empty? (bundle/topolist)) "initial bundle/topolist") | ||||
|  | ||||
| # Try (and fail) to install sample-bundle (missing deps) | ||||
| (assert-error "missing dependencies sample-dep1, sample-dep2" | ||||
|               (bundle/install "./examples/sample-bundle")) | ||||
| (assert (empty? (bundle/list))) | ||||
|  | ||||
| # Install deps (dep1 as :auto-remove) | ||||
| (assert-no-error "sample-dep2" | ||||
|                  (bundle/install "./examples/sample-dep2")) | ||||
| (assert (= 1 (length (bundle/list)))) | ||||
| (assert-no-error "sample-dep1" (bundle/install "./examples/sample-dep1")) | ||||
| (assert (= 2 (length (bundle/list)))) | ||||
|  | ||||
| (assert-no-error "sample-dep2 reinstall" (bundle/reinstall "sample-dep2")) | ||||
| (assert-no-error "sample-dep1 reinstall" (bundle/reinstall "sample-dep1" :auto-remove true)) | ||||
|  | ||||
| (assert (= 2 (length (bundle/list))) "bundles are listed correctly 1") | ||||
| (assert (= 2 (length (bundle/topolist))) "bundles are listed correctly 2") | ||||
|  | ||||
| # Now install sample-bundle | ||||
| (assert-no-error "sample-bundle install" (bundle/install "./examples/sample-bundle")) | ||||
|  | ||||
| (assert-error "" (bundle/install "./examples/sample-dep11111")) | ||||
|  | ||||
| (assert (= 3 (length (bundle/list))) "bundles are listed correctly 3") | ||||
| (assert (= 3 (length (bundle/topolist))) "bundles are listed correctly 4") | ||||
|  | ||||
| # Check topolist has not bad order | ||||
| (def tlist (bundle/topolist)) | ||||
| (assert (> (index-of "sample-bundle" tlist) (index-of "sample-dep2" tlist)) "topolist 1") | ||||
| (assert (> (index-of "sample-bundle" tlist) (index-of "sample-dep1" tlist)) "topolist 2") | ||||
| (assert (> (index-of "sample-dep1" tlist) (index-of "sample-dep2" tlist)) "topolist 3") | ||||
|  | ||||
| # Prune should do nothing | ||||
| (assert-no-error "first prune" (bundle/prune)) | ||||
| (assert (= 3 (length (bundle/list))) "bundles are listed correctly 3") | ||||
| (assert (= 3 (length (bundle/topolist))) "bundles are listed correctly 4") | ||||
|  | ||||
| # Check that we can import the main dependency | ||||
| (import mymod) | ||||
| (assert (= 288 (mymod/myfn 12)) "using sample-bundle") | ||||
|  | ||||
| # Manual uninstall of dep1 and dep2 shouldn't work either since that would break dependencies | ||||
| (assert-error "cannot uninstall sample-dep1, breaks dependent bundles @[\"sample-bundle\"]" | ||||
|               (bundle/uninstall "sample-dep1")) | ||||
|  | ||||
| # Check bundle file aliases | ||||
| (assert-no-error "sample-bundle-aliases install" (bundle/install "./examples/sample-bundle-aliases")) | ||||
| (assert (= 4 (length (bundle/list))) "bundles are listed correctly 5") | ||||
| (assert-no-error "import aliases" (import aliases-mod)) | ||||
| (assert (deep= (range 12) (aliases-mod/fun 12)) "using sample-bundle-aliases") | ||||
| (assert-no-error "aliases uninstall" (bundle/uninstall "sample-bundle-aliases")) | ||||
|  | ||||
| # Now re-install sample-bundle as auto-remove | ||||
| (assert-no-error "sample-bundle install" (bundle/reinstall "sample-bundle" :auto-remove true)) | ||||
|  | ||||
| # Reinstallation should also work without being concerned about breaking dependencies | ||||
| (assert-no-error "reinstall dep" (bundle/reinstall "sample-dep2")) | ||||
|  | ||||
| # Now prune should get rid of everything except sample-dep2 | ||||
| (assert-no-error "second prune" (bundle/prune)) | ||||
|  | ||||
| # Now check that we exactly one package left, which is dep2 | ||||
| (assert (= 1 (length (bundle/list))) "bundles are listed correctly 5") | ||||
| (assert (= 1 (length (bundle/topolist))) "bundles are listed correctly 6") | ||||
|  | ||||
| # Which we can uninstall manually | ||||
| (assert-no-error "uninstall dep2" (bundle/uninstall "sample-dep2")) | ||||
|  | ||||
| # Now check bundle listing is again empty | ||||
| (assert (= 0 (length (bundle/list))) "bundles are listed correctly 7") | ||||
| (assert (= 0 (length (bundle/topolist))) "bundles are listed correctly 8") | ||||
|  | ||||
| # Try installing a bundle that fails check | ||||
| (assert-error "bad test" (bundle/install "./examples/sample-bad-bundle" :check true)) | ||||
| (assert (= 0 (length (bundle/list))) "check failure 0") | ||||
| (assert (= 0 (length (bundle/topolist))) "check failure 1") | ||||
|  | ||||
| (rmrf syspath) | ||||
|  | ||||
| (end-suite) | ||||
| @@ -69,6 +69,13 @@ | ||||
|                (seq [n :range [0 10]] (% n 5 3)) | ||||
|                [0 1 2 0 1 0 1 2 0 1]) "variadic mod") | ||||
|  | ||||
| # linspace range | ||||
| (assert (deep= @[0 1 2 3] (range 4)) "range 1") | ||||
| (assert (deep= @[0 1 2 3] (range 3.01)) "range 2") | ||||
| (assert (deep= @[0 1 2 3] (range 3.999)) "range 3") | ||||
| (assert (deep= @[0.8 1.8 2.8 3.8] (range 0.8 3.999)) "range 4") | ||||
| (assert (deep= @[0.8 1.8 2.8 3.8] (range 0.8 3.999)) "range 5") | ||||
|  | ||||
| (assert (< 1.0 nil false true | ||||
|            (fiber/new (fn [] 1)) | ||||
|            "hi" | ||||
|   | ||||
| @@ -375,4 +375,109 @@ | ||||
| (ev/cancel f (gensym)) | ||||
| (ev/take superv) | ||||
|  | ||||
| # Chat server test | ||||
| (def conmap @{}) | ||||
|  | ||||
| (defn broadcast [em msg] | ||||
|   (eachk par conmap | ||||
|          (if (not= par em) | ||||
|            (if-let [tar (get conmap par)] | ||||
|              (net/write tar (string/format "[%s]:%s" em msg)))))) | ||||
|  | ||||
| (defn handler | ||||
|   [connection] | ||||
|   (net/write connection "Whats your name?\n") | ||||
|   (def name (string/trim (string (ev/read connection 100)))) | ||||
|   (if (get conmap name) | ||||
|     (do | ||||
|       (net/write connection "Name already taken!") | ||||
|       (:close connection)) | ||||
|     (do | ||||
|       (put conmap name connection) | ||||
|       (net/write connection (string/format "Welcome %s\n" name)) | ||||
|       (defer (do | ||||
|                (put conmap name nil) | ||||
|                (:close connection)) | ||||
|         (while (def msg (ev/read connection 100)) | ||||
|           (broadcast name (string msg))))))) | ||||
|  | ||||
| # Now launch the chat server | ||||
| (def chat-server (net/listen test-host test-port)) | ||||
| (ev/spawn | ||||
|     (forever | ||||
|       (def [ok connection] (protect (net/accept chat-server))) | ||||
|       (if (and ok connection) | ||||
|         (ev/call handler connection) | ||||
|         (break)))) | ||||
|  | ||||
| # Read from socket | ||||
|  | ||||
| (defn expect-read | ||||
|   [stream text] | ||||
|   (def result (string (net/read stream 100))) | ||||
|   (assert (= result text) (string/format "expected %v, got %v" text result))) | ||||
|  | ||||
| # Now do our telnet chat | ||||
| (def bob (net/connect test-host test-port :stream)) | ||||
| (expect-read bob "Whats your name?\n") | ||||
| (if (= :mingw (os/which)) | ||||
|   (net/write bob "bob") | ||||
|   (do | ||||
|     (def fbob (ev/to-file bob)) | ||||
|     (file/write fbob "bob") | ||||
|     (file/flush fbob) | ||||
|     (:close fbob))) | ||||
| (expect-read bob "Welcome bob\n") | ||||
| (def alice (net/connect test-host test-port)) | ||||
| (expect-read alice "Whats your name?\n") | ||||
| (net/write alice "alice") | ||||
| (expect-read alice "Welcome alice\n") | ||||
|  | ||||
| # Bob says hello, alice gets the message | ||||
| (net/write bob "hello\n") | ||||
| (expect-read alice "[bob]:hello\n") | ||||
|  | ||||
| # Alice says hello, bob gets the message | ||||
| (net/write alice "hi\n") | ||||
| (expect-read bob "[alice]:hi\n") | ||||
|  | ||||
| # Ted joins the chat server | ||||
| (def ted (net/connect test-host test-port)) | ||||
| (expect-read ted "Whats your name?\n") | ||||
| (net/write ted "ted") | ||||
| (expect-read ted "Welcome ted\n") | ||||
|  | ||||
| # Ted says hi, alice and bob get message | ||||
| (net/write ted "hi\n") | ||||
| (expect-read alice "[ted]:hi\n") | ||||
| (expect-read bob "[ted]:hi\n") | ||||
|  | ||||
| # Bob leaves for work. Now it's just ted and alice | ||||
| (:close bob) | ||||
|  | ||||
| # Alice messages ted, ted gets message | ||||
| (net/write alice "wuzzup\n") | ||||
| (expect-read ted "[alice]:wuzzup\n") | ||||
| (net/write ted "not much\n") | ||||
| (expect-read alice "[ted]:not much\n") | ||||
|  | ||||
| # Alice bounces | ||||
| (:close alice) | ||||
|  | ||||
| # Ted can send messages, nobody gets them :( | ||||
| (net/write ted "hello?\n") | ||||
| (:close ted) | ||||
|  | ||||
| # Close chat server | ||||
| (:close chat-server) | ||||
|  | ||||
| # Issue #1531 | ||||
| (def c (ev/chan 0)) | ||||
| (ev/spawn (while (def x (ev/take c)))) | ||||
| (defn print-to-chan [x] (ev/give c x)) | ||||
| (assert-error "coerce await inside janet_call to error" | ||||
|               (with-dyns [*out* print-to-chan] | ||||
|                 (pp :foo))) | ||||
| (ev/chan-close c) | ||||
|  | ||||
| (end-suite) | ||||
|   | ||||
| @@ -21,7 +21,6 @@ | ||||
| (import ./helper :prefix "" :exit true) | ||||
| (start-suite) | ||||
|  | ||||
| # We should get ARM support... | ||||
| (def has-ffi (dyn 'ffi/native)) | ||||
| (def has-full-ffi | ||||
|   (and has-ffi | ||||
| @@ -53,5 +52,7 @@ | ||||
|   (assert (= 26 (ffi/size [:char :pack :int @[:char 21]])) | ||||
|           "array struct size")) | ||||
|  | ||||
| (end-suite) | ||||
| (compwhen has-ffi | ||||
|   (assert-error "bad struct issue #1512" (ffi/struct :void))) | ||||
|  | ||||
| (end-suite) | ||||
|   | ||||
							
								
								
									
										204
									
								
								test/suite-filewatch.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										204
									
								
								test/suite-filewatch.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,204 @@ | ||||
| # Copyright (c) 2024 Calvin Rose & contributors | ||||
| # | ||||
| # Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| # of this software and associated documentation files (the "Software"), to | ||||
| # deal in the Software without restriction, including without limitation the | ||||
| # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or | ||||
| # sell copies of the Software, and to permit persons to whom the Software is | ||||
| # furnished to do so, subject to the following conditions: | ||||
| # | ||||
| # The above copyright notice and this permission notice shall be included in | ||||
| # all copies or substantial portions of the Software. | ||||
| # | ||||
| # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | ||||
| # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | ||||
| # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE | ||||
| # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | ||||
| # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | ||||
| # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS | ||||
| # IN THE SOFTWARE. | ||||
|  | ||||
| (import ./helper :prefix "" :exit true) | ||||
| (start-suite) | ||||
|  | ||||
| (assert true) | ||||
|  | ||||
| (def chan (ev/chan 1000)) | ||||
| (def is-win (or (= :mingw (os/which)) (= :windows (os/which)))) | ||||
| (def is-linux (= :linux (os/which))) | ||||
|  | ||||
| # If not supported, exit early | ||||
| (def [supported msg] (protect (filewatch/new chan))) | ||||
| (when (and (not supported) (string/find "filewatch not supported" msg)) | ||||
|   (end-suite) | ||||
|   (quit)) | ||||
|  | ||||
| # Test GC | ||||
| (assert-no-error "filewatch/new" (filewatch/new chan)) | ||||
| (gccollect) | ||||
|  | ||||
| (defn- expect | ||||
|   [key value & more-kvs] | ||||
|   (ev/with-deadline | ||||
|     1 | ||||
|     (def event (ev/take chan)) | ||||
|     (when is-verbose (pp event)) | ||||
|     (assert event "check event") | ||||
|     (assert (= value (get event key)) (string/format "got %p, expected %p" (get event key) value)) | ||||
|     (when (next more-kvs) | ||||
|       (each [k v] (partition 2 more-kvs) | ||||
|         (assert (= v (get event k)) (string/format "got %p, expected %p" (get event k) v)))))) | ||||
|  | ||||
| (defn- expect-empty | ||||
|   [] | ||||
|   (assert (zero? (ev/count chan)) "channel check empty") | ||||
|   (ev/sleep 0) # turn the event loop | ||||
|   (assert (zero? (ev/count chan)) "channel check empty") | ||||
|   # Drain if not empty, help with failures after this | ||||
|   (while (pos? (ev/count chan)) (printf "extra: %p" (ev/take chan)))) | ||||
|  | ||||
| (defn- expect-maybe | ||||
|   "On wine + mingw, we get an extra event. This is a wine peculiarity." | ||||
|   [key value] | ||||
|   (ev/with-deadline | ||||
|     1 | ||||
|     (ev/sleep 0) | ||||
|     (when (pos? (ev/count chan)) | ||||
|       (def event (ev/take chan)) | ||||
|       (when is-verbose (pp event)) | ||||
|       (assert event "check event") | ||||
|       (assert (= value (get event key)) (string/format "got %p, expected %p" (get event key) value))))) | ||||
|  | ||||
| (defn spit-file | ||||
|   [dir name] | ||||
|   (def path (string dir "/" name)) | ||||
|   (spit path "test text")) | ||||
|  | ||||
| # Different operating systems report events differently. While it would be nice to | ||||
| # normalize this, each system has very large limitations in what can be reported when | ||||
| # compared with other systems. As such, the maximum subset of common functionality here | ||||
| # is quite small. Instead, test the capabilities of each system. | ||||
|  | ||||
| # Create a file watcher on two test directories | ||||
| (def fw (filewatch/new chan)) | ||||
| (def td1 (randdir)) | ||||
| (def td2 (randdir)) | ||||
| (def td3 (randdir)) | ||||
| (rmrf td1) | ||||
| (rmrf td2) | ||||
| (os/mkdir td1) | ||||
| (os/mkdir td2) | ||||
| (os/mkdir td3) | ||||
| (spit-file td3 "file3.txt") | ||||
| (when is-win | ||||
|   (filewatch/add fw td1 :last-write :last-access :file-name :dir-name :size :attributes :recursive) | ||||
|   (filewatch/add fw td2 :last-write :last-access :file-name :dir-name :size :attributes)) | ||||
| (when is-linux | ||||
|   (filewatch/add fw (string td3 "/file3.txt") :close-write :create :delete) | ||||
|   (filewatch/add fw td1 :close-write :create :delete) | ||||
|   (filewatch/add fw td2 :close-write :create :delete :ignored)) | ||||
| (assert-no-error "filewatch/listen no error" (filewatch/listen fw)) | ||||
|  | ||||
| # | ||||
| # Windows file writing | ||||
| # | ||||
|  | ||||
| (when is-win | ||||
|   (spit-file td1 "file1.txt") | ||||
|   (expect :type :added :file-name "file1.txt" :dir-name td1) | ||||
|   (expect :type :modified) | ||||
|   (expect-maybe :type :modified) # for mingw + wine | ||||
|   (gccollect) | ||||
|   (spit-file td1 "file1.txt") | ||||
|   (expect :type :modified) | ||||
|   (expect :type :modified) | ||||
|   (expect-empty) | ||||
|   (gccollect) | ||||
|  | ||||
|   # Check td2 | ||||
|   (spit-file td2 "file2.txt") | ||||
|   (expect :type :added) | ||||
|   (expect :type :modified) | ||||
|   (expect-maybe :type :modified) | ||||
|  | ||||
|   # Remove a file, then wait for remove event | ||||
|   (rmrf (string td1 "/file1.txt")) | ||||
|   (expect :type :removed) | ||||
|   (expect-empty) | ||||
|  | ||||
|   # Unlisten to some events | ||||
|   (filewatch/remove fw td2) | ||||
|  | ||||
|   # Check that we don't get anymore events from test directory 2 | ||||
|   (spit-file td2 "file2.txt") | ||||
|   (expect-empty) | ||||
|  | ||||
|   # Repeat and things should still work with test directory 1 | ||||
|   (spit-file td1 "file1.txt") | ||||
|   (expect :type :added) | ||||
|   (expect :type :modified) | ||||
|   (expect-maybe :type :modified) | ||||
|   (gccollect) | ||||
|   (spit-file td1 "file1.txt") | ||||
|   (expect :type :modified) | ||||
|   (expect :type :modified) | ||||
|   (expect-maybe :type :modified) | ||||
|   (gccollect)) | ||||
|  | ||||
| # | ||||
| # Linux file writing | ||||
| # | ||||
|  | ||||
| (when is-linux | ||||
|   (spit-file td1 "file1.txt") | ||||
|   (expect :type :create :file-name "file1.txt" :dir-name td1) | ||||
|   (expect :type :close-write) | ||||
|   (expect-empty) | ||||
|   (gccollect) | ||||
|   (spit-file td1 "file1.txt") | ||||
|   (expect :type :close-write) | ||||
|   (expect-empty) | ||||
|   (gccollect) | ||||
|  | ||||
|   # Check file3.txt | ||||
|   (spit-file td3 "file3.txt") | ||||
|   (expect :type :close-write :file-name "file3.txt" :dir-name td3) | ||||
|   (expect-empty) | ||||
|  | ||||
|   # Check td2 | ||||
|   (spit-file td2 "file2.txt") | ||||
|   (expect :type :create) | ||||
|   (expect :type :close-write) | ||||
|   (expect-empty) | ||||
|  | ||||
|   # Remove a file, then wait for remove event | ||||
|   (rmrf (string td1 "/file1.txt")) | ||||
|   (expect :type :delete) | ||||
|   (expect-empty) | ||||
|  | ||||
|   # Unlisten to some events | ||||
|   (filewatch/remove fw td2) | ||||
|   (expect :type :ignored) | ||||
|   (expect-empty) | ||||
|  | ||||
|   # Check that we don't get anymore events from test directory 2 | ||||
|   (spit-file td2 "file2.txt") | ||||
|   (expect-empty) | ||||
|  | ||||
|   # Repeat and things should still work with test directory 1 | ||||
|   (spit-file td1 "file1.txt") | ||||
|   (expect :type :create) | ||||
|   (expect :type :close-write) | ||||
|   (expect-empty) | ||||
|   (gccollect) | ||||
|   (spit-file td1 "file1.txt") | ||||
|   (expect :type :close-write) | ||||
|   (expect-empty) | ||||
|   (gccollect)) | ||||
|  | ||||
| (assert-no-error "filewatch/unlisten no error" (filewatch/unlisten fw)) | ||||
| (assert-no-error "cleanup 1" (rmrf td1)) | ||||
| (assert-no-error "cleanup 2" (rmrf td2)) | ||||
| (assert-no-error "cleanup 3" (rmrf td3)) | ||||
|  | ||||
| (end-suite) | ||||
| @@ -47,6 +47,14 @@ | ||||
| (assert (= (int/to-number (i64 9007199254740991)) 9007199254740991)) | ||||
| (assert (= (int/to-number (i64 -9007199254740991)) -9007199254740991)) | ||||
|  | ||||
| # New parser | ||||
| (assert (= (u64 "123") 123:u) "u64 parsing") | ||||
| (assert (= (u64 "0") 0:u) "u64 parsing") | ||||
| (assert (= (u64 "0xFFFF_FFFF_FFFF_FFFF") 0xFFFF_FFFF_FFFF_FFFF:u) "u64 parsing") | ||||
| (assert (= (i64 "123") 123:s) "s64 parsing") | ||||
| (assert (= (i64 "-123") -123:s) "s64 parsing") | ||||
| (assert (= (i64 "0") 0:s) "s64 parsing") | ||||
|  | ||||
| (assert-error | ||||
|   "u64 out of bounds for safe integer" | ||||
|   (int/to-number (u64 "9007199254740993")) | ||||
|   | ||||
| @@ -146,5 +146,80 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 | ||||
|   (def item (ev/take newchan)) | ||||
|   (assert (= item newchan) "ev/chan marshalling")) | ||||
|  | ||||
| (end-suite) | ||||
| # Issue #1488 - marshalling weak values | ||||
| (testmarsh (array/weak 10) "marsh array/weak") | ||||
| (testmarsh (table/weak-keys 10) "marsh table/weak-keys") | ||||
| (testmarsh (table/weak-values 10) "marsh table/weak-values") | ||||
| (testmarsh (table/weak 10) "marsh table/weak") | ||||
|  | ||||
| # Now check that gc works with weak containers after marshalling | ||||
|  | ||||
| # Turn off automatic GC for testing weak references | ||||
| (gcsetinterval 0x7FFFFFFF) | ||||
|  | ||||
| # array | ||||
| (def a (array/weak 1)) | ||||
| (array/push a @"") | ||||
| (assert (= 1 (length a)) "array/weak marsh 1") | ||||
| (def aclone (-> a marshal unmarshal)) | ||||
| (assert (= 1 (length aclone)) "array/weak marsh 2") | ||||
| (gccollect) | ||||
| (assert (= 1 (length aclone)) "array/weak marsh 3") | ||||
| (assert (= 1 (length a)) "array/weak marsh 4") | ||||
| (assert (= nil (get a 0)) "array/weak marsh 5") | ||||
| (assert (= nil (get aclone 0)) "array/weak marsh 6") | ||||
| (assert (deep= (freeze a) (freeze aclone)) "array/weak marsh 7") | ||||
|  | ||||
| # table weak keys and values | ||||
| (def t (table/weak 1)) | ||||
| (def keep-key :key) | ||||
| (def keep-value :value) | ||||
| (put t :abc @"") | ||||
| (put t :key :value) | ||||
| (assert (= 2 (length t)) "table/weak marsh 1") | ||||
| (def tclone (-> t marshal unmarshal)) | ||||
| (assert (= 2 (length tclone)) "table/weak marsh 2") | ||||
| (gccollect) | ||||
| (assert (= 1 (length tclone)) "table/weak marsh 3") | ||||
| (assert (= 1 (length t)) "table/weak marsh 4") | ||||
| (assert (= keep-value (get t keep-key)) "table/weak marsh 5") | ||||
| (assert (= keep-value (get tclone keep-key)) "table/weak marsh 6") | ||||
| (assert (deep= t tclone) "table/weak marsh 7") | ||||
|  | ||||
| # table weak keys | ||||
| (def t (table/weak-keys 1)) | ||||
| (put t @"" keep-value) | ||||
| (put t :key @"") | ||||
| (assert (= 2 (length t)) "table/weak-keys marsh 1") | ||||
| (def tclone (-> t marshal unmarshal)) | ||||
| (assert (= 2 (length tclone)) "table/weak-keys marsh 2") | ||||
| (gccollect) | ||||
| (assert (= 1 (length tclone)) "table/weak-keys marsh 3") | ||||
| (assert (= 1 (length t)) "table/weak-keys marsh 4") | ||||
| (assert (deep= (freeze t) (freeze tclone)) "table/weak-keys marsh 5") | ||||
|  | ||||
| # table weak values | ||||
| (def t (table/weak-values 1)) | ||||
| (put t @"" keep-value) | ||||
| (put t :key @"") | ||||
| (assert (= 2 (length t)) "table/weak-values marsh 1") | ||||
| (def tclone (-> t marshal unmarshal)) | ||||
| (assert (= 2 (length tclone)) "table/weak-values marsh 2") | ||||
| (gccollect) | ||||
| (assert (= 1 (length t)) "table/weak-value marsh 3") | ||||
| (assert (deep= (freeze t) (freeze tclone)) "table/weak-values marsh 4") | ||||
|  | ||||
| # tables with prototypes | ||||
| (def t (table/weak-values 1)) | ||||
| (table/setproto t @{:abc 123}) | ||||
| (put t @"" keep-value) | ||||
| (put t :key @"") | ||||
| (assert (= 2 (length t)) "marsh weak tables with prototypes 1") | ||||
| (def tclone (-> t marshal unmarshal)) | ||||
| (assert (= 2 (length tclone)) "marsh weak tables with prototypes 2") | ||||
| (gccollect) | ||||
| (assert (= 1 (length t)) "marsh weak tables with prototypes 3") | ||||
| (assert (deep= (freeze t) (freeze tclone)) "marsh weak tables with prototypes 4") | ||||
| (assert (deep= (getproto t) (getproto tclone)) "marsh weak tables with prototypes 5") | ||||
|  | ||||
| (end-suite) | ||||
|   | ||||
Some files were not shown because too many files have changed in this diff Show More
		Reference in New Issue
	
	Block a user