mirror of
				https://github.com/janet-lang/janet
				synced 2025-10-29 06:37:41 +00:00 
			
		
		
		
	Compare commits
	
		
			434 Commits
		
	
	
		
	
	| Author | SHA1 | Date | |
|---|---|---|---|
|   | 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 | ||
|   | 876b7f106f | ||
|   | 809b6589a1 | ||
|   | 02f53ca014 | ||
|   | 0b03ddb21b | ||
|   | ea5d4fd3af | ||
|   | e6b73f8cd1 | ||
|   | af232ef729 | ||
|   | 2e2f8abfc0 | ||
|   | 91a583db27 | ||
|   | dc5cc630ff | ||
|   | c1647a74c5 | ||
|   | 721f280966 | ||
|   | 258ebb9145 | ||
|   | e914eaf055 | ||
|   | fe54013679 | ||
|   | fdaf2e1594 | ||
|   | f0092ef69b | ||
|   | a88ae7e1d9 | ||
|   | 9946f3bdf4 | ||
|   | c747e8d16c | ||
|   | 3e402d397e | ||
|   | 0350834cd3 | ||
|   | 980981c9ee | ||
|   | 3c8346f24e | ||
|   | 42bd27c24b | ||
|   | 4a0f67f3bd | ||
|   | 09b6fc4670 | ||
|   | 4d9bcd6bcc | ||
|   | cd34b89977 | ||
|   | 3151fa3988 | ||
|   | 5e58110e19 | ||
|   | e1cdd0f8cc | ||
|   | 1f39a0f180 | ||
|   | 367c4b14f5 | ||
|   | 9c437796d3 | ||
|   | 60e22d9703 | ||
|   | ee7362e847 | ||
|   | 369f96b80e | ||
|   | 7c5ed04ab1 | ||
|   | 4779a445e0 | ||
|   | f0f1b7ce9e | ||
|   | 7c9157a0ed | ||
|   | 522a6cb435 | ||
|   | d0d551d739 | ||
|   | 71a123fef7 | ||
|   | 3f40c8d7fb | ||
|   | 983c2e5499 | ||
|   | eebb4c3ade | ||
|   | 50425eac72 | ||
|   | 382ff77bbe | ||
|   | bf680fb5d3 | ||
|   | 4ed7db4f91 | ||
|   | bf19920d65 | ||
|   | 174b5f6686 | ||
|   | 4173645b81 | ||
|   | af511f1f55 | ||
|   | 83c6080380 | ||
|   | 2f0c789ea1 | ||
|   | a9b8f8e8a9 | ||
|   | f92f3eb6fa | ||
|   | 89e74dca3e | ||
|   | f2e86d2f8d | ||
|   | 623da131e5 | ||
|   | e89ec31ae5 | ||
|   | 68a6ed208e | ||
|   | c01b32c4f3 | ||
|   | ee11ff9da9 | ||
|   | ed56d5d6ff | ||
|   | b317ab755c | ||
|   | 9819994999 | ||
|   | e9dbaa81d2 | ||
|   | 9f9146ffae | ||
|   | 9d9732af97 | ||
|   | ebb8fa9787 | ||
|   | 9e6abbf4d4 | ||
|   | 6032a6d658 | ||
|   | c29ab22e6d | ||
|   | 592ac4904c | ||
|   | 03ae2ec153 | ||
|   | 3bc42d0d37 | ||
|   | 12630d3e54 | ||
|   | c9897f99c3 | ||
|   | e66dc14b3a | ||
|   | 7a2868c147 | ||
|   | 9e0daaee09 | ||
|   | c293c7de93 | ||
|   | 49eb5f8563 | ||
|   | 674b375b2c | ||
|   | 7e94c091eb | ||
|   | 5885ccba61 | ||
|   | 431ecd3d1a | ||
|   | f6df8ff935 | ||
|   | 3fd70f0951 | ||
|   | bebb635d4f | ||
|   | 354896bc4b | ||
|   | 5ddefff27e | ||
|   | 91827eef4f | ||
|   | 9c14c09962 | ||
|   | e85a84171f | ||
|   | 3a4f86c3d7 | ||
|   | 5e75963312 | ||
|   | 184d9289b5 | ||
|   | b7ff9577c0 | ||
|   | 942a1aaac6 | ||
|   | 69f0fe004d | ||
|   | 2a04347a42 | ||
|   | 1394f1a5c0 | ||
|   | cf4d19a8ea | ||
|   | 23b0fe9f8e | ||
|   | 1ba718b15e | ||
|   | df5f79ff35 | ||
|   | 6d7e8528ea | ||
|   | 197bb73a62 | ||
|   | f91e599451 | ||
|   | 5b9aa9237c | ||
|   | 61f38fab37 | ||
|   | 9142f38cbc | ||
|   | e8ed961572 | ||
|   | be11a2a1ad | ||
|   | ea75086300 | ||
|   | 9eeefbd79a | ||
|   | c573a98363 | ||
|   | 11d7af3f95 | ||
|   | a10b4f61d8 | ||
|   | a0cb7514f1 | ||
|   | b066edc116 | ||
|   | 938f5a689e | ||
|   | 772f4c26e8 | ||
|   | 6b5d151beb | ||
|   | a9176a77e6 | ||
|   | 16f409c6a9 | ||
|   | 9593c930de | ||
|   | 56f33f514b | ||
|   | 1ccd544b94 | ||
|   | 93c83a2ee2 | ||
|   | f459e32ada | ||
|   | 9b640c8e9c | ||
|   | a3228f4997 | ||
|   | 715eb69d92 | ||
|   | df2d5cb3d3 | ||
|   | 3b189eab64 | ||
|   | 609b629c22 | ||
|   | e74365fe38 | ||
|   | 46b34833c2 | ||
|   | 045c80869d | ||
|   | 2ea2e72ddd | ||
|   | 1b17e12fd6 | ||
|   | cc5beda0d2 | ||
|   | a363fd926d | ||
|   | 21ebede529 | ||
|   | 15d67e9191 | ||
|   | b5996f5f02 | ||
|   | 83204dc293 | ||
|   | e3f4142d2a | ||
|   | f18ad36b1b | ||
|   | cb25a2ecd6 | ||
|   | 741a5036e8 | ||
|   | 549ee95f3d | ||
|   | 6ae81058aa | ||
|   | 267c603824 | ||
|   | a8f583a372 | ||
|   | 2b5d90f73a | ||
|   | 4139e426fe | ||
|   | a775a89e01 | ||
|   | 990f6352e0 | ||
|   | b344702304 | ||
|   | d497612bce | ||
|   | 2a3b101bd8 | ||
|   | 63e93af421 | ||
|   | ab055b3ebe | ||
|   | a9a013473f | ||
|   | 87de1e5766 | ||
|   | 894aaef267 | ||
|   | e209e54ffe | ||
|   | 7511eadaa7 | ||
|   | 6c4906605a | ||
|   | 8a9be9d837 | ||
|   | b72098cc71 | ||
|   | defe60e08b | ||
|   | 7f852b8af4 | ||
|   | d71c100ca7 | ||
|   | 5442c8e86d | ||
|   | cf4901e713 | ||
|   | 4b8c1ac2d2 | ||
|   | 555e0c0b85 | ||
|   | dc301305de | ||
|   | f1111c135b | ||
|   | 3905e92965 | ||
|   | 1418ada38f | ||
|   | 9256a66b76 | ||
|   | e8c013a778 | ||
|   | fea8242ea7 | ||
|   | 7bfb17c209 | ||
|   | e7e4341e70 | ||
|   | 6186be4443 | ||
|   | d07f01d7cb | ||
|   | 73291a30a0 | ||
|   | a3b129845b | ||
|   | 0ff8f58be8 | ||
|   | 66292beec9 | ||
|   | bf2af1051f | ||
|   | b6e3020d4c | ||
|   | 8f516a1e28 | ||
|   | 5f2e287efd | ||
|   | 8c0d65cf9f | ||
|   | fa609a5079 | ||
|   | c708ff9708 | ||
|   | 2ea90334a3 | ||
|   | eea8aa555f | ||
|   | 51a75e1872 | ||
|   | af7ed4322e | ||
|   | 7cdd7cf6eb | ||
|   | 26aa622afc | ||
|   | 84ad161f1e | ||
|   | 6efb965dab | ||
|   | 8c90a12e0f | ||
|   | 2d54e88e74 | ||
|   | 16ea5323e0 | ||
|   | 7a23ce2367 | ||
|   | e05bc7eb54 | ||
|   | b3a6e25ce0 | ||
|   | b63d41102e | ||
|   | 964295b59d | ||
|   | d19db30f3d | ||
|   | d12464fc0e | ||
|   | a96971c8a7 | ||
|   | f6f769503a | ||
|   | 82917ac6e3 | ||
|   | a6ffafb1a2 | ||
|   | fb8c529f2e | ||
|   | 1ee98e1e66 | ||
|   | 81f35f5dd1 | ||
|   | 1b402347cd | ||
|   | 7599656784 | ||
|   | dccb60ba35 | ||
|   | ae642ceca0 | ||
|   | 471b6f9966 | ||
|   | 5dd18bac2c | ||
|   | 018f4e0891 | ||
|   | e85809a98a | ||
|   | e6e9bd8147 | ||
|   | 221645d2ce | ||
|   | 2f4a6214a2 | ||
|   | e00a461c26 | ||
|   | c31314be38 | ||
|   | ee142c4be0 | ||
|   | aeacc0b31b | ||
|   | 7b4c3bdbcc | ||
|   | 910b9cf1fd | ||
|   | b10aaceab0 | ||
|   | 169bd812c9 | ||
|   | 34767f1e13 | ||
|   | 4f642c0843 | ||
|   | 4e5889ed59 | ||
|   | a1b848ad76 | ||
|   | dbcc1fad3e | ||
|   | db366558e7 | ||
|   | a23c03fbd0 | ||
|   | ff18b92eb0 | ||
|   | 7f148522ab | ||
|   | 159c612924 | ||
|   | b95dfd4bdf | ||
|   | e69954af2f | ||
|   | a5ff26f602 | ||
|   | a7536268e1 | ||
|   | 541469371a | ||
|   | a13aeaf955 | ||
|   | 9cf674cdcb | ||
|   | 51c0cf97bc | ||
|   | 4cb1f616c5 | ||
|   | 645109048b | ||
|   | f969fb69e1 | ||
|   | bfb60fdb84 | ||
|   | 2f43cb843e | ||
|   | 874fd2aba7 | ||
|   | 33d1371186 | ||
|   | d2dd241e6b | ||
|   | 4ecadfabf4 | ||
|   | ffd79c6097 | ||
|   | 35a8d2a519 | ||
|   | 21eab7e9cc | ||
|   | d9605c2856 | ||
|   | 70a467d469 | ||
|   | 6e8979336d | ||
|   | ee01045db5 | ||
|   | b7f8224588 | ||
|   | ca4c1e4259 | ||
|   | 91712add3d | ||
|   | 7198dcb416 | ||
|   | 08e20e912d | ||
|   | f45571033c | ||
|   | 2ac36a0572 | ||
|   | 3df1d54847 | ||
|   | f3969b6066 | ||
|   | 6222f35bc8 | ||
|   | 2f178963c0 | ||
|   | 15760b0950 | ||
|   | 43a6a70e1e | ||
|   | cd36f1ef5f | ||
|   | cdd7083c86 | ||
|   | 8df7364319 | ||
|   | 63023722d1 | ||
|   | 79c12e5116 | ||
|   | 53e16944a1 | ||
|   | 7475362c85 | ||
|   | 9238b82cde | ||
|   | 7049f658ec | ||
|   | 701913fb19 | ||
|   | 831f41a62b | ||
|   | 0ea1da80e7 | ||
|   | 06eea74b98 | ||
|   | c8c0e112bc | ||
|   | 7417e82c51 | ||
|   | ecc4d80a5a | ||
|   | 3df24c52f4 | ||
|   | 8a70fb95b5 | ||
|   | d8b45ecd61 | ||
|   | 61712bae9c | ||
|   | 4ff81a5a25 | ||
|   | 08f0e55d8f | ||
|   | 080b37cb31 | ||
|   | bbdcd035ba | ||
|   | f9233ef90b | ||
|   | cd3573a4d2 | ||
|   | 738fe24e6d | ||
|   | c2e55b5486 | ||
|   | 989f0726e3 | ||
|   | bdefd3ba1e | ||
|   | 4efcff33bd | ||
|   | 8183cc5a8d | ||
|   | f3bda1536d | ||
|   | 3b6371e03d | ||
|   | b5d3c87253 | ||
|   | f73b8c550a | ||
|   | 5437744126 | ||
|   | 5a5e70b001 | ||
|   | 348a5bc0a9 | ||
|   | 026c64fa01 | ||
|   | e38663c457 | ||
|   | 117c741c29 | ||
|   | 9bc5bec9f1 | ||
|   | a5f4e4d328 | ||
|   | db0abfde72 | ||
|   | edf263bcb5 | ||
|   | 60fba585e3 | ||
|   | ebb6fe5be3 | ||
|   | d91c95bf92 | ||
|   | 2007438424 | ||
|   | 81423635ad | ||
|   | 58d297364a | ||
|   | db902c90c4 | ||
|   | 42ccd0f790 | ||
|   | 20ec6f574e | ||
|   | b3db367ae7 | ||
|   | 8a62c742e6 | ||
|   | b125cbeac9 | ||
|   | 3f7a2c2197 | ||
|   | f6248369fe | ||
|   | c83f3ec097 | ||
|   | 0cd00da354 | ||
|   | 4b7b285aa9 | ||
|   | d63379e777 | ||
|   | b219b146fa | ||
|   | ff90b81ec3 | ||
|   | 9120eaef79 | ||
|   | 1ccd879916 | ||
|   | f977ace7f8 | ||
|   | c3f4dc0c15 | ||
|   | 78eed9b11c | ||
|   | 3a4d56afca | ||
|   | 63bb93fc07 | 
| @@ -1,4 +1,4 @@ | ||||
| image: freebsd/12.x | ||||
| image: freebsd/14.x | ||||
| sources: | ||||
| - https://git.sr.ht/~bakpakin/janet | ||||
| packages: | ||||
| @@ -9,3 +9,4 @@ tasks: | ||||
|     gmake | ||||
|     gmake test | ||||
|     sudo gmake install | ||||
|     sudo gmake uninstall | ||||
|   | ||||
| @@ -1,4 +1,4 @@ | ||||
| image: openbsd/latest | ||||
| image: openbsd/7.4 | ||||
| sources: | ||||
| - https://git.sr.ht/~bakpakin/janet | ||||
| packages: | ||||
| @@ -11,6 +11,7 @@ tasks: | ||||
|     gmake test | ||||
|     doas gmake install | ||||
|     gmake test-install | ||||
|     doas gmake uninstall | ||||
| - 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 | ||||
| @@ -29,4 +30,3 @@ tasks: | ||||
|     ninja | ||||
|     ninja test | ||||
|     doas ninja install | ||||
|  | ||||
|   | ||||
							
								
								
									
										38
									
								
								.github/cosmo/build
									
									
									
									
										vendored
									
									
										Normal file
									
								
							
							
						
						
									
										38
									
								
								.github/cosmo/build
									
									
									
									
										vendored
									
									
										Normal file
									
								
							| @@ -0,0 +1,38 @@ | ||||
| #!/bin/sh | ||||
| set -eux | ||||
|  | ||||
| COSMO_DIR="/sc/cosmocc" | ||||
|  | ||||
| # build x86_64 | ||||
| X86_64_CC="/sc/cosmocc/bin/x86_64-unknown-cosmo-cc" | ||||
| X86_64_AR="/sc/cosmocc/bin/x86_64-unknown-cosmo-ar" | ||||
| mkdir -p /sc/cosmocc/x86_64 | ||||
| make -j CC="$X86_64_CC" AR="$X86_64_AR" HAS_SHARED=0 JANET_NO_AMALG=1 | ||||
| cp build/janet /sc/cosmocc/x86_64/janet | ||||
| make clean | ||||
|  | ||||
| # build aarch64 | ||||
| AARCH64_CC="/sc/cosmocc/bin/aarch64-unknown-cosmo-cc" | ||||
| AARCH64_AR="/sc/cosmocc/bin/aarch64-unknown-cosmo-ar" | ||||
| mkdir -p /sc/cosmocc/aarch64 | ||||
| make -j CC="$AARCH64_CC" AR="$AARCH64_AR" HAS_SHARED=0 JANET_NO_AMALG=1 | ||||
| cp build/janet /sc/cosmocc/aarch64/janet | ||||
| make clean | ||||
|  | ||||
| # fat binary | ||||
| apefat () { | ||||
|     OUTPUT="$1" | ||||
|     OLDNAME_X86_64="$(basename -- "$2")" | ||||
|     OLDNAME_AARCH64="$(basename -- "$3")" | ||||
|     TARG_FOLD="$(dirname "$OUTPUT")" | ||||
|     "$COSMO_DIR/bin/apelink" -l "$COSMO_DIR/bin/ape-x86_64.elf" \ | ||||
|         -l "$COSMO_DIR/bin/ape-aarch64.elf" \ | ||||
|         -M "$COSMO_DIR/bin/ape-m1.c" \ | ||||
|         -o "$OUTPUT" \ | ||||
|         "$2" \ | ||||
|         "$3" | ||||
|     cp "$2" "$TARG_FOLD/$OLDNAME_X86_64.x86_64" | ||||
|     cp "$3" "$TARG_FOLD/$OLDNAME_AARCH64.aarch64" | ||||
| } | ||||
|  | ||||
| apefat /sc/cosmocc/janet.com /sc/cosmocc/x86_64/janet /sc/cosmocc/aarch64/janet | ||||
							
								
								
									
										21
									
								
								.github/cosmo/setup
									
									
									
									
										vendored
									
									
										Normal file
									
								
							
							
						
						
									
										21
									
								
								.github/cosmo/setup
									
									
									
									
										vendored
									
									
										Normal file
									
								
							| @@ -0,0 +1,21 @@ | ||||
| #!/bin/sh | ||||
| set -e | ||||
|  | ||||
| sudo apt update | ||||
| sudo apt-get install -y ca-certificates libssl-dev\ | ||||
|     qemu qemu-utils qemu-user-static\ | ||||
|     texinfo groff\ | ||||
|     cmake ninja-build bison zip\ | ||||
|     pkg-config build-essential autoconf re2c | ||||
|  | ||||
| # download cosmocc | ||||
| cd /sc | ||||
| wget https://github.com/jart/cosmopolitan/releases/download/3.3.3/cosmocc-3.3.3.zip | ||||
| mkdir -p cosmocc | ||||
| cd cosmocc | ||||
| unzip ../cosmocc-3.3.3.zip | ||||
|  | ||||
| # register | ||||
| cd /sc/cosmocc | ||||
| sudo cp ./bin/ape-x86_64.elf /usr/bin/ape | ||||
| sudo sh -c "echo ':APE:M::MZqFpD::/usr/bin/ape:' >/proc/sys/fs/binfmt_misc/register" | ||||
							
								
								
									
										27
									
								
								.github/workflows/release.yml
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										27
									
								
								.github/workflows/release.yml
									
									
									
									
										vendored
									
									
								
							| @@ -60,3 +60,30 @@ jobs: | ||||
|             ./dist/*.zip | ||||
|             ./*.zip | ||||
|             ./*.msi | ||||
|  | ||||
|   release-cosmo: | ||||
|     permissions: | ||||
|       contents: write  # for softprops/action-gh-release to create GitHub release | ||||
|     name: Build release binaries for Cosmo | ||||
|     runs-on: ubuntu-latest | ||||
|     steps: | ||||
|       - name: Checkout the repository | ||||
|         uses: actions/checkout@master | ||||
|       - name: create build folder | ||||
|         run: | | ||||
|           sudo mkdir -p /sc | ||||
|           sudo chmod -R 0777 /sc | ||||
|       - name: setup Cosmopolitan Libc | ||||
|         run: bash ./.github/cosmo/setup | ||||
|       - name: Set the version | ||||
|         run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV | ||||
|       - name: Set the platform | ||||
|         run: echo "platform=cosmo" >> $GITHUB_ENV | ||||
|       - name: build Janet APE binary | ||||
|         run: bash ./.github/cosmo/build | ||||
|       - name: push binary to github | ||||
|         uses: softprops/action-gh-release@v1 | ||||
|         with: | ||||
|           draft: true | ||||
|           files: | | ||||
|             /sc/cosmocc/janet.com | ||||
|   | ||||
							
								
								
									
										19
									
								
								.github/workflows/test.yml
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										19
									
								
								.github/workflows/test.yml
									
									
									
									
										vendored
									
									
								
							| @@ -56,7 +56,7 @@ jobs: | ||||
|             gcc | ||||
|       - name: Build the project | ||||
|         shell: cmd | ||||
|         run: make -j CC=gcc | ||||
|         run: make -j4 CC=gcc JANET_NO_AMALG=1 | ||||
|  | ||||
|   test-mingw-linux: | ||||
|     name: Build and test with Mingw on Linux + Wine | ||||
| @@ -73,4 +73,19 @@ 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 | ||||
|     runs-on: ubuntu-latest | ||||
|     steps: | ||||
|       - name: Checkout the repository | ||||
|         uses: actions/checkout@master | ||||
|       - name: Setup qemu and cross compiler | ||||
|         run: | | ||||
|           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  | ||||
|       - name: Test the project | ||||
|         run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test VERBOSE=1 | ||||
|   | ||||
							
								
								
									
										14
									
								
								.gitignore
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										14
									
								
								.gitignore
									
									
									
									
										vendored
									
									
								
							| @@ -34,8 +34,11 @@ local | ||||
|  | ||||
| # Common test files I use. | ||||
| temp.janet | ||||
| temp*.janet | ||||
| temp.c | ||||
| temp*janet | ||||
| temp*.c | ||||
| scratch.janet | ||||
| scratch.c | ||||
|  | ||||
| # Emscripten | ||||
| *.bc | ||||
| @@ -45,6 +48,8 @@ janet.wasm | ||||
| # Generated files | ||||
| *.gen.h | ||||
| *.gen.c | ||||
| *.tmp | ||||
| temp.* | ||||
|  | ||||
| # Generate test files | ||||
| *.out | ||||
| @@ -57,6 +62,7 @@ xxd.exe | ||||
| # VSCode | ||||
| .vs | ||||
| .clangd | ||||
| .cache | ||||
|  | ||||
| # Swap files | ||||
| *.swp | ||||
| @@ -122,6 +128,9 @@ vgcore.* | ||||
| *.idb | ||||
| *.pdb | ||||
|  | ||||
| # GGov | ||||
| *.gcov | ||||
|  | ||||
| # Kernel Module Compile Results | ||||
| *.mod* | ||||
| *.cmd | ||||
| @@ -130,6 +139,9 @@ Module.symvers | ||||
| Mkfile.old | ||||
| dkms.conf | ||||
|  | ||||
| # Coverage files | ||||
| *.cov | ||||
|  | ||||
| # End of https://www.gitignore.io/api/c | ||||
|  | ||||
| # Created by https://www.gitignore.io/api/cmake | ||||
|   | ||||
							
								
								
									
										85
									
								
								CHANGELOG.md
									
									
									
									
									
								
							
							
						
						
									
										85
									
								
								CHANGELOG.md
									
									
									
									
									
								
							| @@ -1,7 +1,90 @@ | ||||
| # Changelog | ||||
| All notable changes to this project will be documented in this file. | ||||
|  | ||||
| ## 1.29.0 - 2023-06-19 | ||||
| ## 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 | ||||
| - Add long form command line options for readable CLI usage | ||||
| - Fix bug with `net/accept-loop` that would sometimes miss connections. | ||||
|  | ||||
| ## 1.34.0 - 2024-03-22 | ||||
| - Add a new (split) PEG special by @ianthehenry | ||||
| - Add buffer/push-* sized int and float by @pnelson | ||||
| - Documentation improvements: @amano-kenji, @llmII, @MaxGyver83, @pepe, @sogaiu. | ||||
| - Expose _exit to skip certain cleanup with os/exit. | ||||
| - Swap set / body order for each by @sogaiu. | ||||
| - Abort on assert failure instead of exit. | ||||
| - Fix: os/proc-wait by @llmII. | ||||
| - Fix macex1 to keep syntax location for all tuples. | ||||
| - Restore if-let tail calls. | ||||
| - Don't try and resume fibers that can't be resumed. | ||||
| - Register stream on unmarshal. | ||||
| - Fix asm roundtrip issue. | ||||
|  | ||||
| ## 1.33.0 - 2024-01-07 | ||||
| - Add more + and * keywords to default-peg-grammar by @sogaiu. | ||||
| - Use libc strlen in janet_buffer_push_cstring by @williewillus. | ||||
| - Be a bit safer with reference counting. | ||||
| - Add support for atomic loads in Janet's atomic abstraction. | ||||
| - Fix poll event loop CPU usage issue. | ||||
| - Add ipv6, shared, and cryptorand options to meson. | ||||
| - Add more ipv6 feature detection. | ||||
| - Fix loop for forever loop. | ||||
| - Cleaned up unused NetStateConnect, fixed janet_async_end() ev refcount by @zevv. | ||||
| - Fix warnings w/ MSVC and format. | ||||
| - Fix marshal_one_env w/ JANET_MARSHAL_UNSAFE. | ||||
| - Fix `(default)`. | ||||
| - Fix cannot marshal fiber with c stackframe, in a dynamic way that is fairly conservative. | ||||
| - Fix typo for SIGALARM in os/proc-kill. | ||||
| - Prevent bytecode optimization from remove mk* instructions. | ||||
| - Fix arity typo in peg.c by @pepe. | ||||
| - Update Makefile for MinGW. | ||||
| - Fix canceling waiting fiber. | ||||
| - Add a new (sub) PEG special by @ianthehenry. | ||||
| - Fix if net/server's handler has incorrect arity. | ||||
| - Fix macex raising on (). | ||||
|  | ||||
| ## 1.32.1 - 2023-10-15 | ||||
| - Fix return value from C function `janet_dobytes` when called on Janet functions that yield to event loop. | ||||
| - Change C API for event loop interaction - get rid of JanetListener and instead use `janet_async_start` and `janet_async_end`. | ||||
| - Rework event loop to make fewer system calls on kqueue and epoll. | ||||
| - Expose atomic refcount abstraction in janet.h | ||||
| - Add `array/weak` for weak references in arrays | ||||
| - Add support for weak tables via `table/weak`, `table/weak-keys`, and `table/weak-values`. | ||||
| - Fix compiler bug with using the result of `(break x)` expression in some contexts. | ||||
| - Rework internal event loop code to be better behaved on Windows | ||||
| - Update meson build to work better on windows | ||||
|  | ||||
| ## 1.31.0 - 2023-09-17 | ||||
| - Report line and column when using `janet_dobytes` | ||||
| - Add `:unless` loop modifier | ||||
| - Allow calling `reverse` on generators. | ||||
| - Improve performance of a number of core functions including `partition`, `mean`, `keys`, `values`, `pairs`, `interleave`. | ||||
| - Add `lengthable?` | ||||
| - Add `os/sigaction` | ||||
| - Change `every?` and `any?` to behave like the functional versions of the `and` and `or` macros. | ||||
| - Fix bug with garbage collecting threaded abstract types. | ||||
| - Add `:signal` to the `sandbox` function to allow intercepting signals. | ||||
|  | ||||
| ## 1.30.0 - 2023-08-05 | ||||
| - Change indexing of `array/remove` to start from -1 at the end instead of -2. | ||||
| - Add new string escape sequences `\\a`, `\\b`, `\\?`, and `\\'`. | ||||
| - Fix bug with marshalling channels | ||||
| - Add `div` for floored division | ||||
| - Make `div` and `mod` variadic | ||||
| - Support `bnot` for integer types. | ||||
| - Define `(mod x 0)` as `x` | ||||
| - Add `ffi/pointer-cfunction` to convert pointers to cfunctions | ||||
|  | ||||
| ## 1.29.1 - 2023-06-19 | ||||
| - Add support for passing booleans to PEGs for "always" and "never" matching. | ||||
| - Allow dictionary types for `take` and `drop` | ||||
| - Fix bug with closing channels while other fibers were waiting on them - `ev/take`, `ev/give`, and `ev/select`  will now return the correct (documented) value when another fiber closes the channel. | ||||
|   | ||||
							
								
								
									
										33
									
								
								Makefile
									
									
									
									
									
								
							
							
						
						
									
										33
									
								
								Makefile
									
									
									
									
									
								
							| @@ -33,6 +33,7 @@ CLIBS=-lm -lpthread | ||||
| JANET_TARGET=build/janet | ||||
| JANET_BOOT=build/janet_boot | ||||
| JANET_IMPORT_LIB=build/janet.lib | ||||
| JANET_LIBRARY_IMPORT_LIB=build/libjanet.lib | ||||
| JANET_LIBRARY=build/libjanet.so | ||||
| JANET_STATIC_LIBRARY=build/libjanet.a | ||||
| JANET_PATH?=$(LIBDIR)/janet | ||||
| @@ -42,14 +43,17 @@ JANET_DIST_DIR?=janet-dist | ||||
| JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)' | ||||
| JANET_TARGET_OBJECTS=build/janet.o build/shell.o | ||||
| JPM_TAG?=master | ||||
| HAS_SHARED?=1 | ||||
| DEBUGGER=gdb | ||||
| SONAME_SETTER=-Wl,-soname, | ||||
|  | ||||
| # For cross compilation | ||||
| HOSTCC?=$(CC) | ||||
| HOSTAR?=$(AR) | ||||
| # Symbols are (optionally) removed later, keep -g as default! | ||||
| CFLAGS?=-O2 -g | ||||
| LDFLAGS?=-rdynamic | ||||
| LIBJANET_LDFLAGS?=$(LD_FLAGS) | ||||
| RUN:=$(RUN) | ||||
|  | ||||
| COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC | ||||
| @@ -92,12 +96,17 @@ endif | ||||
| ifeq ($(findstring MINGW,$(UNAME)), MINGW) | ||||
| 	CLIBS:=-lws2_32 -lpsapi -lwsock32 | ||||
| 	LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB) | ||||
| 	LIBJANET_LDFLAGS:=-Wl,--out-implib,$(JANET_LIBRARY_IMPORT_LIB) | ||||
| 	JANET_TARGET:=$(JANET_TARGET).exe | ||||
| 	JANET_BOOT:=$(JANET_BOOT).exe | ||||
| endif | ||||
|  | ||||
|  | ||||
| $(shell mkdir -p build/core build/c build/boot build/mainclient) | ||||
| all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h | ||||
| all: $(JANET_TARGET) $(JANET_STATIC_LIBRARY) build/janet.h | ||||
| ifeq ($(HAS_SHARED), 1) | ||||
| all: $(JANET_LIBRARY) | ||||
| endif | ||||
|  | ||||
| ###################### | ||||
| ##### Name Files ##### | ||||
| @@ -195,9 +204,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile | ||||
| ######################## | ||||
|  | ||||
| ifeq ($(UNAME), Darwin) | ||||
| SONAME=libjanet.1.29.dylib | ||||
| SONAME=libjanet.1.35.dylib | ||||
| else | ||||
| SONAME=libjanet.so.1.29 | ||||
| SONAME=libjanet.so.1.35 | ||||
| endif | ||||
|  | ||||
| build/c/shell.c: src/mainclient/shell.c | ||||
| @@ -219,7 +228,7 @@ $(JANET_TARGET): $(JANET_TARGET_OBJECTS) | ||||
| 	$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS) | ||||
|  | ||||
| $(JANET_LIBRARY): $(JANET_TARGET_OBJECTS) | ||||
| 	$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS) | ||||
| 	$(HOSTCC) $(LIBJANET_LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS) | ||||
|  | ||||
| $(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS) | ||||
| 	$(HOSTAR) rcs $@ $^ | ||||
| @@ -262,20 +271,25 @@ dist: build/janet-dist.tar.gz | ||||
|  | ||||
| build/janet-%.tar.gz: $(JANET_TARGET) \ | ||||
| 	build/janet.h \ | ||||
| 	janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \ | ||||
| 	janet.1 LICENSE CONTRIBUTING.md $(JANET_STATIC_LIBRARY) \ | ||||
| 	README.md build/c/janet.c build/c/shell.c | ||||
| 	mkdir -p build/$(JANET_DIST_DIR)/bin | ||||
| 	cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/ | ||||
| 	strip -x -S 'build/$(JANET_DIST_DIR)/bin/janet' | ||||
| 	mkdir -p build/$(JANET_DIST_DIR)/include | ||||
| 	cp build/janet.h build/$(JANET_DIST_DIR)/include/ | ||||
| 	mkdir -p build/$(JANET_DIST_DIR)/lib/ | ||||
| 	cp $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/ | ||||
| 	cp $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/ | ||||
| 	cp $(JANET_LIBRARY) build/$(JANET_DIST_DIR)/lib/ || true | ||||
| 	mkdir -p build/$(JANET_DIST_DIR)/man/man1/ | ||||
| 	cp janet.1 build/$(JANET_DIST_DIR)/man/man1/janet.1 | ||||
| 	mkdir -p build/$(JANET_DIST_DIR)/src/ | ||||
| 	cp build/c/janet.c build/c/shell.c build/$(JANET_DIST_DIR)/src/ | ||||
| 	cp CONTRIBUTING.md LICENSE README.md build/$(JANET_DIST_DIR)/ | ||||
| 	cd build && tar -czvf ../$@ ./$(JANET_DIST_DIR) | ||||
| ifeq ($(HAS_SHARED), 1) | ||||
| build/janet-%.tar.gz: $(JANET_LIBRARY) | ||||
| endif | ||||
|  | ||||
| ######################### | ||||
| ##### Documentation ##### | ||||
| @@ -308,7 +322,7 @@ build/janet.pc: $(JANET_TARGET) | ||||
| install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h | ||||
| 	mkdir -p '$(DESTDIR)$(BINDIR)' | ||||
| 	cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet' | ||||
| 	strip '$(DESTDIR)$(BINDIR)/janet' | ||||
| 	strip -x -S '$(DESTDIR)$(BINDIR)/janet' | ||||
| 	mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet' | ||||
| 	cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet' | ||||
| 	ln -sf ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h' | ||||
| @@ -329,6 +343,7 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc | ||||
| 	mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)' | ||||
| 	cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc' | ||||
| 	cp '$(JANET_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)' | ||||
| 	cp '$(JANET_LIBRARY_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)' | ||||
| 	[ -z '$(DESTDIR)' ] && $(LDCONFIG) || echo "You can ignore this error for non-Linux systems or local installs" | ||||
|  | ||||
| install-jpm-git: $(JANET_TARGET) | ||||
| @@ -357,14 +372,14 @@ uninstall: | ||||
| ################# | ||||
|  | ||||
| format: | ||||
| 	tools/format.sh | ||||
| 	sh tools/format.sh | ||||
|  | ||||
| grammar: build/janet.tmLanguage | ||||
| build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET) | ||||
| 	$(RUN) $(JANET_TARGET) $< > $@ | ||||
|  | ||||
| compile-commands: | ||||
| 	# Requires pip install copmiledb | ||||
| 	# Requires pip install compiledb | ||||
| 	compiledb make | ||||
|  | ||||
| clean: | ||||
|   | ||||
| @@ -315,8 +315,7 @@ See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the w | ||||
|  | ||||
| ## Discussion | ||||
|  | ||||
| Feel free to ask questions and join the discussion on the [Janet Gitter channel](https://gitter.im/janet-language/community). | ||||
| Gitter provides Matrix and IRC bridges as well. | ||||
| Feel free to ask questions and join the discussion on the [Janet Zulip Instance](https://janet.zulipchat.com/) | ||||
|  | ||||
| ## FAQ | ||||
|  | ||||
| @@ -383,7 +382,7 @@ Usually, one of a few reasons: | ||||
| ### Can I bind to Rust/Zig/Go/Java/Nim/C++/D/Pascal/Fortran/Odin/Jai/(Some new "Systems" Programming Language)? | ||||
|  | ||||
| Probably, if that language has a good interface with C. But the programmer may need to do | ||||
| some extra work to map Janet's internal memory model may need some to that of the bound language. Janet | ||||
| some extra work to map Janet's internal memory model to that of the bound language. Janet | ||||
| also uses `setjmp`/`longjmp` for non-local returns internally. This | ||||
| approach is out of favor with many programmers now and doesn't always play well with other languages | ||||
| that have exceptions or stack-unwinding. | ||||
|   | ||||
| @@ -41,32 +41,32 @@ if not exist build\boot mkdir build\boot | ||||
| @rem Build the bootstrap interpreter | ||||
| for %%f in (src\core\*.c) do ( | ||||
|     %JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f | ||||
|     @if errorlevel 1 goto :BUILDFAIL | ||||
|     @if not errorlevel 0 goto :BUILDFAIL | ||||
| ) | ||||
| for %%f in (src\boot\*.c) do ( | ||||
|     %JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f | ||||
|     @if errorlevel 1 goto :BUILDFAIL | ||||
|     @if not errorlevel 0 goto :BUILDFAIL | ||||
| ) | ||||
| %JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
| @if not errorlevel 0 goto :BUILDFAIL | ||||
| build\janet_boot . > build\c\janet.c | ||||
|  | ||||
| @rem Build the sources | ||||
| %JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
| @if not errorlevel 0 goto :BUILDFAIL | ||||
| %JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
| @if not errorlevel 0 goto :BUILDFAIL | ||||
|  | ||||
| @rem Build the resources | ||||
| rc /nologo /fobuild\janet_win.res janet_win.rc | ||||
|  | ||||
| @rem Link everything to main client | ||||
| %JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
| @if not errorlevel 0 goto :BUILDFAIL | ||||
|  | ||||
| @rem Build static library (libjanet.a) | ||||
| @rem Build static library (libjanet.lib) | ||||
| %JANET_LINK_STATIC% /out:build\libjanet.lib build\janet.obj | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
| @if not errorlevel 0 goto :BUILDFAIL | ||||
|  | ||||
| echo === Successfully built janet.exe for Windows === | ||||
| echo === Run 'build_win test' to run tests. == | ||||
| @@ -91,14 +91,16 @@ exit /b 0 | ||||
| :CLEAN | ||||
| del *.exe *.lib *.exp | ||||
| rd /s /q build | ||||
| rd /s /q dist | ||||
| if exist dist ( | ||||
|     rd /s /q dist | ||||
| ) | ||||
| exit /b 0 | ||||
|  | ||||
| @rem Run tests | ||||
| :TEST | ||||
| for %%f in (test/suite*.janet) do ( | ||||
|     janet.exe test\%%f | ||||
|     @if errorlevel 1 goto TESTFAIL | ||||
|     @if not errorlevel 0 goto TESTFAIL | ||||
| ) | ||||
| exit /b 0 | ||||
|  | ||||
| @@ -117,6 +119,7 @@ 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 | ||||
|   | ||||
| @@ -55,6 +55,7 @@ | ||||
| (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-alias int-fn int-fn-aliased :int [a :int b :int]) | ||||
|  | ||||
| # | ||||
| # Struct reading and writing | ||||
| @@ -119,6 +120,7 @@ | ||||
| (tracev (return-struct 42)) | ||||
| (tracev (double-lots 1 2 3 4 5 6 700 800 9 10)) | ||||
| (tracev (struct-big 11 99.5)) | ||||
| (tracev (int-fn-aliased 10 20)) | ||||
|  | ||||
| (assert (= [10 10 12 12] (split-ret-fn 10 12))) | ||||
| (assert (= [12 12 10 10] (split-flip-ret-fn 10 12))) | ||||
|   | ||||
							
								
								
									
										5
									
								
								examples/posix-exec.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										5
									
								
								examples/posix-exec.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,5 @@ | ||||
| # Switch to python | ||||
|  | ||||
| (print "running in Janet") | ||||
| (os/posix-exec ["python"] :p) | ||||
| (print "will not print") | ||||
							
								
								
									
										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)) | ||||
							
								
								
									
										41
									
								
								examples/sigaction.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										41
									
								
								examples/sigaction.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,41 @@ | ||||
| ### | ||||
| ### Usage: janet examples/sigaction.janet 1|2|3|4 & | ||||
| ### | ||||
| ### Then at shell: kill -s SIGTERM $! | ||||
| ### | ||||
|  | ||||
| (defn action | ||||
|   [] | ||||
|   (print "Handled SIGTERM!") | ||||
|   (flush) | ||||
|   (os/exit 1)) | ||||
|  | ||||
| (defn main1 | ||||
|   [] | ||||
|   (os/sigaction :term action true) | ||||
|   (forever)) | ||||
|  | ||||
| (defn main2 | ||||
|   [] | ||||
|   (os/sigaction :term action) | ||||
|   (forever)) | ||||
|  | ||||
| (defn main3 | ||||
|   [] | ||||
|   (os/sigaction :term action true) | ||||
|   (forever (ev/sleep math/inf))) | ||||
|  | ||||
| (defn main4 | ||||
|   [] | ||||
|   (os/sigaction :term action) | ||||
|   (forever (ev/sleep math/inf))) | ||||
|  | ||||
| (defn main | ||||
|   [& args] | ||||
|   (def which (scan-number (get args 1 "1"))) | ||||
|   (case which | ||||
|     1 (main1) # should work | ||||
|     2 (main2) # will not work | ||||
|     3 (main3) # should work | ||||
|     4 (main4) # should work | ||||
|     (error "bad main"))) | ||||
							
								
								
									
										20
									
								
								examples/weak-tables.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										20
									
								
								examples/weak-tables.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,20 @@ | ||||
| (def weak-k (table/weak-keys 10)) | ||||
| (def weak-v (table/weak-values 10)) | ||||
| (def weak-kv (table/weak 10)) | ||||
|  | ||||
| (put weak-kv (gensym) 10) | ||||
| (put weak-kv :hello :world) | ||||
| (put weak-k :abc123zz77asda :stuff) | ||||
| (put weak-k true :abc123zz77asda) | ||||
| (put weak-k :zyzzyz false) | ||||
| (put weak-v (gensym) 10) | ||||
| (put weak-v 20 (gensym)) | ||||
| (print "before gc") | ||||
| (tracev weak-k) | ||||
| (tracev weak-v) | ||||
| (tracev weak-kv) | ||||
| (gccollect) | ||||
| (print "after gc") | ||||
| (tracev weak-k) | ||||
| (tracev weak-v) | ||||
| (tracev weak-kv) | ||||
							
								
								
									
										73
									
								
								meson.build
									
									
									
									
									
								
							
							
						
						
									
										73
									
								
								meson.build
									
									
									
									
									
								
							| @@ -20,7 +20,7 @@ | ||||
|  | ||||
| project('janet', 'c', | ||||
|   default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'], | ||||
|   version : '1.28.0') | ||||
|   version : '1.35.0') | ||||
|  | ||||
| # Global settings | ||||
| janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') | ||||
| @@ -61,6 +61,7 @@ conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps')) | ||||
| conf.set('JANET_NO_ASSEMBLER', not get_option('assembler')) | ||||
| conf.set('JANET_NO_PEG', not get_option('peg')) | ||||
| conf.set('JANET_NO_NET', not get_option('net')) | ||||
| conf.set('JANET_NO_IPV6', not get_option('ipv6')) | ||||
| conf.set('JANET_NO_EV', not get_option('ev') or get_option('single_threaded')) | ||||
| conf.set('JANET_REDUCED_OS', get_option('reduced_os')) | ||||
| conf.set('JANET_NO_INT_TYPES', not get_option('int_types')) | ||||
| @@ -78,6 +79,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_CRYPTORAND', not get_option('cryptorand')) | ||||
| if get_option('os_name') != '' | ||||
|   conf.set('JANET_OS_NAME', get_option('os_name')) | ||||
| endif | ||||
| @@ -169,7 +171,7 @@ janet_boot = executable('janet-boot', core_src, boot_src, | ||||
|  | ||||
| # Build janet.c | ||||
| janetc = custom_target('janetc', | ||||
|   input : [janet_boot], | ||||
|   input : [janet_boot, 'src/boot/boot.janet'], | ||||
|   output : 'janet.c', | ||||
|   capture : true, | ||||
|   command : [ | ||||
| @@ -182,25 +184,41 @@ if not get_option('single_threaded') | ||||
|   janet_dependencies += thread_dep | ||||
| endif | ||||
|  | ||||
| libjanet = library('janet', janetc, | ||||
|   include_directories : incdir, | ||||
|   dependencies : janet_dependencies, | ||||
|   version: meson.project_version(), | ||||
|   soversion: version_parts[0] + '.' + version_parts[1], | ||||
|   install : true) | ||||
|  | ||||
| # Allow building with no shared library | ||||
| if cc.has_argument('-fvisibility=hidden') | ||||
|   lib_cflags = ['-fvisibility=hidden'] | ||||
| else | ||||
|   lib_cflags = [] | ||||
| endif | ||||
| if get_option('shared') | ||||
|   libjanet = library('janet', janetc, | ||||
|     include_directories : incdir, | ||||
|     dependencies : janet_dependencies, | ||||
|     version: meson.project_version(), | ||||
|     soversion: version_parts[0] + '.' + version_parts[1], | ||||
|     c_args : lib_cflags, | ||||
|     install : true) | ||||
| # Extra c flags - adding -fvisibility=hidden matches the Makefile and | ||||
| # shaves off about 10k on linux x64, likely similar on other platforms. | ||||
| if cc.has_argument('-fvisibility=hidden') | ||||
|   extra_cflags = ['-fvisibility=hidden'] | ||||
|   if cc.has_argument('-fvisibility=hidden') | ||||
|     extra_cflags = ['-fvisibility=hidden', '-DJANET_DLL_IMPORT'] | ||||
|   else | ||||
|     extra_cflags = ['-DJANET_DLL_IMPORT'] | ||||
|   endif | ||||
|   janet_mainclient = executable('janet', mainclient_src, | ||||
|     include_directories : incdir, | ||||
|     dependencies : janet_dependencies, | ||||
|     link_with: [libjanet], | ||||
|     c_args : extra_cflags, | ||||
|     install : true) | ||||
| else | ||||
|   extra_cflags = [] | ||||
|   # No shared library | ||||
|   janet_mainclient = executable('janet', mainclient_src, janetc, | ||||
|     include_directories : incdir, | ||||
|     dependencies : janet_dependencies, | ||||
|     c_args : lib_cflags, | ||||
|     install : true) | ||||
| endif | ||||
| janet_mainclient = executable('janet', janetc, mainclient_src, | ||||
|   include_directories : incdir, | ||||
|   dependencies : janet_dependencies, | ||||
|   c_args : extra_cflags, | ||||
|   install : true) | ||||
|  | ||||
| if meson.is_cross_build() | ||||
|   native_cc = meson.get_compiler('c', native: true) | ||||
| @@ -231,6 +249,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', | ||||
| @@ -264,14 +283,15 @@ endforeach | ||||
| run_target('repl', command : [janet_nativeclient]) | ||||
|  | ||||
| # For use as meson subproject (wrap) | ||||
| janet_dep = declare_dependency(include_directories : incdir, | ||||
|   link_with : libjanet) | ||||
|  | ||||
| if get_option('shared') | ||||
|   janet_dep = declare_dependency(include_directories : incdir, | ||||
|     link_with : libjanet) | ||||
| # pkgconfig | ||||
| pkg = import('pkgconfig') | ||||
| pkg.generate(libjanet, | ||||
|   subdirs: 'janet', | ||||
|   description: 'Library for the Janet programming language.') | ||||
|   pkg = import('pkgconfig') | ||||
|   pkg.generate(libjanet, | ||||
|     subdirs: 'janet', | ||||
|     description: 'Library for the Janet programming language.') | ||||
| endif | ||||
|  | ||||
| # Installation | ||||
| install_man('janet.1') | ||||
| @@ -281,11 +301,12 @@ patched_janet = custom_target('patched-janeth', | ||||
|   install : true, | ||||
|   install_dir : join_paths(get_option('includedir'), 'janet'), | ||||
|   build_by_default : true, | ||||
|   output : ['janet.h'], | ||||
|   output : ['janet_' + meson.project_version() + '.h'], | ||||
|   command : [janet_nativeclient, '@INPUT@', '@OUTPUT@']) | ||||
|  | ||||
| # Create a version of the janet.h header that matches what jpm often expects | ||||
| if meson.version().version_compare('>=0.61') | ||||
|   install_symlink('janet.h', pointing_to: 'janet/janet.h', install_dir: get_option('includedir')) | ||||
|   install_symlink('janet.h', pointing_to: 'janet/janet_' + meson.project_version() + '.h', install_dir: get_option('includedir')) | ||||
|   install_symlink('janet.h', pointing_to: 'janet_' + meson.project_version() + '.h', install_dir: join_paths(get_option('includedir'), 'janet')) | ||||
| endif | ||||
|  | ||||
|   | ||||
| @@ -11,14 +11,15 @@ option('peg', type : 'boolean', value : true) | ||||
| option('int_types', type : 'boolean', value : true) | ||||
| option('prf', type : 'boolean', value : false) | ||||
| option('net', type : 'boolean', value : true) | ||||
| option('ipv6', type : 'boolean', value : true) | ||||
| option('ev', type : 'boolean', value : true) | ||||
| option('processes', type : 'boolean', value : true) | ||||
| option('umask', type : 'boolean', value : true) | ||||
| option('realpath', type : 'boolean', value : true) | ||||
| option('simple_getline', type : 'boolean', value : false) | ||||
| option('epoll', type : 'boolean', value : false) | ||||
| option('kqueue', type : 'boolean', value : false) | ||||
| option('interpreter_interrupt', type : 'boolean', value : false) | ||||
| option('epoll', type : 'boolean', value : true) | ||||
| 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) | ||||
|  | ||||
| @@ -29,3 +30,5 @@ option('stack_max', type : 'integer', min : 8096, max : 0x7fffffff, value : 0x7f | ||||
|  | ||||
| option('arch_name', type : 'string', value: '') | ||||
| option('os_name', type : 'string', value: '') | ||||
| option('shared', type : 'boolean', value: true) | ||||
| option('cryptorand', type : 'boolean', value: true) | ||||
|   | ||||
							
								
								
									
										1084
									
								
								src/boot/boot.janet
									
									
									
									
									
								
							
							
						
						
									
										1084
									
								
								src/boot/boot.janet
									
									
									
									
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							| @@ -4,10 +4,10 @@ | ||||
| #define JANETCONF_H | ||||
|  | ||||
| #define JANET_VERSION_MAJOR 1 | ||||
| #define JANET_VERSION_MINOR 29 | ||||
| #define JANET_VERSION_MINOR 34 | ||||
| #define JANET_VERSION_PATCH 0 | ||||
| #define JANET_VERSION_EXTRA "" | ||||
| #define JANET_VERSION "1.29.0" | ||||
| #define JANET_VERSION "1.35.0" | ||||
|  | ||||
| /* #define JANET_BUILD "local" */ | ||||
|  | ||||
| @@ -52,6 +52,9 @@ | ||||
| /* #define JANET_EV_NO_EPOLL */ | ||||
| /* #define JANET_EV_NO_KQUEUE */ | ||||
| /* #define JANET_NO_INTERPRETER_INTERRUPT */ | ||||
| /* #define JANET_NO_IPV6 */ | ||||
| /* #define JANET_NO_CRYPTORAND */ | ||||
| /* #define JANET_USE_STDATOMIC */ | ||||
|  | ||||
| /* Custom vm allocator support */ | ||||
| /* #include <mimalloc.h> */ | ||||
|   | ||||
| @@ -31,8 +31,6 @@ | ||||
| #ifdef JANET_EV | ||||
| #ifdef JANET_WINDOWS | ||||
| #include <windows.h> | ||||
| #else | ||||
| #include <stdatomic.h> | ||||
| #endif | ||||
| #endif | ||||
|  | ||||
| @@ -97,14 +95,6 @@ size_t janet_os_rwlock_size(void) { | ||||
|     return sizeof(void *); | ||||
| } | ||||
|  | ||||
| static int32_t janet_incref(JanetAbstractHead *ab) { | ||||
|     return InterlockedIncrement((LONG volatile *) &ab->gc.data.refcount); | ||||
| } | ||||
|  | ||||
| static int32_t janet_decref(JanetAbstractHead *ab) { | ||||
|     return InterlockedDecrement((LONG volatile *) &ab->gc.data.refcount); | ||||
| } | ||||
|  | ||||
| void janet_os_mutex_init(JanetOSMutex *mutex) { | ||||
|     InitializeCriticalSection((CRITICAL_SECTION *) mutex); | ||||
| } | ||||
| @@ -157,14 +147,6 @@ size_t janet_os_rwlock_size(void) { | ||||
|     return sizeof(pthread_rwlock_t); | ||||
| } | ||||
|  | ||||
| static int32_t janet_incref(JanetAbstractHead *ab) { | ||||
|     return __atomic_add_fetch(&ab->gc.data.refcount, 1, __ATOMIC_RELAXED); | ||||
| } | ||||
|  | ||||
| static int32_t janet_decref(JanetAbstractHead *ab) { | ||||
|     return __atomic_add_fetch(&ab->gc.data.refcount, -1, __ATOMIC_RELAXED); | ||||
| } | ||||
|  | ||||
| void janet_os_mutex_init(JanetOSMutex *mutex) { | ||||
|     pthread_mutexattr_t attr; | ||||
|     pthread_mutexattr_init(&attr); | ||||
| @@ -212,11 +194,11 @@ void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) { | ||||
| #endif | ||||
|  | ||||
| int32_t janet_abstract_incref(void *abst) { | ||||
|     return janet_incref(janet_abstract_head(abst)); | ||||
|     return janet_atomic_inc(&janet_abstract_head(abst)->gc.data.refcount); | ||||
| } | ||||
|  | ||||
| int32_t janet_abstract_decref(void *abst) { | ||||
|     return janet_decref(janet_abstract_head(abst)); | ||||
|     return janet_atomic_dec(&janet_abstract_head(abst)->gc.data.refcount); | ||||
| } | ||||
|  | ||||
| #endif | ||||
|   | ||||
| @@ -30,9 +30,7 @@ | ||||
|  | ||||
| #include <string.h> | ||||
|  | ||||
| /* Creates a new array */ | ||||
| JanetArray *janet_array(int32_t capacity) { | ||||
|     JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray)); | ||||
| static void janet_array_impl(JanetArray *array, int32_t capacity) { | ||||
|     Janet *data = NULL; | ||||
|     if (capacity > 0) { | ||||
|         janet_vm.next_collection += capacity * sizeof(Janet); | ||||
| @@ -44,6 +42,19 @@ JanetArray *janet_array(int32_t capacity) { | ||||
|     array->count = 0; | ||||
|     array->capacity = capacity; | ||||
|     array->data = data; | ||||
| } | ||||
|  | ||||
| /* Creates a new array */ | ||||
| JanetArray *janet_array(int32_t capacity) { | ||||
|     JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray)); | ||||
|     janet_array_impl(array, capacity); | ||||
|     return array; | ||||
| } | ||||
|  | ||||
| /* Creates a new array with weak references */ | ||||
| JanetArray *janet_array_weak(int32_t capacity) { | ||||
|     JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY_WEAK, sizeof(JanetArray)); | ||||
|     janet_array_impl(array, capacity); | ||||
|     return array; | ||||
| } | ||||
|  | ||||
| @@ -132,6 +143,15 @@ JANET_CORE_FN(cfun_array_new, | ||||
|     return janet_wrap_array(array); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_array_weak, | ||||
|               "(array/weak capacity)", | ||||
|               "Creates a new empty array with a pre-allocated capacity and support for weak references. Similar to `array/new`.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     int32_t cap = janet_getinteger(argv, 0); | ||||
|     JanetArray *array = janet_array_weak(cap); | ||||
|     return janet_wrap_array(array); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_array_new_filled, | ||||
|               "(array/new-filled count &opt value)", | ||||
|               "Creates a new array of `count` elements, all set to `value`, which defaults to nil. Returns the new array.") { | ||||
| @@ -177,8 +197,8 @@ JANET_CORE_FN(cfun_array_peek, | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_array_push, | ||||
|               "(array/push arr x)", | ||||
|               "Insert an element in the end of an array. Modifies the input array and returns it.") { | ||||
|               "(array/push arr & xs)", | ||||
|               "Push all the elements of xs to the end of an array. Modifies the input array and returns it.") { | ||||
|     janet_arity(argc, 1, -1); | ||||
|     JanetArray *array = janet_getarray(argv, 0); | ||||
|     if (INT32_MAX - argc + 1 <= array->count) { | ||||
| @@ -211,7 +231,7 @@ JANET_CORE_FN(cfun_array_slice, | ||||
|               "Takes a slice of array or tuple from `start` to `end`. The range is half open, " | ||||
|               "[start, end). Indexes can also be negative, indicating indexing from the " | ||||
|               "end of the array. By default, `start` is 0 and `end` is the length of the array. " | ||||
|               "Note that index -1 is synonymous with index `(length arrtup)` to allow a full " | ||||
|               "Note that if the range is negative, it is taken as (start, end] to allow a full " | ||||
|               "negative slice range. Returns a new array.") { | ||||
|     JanetView view = janet_getindexed(argv, 0); | ||||
|     JanetRange range = janet_getslice(argc, argv); | ||||
| @@ -259,8 +279,8 @@ 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 " | ||||
|               "0 and the length of the array. A negative value for `at` will index backwards from " | ||||
|               "the end of the array, such that inserting at -1 appends to the array. " | ||||
|               "Returns the array.") { | ||||
|               "the end of the array, inserting after the index such that inserting at -1 appends to " | ||||
|               "the array. Returns the array.") { | ||||
|     size_t chunksize, restsize; | ||||
|     janet_arity(argc, 2, -1); | ||||
|     JanetArray *array = janet_getarray(argv, 0); | ||||
| @@ -297,7 +317,7 @@ JANET_CORE_FN(cfun_array_remove, | ||||
|     int32_t at = janet_getinteger(argv, 1); | ||||
|     int32_t n = 1; | ||||
|     if (at < 0) { | ||||
|         at = array->count + at + 1; | ||||
|         at = array->count + at; | ||||
|     } | ||||
|     if (at < 0 || at > array->count) | ||||
|         janet_panicf("removal index %d out of range [0,%d]", at, array->count); | ||||
| @@ -352,6 +372,7 @@ JANET_CORE_FN(cfun_array_clear, | ||||
| void janet_lib_array(JanetTable *env) { | ||||
|     JanetRegExt array_cfuns[] = { | ||||
|         JANET_CORE_REG("array/new", cfun_array_new), | ||||
|         JANET_CORE_REG("array/weak", cfun_array_weak), | ||||
|         JANET_CORE_REG("array/new-filled", cfun_array_new_filled), | ||||
|         JANET_CORE_REG("array/fill", cfun_array_fill), | ||||
|         JANET_CORE_REG("array/pop", cfun_array_pop), | ||||
|   | ||||
| @@ -75,6 +75,7 @@ static const JanetInstructionDef janet_ops[] = { | ||||
|     {"cmp", JOP_COMPARE}, | ||||
|     {"cncl", JOP_CANCEL}, | ||||
|     {"div", JOP_DIVIDE}, | ||||
|     {"divf", JOP_DIVIDE_FLOOR}, | ||||
|     {"divim", JOP_DIVIDE_IMMEDIATE}, | ||||
|     {"eq", JOP_EQUALS}, | ||||
|     {"eqim", JOP_EQUALS_IMMEDIATE}, | ||||
| @@ -137,6 +138,7 @@ static const JanetInstructionDef janet_ops[] = { | ||||
|     {"sru", JOP_SHIFT_RIGHT_UNSIGNED}, | ||||
|     {"sruim", JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE}, | ||||
|     {"sub", JOP_SUBTRACT}, | ||||
|     {"subim", JOP_SUBTRACT_IMMEDIATE}, | ||||
|     {"tcall", JOP_TAILCALL}, | ||||
|     {"tchck", JOP_TYPECHECK} | ||||
| }; | ||||
| @@ -558,6 +560,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int | ||||
|     x = janet_get1(s, janet_ckeywordv("vararg")); | ||||
|     if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG; | ||||
|  | ||||
|     /* Initialize slotcount */ | ||||
|     def->slotcount = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG) + def->arity; | ||||
|  | ||||
|     /* Check structarg */ | ||||
|     x = janet_get1(s, janet_ckeywordv("structarg")); | ||||
|     if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG; | ||||
| @@ -782,8 +787,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int | ||||
|     } | ||||
|  | ||||
|     /* Verify the func def */ | ||||
|     if (janet_verify(def)) { | ||||
|         janet_asm_error(&a, "invalid assembly"); | ||||
|     int verify_status = janet_verify(def); | ||||
|     if (verify_status) { | ||||
|         janet_asm_errorv(&a, janet_formatc("invalid assembly (%d)", verify_status)); | ||||
|     } | ||||
|  | ||||
|     /* Add final flags */ | ||||
|   | ||||
| @@ -135,8 +135,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) { | ||||
|  | ||||
| /* Push a cstring to buffer */ | ||||
| void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) { | ||||
|     int32_t len = 0; | ||||
|     while (cstring[len]) ++len; | ||||
|     int32_t len = (int32_t) strlen(cstring); | ||||
|     janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len); | ||||
| } | ||||
|  | ||||
| @@ -221,6 +220,20 @@ JANET_CORE_FN(cfun_buffer_new_filled, | ||||
|     return janet_wrap_buffer(buffer); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_buffer_frombytes, | ||||
|               "(buffer/from-bytes & byte-vals)", | ||||
|               "Creates a buffer from integer parameters with byte values. All integers " | ||||
|               "will be coerced to the range of 1 byte 0-255.") { | ||||
|     int32_t i; | ||||
|     JanetBuffer *buffer = janet_buffer(argc); | ||||
|     for (i = 0; i < argc; i++) { | ||||
|         int32_t c = janet_getinteger(argv, i); | ||||
|         buffer->data[i] = c & 0xFF; | ||||
|     } | ||||
|     buffer->count = argc; | ||||
|     return janet_wrap_buffer(buffer); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_buffer_fill, | ||||
|               "(buffer/fill buffer &opt byte)", | ||||
|               "Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. " | ||||
| @@ -307,6 +320,143 @@ JANET_CORE_FN(cfun_buffer_chars, | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static int should_reverse_bytes(const Janet *argv, int32_t argc) { | ||||
|     JanetKeyword order_kw = janet_getkeyword(argv, argc); | ||||
|     if (!janet_cstrcmp(order_kw, "le")) { | ||||
| #if JANET_BIG_ENDIAN | ||||
|         return 1; | ||||
| #endif | ||||
|     } else if (!janet_cstrcmp(order_kw, "be")) { | ||||
| #if JANET_LITTLE_ENDIAN | ||||
|         return 1; | ||||
| #endif | ||||
|     } else if (!janet_cstrcmp(order_kw, "native")) { | ||||
|         return 0; | ||||
|     } else { | ||||
|         janet_panicf("expected endianness :le, :be or :native, got %v", argv[1]); | ||||
|     } | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| static void reverse_u32(uint8_t bytes[4]) { | ||||
|     uint8_t temp; | ||||
|     temp = bytes[3]; | ||||
|     bytes[3] = bytes[0]; | ||||
|     bytes[0] = temp; | ||||
|     temp = bytes[2]; | ||||
|     bytes[2] = bytes[1]; | ||||
|     bytes[1] = temp; | ||||
| } | ||||
|  | ||||
| static void reverse_u64(uint8_t bytes[8]) { | ||||
|     uint8_t temp; | ||||
|     temp = bytes[7]; | ||||
|     bytes[7] = bytes[0]; | ||||
|     bytes[0] = temp; | ||||
|     temp = bytes[6]; | ||||
|     bytes[6] = bytes[1]; | ||||
|     bytes[1] = temp; | ||||
|     temp = bytes[5]; | ||||
|     bytes[5] = bytes[2]; | ||||
|     bytes[2] = temp; | ||||
|     temp = bytes[4]; | ||||
|     bytes[4] = bytes[3]; | ||||
|     bytes[3] = temp; | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_buffer_push_uint16, | ||||
|               "(buffer/push-uint16 buffer order data)", | ||||
|               "Push a 16 bit unsigned integer data onto the end of the buffer. " | ||||
|               "Returns the modified buffer.") { | ||||
|     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 = janet_getuinteger16(argv, 2); | ||||
|     if (reverse) { | ||||
|         uint8_t temp = u.bytes[1]; | ||||
|         u.bytes[1] = u.bytes[0]; | ||||
|         u.bytes[0] = temp; | ||||
|     } | ||||
|     janet_buffer_push_u16(buffer, *(uint16_t *) u.bytes); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_buffer_push_uint32, | ||||
|               "(buffer/push-uint32 buffer order data)", | ||||
|               "Push a 32 bit unsigned integer data onto the end of the buffer. " | ||||
|               "Returns the modified buffer.") { | ||||
|     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 = janet_getuinteger(argv, 2); | ||||
|     if (reverse) | ||||
|         reverse_u32(u.bytes); | ||||
|     janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_buffer_push_uint64, | ||||
|               "(buffer/push-uint64 buffer order data)", | ||||
|               "Push a 64 bit unsigned integer data onto the end of the buffer. " | ||||
|               "Returns the modified buffer.") { | ||||
|     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 = janet_getuinteger64(argv, 2); | ||||
|     if (reverse) | ||||
|         reverse_u64(u.bytes); | ||||
|     janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_buffer_push_float32, | ||||
|               "(buffer/push-float32 buffer order data)", | ||||
|               "Push the underlying bytes of a 32 bit float data onto the end of the buffer. " | ||||
|               "Returns the modified buffer.") { | ||||
|     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); | ||||
|     if (reverse) | ||||
|         reverse_u32(u.bytes); | ||||
|     janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_buffer_push_float64, | ||||
|               "(buffer/push-float64 buffer order data)", | ||||
|               "Push the underlying bytes of a 64 bit float data onto the end of the buffer. " | ||||
|               "Returns the modified buffer.") { | ||||
|     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); | ||||
|     if (reverse) | ||||
|         reverse_u64(u.bytes); | ||||
|     janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static void buffer_push_impl(JanetBuffer *buffer, Janet *argv, int32_t argc_offset, int32_t argc) { | ||||
|     for (int32_t i = argc_offset; i < argc; i++) { | ||||
|         if (janet_checktype(argv[i], JANET_NUMBER)) { | ||||
| @@ -462,13 +612,15 @@ JANET_CORE_FN(cfun_buffer_blit, | ||||
|     int same_buf = src.bytes == dest->data; | ||||
|     int32_t offset_dest = 0; | ||||
|     int32_t offset_src = 0; | ||||
|     if (argc > 2) | ||||
|     if (argc > 2 && !janet_checktype(argv[2], JANET_NIL)) | ||||
|         offset_dest = janet_gethalfrange(argv, 2, dest->count, "dest-start"); | ||||
|     if (argc > 3) | ||||
|     if (argc > 3 && !janet_checktype(argv[3], JANET_NIL)) | ||||
|         offset_src = janet_gethalfrange(argv, 3, src.len, "src-start"); | ||||
|     int32_t length_src; | ||||
|     if (argc > 4) { | ||||
|         int32_t src_end = janet_gethalfrange(argv, 4, src.len, "src-end"); | ||||
|         int32_t src_end = src.len; | ||||
|         if (!janet_checktype(argv[4], JANET_NIL)) | ||||
|             src_end = janet_gethalfrange(argv, 4, src.len, "src-end"); | ||||
|         length_src = src_end - offset_src; | ||||
|         if (length_src < 0) length_src = 0; | ||||
|     } else { | ||||
| @@ -503,15 +655,42 @@ JANET_CORE_FN(cfun_buffer_format, | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_buffer_format_at, | ||||
|               "(buffer/format-at buffer at format & args)", | ||||
|               "Snprintf like functionality for printing values into a buffer. Returns " | ||||
|               "the modified buffer.") { | ||||
|     janet_arity(argc, 2, -1); | ||||
|     JanetBuffer *buffer = janet_getbuffer(argv, 0); | ||||
|     int32_t at = janet_getinteger(argv, 1); | ||||
|     if (at < 0) { | ||||
|         at += buffer->count + 1; | ||||
|     } | ||||
|     if (at > buffer->count || at < 0) janet_panicf("expected index at to be in range [0, %d), got %d", buffer->count, at); | ||||
|     int32_t oldcount = buffer->count; | ||||
|     buffer->count = at; | ||||
|     const char *strfrmt = (const char *) janet_getstring(argv, 2); | ||||
|     janet_buffer_format(buffer, strfrmt, 2, argc, argv); | ||||
|     if (buffer->count < oldcount) { | ||||
|         buffer->count = oldcount; | ||||
|     } | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| void janet_lib_buffer(JanetTable *env) { | ||||
|     JanetRegExt buffer_cfuns[] = { | ||||
|         JANET_CORE_REG("buffer/new", cfun_buffer_new), | ||||
|         JANET_CORE_REG("buffer/new-filled", cfun_buffer_new_filled), | ||||
|         JANET_CORE_REG("buffer/from-bytes", cfun_buffer_frombytes), | ||||
|         JANET_CORE_REG("buffer/fill", cfun_buffer_fill), | ||||
|         JANET_CORE_REG("buffer/trim", cfun_buffer_trim), | ||||
|         JANET_CORE_REG("buffer/push-byte", cfun_buffer_u8), | ||||
|         JANET_CORE_REG("buffer/push-word", cfun_buffer_word), | ||||
|         JANET_CORE_REG("buffer/push-string", cfun_buffer_chars), | ||||
|         JANET_CORE_REG("buffer/push-uint16", cfun_buffer_push_uint16), | ||||
|         JANET_CORE_REG("buffer/push-uint32", cfun_buffer_push_uint32), | ||||
|         JANET_CORE_REG("buffer/push-uint64", cfun_buffer_push_uint64), | ||||
|         JANET_CORE_REG("buffer/push-float32", cfun_buffer_push_float32), | ||||
|         JANET_CORE_REG("buffer/push-float64", cfun_buffer_push_float64), | ||||
|         JANET_CORE_REG("buffer/push", cfun_buffer_push), | ||||
|         JANET_CORE_REG("buffer/push-at", cfun_buffer_push_at), | ||||
|         JANET_CORE_REG("buffer/popn", cfun_buffer_popn), | ||||
| @@ -523,6 +702,7 @@ void janet_lib_buffer(JanetTable *env) { | ||||
|         JANET_CORE_REG("buffer/bit-toggle", cfun_buffer_bittoggle), | ||||
|         JANET_CORE_REG("buffer/blit", cfun_buffer_blit), | ||||
|         JANET_CORE_REG("buffer/format", cfun_buffer_format), | ||||
|         JANET_CORE_REG("buffer/format-at", cfun_buffer_format_at), | ||||
|         JANET_REG_END | ||||
|     }; | ||||
|     janet_core_cfuns_ext(env, NULL, buffer_cfuns); | ||||
|   | ||||
| @@ -37,11 +37,13 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = { | ||||
|     JINT_0, /* JOP_RETURN_NIL, */ | ||||
|     JINT_SSI, /* JOP_ADD_IMMEDIATE, */ | ||||
|     JINT_SSS, /* JOP_ADD, */ | ||||
|     JINT_SSI, /* JOP_SUBTRACT_IMMEDIATE, */ | ||||
|     JINT_SSS, /* JOP_SUBTRACT, */ | ||||
|     JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */ | ||||
|     JINT_SSS, /* JOP_MULTIPLY, */ | ||||
|     JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */ | ||||
|     JINT_SSS, /* JOP_DIVIDE, */ | ||||
|     JINT_SSS, /* JOP_DIVIDE_FLOOR */ | ||||
|     JINT_SSS, /* JOP_MODULO, */ | ||||
|     JINT_SSS, /* JOP_REMAINDER, */ | ||||
|     JINT_SSS, /* JOP_BAND, */ | ||||
| @@ -224,6 +226,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) { | ||||
|                 case JOP_LOAD_TRUE: | ||||
|                 case JOP_LOAD_FALSE: | ||||
|                 case JOP_LOAD_SELF: | ||||
|                     break; | ||||
|                 case JOP_MAKE_ARRAY: | ||||
|                 case JOP_MAKE_BUFFER: | ||||
|                 case JOP_MAKE_STRING: | ||||
| @@ -231,6 +234,8 @@ void janet_bytecode_movopt(JanetFuncDef *def) { | ||||
|                 case JOP_MAKE_TABLE: | ||||
|                 case JOP_MAKE_TUPLE: | ||||
|                 case JOP_MAKE_BRACKET_TUPLE: | ||||
|                     /* Reads from the stack, don't remove */ | ||||
|                     janetc_regalloc_touch(&ra, DD); | ||||
|                     break; | ||||
|  | ||||
|                 /* Read A */ | ||||
| @@ -250,6 +255,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) { | ||||
|                 case JOP_SIGNAL: | ||||
|                 /* Write A, Read B */ | ||||
|                 case JOP_ADD_IMMEDIATE: | ||||
|                 case JOP_SUBTRACT_IMMEDIATE: | ||||
|                 case JOP_MULTIPLY_IMMEDIATE: | ||||
|                 case JOP_DIVIDE_IMMEDIATE: | ||||
|                 case JOP_SHIFT_LEFT_IMMEDIATE: | ||||
| @@ -301,6 +307,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) { | ||||
|                 case JOP_SUBTRACT: | ||||
|                 case JOP_MULTIPLY: | ||||
|                 case JOP_DIVIDE: | ||||
|                 case JOP_DIVIDE_FLOOR: | ||||
|                 case JOP_MODULO: | ||||
|                 case JOP_REMAINDER: | ||||
|                 case JOP_SHIFT_LEFT: | ||||
|   | ||||
							
								
								
									
										138
									
								
								src/core/capi.c
									
									
									
									
									
								
							
							
						
						
									
										138
									
								
								src/core/capi.c
									
									
									
									
									
								
							| @@ -35,6 +35,13 @@ | ||||
| #endif | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_USE_STDATOMIC | ||||
| #include <stdatomic.h> | ||||
| /* We don't need stdatomic on most compilers since we use compiler builtins for atomic operations. | ||||
|  * Some (TCC), explicitly require using stdatomic.h and don't have any exposed builtins (that I know of). | ||||
|  * For TCC and similar compilers, one would need -std=c11 or similar then to get access. */ | ||||
| #endif | ||||
|  | ||||
| JANET_NO_RETURN static void janet_top_level_signal(const char *msg) { | ||||
| #ifdef JANET_TOP_LEVEL_SIGNAL | ||||
|     JANET_TOP_LEVEL_SIGNAL(msg); | ||||
| @@ -216,12 +223,32 @@ const char *janet_getcstring(const Janet *argv, int32_t n) { | ||||
| } | ||||
|  | ||||
| const char *janet_getcbytes(const Janet *argv, int32_t n) { | ||||
|     /* Ensure buffer 0-padded */ | ||||
|     if (janet_checktype(argv[n], JANET_BUFFER)) { | ||||
|         JanetBuffer *b = janet_unwrap_buffer(argv[n]); | ||||
|         if ((b->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) && b->count == b->capacity) { | ||||
|             /* Make a copy with janet_smalloc in the rare case we have a buffer that | ||||
|              * cannot be realloced and pushing a 0 byte would panic. */ | ||||
|             char *new_string = janet_smalloc(b->count + 1); | ||||
|             memcpy(new_string, b->data, b->count); | ||||
|             new_string[b->count] = 0; | ||||
|             if (strlen(new_string) != (size_t) b->count) goto badzeros; | ||||
|             return new_string; | ||||
|         } else { | ||||
|             /* Ensure trailing 0 */ | ||||
|             janet_buffer_push_u8(b, 0); | ||||
|             b->count--; | ||||
|             if (strlen((char *)b->data) != (size_t) b->count) goto badzeros; | ||||
|             return (const char *) b->data; | ||||
|         } | ||||
|     } | ||||
|     JanetByteView view = janet_getbytes(argv, n); | ||||
|     const char *cstr = (const char *)view.bytes; | ||||
|     if (strlen(cstr) != (size_t) view.len) { | ||||
|         janet_panic("bytes contain embedded 0s"); | ||||
|     } | ||||
|     if (strlen(cstr) != (size_t) view.len) goto badzeros; | ||||
|     return cstr; | ||||
|  | ||||
| badzeros: | ||||
|     janet_panic("bytes contain embedded 0s"); | ||||
| } | ||||
|  | ||||
| const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt) { | ||||
| @@ -273,6 +300,31 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) { | ||||
|     return janet_unwrap_integer(x); | ||||
| } | ||||
|  | ||||
| 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 unsigned integer, got %v", n, 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]); | ||||
| @@ -290,7 +342,7 @@ uint64_t janet_getuinteger64(const Janet *argv, int32_t n) { | ||||
|     return janet_unwrap_u64(argv[n]); | ||||
| #else | ||||
|     Janet x = argv[n]; | ||||
|     if (!janet_checkint64(x)) { | ||||
|     if (!janet_checkuint64(x)) { | ||||
|         janet_panicf("bad slot #%d, expected 64 bit unsigned integer, got %v", n, x); | ||||
|     } | ||||
|     return (uint64_t) janet_unwrap_number(x); | ||||
| @@ -310,16 +362,30 @@ int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const c | ||||
|     int32_t not_raw = raw; | ||||
|     if (not_raw < 0) not_raw += length + 1; | ||||
|     if (not_raw < 0 || not_raw > length) | ||||
|         janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length); | ||||
|         janet_panicf("%s index %d out of range [%d,%d]", which, (int64_t) raw, -(int64_t)length - 1, (int64_t) length); | ||||
|     return not_raw; | ||||
| } | ||||
|  | ||||
| int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) { | ||||
|     if (n >= argc || janet_checktype(argv[n], JANET_NIL)) { | ||||
|         return 0; | ||||
|     } | ||||
|     return janet_gethalfrange(argv, n, length, "start"); | ||||
| } | ||||
|  | ||||
| int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) { | ||||
|     if (n >= argc || janet_checktype(argv[n], JANET_NIL)) { | ||||
|         return length; | ||||
|     } | ||||
|     return janet_gethalfrange(argv, n, length, "end"); | ||||
| } | ||||
|  | ||||
| int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) { | ||||
|     int32_t raw = janet_getinteger(argv, n); | ||||
|     int32_t not_raw = raw; | ||||
|     if (not_raw < 0) not_raw += length; | ||||
|     if (not_raw < 0 || not_raw > length) | ||||
|         janet_panicf("%s index %d out of range [%d,%d)", which, raw, -length, length); | ||||
|         janet_panicf("%s index %d out of range [%d,%d)", which, (int64_t)raw, -(int64_t)length, (int64_t)length); | ||||
|     return not_raw; | ||||
| } | ||||
|  | ||||
| @@ -366,24 +432,10 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) { | ||||
|     janet_arity(argc, 1, 3); | ||||
|     JanetRange range; | ||||
|     int32_t length = janet_length(argv[0]); | ||||
|     if (argc == 1) { | ||||
|         range.start = 0; | ||||
|         range.end = length; | ||||
|     } else if (argc == 2) { | ||||
|         range.start = janet_checktype(argv[1], JANET_NIL) | ||||
|                       ? 0 | ||||
|                       : janet_gethalfrange(argv, 1, length, "start"); | ||||
|         range.end = length; | ||||
|     } else { | ||||
|         range.start = janet_checktype(argv[1], JANET_NIL) | ||||
|                       ? 0 | ||||
|                       : janet_gethalfrange(argv, 1, length, "start"); | ||||
|         range.end = janet_checktype(argv[2], JANET_NIL) | ||||
|                     ? length | ||||
|                     : janet_gethalfrange(argv, 2, length, "end"); | ||||
|         if (range.end < range.start) | ||||
|             range.end = range.start; | ||||
|     } | ||||
|     range.start = janet_getstartrange(argv, argc, 1, length); | ||||
|     range.end = janet_getendrange(argv, argc, 2, length); | ||||
|     if (range.end < range.start) | ||||
|         range.end = range.start; | ||||
|     return range; | ||||
| } | ||||
|  | ||||
| @@ -463,9 +515,41 @@ void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetA | ||||
|     return janet_getabstract(argv, n, at); | ||||
| } | ||||
|  | ||||
| /* Atomic refcounts */ | ||||
|  | ||||
| JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     return InterlockedIncrement(x); | ||||
| #elif defined(JANET_USE_STDATOMIC) | ||||
|     return atomic_fetch_add_explicit(x, 1, memory_order_relaxed) + 1; | ||||
| #else | ||||
|     return __atomic_add_fetch(x, 1, __ATOMIC_RELAXED); | ||||
| #endif | ||||
| } | ||||
|  | ||||
| JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     return InterlockedDecrement(x); | ||||
| #elif defined(JANET_USE_STDATOMIC) | ||||
|     return atomic_fetch_add_explicit(x, -1, memory_order_acq_rel) - 1; | ||||
| #else | ||||
|     return __atomic_add_fetch(x, -1, __ATOMIC_ACQ_REL); | ||||
| #endif | ||||
| } | ||||
|  | ||||
| JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     return InterlockedOr(x, 0); | ||||
| #elif defined(JANET_USE_STDATOMIC) | ||||
|     return atomic_load_explicit(x, memory_order_acquire); | ||||
| #else | ||||
|     return __atomic_load_n(x, __ATOMIC_ACQUIRE); | ||||
| #endif | ||||
| } | ||||
|  | ||||
| /* Some definitions for function-like macros */ | ||||
|  | ||||
| JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) { | ||||
| JANET_API JanetStructHead *(janet_struct_head)(JanetStruct st) { | ||||
|     return janet_struct_head(st); | ||||
| } | ||||
|  | ||||
| @@ -473,10 +557,10 @@ JANET_API JanetAbstractHead *(janet_abstract_head)(const void *abstract) { | ||||
|     return janet_abstract_head(abstract); | ||||
| } | ||||
|  | ||||
| JANET_API JanetStringHead *(janet_string_head)(const uint8_t *s) { | ||||
| JANET_API JanetStringHead *(janet_string_head)(JanetString s) { | ||||
|     return janet_string_head(s); | ||||
| } | ||||
|  | ||||
| JANET_API JanetTupleHead *(janet_tuple_head)(const Janet *tuple) { | ||||
| JANET_API JanetTupleHead *(janet_tuple_head)(JanetTuple tuple) { | ||||
|     return janet_tuple_head(tuple); | ||||
| } | ||||
|   | ||||
| @@ -99,7 +99,7 @@ static JanetSlot opfunction( | ||||
| static int can_be_imm(Janet x, int8_t *out) { | ||||
|     if (!janet_checkint(x)) return 0; | ||||
|     int32_t integer = janet_unwrap_integer(x); | ||||
|     if (integer > 127 || integer < -127) return 0; | ||||
|     if (integer > INT8_MAX || integer < INT8_MIN) return 0; | ||||
|     *out = (int8_t) integer; | ||||
|     return 1; | ||||
| } | ||||
| @@ -116,12 +116,11 @@ static JanetSlot opreduce( | ||||
|     JanetSlot *args, | ||||
|     int op, | ||||
|     int opim, | ||||
|     Janet nullary) { | ||||
|     Janet nullary, | ||||
|     Janet unary) { | ||||
|     JanetCompiler *c = opts.compiler; | ||||
|     int32_t i, len; | ||||
|     int8_t imm = 0; | ||||
|     int neg = opim < 0; | ||||
|     if (opim < 0) opim = -opim; | ||||
|     len = janet_v_count(args); | ||||
|     JanetSlot t; | ||||
|     if (len == 0) { | ||||
| @@ -132,19 +131,19 @@ static JanetSlot opreduce( | ||||
|         if (op == JOP_SUBTRACT) { | ||||
|             janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1); | ||||
|         } else { | ||||
|             janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1); | ||||
|             janetc_emit_sss(c, op, t, janetc_cslot(unary), args[0], 1); | ||||
|         } | ||||
|         return t; | ||||
|     } | ||||
|     t = janetc_gettarget(opts); | ||||
|     if (opim && can_slot_be_imm(args[1], &imm)) { | ||||
|         janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1); | ||||
|         janetc_emit_ssi(c, opim, t, args[0], imm, 1); | ||||
|     } else { | ||||
|         janetc_emit_sss(c, op, t, args[0], args[1], 1); | ||||
|     } | ||||
|     for (i = 2; i < len; i++) { | ||||
|         if (opim && can_slot_be_imm(args[i], &imm)) { | ||||
|             janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1); | ||||
|             janetc_emit_ssi(c, opim, t, t, imm, 1); | ||||
|         } else { | ||||
|             janetc_emit_sss(c, op, t, t, args[i], 1); | ||||
|         } | ||||
| @@ -155,7 +154,7 @@ static JanetSlot opreduce( | ||||
| /* Function optimizers */ | ||||
|  | ||||
| static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil()); | ||||
|     return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil(), janet_wrap_nil()); | ||||
| } | ||||
| static JanetSlot do_error(JanetFopts opts, JanetSlot *args) { | ||||
|     janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0); | ||||
| @@ -172,7 +171,7 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) { | ||||
|     return t; | ||||
| } | ||||
| static JanetSlot do_in(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil()); | ||||
|     return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil(), janet_wrap_nil()); | ||||
| } | ||||
| static JanetSlot do_get(JanetFopts opts, JanetSlot *args) { | ||||
|     if (janet_v_count(args) == 3) { | ||||
| @@ -192,20 +191,14 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) { | ||||
|         c->buffer[label] |= (current - label) << 16; | ||||
|         return t; | ||||
|     } else { | ||||
|         return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil()); | ||||
|         return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil(), janet_wrap_nil()); | ||||
|     } | ||||
| } | ||||
| static JanetSlot do_next(JanetFopts opts, JanetSlot *args) { | ||||
|     return opfunction(opts, args, JOP_NEXT, janet_wrap_nil()); | ||||
| } | ||||
| static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil()); | ||||
| } | ||||
| static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil()); | ||||
| } | ||||
| static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil()); | ||||
|     return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil(), janet_wrap_nil()); | ||||
| } | ||||
| static JanetSlot do_put(JanetFopts opts, JanetSlot *args) { | ||||
|     if (opts.flags & JANET_FOPTS_DROP) { | ||||
| @@ -262,34 +255,43 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) { | ||||
| /* Variadic operators specialization */ | ||||
|  | ||||
| static JanetSlot do_add(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0)); | ||||
|     return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0)); | ||||
| } | ||||
| static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0)); | ||||
|     return opreduce(opts, args, JOP_SUBTRACT, JOP_SUBTRACT_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0)); | ||||
| } | ||||
| static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1)); | ||||
|     return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1)); | ||||
| } | ||||
| static JanetSlot do_div(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1)); | ||||
|     return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1)); | ||||
| } | ||||
| static JanetSlot do_divf(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_DIVIDE_FLOOR, 0, janet_wrap_integer(1), janet_wrap_integer(1)); | ||||
| } | ||||
| static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_integer(0), janet_wrap_integer(1)); | ||||
| } | ||||
| static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_integer(0), janet_wrap_integer(1)); | ||||
| } | ||||
| static JanetSlot do_band(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1)); | ||||
|     return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1), janet_wrap_integer(-1)); | ||||
| } | ||||
| static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0)); | ||||
|     return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0), janet_wrap_integer(0)); | ||||
| } | ||||
| static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0)); | ||||
|     return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0), janet_wrap_integer(0)); | ||||
| } | ||||
| static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1)); | ||||
|     return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1)); | ||||
| } | ||||
| static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1)); | ||||
|     return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1)); | ||||
| } | ||||
| static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1)); | ||||
|     return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1)); | ||||
| } | ||||
| static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) { | ||||
|     return genericSS(opts, JOP_BNOT, args[0]); | ||||
| @@ -383,10 +385,11 @@ static const JanetFunOptimizer optimizers[] = { | ||||
|     {fixarity2, do_propagate}, | ||||
|     {arity2or3, do_get}, | ||||
|     {arity1or2, do_next}, | ||||
|     {fixarity2, do_modulo}, | ||||
|     {fixarity2, do_remainder}, | ||||
|     {NULL, do_modulo}, | ||||
|     {NULL, do_remainder}, | ||||
|     {fixarity2, do_cmp}, | ||||
|     {fixarity2, do_cancel}, | ||||
|     {NULL, do_divf} | ||||
| }; | ||||
|  | ||||
| const JanetFunOptimizer *janetc_funopt(uint32_t flags) { | ||||
|   | ||||
| @@ -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(sizeof(uint32_t), slotchunks); | ||||
|         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 { | ||||
|   | ||||
| @@ -69,6 +69,7 @@ typedef enum { | ||||
| #define JANET_FUN_REMAINDER 30 | ||||
| #define JANET_FUN_CMP 31 | ||||
| #define JANET_FUN_CANCEL 32 | ||||
| #define JANET_FUN_DIVIDE_FLOOR 33 | ||||
|  | ||||
| /* Compiler typedefs */ | ||||
| typedef struct JanetCompiler JanetCompiler; | ||||
|   | ||||
| @@ -69,15 +69,15 @@ JanetModule janet_native(const char *name, const uint8_t **error) { | ||||
|             host.minor < modconf.minor || | ||||
|             host.bits != modconf.bits) { | ||||
|         char errbuf[128]; | ||||
|         sprintf(errbuf, "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)", | ||||
|                 host.major, | ||||
|                 host.minor, | ||||
|                 host.patch, | ||||
|                 host.bits, | ||||
|                 modconf.major, | ||||
|                 modconf.minor, | ||||
|                 modconf.patch, | ||||
|                 modconf.bits); | ||||
|         snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)", | ||||
|                  host.major, | ||||
|                  host.minor, | ||||
|                  host.patch, | ||||
|                  host.bits, | ||||
|                  modconf.major, | ||||
|                  modconf.minor, | ||||
|                  modconf.patch, | ||||
|                  modconf.bits); | ||||
|         *error = janet_cstring(errbuf); | ||||
|         return NULL; | ||||
|     } | ||||
| @@ -110,14 +110,14 @@ JANET_CORE_FN(janet_core_expand_path, | ||||
|               "(module/expand-path path template)", | ||||
|               "Expands a path template as found in `module/paths` for `module/find`. " | ||||
|               "This takes in a path (the argument to require) and a template string, " | ||||
|               "to expand the path to a path that can be " | ||||
|               "used for importing files. The replacements are as follows:\n\n" | ||||
|               "to expand the path to a path that can be used for importing files. " | ||||
|               "The replacements are as follows:\n\n" | ||||
|               "* :all: -- the value of path verbatim.\n\n" | ||||
|               "* :@all: -- Same as :all:, but if `path` starts with the @ character,\n" | ||||
|               "           the first path segment is replaced with a dynamic binding\n" | ||||
|               "           `(dyn <first path segment as keyword>)`.\n\n" | ||||
|               "* :cur: -- the current file, or (dyn :current-file)\n\n" | ||||
|               "* :dir: -- the directory containing the current file\n\n" | ||||
|               "* :@all: -- Same as :all:, but if `path` starts with the @ character, " | ||||
|               "the first path segment is replaced with a dynamic binding " | ||||
|               "`(dyn <first path segment as keyword>)`.\n\n" | ||||
|               "* :cur: -- the directory portion, if any, of (dyn :current-file)\n\n" | ||||
|               "* :dir: -- the directory portion, if any, of the path argument\n\n" | ||||
|               "* :name: -- the name component of path, with extension if given\n\n" | ||||
|               "* :native: -- the extension used to load natives, .so or .dll\n\n" | ||||
|               "* :sys: -- the system path, or (dyn :syspath)") { | ||||
| @@ -426,6 +426,36 @@ JANET_CORE_FN(janet_core_slice, | ||||
|     } | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(janet_core_range, | ||||
|               "(range & args)", | ||||
|               "Create an array of values [start, end) with a given step. " | ||||
|               "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; | ||||
|     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); | ||||
|     } else if (argc == 2) { | ||||
|         start = janet_getinteger(argv, 0); | ||||
|         stop = janet_getinteger(argv, 1); | ||||
|         count = stop - start; | ||||
|     } else { | ||||
|         stop = janet_getinteger(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); | ||||
|     } | ||||
|     array->count = count; | ||||
|     return janet_wrap_array(array); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(janet_core_table, | ||||
|               "(table & kvs)", | ||||
|               "Creates a new table from a variadic number of keys and values. " | ||||
| @@ -629,6 +659,34 @@ ret_false: | ||||
|     return janet_wrap_false(); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(janet_core_is_bytes, | ||||
|               "(bytes? x)", | ||||
|               "Check if x is a string, symbol, keyword, or buffer.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_BYTES)); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(janet_core_is_indexed, | ||||
|               "(indexed? x)", | ||||
|               "Check if x is an array or tuple.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_INDEXED)); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(janet_core_is_dictionary, | ||||
|               "(dictionary? x)", | ||||
|               "Check if x is a table or struct.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_DICTIONARY)); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(janet_core_is_lengthable, | ||||
|               "(lengthable? x)", | ||||
|               "Check if x is a bytes, indexed, or dictionary.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_LENGTHABLE)); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(janet_core_signal, | ||||
|               "(signal what x)", | ||||
|               "Raise a signal with payload x. ") { | ||||
| @@ -690,6 +748,7 @@ static const SandboxOption sandbox_options[] = { | ||||
|     {"net-connect", JANET_SANDBOX_NET_CONNECT}, | ||||
|     {"net-listen", JANET_SANDBOX_NET_LISTEN}, | ||||
|     {"sandbox", JANET_SANDBOX_SANDBOX}, | ||||
|     {"signal", JANET_SANDBOX_SIGNAL}, | ||||
|     {"subprocess", JANET_SANDBOX_SUBPROCESS}, | ||||
|     {NULL, 0} | ||||
| }; | ||||
| @@ -714,6 +773,7 @@ JANET_CORE_FN(janet_core_sandbox, | ||||
|               "* :net-connect - disallow making outbound network connections\n" | ||||
|               "* :net-listen - disallow accepting inbound network connections\n" | ||||
|               "* :sandbox - disallow calling this function\n" | ||||
|               "* :signal - disallow adding or removing signal handlers\n" | ||||
|               "* :subprocess - disallow running subprocesses") { | ||||
|     uint32_t flags = 0; | ||||
|     for (int32_t i = 0; i < argc; i++) { | ||||
| @@ -985,14 +1045,6 @@ static const uint32_t next_asm[] = { | ||||
|     JOP_NEXT | (1 << 24), | ||||
|     JOP_RETURN | ||||
| }; | ||||
| static const uint32_t modulo_asm[] = { | ||||
|     JOP_MODULO | (1 << 24), | ||||
|     JOP_RETURN | ||||
| }; | ||||
| static const uint32_t remainder_asm[] = { | ||||
|     JOP_REMAINDER | (1 << 24), | ||||
|     JOP_RETURN | ||||
| }; | ||||
| static const uint32_t cmp_asm[] = { | ||||
|     JOP_COMPARE | (1 << 24), | ||||
|     JOP_RETURN | ||||
| @@ -1031,7 +1083,12 @@ static void janet_load_libs(JanetTable *env) { | ||||
|         JANET_CORE_REG("module/expand-path", janet_core_expand_path), | ||||
|         JANET_CORE_REG("int?", janet_core_check_int), | ||||
|         JANET_CORE_REG("nat?", janet_core_check_nat), | ||||
|         JANET_CORE_REG("bytes?", janet_core_is_bytes), | ||||
|         JANET_CORE_REG("indexed?", janet_core_is_indexed), | ||||
|         JANET_CORE_REG("dictionary?", janet_core_is_dictionary), | ||||
|         JANET_CORE_REG("lengthable?", janet_core_is_lengthable), | ||||
|         JANET_CORE_REG("slice", janet_core_slice), | ||||
|         JANET_CORE_REG("range", janet_core_range), | ||||
|         JANET_CORE_REG("signal", janet_core_signal), | ||||
|         JANET_CORE_REG("memcmp", janet_core_memcmp), | ||||
|         JANET_CORE_REG("getproto", janet_core_getproto), | ||||
| @@ -1077,14 +1134,6 @@ static void janet_load_libs(JanetTable *env) { | ||||
|  | ||||
| JanetTable *janet_core_env(JanetTable *replacements) { | ||||
|     JanetTable *env = (NULL != replacements) ? replacements : janet_table(0); | ||||
|     janet_quick_asm(env, JANET_FUN_MODULO, | ||||
|                     "mod", 2, 2, 2, 2, modulo_asm, sizeof(modulo_asm), | ||||
|                     JDOC("(mod dividend divisor)\n\n" | ||||
|                          "Returns the modulo of dividend / divisor.")); | ||||
|     janet_quick_asm(env, JANET_FUN_REMAINDER, | ||||
|                     "%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm), | ||||
|                     JDOC("(% dividend divisor)\n\n" | ||||
|                          "Returns the remainder of dividend / divisor.")); | ||||
|     janet_quick_asm(env, JANET_FUN_CMP, | ||||
|                     "cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm), | ||||
|                     JDOC("(cmp x y)\n\n" | ||||
| @@ -1095,17 +1144,20 @@ JanetTable *janet_core_env(JanetTable *replacements) { | ||||
|                     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 they data structure is not mutated " | ||||
|                          "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. 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" | ||||
| @@ -1183,6 +1235,18 @@ JanetTable *janet_core_env(JanetTable *replacements) { | ||||
|                           "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.")); | ||||
|     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`.")); | ||||
|     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.")); | ||||
|     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.")); | ||||
|   | ||||
| @@ -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"); | ||||
|             } | ||||
|             */ | ||||
|         } | ||||
|     } | ||||
|  | ||||
| @@ -388,8 +393,8 @@ JANET_CORE_FN(cfun_debug_stack, | ||||
| JANET_CORE_FN(cfun_debug_stacktrace, | ||||
|               "(debug/stacktrace fiber &opt err prefix)", | ||||
|               "Prints a nice looking stacktrace for a fiber. Can optionally provide " | ||||
|               "an error value to print the stack trace with. If `err` is nil or not " | ||||
|               "provided, and no prefix is given, will skip the error line. Returns the fiber.") { | ||||
|               "an error value to print the stack trace with. If `prefix` is nil or not " | ||||
|               "provided, will skip the error line. Returns the fiber.") { | ||||
|     janet_arity(argc, 1, 3); | ||||
|     JanetFiber *fiber = janet_getfiber(argv, 0); | ||||
|     Janet x = argc == 1 ? janet_wrap_nil() : argv[1]; | ||||
|   | ||||
| @@ -26,6 +26,7 @@ | ||||
| #include "emit.h" | ||||
| #include "vector.h" | ||||
| #include "regalloc.h" | ||||
| #include "util.h" | ||||
| #endif | ||||
|  | ||||
| /* Get a register */ | ||||
| @@ -128,7 +129,8 @@ static void janetc_movenear(JanetCompiler *c, | ||||
|                     ((uint32_t)(src.envindex) << 16) | | ||||
|                     ((uint32_t)(dest) << 8) | | ||||
|                     JOP_LOAD_UPVALUE); | ||||
|     } else if (src.index > 0xFF || src.index != dest) { | ||||
|     } else if (src.index != dest) { | ||||
|         janet_assert(src.index >= 0, "bad slot"); | ||||
|         janetc_emit(c, | ||||
|                     ((uint32_t)(src.index) << 16) | | ||||
|                     ((uint32_t)(dest) << 8) | | ||||
| @@ -155,6 +157,7 @@ static void janetc_moveback(JanetCompiler *c, | ||||
|                     ((uint32_t)(src) << 8) | | ||||
|                     JOP_SET_UPVALUE); | ||||
|     } else if (dest.index != src) { | ||||
|         janet_assert(dest.index >= 0, "bad slot"); | ||||
|         janetc_emit(c, | ||||
|                     ((uint32_t)(dest.index) << 16) | | ||||
|                     ((uint32_t)(src) << 8) | | ||||
|   | ||||
							
								
								
									
										1162
									
								
								src/core/ev.c
									
									
									
									
									
								
							
							
						
						
									
										1162
									
								
								src/core/ev.c
									
									
									
									
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							| @@ -76,4 +76,6 @@ | ||||
| #define __BSD_VISIBLE 1 | ||||
| #endif | ||||
|  | ||||
| #define _FILE_OFFSET_BITS 64 | ||||
|  | ||||
| #endif | ||||
|   | ||||
| @@ -1381,7 +1381,7 @@ JANET_CORE_FN(cfun_ffi_buffer_write, | ||||
|               "(ffi/write ffi-type data &opt buffer index)", | ||||
|               "Append a native type to a buffer such as it would appear in memory. This can be used " | ||||
|               "to pass pointers to structs in the ffi, or send C/C++/native structs over the network " | ||||
|               "or to files. Returns a modifed buffer or a new buffer if one is not supplied.") { | ||||
|               "or to files. Returns a modified buffer or a new buffer if one is not supplied.") { | ||||
|     janet_sandbox_assert(JANET_SANDBOX_FFI_USE); | ||||
|     janet_arity(argc, 2, 4); | ||||
|     JanetFFIType type = decode_ffi_type(argv[0]); | ||||
| @@ -1530,9 +1530,25 @@ JANET_CORE_FN(cfun_ffi_pointer_buffer, | ||||
|     return janet_wrap_buffer(janet_pointer_buffer_unsafe(offset_pointer, capacity, count)); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_ffi_pointer_cfunction, | ||||
|               "(ffi/pointer-cfunction pointer &opt name source-file source-line)", | ||||
|               "Create a C Function from a raw pointer. Optionally give the cfunction a name and " | ||||
|               "source location for stack traces and debugging.") { | ||||
|     janet_sandbox_assert(JANET_SANDBOX_FFI_USE); | ||||
|     janet_arity(argc, 1, 4); | ||||
|     void *pointer = janet_getpointer(argv, 0); | ||||
|     const char *name = janet_optcstring(argv, argc, 1, NULL); | ||||
|     const char *source = janet_optcstring(argv, argc, 2, NULL); | ||||
|     int32_t line = janet_optinteger(argv, argc, 3, -1); | ||||
|     if ((name != NULL) || (source != NULL) || (line != -1)) { | ||||
|         janet_registry_put((JanetCFunction) pointer, name, NULL, source, line); | ||||
|     } | ||||
|     return janet_wrap_cfunction((JanetCFunction) pointer); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_ffi_supported_calling_conventions, | ||||
|               "(ffi/calling-conventions)", | ||||
|               "Get an array of all supported calling conventions on the current arhcitecture. Some architectures may have some FFI " | ||||
|               "Get an array of all supported calling conventions on the current architecture. Some architectures may have some FFI " | ||||
|               "functionality (ffi/malloc, ffi/free, ffi/read, ffi/write, etc.) but not support " | ||||
|               "any calling conventions. This function can be used to get all supported calling conventions " | ||||
|               "that can be used on this architecture. All architectures support the :none calling " | ||||
| @@ -1567,6 +1583,7 @@ void janet_lib_ffi(JanetTable *env) { | ||||
|         JANET_CORE_REG("ffi/malloc", cfun_ffi_malloc), | ||||
|         JANET_CORE_REG("ffi/free", cfun_ffi_free), | ||||
|         JANET_CORE_REG("ffi/pointer-buffer", cfun_ffi_pointer_buffer), | ||||
|         JANET_CORE_REG("ffi/pointer-cfunction", cfun_ffi_pointer_cfunction), | ||||
|         JANET_CORE_REG("ffi/calling-conventions", cfun_ffi_supported_calling_conventions), | ||||
|         JANET_REG_END | ||||
|     }; | ||||
|   | ||||
| @@ -39,8 +39,10 @@ static void fiber_reset(JanetFiber *fiber) { | ||||
|     fiber->env = NULL; | ||||
|     fiber->last_value = janet_wrap_nil(); | ||||
| #ifdef JANET_EV | ||||
|     fiber->waiting = NULL; | ||||
|     fiber->sched_id = 0; | ||||
|     fiber->ev_callback = NULL; | ||||
|     fiber->ev_state = NULL; | ||||
|     fiber->ev_stream = NULL; | ||||
|     fiber->supervisor_channel = NULL; | ||||
| #endif | ||||
|     janet_fiber_set_status(fiber, JANET_STATUS_NEW); | ||||
| @@ -85,7 +87,6 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t | ||||
|     if (janet_fiber_funcframe(fiber, callee)) return NULL; | ||||
|     janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE; | ||||
| #ifdef JANET_EV | ||||
|     fiber->waiting = NULL; | ||||
|     fiber->supervisor_channel = NULL; | ||||
| #endif | ||||
|     return fiber; | ||||
| @@ -238,8 +239,8 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) { | ||||
|                                          fiber->data + tuplehead, | ||||
|                                          oldtop - tuplehead) | ||||
|                                      : janet_wrap_tuple(janet_tuple_n( | ||||
|                                                  fiber->data + tuplehead, | ||||
|                                                  oldtop - tuplehead)); | ||||
|                                              fiber->data + tuplehead, | ||||
|                                              oldtop - tuplehead)); | ||||
|         } | ||||
|     } | ||||
|  | ||||
| @@ -369,8 +370,8 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) { | ||||
|                                          fiber->data + tuplehead, | ||||
|                                          fiber->stacktop - tuplehead) | ||||
|                                      : janet_wrap_tuple(janet_tuple_n( | ||||
|                                                  fiber->data + tuplehead, | ||||
|                                                  fiber->stacktop - tuplehead)); | ||||
|                                              fiber->data + tuplehead, | ||||
|                                              fiber->stacktop - tuplehead)); | ||||
|         } | ||||
|         stacksize = tuplehead - fiber->stackstart + 1; | ||||
|     } else { | ||||
| @@ -661,7 +662,7 @@ JANET_CORE_FN(cfun_fiber_can_resume, | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_fiber_last_value, | ||||
|               "(fiber/last-value)", | ||||
|               "(fiber/last-value fiber)", | ||||
|               "Get the last value returned or signaled from the fiber.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetFiber *fiber = janet_getfiber(argv, 0); | ||||
|   | ||||
| @@ -59,6 +59,9 @@ | ||||
| #define JANET_FIBER_EV_FLAG_CANCELED 0x10000 | ||||
| #define JANET_FIBER_EV_FLAG_SUSPENDED 0x20000 | ||||
| #define JANET_FIBER_FLAG_ROOT 0x40000 | ||||
| #define JANET_FIBER_EV_FLAG_IN_FLIGHT 0x1 | ||||
|  | ||||
| /* used only on windows, should otherwise be unset */ | ||||
|  | ||||
| #define janet_fiber_set_status(f, s) do {\ | ||||
|     (f)->flags &= ~JANET_FIBER_STATUS_MASK;\ | ||||
|   | ||||
							
								
								
									
										171
									
								
								src/core/gc.c
									
									
									
									
									
								
							
							
						
						
									
										171
									
								
								src/core/gc.c
									
									
									
									
									
								
							| @@ -132,6 +132,24 @@ static void janet_mark_many(const Janet *values, int32_t n) { | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Mark a bunch of key values items in memory */ | ||||
| static void janet_mark_keys(const JanetKV *kvs, int32_t n) { | ||||
|     const JanetKV *end = kvs + n; | ||||
|     while (kvs < end) { | ||||
|         janet_mark(kvs->key); | ||||
|         kvs++; | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Mark a bunch of key values items in memory */ | ||||
| static void janet_mark_values(const JanetKV *kvs, int32_t n) { | ||||
|     const JanetKV *end = kvs + n; | ||||
|     while (kvs < end) { | ||||
|         janet_mark(kvs->value); | ||||
|         kvs++; | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Mark a bunch of key values items in memory */ | ||||
| static void janet_mark_kvs(const JanetKV *kvs, int32_t n) { | ||||
|     const JanetKV *end = kvs + n; | ||||
| @@ -146,7 +164,9 @@ static void janet_mark_array(JanetArray *array) { | ||||
|     if (janet_gc_reachable(array)) | ||||
|         return; | ||||
|     janet_gc_mark(array); | ||||
|     janet_mark_many(array->data, array->count); | ||||
|     if (janet_gc_type((JanetGCObject *) array) == JANET_MEMORY_ARRAY) { | ||||
|         janet_mark_many(array->data, array->count); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static void janet_mark_table(JanetTable *table) { | ||||
| @@ -154,7 +174,15 @@ recur: /* Manual tail recursion */ | ||||
|     if (janet_gc_reachable(table)) | ||||
|         return; | ||||
|     janet_gc_mark(table); | ||||
|     janet_mark_kvs(table->data, table->capacity); | ||||
|     enum JanetMemoryType memtype = janet_gc_type(table); | ||||
|     if (memtype == JANET_MEMORY_TABLE_WEAKK) { | ||||
|         janet_mark_values(table->data, table->capacity); | ||||
|     } else if (memtype == JANET_MEMORY_TABLE_WEAKV) { | ||||
|         janet_mark_keys(table->data, table->capacity); | ||||
|     } else if (memtype == JANET_MEMORY_TABLE) { | ||||
|         janet_mark_kvs(table->data, table->capacity); | ||||
|     } | ||||
|     /* do nothing for JANET_MEMORY_TABLE_WEAKKV */ | ||||
|     if (table->proto) { | ||||
|         table = table->proto; | ||||
|         goto recur; | ||||
| @@ -268,6 +296,12 @@ recur: | ||||
|     if (fiber->supervisor_channel) { | ||||
|         janet_mark_abstract(fiber->supervisor_channel); | ||||
|     } | ||||
|     if (fiber->ev_stream) { | ||||
|         janet_mark_abstract(fiber->ev_stream); | ||||
|     } | ||||
|     if (fiber->ev_callback) { | ||||
|         fiber->ev_callback(fiber, JANET_ASYNC_EVENT_MARK); | ||||
|     } | ||||
| #endif | ||||
|  | ||||
|     /* Explicit tail recursion */ | ||||
| @@ -292,9 +326,17 @@ static void janet_deinit_block(JanetGCObject *mem) { | ||||
|         case JANET_MEMORY_TABLE: | ||||
|             janet_free(((JanetTable *) mem)->data); | ||||
|             break; | ||||
|         case JANET_MEMORY_FIBER: | ||||
|             janet_free(((JanetFiber *)mem)->data); | ||||
|             break; | ||||
|         case JANET_MEMORY_FIBER: { | ||||
|             JanetFiber *f = (JanetFiber *)mem; | ||||
| #ifdef JANET_EV | ||||
|             if (f->ev_state && !(f->flags & JANET_FIBER_EV_FLAG_IN_FLIGHT)) { | ||||
|                 janet_ev_dec_refcount(); | ||||
|                 janet_free(f->ev_state); | ||||
|             } | ||||
| #endif | ||||
|             janet_free(f->data); | ||||
|         } | ||||
|         break; | ||||
|         case JANET_MEMORY_BUFFER: | ||||
|             janet_buffer_deinit((JanetBuffer *) mem); | ||||
|             break; | ||||
| @@ -326,12 +368,98 @@ static void janet_deinit_block(JanetGCObject *mem) { | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Check that a value x has been visited in the mark phase */ | ||||
| static int janet_check_liveref(Janet x) { | ||||
|     switch (janet_type(x)) { | ||||
|         default: | ||||
|             return 1; | ||||
|         case JANET_ARRAY: | ||||
|         case JANET_TABLE: | ||||
|         case JANET_FUNCTION: | ||||
|         case JANET_BUFFER: | ||||
|         case JANET_FIBER: | ||||
|             return janet_gc_reachable(janet_unwrap_pointer(x)); | ||||
|         case JANET_STRING: | ||||
|         case JANET_SYMBOL: | ||||
|         case JANET_KEYWORD: | ||||
|             return janet_gc_reachable(janet_string_head(janet_unwrap_string(x))); | ||||
|         case JANET_ABSTRACT: | ||||
|             return janet_gc_reachable(janet_abstract_head(janet_unwrap_abstract(x))); | ||||
|         case JANET_TUPLE: | ||||
|             return janet_gc_reachable(janet_tuple_head(janet_unwrap_tuple(x))); | ||||
|         case JANET_STRUCT: | ||||
|             return janet_gc_reachable(janet_struct_head(janet_unwrap_struct(x))); | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Iterate over all allocated memory, and free memory that is not | ||||
|  * marked as reachable. Flip the gc color flag for next sweep. */ | ||||
| void janet_sweep() { | ||||
|     JanetGCObject *previous = NULL; | ||||
|     JanetGCObject *current = janet_vm.blocks; | ||||
|     JanetGCObject *current = janet_vm.weak_blocks; | ||||
|     JanetGCObject *next; | ||||
|  | ||||
|     /* Sweep weak heap to drop weak refs */ | ||||
|     while (NULL != current) { | ||||
|         next = current->data.next; | ||||
|         if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) { | ||||
|             /* Check for dead references */ | ||||
|             enum JanetMemoryType type = janet_gc_type(current); | ||||
|             if (type == JANET_MEMORY_ARRAY_WEAK) { | ||||
|                 JanetArray *array = (JanetArray *) current; | ||||
|                 for (uint32_t i = 0; i < (uint32_t) array->count; i++) { | ||||
|                     if (!janet_check_liveref(array->data[i])) { | ||||
|                         array->data[i] = janet_wrap_nil(); | ||||
|                     } | ||||
|                 } | ||||
|             } else { | ||||
|                 JanetTable *table = (JanetTable *) current; | ||||
|                 int check_values = (type == JANET_MEMORY_TABLE_WEAKV) || (type == JANET_MEMORY_TABLE_WEAKKV); | ||||
|                 int check_keys = (type == JANET_MEMORY_TABLE_WEAKK) || (type == JANET_MEMORY_TABLE_WEAKKV); | ||||
|                 JanetKV *end = table->data + table->capacity; | ||||
|                 JanetKV *kvs = table->data; | ||||
|                 while (kvs < end) { | ||||
|                     int drop = 0; | ||||
|                     if (check_keys && !janet_check_liveref(kvs->key)) drop = 1; | ||||
|                     if (check_values && !janet_check_liveref(kvs->value)) drop = 1; | ||||
|                     if (drop) { | ||||
|                         /* Inlined from janet_table_remove without search */ | ||||
|                         table->count--; | ||||
|                         table->deleted++; | ||||
|                         kvs->key = janet_wrap_nil(); | ||||
|                         kvs->value = janet_wrap_false(); | ||||
|                     } | ||||
|                     kvs++; | ||||
|                 } | ||||
|             } | ||||
|         } | ||||
|         current = next; | ||||
|     } | ||||
|  | ||||
|     /* Sweep weak heap to free blocks */ | ||||
|     previous = NULL; | ||||
|     current = janet_vm.weak_blocks; | ||||
|     while (NULL != current) { | ||||
|         next = current->data.next; | ||||
|         if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) { | ||||
|             previous = current; | ||||
|             current->flags &= ~JANET_MEM_REACHABLE; | ||||
|         } else { | ||||
|             janet_vm.block_count--; | ||||
|             janet_deinit_block(current); | ||||
|             if (NULL != previous) { | ||||
|                 previous->data.next = next; | ||||
|             } else { | ||||
|                 janet_vm.weak_blocks = next; | ||||
|             } | ||||
|             janet_free(current); | ||||
|         } | ||||
|         current = next; | ||||
|     } | ||||
|  | ||||
|     /* Sweep main heap to free blocks */ | ||||
|     previous = NULL; | ||||
|     current = janet_vm.blocks; | ||||
|     while (NULL != current) { | ||||
|         next = current->data.next; | ||||
|         if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) { | ||||
| @@ -349,6 +477,7 @@ void janet_sweep() { | ||||
|         } | ||||
|         current = next; | ||||
|     } | ||||
|  | ||||
| #ifdef JANET_EV | ||||
|     /* Sweep threaded abstract types for references to decrement */ | ||||
|     JanetKV *items = janet_vm.threaded_abstracts.data; | ||||
| @@ -370,14 +499,15 @@ void janet_sweep() { | ||||
|                     if (head->type->gc) { | ||||
|                         janet_assert(!head->type->gc(head->data, head->size), "finalizer failed"); | ||||
|                     } | ||||
|                     /* Mark as tombstone in place */ | ||||
|                     items[i].key = janet_wrap_nil(); | ||||
|                     items[i].value = janet_wrap_false(); | ||||
|                     janet_vm.threaded_abstracts.deleted++; | ||||
|                     janet_vm.threaded_abstracts.count--; | ||||
|                     /* Free memory */ | ||||
|                     janet_free(janet_abstract_head(abst)); | ||||
|                 } | ||||
|  | ||||
|                 /* Mark as tombstone in place */ | ||||
|                 items[i].key = janet_wrap_nil(); | ||||
|                 items[i].value = janet_wrap_false(); | ||||
|                 janet_vm.threaded_abstracts.deleted++; | ||||
|                 janet_vm.threaded_abstracts.count--; | ||||
|             } | ||||
|  | ||||
|             /* Reset for next sweep */ | ||||
| @@ -405,8 +535,15 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) { | ||||
|  | ||||
|     /* Prepend block to heap list */ | ||||
|     janet_vm.next_collection += size; | ||||
|     mem->data.next = janet_vm.blocks; | ||||
|     janet_vm.blocks = mem; | ||||
|     if (type < JANET_MEMORY_TABLE_WEAKK) { | ||||
|         /* normal heap */ | ||||
|         mem->data.next = janet_vm.blocks; | ||||
|         janet_vm.blocks = mem; | ||||
|     } else { | ||||
|         /* weak heap */ | ||||
|         mem->data.next = janet_vm.weak_blocks; | ||||
|         janet_vm.weak_blocks = mem; | ||||
|     } | ||||
|     janet_vm.block_count++; | ||||
|  | ||||
|     return (void *)mem; | ||||
| @@ -437,7 +574,8 @@ void janet_collect(void) { | ||||
|     uint32_t i; | ||||
|     if (janet_vm.gc_suspend) return; | ||||
|     depth = JANET_RECURSION_GUARD; | ||||
|     /* Try and prevent many major collections back to back. | ||||
|     janet_vm.gc_mark_phase = 1; | ||||
|     /* Try to prevent many major collections back to back. | ||||
|      * A full collection will take O(janet_vm.block_count) time. | ||||
|      * If we have a large heap, make sure our interval is not too | ||||
|      * small so we won't make many collections over it. This is just a | ||||
| @@ -456,6 +594,7 @@ void janet_collect(void) { | ||||
|         Janet x = janet_vm.roots[--janet_vm.root_count]; | ||||
|         janet_mark(x); | ||||
|     } | ||||
|     janet_vm.gc_mark_phase = 0; | ||||
|     janet_sweep(); | ||||
|     janet_vm.next_collection = 0; | ||||
|     janet_free_all_scratch(); | ||||
| @@ -559,7 +698,9 @@ void janet_gcunlock(int handle) { | ||||
|     janet_vm.gc_suspend = handle; | ||||
| } | ||||
|  | ||||
| /* Scratch memory API */ | ||||
| /* Scratch memory API | ||||
|  * Scratch memory allocations do not need to be free (but optionally can be), and will be automatically cleaned | ||||
|  * up in the next call to janet_collect. */ | ||||
|  | ||||
| void *janet_smalloc(size_t size) { | ||||
|     JanetScratch *s = janet_malloc(sizeof(JanetScratch) + size); | ||||
|   | ||||
| @@ -57,6 +57,10 @@ enum JanetMemoryType { | ||||
|     JANET_MEMORY_FUNCENV, | ||||
|     JANET_MEMORY_FUNCDEF, | ||||
|     JANET_MEMORY_THREADED_ABSTRACT, | ||||
|     JANET_MEMORY_TABLE_WEAKK, | ||||
|     JANET_MEMORY_TABLE_WEAKV, | ||||
|     JANET_MEMORY_TABLE_WEAKKV, | ||||
|     JANET_MEMORY_ARRAY_WEAK | ||||
| }; | ||||
|  | ||||
| /* To allocate collectable memory, one must call janet_alloc, initialize the memory, | ||||
|   | ||||
| @@ -73,13 +73,13 @@ static void *int64_unmarshal(JanetMarshalContext *ctx) { | ||||
|  | ||||
| static void it_s64_tostring(void *p, JanetBuffer *buffer) { | ||||
|     char str[32]; | ||||
|     sprintf(str, "%" PRId64, *((int64_t *)p)); | ||||
|     snprintf(str, sizeof(str), "%" PRId64, *((int64_t *)p)); | ||||
|     janet_buffer_push_cstring(buffer, str); | ||||
| } | ||||
|  | ||||
| static void it_u64_tostring(void *p, JanetBuffer *buffer) { | ||||
|     char str[32]; | ||||
|     sprintf(str, "%" PRIu64, *((uint64_t *)p)); | ||||
|     snprintf(str, sizeof(str), "%" PRIu64, *((uint64_t *)p)); | ||||
|     janet_buffer_push_cstring(buffer, str); | ||||
| } | ||||
|  | ||||
| @@ -118,10 +118,9 @@ int64_t janet_unwrap_s64(Janet x) { | ||||
|         default: | ||||
|             break; | ||||
|         case JANET_NUMBER : { | ||||
|             double dbl = janet_unwrap_number(x); | ||||
|             if (fabs(dbl) <=  MAX_INT_IN_DBL) | ||||
|                 return (int64_t)dbl; | ||||
|             break; | ||||
|             double d = janet_unwrap_number(x); | ||||
|             if (!janet_checkint64range(d)) break; | ||||
|             return (int64_t) d; | ||||
|         } | ||||
|         case JANET_STRING: { | ||||
|             int64_t value; | ||||
| @@ -147,12 +146,9 @@ uint64_t janet_unwrap_u64(Janet x) { | ||||
|         default: | ||||
|             break; | ||||
|         case JANET_NUMBER : { | ||||
|             double dbl = janet_unwrap_number(x); | ||||
|             /* Allow negative values to be cast to "wrap around". | ||||
|              * This let's addition and subtraction work as expected. */ | ||||
|             if (fabs(dbl) <=  MAX_INT_IN_DBL) | ||||
|                 return (uint64_t)dbl; | ||||
|             break; | ||||
|             double d = janet_unwrap_number(x); | ||||
|             if (!janet_checkuint64range(d)) break; | ||||
|             return (uint64_t) d; | ||||
|         } | ||||
|         case JANET_STRING: { | ||||
|             uint64_t value; | ||||
| @@ -243,7 +239,7 @@ JANET_CORE_FN(cfun_to_bytes, | ||||
|               "Write the bytes of an `int/s64` or `int/u64` into a buffer.\n" | ||||
|               "The `buffer` parameter specifies an existing buffer to write to, if unset a new buffer will be created.\n" | ||||
|               "Returns the modified buffer.\n" | ||||
|               "The `endianness` paramater indicates the byte order:\n" | ||||
|               "The `endianness` parameter indicates the byte order:\n" | ||||
|               "- `nil` (unset): system byte order\n" | ||||
|               "- `:le`: little-endian, least significant byte first\n" | ||||
|               "- `:be`: big-endian, most significant byte first\n") { | ||||
| @@ -307,8 +303,8 @@ static int compare_double_double(double x, double y) { | ||||
|  | ||||
| static int compare_int64_double(int64_t x, double y) { | ||||
|     if (isnan(y)) { | ||||
|         return 0; // clojure and python do this | ||||
|     } else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) { | ||||
|         return 0; | ||||
|     } else if ((y > JANET_INTMIN_DOUBLE) && (y < JANET_INTMAX_DOUBLE)) { | ||||
|         double dx = (double) x; | ||||
|         return compare_double_double(dx, y); | ||||
|     } else if (y > ((double) INT64_MAX)) { | ||||
| @@ -323,10 +319,10 @@ static int compare_int64_double(int64_t x, double y) { | ||||
|  | ||||
| static int compare_uint64_double(uint64_t x, double y) { | ||||
|     if (isnan(y)) { | ||||
|         return 0; // clojure and python do this | ||||
|         return 0; | ||||
|     } else if (y < 0) { | ||||
|         return 1; | ||||
|     } else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) { | ||||
|     } else if ((y >= 0) && (y < JANET_INTMAX_DOUBLE)) { | ||||
|         double dx = (double) x; | ||||
|         return compare_double_double(dx, y); | ||||
|     } else if (y > ((double) UINT64_MAX)) { | ||||
| @@ -339,8 +335,9 @@ static int compare_uint64_double(uint64_t x, double y) { | ||||
|  | ||||
| static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 2); | ||||
|     if (janet_is_int(argv[0]) != JANET_INT_S64) | ||||
|     if (janet_is_int(argv[0]) != JANET_INT_S64) { | ||||
|         janet_panic("compare method requires int/s64 as first argument"); | ||||
|     } | ||||
|     int64_t x = janet_unwrap_s64(argv[0]); | ||||
|     switch (janet_type(argv[1])) { | ||||
|         default: | ||||
| @@ -355,7 +352,6 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) { | ||||
|                 int64_t y = *(int64_t *)abst; | ||||
|                 return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0)); | ||||
|             } else if (janet_abstract_type(abst) == &janet_u64_type) { | ||||
|                 // comparing signed to unsigned -- be careful! | ||||
|                 uint64_t y = *(uint64_t *)abst; | ||||
|                 if (x < 0) { | ||||
|                     return janet_wrap_number(-1); | ||||
| @@ -374,8 +370,9 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) { | ||||
|  | ||||
| static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 2); | ||||
|     if (janet_is_int(argv[0]) != JANET_INT_U64)  // is this needed? | ||||
|     if (janet_is_int(argv[0]) != JANET_INT_U64) { | ||||
|         janet_panic("compare method requires int/u64 as first argument"); | ||||
|     } | ||||
|     uint64_t x = janet_unwrap_u64(argv[0]); | ||||
|     switch (janet_type(argv[1])) { | ||||
|         default: | ||||
| @@ -390,7 +387,6 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) { | ||||
|                 uint64_t y = *(uint64_t *)abst; | ||||
|                 return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0)); | ||||
|             } else if (janet_abstract_type(abst) == &janet_s64_type) { | ||||
|                 // comparing unsigned to signed -- be careful! | ||||
|                 int64_t y = *(int64_t *)abst; | ||||
|                 if (y < 0) { | ||||
|                     return janet_wrap_number(1); | ||||
| @@ -431,7 +427,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ | ||||
| } \ | ||||
|  | ||||
| #define OPMETHODINVERT(T, type, name, oper) \ | ||||
| static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ | ||||
| static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \ | ||||
|     janet_fixarity(argc, 2); \ | ||||
|     T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ | ||||
|     *box = janet_unwrap_##type(argv[1]); \ | ||||
| @@ -440,6 +436,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ | ||||
|     return janet_wrap_abstract(box); \ | ||||
| } \ | ||||
|  | ||||
| #define UNARYMETHOD(T, type, name, oper) \ | ||||
| static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ | ||||
|     janet_fixarity(argc, 1); \ | ||||
|     T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ | ||||
|     *box = oper(janet_unwrap_##type(argv[0])); \ | ||||
|     return janet_wrap_abstract(box); \ | ||||
| } \ | ||||
|  | ||||
| #define DIVZERO(name) DIVZERO_##name | ||||
| #define DIVZERO_div janet_panic("division by zero") | ||||
| #define DIVZERO_rem janet_panic("division by zero") | ||||
| #define DIVZERO_mod return janet_wrap_abstract(box) | ||||
|  | ||||
| #define DIVMETHOD(T, type, name, oper) \ | ||||
| static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ | ||||
|     janet_arity(argc, 2, -1);                       \ | ||||
| @@ -447,19 +456,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ | ||||
|     *box = janet_unwrap_##type(argv[0]); \ | ||||
|     for (int32_t i = 1; i < argc; i++) { \ | ||||
|       T value = janet_unwrap_##type(argv[i]); \ | ||||
|       if (value == 0) janet_panic("division by zero"); \ | ||||
|       if (value == 0) DIVZERO(name); \ | ||||
|       *box oper##= value; \ | ||||
|     } \ | ||||
|     return janet_wrap_abstract(box); \ | ||||
| } \ | ||||
|  | ||||
| #define DIVMETHODINVERT(T, type, name, oper) \ | ||||
| static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ | ||||
| static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \ | ||||
|     janet_fixarity(argc, 2);                       \ | ||||
|     T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ | ||||
|     *box = janet_unwrap_##type(argv[1]); \ | ||||
|     T value = janet_unwrap_##type(argv[0]); \ | ||||
|     if (value == 0) janet_panic("division by zero"); \ | ||||
|     if (value == 0) DIVZERO(name); \ | ||||
|     *box oper##= value; \ | ||||
|     return janet_wrap_abstract(box); \ | ||||
| } \ | ||||
| @@ -471,7 +480,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ | ||||
|     *box = janet_unwrap_##type(argv[0]); \ | ||||
|     for (int32_t i = 1; i < argc; i++) { \ | ||||
|       T value = janet_unwrap_##type(argv[i]); \ | ||||
|       if (value == 0) janet_panic("division by zero"); \ | ||||
|       if (value == 0) DIVZERO(name); \ | ||||
|       if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \ | ||||
|       *box oper##= value; \ | ||||
|     } \ | ||||
| @@ -479,26 +488,50 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ | ||||
| } \ | ||||
|  | ||||
| #define DIVMETHODINVERT_SIGNED(T, type, name, oper) \ | ||||
| static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ | ||||
| static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \ | ||||
|     janet_fixarity(argc, 2);                       \ | ||||
|     T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ | ||||
|     *box = janet_unwrap_##type(argv[1]); \ | ||||
|     T value = janet_unwrap_##type(argv[0]); \ | ||||
|     if (value == 0) janet_panic("division by zero"); \ | ||||
|     if (value == 0) DIVZERO(name); \ | ||||
|     if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \ | ||||
|     *box oper##= value; \ | ||||
|     return janet_wrap_abstract(box); \ | ||||
| } \ | ||||
|  | ||||
| static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 2); | ||||
|     int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); | ||||
|     int64_t op1 = janet_unwrap_s64(argv[0]); | ||||
|     int64_t op2 = janet_unwrap_s64(argv[1]); | ||||
|     if (op2 == 0) janet_panic("division by zero"); | ||||
|     int64_t x = op1 / op2; | ||||
|     *box = x - (((op1 ^ op2) < 0) && (x * op2 != op1)); | ||||
|     return janet_wrap_abstract(box); | ||||
| } | ||||
|  | ||||
| static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 2); | ||||
|     int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); | ||||
|     int64_t op2 = janet_unwrap_s64(argv[0]); | ||||
|     int64_t op1 = janet_unwrap_s64(argv[1]); | ||||
|     if (op2 == 0) janet_panic("division by zero"); | ||||
|     int64_t x = op1 / op2; | ||||
|     *box = x - (((op1 ^ op2) < 0) && (x * op2 != op1)); | ||||
|     return janet_wrap_abstract(box); | ||||
| } | ||||
|  | ||||
| static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 2); | ||||
|     int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); | ||||
|     int64_t op1 = janet_unwrap_s64(argv[0]); | ||||
|     int64_t op2 = janet_unwrap_s64(argv[1]); | ||||
|     int64_t x = op1 % op2; | ||||
|     *box = (op1 > 0) | ||||
|            ? ((op2 > 0) ? x : (0 == x ? x : x + op2)) | ||||
|            : ((op2 > 0) ? (0 == x ? x : x + op2) : x); | ||||
|     if (op2 == 0) { | ||||
|         *box = op1; | ||||
|     } else { | ||||
|         int64_t x = op1 % op2; | ||||
|         *box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x; | ||||
|     } | ||||
|     return janet_wrap_abstract(box); | ||||
| } | ||||
|  | ||||
| @@ -507,37 +540,43 @@ static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) { | ||||
|     int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); | ||||
|     int64_t op2 = janet_unwrap_s64(argv[0]); | ||||
|     int64_t op1 = janet_unwrap_s64(argv[1]); | ||||
|     int64_t x = op1 % op2; | ||||
|     *box = (op1 > 0) | ||||
|            ? ((op2 > 0) ? x : (0 == x ? x : x + op2)) | ||||
|            : ((op2 > 0) ? (0 == x ? x : x + op2) : x); | ||||
|     if (op2 == 0) { | ||||
|         *box = op1; | ||||
|     } else { | ||||
|         int64_t x = op1 % op2; | ||||
|         *box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x; | ||||
|     } | ||||
|     return janet_wrap_abstract(box); | ||||
| } | ||||
|  | ||||
| OPMETHOD(int64_t, s64, add, +) | ||||
| OPMETHOD(int64_t, s64, sub, -) | ||||
| OPMETHODINVERT(int64_t, s64, subi, -) | ||||
| OPMETHODINVERT(int64_t, s64, sub, -) | ||||
| OPMETHOD(int64_t, s64, mul, *) | ||||
| DIVMETHOD_SIGNED(int64_t, s64, div, /) | ||||
| DIVMETHOD_SIGNED(int64_t, s64, rem, %) | ||||
| DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /) | ||||
| DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %) | ||||
| DIVMETHODINVERT_SIGNED(int64_t, s64, div, /) | ||||
| DIVMETHODINVERT_SIGNED(int64_t, s64, rem, %) | ||||
| OPMETHOD(int64_t, s64, and, &) | ||||
| OPMETHOD(int64_t, s64, or, |) | ||||
| OPMETHOD(int64_t, s64, xor, ^) | ||||
| UNARYMETHOD(int64_t, s64, not, ~) | ||||
| OPMETHOD(int64_t, s64, lshift, <<) | ||||
| OPMETHOD(int64_t, s64, rshift, >>) | ||||
| OPMETHOD(uint64_t, u64, add, +) | ||||
| OPMETHOD(uint64_t, u64, sub, -) | ||||
| OPMETHODINVERT(uint64_t, u64, subi, -) | ||||
| OPMETHODINVERT(uint64_t, u64, sub, -) | ||||
| OPMETHOD(uint64_t, u64, mul, *) | ||||
| DIVMETHOD(uint64_t, u64, div, /) | ||||
| DIVMETHOD(uint64_t, u64, rem, %) | ||||
| DIVMETHOD(uint64_t, u64, mod, %) | ||||
| DIVMETHODINVERT(uint64_t, u64, divi, /) | ||||
| DIVMETHODINVERT(uint64_t, u64, modi, %) | ||||
| DIVMETHODINVERT(uint64_t, u64, div, /) | ||||
| DIVMETHODINVERT(uint64_t, u64, rem, %) | ||||
| DIVMETHODINVERT(uint64_t, u64, mod, %) | ||||
| OPMETHOD(uint64_t, u64, and, &) | ||||
| OPMETHOD(uint64_t, u64, or, |) | ||||
| OPMETHOD(uint64_t, u64, xor, ^) | ||||
| UNARYMETHOD(uint64_t, u64, not, ~) | ||||
| OPMETHOD(uint64_t, u64, lshift, <<) | ||||
| OPMETHOD(uint64_t, u64, rshift, >>) | ||||
|  | ||||
| @@ -555,6 +594,8 @@ static JanetMethod it_s64_methods[] = { | ||||
|     {"r*", cfun_it_s64_mul}, | ||||
|     {"/", cfun_it_s64_div}, | ||||
|     {"r/", cfun_it_s64_divi}, | ||||
|     {"div", cfun_it_s64_divf}, | ||||
|     {"rdiv", cfun_it_s64_divfi}, | ||||
|     {"mod", cfun_it_s64_mod}, | ||||
|     {"rmod", cfun_it_s64_modi}, | ||||
|     {"%", cfun_it_s64_rem}, | ||||
| @@ -565,6 +606,7 @@ static JanetMethod it_s64_methods[] = { | ||||
|     {"r|", cfun_it_s64_or}, | ||||
|     {"^", cfun_it_s64_xor}, | ||||
|     {"r^", cfun_it_s64_xor}, | ||||
|     {"~", cfun_it_s64_not}, | ||||
|     {"<<", cfun_it_s64_lshift}, | ||||
|     {">>", cfun_it_s64_rshift}, | ||||
|     {"compare", cfun_it_s64_compare}, | ||||
| @@ -580,16 +622,19 @@ static JanetMethod it_u64_methods[] = { | ||||
|     {"r*", cfun_it_u64_mul}, | ||||
|     {"/", cfun_it_u64_div}, | ||||
|     {"r/", cfun_it_u64_divi}, | ||||
|     {"div", cfun_it_u64_div}, | ||||
|     {"rdiv", cfun_it_u64_divi}, | ||||
|     {"mod", cfun_it_u64_mod}, | ||||
|     {"rmod", cfun_it_u64_modi}, | ||||
|     {"%", cfun_it_u64_mod}, | ||||
|     {"r%", cfun_it_u64_modi}, | ||||
|     {"%", cfun_it_u64_rem}, | ||||
|     {"r%", cfun_it_u64_remi}, | ||||
|     {"&", cfun_it_u64_and}, | ||||
|     {"r&", cfun_it_u64_and}, | ||||
|     {"|", cfun_it_u64_or}, | ||||
|     {"r|", cfun_it_u64_or}, | ||||
|     {"^", cfun_it_u64_xor}, | ||||
|     {"r^", cfun_it_u64_xor}, | ||||
|     {"~", cfun_it_u64_not}, | ||||
|     {"<<", cfun_it_u64_lshift}, | ||||
|     {">>", cfun_it_u64_rshift}, | ||||
|     {"compare", cfun_it_u64_compare}, | ||||
|   | ||||
| @@ -41,6 +41,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,12 +131,12 @@ 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); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_io_fopen, | ||||
|               "(file/open path &opt mode)", | ||||
|               "(file/open path &opt mode buffer-size)", | ||||
|               "Open a file. `path` is an absolute or relative path, and " | ||||
|               "`mode` is a set of flags indicating the mode to open the file in. " | ||||
|               "`mode` is a keyword where each character represents a flag. If the file " | ||||
| @@ -143,8 +148,9 @@ JANET_CORE_FN(cfun_io_fopen, | ||||
|               "Following one of the initial flags, 0 or more of the following flags can be appended:\n\n" | ||||
|               "* b - open the file in binary mode (rather than text mode)\n\n" | ||||
|               "* + - append to the file instead of overwriting it\n\n" | ||||
|               "* n - error if the file cannot be opened instead of returning nil") { | ||||
|     janet_arity(argc, 1, 2); | ||||
|               "* n - error if the file cannot be opened instead of returning nil\n\n" | ||||
|               "See fopen (<stdio.h>, C99) for further details.") { | ||||
|     janet_arity(argc, 1, 3); | ||||
|     const uint8_t *fname = janet_getstring(argv, 0); | ||||
|     const uint8_t *fmode; | ||||
|     int32_t flags; | ||||
| @@ -157,8 +163,17 @@ JANET_CORE_FN(cfun_io_fopen, | ||||
|         flags = JANET_FILE_READ; | ||||
|     } | ||||
|     FILE *f = fopen((const char *)fname, (const char *)fmode); | ||||
|     if (f != NULL) { | ||||
|         size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ); | ||||
|         if (bufsize != BUFSIZ) { | ||||
|             int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize); | ||||
|             if (result) { | ||||
|                 janet_panic("failed to set buffer size for file"); | ||||
|             } | ||||
|         } | ||||
|     } | ||||
|     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(); | ||||
| } | ||||
|  | ||||
| @@ -327,7 +342,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); | ||||
| @@ -341,7 +356,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"); | ||||
| @@ -355,7 +370,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); | ||||
| } | ||||
|   | ||||
							
								
								
									
										135
									
								
								src/core/marsh.c
									
									
									
									
									
								
							
							
						
						
									
										135
									
								
								src/core/marsh.c
									
									
									
									
									
								
							| @@ -154,7 +154,7 @@ static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) { | ||||
|     janet_buffer_push_bytes(st->buf, bytes, len); | ||||
| } | ||||
|  | ||||
| static void pushpointer(MarshalState *st, void *ptr) { | ||||
| static void pushpointer(MarshalState *st, const void *ptr) { | ||||
|     janet_buffer_push_bytes(st->buf, (const uint8_t *) &ptr, sizeof(ptr)); | ||||
| } | ||||
|  | ||||
| @@ -185,6 +185,19 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags); | ||||
| /* Prevent stack overflows */ | ||||
| #define MARSH_STACKCHECK if ((flags & 0xFFFF) > JANET_RECURSION_GUARD) janet_panic("stack overflow") | ||||
|  | ||||
| /* Quick check if a fiber cannot be marshalled. This is will | ||||
|  * have no false positives, but may have false negatives. */ | ||||
| static int fiber_cannot_be_marshalled(JanetFiber *fiber) { | ||||
|     if (janet_fiber_status(fiber) == JANET_STATUS_ALIVE) return 1; | ||||
|     int32_t i = fiber->frame; | ||||
|     while (i > 0) { | ||||
|         JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE); | ||||
|         if (!frame->func) return 1; /* has cfunction on stack */ | ||||
|         i = frame->prevframe; | ||||
|     } | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| /* Marshal a function env */ | ||||
| static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) { | ||||
|     MARSH_STACKCHECK; | ||||
| @@ -197,7 +210,9 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) { | ||||
|     } | ||||
|     janet_env_valid(env); | ||||
|     janet_v_push(st->seen_envs, env); | ||||
|     if (env->offset > 0 && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) { | ||||
|  | ||||
|     /* Special case for early detachment */ | ||||
|     if (env->offset > 0 && fiber_cannot_be_marshalled(env->as.fiber)) { | ||||
|         pushint(st, 0); | ||||
|         pushint(st, env->length); | ||||
|         Janet *values = env->as.fiber->data + env->offset; | ||||
| @@ -246,6 +261,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) { | ||||
|     } | ||||
|     /* Add to lookup */ | ||||
|     janet_v_push(st->seen_defs, def); | ||||
|  | ||||
|     pushint(st, def->flags); | ||||
|     pushint(st, def->slotcount); | ||||
|     pushint(st, def->arity); | ||||
| @@ -266,14 +282,14 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) { | ||||
|  | ||||
|     /* marshal constants */ | ||||
|     for (int32_t i = 0; i < def->constants_length; i++) | ||||
|         marshal_one(st, def->constants[i], flags); | ||||
|         marshal_one(st, def->constants[i], flags + 1); | ||||
|  | ||||
|     /* Marshal symbol map, if needed */ | ||||
|     for (int32_t i = 0; i < def->symbolmap_length; i++) { | ||||
|         pushint(st, (int32_t) def->symbolmap[i].birth_pc); | ||||
|         pushint(st, (int32_t) def->symbolmap[i].death_pc); | ||||
|         pushint(st, (int32_t) def->symbolmap[i].slot_index); | ||||
|         marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags); | ||||
|         marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags + 1); | ||||
|     } | ||||
|  | ||||
|     /* marshal the bytecode */ | ||||
| @@ -327,7 +343,7 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) { | ||||
|     while (i > 0) { | ||||
|         JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE); | ||||
|         if (frame->env) frame->flags |= JANET_STACKFRAME_HASENV; | ||||
|         if (!frame->func) janet_panic("cannot marshal fiber with c stackframe"); | ||||
|         if (!frame->func) janet_panicf("cannot marshal fiber with c stackframe (%v)", janet_wrap_cfunction((JanetCFunction) frame->pc)); | ||||
|         pushint(st, frame->flags); | ||||
|         pushint(st, frame->prevframe); | ||||
|         int32_t pcdiff = (int32_t)(frame->pc - frame->func->def->bytecode); | ||||
| @@ -362,6 +378,15 @@ void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) { | ||||
|     pushint(st, value); | ||||
| } | ||||
|  | ||||
| /* Only use in unsafe - don't marshal pointers otherwise */ | ||||
| void janet_marshal_ptr(JanetMarshalContext *ctx, const void *ptr) { | ||||
|     if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) { | ||||
|         janet_panic("can only marshal pointers in unsafe mode"); | ||||
|     } | ||||
|     MarshalState *st = (MarshalState *)(ctx->m_state); | ||||
|     pushpointer(st, ptr); | ||||
| } | ||||
|  | ||||
| void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) { | ||||
|     MarshalState *st = (MarshalState *)(ctx->m_state); | ||||
|     pushbyte(st, value); | ||||
| @@ -378,18 +403,27 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) { | ||||
|     marshal_one(st, x, ctx->flags + 1); | ||||
| } | ||||
|  | ||||
| #ifdef JANET_MARSHAL_DEBUG | ||||
| #define MARK_SEEN() \ | ||||
|     do { if (st->maybe_cycles) { \ | ||||
|         Janet _check = janet_table_get(&st->seen, x); \ | ||||
|         if (!janet_checktype(_check, JANET_NIL)) janet_eprintf("double MARK_SEEN on %v\n", x); \ | ||||
|         janet_eprintf("made reference %d (%t) to %v\n", st->nextid, x, x); \ | ||||
|         janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \ | ||||
|     } } while (0) | ||||
| #else | ||||
| #define MARK_SEEN() \ | ||||
|     do { if (st->maybe_cycles) { \ | ||||
|         janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \ | ||||
|     } } while (0) | ||||
| #endif | ||||
|  | ||||
| void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) { | ||||
|     MarshalState *st = (MarshalState *)(ctx->m_state); | ||||
|     if (st->maybe_cycles) { | ||||
|         janet_table_put(&st->seen, | ||||
|                         janet_wrap_abstract(abstract), | ||||
|                         janet_wrap_integer(st->nextid++)); | ||||
|     } | ||||
|     Janet x = janet_wrap_abstract(abstract); | ||||
|     MARK_SEEN(); | ||||
| } | ||||
|  | ||||
| #define MARK_SEEN() \ | ||||
|     do { if (st->maybe_cycles) janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); } while (0) | ||||
|  | ||||
| static void marshal_one_abstract(MarshalState *st, Janet x, int flags) { | ||||
|     void *abstract = janet_unwrap_abstract(x); | ||||
| #ifdef JANET_EV | ||||
| @@ -411,7 +445,7 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) { | ||||
|     if (at->marshal) { | ||||
|         pushbyte(st, LB_ABSTRACT); | ||||
|         marshal_one(st, janet_csymbolv(at->name), flags + 1); | ||||
|         JanetMarshalContext context = {st, NULL, flags, NULL, at}; | ||||
|         JanetMarshalContext context = {st, NULL, flags + 1, NULL, at}; | ||||
|         at->marshal(abstract, &context); | ||||
|     } else { | ||||
|         janet_panicf("cannot marshal %p", x); | ||||
| @@ -728,9 +762,22 @@ static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) { | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| #ifdef JANET_MARSHAL_DEBUG | ||||
| static void dump_reference_table(UnmarshalState *st) { | ||||
|     for (int32_t i = 0; i < janet_v_count(st->lookup); i++) { | ||||
|         janet_eprintf("  reference %d (%t) = %v\n", i, st->lookup[i], st->lookup[i]); | ||||
|     } | ||||
| } | ||||
| #endif | ||||
|  | ||||
| /* Assert a janet type */ | ||||
| static void janet_asserttype(Janet x, JanetType t) { | ||||
| static void janet_asserttype(Janet x, JanetType t, UnmarshalState *st) { | ||||
|     if (!janet_checktype(x, t)) { | ||||
| #ifdef JANET_MARSHAL_DEBUG | ||||
|         dump_reference_table(st); | ||||
| #else | ||||
|         (void) st; | ||||
| #endif | ||||
|         janet_panicf("expected type %T, got %v", 1 << t, x); | ||||
|     } | ||||
| } | ||||
| @@ -782,7 +829,7 @@ static const uint8_t *unmarshal_one_env( | ||||
|             Janet fiberv; | ||||
|             /* On stack variant */ | ||||
|             data = unmarshal_one(st, data, &fiberv, flags); | ||||
|             janet_asserttype(fiberv, JANET_FIBER); | ||||
|             janet_asserttype(fiberv, JANET_FIBER, st); | ||||
|             env->as.fiber = janet_unwrap_fiber(fiberv); | ||||
|             /* Negative offset indicates untrusted input */ | ||||
|             env->offset = -offset; | ||||
| @@ -880,13 +927,13 @@ static const uint8_t *unmarshal_one_def( | ||||
|         if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) { | ||||
|             Janet x; | ||||
|             data = unmarshal_one(st, data, &x, flags + 1); | ||||
|             janet_asserttype(x, JANET_STRING); | ||||
|             janet_asserttype(x, JANET_STRING, st); | ||||
|             def->name = janet_unwrap_string(x); | ||||
|         } | ||||
|         if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE) { | ||||
|             Janet x; | ||||
|             data = unmarshal_one(st, data, &x, flags + 1); | ||||
|             janet_asserttype(x, JANET_STRING); | ||||
|             janet_asserttype(x, JANET_STRING, st); | ||||
|             def->source = janet_unwrap_string(x); | ||||
|         } | ||||
|  | ||||
| @@ -916,8 +963,9 @@ static const uint8_t *unmarshal_one_def( | ||||
|                 def->symbolmap[i].slot_index = (uint32_t) readint(st, &data); | ||||
|                 Janet value; | ||||
|                 data = unmarshal_one(st, data, &value, flags + 1); | ||||
|                 if (!janet_checktype(value, JANET_SYMBOL)) | ||||
|                     janet_panic("expected symbol in symbol map"); | ||||
|                 if (!janet_checktype(value, JANET_SYMBOL)) { | ||||
|                     janet_panicf("corrupted symbolmap when unmarshalling debug info, got %v", value); | ||||
|                 } | ||||
|                 def->symbolmap[i].symbol = janet_unwrap_symbol(value); | ||||
|             } | ||||
|             def->symbolmap_length = (uint32_t) symbolmap_length; | ||||
| @@ -1015,9 +1063,11 @@ static const uint8_t *unmarshal_one_fiber( | ||||
|     fiber->env = NULL; | ||||
|     fiber->last_value = janet_wrap_nil(); | ||||
| #ifdef JANET_EV | ||||
|     fiber->waiting = NULL; | ||||
|     fiber->sched_id = 0; | ||||
|     fiber->supervisor_channel = NULL; | ||||
|     fiber->ev_state = NULL; | ||||
|     fiber->ev_callback = NULL; | ||||
|     fiber->ev_stream = NULL; | ||||
| #endif | ||||
|  | ||||
|     /* Push fiber to seen stack */ | ||||
| @@ -1066,7 +1116,7 @@ static const uint8_t *unmarshal_one_fiber( | ||||
|         /* Get function */ | ||||
|         Janet funcv; | ||||
|         data = unmarshal_one(st, data, &funcv, flags + 1); | ||||
|         janet_asserttype(funcv, JANET_FUNCTION); | ||||
|         janet_asserttype(funcv, JANET_FUNCTION, st); | ||||
|         func = janet_unwrap_function(funcv); | ||||
|         def = func->def; | ||||
|  | ||||
| @@ -1112,7 +1162,7 @@ static const uint8_t *unmarshal_one_fiber( | ||||
|         Janet envv; | ||||
|         fiber_flags &= ~JANET_FIBER_FLAG_HASENV; | ||||
|         data = unmarshal_one(st, data, &envv, flags + 1); | ||||
|         janet_asserttype(envv, JANET_TABLE); | ||||
|         janet_asserttype(envv, JANET_TABLE, st); | ||||
|         fiber_env = janet_unwrap_table(envv); | ||||
|     } | ||||
|  | ||||
| @@ -1121,7 +1171,7 @@ static const uint8_t *unmarshal_one_fiber( | ||||
|         Janet fiberv; | ||||
|         fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD; | ||||
|         data = unmarshal_one(st, data, &fiberv, flags + 1); | ||||
|         janet_asserttype(fiberv, JANET_FIBER); | ||||
|         janet_asserttype(fiberv, JANET_FIBER, st); | ||||
|         fiber->child = janet_unwrap_fiber(fiberv); | ||||
|     } | ||||
|  | ||||
| @@ -1165,6 +1215,18 @@ int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) { | ||||
|     return read64(st, &(ctx->data)); | ||||
| } | ||||
|  | ||||
| void *janet_unmarshal_ptr(JanetMarshalContext *ctx) { | ||||
|     if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) { | ||||
|         janet_panic("can only unmarshal pointers in unsafe mode"); | ||||
|     } | ||||
|     UnmarshalState *st = (UnmarshalState *)(ctx->u_state); | ||||
|     void *ptr; | ||||
|     MARSH_EOS(st, ctx->data + sizeof(void *) - 1); | ||||
|     memcpy((char *) &ptr, ctx->data, sizeof(void *)); | ||||
|     ctx->data += sizeof(void *); | ||||
|     return ptr; | ||||
| } | ||||
|  | ||||
| uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) { | ||||
|     UnmarshalState *st = (UnmarshalState *)(ctx->u_state); | ||||
|     MARSH_EOS(st, ctx->data); | ||||
| @@ -1200,6 +1262,18 @@ void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) { | ||||
|     return p; | ||||
| } | ||||
|  | ||||
| void *janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size) { | ||||
| #ifdef JANET_THREADS | ||||
|     void *p = janet_abstract_threaded(ctx->at, size); | ||||
|     janet_unmarshal_abstract_reuse(ctx, p); | ||||
|     return p; | ||||
| #else | ||||
|     (void) ctx; | ||||
|     (void) size; | ||||
|     janet_panic("threaded abstracts not supported"); | ||||
| #endif | ||||
| } | ||||
|  | ||||
| static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) { | ||||
|     Janet key; | ||||
|     data = unmarshal_one(st, data, &key, flags + 1); | ||||
| @@ -1207,7 +1281,9 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t * | ||||
|     if (at == NULL) janet_panic("unknown abstract type"); | ||||
|     if (at->unmarshal) { | ||||
|         JanetMarshalContext context = {NULL, st, flags, data, at}; | ||||
|         *out = janet_wrap_abstract(at->unmarshal(&context)); | ||||
|         void *abst = at->unmarshal(&context); | ||||
|         janet_assert(abst != NULL, "null pointer abstract"); | ||||
|         *out = janet_wrap_abstract(abst); | ||||
|         if (context.at != NULL) { | ||||
|             janet_panic("janet_unmarshal_abstract not called"); | ||||
|         } | ||||
| @@ -1308,7 +1384,7 @@ static const uint8_t *unmarshal_one( | ||||
|         } | ||||
|         case LB_FIBER: { | ||||
|             JanetFiber *fiber; | ||||
|             data = unmarshal_one_fiber(st, data + 1, &fiber, flags); | ||||
|             data = unmarshal_one_fiber(st, data + 1, &fiber, flags + 1); | ||||
|             *out = janet_wrap_fiber(fiber); | ||||
|             return data; | ||||
|         } | ||||
| @@ -1323,6 +1399,9 @@ static const uint8_t *unmarshal_one( | ||||
|             func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) + | ||||
|                                  len * sizeof(JanetFuncEnv)); | ||||
|             func->def = NULL; | ||||
|             for (int32_t i = 0; i < len; i++) { | ||||
|                 func->envs[i] = NULL; | ||||
|             } | ||||
|             *out = janet_wrap_function(func); | ||||
|             janet_v_push(st->lookup, *out); | ||||
|             data = unmarshal_one_def(st, data, &def, flags + 1); | ||||
| @@ -1376,7 +1455,7 @@ static const uint8_t *unmarshal_one( | ||||
|                 if (lead == LB_STRUCT_PROTO) { | ||||
|                     Janet proto; | ||||
|                     data = unmarshal_one(st, data, &proto, flags + 1); | ||||
|                     janet_asserttype(proto, JANET_STRUCT); | ||||
|                     janet_asserttype(proto, JANET_STRUCT, st); | ||||
|                     janet_struct_proto(struct_) = janet_unwrap_struct(proto); | ||||
|                 } | ||||
|                 for (int32_t i = 0; i < len; i++) { | ||||
| @@ -1399,7 +1478,7 @@ static const uint8_t *unmarshal_one( | ||||
|                 if (lead == LB_TABLE_PROTO) { | ||||
|                     Janet proto; | ||||
|                     data = unmarshal_one(st, data, &proto, flags + 1); | ||||
|                     janet_asserttype(proto, JANET_TABLE); | ||||
|                     janet_asserttype(proto, JANET_TABLE, st); | ||||
|                     t->proto = janet_unwrap_table(proto); | ||||
|                 } | ||||
|                 for (int32_t i = 0; i < len; i++) { | ||||
|   | ||||
| @@ -119,7 +119,7 @@ double janet_rng_double(JanetRNG *rng) { | ||||
|  | ||||
| JANET_CORE_FN(cfun_rng_make, | ||||
|               "(math/rng &opt seed)", | ||||
|               "Creates a Psuedo-Random number generator, with an optional seed. " | ||||
|               "Creates a Pseudo-Random number generator, with an optional seed. " | ||||
|               "The seed should be an unsigned 32 bit integer or a buffer. " | ||||
|               "Do not use this for cryptography. Returns a core/rng abstract type." | ||||
|              ) { | ||||
| @@ -349,6 +349,26 @@ JANET_CORE_FN(janet_cfun_lcm, "(math/lcm x y)", | ||||
|     return janet_wrap_number(janet_lcm(x, y)); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(janet_cfun_frexp, "(math/frexp x)", | ||||
|               "Returns a tuple of (mantissa, exponent) from number.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     double x = janet_getnumber(argv, 0); | ||||
|     int exp; | ||||
|     x = frexp(x, &exp); | ||||
|     Janet *result = janet_tuple_begin(2); | ||||
|     result[0] = janet_wrap_number(x); | ||||
|     result[1] = janet_wrap_number((double) exp); | ||||
|     return janet_wrap_tuple(janet_tuple_end(result)); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(janet_cfun_ldexp, "(math/ldexp m e)", | ||||
|               "Creates a new number from a mantissa and an exponent.") { | ||||
|     janet_fixarity(argc, 2); | ||||
|     double x = janet_getnumber(argv, 0); | ||||
|     int32_t y = janet_getinteger(argv, 1); | ||||
|     return janet_wrap_number(ldexp(x, y)); | ||||
| } | ||||
|  | ||||
| /* Module entry point */ | ||||
| void janet_lib_math(JanetTable *env) { | ||||
|     JanetRegExt math_cfuns[] = { | ||||
| @@ -395,6 +415,8 @@ void janet_lib_math(JanetTable *env) { | ||||
|         JANET_CORE_REG("math/next", janet_nextafter), | ||||
|         JANET_CORE_REG("math/gcd", janet_cfun_gcd), | ||||
|         JANET_CORE_REG("math/lcm", janet_cfun_lcm), | ||||
|         JANET_CORE_REG("math/frexp", janet_cfun_frexp), | ||||
|         JANET_CORE_REG("math/ldexp", janet_cfun_ldexp), | ||||
|         JANET_REG_END | ||||
|     }; | ||||
|     janet_core_cfuns_ext(env, NULL, math_cfuns); | ||||
| @@ -411,11 +433,11 @@ void janet_lib_math(JanetTable *env) { | ||||
|     JANET_CORE_DEF(env, "math/int32-min", janet_wrap_number(INT32_MIN), | ||||
|                    "The minimum contiguous integer representable by a 32 bit signed integer"); | ||||
|     JANET_CORE_DEF(env, "math/int32-max", janet_wrap_number(INT32_MAX), | ||||
|                    "The maximum contiguous integer represtenable by a 32 bit signed integer"); | ||||
|                    "The maximum contiguous integer representable by a 32 bit signed integer"); | ||||
|     JANET_CORE_DEF(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE), | ||||
|                    "The minimum contiguous integer representable by a double (2^53)"); | ||||
|     JANET_CORE_DEF(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE), | ||||
|                    "The maximum contiguous integer represtenable by a double (-(2^53))"); | ||||
|                    "The maximum contiguous integer representable by a double (-(2^53))"); | ||||
| #ifdef NAN | ||||
|     JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN)"); | ||||
| #else | ||||
|   | ||||
							
								
								
									
										172
									
								
								src/core/net.c
									
									
									
									
									
								
							
							
						
						
									
										172
									
								
								src/core/net.c
									
									
									
									
									
								
							| @@ -24,6 +24,7 @@ | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "util.h" | ||||
| #include "fiber.h" | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_NET | ||||
| @@ -78,12 +79,20 @@ const JanetAbstractType janet_address_type = { | ||||
|  | ||||
| /* maximum number of bytes in a socket address host (post name resolution) */ | ||||
| #ifdef JANET_WINDOWS | ||||
| #ifdef JANET_NO_IPV6 | ||||
| #define SA_ADDRSTRLEN (INET_ADDRSTRLEN + 1) | ||||
| #else | ||||
| #define SA_ADDRSTRLEN (INET6_ADDRSTRLEN + 1) | ||||
| #endif | ||||
| typedef unsigned short in_port_t; | ||||
| #else | ||||
| #define JANET_SA_MAX(a, b) (((a) > (b))? (a) : (b)) | ||||
| #ifdef JANET_NO_IPV6 | ||||
| #define SA_ADDRSTRLEN JANET_SA_MAX(INET_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1) | ||||
| #else | ||||
| #define SA_ADDRSTRLEN JANET_SA_MAX(INET6_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1) | ||||
| #endif | ||||
| #endif | ||||
|  | ||||
| static JanetStream *make_stream(JSock handle, uint32_t flags); | ||||
|  | ||||
| @@ -111,12 +120,57 @@ static void janet_net_socknoblock(JSock s) { | ||||
| #endif | ||||
| } | ||||
|  | ||||
| /* State machine for async connect */ | ||||
|  | ||||
| void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) { | ||||
|     JanetStream *stream = fiber->ev_stream; | ||||
|     switch (event) { | ||||
|         default: | ||||
|             break; | ||||
| #ifndef JANET_WINDOWS | ||||
|         /* Wait until we have an actual event before checking. | ||||
|          * Windows doesn't support async connect with this, just try immediately.*/ | ||||
|         case JANET_ASYNC_EVENT_INIT: | ||||
| #endif | ||||
|         case JANET_ASYNC_EVENT_DEINIT: | ||||
|             return; | ||||
|         case JANET_ASYNC_EVENT_CLOSE: | ||||
|             janet_cancel(fiber, janet_cstringv("stream closed")); | ||||
|             janet_async_end(fiber); | ||||
|             return; | ||||
|     } | ||||
| #ifdef JANET_WINDOWS | ||||
|     int res = 0; | ||||
|     int size = sizeof(res); | ||||
|     int r = getsockopt((SOCKET)stream->handle, SOL_SOCKET, SO_ERROR, (char *)&res, &size); | ||||
| #else | ||||
|     int res = 0; | ||||
|     socklen_t size = sizeof res; | ||||
|     int r = getsockopt(stream->handle, SOL_SOCKET, SO_ERROR, &res, &size); | ||||
| #endif | ||||
|     if (r == 0) { | ||||
|         if (res == 0) { | ||||
|             janet_schedule(fiber, janet_wrap_abstract(stream)); | ||||
|         } else { | ||||
|             janet_cancel(fiber, janet_cstringv(janet_strerror(res))); | ||||
|             stream->flags |= JANET_STREAM_TOCLOSE; | ||||
|         } | ||||
|     } else { | ||||
|         janet_cancel(fiber, janet_ev_lasterr()); | ||||
|         stream->flags |= JANET_STREAM_TOCLOSE; | ||||
|     } | ||||
|     janet_async_end(fiber); | ||||
| } | ||||
|  | ||||
| static JANET_NO_RETURN void net_sched_connect(JanetStream *stream) { | ||||
|     janet_async_start(stream, JANET_ASYNC_LISTEN_WRITE, net_callback_connect, NULL); | ||||
| } | ||||
|  | ||||
| /* State machine for accepting connections. */ | ||||
|  | ||||
| #ifdef JANET_WINDOWS | ||||
|  | ||||
| typedef struct { | ||||
|     JanetListenerState head; | ||||
|     WSAOVERLAPPED overlapped; | ||||
|     JanetFunction *function; | ||||
|     JanetStream *lstream; | ||||
| @@ -124,10 +178,10 @@ typedef struct { | ||||
|     char buf[1024]; | ||||
| } NetStateAccept; | ||||
|  | ||||
| static int net_sched_accept_impl(NetStateAccept *state, Janet *err); | ||||
| static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet *err); | ||||
|  | ||||
| JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) { | ||||
|     NetStateAccept *state = (NetStateAccept *)s; | ||||
| void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) { | ||||
|     NetStateAccept *state = (NetStateAccept *)fiber->ev_state; | ||||
|     switch (event) { | ||||
|         default: | ||||
|             break; | ||||
| @@ -138,55 +192,60 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event | ||||
|             break; | ||||
|         } | ||||
|         case JANET_ASYNC_EVENT_CLOSE: | ||||
|             janet_schedule(s->fiber, janet_wrap_nil()); | ||||
|             return JANET_ASYNC_STATUS_DONE; | ||||
|             janet_schedule(fiber, janet_wrap_nil()); | ||||
|             janet_async_end(fiber); | ||||
|             return; | ||||
|         case JANET_ASYNC_EVENT_COMPLETE: { | ||||
|             if (state->astream->flags & JANET_STREAM_CLOSED) { | ||||
|                 janet_cancel(s->fiber, janet_cstringv("failed to accept connection")); | ||||
|                 return JANET_ASYNC_STATUS_DONE; | ||||
|                 janet_cancel(fiber, janet_cstringv("failed to accept connection")); | ||||
|                 janet_async_end(fiber); | ||||
|                 return; | ||||
|             } | ||||
|             SOCKET lsock = (SOCKET) state->lstream->handle; | ||||
|             if (NO_ERROR != setsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_UPDATE_ACCEPT_CONTEXT, | ||||
|                                        (char *) &lsock, sizeof(lsock))) { | ||||
|                 janet_cancel(s->fiber, janet_cstringv("failed to accept connection")); | ||||
|                 return JANET_ASYNC_STATUS_DONE; | ||||
|                 janet_cancel(fiber, janet_cstringv("failed to accept connection")); | ||||
|                 janet_async_end(fiber); | ||||
|                 return; | ||||
|             } | ||||
|  | ||||
|             Janet streamv = janet_wrap_abstract(state->astream); | ||||
|             if (state->function) { | ||||
|                 /* Schedule worker */ | ||||
|                 JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv); | ||||
|                 fiber->supervisor_channel = s->fiber->supervisor_channel; | ||||
|                 janet_schedule(fiber, janet_wrap_nil()); | ||||
|                 JanetFiber *sub_fiber = janet_fiber(state->function, 64, 1, &streamv); | ||||
|                 sub_fiber->supervisor_channel = fiber->supervisor_channel; | ||||
|                 janet_schedule(sub_fiber, janet_wrap_nil()); | ||||
|                 /* Now listen again for next connection */ | ||||
|                 Janet err; | ||||
|                 if (net_sched_accept_impl(state, &err)) { | ||||
|                     janet_cancel(s->fiber, err); | ||||
|                     return JANET_ASYNC_STATUS_DONE; | ||||
|                 if (net_sched_accept_impl(state, fiber, &err)) { | ||||
|                     janet_cancel(fiber, err); | ||||
|                     janet_async_end(fiber); | ||||
|                     return; | ||||
|                 } | ||||
|             } else { | ||||
|                 janet_schedule(s->fiber, streamv); | ||||
|                 return JANET_ASYNC_STATUS_DONE; | ||||
|                 janet_schedule(fiber, streamv); | ||||
|                 janet_async_end(fiber); | ||||
|                 return; | ||||
|             } | ||||
|         } | ||||
|     } | ||||
|     return JANET_ASYNC_STATUS_NOT_DONE; | ||||
| } | ||||
|  | ||||
| JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) { | ||||
|     Janet err; | ||||
|     JanetListenerState *s = janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL); | ||||
|     NetStateAccept *state = (NetStateAccept *)s; | ||||
|     NetStateAccept *state = janet_malloc(sizeof(NetStateAccept)); | ||||
|     memset(&state->overlapped, 0, sizeof(WSAOVERLAPPED)); | ||||
|     memset(&state->buf, 0, 1024); | ||||
|     state->function = fun; | ||||
|     state->lstream = stream; | ||||
|     s->tag = &state->overlapped; | ||||
|     if (net_sched_accept_impl(state, &err)) janet_panicv(err); | ||||
|     janet_await(); | ||||
|     if (net_sched_accept_impl(state, janet_root_fiber(), &err)) { | ||||
|         janet_free(state); | ||||
|         janet_panicv(err); | ||||
|     } | ||||
|     janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state); | ||||
| } | ||||
|  | ||||
| static int net_sched_accept_impl(NetStateAccept *state, Janet *err) { | ||||
| static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet *err) { | ||||
|     SOCKET lsock = (SOCKET) state->lstream->handle; | ||||
|     SOCKET asock = WSASocketW(AF_INET, SOCK_STREAM, IPPROTO_TCP, NULL, 0, WSA_FLAG_OVERLAPPED); | ||||
|     if (asock == INVALID_SOCKET) { | ||||
| @@ -198,7 +257,11 @@ static int net_sched_accept_impl(NetStateAccept *state, Janet *err) { | ||||
|     int socksize = sizeof(SOCKADDR_STORAGE) + 16; | ||||
|     if (FALSE == AcceptEx(lsock, asock, state->buf, 0, socksize, socksize, NULL, &state->overlapped)) { | ||||
|         int code = WSAGetLastError(); | ||||
|         if (code == WSA_IO_PENDING) return 0; /* indicates io is happening async */ | ||||
|         if (code == WSA_IO_PENDING) { | ||||
|             /* indicates io is happening async */ | ||||
|             janet_async_in_flight(fiber); | ||||
|             return 0; | ||||
|         } | ||||
|         *err = janet_ev_lasterr(); | ||||
|         return 1; | ||||
|     } | ||||
| @@ -208,12 +271,12 @@ static int net_sched_accept_impl(NetStateAccept *state, Janet *err) { | ||||
| #else | ||||
|  | ||||
| typedef struct { | ||||
|     JanetListenerState head; | ||||
|     JanetFunction *function; | ||||
| } NetStateAccept; | ||||
|  | ||||
| JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) { | ||||
|     NetStateAccept *state = (NetStateAccept *)s; | ||||
| void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) { | ||||
|     JanetStream *stream = fiber->ev_stream; | ||||
|     NetStateAccept *state = (NetStateAccept *)fiber->ev_state; | ||||
|     switch (event) { | ||||
|         default: | ||||
|             break; | ||||
| @@ -222,38 +285,42 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event | ||||
|             break; | ||||
|         } | ||||
|         case JANET_ASYNC_EVENT_CLOSE: | ||||
|             janet_schedule(s->fiber, janet_wrap_nil()); | ||||
|             return JANET_ASYNC_STATUS_DONE; | ||||
|             janet_schedule(fiber, janet_wrap_nil()); | ||||
|             janet_async_end(fiber); | ||||
|             return; | ||||
|         case JANET_ASYNC_EVENT_INIT: | ||||
|         case JANET_ASYNC_EVENT_READ: { | ||||
| #if defined(JANET_LINUX) | ||||
|             JSock connfd = accept4(s->stream->handle, NULL, NULL, SOCK_CLOEXEC); | ||||
|             JSock connfd = accept4(stream->handle, NULL, NULL, SOCK_CLOEXEC); | ||||
| #else | ||||
|             /* On BSDs, CLOEXEC should be inherited from server socket */ | ||||
|             JSock connfd = accept(s->stream->handle, NULL, NULL); | ||||
|             JSock connfd = accept(stream->handle, NULL, NULL); | ||||
| #endif | ||||
|             if (JSOCKVALID(connfd)) { | ||||
|                 janet_net_socknoblock(connfd); | ||||
|                 JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE); | ||||
|                 Janet streamv = janet_wrap_abstract(stream); | ||||
|                 if (state->function) { | ||||
|                     JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv); | ||||
|                     fiber->supervisor_channel = s->fiber->supervisor_channel; | ||||
|                     janet_schedule(fiber, janet_wrap_nil()); | ||||
|                     JanetFiber *sub_fiber = janet_fiber(state->function, 64, 1, &streamv); | ||||
|                     sub_fiber->supervisor_channel = fiber->supervisor_channel; | ||||
|                     janet_schedule(sub_fiber, janet_wrap_nil()); | ||||
|                 } else { | ||||
|                     janet_schedule(s->fiber, streamv); | ||||
|                     return JANET_ASYNC_STATUS_DONE; | ||||
|                     janet_schedule(fiber, streamv); | ||||
|                     janet_async_end(fiber); | ||||
|                     return; | ||||
|                 } | ||||
|             } | ||||
|             break; | ||||
|         } | ||||
|     } | ||||
|     return JANET_ASYNC_STATUS_NOT_DONE; | ||||
| } | ||||
|  | ||||
| JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) { | ||||
|     NetStateAccept *state = (NetStateAccept *) janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL); | ||||
|     NetStateAccept *state = janet_malloc(sizeof(NetStateAccept)); | ||||
|     memset(state, 0, sizeof(NetStateAccept)); | ||||
|     state->function = fun; | ||||
|     janet_await(); | ||||
|     if (fun) janet_stream_level_triggered(stream); | ||||
|     janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state); | ||||
| } | ||||
|  | ||||
| #endif | ||||
| @@ -496,7 +563,7 @@ JANET_CORE_FN(cfun_net_connect, | ||||
|     } | ||||
| #endif | ||||
|  | ||||
|     if (status != 0) { | ||||
|     if (status) { | ||||
| #ifdef JANET_WINDOWS | ||||
|         if (err != WSAEWOULDBLOCK) { | ||||
| #else | ||||
| @@ -508,10 +575,7 @@ JANET_CORE_FN(cfun_net_connect, | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     /* Handle the connect() result in the event loop*/ | ||||
|     janet_ev_connect(stream, MSG_NOSIGNAL); | ||||
|  | ||||
|     janet_await(); | ||||
|     net_sched_connect(stream); | ||||
| } | ||||
|  | ||||
| static const char *serverify_socket(JSock sfd) { | ||||
| @@ -682,6 +746,7 @@ static Janet janet_so_getname(const void *sa_any) { | ||||
|             Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai->sin_port))}; | ||||
|             return janet_wrap_tuple(janet_tuple_n(pair, 2)); | ||||
|         } | ||||
| #ifndef JANET_NO_IPV6 | ||||
|         case AF_INET6: { | ||||
|             const struct sockaddr_in6 *sai6 = sa_any; | ||||
|             if (!inet_ntop(AF_INET6, &(sai6->sin6_addr), buffer, sizeof(buffer))) { | ||||
| @@ -690,6 +755,7 @@ static Janet janet_so_getname(const void *sa_any) { | ||||
|             Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai6->sin6_port))}; | ||||
|             return janet_wrap_tuple(janet_tuple_n(pair, 2)); | ||||
|         } | ||||
| #endif | ||||
| #ifndef JANET_WINDOWS | ||||
|         case AF_UNIX: { | ||||
|             const struct sockaddr_un *sun = sa_any; | ||||
| @@ -756,6 +822,7 @@ JANET_CORE_FN(cfun_stream_accept_loop, | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
|     janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET); | ||||
|     JanetFunction *fun = janet_getfunction(argv, 1); | ||||
|     if (fun->def->min_arity < 1) janet_panic("handler function must take at least 1 argument"); | ||||
|     janet_sched_accept(stream, fun); | ||||
| } | ||||
|  | ||||
| @@ -792,7 +859,6 @@ JANET_CORE_FN(cfun_stream_read, | ||||
|         if (to != INFINITY) janet_addtimeout(to); | ||||
|         janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL); | ||||
|     } | ||||
|     janet_await(); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_stream_chunk, | ||||
| @@ -807,7 +873,6 @@ JANET_CORE_FN(cfun_stream_chunk, | ||||
|     double to = janet_optnumber(argv, argc, 3, INFINITY); | ||||
|     if (to != INFINITY) janet_addtimeout(to); | ||||
|     janet_ev_recvchunk(stream, buffer, n, MSG_NOSIGNAL); | ||||
|     janet_await(); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_stream_recv_from, | ||||
| @@ -822,7 +887,6 @@ JANET_CORE_FN(cfun_stream_recv_from, | ||||
|     double to = janet_optnumber(argv, argc, 3, INFINITY); | ||||
|     if (to != INFINITY) janet_addtimeout(to); | ||||
|     janet_ev_recvfrom(stream, buffer, n, MSG_NOSIGNAL); | ||||
|     janet_await(); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_stream_write, | ||||
| @@ -842,7 +906,6 @@ JANET_CORE_FN(cfun_stream_write, | ||||
|         if (to != INFINITY) janet_addtimeout(to); | ||||
|         janet_ev_send_string(stream, bytes.bytes, MSG_NOSIGNAL); | ||||
|     } | ||||
|     janet_await(); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_stream_send_to, | ||||
| @@ -863,7 +926,6 @@ JANET_CORE_FN(cfun_stream_send_to, | ||||
|         if (to != INFINITY) janet_addtimeout(to); | ||||
|         janet_ev_sendto_string(stream, bytes.bytes, dest, MSG_NOSIGNAL); | ||||
|     } | ||||
|     janet_await(); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_stream_flush, | ||||
| @@ -897,8 +959,10 @@ static const struct sockopt_type sockopt_type_list[] = { | ||||
|     { "ip-multicast-ttl", IPPROTO_IP, IP_MULTICAST_TTL, JANET_NUMBER }, | ||||
|     { "ip-add-membership", IPPROTO_IP, IP_ADD_MEMBERSHIP, JANET_POINTER }, | ||||
|     { "ip-drop-membership", IPPROTO_IP, IP_DROP_MEMBERSHIP, JANET_POINTER }, | ||||
| #ifndef JANET_NO_IPV6 | ||||
|     { "ipv6-join-group", IPPROTO_IPV6, IPV6_JOIN_GROUP, JANET_POINTER }, | ||||
|     { "ipv6-leave-group", IPPROTO_IPV6, IPV6_LEAVE_GROUP, JANET_POINTER }, | ||||
| #endif | ||||
|     { NULL, 0, 0, JANET_POINTER } | ||||
| }; | ||||
|  | ||||
| @@ -935,7 +999,9 @@ JANET_CORE_FN(cfun_net_setsockopt, | ||||
|     union { | ||||
|         int v_int; | ||||
|         struct ip_mreq v_mreq; | ||||
| #ifndef JANET_NO_IPV6 | ||||
|         struct ipv6_mreq v_mreq6; | ||||
| #endif | ||||
|     } val; | ||||
|  | ||||
|     void *optval = (void *)&val; | ||||
| @@ -953,12 +1019,14 @@ JANET_CORE_FN(cfun_net_setsockopt, | ||||
|         val.v_mreq.imr_interface.s_addr = htonl(INADDR_ANY); | ||||
|         inet_pton(AF_INET, addr, &val.v_mreq.imr_multiaddr.s_addr); | ||||
|         optlen = sizeof(val.v_mreq); | ||||
| #ifndef JANET_NO_IPV6 | ||||
|     } else if (st->optname == IPV6_JOIN_GROUP || st->optname == IPV6_LEAVE_GROUP) { | ||||
|         const char *addr = janet_getcstring(argv, 2); | ||||
|         memset(&val.v_mreq6, 0, sizeof val.v_mreq6); | ||||
|         val.v_mreq6.ipv6mr_interface = 0; | ||||
|         inet_pton(AF_INET6, addr, &val.v_mreq6.ipv6mr_multiaddr); | ||||
|         optlen = sizeof(val.v_mreq6); | ||||
| #endif | ||||
|     } else { | ||||
|         janet_panicf("invalid socket option type"); | ||||
|     } | ||||
| @@ -967,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(); | ||||
|   | ||||
							
								
								
									
										419
									
								
								src/core/os.c
									
									
									
									
									
								
							
							
						
						
									
										419
									
								
								src/core/os.c
									
									
									
									
									
								
							| @@ -38,6 +38,7 @@ | ||||
| #include <string.h> | ||||
| #include <sys/stat.h> | ||||
| #include <signal.h> | ||||
| #include <locale.h> | ||||
|  | ||||
| #ifdef JANET_BSD | ||||
| #include <sys/sysctl.h> | ||||
| @@ -229,10 +230,11 @@ JANET_CORE_FN(os_compiler, | ||||
| #undef janet_stringify | ||||
|  | ||||
| JANET_CORE_FN(os_exit, | ||||
|               "(os/exit &opt x)", | ||||
|               "(os/exit &opt x force)", | ||||
|               "Exit from janet with an exit code equal to x. If x is not an integer, " | ||||
|               "the exit with status equal the hash of x.") { | ||||
|     janet_arity(argc, 0, 1); | ||||
|               "the exit with status equal the hash of x. If `force` is truthy will exit immediately and " | ||||
|               "skip cleanup code.") { | ||||
|     janet_arity(argc, 0, 2); | ||||
|     int status; | ||||
|     if (argc == 0) { | ||||
|         status = EXIT_SUCCESS; | ||||
| @@ -242,7 +244,11 @@ JANET_CORE_FN(os_exit, | ||||
|         status = EXIT_FAILURE; | ||||
|     } | ||||
|     janet_deinit(); | ||||
|     exit(status); | ||||
|     if (argc >= 2 && janet_truthy(argv[1])) { | ||||
|         _exit(status); | ||||
|     } else { | ||||
|         exit(status); | ||||
|     } | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| @@ -500,8 +506,11 @@ static int proc_get_status(JanetProc *proc) { | ||||
|         status = WEXITSTATUS(status); | ||||
|     } else if (WIFSTOPPED(status)) { | ||||
|         status = WSTOPSIG(status) + 128; | ||||
|     } else { | ||||
|     } else if (WIFSIGNALED(status)) { | ||||
|         status = WTERMSIG(status) + 128; | ||||
|     } else { | ||||
|         /* Could possibly return -1 but for now, just panic */ | ||||
|         janet_panicf("Undefined status code for process termination, %d.", status); | ||||
|     } | ||||
|     return status; | ||||
| } | ||||
| @@ -517,7 +526,6 @@ static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) { | ||||
|  | ||||
| /* Callback that is called in main thread when subroutine completes. */ | ||||
| static void janet_proc_wait_cb(JanetEVGenericMessage args) { | ||||
|     janet_ev_dec_refcount(); | ||||
|     JanetProc *proc = (JanetProc *) args.argp; | ||||
|     if (NULL != proc) { | ||||
|         int status = args.tag; | ||||
| @@ -530,7 +538,9 @@ static void janet_proc_wait_cb(JanetEVGenericMessage args) { | ||||
|             JanetString s = janet_formatc("command failed with non-zero exit code %d", status); | ||||
|             janet_cancel(args.fiber, janet_wrap_string(s)); | ||||
|         } else { | ||||
|             janet_schedule(args.fiber, janet_wrap_integer(status)); | ||||
|             if (janet_fiber_can_resume(args.fiber)) { | ||||
|                 janet_schedule(args.fiber, janet_wrap_integer(status)); | ||||
|             } | ||||
|         } | ||||
|     } | ||||
| } | ||||
| @@ -612,7 +622,11 @@ os_proc_wait_impl(JanetProc *proc) { | ||||
|  | ||||
| JANET_CORE_FN(os_proc_wait, | ||||
|               "(os/proc-wait proc)", | ||||
|               "Block until the subprocess completes. Returns the subprocess return code.") { | ||||
|               "Suspend the current fiber until the subprocess completes. Returns the subprocess return code. " | ||||
|               "os/proc-wait cannot be called twice on the same process. If `ev/with-deadline` cancels `os/proc-wait` " | ||||
|               "with an error or os/proc-wait is cancelled with any error caused by anything else, os/proc-wait still " | ||||
|               "finishes in the background. Only after os/proc-wait finishes, a process is cleaned up by the operating " | ||||
|               "system. Thus, a process becomes a zombie process if os/proc-wait is not called.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetProc *proc = janet_getabstract(argv, 0, &ProcAT); | ||||
| #ifdef JANET_EV | ||||
| @@ -641,7 +655,7 @@ static const struct keyword_signal signal_keywords[] = { | ||||
| #ifdef SIGTERM | ||||
|     {"term", SIGTERM}, | ||||
| #endif | ||||
| #ifdef SIGARLM | ||||
| #ifdef SIGALRM | ||||
|     {"alrm", SIGALRM}, | ||||
| #endif | ||||
| #ifdef SIGHUP | ||||
| @@ -706,15 +720,28 @@ static const struct keyword_signal signal_keywords[] = { | ||||
| #endif | ||||
|     {NULL, 0}, | ||||
| }; | ||||
|  | ||||
| static int get_signal_kw(const Janet *argv, int32_t n) { | ||||
|     JanetKeyword signal_kw = janet_getkeyword(argv, n); | ||||
|     const struct keyword_signal *ptr = signal_keywords; | ||||
|     while (ptr->keyword) { | ||||
|         if (!janet_cstrcmp(signal_kw, ptr->keyword)) { | ||||
|             return ptr->signal; | ||||
|         } | ||||
|         ptr++; | ||||
|     } | ||||
|     janet_panicf("undefined signal %v", argv[n]); | ||||
| } | ||||
| #endif | ||||
|  | ||||
| JANET_CORE_FN(os_proc_kill, | ||||
|               "(os/proc-kill proc &opt wait signal)", | ||||
|               "Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process " | ||||
|               "handle on windows. If `wait` is truthy, will wait for the process to finish and " | ||||
|               "returns the exit code. Otherwise, returns `proc`. If signal is specified send it instead." | ||||
|               "Signal keywords are named after their C counterparts but in lowercase with the leading " | ||||
|               "`SIG` stripped. Signals are ignored on windows.") { | ||||
|               "handle on windows. If os/proc-wait already finished for proc, os/proc-kill raises an error. After " | ||||
|               "sending signal to proc, if `wait` is truthy, will wait for the process to finish and return the exit " | ||||
|               "code by calling os/proc-wait. Otherwise, returns `proc`. If signal is specified, send it instead. " | ||||
|               "Signal keywords are named after their C counterparts but in lowercase with the leading `SIG` stripped. " | ||||
|               "Signals are ignored on windows.") { | ||||
|     janet_arity(argc, 1, 3); | ||||
|     JanetProc *proc = janet_getabstract(argv, 0, &ProcAT); | ||||
|     if (proc->flags & JANET_PROC_WAITED) { | ||||
| @@ -731,22 +758,11 @@ JANET_CORE_FN(os_proc_kill, | ||||
| #else | ||||
|     int signal = -1; | ||||
|     if (argc == 3) { | ||||
|         JanetKeyword signal_kw = janet_getkeyword(argv, 2); | ||||
|         const struct keyword_signal *ptr = signal_keywords; | ||||
|         while (ptr->keyword) { | ||||
|             if (!janet_cstrcmp(signal_kw, ptr->keyword)) { | ||||
|                 signal = ptr->signal; | ||||
|                 break; | ||||
|             } | ||||
|             ptr++; | ||||
|         } | ||||
|         if (signal == -1) { | ||||
|             janet_panic("undefined signal"); | ||||
|         } | ||||
|         signal = get_signal_kw(argv, 2); | ||||
|     } | ||||
|     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. */ | ||||
| @@ -764,8 +780,9 @@ JANET_CORE_FN(os_proc_kill, | ||||
|  | ||||
| JANET_CORE_FN(os_proc_close, | ||||
|               "(os/proc-close proc)", | ||||
|               "Wait on a process if it has not been waited on, and close pipes created by `os/spawn` " | ||||
|               "if they have not been closed. Returns nil.") { | ||||
|               "Close pipes created by `os/spawn` if they have not been closed. Then, if os/proc-wait was not already " | ||||
|               "called on proc, os/proc-wait is called on it, and it returns the exit code returned by os/proc-wait. " | ||||
|               "Otherwise, returns nil.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetProc *proc = janet_getabstract(argv, 0, &ProcAT); | ||||
| #ifdef JANET_EV | ||||
| @@ -803,6 +820,106 @@ static void close_handle(JanetHandle handle) { | ||||
| #endif | ||||
| } | ||||
|  | ||||
| #ifdef JANET_EV | ||||
|  | ||||
| #ifndef JANET_WINDOWS | ||||
| static void janet_signal_callback(JanetEVGenericMessage msg) { | ||||
|     int sig = msg.tag; | ||||
|     if (msg.argi) janet_interpreter_interrupt_handled(NULL); | ||||
|     Janet handlerv = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig)); | ||||
|     if (!janet_checktype(handlerv, JANET_FUNCTION)) { | ||||
|         /* Let another thread/process try to handle this */ | ||||
|         sigset_t set; | ||||
|         sigemptyset(&set); | ||||
|         sigaddset(&set, sig); | ||||
| #ifdef JANET_THREADS | ||||
|         pthread_sigmask(SIG_BLOCK, &set, NULL); | ||||
| #else | ||||
|         sigprocmask(SIG_BLOCK, &set, NULL); | ||||
| #endif | ||||
|         raise(sig); | ||||
|         return; | ||||
|     } | ||||
|     JanetFunction *handler = janet_unwrap_function(handlerv); | ||||
|     JanetFiber *fiber = janet_fiber(handler, 64, 0, NULL); | ||||
|     janet_schedule_soon(fiber, janet_wrap_nil(), JANET_SIGNAL_OK); | ||||
| } | ||||
|  | ||||
| static void janet_signal_trampoline_no_interrupt(int sig) { | ||||
|     /* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */ | ||||
|     JanetEVGenericMessage msg; | ||||
|     memset(&msg, 0, sizeof(msg)); | ||||
|     msg.tag = sig; | ||||
|     janet_ev_post_event(&janet_vm, janet_signal_callback, msg); | ||||
| } | ||||
|  | ||||
| static void janet_signal_trampoline(int sig) { | ||||
|     /* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */ | ||||
|     JanetEVGenericMessage msg; | ||||
|     memset(&msg, 0, sizeof(msg)); | ||||
|     msg.tag = sig; | ||||
|     msg.argi = 1; | ||||
|     janet_interpreter_interrupt(NULL); | ||||
|     janet_ev_post_event(&janet_vm, janet_signal_callback, msg); | ||||
| } | ||||
| #endif | ||||
|  | ||||
| JANET_CORE_FN(os_sigaction, | ||||
|               "(os/sigaction which &opt handler interrupt-interpreter)", | ||||
|               "Add a signal handler for a given action. Use nil for the `handler` argument to remove a signal handler. " | ||||
|               "All signal handlers are the same as supported by `os/proc-kill`.") { | ||||
|     janet_sandbox_assert(JANET_SANDBOX_SIGNAL); | ||||
|     janet_arity(argc, 1, 3); | ||||
| #ifdef JANET_WINDOWS | ||||
|     (void) argv; | ||||
|     janet_panic("unsupported on this platform"); | ||||
| #else | ||||
|     /* TODO - per thread signal masks */ | ||||
|     int rc; | ||||
|     int sig = get_signal_kw(argv, 0); | ||||
|     JanetFunction *handler = janet_optfunction(argv, argc, 1, NULL); | ||||
|     int can_interrupt = janet_optboolean(argv, argc, 2, 0); | ||||
|     Janet oldhandler = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig)); | ||||
|     if (!janet_checktype(oldhandler, JANET_NIL)) { | ||||
|         janet_gcunroot(oldhandler); | ||||
|     } | ||||
|     if (NULL != handler) { | ||||
|         Janet handlerv = janet_wrap_function(handler); | ||||
|         janet_gcroot(handlerv); | ||||
|         janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), handlerv); | ||||
|     } else { | ||||
|         janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), janet_wrap_nil()); | ||||
|     } | ||||
|     struct sigaction action; | ||||
|     sigset_t mask; | ||||
|     sigaddset(&mask, sig); | ||||
|     memset(&action, 0, sizeof(action)); | ||||
|     action.sa_flags |= SA_RESTART; | ||||
|     if (can_interrupt) { | ||||
| #ifdef JANET_NO_INTERPRETER_INTERRUPT | ||||
|         janet_panic("interpreter interrupt not enabled"); | ||||
| #else | ||||
|         action.sa_handler = janet_signal_trampoline; | ||||
| #endif | ||||
|     } else { | ||||
|         action.sa_handler = janet_signal_trampoline_no_interrupt; | ||||
|     } | ||||
|     action.sa_mask = mask; | ||||
|     RETRY_EINTR(rc, sigaction(sig, &action, NULL)); | ||||
|     sigset_t set; | ||||
|     sigemptyset(&set); | ||||
|     sigaddset(&set, sig); | ||||
| #ifdef JANET_THREADS | ||||
|     pthread_sigmask(SIG_UNBLOCK, &set, NULL); | ||||
| #else | ||||
|     sigprocmask(SIG_UNBLOCK, &set, NULL); | ||||
| #endif | ||||
|     return janet_wrap_nil(); | ||||
| #endif | ||||
| } | ||||
|  | ||||
| #endif | ||||
|  | ||||
| /* Create piped file for os/execute and os/spawn. Need to be careful that we mark | ||||
|    the error flag if we can't create pipe and don't leak handles. *handle will be cleaned | ||||
|    up by the calling function. If everything goes well, *handle is owned by the calling function, | ||||
| @@ -982,11 +1099,18 @@ static JanetFile *get_stdio_for_handle(JanetHandle handle, void *orig, int iswri | ||||
| } | ||||
| #endif | ||||
|  | ||||
| static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) { | ||||
| typedef enum { | ||||
|     JANET_EXECUTE_EXECUTE, | ||||
|     JANET_EXECUTE_SPAWN, | ||||
|     JANET_EXECUTE_EXEC | ||||
| } JanetExecuteMode; | ||||
|  | ||||
| static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) { | ||||
|     janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS); | ||||
|     janet_arity(argc, 1, 3); | ||||
|  | ||||
|     /* Get flags */ | ||||
|     int is_spawn = mode == JANET_EXECUTE_SPAWN; | ||||
|     uint64_t flags = 0; | ||||
|     if (argc > 1) { | ||||
|         flags = janet_getflags(argv, 1, "epxd"); | ||||
| @@ -1010,7 +1134,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) { | ||||
|     int pipe_owner_flags = (is_spawn && (flags & 0x8)) ? JANET_PROC_ALLOW_ZOMBIE : 0; | ||||
|  | ||||
|     /* Get optional redirections */ | ||||
|     if (argc > 2) { | ||||
|     if (argc > 2 && (mode != JANET_EXECUTE_EXEC)) { | ||||
|         JanetDictView tab = janet_getdictionary(argv, 2); | ||||
|         Janet maybe_stdin = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("in")); | ||||
|         Janet maybe_stdout = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("out")); | ||||
| @@ -1131,12 +1255,32 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) { | ||||
|      * of posix_spawn would modify the argv array passed in. */ | ||||
|     char *const *cargv = (char *const *)child_argv; | ||||
|  | ||||
|     /* Use posix_spawn to spawn new process */ | ||||
|  | ||||
|     if (use_environ) { | ||||
|         janet_lock_environ(); | ||||
|     } | ||||
|  | ||||
|     /* exec mode */ | ||||
|     if (mode == JANET_EXECUTE_EXEC) { | ||||
| #ifdef JANET_WINDOWS | ||||
|         janet_panic("not supported on windows"); | ||||
| #else | ||||
|         int status; | ||||
|         if (!use_environ) { | ||||
|             environ = envp; | ||||
|         } | ||||
|         do { | ||||
|             if (janet_flag_at(flags, 1)) { | ||||
|                 status = execvp(cargv[0], cargv); | ||||
|             } else { | ||||
|                 status = execv(cargv[0], cargv); | ||||
|             } | ||||
|         } while (status == -1 && errno == EINTR); | ||||
|         janet_panicf("%p: %s", cargv[0], janet_strerror(errno ? errno : ENOENT)); | ||||
| #endif | ||||
|     } | ||||
|  | ||||
|     /* Use posix_spawn to spawn new process */ | ||||
|  | ||||
|     /* Posix spawn setup */ | ||||
|     posix_spawn_file_actions_t actions; | ||||
|     posix_spawn_file_actions_init(&actions); | ||||
| @@ -1145,14 +1289,16 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) { | ||||
|         posix_spawn_file_actions_addclose(&actions, pipe_in); | ||||
|     } else if (new_in != JANET_HANDLE_NONE && new_in != 0) { | ||||
|         posix_spawn_file_actions_adddup2(&actions, new_in, 0); | ||||
|         posix_spawn_file_actions_addclose(&actions, new_in); | ||||
|         if (new_in != new_out && new_in != new_err) | ||||
|             posix_spawn_file_actions_addclose(&actions, new_in); | ||||
|     } | ||||
|     if (pipe_out != JANET_HANDLE_NONE) { | ||||
|         posix_spawn_file_actions_adddup2(&actions, pipe_out, 1); | ||||
|         posix_spawn_file_actions_addclose(&actions, pipe_out); | ||||
|     } else if (new_out != JANET_HANDLE_NONE && new_out != 1) { | ||||
|         posix_spawn_file_actions_adddup2(&actions, new_out, 1); | ||||
|         posix_spawn_file_actions_addclose(&actions, new_out); | ||||
|         if (new_out != new_err) | ||||
|             posix_spawn_file_actions_addclose(&actions, new_out); | ||||
|     } | ||||
|     if (pipe_err != JANET_HANDLE_NONE) { | ||||
|         posix_spawn_file_actions_adddup2(&actions, pipe_err, 2); | ||||
| @@ -1186,7 +1332,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) { | ||||
|     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 | ||||
| @@ -1241,22 +1387,63 @@ JANET_CORE_FN(os_execute, | ||||
|               "* :d - Don't try and terminate the process on garbage collection (allow spawning zombies).\n" | ||||
|               "`env` is a table or struct mapping environment variables to values. It can also " | ||||
|               "contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. " | ||||
|               "These arguments should be core/file values. " | ||||
|               "Returns the exit status of the program.") { | ||||
|     return os_execute_impl(argc, argv, 0); | ||||
|               ":in, :out, and :err should be core/file values or core/stream values. core/file values and core/stream " | ||||
|               "values passed to :in, :out, and :err should be closed manually because os/execute doesn't close them. " | ||||
|               "Returns the exit code of the program.") { | ||||
|     return os_execute_impl(argc, argv, JANET_EXECUTE_EXECUTE); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(os_spawn, | ||||
|               "(os/spawn args &opt flags env)", | ||||
|               "Execute a program on the system and return a handle to the process. Otherwise, takes the " | ||||
|               "same arguments as `os/execute`. Does not wait for the process. " | ||||
|               "For each of the :in, :out, and :err keys to the `env` argument, one " | ||||
|               "can also pass in the keyword `:pipe` " | ||||
|               "to get streams for standard IO of the subprocess that can be read from and written to. " | ||||
|               "The returned value `proc` has the fields :in, :out, :err, :return-code, and " | ||||
|               "the additional field :pid on unix-like platforms. Use `(os/proc-wait proc)` to rejoin the " | ||||
|               "subprocess or `(os/proc-kill proc)`.") { | ||||
|     return os_execute_impl(argc, argv, 1); | ||||
|               "same arguments as `os/execute`. Does not wait for the process. For each of the :in, :out, and :err keys " | ||||
|               "of the `env` argument, one can also pass in the keyword `:pipe` to get streams for standard IO of the " | ||||
|               "subprocess that can be read from and written to. The returned value `proc` has the fields :in, :out, " | ||||
|               ":err, and the additional field :pid on unix-like platforms. `(os/proc-wait proc)` must be called to " | ||||
|               "rejoin the subprocess. After `(os/proc-wait proc)` finishes, proc gains a new field, :return-code. " | ||||
|               "If :x flag is passed to os/spawn, non-zero exit code will cause os/proc-wait to raise an error. " | ||||
|               "If pipe streams created with :pipe keyword are not closed in time, janet can run out of file " | ||||
|               "descriptors. They can be closed individually, or `os/proc-close` can close all pipe streams on proc. " | ||||
|               "If pipe streams aren't read before `os/proc-wait` finishes, then pipe buffers become full, and the " | ||||
|               "process cannot finish because the process cannot print more on pipe buffers which are already full. " | ||||
|               "If the process cannot finish, os/proc-wait cannot finish, either.") { | ||||
|     return os_execute_impl(argc, argv, JANET_EXECUTE_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 " | ||||
|               "does not allow redirection of stdio.") { | ||||
|     return os_execute_impl(argc, argv, JANET_EXECUTE_EXEC); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(os_posix_fork, | ||||
|               "(os/posix-fork)", | ||||
|               "Make a `fork` system call and create a new process. Return nil if in the new process, otherwise a core/process object (as returned by os/spawn). " | ||||
|               "Not supported on all systems (POSIX only).") { | ||||
|     janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS); | ||||
|     janet_fixarity(argc, 0); | ||||
|     (void) argv; | ||||
| #ifdef JANET_WINDOWS | ||||
|     janet_panic("not supported"); | ||||
| #else | ||||
|     pid_t result; | ||||
|     do { | ||||
|         result = fork(); | ||||
|     } while (result == -1 && errno == EINTR); | ||||
|     if (result == -1) { | ||||
|         janet_panic(janet_strerror(errno)); | ||||
|     } | ||||
|     if (result) { | ||||
|         JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc)); | ||||
|         memset(proc, 0, sizeof(JanetProc)); | ||||
|         proc->pid = result; | ||||
|         proc->flags = JANET_PROC_ALLOW_ZOMBIE; | ||||
|         return janet_wrap_abstract(proc); | ||||
|     } | ||||
|     return janet_wrap_nil(); | ||||
| #endif | ||||
| } | ||||
|  | ||||
| #ifdef JANET_EV | ||||
| @@ -1332,8 +1519,8 @@ JANET_CORE_FN(os_getenv, | ||||
|     janet_sandbox_assert(JANET_SANDBOX_ENV); | ||||
|     janet_arity(argc, 1, 2); | ||||
|     const char *cstr = janet_getcstring(argv, 0); | ||||
|     const char *res = getenv(cstr); | ||||
|     janet_lock_environ(); | ||||
|     const char *res = getenv(cstr); | ||||
|     Janet ret = res | ||||
|                 ? janet_cstringv(res) | ||||
|                 : argc == 2 | ||||
| @@ -1378,34 +1565,51 @@ JANET_CORE_FN(os_time, | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(os_clock, | ||||
|               "(os/clock &opt source)", | ||||
|               "Return the number of whole + fractional seconds of the requested clock source.\n\n" | ||||
|               "(os/clock &opt source format)", | ||||
|               "Return the current time of the requested clock source.\n\n" | ||||
|               "The `source` argument selects the clock source to use, when not specified the default " | ||||
|               "is `:realtime`:\n" | ||||
|               "- :realtime: Return the real (i.e., wall-clock) time. This clock is affected by discontinuous " | ||||
|               "  jumps in the system time\n" | ||||
|               "- :monotonic: Return the number of whole + fractional seconds since some fixed point in " | ||||
|               "  time. The clock is guaranteed to be non-decreasing in real time.\n" | ||||
|               "- :cputime: Return the CPU time consumed by this process  (i.e. all threads in the process)\n") { | ||||
|               "- :cputime: Return the CPU time consumed by this process  (i.e. all threads in the process)\n" | ||||
|               "The `format` argument selects the type of output, when not specified the default is `:double`:\n" | ||||
|               "- :double: Return the number of seconds + fractional seconds as a double\n" | ||||
|               "- :int: Return the number of seconds as an integer\n" | ||||
|               "- :tuple: Return a 2 integer tuple [seconds, nanoseconds]\n") { | ||||
|     enum JanetTimeSource source; | ||||
|     janet_sandbox_assert(JANET_SANDBOX_HRTIME); | ||||
|     janet_arity(argc, 0, 1); | ||||
|     enum JanetTimeSource source = JANET_TIME_REALTIME; | ||||
|     if (argc == 1) { | ||||
|         JanetKeyword sourcestr = janet_getkeyword(argv, 0); | ||||
|         if (janet_cstrcmp(sourcestr, "realtime") == 0) { | ||||
|             source = JANET_TIME_REALTIME; | ||||
|         } else if (janet_cstrcmp(sourcestr, "monotonic") == 0) { | ||||
|             source = JANET_TIME_MONOTONIC; | ||||
|         } else if (janet_cstrcmp(sourcestr, "cputime") == 0) { | ||||
|             source = JANET_TIME_CPUTIME; | ||||
|         } else { | ||||
|             janet_panicf("expected :realtime, :monotonic, or :cputime, got %v", argv[0]); | ||||
|         } | ||||
|     janet_arity(argc, 0, 2); | ||||
|  | ||||
|     JanetKeyword sourcestr = janet_optkeyword(argv, argc, 0, (const uint8_t *) "realtime"); | ||||
|     if (janet_cstrcmp(sourcestr, "realtime") == 0) { | ||||
|         source = JANET_TIME_REALTIME; | ||||
|     } else if (janet_cstrcmp(sourcestr, "monotonic") == 0) { | ||||
|         source = JANET_TIME_MONOTONIC; | ||||
|     } else if (janet_cstrcmp(sourcestr, "cputime") == 0) { | ||||
|         source = JANET_TIME_CPUTIME; | ||||
|     } else { | ||||
|         janet_panicf("expected :realtime, :monotonic, or :cputime, got %v", argv[0]); | ||||
|     } | ||||
|  | ||||
|     struct timespec tv; | ||||
|     if (janet_gettime(&tv, source)) janet_panic("could not get time"); | ||||
|     double dtime = tv.tv_sec + (tv.tv_nsec / 1E9); | ||||
|     return janet_wrap_number(dtime); | ||||
|  | ||||
|     JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, (const uint8_t *) "double"); | ||||
|     if (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) { | ||||
|         return janet_wrap_number((double)(tv.tv_sec)); | ||||
|     } else if (janet_cstrcmp(formatstr, "tuple") == 0) { | ||||
|         Janet tup[2] = {janet_wrap_number((double)tv.tv_sec), | ||||
|                         janet_wrap_number((double)tv.tv_nsec) | ||||
|                        }; | ||||
|         return janet_wrap_tuple(janet_tuple_n(tup, 2)); | ||||
|     } else { | ||||
|         janet_panicf("expected :double, :int, or :tuple, got %v", argv[1]); | ||||
|     } | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(os_sleep, | ||||
| @@ -1437,11 +1641,11 @@ JANET_CORE_FN(os_isatty, | ||||
|     FILE *f = (argc == 1) ? janet_getfile(argv, 0, NULL) : stdout; | ||||
| #ifdef JANET_WINDOWS | ||||
|     int fd = _fileno(f); | ||||
|     if (fd == -1) janet_panicv(janet_ev_lasterr()); | ||||
|     if (fd == -1) janet_panic("not a valid stream"); | ||||
|     return janet_wrap_boolean(_isatty(fd)); | ||||
| #else | ||||
|     int fd = fileno(f); | ||||
|     if (fd == -1) janet_panicv(janet_ev_lasterr()); | ||||
|     if (fd == -1) janet_panic(janet_strerror(errno)); | ||||
|     return janet_wrap_boolean(isatty(fd)); | ||||
| #endif | ||||
| } | ||||
| @@ -1676,7 +1880,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); | ||||
| @@ -1688,6 +1892,43 @@ JANET_CORE_FN(os_mktime, | ||||
| #define j_symlink symlink | ||||
| #endif | ||||
|  | ||||
| JANET_CORE_FN(os_setlocale, | ||||
|               "(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. 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) return janet_wrap_nil(); | ||||
|     return janet_cstringv(old); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(os_link, | ||||
|               "(os/link oldpath newpath &opt symlink)", | ||||
|               "Create a link at newpath that points to oldpath and returns nil. " | ||||
| @@ -1705,7 +1946,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 | ||||
| } | ||||
| @@ -1724,7 +1965,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 | ||||
| } | ||||
| @@ -1746,7 +1987,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, | ||||
| @@ -1760,7 +2001,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(); | ||||
| } | ||||
|  | ||||
| @@ -1775,7 +2016,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(); | ||||
| } | ||||
|  | ||||
| @@ -1799,7 +2040,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(); | ||||
| } | ||||
|  | ||||
| @@ -1809,7 +2050,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(); | ||||
| } | ||||
|  | ||||
| @@ -1828,7 +2069,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 | ||||
| } | ||||
| @@ -2123,7 +2364,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(); | ||||
| } | ||||
|  | ||||
| @@ -2159,7 +2400,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)); | ||||
| @@ -2170,8 +2411,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; | ||||
|         } | ||||
| @@ -2191,7 +2442,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(); | ||||
| } | ||||
| @@ -2211,7 +2462,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; | ||||
| @@ -2485,6 +2736,7 @@ void janet_lib_os(JanetTable *env) { | ||||
|         JANET_CORE_REG("os/strftime", os_strftime), | ||||
|         JANET_CORE_REG("os/sleep", os_sleep), | ||||
|         JANET_CORE_REG("os/isatty", os_isatty), | ||||
|         JANET_CORE_REG("os/setlocale", os_setlocale), | ||||
|  | ||||
|         /* env functions */ | ||||
|         JANET_CORE_REG("os/environ", os_environ), | ||||
| @@ -2521,6 +2773,8 @@ void janet_lib_os(JanetTable *env) { | ||||
|         JANET_CORE_REG("os/execute", os_execute), | ||||
|         JANET_CORE_REG("os/spawn", os_spawn), | ||||
|         JANET_CORE_REG("os/shell", os_shell), | ||||
|         JANET_CORE_REG("os/posix-fork", os_posix_fork), | ||||
|         JANET_CORE_REG("os/posix-exec", os_posix_exec), | ||||
|         /* no need to sandbox process management if you can't create processes | ||||
|          * (allows for limited functionality if use exposes C-functions to create specific processes) */ | ||||
|         JANET_CORE_REG("os/proc-wait", os_proc_wait), | ||||
| @@ -2534,6 +2788,7 @@ void janet_lib_os(JanetTable *env) { | ||||
| #ifdef JANET_EV | ||||
|         JANET_CORE_REG("os/open", os_open), /* fs read and write */ | ||||
|         JANET_CORE_REG("os/pipe", os_pipe), | ||||
|         JANET_CORE_REG("os/sigaction", os_sigaction), | ||||
| #endif | ||||
| #endif | ||||
|         JANET_REG_END | ||||
|   | ||||
| @@ -259,6 +259,14 @@ static int checkescape(uint8_t c) { | ||||
|             return '\f'; | ||||
|         case 'v': | ||||
|             return '\v'; | ||||
|         case 'a': | ||||
|             return '\a'; | ||||
|         case 'b': | ||||
|             return '\b'; | ||||
|         case '\'': | ||||
|             return '\''; | ||||
|         case '?': | ||||
|             return '?'; | ||||
|         case 'e': | ||||
|             return 27; | ||||
|         case '"': | ||||
|   | ||||
							
								
								
									
										106
									
								
								src/core/peg.c
									
									
									
									
									
								
							
							
						
						
									
										106
									
								
								src/core/peg.c
									
									
									
									
									
								
							| @@ -39,6 +39,10 @@ | ||||
| typedef struct { | ||||
|     const uint8_t *text_start; | ||||
|     const uint8_t *text_end; | ||||
|     /* text_end can be restricted by some rules, but | ||||
|        outer_text_end will always contain the real end of | ||||
|        input, which we need to generate a line mapping */ | ||||
|     const uint8_t *outer_text_end; | ||||
|     const uint32_t *bytecode; | ||||
|     const Janet *constants; | ||||
|     JanetArray *captures; | ||||
| @@ -114,12 +118,12 @@ static LineCol get_linecol_from_position(PegState *s, int32_t position) { | ||||
|     /* Generate if not made yet */ | ||||
|     if (s->linemaplen < 0) { | ||||
|         int32_t newline_count = 0; | ||||
|         for (const uint8_t *c = s->text_start; c < s->text_end; c++) { | ||||
|         for (const uint8_t *c = s->text_start; c < s->outer_text_end; c++) { | ||||
|             if (*c == '\n') newline_count++; | ||||
|         } | ||||
|         int32_t *mem = janet_smalloc(sizeof(int32_t) * newline_count); | ||||
|         size_t index = 0; | ||||
|         for (const uint8_t *c = s->text_start; c < s->text_end; c++) { | ||||
|         for (const uint8_t *c = s->text_start; c < s->outer_text_end; c++) { | ||||
|             if (*c == '\n') mem[index++] = (int32_t)(c - s->text_start); | ||||
|         } | ||||
|         s->linemaplen = newline_count; | ||||
| @@ -179,7 +183,7 @@ static const uint8_t *peg_rule( | ||||
|     const uint32_t *rule, | ||||
|     const uint8_t *text) { | ||||
| tail: | ||||
|     switch (*rule & 0x1F) { | ||||
|     switch (*rule) { | ||||
|         default: | ||||
|             janet_panic("unexpected opcode"); | ||||
|             return NULL; | ||||
| @@ -482,6 +486,68 @@ tail: | ||||
|             return result; | ||||
|         } | ||||
|  | ||||
|         case RULE_SUB: { | ||||
|             const uint8_t *text_start = text; | ||||
|             const uint32_t *rule_window = s->bytecode + rule[1]; | ||||
|             const uint32_t *rule_subpattern = s->bytecode + rule[2]; | ||||
|             down1(s); | ||||
|             const uint8_t *window_end = peg_rule(s, rule_window, text); | ||||
|             up1(s); | ||||
|             if (!window_end) { | ||||
|                 return NULL; | ||||
|             } | ||||
|             const uint8_t *saved_end = s->text_end; | ||||
|             s->text_end = window_end; | ||||
|             down1(s); | ||||
|             const uint8_t *next_text = peg_rule(s, rule_subpattern, text_start); | ||||
|             up1(s); | ||||
|             s->text_end = saved_end; | ||||
|  | ||||
|             if (!next_text) { | ||||
|                 return NULL; | ||||
|             } | ||||
|  | ||||
|             return window_end; | ||||
|         } | ||||
|  | ||||
|         case RULE_SPLIT: { | ||||
|             const uint8_t *saved_end = s->text_end; | ||||
|             const uint32_t *rule_separator = s->bytecode + rule[1]; | ||||
|             const uint32_t *rule_subpattern = s->bytecode + rule[2]; | ||||
|  | ||||
|             const uint8_t *separator_end = NULL; | ||||
|             do { | ||||
|                 const uint8_t *text_start = text; | ||||
|                 CapState cs = cap_save(s); | ||||
|                 down1(s); | ||||
|                 while (text <= s->text_end) { | ||||
|                     separator_end = peg_rule(s, rule_separator, text); | ||||
|                     cap_load(s, cs); | ||||
|                     if (separator_end) { | ||||
|                         break; | ||||
|                     } | ||||
|                     text++; | ||||
|                 } | ||||
|                 up1(s); | ||||
|  | ||||
|                 if (separator_end) { | ||||
|                     s->text_end = text; | ||||
|                     text = separator_end; | ||||
|                 } | ||||
|  | ||||
|                 down1(s); | ||||
|                 const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, text_start); | ||||
|                 up1(s); | ||||
|                 s->text_end = saved_end; | ||||
|  | ||||
|                 if (!subpattern_end) { | ||||
|                     return NULL; | ||||
|                 } | ||||
|             } while (separator_end); | ||||
|  | ||||
|             return s->text_end; | ||||
|         } | ||||
|  | ||||
|         case RULE_REPLACE: | ||||
|         case RULE_MATCHTIME: { | ||||
|             uint32_t tag = rule[3]; | ||||
| @@ -1107,6 +1173,22 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) { | ||||
|     emit_3(r, RULE_MATCHTIME, subrule, cindex, tag); | ||||
| } | ||||
|  | ||||
| static void spec_sub(Builder *b, int32_t argc, const Janet *argv) { | ||||
|     peg_fixarity(b, argc, 2); | ||||
|     Reserve r = reserve(b, 3); | ||||
|     uint32_t subrule1 = peg_compile1(b, argv[0]); | ||||
|     uint32_t subrule2 = peg_compile1(b, argv[1]); | ||||
|     emit_2(r, RULE_SUB, subrule1, subrule2); | ||||
| } | ||||
|  | ||||
| static void spec_split(Builder *b, int32_t argc, const Janet *argv) { | ||||
|     peg_fixarity(b, argc, 2); | ||||
|     Reserve r = reserve(b, 3); | ||||
|     uint32_t subrule1 = peg_compile1(b, argv[0]); | ||||
|     uint32_t subrule2 = peg_compile1(b, argv[1]); | ||||
|     emit_2(r, RULE_SPLIT, subrule1, subrule2); | ||||
| } | ||||
|  | ||||
| #ifdef JANET_INT_TYPES | ||||
| #define JANET_MAX_READINT_WIDTH 8 | ||||
| #else | ||||
| @@ -1190,6 +1272,8 @@ static const SpecialPair peg_specials[] = { | ||||
|     {"sequence", spec_sequence}, | ||||
|     {"set", spec_set}, | ||||
|     {"some", spec_some}, | ||||
|     {"split", spec_split}, | ||||
|     {"sub", spec_sub}, | ||||
|     {"thru", spec_thru}, | ||||
|     {"to", spec_to}, | ||||
|     {"uint", spec_uint_le}, | ||||
| @@ -1431,7 +1515,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) { | ||||
|         uint32_t instr = bytecode[i]; | ||||
|         uint32_t *rule = bytecode + i; | ||||
|         op_flags[i] |= 0x02; | ||||
|         switch (instr & 0x1F) { | ||||
|         switch (instr) { | ||||
|             case RULE_LITERAL: | ||||
|                 i += 2 + ((rule[1] + 3) >> 2); | ||||
|                 break; | ||||
| @@ -1524,6 +1608,15 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) { | ||||
|                 op_flags[rule[1]] |= 0x01; | ||||
|                 i += 4; | ||||
|                 break; | ||||
|             case RULE_SUB: | ||||
|             case RULE_SPLIT: | ||||
|                 /* [rule, rule] */ | ||||
|                 if (rule[1] >= blen) goto bad; | ||||
|                 if (rule[2] >= blen) goto bad; | ||||
|                 op_flags[rule[1]] |= 0x01; | ||||
|                 op_flags[rule[2]] |= 0x01; | ||||
|                 i += 3; | ||||
|                 break; | ||||
|             case RULE_ERROR: | ||||
|             case RULE_DROP: | ||||
|             case RULE_NOT: | ||||
| @@ -1652,7 +1745,7 @@ typedef struct { | ||||
| static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) { | ||||
|     PegCall ret; | ||||
|     int32_t min = get_replace ? 3 : 2; | ||||
|     janet_arity(argc, get_replace, -1); | ||||
|     janet_arity(argc, min, -1); | ||||
|     if (janet_checktype(argv[0], JANET_ABSTRACT) && | ||||
|             janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) { | ||||
|         ret.peg = janet_unwrap_abstract(argv[0]); | ||||
| @@ -1677,6 +1770,7 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) { | ||||
|     ret.s.mode = PEG_MODE_NORMAL; | ||||
|     ret.s.text_start = ret.bytes.bytes; | ||||
|     ret.s.text_end = ret.bytes.bytes + ret.bytes.len; | ||||
|     ret.s.outer_text_end = ret.s.text_end; | ||||
|     ret.s.depth = JANET_RECURSION_GUARD; | ||||
|     ret.s.captures = janet_array(0); | ||||
|     ret.s.tagged_captures = janet_array(0); | ||||
| @@ -1771,7 +1865,7 @@ JANET_CORE_FN(cfun_peg_replace_all, | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_peg_replace, | ||||
|               "(peg/replace peg repl text &opt start & args)", | ||||
|               "(peg/replace peg subst text &opt start & args)", | ||||
|               "Replace first match of `peg` in `text` with `subst`, returning a new buffer. " | ||||
|               "The peg does not need to make captures to do replacement. " | ||||
|               "If `subst` is a function, it will be called with the " | ||||
|   | ||||
| @@ -31,6 +31,7 @@ | ||||
| #include <string.h> | ||||
| #include <ctype.h> | ||||
| #include <inttypes.h> | ||||
| #include <float.h> | ||||
|  | ||||
| /* Implements a pretty printer for Janet. The pretty printer | ||||
|  * is simple and not that flexible, but fast. */ | ||||
| @@ -38,11 +39,15 @@ | ||||
| /* Temporary buffer size */ | ||||
| #define BUFSIZE 64 | ||||
|  | ||||
| /* Preprocessor hacks */ | ||||
| #define STR_HELPER(x) #x | ||||
| #define STR(x) STR_HELPER(x) | ||||
|  | ||||
| static void number_to_string_b(JanetBuffer *buffer, double x) { | ||||
|     janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2); | ||||
|     const char *fmt = (x == floor(x) && | ||||
|                        x <= JANET_INTMAX_DOUBLE && | ||||
|                        x >= JANET_INTMIN_DOUBLE) ? "%.0f" : "%g"; | ||||
|                        x >= JANET_INTMIN_DOUBLE) ? "%.0f" : ("%." STR(DBL_DIG) "g"); | ||||
|     int count; | ||||
|     if (x == 0.0) { | ||||
|         /* Prevent printing of '-0' */ | ||||
| @@ -152,6 +157,12 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in | ||||
|             case '\v': | ||||
|                 janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2); | ||||
|                 break; | ||||
|             case '\a': | ||||
|                 janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2); | ||||
|                 break; | ||||
|             case '\b': | ||||
|                 janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2); | ||||
|                 break; | ||||
|             case 27: | ||||
|                 janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2); | ||||
|                 break; | ||||
| @@ -244,6 +255,10 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) { | ||||
|         case JANET_FUNCTION: { | ||||
|             JanetFunction *fun = janet_unwrap_function(x); | ||||
|             JanetFuncDef *def = fun->def; | ||||
|             if (def == NULL) { | ||||
|                 janet_buffer_push_cstring(buffer, "<incomplete function>"); | ||||
|                 break; | ||||
|             } | ||||
|             if (def->name) { | ||||
|                 const uint8_t *n = def->name; | ||||
|                 janet_buffer_push_cstring(buffer, "<function "); | ||||
| @@ -364,8 +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)); | ||||
|             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: | ||||
| @@ -762,6 +779,8 @@ struct FmtMapping { | ||||
| /* Janet uses fixed width integer types for most things, so map | ||||
|  * format specifiers to these fixed sizes */ | ||||
| static const struct FmtMapping format_mappings[] = { | ||||
|     {'D', PRId64}, | ||||
|     {'I', PRIi64}, | ||||
|     {'d', PRId64}, | ||||
|     {'i', PRIi64}, | ||||
|     {'o', PRIo64}, | ||||
| @@ -813,7 +832,7 @@ static const char *scanformat( | ||||
|         if (loc != NULL && *loc != '\0') { | ||||
|             const char *mapping = get_fmt_mapping(*p2++); | ||||
|             size_t len = strlen(mapping); | ||||
|             strcpy(form, mapping); | ||||
|             memcpy(form, mapping, len); | ||||
|             form += len; | ||||
|         } else { | ||||
|             *(form++) = *(p2++); | ||||
| @@ -840,13 +859,19 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) { | ||||
|             c = scanformat(c, form, width, precision); | ||||
|             switch (*c++) { | ||||
|                 case 'c': { | ||||
|                     int n = va_arg(args, long); | ||||
|                     int n = va_arg(args, int); | ||||
|                     nb = snprintf(item, MAX_ITEM, form, n); | ||||
|                     break; | ||||
|                 } | ||||
|                 case 'd': | ||||
|                 case 'i': { | ||||
|                     int64_t n = va_arg(args, int); | ||||
|                     int64_t n = (int64_t) va_arg(args, int32_t); | ||||
|                     nb = snprintf(item, MAX_ITEM, form, n); | ||||
|                     break; | ||||
|                 } | ||||
|                 case 'D': | ||||
|                 case 'I': { | ||||
|                     int64_t n = va_arg(args, int64_t); | ||||
|                     nb = snprintf(item, MAX_ITEM, form, n); | ||||
|                     break; | ||||
|                 } | ||||
| @@ -854,7 +879,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) { | ||||
|                 case 'X': | ||||
|                 case 'o': | ||||
|                 case 'u': { | ||||
|                     uint64_t n = va_arg(args, unsigned int); | ||||
|                     uint64_t n = va_arg(args, uint64_t); | ||||
|                     nb = snprintf(item, MAX_ITEM, form, n); | ||||
|                     break; | ||||
|                 } | ||||
| @@ -898,7 +923,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) { | ||||
|                     janet_buffer_push_cstring(b, typestr(va_arg(args, Janet))); | ||||
|                     break; | ||||
|                 case 'T': { | ||||
|                     int types = va_arg(args, long); | ||||
|                     int types = va_arg(args, int); | ||||
|                     pushtypes(b, types); | ||||
|                     break; | ||||
|                 } | ||||
| @@ -1007,6 +1032,8 @@ void janet_buffer_format( | ||||
|                                   janet_getinteger(argv, arg)); | ||||
|                     break; | ||||
|                 } | ||||
|                 case 'D': | ||||
|                 case 'I': | ||||
|                 case 'd': | ||||
|                 case 'i': { | ||||
|                     int64_t n = janet_getinteger64(argv, arg); | ||||
|   | ||||
| @@ -32,6 +32,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char | ||||
|     int errflags = 0, done = 0; | ||||
|     int32_t index = 0; | ||||
|     Janet ret = janet_wrap_nil(); | ||||
|     JanetFiber *fiber = NULL; | ||||
|     const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL; | ||||
|  | ||||
|     if (where) janet_gcroot(janet_wrap_string(where)); | ||||
| @@ -47,7 +48,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char | ||||
|             JanetCompileResult cres = janet_compile(form, env, where); | ||||
|             if (cres.status == JANET_COMPILE_OK) { | ||||
|                 JanetFunction *f = janet_thunk(cres.funcdef); | ||||
|                 JanetFiber *fiber = janet_fiber(f, 64, 0, NULL); | ||||
|                 fiber = janet_fiber(f, 64, 0, NULL); | ||||
|                 fiber->env = env; | ||||
|                 JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret); | ||||
|                 if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) { | ||||
| @@ -57,12 +58,20 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char | ||||
|                 } | ||||
|             } else { | ||||
|                 ret = janet_wrap_string(cres.error); | ||||
|                 int32_t line = (int32_t) parser.line; | ||||
|                 int32_t col = (int32_t) parser.column; | ||||
|                 if ((cres.error_mapping.line > 0) && | ||||
|                         (cres.error_mapping.column > 0)) { | ||||
|                     line = cres.error_mapping.line; | ||||
|                     col = cres.error_mapping.column; | ||||
|                 } | ||||
|                 if (cres.macrofiber) { | ||||
|                     janet_eprintf("compile error in %s: ", sourcePath); | ||||
|                     janet_eprintf("%s:%d:%d: compile error", sourcePath, | ||||
|                                   line, col); | ||||
|                     janet_stacktrace_ext(cres.macrofiber, ret, ""); | ||||
|                 } else { | ||||
|                     janet_eprintf("compile error in %s: %s\n", sourcePath, | ||||
|                                   (const char *)cres.error); | ||||
|                     janet_eprintf("%s:%d:%d: compile error: %s\n", sourcePath, | ||||
|                                   line, col, (const char *)cres.error); | ||||
|                 } | ||||
|                 errflags |= 0x02; | ||||
|                 done = 1; | ||||
| @@ -104,9 +113,14 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char | ||||
| #ifdef JANET_EV | ||||
|     /* Enter the event loop if we are not already in it */ | ||||
|     if (janet_vm.stackn == 0) { | ||||
|         janet_gcroot(ret); | ||||
|         if (fiber) { | ||||
|             janet_gcroot(janet_wrap_fiber(fiber)); | ||||
|         } | ||||
|         janet_loop(); | ||||
|         janet_gcunroot(ret); | ||||
|         if (fiber) { | ||||
|             janet_gcunroot(janet_wrap_fiber(fiber)); | ||||
|             ret = fiber->last_value; | ||||
|         } | ||||
|     } | ||||
| #endif | ||||
|     if (out) *out = ret; | ||||
|   | ||||
| @@ -149,7 +149,7 @@ static int destructure(JanetCompiler *c, | ||||
|                        JanetTable *attr) { | ||||
|     switch (janet_type(left)) { | ||||
|         default: | ||||
|             janetc_error(c, janet_formatc("unexpected type in destruction, got %v", left)); | ||||
|             janetc_error(c, janet_formatc("unexpected type in destructuring, got %v", left)); | ||||
|             return 1; | ||||
|         case JANET_SYMBOL: | ||||
|             /* Leaf, assign right to left */ | ||||
| @@ -357,7 +357,8 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt | ||||
|  | ||||
|     if (has_drop && can_destructure_lhs && rhs_is_indexed) { | ||||
|         /* Code is of the form (def [a b] [1 2]), avoid the allocation of two tuples */ | ||||
|         JanetView view_lhs, view_rhs; | ||||
|         JanetView view_lhs = {0}; | ||||
|         JanetView view_rhs = {0}; | ||||
|         janet_indexed_view(lhs, &view_lhs.items, &view_lhs.len); | ||||
|         janet_indexed_view(rhs, &view_rhs.items, &view_rhs.len); | ||||
|         int found_amp = 0; | ||||
| @@ -529,6 +530,26 @@ static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| /* Check if a form matches the pattern (= nil _) or (not= nil _) */ | ||||
| static int janetc_check_nil_form(Janet x, Janet *capture, uint32_t fun_tag) { | ||||
|     if (!janet_checktype(x, JANET_TUPLE)) return 0; | ||||
|     JanetTuple tup = janet_unwrap_tuple(x); | ||||
|     if (3 != janet_tuple_length(tup)) return 0; | ||||
|     Janet op1 = tup[0]; | ||||
|     if (!janet_checktype(op1, JANET_FUNCTION)) return 0; | ||||
|     JanetFunction *fun = janet_unwrap_function(op1); | ||||
|     uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG; | ||||
|     if (tag != fun_tag) return 0; | ||||
|     if (janet_checktype(tup[1], JANET_NIL)) { | ||||
|         *capture = tup[2]; | ||||
|         return 1; | ||||
|     } else if (janet_checktype(tup[2], JANET_NIL)) { | ||||
|         *capture = tup[1]; | ||||
|         return 1; | ||||
|     } | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| /* | ||||
|  * :condition | ||||
|  * ... | ||||
| @@ -549,6 +570,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|     JanetScope condscope, tempscope; | ||||
|     const int tail = opts.flags & JANET_FOPTS_TAIL; | ||||
|     const int drop = opts.flags & JANET_FOPTS_DROP; | ||||
|     uint8_t ifnjmp = JOP_JUMP_IF_NOT; | ||||
|  | ||||
|     if (argn < 2 || argn > 3) { | ||||
|         janetc_cerror(c, "expected 2 or 3 arguments to if"); | ||||
| @@ -571,12 +593,24 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|  | ||||
|     /* Compile condition */ | ||||
|     janetc_scope(&condscope, c, 0, "if"); | ||||
|     cond = janetc_value(condopts, argv[0]); | ||||
|  | ||||
|     Janet condform = argv[0]; | ||||
|     if (janetc_check_nil_form(condform, &condform, JANET_FUN_EQ)) { | ||||
|         ifnjmp = JOP_JUMP_IF_NOT_NIL; | ||||
|     } else if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) { | ||||
|         ifnjmp = JOP_JUMP_IF_NIL; | ||||
|     } | ||||
|  | ||||
|     cond = janetc_value(condopts, condform); | ||||
|  | ||||
|     /* Check constant condition. */ | ||||
|     /* TODO: Use type info for more short circuits */ | ||||
|     if (cond.flags & JANET_SLOT_CONSTANT) { | ||||
|         if (!janet_truthy(cond.constant)) { | ||||
|         int swap_condition = 0; | ||||
|         if (ifnjmp == JOP_JUMP_IF_NOT && !janet_truthy(cond.constant)) swap_condition = 1; | ||||
|         if (ifnjmp == JOP_JUMP_IF_NIL && janet_checktype(cond.constant, JANET_NIL)) swap_condition = 1; | ||||
|         if (ifnjmp == JOP_JUMP_IF_NOT_NIL && !janet_checktype(cond.constant, JANET_NIL)) swap_condition = 1; | ||||
|         if (swap_condition) { | ||||
|             /* Swap the true and false bodies */ | ||||
|             Janet temp = falsebody; | ||||
|             falsebody = truebody; | ||||
| @@ -594,7 +628,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|     } | ||||
|  | ||||
|     /* Compile jump to right */ | ||||
|     labeljr = janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0); | ||||
|     labeljr = janetc_emit_si(c, ifnjmp, cond, 0, 0); | ||||
|  | ||||
|     /* Condition left body */ | ||||
|     janetc_scope(&tempscope, c, 0, "if-true"); | ||||
| @@ -604,7 +638,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|  | ||||
|     /* Compile jump to done */ | ||||
|     labeljd = janet_v_count(c->buffer); | ||||
|     if (!tail) janetc_emit(c, JOP_JUMP); | ||||
|     if (!tail && !(drop && janet_checktype(falsebody, JANET_NIL))) janetc_emit(c, JOP_JUMP); | ||||
|  | ||||
|     /* Compile right body */ | ||||
|     labelr = janet_v_count(c->buffer); | ||||
| @@ -715,9 +749,8 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv) | ||||
|         if (!(scope->flags & JANET_SCOPE_WHILE) && argn) { | ||||
|             /* Closure body with return argument */ | ||||
|             subopts.flags |= JANET_FOPTS_TAIL; | ||||
|             JanetSlot ret = janetc_value(subopts, argv[0]); | ||||
|             ret.flags |= JANET_SLOT_RETURNED; | ||||
|             return ret; | ||||
|             janetc_value(subopts, argv[0]); | ||||
|             return janetc_cslot(janet_wrap_nil()); | ||||
|         } else { | ||||
|             /* while loop IIFE or no argument */ | ||||
|             if (argn) { | ||||
| @@ -725,9 +758,7 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv) | ||||
|                 janetc_value(subopts, argv[0]); | ||||
|             } | ||||
|             janetc_emit(c, JOP_RETURN_NIL); | ||||
|             JanetSlot s = janetc_cslot(janet_wrap_nil()); | ||||
|             s.flags |= JANET_SLOT_RETURNED; | ||||
|             return s; | ||||
|             return janetc_cslot(janet_wrap_nil()); | ||||
|         } | ||||
|     } else { | ||||
|         if (argn) { | ||||
| @@ -740,20 +771,6 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv) | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Check if a form matches the pattern (not= nil _) */ | ||||
| static int janetc_check_notnil_form(Janet x, Janet *capture) { | ||||
|     if (!janet_checktype(x, JANET_TUPLE)) return 0; | ||||
|     JanetTuple tup = janet_unwrap_tuple(x); | ||||
|     if (!janet_checktype(tup[0], JANET_FUNCTION)) return 0; | ||||
|     if (3 != janet_tuple_length(tup)) return 0; | ||||
|     JanetFunction *fun = janet_unwrap_function(tup[0]); | ||||
|     uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG; | ||||
|     if (tag != JANET_FUN_NEQ) return 0; | ||||
|     if (!janet_checktype(tup[1], JANET_NIL)) return 0; | ||||
|     *capture = tup[2]; | ||||
|     return 1; | ||||
| } | ||||
|  | ||||
| /* | ||||
|  * :whiletop | ||||
|  * ... | ||||
| @@ -770,6 +787,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv) | ||||
|     JanetScope tempscope; | ||||
|     int32_t labelwt, labeld, labeljt, labelc, i; | ||||
|     int infinite = 0; | ||||
|     int is_nil_form = 0; | ||||
|     int is_notnil_form = 0; | ||||
|     uint8_t ifjmp = JOP_JUMP_IF; | ||||
|     uint8_t ifnjmp = JOP_JUMP_IF_NOT; | ||||
| @@ -783,11 +801,16 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv) | ||||
|  | ||||
|     janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while"); | ||||
|  | ||||
|     /* Check for `(not= nil _)` in condition, and if so, use the | ||||
|     /* Check for `(= nil _)` or `(not= nil _)` in condition, and if so, use the | ||||
|      * jmpnl or jmpnn instructions. This let's us implement `(each ...)` | ||||
|      * more efficiently. */ | ||||
|     Janet condform = argv[0]; | ||||
|     if (janetc_check_notnil_form(condform, &condform)) { | ||||
|     if (janetc_check_nil_form(condform, &condform, JANET_FUN_EQ)) { | ||||
|         is_nil_form = 1; | ||||
|         ifjmp = JOP_JUMP_IF_NIL; | ||||
|         ifnjmp = JOP_JUMP_IF_NOT_NIL; | ||||
|     } | ||||
|     if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) { | ||||
|         is_notnil_form = 1; | ||||
|         ifjmp = JOP_JUMP_IF_NOT_NIL; | ||||
|         ifnjmp = JOP_JUMP_IF_NIL; | ||||
| @@ -799,7 +822,9 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv) | ||||
|     /* Check for constant condition */ | ||||
|     if (cond.flags & JANET_SLOT_CONSTANT) { | ||||
|         /* Loop never executes */ | ||||
|         int never_executes = is_notnil_form | ||||
|         int never_executes = is_nil_form | ||||
|                              ? !janet_checktype(cond.constant, JANET_NIL) | ||||
|                              : is_notnil_form | ||||
|                              ? janet_checktype(cond.constant, JANET_NIL) | ||||
|                              : !janet_truthy(cond.constant); | ||||
|         if (never_executes) { | ||||
| @@ -900,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; | ||||
| @@ -918,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)) { | ||||
| @@ -1078,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); | ||||
|  | ||||
|   | ||||
| @@ -24,6 +24,11 @@ | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "state.h" | ||||
| #include "util.h" | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_WINDOWS | ||||
| #include <windows.h> | ||||
| #endif | ||||
|  | ||||
| JANET_THREAD_LOCAL JanetVM janet_vm; | ||||
| @@ -57,5 +62,10 @@ void janet_vm_load(JanetVM *from) { | ||||
|  * use NULL to interrupt the current VM when convenient */ | ||||
| void janet_interpreter_interrupt(JanetVM *vm) { | ||||
|     vm = vm ? vm : &janet_vm; | ||||
|     vm->auto_suspend = 1; | ||||
|     janet_atomic_inc(&vm->auto_suspend); | ||||
| } | ||||
|  | ||||
| void janet_interpreter_interrupt_handled(JanetVM *vm) { | ||||
|     vm = vm ? vm : &janet_vm; | ||||
|     janet_atomic_dec(&vm->auto_suspend); | ||||
| } | ||||
|   | ||||
| @@ -89,7 +89,7 @@ struct JanetVM { | ||||
|  | ||||
|     /* If this flag is true, suspend on function calls and backwards jumps. | ||||
|      * When this occurs, this flag will be reset to 0. */ | ||||
|     int auto_suspend; | ||||
|     volatile JanetAtomicInt auto_suspend; | ||||
|  | ||||
|     /* The current running fiber on the current thread. | ||||
|      * Set and unset by functions in vm.c */ | ||||
| @@ -121,10 +121,12 @@ struct JanetVM { | ||||
|  | ||||
|     /* Garbage collection */ | ||||
|     void *blocks; | ||||
|     void *weak_blocks; | ||||
|     size_t gc_interval; | ||||
|     size_t next_collection; | ||||
|     size_t block_count; | ||||
|     int gc_suspend; | ||||
|     int gc_mark_phase; | ||||
|  | ||||
|     /* GC roots */ | ||||
|     Janet *roots; | ||||
| @@ -147,6 +149,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; | ||||
| @@ -154,12 +161,10 @@ struct JanetVM { | ||||
|     JanetQueue spawn; | ||||
|     JanetTimeout *tq; | ||||
|     JanetRNG ev_rng; | ||||
|     JanetListenerState **listeners; | ||||
|     size_t listener_count; | ||||
|     size_t listener_cap; | ||||
|     size_t extra_listeners; | ||||
|     volatile JanetAtomicInt listener_count; /* used in signal handler, must be volatile */ | ||||
|     JanetTable threaded_abstracts; /* All abstract types that can be shared between threads (used in this thread) */ | ||||
|     JanetTable active_tasks; /* All possibly live task fibers - used just for tracking */ | ||||
|     JanetTable signal_handlers; | ||||
| #ifdef JANET_WINDOWS | ||||
|     void **iocp; | ||||
| #elif defined(JANET_EV_EPOLL) | ||||
| @@ -175,6 +180,9 @@ struct JanetVM { | ||||
|     int timer; | ||||
|     int timer_enabled; | ||||
| #else | ||||
|     JanetStream **streams; | ||||
|     size_t stream_count; | ||||
|     size_t stream_capacity; | ||||
|     pthread_attr_t new_thread_attr; | ||||
|     JanetHandle selfpipe[2]; | ||||
|     struct pollfd *fds; | ||||
|   | ||||
| @@ -175,8 +175,9 @@ JANET_CORE_FN(cfun_string_slice, | ||||
|               "Returns a substring from a byte sequence. The substring is from " | ||||
|               "index `start` inclusive to index `end`, exclusive. All indexing " | ||||
|               "is from 0. `start` and `end` can also be negative to indicate indexing " | ||||
|               "from the end of the string. Note that index -1 is synonymous with " | ||||
|               "index `(length bytes)` to allow a full negative slice range. ") { | ||||
|               "from the end of the string. Note that if `start` is negative it is " | ||||
|               "exclusive, and if `end` is negative it is inclusive, to allow a full " | ||||
|               "negative slice range.") { | ||||
|     JanetByteView view = janet_getbytes(argv, 0); | ||||
|     JanetRange range = janet_getslice(argc, argv); | ||||
|     return janet_stringv(view.bytes + range.start, range.end - range.start); | ||||
| @@ -548,12 +549,12 @@ JANET_CORE_FN(cfun_string_format, | ||||
|               "- `a`, `A`: floating point number, formatted as a hexadecimal number.\n" | ||||
|               "- `s`: formatted as a string, precision indicates padding and maximum length.\n" | ||||
|               "- `t`: emit the type of the given value.\n" | ||||
|               "- `v`: format with (describe x)" | ||||
|               "- `V`: format with (string x)" | ||||
|               "- `v`: format with (describe x)\n" | ||||
|               "- `V`: format with (string x)\n" | ||||
|               "- `j`: format to jdn (Janet data notation).\n" | ||||
|               "\n" | ||||
|               "The following conversion specifiers are used for \"pretty-printing\", where the upper-case " | ||||
|               "variants generate colored output. These speficiers can take a precision " | ||||
|               "variants generate colored output. These specifiers can take a precision " | ||||
|               "argument to specify the maximum nesting depth to print.\n" | ||||
|               "- `p`, `P`: pretty format, truncating if necessary\n" | ||||
|               "- `m`, `M`: pretty format without truncating.\n" | ||||
|   | ||||
| @@ -490,3 +490,18 @@ int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out) { | ||||
| } | ||||
|  | ||||
| #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; | ||||
| } | ||||
|   | ||||
| @@ -234,6 +234,7 @@ const uint8_t *janet_symbol_gen(void) { | ||||
|     head->hash = hash; | ||||
|     sym = (uint8_t *)(head->data); | ||||
|     memcpy(sym, janet_vm.gensym_counter, sizeof(janet_vm.gensym_counter)); | ||||
|     sym[head->length] = 0; | ||||
|     janet_symcache_put((const uint8_t *)sym, bucket); | ||||
|     return (const uint8_t *)sym; | ||||
| } | ||||
|   | ||||
| @@ -87,11 +87,27 @@ void janet_table_deinit(JanetTable *table) { | ||||
| } | ||||
|  | ||||
| /* Create a new table */ | ||||
|  | ||||
| JanetTable *janet_table(int32_t capacity) { | ||||
|     JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable)); | ||||
|     return janet_table_init_impl(table, capacity, 0); | ||||
| } | ||||
|  | ||||
| JanetTable *janet_table_weakk(int32_t capacity) { | ||||
|     JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE_WEAKK, sizeof(JanetTable)); | ||||
|     return janet_table_init_impl(table, capacity, 0); | ||||
| } | ||||
|  | ||||
| JanetTable *janet_table_weakv(int32_t capacity) { | ||||
|     JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE_WEAKV, sizeof(JanetTable)); | ||||
|     return janet_table_init_impl(table, capacity, 0); | ||||
| } | ||||
|  | ||||
| JanetTable *janet_table_weakkv(int32_t capacity) { | ||||
|     JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE_WEAKKV, sizeof(JanetTable)); | ||||
|     return janet_table_init_impl(table, capacity, 0); | ||||
| } | ||||
|  | ||||
| /* Find the bucket that contains the given key. Will also return | ||||
|  * bucket where key should go if not in the table. */ | ||||
| JanetKV *janet_table_find(JanetTable *t, Janet key) { | ||||
| @@ -111,12 +127,11 @@ static void janet_table_rehash(JanetTable *t, int32_t size) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|     } | ||||
|     int32_t i, oldcapacity; | ||||
|     oldcapacity = t->capacity; | ||||
|     int32_t oldcapacity = t->capacity; | ||||
|     t->data = newdata; | ||||
|     t->capacity = size; | ||||
|     t->deleted = 0; | ||||
|     for (i = 0; i < oldcapacity; i++) { | ||||
|     for (int32_t i = 0; i < oldcapacity; i++) { | ||||
|         JanetKV *kv = olddata + i; | ||||
|         if (!janet_checktype(kv->key, JANET_NIL)) { | ||||
|             JanetKV *newkv = janet_table_find(t, kv->key); | ||||
| @@ -298,12 +313,40 @@ JANET_CORE_FN(cfun_table_new, | ||||
|               "Creates a new empty table with pre-allocated memory " | ||||
|               "for `capacity` entries. This means that if one knows the number of " | ||||
|               "entries going into a table on creation, extra memory allocation " | ||||
|               "can be avoided. Returns the new table.") { | ||||
|               "can be avoided. " | ||||
|               "Returns the new table.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     int32_t cap = janet_getnat(argv, 0); | ||||
|     return janet_wrap_table(janet_table(cap)); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_table_weak, | ||||
|               "(table/weak capacity)", | ||||
|               "Creates a new empty table with weak references to keys and values. Similar to `table/new`. " | ||||
|               "Returns the new table.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     int32_t cap = janet_getnat(argv, 0); | ||||
|     return janet_wrap_table(janet_table_weakkv(cap)); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_table_weak_keys, | ||||
|               "(table/weak-keys capacity)", | ||||
|               "Creates a new empty table with weak references to keys and normal references to values. Similar to `table/new`. " | ||||
|               "Returns the new table.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     int32_t cap = janet_getnat(argv, 0); | ||||
|     return janet_wrap_table(janet_table_weakk(cap)); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_table_weak_values, | ||||
|               "(table/weak-values capacity)", | ||||
|               "Creates a new empty table with normal references to keys and weak references to values. Similar to `table/new`. " | ||||
|               "Returns the new table.") { | ||||
|     janet_fixarity(argc, 1); | ||||
|     int32_t cap = janet_getnat(argv, 0); | ||||
|     return janet_wrap_table(janet_table_weakv(cap)); | ||||
| } | ||||
|  | ||||
| JANET_CORE_FN(cfun_table_getproto, | ||||
|               "(table/getproto tab)", | ||||
|               "Get the prototype table of a table. Returns nil if the table " | ||||
| @@ -377,6 +420,9 @@ JANET_CORE_FN(cfun_table_proto_flatten, | ||||
| void janet_lib_table(JanetTable *env) { | ||||
|     JanetRegExt table_cfuns[] = { | ||||
|         JANET_CORE_REG("table/new", cfun_table_new), | ||||
|         JANET_CORE_REG("table/weak", cfun_table_weak), | ||||
|         JANET_CORE_REG("table/weak-keys", cfun_table_weak_keys), | ||||
|         JANET_CORE_REG("table/weak-values", cfun_table_weak_values), | ||||
|         JANET_CORE_REG("table/to-struct", cfun_table_tostruct), | ||||
|         JANET_CORE_REG("table/getproto", cfun_table_getproto), | ||||
|         JANET_CORE_REG("table/setproto", cfun_table_setproto), | ||||
|   | ||||
| @@ -69,9 +69,9 @@ JANET_CORE_FN(cfun_tuple_slice, | ||||
|               "inclusive to index `end` exclusive. If `start` or `end` are not provided, " | ||||
|               "they default to 0 and the length of `arrtup`, respectively. " | ||||
|               "`start` and `end` can also be negative to indicate indexing " | ||||
|               "from the end of the input. Note that index -1 is synonymous with " | ||||
|               "index `(length arrtup)` to allow a full negative slice range. " | ||||
|               "Returns the new tuple.") { | ||||
|               "from the end of the input. Note that if `start` is negative it is " | ||||
|               "exclusive, and if `end` is negative it is inclusive, to allow a full " | ||||
|               "negative slice range. Returns the new tuple.") { | ||||
|     JanetView view = janet_getindexed(argv, 0); | ||||
|     JanetRange range = janet_getslice(argc, argv); | ||||
|     return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start)); | ||||
|   | ||||
| @@ -805,6 +805,13 @@ int janet_checkint(Janet x) { | ||||
|     return janet_checkintrange(dval); | ||||
| } | ||||
|  | ||||
| int janet_checkuint(Janet x) { | ||||
|     if (!janet_checktype(x, JANET_NUMBER)) | ||||
|         return 0; | ||||
|     double dval = janet_unwrap_number(x); | ||||
|     return janet_checkuintrange(dval); | ||||
| } | ||||
|  | ||||
| int janet_checkint64(Janet x) { | ||||
|     if (!janet_checktype(x, JANET_NUMBER)) | ||||
|         return 0; | ||||
| @@ -816,7 +823,21 @@ int janet_checkuint64(Janet x) { | ||||
|     if (!janet_checktype(x, JANET_NUMBER)) | ||||
|         return 0; | ||||
|     double dval = janet_unwrap_number(x); | ||||
|     return dval >= 0 && dval <= JANET_INTMAX_DOUBLE && dval == (uint64_t) dval; | ||||
|     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) { | ||||
| @@ -946,6 +967,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(_GNU_SOURCE) | ||||
|     /* 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) | ||||
| @@ -953,6 +988,7 @@ void arc4random_buf(void *buf, size_t nbytes); | ||||
| #endif | ||||
|  | ||||
| int janet_cryptorand(uint8_t *out, size_t n) { | ||||
| #ifndef JANET_NO_CRYPTORAND | ||||
| #ifdef JANET_WINDOWS | ||||
|     for (size_t i = 0; i < n; i += sizeof(unsigned int)) { | ||||
|         unsigned int v; | ||||
| @@ -964,7 +1000,10 @@ int janet_cryptorand(uint8_t *out, size_t n) { | ||||
|         } | ||||
|     } | ||||
|     return 0; | ||||
| #elif defined(JANET_LINUX) || defined(JANET_CYGWIN) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) ) | ||||
| #elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7) | ||||
|     arc4random_buf(out, n); | ||||
|     return 0; | ||||
| #else | ||||
|     /* We should be able to call getrandom on linux, but it doesn't seem | ||||
|        to be uniformly supported on linux distros. | ||||
|        On Mac, arc4random_buf wasn't available on until 10.7. | ||||
| @@ -986,12 +1025,10 @@ int janet_cryptorand(uint8_t *out, size_t n) { | ||||
|     } | ||||
|     RETRY_EINTR(rc, close(randfd)); | ||||
|     return 0; | ||||
| #elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7) | ||||
|     arc4random_buf(out, n); | ||||
|     return 0; | ||||
| #endif | ||||
| #else | ||||
|     (void) n; | ||||
|     (void) out; | ||||
|     (void) n; | ||||
|     return -1; | ||||
| #endif | ||||
| } | ||||
|   | ||||
| @@ -49,11 +49,11 @@ | ||||
| #ifndef JANET_EXIT | ||||
| #include <stdio.h> | ||||
| #define JANET_EXIT(m) do { \ | ||||
|     fprintf(stderr, "C runtime error at line %d in file %s: %s\n",\ | ||||
|     fprintf(stderr, "janet internal error at line %d in file %s: %s\n",\ | ||||
|         __LINE__,\ | ||||
|         __FILE__,\ | ||||
|         (m));\ | ||||
|     exit(1);\ | ||||
|     abort();\ | ||||
| } while (0) | ||||
| #endif | ||||
|  | ||||
| @@ -80,6 +80,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, | ||||
|   | ||||
| @@ -698,11 +698,16 @@ Janet janet_lengthv(Janet x) { | ||||
|             const JanetAbstractType *type = janet_abstract_type(abst); | ||||
|             if (type->length != NULL) { | ||||
|                 size_t len = type->length(abst, janet_abstract_size(abst)); | ||||
|                 if ((uint64_t) len <= (uint64_t) JANET_INTMAX_INT64) { | ||||
|                 /* If len is always less then double, we can never overflow */ | ||||
| #ifdef JANET_32 | ||||
|                 return janet_wrap_number(len); | ||||
| #else | ||||
|                 if (len < (size_t) JANET_INTMAX_INT64) { | ||||
|                     return janet_wrap_number((double) len); | ||||
|                 } else { | ||||
|                     janet_panicf("integer length %u too large", len); | ||||
|                 } | ||||
| #endif | ||||
|             } | ||||
|             Janet argv[1] = { x }; | ||||
|             return janet_mcall("length", 1, argv); | ||||
|   | ||||
							
								
								
									
										100
									
								
								src/core/vm.c
									
									
									
									
									
								
							
							
						
						
									
										100
									
								
								src/core/vm.c
									
									
									
									
									
								
							| @@ -116,7 +116,6 @@ | ||||
| #else | ||||
| #define vm_maybe_auto_suspend(COND) do { \ | ||||
|     if ((COND) && janet_vm.auto_suspend) { \ | ||||
|         janet_vm.auto_suspend = 0; \ | ||||
|         fiber->flags |= (JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP); \ | ||||
|         vm_return(JANET_SIGNAL_INTERRUPT, janet_wrap_nil()); \ | ||||
|     } \ | ||||
| @@ -138,7 +137,7 @@ | ||||
|             vm_pcnext();\ | ||||
|         }\ | ||||
|     } | ||||
| #define _vm_bitop_immediate(op, type1)\ | ||||
| #define _vm_bitop_immediate(op, type1, rangecheck, msg)\ | ||||
|     {\ | ||||
|         Janet op1 = stack[B];\ | ||||
|         if (!janet_checktype(op1, JANET_NUMBER)) {\ | ||||
| @@ -147,13 +146,15 @@ | ||||
|             stack[A] = janet_mcall(#op, 2, _argv);\ | ||||
|             vm_checkgc_pcnext();\ | ||||
|         } else {\ | ||||
|             type1 x1 = (type1) janet_unwrap_integer(op1);\ | ||||
|             stack[A] = janet_wrap_integer(x1 op CS);\ | ||||
|             double y1 = janet_unwrap_number(op1);\ | ||||
|             if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\ | ||||
|             type1 x1 = (type1) y1;\ | ||||
|             stack[A] = janet_wrap_number((type1) (x1 op CS));\ | ||||
|             vm_pcnext();\ | ||||
|         }\ | ||||
|     } | ||||
| #define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t); | ||||
| #define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t); | ||||
| #define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t, janet_checkintrange, "32-bit signed integers"); | ||||
| #define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers"); | ||||
| #define _vm_binop(op, wrap)\ | ||||
|     {\ | ||||
|         Janet op1 = stack[B];\ | ||||
| @@ -170,14 +171,18 @@ | ||||
|         }\ | ||||
|     } | ||||
| #define vm_binop(op) _vm_binop(op, janet_wrap_number) | ||||
| #define _vm_bitop(op, type1)\ | ||||
| #define _vm_bitop(op, type1, rangecheck, msg)\ | ||||
|     {\ | ||||
|         Janet op1 = stack[B];\ | ||||
|         Janet op2 = stack[C];\ | ||||
|         if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\ | ||||
|             type1 x1 = (type1) janet_unwrap_integer(op1);\ | ||||
|             int32_t x2 = janet_unwrap_integer(op2);\ | ||||
|             stack[A] = janet_wrap_integer(x1 op x2);\ | ||||
|             double y1 = janet_unwrap_number(op1);\ | ||||
|             double y2 = janet_unwrap_number(op2);\ | ||||
|             if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\ | ||||
|             if (!janet_checkintrange(y2)) { vm_commit(); janet_panicf("rhs must be valid 32-bit signed integer, got %f", op2); }\ | ||||
|             type1 x1 = (type1) y1;\ | ||||
|             int32_t x2 = (int32_t) y2;\ | ||||
|             stack[A] = janet_wrap_number((type1) (x1 op x2));\ | ||||
|             vm_pcnext();\ | ||||
|         } else {\ | ||||
|             vm_commit();\ | ||||
| @@ -185,8 +190,8 @@ | ||||
|             vm_checkgc_pcnext();\ | ||||
|         }\ | ||||
|     } | ||||
| #define vm_bitop(op) _vm_bitop(op, int32_t) | ||||
| #define vm_bitopu(op) _vm_bitop(op, uint32_t) | ||||
| #define vm_bitop(op) _vm_bitop(op, int32_t, janet_checkintrange, "32-bit signed integers") | ||||
| #define vm_bitopu(op) _vm_bitop(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers") | ||||
| #define vm_compop(op) \ | ||||
|     {\ | ||||
|         Janet op1 = stack[B];\ | ||||
| @@ -295,6 +300,16 @@ static Janet janet_method_lookup(Janet x, const char *name) { | ||||
|     return method_to_fun(janet_ckeywordv(name), x); | ||||
| } | ||||
|  | ||||
| static Janet janet_unary_call(const char *method, Janet arg) { | ||||
|     Janet m = janet_method_lookup(arg, method); | ||||
|     if (janet_checktype(m, JANET_NIL)) { | ||||
|         janet_panicf("could not find method :%s for %v", method, arg); | ||||
|     } else { | ||||
|         Janet argv[1] = { arg }; | ||||
|         return janet_method_invoke(m, 1, argv); | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Call a method first on the righthand side, and then on the left hand side with a prefix */ | ||||
| static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lhs, Janet rhs) { | ||||
|     Janet lm = janet_method_lookup(lhs, lmethod); | ||||
| @@ -303,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); | ||||
|         } | ||||
| @@ -331,11 +346,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { | ||||
|         &&label_JOP_RETURN_NIL, | ||||
|         &&label_JOP_ADD_IMMEDIATE, | ||||
|         &&label_JOP_ADD, | ||||
|         &&label_JOP_SUBTRACT_IMMEDIATE, | ||||
|         &&label_JOP_SUBTRACT, | ||||
|         &&label_JOP_MULTIPLY_IMMEDIATE, | ||||
|         &&label_JOP_MULTIPLY, | ||||
|         &&label_JOP_DIVIDE_IMMEDIATE, | ||||
|         &&label_JOP_DIVIDE, | ||||
|         &&label_JOP_DIVIDE_FLOOR, | ||||
|         &&label_JOP_MODULO, | ||||
|         &&label_JOP_REMAINDER, | ||||
|         &&label_JOP_BAND, | ||||
| @@ -576,8 +593,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { | ||||
|         &&label_unknown_op, | ||||
|         &&label_unknown_op, | ||||
|         &&label_unknown_op, | ||||
|         &&label_unknown_op, | ||||
|         &&label_unknown_op, | ||||
|         &&label_unknown_op | ||||
|     }; | ||||
| #endif | ||||
| @@ -667,6 +682,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { | ||||
|     VM_OP(JOP_ADD) | ||||
|     vm_binop(+); | ||||
|  | ||||
|     VM_OP(JOP_SUBTRACT_IMMEDIATE) | ||||
|     vm_binop_immediate(-); | ||||
|  | ||||
|     VM_OP(JOP_SUBTRACT) | ||||
|     vm_binop(-); | ||||
|  | ||||
| @@ -682,14 +700,33 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { | ||||
|     VM_OP(JOP_DIVIDE) | ||||
|     vm_binop( /); | ||||
|  | ||||
|     VM_OP(JOP_DIVIDE_FLOOR) { | ||||
|         Janet op1 = stack[B]; | ||||
|         Janet op2 = stack[C]; | ||||
|         if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) { | ||||
|             double x1 = janet_unwrap_number(op1); | ||||
|             double x2 = janet_unwrap_number(op2); | ||||
|             stack[A] = janet_wrap_number(floor(x1 / x2)); | ||||
|             vm_pcnext(); | ||||
|         } else { | ||||
|             vm_commit(); | ||||
|             stack[A] = janet_binop_call("div", "rdiv", op1, op2); | ||||
|             vm_checkgc_pcnext(); | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     VM_OP(JOP_MODULO) { | ||||
|         Janet op1 = stack[B]; | ||||
|         Janet op2 = stack[C]; | ||||
|         if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) { | ||||
|             double x1 = janet_unwrap_number(op1); | ||||
|             double x2 = janet_unwrap_number(op2); | ||||
|             double intres = x2 * floor(x1 / x2); | ||||
|             stack[A] = janet_wrap_number(x1 - intres); | ||||
|             if (x2 == 0) { | ||||
|                 stack[A] = janet_wrap_number(x1); | ||||
|             } else { | ||||
|                 double intres = x2 * floor(x1 / x2); | ||||
|                 stack[A] = janet_wrap_number(x1 - intres); | ||||
|             } | ||||
|             vm_pcnext(); | ||||
|         } else { | ||||
|             vm_commit(); | ||||
| @@ -724,9 +761,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { | ||||
|  | ||||
|     VM_OP(JOP_BNOT) { | ||||
|         Janet op = stack[E]; | ||||
|         vm_assert_type(op, JANET_NUMBER); | ||||
|         stack[A] = janet_wrap_integer(~janet_unwrap_integer(op)); | ||||
|         vm_pcnext(); | ||||
|         if (janet_checktype(op, JANET_NUMBER)) { | ||||
|             stack[A] = janet_wrap_integer(~janet_unwrap_integer(op)); | ||||
|             vm_pcnext(); | ||||
|         } else { | ||||
|             vm_commit(); | ||||
|             stack[A] = janet_unary_call("~", op); | ||||
|             vm_checkgc_pcnext(); | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     VM_OP(JOP_SHIFT_RIGHT_UNSIGNED) | ||||
| @@ -757,13 +799,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { | ||||
|  | ||||
|     VM_OP(JOP_JUMP) | ||||
|     pc += DS; | ||||
|     vm_maybe_auto_suspend(DS < 0); | ||||
|     vm_maybe_auto_suspend(DS <= 0); | ||||
|     vm_next(); | ||||
|  | ||||
|     VM_OP(JOP_JUMP_IF) | ||||
|     if (janet_truthy(stack[A])) { | ||||
|         pc += ES; | ||||
|         vm_maybe_auto_suspend(ES < 0); | ||||
|         vm_maybe_auto_suspend(ES <= 0); | ||||
|     } else { | ||||
|         pc++; | ||||
|     } | ||||
| @@ -774,14 +816,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { | ||||
|         pc++; | ||||
|     } else { | ||||
|         pc += ES; | ||||
|         vm_maybe_auto_suspend(ES < 0); | ||||
|         vm_maybe_auto_suspend(ES <= 0); | ||||
|     } | ||||
|     vm_next(); | ||||
|  | ||||
|     VM_OP(JOP_JUMP_IF_NIL) | ||||
|     if (janet_checktype(stack[A], JANET_NIL)) { | ||||
|         pc += ES; | ||||
|         vm_maybe_auto_suspend(ES < 0); | ||||
|         vm_maybe_auto_suspend(ES <= 0); | ||||
|     } else { | ||||
|         pc++; | ||||
|     } | ||||
| @@ -792,7 +834,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { | ||||
|         pc++; | ||||
|     } else { | ||||
|         pc += ES; | ||||
|         vm_maybe_auto_suspend(ES < 0); | ||||
|         vm_maybe_auto_suspend(ES <= 0); | ||||
|     } | ||||
|     vm_next(); | ||||
|  | ||||
| @@ -819,7 +861,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { | ||||
|     vm_pcnext(); | ||||
|  | ||||
|     VM_OP(JOP_EQUALS_IMMEDIATE) | ||||
|     stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) == (double) CS); | ||||
|     stack[A] = janet_wrap_boolean(janet_checktype(stack[B], JANET_NUMBER) && (janet_unwrap_number(stack[B]) == (double) CS)); | ||||
|     vm_pcnext(); | ||||
|  | ||||
|     VM_OP(JOP_NOT_EQUALS) | ||||
| @@ -827,7 +869,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { | ||||
|     vm_pcnext(); | ||||
|  | ||||
|     VM_OP(JOP_NOT_EQUALS_IMMEDIATE) | ||||
|     stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) != (double) CS); | ||||
|     stack[A] = janet_wrap_boolean(!janet_checktype(stack[B], JANET_NUMBER) || (janet_unwrap_number(stack[B]) != (double) CS)); | ||||
|     vm_pcnext(); | ||||
|  | ||||
|     VM_OP(JOP_COMPARE) | ||||
| @@ -980,7 +1022,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { | ||||
|             if (func->gc.flags & JANET_FUNCFLAG_TRACE) { | ||||
|                 vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart); | ||||
|             } | ||||
|             janet_stack_frame(stack)->pc = pc; | ||||
|             vm_commit(); | ||||
|             if (janet_fiber_funcframe(fiber, func)) { | ||||
|                 int32_t n = fiber->stacktop - fiber->stackstart; | ||||
|                 janet_panicf("%v called with %d argument%s, expected %d", | ||||
| @@ -1543,9 +1585,11 @@ int janet_init(void) { | ||||
|  | ||||
|     /* Garbage collection */ | ||||
|     janet_vm.blocks = NULL; | ||||
|     janet_vm.weak_blocks = NULL; | ||||
|     janet_vm.next_collection = 0; | ||||
|     janet_vm.gc_interval = 0x400000; | ||||
|     janet_vm.block_count = 0; | ||||
|     janet_vm.gc_mark_phase = 0; | ||||
|  | ||||
|     janet_symcache_init(); | ||||
|  | ||||
|   | ||||
| @@ -43,10 +43,10 @@ int (janet_truthy)(Janet x) { | ||||
|     return janet_truthy(x); | ||||
| } | ||||
|  | ||||
| const JanetKV *(janet_unwrap_struct)(Janet x) { | ||||
| JanetStruct(janet_unwrap_struct)(Janet x) { | ||||
|     return janet_unwrap_struct(x); | ||||
| } | ||||
| const Janet *(janet_unwrap_tuple)(Janet x) { | ||||
| JanetTuple(janet_unwrap_tuple)(Janet x) { | ||||
|     return janet_unwrap_tuple(x); | ||||
| } | ||||
| JanetFiber *(janet_unwrap_fiber)(Janet x) { | ||||
| @@ -61,16 +61,16 @@ JanetTable *(janet_unwrap_table)(Janet x) { | ||||
| JanetBuffer *(janet_unwrap_buffer)(Janet x) { | ||||
|     return janet_unwrap_buffer(x); | ||||
| } | ||||
| const uint8_t *(janet_unwrap_string)(Janet x) { | ||||
| JanetString(janet_unwrap_string)(Janet x) { | ||||
|     return janet_unwrap_string(x); | ||||
| } | ||||
| const uint8_t *(janet_unwrap_symbol)(Janet x) { | ||||
| JanetSymbol(janet_unwrap_symbol)(Janet x) { | ||||
|     return janet_unwrap_symbol(x); | ||||
| } | ||||
| const uint8_t *(janet_unwrap_keyword)(Janet x) { | ||||
| JanetKeyword(janet_unwrap_keyword)(Janet x) { | ||||
|     return janet_unwrap_keyword(x); | ||||
| } | ||||
| void *(janet_unwrap_abstract)(Janet x) { | ||||
| JanetAbstract(janet_unwrap_abstract)(Janet x) { | ||||
|     return janet_unwrap_abstract(x); | ||||
| } | ||||
| void *(janet_unwrap_pointer)(Janet x) { | ||||
| @@ -102,22 +102,22 @@ Janet(janet_wrap_false)(void) { | ||||
| Janet(janet_wrap_boolean)(int x) { | ||||
|     return janet_wrap_boolean(x); | ||||
| } | ||||
| Janet(janet_wrap_string)(const uint8_t *x) { | ||||
| Janet(janet_wrap_string)(JanetString x) { | ||||
|     return janet_wrap_string(x); | ||||
| } | ||||
| Janet(janet_wrap_symbol)(const uint8_t *x) { | ||||
| Janet(janet_wrap_symbol)(JanetSymbol x) { | ||||
|     return janet_wrap_symbol(x); | ||||
| } | ||||
| Janet(janet_wrap_keyword)(const uint8_t *x) { | ||||
| Janet(janet_wrap_keyword)(JanetKeyword x) { | ||||
|     return janet_wrap_keyword(x); | ||||
| } | ||||
| Janet(janet_wrap_array)(JanetArray *x) { | ||||
|     return janet_wrap_array(x); | ||||
| } | ||||
| Janet(janet_wrap_tuple)(const Janet *x) { | ||||
| Janet(janet_wrap_tuple)(JanetTuple x) { | ||||
|     return janet_wrap_tuple(x); | ||||
| } | ||||
| Janet(janet_wrap_struct)(const JanetKV *x) { | ||||
| Janet(janet_wrap_struct)(JanetStruct x) { | ||||
|     return janet_wrap_struct(x); | ||||
| } | ||||
| Janet(janet_wrap_fiber)(JanetFiber *x) { | ||||
| @@ -135,7 +135,7 @@ Janet(janet_wrap_cfunction)(JanetCFunction x) { | ||||
| Janet(janet_wrap_table)(JanetTable *x) { | ||||
|     return janet_wrap_table(x); | ||||
| } | ||||
| Janet(janet_wrap_abstract)(void *x) { | ||||
| Janet(janet_wrap_abstract)(JanetAbstract x) { | ||||
|     return janet_wrap_abstract(x); | ||||
| } | ||||
| Janet(janet_wrap_pointer)(void *x) { | ||||
| @@ -317,4 +317,3 @@ JANET_WRAP_DEFINE(pointer, void *, JANET_POINTER, pointer) | ||||
| #undef JANET_WRAP_DEFINE | ||||
|  | ||||
| #endif | ||||
|  | ||||
|   | ||||
| @@ -112,7 +112,8 @@ extern "C" { | ||||
|     || defined(__s390x__) /* S390 64-bit (BE) */ \ | ||||
|     || (defined(__ppc64__) || defined(__PPC64__)) \ | ||||
|     || defined(__aarch64__) /* ARM 64-bit */ \ | ||||
|     || (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */ | ||||
|     || (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */ \ | ||||
|     || defined(__loongarch64) /* LoongArch64 64-bit */ | ||||
| #define JANET_64 1 | ||||
| #else | ||||
| #define JANET_32 1 | ||||
| @@ -234,10 +235,28 @@ extern "C" { | ||||
| #define JANET_EV_KQUEUE | ||||
| #endif | ||||
|  | ||||
| /* Use poll as last resort */ | ||||
| #if !defined(JANET_WINDOWS) && !defined(JANET_EV_EPOLL) && !defined(JANET_EV_KQUEUE) | ||||
| #define JANET_EV_POLL | ||||
| #endif | ||||
|  | ||||
| /* How to export symbols */ | ||||
| #ifndef JANET_EXPORT | ||||
| #ifdef JANET_WINDOWS | ||||
| #define JANET_EXPORT __declspec(dllexport) | ||||
| #else | ||||
| #define JANET_EXPORT __attribute__((visibility ("default"))) | ||||
| #endif | ||||
| #endif | ||||
|  | ||||
| /* How declare API functions */ | ||||
| #ifndef JANET_API | ||||
| #ifdef JANET_WINDOWS | ||||
| #ifdef JANET_DLL_IMPORT | ||||
| #define JANET_API __declspec(dllimport) | ||||
| #else | ||||
| #define JANET_API __declspec(dllexport) | ||||
| #endif | ||||
| #else | ||||
| #define JANET_API __attribute__((visibility ("default"))) | ||||
| #endif | ||||
| @@ -393,12 +412,11 @@ typedef enum { | ||||
|     JANET_SIGNAL_USER6, | ||||
|     JANET_SIGNAL_USER7, | ||||
|     JANET_SIGNAL_USER8, | ||||
|     JANET_SIGNAL_USER9 | ||||
|     JANET_SIGNAL_USER9, | ||||
|     JANET_SIGNAL_INTERRUPT = JANET_SIGNAL_USER8, | ||||
|     JANET_SIGNAL_EVENT = JANET_SIGNAL_USER9, | ||||
| } JanetSignal; | ||||
|  | ||||
| #define JANET_SIGNAL_EVENT JANET_SIGNAL_USER9 | ||||
| #define JANET_SIGNAL_INTERRUPT JANET_SIGNAL_USER8 | ||||
|  | ||||
| /* Fiber statuses - mostly corresponds to signals. */ | ||||
| typedef enum { | ||||
|     JANET_STATUS_DEAD, | ||||
| @@ -562,7 +580,7 @@ typedef void *JanetAbstract; | ||||
|  | ||||
| #define JANET_STREAM_CLOSED 0x1 | ||||
| #define JANET_STREAM_SOCKET 0x2 | ||||
| #define JANET_STREAM_IOCP 0x4 | ||||
| #define JANET_STREAM_UNREGISTERED 0x4 | ||||
| #define JANET_STREAM_READABLE 0x200 | ||||
| #define JANET_STREAM_WRITABLE 0x400 | ||||
| #define JANET_STREAM_ACCEPTABLE 0x800 | ||||
| @@ -570,62 +588,73 @@ typedef void *JanetAbstract; | ||||
| #define JANET_STREAM_TOCLOSE 0x10000 | ||||
|  | ||||
| typedef enum { | ||||
|     JANET_ASYNC_EVENT_INIT, | ||||
|     JANET_ASYNC_EVENT_MARK, | ||||
|     JANET_ASYNC_EVENT_DEINIT, | ||||
|     JANET_ASYNC_EVENT_CLOSE, | ||||
|     JANET_ASYNC_EVENT_ERR, | ||||
|     JANET_ASYNC_EVENT_HUP, | ||||
|     JANET_ASYNC_EVENT_READ, | ||||
|     JANET_ASYNC_EVENT_WRITE, | ||||
|     JANET_ASYNC_EVENT_CANCEL, | ||||
|     JANET_ASYNC_EVENT_COMPLETE, /* Used on windows for IOCP */ | ||||
|     JANET_ASYNC_EVENT_USER | ||||
|     JANET_ASYNC_EVENT_INIT = 0, | ||||
|     JANET_ASYNC_EVENT_MARK = 1, | ||||
|     JANET_ASYNC_EVENT_DEINIT = 2, | ||||
|     JANET_ASYNC_EVENT_CLOSE = 3, | ||||
|     JANET_ASYNC_EVENT_ERR = 4, | ||||
|     JANET_ASYNC_EVENT_HUP = 5, | ||||
|     JANET_ASYNC_EVENT_READ = 6, | ||||
|     JANET_ASYNC_EVENT_WRITE = 7, | ||||
|     JANET_ASYNC_EVENT_COMPLETE = 8, /* Used on windows for IOCP */ | ||||
|     JANET_ASYNC_EVENT_FAILED = 9 /* Used on windows for IOCP */ | ||||
| } JanetAsyncEvent; | ||||
|  | ||||
| #define JANET_ASYNC_LISTEN_READ (1 << JANET_ASYNC_EVENT_READ) | ||||
| #define JANET_ASYNC_LISTEN_WRITE (1 << JANET_ASYNC_EVENT_WRITE) | ||||
|  | ||||
| typedef enum { | ||||
|     JANET_ASYNC_STATUS_NOT_DONE, | ||||
|     JANET_ASYNC_STATUS_DONE | ||||
| } JanetAsyncStatus; | ||||
|     JANET_ASYNC_LISTEN_READ = 1, | ||||
|     JANET_ASYNC_LISTEN_WRITE, | ||||
|     JANET_ASYNC_LISTEN_BOTH | ||||
| } JanetAsyncMode; | ||||
|  | ||||
| /* Typedefs */ | ||||
| typedef struct JanetListenerState JanetListenerState; | ||||
| typedef struct JanetStream JanetStream; | ||||
| typedef JanetAsyncStatus(*JanetListener)(JanetListenerState *state, JanetAsyncEvent event); | ||||
|  | ||||
| /* Wrapper around file descriptors and HANDLEs that can be polled. */ | ||||
| struct JanetStream { | ||||
|     JanetHandle handle; | ||||
|     uint32_t flags; | ||||
|     /* Linked list of all in-flight IO routines for this stream */ | ||||
|     JanetListenerState *state; | ||||
|     uint32_t index; | ||||
|     JanetFiber *read_fiber; | ||||
|     JanetFiber *write_fiber; | ||||
|     const void *methods; /* Methods for this stream */ | ||||
|     /* internal - used to disallow multiple concurrent reads / writes on the same stream. | ||||
|      * this constraint may be lifted later but allowing such would require more internal book keeping | ||||
|      * for some implementations. You can read and write at the same time on the same stream, though. */ | ||||
|     int _mask; | ||||
| }; | ||||
|  | ||||
| /* Interface for state machine based event loop */ | ||||
| struct JanetListenerState { | ||||
|     JanetListener machine; | ||||
|     JanetFiber *fiber; | ||||
|     JanetStream *stream; | ||||
|     void *event; /* Used to pass data from asynchronous IO event. Contents depend on both | ||||
|                     implementation of the event loop and the particular event. */ | ||||
| typedef void (*JanetEVCallback)(JanetFiber *fiber, JanetAsyncEvent event); | ||||
|  | ||||
| /* Start listening for events from a stream on the current root fiber. After | ||||
|  * calling this, users should call janet_await() before returning from the | ||||
|  * current C Function. This also will call janet_await. | ||||
|  * mode is which events to listen for, and callback is the function pointer to | ||||
|  * 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. */ | ||||
| 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 | ||||
|  * or canceled. */ | ||||
| JANET_API void janet_async_end(JanetFiber *fiber); | ||||
|  | ||||
| /* Needed for windows to mark a fiber as waiting for an IOCP completion event. Noop on other platforms. */ | ||||
| JANET_API void janet_async_in_flight(JanetFiber *fiber); | ||||
|  | ||||
| /* On some platforms, it is important to be able to control if a stream is edge-trigger or level triggered. | ||||
|  * For example, a server that is accepting connections might want to be level triggered or edge-triggered | ||||
|  * depending on expected service. */ | ||||
| JANET_API void janet_stream_edge_triggered(JanetStream *stream); | ||||
| JANET_API void janet_stream_level_triggered(JanetStream *stream); | ||||
|  | ||||
| #endif | ||||
|  | ||||
| /* Janet uses atomic integers in several places for synchronization between threads and | ||||
|  * signals. Define them here */ | ||||
| #ifdef JANET_WINDOWS | ||||
|     void *tag; /* Used to associate listeners with an overlapped structure */ | ||||
|     int bytes; /* Used to track how many bytes were transfered. */ | ||||
| #endif | ||||
|     /* internal */ | ||||
|     size_t _index; | ||||
|     int _mask; | ||||
|     JanetListenerState *_next; | ||||
| }; | ||||
| typedef long JanetAtomicInt; | ||||
| #else | ||||
| typedef int32_t JanetAtomicInt; | ||||
| #endif | ||||
| JANET_API JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x); | ||||
| JANET_API JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x); | ||||
| JANET_API JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x); | ||||
|  | ||||
| /* We provide three possible implementations of Janets. The preferred | ||||
|  * nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the | ||||
| @@ -653,10 +682,10 @@ struct JanetListenerState { | ||||
|  * external bindings, we should prefer using the Head structs directly, and | ||||
|  * use the host language to add sugar around the manipulation of the Janet types. */ | ||||
|  | ||||
| JANET_API JanetStructHead *janet_struct_head(const JanetKV *st); | ||||
| JANET_API JanetStructHead *janet_struct_head(JanetStruct st); | ||||
| JANET_API JanetAbstractHead *janet_abstract_head(const void *abstract); | ||||
| JANET_API JanetStringHead *janet_string_head(const uint8_t *s); | ||||
| JANET_API JanetTupleHead *janet_tuple_head(const Janet *tuple); | ||||
| JANET_API JanetStringHead *janet_string_head(JanetString s); | ||||
| JANET_API JanetTupleHead *janet_tuple_head(JanetTuple tuple); | ||||
|  | ||||
| /* Some language bindings won't have access to the macro versions. */ | ||||
|  | ||||
| @@ -665,16 +694,16 @@ JANET_API int janet_checktype(Janet x, JanetType type); | ||||
| JANET_API int janet_checktypes(Janet x, int typeflags); | ||||
| JANET_API int janet_truthy(Janet x); | ||||
|  | ||||
| JANET_API const JanetKV *janet_unwrap_struct(Janet x); | ||||
| JANET_API const Janet *janet_unwrap_tuple(Janet x); | ||||
| JANET_API JanetStruct janet_unwrap_struct(Janet x); | ||||
| JANET_API JanetTuple janet_unwrap_tuple(Janet x); | ||||
| JANET_API JanetFiber *janet_unwrap_fiber(Janet x); | ||||
| JANET_API JanetArray *janet_unwrap_array(Janet x); | ||||
| JANET_API JanetTable *janet_unwrap_table(Janet x); | ||||
| JANET_API JanetBuffer *janet_unwrap_buffer(Janet x); | ||||
| JANET_API const uint8_t *janet_unwrap_string(Janet x); | ||||
| JANET_API const uint8_t *janet_unwrap_symbol(Janet x); | ||||
| JANET_API const uint8_t *janet_unwrap_keyword(Janet x); | ||||
| JANET_API void *janet_unwrap_abstract(Janet x); | ||||
| JANET_API JanetString janet_unwrap_string(Janet x); | ||||
| JANET_API JanetSymbol janet_unwrap_symbol(Janet x); | ||||
| JANET_API JanetKeyword janet_unwrap_keyword(Janet x); | ||||
| JANET_API JanetAbstract janet_unwrap_abstract(Janet x); | ||||
| JANET_API void *janet_unwrap_pointer(Janet x); | ||||
| JANET_API JanetFunction *janet_unwrap_function(Janet x); | ||||
| JANET_API JanetCFunction janet_unwrap_cfunction(Janet x); | ||||
| @@ -687,18 +716,18 @@ JANET_API Janet janet_wrap_number(double x); | ||||
| JANET_API Janet janet_wrap_true(void); | ||||
| JANET_API Janet janet_wrap_false(void); | ||||
| JANET_API Janet janet_wrap_boolean(int x); | ||||
| JANET_API Janet janet_wrap_string(const uint8_t *x); | ||||
| JANET_API Janet janet_wrap_symbol(const uint8_t *x); | ||||
| JANET_API Janet janet_wrap_keyword(const uint8_t *x); | ||||
| JANET_API Janet janet_wrap_string(JanetString x); | ||||
| JANET_API Janet janet_wrap_symbol(JanetSymbol x); | ||||
| JANET_API Janet janet_wrap_keyword(JanetKeyword x); | ||||
| JANET_API Janet janet_wrap_array(JanetArray *x); | ||||
| JANET_API Janet janet_wrap_tuple(const Janet *x); | ||||
| JANET_API Janet janet_wrap_struct(const JanetKV *x); | ||||
| JANET_API Janet janet_wrap_tuple(JanetTuple x); | ||||
| JANET_API Janet janet_wrap_struct(JanetStruct x); | ||||
| JANET_API Janet janet_wrap_fiber(JanetFiber *x); | ||||
| JANET_API Janet janet_wrap_buffer(JanetBuffer *x); | ||||
| JANET_API Janet janet_wrap_function(JanetFunction *x); | ||||
| JANET_API Janet janet_wrap_cfunction(JanetCFunction x); | ||||
| JANET_API Janet janet_wrap_table(JanetTable *x); | ||||
| JANET_API Janet janet_wrap_abstract(void *x); | ||||
| JANET_API Janet janet_wrap_abstract(JanetAbstract x); | ||||
| JANET_API Janet janet_wrap_pointer(void *x); | ||||
| JANET_API Janet janet_wrap_integer(int32_t x); | ||||
|  | ||||
| @@ -730,6 +759,7 @@ JANET_API Janet janet_wrap_integer(int32_t x); | ||||
|         ? janet_nanbox_isnumber(x) \ | ||||
|         : janet_nanbox_checkauxtype((x), (t))) | ||||
|  | ||||
| /* Use JANET_API so that modules will use a local version of these functions if possible */ | ||||
| JANET_API void *janet_nanbox_to_pointer(Janet x); | ||||
| JANET_API Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask); | ||||
| JANET_API Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask); | ||||
| @@ -776,14 +806,14 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits); | ||||
| #define janet_wrap_pointer(s) janet_nanbox_wrap_((s), JANET_POINTER) | ||||
|  | ||||
| /* Unwrap the pointer types */ | ||||
| #define janet_unwrap_struct(x) ((const JanetKV *)janet_nanbox_to_pointer(x)) | ||||
| #define janet_unwrap_tuple(x) ((const Janet *)janet_nanbox_to_pointer(x)) | ||||
| #define janet_unwrap_struct(x) ((JanetStruct)janet_nanbox_to_pointer(x)) | ||||
| #define janet_unwrap_tuple(x) ((JanetTuple)janet_nanbox_to_pointer(x)) | ||||
| #define janet_unwrap_fiber(x) ((JanetFiber *)janet_nanbox_to_pointer(x)) | ||||
| #define janet_unwrap_array(x) ((JanetArray *)janet_nanbox_to_pointer(x)) | ||||
| #define janet_unwrap_table(x) ((JanetTable *)janet_nanbox_to_pointer(x)) | ||||
| #define janet_unwrap_buffer(x) ((JanetBuffer *)janet_nanbox_to_pointer(x)) | ||||
| #define janet_unwrap_string(x) ((const uint8_t *)janet_nanbox_to_pointer(x)) | ||||
| #define janet_unwrap_symbol(x) ((const uint8_t *)janet_nanbox_to_pointer(x)) | ||||
| #define janet_unwrap_string(x) ((JanetString)janet_nanbox_to_pointer(x)) | ||||
| #define janet_unwrap_symbol(x) ((JanetSymbol)janet_nanbox_to_pointer(x)) | ||||
| #define janet_unwrap_keyword(x) ((const uint8_t *)janet_nanbox_to_pointer(x)) | ||||
| #define janet_unwrap_abstract(x) (janet_nanbox_to_pointer(x)) | ||||
| #define janet_unwrap_pointer(x) (janet_nanbox_to_pointer(x)) | ||||
| @@ -825,15 +855,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer); | ||||
| #define janet_wrap_cfunction(s) janet_nanbox32_from_tagp(JANET_CFUNCTION, (void *)(s)) | ||||
| #define janet_wrap_pointer(s) janet_nanbox32_from_tagp(JANET_POINTER, (void *)(s)) | ||||
|  | ||||
| #define janet_unwrap_struct(x) ((const JanetKV *)(x).tagged.payload.pointer) | ||||
| #define janet_unwrap_tuple(x) ((const Janet *)(x).tagged.payload.pointer) | ||||
| #define janet_unwrap_struct(x) ((JanetStruct)(x).tagged.payload.pointer) | ||||
| #define janet_unwrap_tuple(x) ((JanetTuple)(x).tagged.payload.pointer) | ||||
| #define janet_unwrap_fiber(x) ((JanetFiber *)(x).tagged.payload.pointer) | ||||
| #define janet_unwrap_array(x) ((JanetArray *)(x).tagged.payload.pointer) | ||||
| #define janet_unwrap_table(x) ((JanetTable *)(x).tagged.payload.pointer) | ||||
| #define janet_unwrap_buffer(x) ((JanetBuffer *)(x).tagged.payload.pointer) | ||||
| #define janet_unwrap_string(x) ((const uint8_t *)(x).tagged.payload.pointer) | ||||
| #define janet_unwrap_symbol(x) ((const uint8_t *)(x).tagged.payload.pointer) | ||||
| #define janet_unwrap_keyword(x) ((const uint8_t *)(x).tagged.payload.pointer) | ||||
| #define janet_unwrap_string(x) ((JanetString)(x).tagged.payload.pointer) | ||||
| #define janet_unwrap_symbol(x) ((JanetSymbol)(x).tagged.payload.pointer) | ||||
| #define janet_unwrap_keyword(x) ((JanetKeyword)(x).tagged.payload.pointer) | ||||
| #define janet_unwrap_abstract(x) ((x).tagged.payload.pointer) | ||||
| #define janet_unwrap_pointer(x) ((x).tagged.payload.pointer) | ||||
| #define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer) | ||||
| @@ -848,15 +878,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer); | ||||
| #define janet_truthy(x) \ | ||||
|     ((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.u64 & 0x1))) | ||||
|  | ||||
| #define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer) | ||||
| #define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer) | ||||
| #define janet_unwrap_struct(x) ((JanetStruct)(x).as.pointer) | ||||
| #define janet_unwrap_tuple(x) ((JanetTuple)(x).as.pointer) | ||||
| #define janet_unwrap_fiber(x) ((JanetFiber *)(x).as.pointer) | ||||
| #define janet_unwrap_array(x) ((JanetArray *)(x).as.pointer) | ||||
| #define janet_unwrap_table(x) ((JanetTable *)(x).as.pointer) | ||||
| #define janet_unwrap_buffer(x) ((JanetBuffer *)(x).as.pointer) | ||||
| #define janet_unwrap_string(x) ((const uint8_t *)(x).as.pointer) | ||||
| #define janet_unwrap_symbol(x) ((const uint8_t *)(x).as.pointer) | ||||
| #define janet_unwrap_keyword(x) ((const uint8_t *)(x).as.pointer) | ||||
| #define janet_unwrap_string(x) ((JanetString)(x).as.pointer) | ||||
| #define janet_unwrap_symbol(x) ((JanetSymbol)(x).as.pointer) | ||||
| #define janet_unwrap_keyword(x) ((JanetKeyword)(x).as.pointer) | ||||
| #define janet_unwrap_abstract(x) ((x).as.pointer) | ||||
| #define janet_unwrap_pointer(x) ((x).as.pointer) | ||||
| #define janet_unwrap_function(x) ((JanetFunction *)(x).as.pointer) | ||||
| @@ -867,13 +897,20 @@ 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)) | ||||
| #define janet_checkuint64range(x) ((x) >= 0 && (x) <= JANET_INTMAX_DOUBLE && (x) == (uint64_t)(x)) | ||||
| #define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x)) | ||||
| #define janet_wrap_integer(x) janet_wrap_number((int32_t)(x)) | ||||
|  | ||||
| @@ -886,7 +923,7 @@ struct JanetGCObject { | ||||
|     int32_t flags; | ||||
|     union { | ||||
|         JanetGCObject *next; | ||||
|         int32_t refcount; /* For threaded abstract types */ | ||||
|         volatile JanetAtomicInt refcount; /* For threaded abstract types */ | ||||
|     } data; | ||||
| }; | ||||
|  | ||||
| @@ -909,8 +946,10 @@ struct JanetFiber { | ||||
|      * that is, fibers that are scheduled on the event loop and behave much like threads | ||||
|      * in a multi-tasking system. It would be possible to move these fields to a new | ||||
|      * type, say "JanetTask", that as separate from fibers to save a bit of space. */ | ||||
|     JanetListenerState *waiting; | ||||
|     uint32_t sched_id; /* Increment everytime fiber is scheduled by event loop */ | ||||
|     JanetEVCallback ev_callback; /* Call this before starting scheduled fibers */ | ||||
|     JanetStream *ev_stream; /* which stream we are waiting on */ | ||||
|     void *ev_state; /* Extra data for ev callback state. On windows, first element must be OVERLAPPED. */ | ||||
|     void *supervisor_channel; /* Channel to push self to when complete */ | ||||
| #endif | ||||
| }; | ||||
| @@ -1259,11 +1298,13 @@ enum JanetOpCode { | ||||
|     JOP_RETURN_NIL, | ||||
|     JOP_ADD_IMMEDIATE, | ||||
|     JOP_ADD, | ||||
|     JOP_SUBTRACT_IMMEDIATE, | ||||
|     JOP_SUBTRACT, | ||||
|     JOP_MULTIPLY_IMMEDIATE, | ||||
|     JOP_MULTIPLY, | ||||
|     JOP_DIVIDE_IMMEDIATE, | ||||
|     JOP_DIVIDE, | ||||
|     JOP_DIVIDE_FLOOR, | ||||
|     JOP_MODULO, | ||||
|     JOP_REMAINDER, | ||||
|     JOP_BAND, | ||||
| @@ -1383,9 +1424,7 @@ JANET_API void janet_stream_flags(JanetStream *stream, uint32_t flags); | ||||
| JANET_API void janet_schedule(JanetFiber *fiber, Janet value); | ||||
| JANET_API void janet_cancel(JanetFiber *fiber, Janet value); | ||||
| JANET_API void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig); | ||||
|  | ||||
| /* Start a state machine listening for events from a stream */ | ||||
| JANET_API JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user); | ||||
| JANET_API void janet_schedule_soon(JanetFiber *fiber, Janet value, JanetSignal sig); | ||||
|  | ||||
| /* Shorthand for yielding to event loop in C */ | ||||
| JANET_NO_RETURN JANET_API void janet_await(void); | ||||
| @@ -1473,23 +1512,22 @@ JANET_API void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGeneric | ||||
| JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value); | ||||
|  | ||||
| /* Read async from a stream */ | ||||
| JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes); | ||||
| JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes); | ||||
| JANET_NO_RETURN JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes); | ||||
| JANET_NO_RETURN JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes); | ||||
| #ifdef JANET_NET | ||||
| JANET_API void janet_ev_recv(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags); | ||||
| JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags); | ||||
| JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags); | ||||
| JANET_API void janet_ev_connect(JanetStream *stream, int flags); | ||||
| JANET_NO_RETURN JANET_API void janet_ev_recv(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags); | ||||
| JANET_NO_RETURN JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags); | ||||
| JANET_NO_RETURN JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags); | ||||
| #endif | ||||
|  | ||||
| /* Write async to a stream */ | ||||
| JANET_API void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf); | ||||
| JANET_API void janet_ev_write_string(JanetStream *stream, JanetString str); | ||||
| JANET_NO_RETURN JANET_API void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf); | ||||
| JANET_NO_RETURN JANET_API void janet_ev_write_string(JanetStream *stream, JanetString str); | ||||
| #ifdef JANET_NET | ||||
| JANET_API void janet_ev_send_buffer(JanetStream *stream, JanetBuffer *buf, int flags); | ||||
| JANET_API void janet_ev_send_string(JanetStream *stream, JanetString str, int flags); | ||||
| JANET_API void janet_ev_sendto_buffer(JanetStream *stream, JanetBuffer *buf, void *dest, int flags); | ||||
| JANET_API void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, int flags); | ||||
| JANET_NO_RETURN JANET_API void janet_ev_send_buffer(JanetStream *stream, JanetBuffer *buf, int flags); | ||||
| JANET_NO_RETURN JANET_API void janet_ev_send_string(JanetStream *stream, JanetString str, int flags); | ||||
| JANET_NO_RETURN JANET_API void janet_ev_sendto_buffer(JanetStream *stream, JanetBuffer *buf, void *dest, int flags); | ||||
| JANET_NO_RETURN JANET_API void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, int flags); | ||||
| #endif | ||||
|  | ||||
| #endif | ||||
| @@ -1578,6 +1616,7 @@ JANET_API double janet_rng_double(JanetRNG *rng); | ||||
|  | ||||
| /* Array functions */ | ||||
| JANET_API JanetArray *janet_array(int32_t capacity); | ||||
| JANET_API JanetArray *janet_array_weak(int32_t capacity); | ||||
| JANET_API JanetArray *janet_array_n(const Janet *elements, int32_t n); | ||||
| JANET_API void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth); | ||||
| JANET_API void janet_array_setcount(JanetArray *array, int32_t count); | ||||
| @@ -1607,7 +1646,7 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x); | ||||
| #define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000 | ||||
|  | ||||
| #define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data))) | ||||
| #define janet_tuple_from_head(gcobject) ((const Janet *)((char *)gcobject + offsetof(JanetTupleHead, data))) | ||||
| #define janet_tuple_from_head(gcobject) ((JanetTuple)((char *)gcobject + offsetof(JanetTupleHead, data))) | ||||
| #define janet_tuple_length(t) (janet_tuple_head(t)->length) | ||||
| #define janet_tuple_hash(t) (janet_tuple_head(t)->hash) | ||||
| #define janet_tuple_sm_line(t) (janet_tuple_head(t)->sm_line) | ||||
| @@ -1653,7 +1692,7 @@ JANET_API JanetSymbol janet_symbol_gen(void); | ||||
|  | ||||
| /* Structs */ | ||||
| #define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data))) | ||||
| #define janet_struct_from_head(t) ((const JanetKV *)((char *)gcobject + offsetof(JanetStructHead, data))) | ||||
| #define janet_struct_from_head(t) ((JanetStruct)((char *)gcobject + offsetof(JanetStructHead, data))) | ||||
| #define janet_struct_length(t) (janet_struct_head(t)->length) | ||||
| #define janet_struct_capacity(t) (janet_struct_head(t)->capacity) | ||||
| #define janet_struct_hash(t) (janet_struct_head(t)->hash) | ||||
| @@ -1794,6 +1833,7 @@ JANET_API void janet_vm_free(JanetVM *vm); | ||||
| JANET_API void janet_vm_save(JanetVM *into); | ||||
| JANET_API void janet_vm_load(JanetVM *from); | ||||
| JANET_API void janet_interpreter_interrupt(JanetVM *vm); | ||||
| JANET_API void janet_interpreter_interrupt_handled(JanetVM *vm); | ||||
| JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out); | ||||
| JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig); | ||||
| JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f); | ||||
| @@ -1817,6 +1857,7 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr | ||||
| #define JANET_SANDBOX_FS_TEMP 1024 | ||||
| #define JANET_SANDBOX_FFI_USE 2048 | ||||
| #define JANET_SANDBOX_FFI_JIT 4096 | ||||
| #define JANET_SANDBOX_SIGNAL 8192 | ||||
| #define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT) | ||||
| #define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP) | ||||
| #define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN) | ||||
| @@ -1940,10 +1981,10 @@ JANET_API void janet_register(const char *name, JanetCFunction cfun); | ||||
| #endif | ||||
| #ifndef JANET_ENTRY_NAME | ||||
| #define JANET_MODULE_ENTRY \ | ||||
|     JANET_MODULE_PREFIX JANET_API JanetBuildConfig _janet_mod_config(void) { \ | ||||
|     JANET_MODULE_PREFIX JANET_EXPORT JanetBuildConfig _janet_mod_config(void) { \ | ||||
|         return janet_config_current(); \ | ||||
|     } \ | ||||
|     JANET_MODULE_PREFIX JANET_API void _janet_init | ||||
|     JANET_MODULE_PREFIX JANET_EXPORT void _janet_init | ||||
| #else | ||||
| #define JANET_MODULE_ENTRY JANET_MODULE_PREFIX JANET_API void JANET_ENTRY_NAME | ||||
| #endif | ||||
| @@ -1983,7 +2024,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); | ||||
| @@ -1992,6 +2036,8 @@ JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n); | ||||
| JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at); | ||||
| JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv); | ||||
| JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which); | ||||
| JANET_API int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length); | ||||
| JANET_API int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length); | ||||
| JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which); | ||||
| JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags); | ||||
|  | ||||
| @@ -2050,6 +2096,7 @@ JANET_API int janet_cryptorand(uint8_t *out, size_t n); | ||||
| JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value); | ||||
| JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value); | ||||
| JANET_API void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value); | ||||
| JANET_API void janet_marshal_ptr(JanetMarshalContext *ctx, const void *value); | ||||
| JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value); | ||||
| JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len); | ||||
| JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x); | ||||
| @@ -2059,10 +2106,12 @@ JANET_API void janet_unmarshal_ensure(JanetMarshalContext *ctx, size_t size); | ||||
| JANET_API size_t janet_unmarshal_size(JanetMarshalContext *ctx); | ||||
| JANET_API int32_t janet_unmarshal_int(JanetMarshalContext *ctx); | ||||
| JANET_API int64_t janet_unmarshal_int64(JanetMarshalContext *ctx); | ||||
| JANET_API void *janet_unmarshal_ptr(JanetMarshalContext *ctx); | ||||
| JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx); | ||||
| JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len); | ||||
| JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx); | ||||
| JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size); | ||||
| JANET_API JanetAbstract janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size); | ||||
| JANET_API void janet_unmarshal_abstract_reuse(JanetMarshalContext *ctx, void *p); | ||||
|  | ||||
| JANET_API void janet_register_abstract_type(const JanetAbstractType *at); | ||||
| @@ -2105,7 +2154,9 @@ typedef enum { | ||||
|     RULE_LINE,         /* [tag] */ | ||||
|     RULE_COLUMN,       /* [tag] */ | ||||
|     RULE_UNREF,        /* [rule, tag] */ | ||||
|     RULE_CAPTURE_NUM   /* [rule, tag] */ | ||||
|     RULE_CAPTURE_NUM,  /* [rule, tag] */ | ||||
|     RULE_SUB,          /* [rule, rule] */ | ||||
|     RULE_SPLIT         /* [rule, rule] */ | ||||
| } JanetPegOpcod; | ||||
|  | ||||
| typedef struct { | ||||
|   | ||||
| @@ -502,10 +502,10 @@ static void kright(void) { | ||||
| } | ||||
|  | ||||
| static void krightw(void) { | ||||
|     while (gbl_pos != gbl_len && !isspace(gbl_buf[gbl_pos])) { | ||||
|     while (gbl_pos != gbl_len && isspace(gbl_buf[gbl_pos])) { | ||||
|         gbl_pos++; | ||||
|     } | ||||
|     while (gbl_pos != gbl_len && isspace(gbl_buf[gbl_pos])) { | ||||
|     while (gbl_pos != gbl_len && !isspace(gbl_buf[gbl_pos])) { | ||||
|         gbl_pos++; | ||||
|     } | ||||
|     refresh(); | ||||
|   | ||||
| @@ -19,7 +19,7 @@ | ||||
|                               (frame :source) (frame :source-line))) | ||||
|   (if x | ||||
|     (when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x)) | ||||
|     (eprintf "\e[31m✘\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))) | ||||
|   x) | ||||
|  | ||||
| (defmacro assert-error | ||||
| @@ -34,17 +34,17 @@ | ||||
|  | ||||
| (defmacro assert-no-error | ||||
|   [msg & forms] | ||||
|   (def errsym (keyword (gensym))) | ||||
|   ~(assert (not= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg)) | ||||
|   (def e (gensym)) | ||||
|   (def f (gensym)) | ||||
|   (if is-verbose | ||||
|   ~(try (do ,;forms (,assert true ,msg)) ([,e ,f] (,assert false ,msg) (,debug/stacktrace ,f ,e "\e[31m✘\e[0m "))) | ||||
|   ~(try (do ,;forms (,assert true ,msg)) ([_] (,assert false ,msg))))) | ||||
|  | ||||
| (defn start-suite [&opt x] | ||||
|   (default x (dyn :current-file)) | ||||
|   (set suite-name | ||||
|        (cond | ||||
|          (number? x) (string x) | ||||
|          (string? x) (string/slice x | ||||
|                                    (length "test/suite-") | ||||
|                                    (- (inc (length ".janet")))) | ||||
|          (string x))) | ||||
|   (set start-time (os/clock)) | ||||
|   (eprint "Starting suite " suite-name "...")) | ||||
|   | ||||
| @@ -44,7 +44,7 @@ | ||||
| (assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1") | ||||
| (assert (deep= (array/remove @[1 2 3 4 5] 2 2) @[1 2 5]) "array/remove 2") | ||||
| (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] -3 200) @[1 2 3]) "array/remove 4") | ||||
| (assert (deep= (array/remove @[1 2 3 4 5] -2 200) @[1 2 3]) "array/remove 4") | ||||
|  | ||||
|  | ||||
| # array/peek | ||||
|   | ||||
| @@ -51,5 +51,13 @@ | ||||
| (def f (asm (disasm (fn [x] (fn [y] (+ x y)))))) | ||||
| (assert (= ((f 10) 37) 47) "asm environment tables") | ||||
|  | ||||
| # issue #1424 | ||||
| (assert-no-error "arity > used slots (issue #1424)" | ||||
|                  (asm | ||||
|                    (disasm | ||||
|                      (fn [] | ||||
|                        (def foo (fn [one two] one)) | ||||
|                        (foo 100 200))))) | ||||
|  | ||||
| (end-suite) | ||||
|  | ||||
|   | ||||
| @@ -113,13 +113,22 @@ | ||||
| # 7478ad11 | ||||
| (assert (= nil (any? [])) "any? 1") | ||||
| (assert (= nil (any? [false nil])) "any? 2") | ||||
| (assert (= nil (any? [nil false])) "any? 3") | ||||
| (assert (= false (any? [nil false])) "any? 3") | ||||
| (assert (= 1 (any? [1])) "any? 4") | ||||
| (assert (nan? (any? [nil math/nan nil])) "any? 5") | ||||
| (assert (= true | ||||
|            (any? [nil nil false nil nil true nil nil nil nil false :a nil])) | ||||
|         "any? 6") | ||||
|  | ||||
| (assert (= true (every? [])) "every? 1") | ||||
| (assert (= true (every? [1 true])) "every? 2") | ||||
| (assert (= 1 (every? [true 1])) "every? 3") | ||||
| (assert (= nil (every? [nil])) "every? 4") | ||||
| (assert (= 2 (every? [1 math/nan 2])) "every? 5") | ||||
| (assert (= false | ||||
|            (every? [1 1 true 1 1 false 1 1 1 1 true :a nil])) | ||||
|         "every? 6") | ||||
|  | ||||
| # Some higher order functions and macros | ||||
| # 5e2de33 | ||||
| (def my-array @[1 2 3 4 5 6]) | ||||
| @@ -177,6 +186,11 @@ | ||||
| (assert (= txs [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]]) | ||||
|         "nested seq") | ||||
|  | ||||
| # :unless modifier | ||||
| (assert (deep= (seq [i :range [0 10] :unless (odd? i)] i) | ||||
|                @[0 2 4 6 8]) | ||||
|         ":unless modifier") | ||||
|  | ||||
| # 515891b03 | ||||
| (assert (deep= (tabseq [i :in (range 3)] i (* 3 i)) | ||||
|                @{0 0 1 3 2 6})) | ||||
| @@ -195,6 +209,12 @@ | ||||
| (assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x)) | ||||
|         "loop :down-to") | ||||
|  | ||||
| # one-term :range forms | ||||
| (assert (deep= (seq [x :range [10]] x) (seq [x :range [0 10]] x)) | ||||
|         "one-term :range") | ||||
| (assert (deep= (seq [x :down [10]] x) (seq [x :down [10 0]] x)) | ||||
|         "one-term :down") | ||||
|  | ||||
| # 7880d7320 | ||||
| (def res @{}) | ||||
| (loop [[k v] :pairs @{1 2 3 4 5 6}] | ||||
| @@ -221,6 +241,16 @@ | ||||
|   (assert (pos? (% x 4)) "generate in loop")) | ||||
| (assert (= gencount 75) "generate loop count") | ||||
|  | ||||
| # more loop checks | ||||
| (assert (deep= (seq [i :range [0 10]] i) @[0 1 2 3 4 5 6 7 8 9]) "seq 1") | ||||
| (assert (deep= (seq [i :range [0 10 2]] i) @[0 2 4 6 8]) "seq 2") | ||||
| (assert (deep= (seq [i :range [10]] i) @[0 1 2 3 4 5 6 7 8 9]) "seq 3") | ||||
| (assert (deep= (seq [i :range-to [10]] i) @[0 1 2 3 4 5 6 7 8 9 10]) "seq 4") | ||||
| (def gen (generate [x :range-to [0 nil 2]] x)) | ||||
| (assert (deep= (take 5 gen) @[0 2 4 6 8]) "generate nil limit") | ||||
| (def gen (generate [x :range [0 nil 2]] x)) | ||||
| (assert (deep= (take 5 gen) @[0 2 4 6 8]) "generate nil limit 2") | ||||
|  | ||||
| # Even and odd | ||||
| # ff163a5ae | ||||
| (assert (odd? 9) "odd? 1") | ||||
| @@ -334,6 +364,13 @@ | ||||
|         "sort 5") | ||||
| (assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6") | ||||
|  | ||||
| # #1283 | ||||
| (assert (deep= | ||||
|           (partition 2 (generate [ i :in [:a :b :c :d :e]] i)) | ||||
|           '@[(:a :b) (:c :d) (:e)])) | ||||
| (assert (= (mean (generate [i :in [2 3 5 7 11]] i)) | ||||
|            5.6)) | ||||
|  | ||||
| # And and or | ||||
| # c16a9d846 | ||||
| (assert (= (and true true) true) "and true true") | ||||
| @@ -362,14 +399,7 @@ | ||||
| (assert (= false (and false false)) "and 1") | ||||
| (assert (= false (or false false)) "or 1") | ||||
|  | ||||
| # Range | ||||
| # a982f351d | ||||
| (assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "range 1 argument") | ||||
| (assert (deep= (range 5 10) @[5 6 7 8 9]) "range 2 arguments") | ||||
| (assert (deep= (range 5 10 2) @[5 7 9]) "range 3 arguments") | ||||
| # 11cd1279d | ||||
| (assert (= (length (range 10)) 10) "(range 10)") | ||||
| (assert (= (length (range 1 10)) 9) "(range 1 10)") | ||||
| (assert (deep= @{:a 1 :b 2 :c 3} (zipcoll '[:a :b :c] '[1 2 3])) "zipcoll") | ||||
|  | ||||
| # bc8be266f | ||||
| @@ -904,4 +934,49 @@ | ||||
|                        [:strict 3 4 "bar-oops"]]) | ||||
|         "maclintf 2") | ||||
|  | ||||
| # Bad bytecode wrt. using result from break expression | ||||
| (defn bytecode-roundtrip | ||||
|   [f] | ||||
|   (assert-no-error "bytecode round-trip" (unmarshal (marshal f make-image-dict)))) | ||||
|  | ||||
| (defn case-1 [&] (def x (break 1))) | ||||
| (bytecode-roundtrip case-1) | ||||
| (defn foo [&]) | ||||
| (defn case-2 [&] | ||||
|   (foo (break (foo))) | ||||
|   (foo)) | ||||
| (bytecode-roundtrip case-2) | ||||
| (defn case-3 [&] | ||||
|   (def x (break (do (foo))))) | ||||
| (bytecode-roundtrip case-3) | ||||
| (defn case-4 [&] | ||||
|   (def x (break (break (foo))))) | ||||
| (bytecode-roundtrip case-4) | ||||
| (defn case-4 [&] | ||||
|   (def x (break (break (break))))) | ||||
| (bytecode-roundtrip case-4) | ||||
| (defn case-5 [] | ||||
|   (def foo (fn [one two] one)) | ||||
|   (foo 100 200)) | ||||
| (bytecode-roundtrip case-5) | ||||
|  | ||||
| # Debug bytecode of these functions | ||||
| # (pp (disasm case-1)) | ||||
| # (pp (disasm case-2)) | ||||
| # (pp (disasm case-3)) | ||||
|  | ||||
| # Regression #1330 | ||||
| (defn regress-1330 [&] | ||||
|   (def a [1 2 3]) | ||||
|   (def b [;a]) | ||||
|   (identity a)) | ||||
| (assert (= [1 2 3] (regress-1330)) "regression 1330") | ||||
|  | ||||
| # Issue 1341 | ||||
| (assert (= () '() (macex '())) "macex ()") | ||||
| (assert (= '[] (macex '[])) "macex []") | ||||
|  | ||||
| (assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn") | ||||
| (assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 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 | ||||
| @@ -77,6 +77,56 @@ | ||||
| (buffer/push-string b5 "456" @"789") | ||||
| (assert (= "123456789" (string b5)) "buffer/push-buffer 2") | ||||
|  | ||||
| (def buffer-uint16-be @"") | ||||
| (buffer/push-uint16 buffer-uint16-be :be 0x0102) | ||||
| (assert (= "\x01\x02" (string buffer-uint16-be)) "buffer/push-uint16 big endian") | ||||
|  | ||||
| (def buffer-uint16-le @"") | ||||
| (buffer/push-uint16 buffer-uint16-le :le 0x0102) | ||||
| (assert (= "\x02\x01" (string buffer-uint16-le)) "buffer/push-uint16 little endian") | ||||
|  | ||||
| (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) | ||||
| (assert (= "\x01\x02\x03\x04" (string buffer-uint32-be)) "buffer/push-uint32 big endian") | ||||
|  | ||||
| (def buffer-uint32-le @"") | ||||
| (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-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) | ||||
| (assert (= "\x3f\x9d\xf3\xb6" (string buffer-float32-be)) "buffer/push-float32 big endian") | ||||
|  | ||||
| (def buffer-float32-le @"") | ||||
| (buffer/push-float32 buffer-float32-le :le 1.234) | ||||
| (assert (= "\xb6\xf3\x9d\x3f" (string buffer-float32-le)) "buffer/push-float32 little endian") | ||||
|  | ||||
| (def buffer-float64-be @"") | ||||
| (buffer/push-float64 buffer-float64-be :be 1.234) | ||||
| (assert (= "\x3f\xf3\xbe\x76\xc8\xb4\x39\x58" (string buffer-float64-be)) "buffer/push-float64 big endian") | ||||
|  | ||||
| (def buffer-float64-le @"") | ||||
| (buffer/push-float64 buffer-float64-le :le 1.234) | ||||
| (assert (= "\x58\x39\xb4\xc8\x76\xbe\xf3\x3f" (string buffer-float64-le)) "buffer/push-float64 little endian") | ||||
|  | ||||
| # Buffer from bytes | ||||
| (assert (deep= @"" (buffer/from-bytes)) "buffer/from-bytes 1") | ||||
| (assert (deep= @"ABC" (buffer/from-bytes 65 66 67)) "buffer/from-bytes 2") | ||||
| (assert (deep= @"0123456789" (buffer/from-bytes ;(range 48 58))) "buffer/from-bytes 3") | ||||
| (assert (= 0 (length (buffer/from-bytes))) "buffer/from-bytes 4") | ||||
| (assert (= 5 (length (buffer/from-bytes ;(range 5)))) "buffer/from-bytes 5") | ||||
| (assert-error "bad slot #1, expected 32 bit signed integer" (buffer/from-bytes :abc)) | ||||
|  | ||||
| # some tests for buffer/format | ||||
| # 029394d | ||||
| (assert (= (string (buffer/format @"" "pi = %6.3f" math/pi)) "pi =  3.142") | ||||
| @@ -103,6 +153,7 @@ | ||||
| (assert (deep= @"bcde" (buffer/blit @"" a -1 1 5)) "buffer/blit 3") | ||||
| (assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4") | ||||
| (assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5") | ||||
| (assert (deep= @"de" (buffer/blit @"" a nil 3 5)) "buffer/blit 6") | ||||
|  | ||||
| # buffer/push-at | ||||
| # c55d93512 | ||||
| @@ -113,8 +164,20 @@ | ||||
| (assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4")) | ||||
|         "buffer/push-at 3") | ||||
|  | ||||
| # 4782a76 | ||||
| (assert (= 10 (do (var x 10) (def y x) (++ x) y)) "no invalid aliasing") | ||||
| # buffer/format-at | ||||
| (def start-buf (buffer/new-filled 100 (chr "x"))) | ||||
| (buffer/format-at start-buf 50 "aa%dbb" 32) | ||||
| (assert (= (string start-buf) (string (string/repeat "x" 50) "aa32bb"  (string/repeat "x" 44))) | ||||
|         "buffer/format-at 1") | ||||
| (assert | ||||
|   (deep= | ||||
|     (buffer/format @"" "%j" [1 2 3 :a :b :c]) | ||||
|     (buffer/format-at @"" 0 "%j" [1 2 3 :a :b :c])) | ||||
|   "buffer/format-at empty buffer") | ||||
| (def buf @"xxxyyy") | ||||
| (buffer/format-at buf -4 "xxx") | ||||
| (assert (= (string buf) "xxxxxx") "buffer/format-at negative index") | ||||
| (assert-error "expected index at to be in range [0, 0), got 1" (buffer/format-at @"" 1 "abc")) | ||||
|  | ||||
| (end-suite) | ||||
|  | ||||
|   | ||||
							
								
								
									
										125
									
								
								test/suite-bundle.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										125
									
								
								test/suite-bundle.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,125 @@ | ||||
| # 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 | ||||
|  | ||||
| # Copy since not exposed in boot.janet | ||||
| (defn- bundle-rpath | ||||
|   [path] | ||||
|   (string/replace-all "\\" "/" (os/realpath path))) | ||||
|  | ||||
| (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) | ||||
|  | ||||
| # Test mkdir -> rmdir | ||||
| (assert (os/mkdir "tempdir123")) | ||||
| (rmrf "tempdir123") | ||||
|  | ||||
| # Setup a temporary syspath for manipultation | ||||
| (math/seedrandom (os/cryptorand 16)) | ||||
| (def syspath (string (math/random) "_jpm_tree.tmp")) | ||||
| (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")) | ||||
|  | ||||
| # 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") | ||||
|  | ||||
| (rmrf syspath) | ||||
|  | ||||
| (end-suite) | ||||
| @@ -30,10 +30,12 @@ | ||||
| (assert (= 1 (brshift 4 2)) "right shift") | ||||
| # unsigned shift | ||||
| (assert (= 32768 (brushift 0x80000000 16)) "right shift unsigned 1") | ||||
| (assert (= -32768 (brshift 0x80000000 16)) "right shift unsigned 2") | ||||
| (assert-error "right shift unsigned 2" (= -32768 (brshift 0x80000000 16))) | ||||
| (assert (= -1 (brshift -1 16)) "right shift unsigned 3") | ||||
| # non-immediate forms | ||||
| (assert (= 32768 (brushift 0x80000000 (+ 0 16))) "right shift unsigned non-immediate") | ||||
| (assert (= -32768 (brshift 0x80000000 (+ 0 16))) "right shift non-immediate") | ||||
| (assert-error "right shift non-immediate" (= -32768 (brshift 0x80000000 (+ 0 16)))) | ||||
| (assert (= -1 (brshift -1 (+ 0 16))) "right shift non-immediate 2") | ||||
| (assert (= 32768 (blshift 1 (+ 0 15))) "left shift non-immediate") | ||||
| # 7e46ead | ||||
| (assert (< 1 2 3 4 5 6) "less than integers") | ||||
| @@ -44,8 +46,28 @@ | ||||
| (assert (<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "less than or equal to reals") | ||||
| (assert (>= 6 5 4 4 3 2 1) "greater than or equal to integers") | ||||
| (assert (>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "greater than or equal to reals") | ||||
| (assert (= 7 (% 20 13)) "modulo 1") | ||||
| (assert (= -7 (% -20 13)) "modulo 2") | ||||
|  | ||||
| (assert (= 7 (% 20 13)) "rem 1") | ||||
| (assert (= -7 (% -20 13)) "rem 2") | ||||
| (assert (= 7 (% 20 -13)) "rem 3") | ||||
| (assert (= -7 (% -20 -13)) "rem 4") | ||||
| (assert (nan? (% 20 0)) "rem 5") | ||||
|  | ||||
| (assert (= 7 (mod 20 13)) "mod 1") | ||||
| (assert (= 6 (mod -20 13)) "mod 2") | ||||
| (assert (= -6 (mod 20 -13)) "mod 3") | ||||
| (assert (= -7 (mod -20 -13)) "mod 4") | ||||
| (assert (= 20 (mod 20 0)) "mod 5") | ||||
|  | ||||
| (assert (= 1 (div 20 13)) "div 1") | ||||
| (assert (= -2 (div -20 13)) "div 2") | ||||
| (assert (= -2 (div 20 -13)) "div 3") | ||||
| (assert (= 1 (div -20 -13)) "div 4") | ||||
| (assert (= math/inf (div 20 0)) "div 5") | ||||
|  | ||||
| (assert (all = (seq [n :range [0 10]] (mod n 5 3)) | ||||
|                (seq [n :range [0 10]] (% n 5 3)) | ||||
|                [0 1 2 0 1 0 1 2 0 1]) "variadic mod") | ||||
|  | ||||
| (assert (< 1.0 nil false true | ||||
|            (fiber/new (fn [] 1)) | ||||
| @@ -137,5 +159,23 @@ | ||||
| (assert-error "invalid offset-a: 1" (memcmp "a" "b" 1 1 0)) | ||||
| (assert-error "invalid offset-b: 1" (memcmp "a" "b" 1 0 1)) | ||||
|  | ||||
| # Range | ||||
| # a982f351d | ||||
| (assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "(range 10)") | ||||
| (assert (deep= (range 5 10) @[5 6 7 8 9]) "(range 5 10)") | ||||
| (assert (deep= (range 0 16 4) @[0 4 8 12]) "(range 0 16 4)") | ||||
| (assert (deep= (range 0 17 4) @[0 4 8 12 16]) "(range 0 17 4)") | ||||
| (assert (deep= (range 16 0 -4) @[16 12 8 4]) "(range 16 0 -4)") | ||||
| (assert (deep= (range 17 0 -4) @[17 13 9 5 1]) "(range 17 0 -4)") | ||||
|  | ||||
| (assert (= (length (range 10)) 10) "(range 10)") | ||||
| (assert (= (length (range -10)) 0) "(range -10)") | ||||
| (assert (= (length (range 1 10)) 9) "(range 1 10)") | ||||
|  | ||||
| # iterating over generator | ||||
| (assert-no-error "iterate over coro 1" (values (generate [x :range [0 10]] x))) | ||||
| (assert-no-error "iterate over coro 2" (keys (generate [x :range [0 10]] x))) | ||||
| (assert-no-error "iterate over coro 3" (pairs (generate [x :range [0 10]] x))) | ||||
|  | ||||
| (end-suite) | ||||
|  | ||||
|   | ||||
| @@ -21,42 +21,48 @@ | ||||
| (import ./helper :prefix "" :exit true) | ||||
| (start-suite) | ||||
|  | ||||
| (def test-port (os/getenv "JANET_TEST_PORT" "8761")) | ||||
| (def test-host (os/getenv "JANET_TEST_HOST" "127.0.0.1")) | ||||
|  | ||||
| # Subprocess | ||||
| # 5e1a8c86f | ||||
| (def janet (dyn :executable)) | ||||
| (def janet (dyn *executable*)) | ||||
|  | ||||
| # Subprocess should inherit the "RUN" parameter for fancy testing | ||||
| (def run (filter next (string/split " " (os/getenv "SUBRUN" "")))) | ||||
|  | ||||
| (repeat 10 | ||||
|  | ||||
|   (let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})] | ||||
|   (let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})] | ||||
|     (os/proc-wait p) | ||||
|     (def x (:read (p :out) :all)) | ||||
|     (assert (deep= "hello" (string/trim x)) | ||||
|             "capture stdout from os/spawn pre close.")) | ||||
|  | ||||
|   (let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})] | ||||
|   (let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})] | ||||
|     (def x (:read (p :out) 1024)) | ||||
|     (os/proc-wait p) | ||||
|     (assert (deep= "hello" (string/trim x)) | ||||
|             "capture stdout from os/spawn post close.")) | ||||
|  | ||||
|   (let [p (os/spawn [janet "-e" `(file/read stdin :line)`] :px | ||||
|   (let [p (os/spawn [;run janet "-e" `(file/read stdin :line)`] :px | ||||
|                     {:in :pipe})] | ||||
|     (:write (p :in) "hello!\n") | ||||
|     (assert-no-error "pipe stdin to process" (os/proc-wait p)))) | ||||
|  | ||||
| (let [p (os/spawn [janet "-e" `(print (file/read stdin :line))`] :px | ||||
| (let [p (os/spawn [;run janet "-e" `(print (file/read stdin :line))`] :px | ||||
|                   {:in :pipe :out :pipe})] | ||||
|   (:write (p :in) "hello!\n") | ||||
|   (def x (:read (p :out) 1024)) | ||||
|   (assert-no-error "pipe stdin to process 2" (os/proc-wait p)) | ||||
|   (assert (= "hello!" (string/trim x)) "round trip pipeline in process")) | ||||
|  | ||||
| (let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)] | ||||
| (let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)] | ||||
|   (os/proc-kill p) | ||||
|   (def retval (os/proc-wait p)) | ||||
|   (assert (not= retval 24) "Process was *not* terminated by parent")) | ||||
|  | ||||
| (let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)] | ||||
| (let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)] | ||||
|   (os/proc-kill p false :term) | ||||
|   (def retval (os/proc-wait p)) | ||||
|   (assert (not= retval 24) "Process was *not* terminated by parent")) | ||||
| @@ -66,7 +72,7 @@ | ||||
| (defn calc-1 | ||||
|   "Run subprocess, read from stdout, then wait on subprocess." | ||||
|   [code] | ||||
|   (let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px | ||||
|   (let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px | ||||
|                     {:out :pipe})] | ||||
|     (os/proc-wait p) | ||||
|     (def output (:read (p :out) :all)) | ||||
| @@ -86,7 +92,7 @@ | ||||
|   to 10 bytes instead of :all | ||||
|   `` | ||||
|   [code] | ||||
|   (let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px | ||||
|   (let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px | ||||
|                     {:out :pipe})] | ||||
|     (def output (:read (p :out) 10)) | ||||
|     (os/proc-wait p) | ||||
| @@ -104,18 +110,18 @@ | ||||
| # a1cc5ca04 | ||||
| (assert-no-error "file writing 1" | ||||
|   (with [f (file/temp)] | ||||
|     (os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f}))) | ||||
|     (os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f}))) | ||||
|  | ||||
| (assert-no-error "file writing 2" | ||||
|   (with [f (file/open "unique.txt" :w)] | ||||
|     (os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f}) | ||||
|     (os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f}) | ||||
|     (file/flush f))) | ||||
|  | ||||
| # Issue #593 | ||||
| # a1cc5ca04 | ||||
| (assert-no-error "file writing 3" | ||||
|   (def outfile (file/open "unique.txt" :w)) | ||||
|   (os/execute [janet "-e" "(pp (seq [i :range (1 10)] i))"] :p | ||||
|   (os/execute [;run janet "-e" "(pp (seq [i :range (1 10)] i))"] :p | ||||
|               {:out outfile}) | ||||
|   (file/flush outfile) | ||||
|   (file/close outfile) | ||||
| @@ -189,11 +195,11 @@ | ||||
|       (net/write stream b) | ||||
|       (buffer/clear b))) | ||||
|  | ||||
|   (def s (net/server "127.0.0.1" "8000" handler)) | ||||
|   (def s (net/server test-host test-port handler)) | ||||
|   (assert s "made server 1") | ||||
|  | ||||
|   (defn test-echo [msg] | ||||
|     (with [conn (net/connect "127.0.0.1" "8000")] | ||||
|     (with [conn (net/connect test-host test-port)] | ||||
|       (net/write conn msg) | ||||
|       (def res (net/read conn 1024)) | ||||
|       (assert (= (string res) msg) (string "echo " msg)))) | ||||
| @@ -202,7 +208,8 @@ | ||||
|   (test-echo "world") | ||||
|   (test-echo (string/repeat "abcd" 200)) | ||||
|  | ||||
|   (:close s)) | ||||
|   (:close s) | ||||
|   (gccollect)) | ||||
|  | ||||
| # Test on both server and client | ||||
| # 504411e | ||||
| @@ -212,18 +219,18 @@ | ||||
|     # prevent immediate close | ||||
|     (ev/read stream 1) | ||||
|     (def [host port] (net/localname stream)) | ||||
|     (assert (= host "127.0.0.1") "localname host server") | ||||
|     (assert (= port 8000) "localname port server"))) | ||||
|     (assert (= host test-host) "localname host server") | ||||
|     (assert (= port (scan-number test-port)) "localname port server"))) | ||||
|  | ||||
| # Test localname and peername | ||||
| # 077bf5eba | ||||
| (repeat 10 | ||||
|   (with [s (net/server "127.0.0.1" "8000" names-handler)] | ||||
|   (with [s (net/server test-host test-port names-handler)] | ||||
|     (repeat 10 | ||||
|       (with [conn (net/connect "127.0.0.1" "8000")] | ||||
|       (with [conn (net/connect test-host test-port)] | ||||
|         (def [host port] (net/peername conn)) | ||||
|         (assert (= host "127.0.0.1") "peername host client ") | ||||
|         (assert (= port 8000) "peername port client") | ||||
|         (assert (= host test-host) "peername host client ") | ||||
|         (assert (= port (scan-number test-port)) "peername port client") | ||||
|         # let server close | ||||
|         (ev/write conn " ")))) | ||||
|   (gccollect)) | ||||
| @@ -256,7 +263,7 @@ | ||||
| (ev/cancel fiber "boop") | ||||
|  | ||||
| # f0dbc2e | ||||
| (assert (os/execute [janet "-e" `(+ 1 2 3)`] :xp) "os/execute self") | ||||
| (assert (os/execute [;run janet "-e" `(+ 1 2 3)`] :xp) "os/execute self") | ||||
|  | ||||
| # Test some channel | ||||
| # e76b8da26 | ||||
| @@ -341,5 +348,31 @@ | ||||
| (ev/go |(ev/chan-close ch)) | ||||
| (assert (= (ev/select [ch 1]) [:close ch])) | ||||
|  | ||||
| (end-suite) | ||||
| # ev/gather check | ||||
| (defn exec-slurp | ||||
|   "Read stdout of subprocess and return it trimmed in a string." | ||||
|   [& args] | ||||
|   (def env (os/environ)) | ||||
|   (put env :out :pipe) | ||||
|   (def proc (os/spawn args :epx env)) | ||||
|   (def out (get proc :out)) | ||||
|   (def buf @"") | ||||
|   (ev/gather | ||||
|     (:read out :all buf) | ||||
|     (:wait proc)) | ||||
|   (string/trimr buf)) | ||||
| (assert-no-error | ||||
|   "ev/with-deadline 1" | ||||
|   (assert (= "hi" | ||||
|              (ev/with-deadline | ||||
|                10 | ||||
|                (exec-slurp ;run janet "-e" "(print :hi)"))) | ||||
|           "exec-slurp 1")) | ||||
|  | ||||
| # valgrind-able check for #1337 | ||||
| (def superv (ev/chan 10)) | ||||
| (def f (ev/go |(ev/sleep 1e9) nil superv)) | ||||
| (ev/cancel f (gensym)) | ||||
| (ev/take superv) | ||||
|  | ||||
| (end-suite) | ||||
|   | ||||
| @@ -126,7 +126,7 @@ | ||||
|   (assert (deep= (int/to-bytes (u64 300) :be buf2) | ||||
|                  @"abcd\x00\x00\x00\x00\x00\x00\x01\x2C"))) | ||||
|  | ||||
| # int/s64 and int/u64 paramater type checking | ||||
| # int/s64 and int/u64 parameter type checking | ||||
| # 6aea7c7f7 | ||||
| (assert-error | ||||
|   "bad value passed to int/to-bytes" | ||||
| @@ -171,22 +171,44 @@ | ||||
| (assert (not (even? (int/s64 "-1001"))) "even? 6") | ||||
|  | ||||
| # integer type operations | ||||
| (defn modcheck [x y] | ||||
|   (assert (= (string (mod x y)) (string (mod (int/s64 x) y))) | ||||
|           (string "int/s64 (mod " x " " y ") expected " (mod x y) ", got " | ||||
|                   (mod (int/s64 x) y))) | ||||
|   (assert (= (string (% x y)) (string (% (int/s64 x) y))) | ||||
|           (string "int/s64 (% " x " " y ") expected " (% x y) ", got " | ||||
|                   (% (int/s64 x) y)))) | ||||
| (defn opcheck [int x y] | ||||
|   (each op [mod % div] | ||||
|     (assert (compare= (op x y) (op (int x) y)) | ||||
|             (string int " (" op " " x " " y ") expected " (op x y) | ||||
|                     ", got " (op (int x) y))) | ||||
|     (assert (compare= (op x y) (op x (int y))) | ||||
|             (string int " (" op " " x " " y ") expected " (op x y) | ||||
|                     ", got " (op x (int y)))) | ||||
|     (assert (compare= (op x y) (op (int x) (int y))) | ||||
|             (string int " (" op " " x " " y ") expected " (op x y) | ||||
|                     ", got " (op (int x) (int y)))))) | ||||
|  | ||||
| (modcheck 1 2) | ||||
| (modcheck 1 3) | ||||
| (modcheck 4 2) | ||||
| (modcheck 4 1) | ||||
| (modcheck 10 3) | ||||
| (modcheck 10 -3) | ||||
| (modcheck -10 3) | ||||
| (modcheck -10 -3) | ||||
| (loop [x :in [-5 -3 0 3 5] | ||||
|        y :in [-4 -3 3 4]] | ||||
|   (opcheck int/s64 x y) | ||||
|   (if (and (>= x 0) (>= y 0)) | ||||
|     (opcheck int/u64 x y))) | ||||
|  | ||||
| (each int [int/s64 int/u64] | ||||
|   (each op [% / div] | ||||
|     (assert-error "division by zero" (op (int 7) 0)) | ||||
|     (assert-error "division by zero" (op 7 (int 0))) | ||||
|     (assert-error "division by zero" (op (int 7) (int 0))))) | ||||
|  | ||||
| (each int [int/s64 int/u64] | ||||
|   (loop [x :in [-5 -3 0 3 5] :when (or (pos? x) (= int int/s64))] | ||||
|     # skip check when comparing negative values with unsigned integers. | ||||
|     (assert (= (int x) (mod (int x) 0)) (string int " mod 0")) | ||||
|     (assert (= (int x) (mod x (int 0))) (string int " mod 0")) | ||||
|     (assert (= (int x) (mod (int x) (int 0))) (string int " mod 0")))) | ||||
|  | ||||
| (loop [x :in [-5 -3 0 3 5]] | ||||
|   (assert (compare= (bnot x) (bnot (int/s64 x))) "int/s64 bnot")) | ||||
|  | ||||
| (loop [x :range [0 10]] | ||||
|   (assert (= (int/u64 "0xFFFF_FFFF_FFFF_FFFF") | ||||
|           (bxor (int/u64 x) (bnot (int/u64 x)))) | ||||
|           "int/u64 bnot")) | ||||
|  | ||||
| # Check for issue #1130 | ||||
| # 7e65c2bda | ||||
| @@ -246,13 +268,21 @@ | ||||
| # compare u64/i64 | ||||
| (assert (= (compare (u64 1) (i64 2)) -1) "compare 7") | ||||
| (assert (= (compare (u64 1) (i64 -1)) +1) "compare 8") | ||||
| (assert (= (compare (u64 -1) (i64 -1)) +1) "compare 9") | ||||
| (assert (= (compare (u64 0) (i64 -1)) +1) "compare 9") | ||||
|  | ||||
| # compare i64/u64 | ||||
| (assert (= (compare (i64 1) (u64 2)) -1) "compare 10") | ||||
| (assert (= (compare (i64 -1) (u64 1)) -1) "compare 11") | ||||
| (assert (= (compare (i64 -1) (u64 -1)) -1) "compare 12") | ||||
| (assert (= (compare (i64 -1) (u64 0)) -1) "compare 12") | ||||
|  | ||||
| # off by 1 error in inttypes | ||||
| # a3e812b86 | ||||
| (assert (= (int/s64 "-0x8000_0000_0000_0000") | ||||
|            (+ (int/s64 "0x7FFF_FFFF_FFFF_FFFF") 1)) "int types wrap around") | ||||
| (assert (= (int/s64 "0x7FFF_FFFF_FFFF_FFFF") | ||||
|            (- (int/s64 "-0x8000_0000_0000_0000") 1)) "int types wrap around") | ||||
|  | ||||
| # Issue #1217 | ||||
| (assert (= (- (int/u64 "0xFFFFFFFF") 1) (int/u64 "0xFFFFFFFE")) "u64 subtract") | ||||
|  | ||||
| (end-suite) | ||||
|  | ||||
|   | ||||
| @@ -138,5 +138,13 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 | ||||
| # XXX: still needed? see 72beeeea | ||||
| (gccollect) | ||||
|  | ||||
| # ev/chan marshalling | ||||
| (compwhen (dyn 'ev/chan) | ||||
|   (def chan (ev/chan 10)) | ||||
|   (ev/give chan chan) | ||||
|   (def newchan (unmarshal (marshal chan))) | ||||
|   (def item (ev/take newchan)) | ||||
|   (assert (= item newchan) "ev/chan marshalling")) | ||||
|  | ||||
| (end-suite) | ||||
|  | ||||
|   | ||||
| @@ -21,6 +21,9 @@ | ||||
| (import ./helper :prefix "" :exit true) | ||||
| (start-suite) | ||||
|  | ||||
| (def janet (dyn :executable)) | ||||
| (def run (filter next (string/split " " (os/getenv "SUBRUN" "")))) | ||||
|  | ||||
| # OS Date test | ||||
| # 719f7ba0c | ||||
| (assert (deep= {:year-day 0 | ||||
| @@ -93,10 +96,22 @@ | ||||
|   (assert (= (in buf 0) 0) "cryptorand doesn't overwrite buffer") | ||||
|   (assert (= (length buf) 2) "cryptorand appends to buffer")) | ||||
|  | ||||
| (assert-no-error "realtime clock" (os/clock)) | ||||
| (assert-no-error "realtime clock" (os/clock nil)) | ||||
| (assert-no-error "realtime clock" (os/clock nil nil)) | ||||
|  | ||||
| # 80db68210 | ||||
| (assert-no-error (os/clock :realtime) "realtime clock") | ||||
| (assert-no-error (os/clock :cputime) "cputime clock") | ||||
| (assert-no-error (os/clock :monotonic) "monotonic clock") | ||||
| (assert-no-error "realtime clock" (os/clock :realtime)) | ||||
| (assert-no-error "cputime clock" (os/clock :cputime)) | ||||
| (assert-no-error "monotonic clock" (os/clock :monotonic)) | ||||
|  | ||||
| (assert-no-error "realtime clock double output" (os/clock nil :double)) | ||||
| (assert-no-error "realtime clock int output" (os/clock nil :int)) | ||||
| (assert-no-error "realtime clock tuple output" (os/clock nil :tuple)) | ||||
|  | ||||
| (assert-error "invalid clock" (os/clock :a)) | ||||
| (assert-error "invalid output" (os/clock :realtime :b)) | ||||
| (assert-error "invalid clock and output" (os/clock :a :b)) | ||||
|  | ||||
| (def before (os/clock :monotonic)) | ||||
| (def after (os/clock :monotonic)) | ||||
| @@ -118,16 +133,30 @@ | ||||
|  | ||||
| # os/execute with environment variables | ||||
| # issue #636 - 7e2c433ab | ||||
| (assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe | ||||
| (assert (= 0 (os/execute [;run janet "-e" "(+ 1 2 3)"] :pe | ||||
|                          (merge (os/environ) {"HELLO" "WORLD"}))) | ||||
|         "os/execute with env") | ||||
|  | ||||
| # os/execute regressions | ||||
| # 427f7c362 | ||||
| (for i 0 10 | ||||
|   (assert (= i (os/execute [(dyn :executable) "-e" | ||||
|   (assert (= i (os/execute [;run janet "-e" | ||||
|                             (string/format "(os/exit %d)" i)] :p)) | ||||
|           (string "os/execute " i))) | ||||
|  | ||||
| (end-suite) | ||||
| # os/execute IO redirection | ||||
| (assert-no-error "IO redirection" | ||||
|                  (defn devnull [] | ||||
|                    (def os (os/which)) | ||||
|                    (def path (if (or (= os :mingw) (= os :windows)) | ||||
|                                "NUL" | ||||
|                                "/dev/null")) | ||||
|                    (os/open path :w)) | ||||
|                  (with [dn (devnull)] | ||||
|                    (os/execute [;run janet | ||||
|                                 "-e" | ||||
|                                 "(print :foo) (eprint :bar)"] | ||||
|                                :px | ||||
|                                {:out dn :err dn}))) | ||||
|  | ||||
| (end-suite) | ||||
|   | ||||
| @@ -263,6 +263,9 @@ | ||||
| (marshpeg '(if-not "abcdf" 123)) | ||||
| (marshpeg ~(cmt "abcdf" ,identity)) | ||||
| (marshpeg '(group "abc")) | ||||
| (marshpeg '(sub "abcdf" "abc")) | ||||
| (marshpeg '(* (sub 1 1))) | ||||
| (marshpeg '(split "," (+ "a" "b" "c"))) | ||||
|  | ||||
| # Peg swallowing errors | ||||
| # 159651117 | ||||
| @@ -307,12 +310,12 @@ | ||||
| (check-deep '(uint 2) "\xff\x7f" @[0x7fff]) | ||||
| (check-deep '(uint-be 2) "\x7f\xff" @[0x7fff]) | ||||
| (check-deep '(uint-be 2) "\x7f\xff" @[0x7fff]) | ||||
| (check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" | ||||
|             @[(int/u64 0x7fff)]) | ||||
| (check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" | ||||
|             @[(int/s64 0x7fff)]) | ||||
| (check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)]) | ||||
| (check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)]) | ||||
| (when-let [u64 int/u64 | ||||
|            i64 int/s64] | ||||
|   (check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(u64 0x7fff)]) | ||||
|   (check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(i64 0x7fff)]) | ||||
|   (check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(u64 0x7fff)]) | ||||
|   (check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(i64 0x7fff)])) | ||||
|  | ||||
| (check-deep '(* (int 2) -1) "123" nil) | ||||
|  | ||||
| @@ -367,7 +370,7 @@ | ||||
|                  (set "!$%&*+-./:<?=>@^_|")) | ||||
|     :token (some :symchars) | ||||
|     :hex (range "09" "af" "AF") | ||||
|     :escape (* "\\" (+ (set "ntrvzf0e\"\\") | ||||
|     :escape (* "\\" (+ (set `"'0?\abefnrtvz`) | ||||
|                        (* "x" :hex :hex) | ||||
|                        (error (constant "bad hex escape")))) | ||||
|     :comment (/ '(* "#" (any (if-not (+ "\n" -1) 1))) (constant :comment)) | ||||
| @@ -660,5 +663,98 @@ | ||||
|   (peg/match '(if (not (* (constant 7) "a")) "hello") "hello") | ||||
|   @[]) "peg if not") | ||||
|  | ||||
| (defn test [name peg input expected] | ||||
|   (assert (deep= (peg/match peg input) expected) name)) | ||||
|  | ||||
| (test "sub: matches the same input twice" | ||||
|   ~(sub "abcd" "abc") | ||||
|   "abcdef" | ||||
|   @[]) | ||||
|  | ||||
| (test "sub: second pattern cannot match more than the first pattern" | ||||
|   ~(sub "abcd" "abcde") | ||||
|   "abcdef" | ||||
|   nil) | ||||
|  | ||||
| (test "sub: fails if first pattern fails" | ||||
|   ~(sub "x" "abc") | ||||
|   "abcdef" | ||||
|   nil) | ||||
|  | ||||
| (test "sub: fails if second pattern fails" | ||||
|   ~(sub "abc" "x") | ||||
|   "abcdef" | ||||
|   nil) | ||||
|  | ||||
| (test "sub: keeps captures from both patterns" | ||||
|   ~(sub '"abcd" '"abc") | ||||
|   "abcdef" | ||||
|   @["abcd" "abc"]) | ||||
|  | ||||
| (test "sub: second pattern can reference captures from first" | ||||
|   ~(* (constant 5 :tag) (sub (capture "abc" :tag) (backref :tag))) | ||||
|   "abcdef" | ||||
|   @[5 "abc" "abc"]) | ||||
|  | ||||
| (test "sub: second pattern can't see past what the first pattern matches" | ||||
|   ~(sub "abc" (* "abc" -1)) | ||||
|   "abcdef" | ||||
|   @[]) | ||||
|  | ||||
| (test "sub: positions inside second match are still relative to the entire input" | ||||
|   ~(* "one\ntw" (sub "o" (* ($) (line) (column)))) | ||||
|   "one\ntwo\nthree\n" | ||||
|   @[6 2 3]) | ||||
|  | ||||
| (test "sub: advances to the end of the first pattern's match" | ||||
|   ~(* (sub "abc" "ab") "d") | ||||
|   "abcdef" | ||||
|   @[]) | ||||
|  | ||||
| (test "split: basic functionality" | ||||
|   ~(split "," '1) | ||||
|   "a,b,c" | ||||
|   @["a" "b" "c"]) | ||||
|  | ||||
| (test "split: drops captures from separator pattern" | ||||
|   ~(split '"," '1) | ||||
|   "a,b,c" | ||||
|   @["a" "b" "c"]) | ||||
|  | ||||
| (test "split: can match empty subpatterns" | ||||
|   ~(split "," ':w*) | ||||
|   ",a,,bar,,,c,," | ||||
|   @["" "a" "" "bar" "" "" "c" "" ""]) | ||||
|  | ||||
| (test "split: subpattern is limited to only text before the separator" | ||||
|   ~(split "," '(to -1)) | ||||
|   "a,,bar,c" | ||||
|   @["a" "" "bar" "c"]) | ||||
|  | ||||
| (test "split: fails if any subpattern fails" | ||||
|   ~(split "," '"a") | ||||
|   "a,a,b" | ||||
|   nil) | ||||
|  | ||||
| (test "split: separator does not have to match anything" | ||||
|   ~(split "x" '(to -1)) | ||||
|   "a,a,b" | ||||
|   @["a,a,b"]) | ||||
|  | ||||
| (test "split: always consumes entire input" | ||||
|   ~(split 1 '"") | ||||
|   "abc" | ||||
|   @["" "" "" ""]) | ||||
|  | ||||
| (test "split: separator can be an arbitrary PEG" | ||||
|   ~(split :s+ '(to -1)) | ||||
|   "a   b      c" | ||||
|   @["a" "b" "c"]) | ||||
|  | ||||
| (test "split: does not advance past the end of the input" | ||||
|   ~(* (split "," ':w+) 0) | ||||
|   "a,b,c" | ||||
|   @["a" "b" "c"]) | ||||
|  | ||||
| (end-suite) | ||||
|  | ||||
|   | ||||
| @@ -198,5 +198,9 @@ | ||||
|  | ||||
| (assert (= (test) '(1 ())) "issue #919") | ||||
|  | ||||
| (end-suite) | ||||
| # Regression #1327 | ||||
| (def x "A") | ||||
| (def x (if (= nil x) "B" x)) | ||||
| (assert (= x "A")) | ||||
|  | ||||
| (end-suite) | ||||
|   | ||||
| @@ -35,10 +35,5 @@ | ||||
| # c876e63 | ||||
| 0xf&1fffFFFF | ||||
|  | ||||
| # off by 1 error in inttypes | ||||
| # a3e812b86 | ||||
| (assert (= (int/s64 "-0x8000_0000_0000_0000") | ||||
|            (+ (int/s64 "0x7FFF_FFFF_FFFF_FFFF") 1)) "int types wrap around") | ||||
|  | ||||
| (end-suite) | ||||
|  | ||||
|   | ||||
| @@ -292,5 +292,8 @@ | ||||
|                  [2 6 4 'z]]) | ||||
|         "arg & inner symbolmap") | ||||
|  | ||||
| # 4782a76 | ||||
| (assert (= 10 (do (var x 10) (def y x) (++ x) y)) "no invalid aliasing") | ||||
|  | ||||
| (end-suite) | ||||
|  | ||||
|   | ||||
| @@ -42,7 +42,7 @@ | ||||
|  | ||||
| (defn buffer-factory | ||||
|   [] | ||||
|   @"im am a buffer") | ||||
|   @"i am a buffer") | ||||
|  | ||||
| (assert (not= (buffer-factory) (buffer-factory)) "buffer instantiation") | ||||
|  | ||||
|   | ||||
							
								
								
									
										2
									
								
								tools/format.sh
									
									
									
									
									
										
										
										Executable file → Normal file
									
								
							
							
						
						
									
										2
									
								
								tools/format.sh
									
									
									
									
									
										
										
										Executable file → Normal file
									
								
							| @@ -1,4 +1,4 @@ | ||||
| #!/usr/bin/env bash | ||||
| #!/usr/bin/env sh | ||||
|  | ||||
| # Format all code with astyle | ||||
|  | ||||
|   | ||||
		Reference in New Issue
	
	Block a user