mirror of
				https://github.com/janet-lang/janet
				synced 2025-10-29 06:37:41 +00:00 
			
		
		
		
	Compare commits
	
		
			1 Commits
		
	
	
		
	
	| Author | SHA1 | Date | |
|---|---|---|---|
|   | be89d10004 | 
							
								
								
									
										11
									
								
								.builds/.freebsd.yaml
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										11
									
								
								.builds/.freebsd.yaml
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,11 @@ | ||||
| image: freebsd/latest | ||||
| packages: | ||||
|   - gmake | ||||
| tasks: | ||||
|   - build: | | ||||
|       cd janet | ||||
|       gmake | ||||
|       gmake test | ||||
|       sudo gmake install | ||||
|       gmake test-install | ||||
|       gmake test-amalg | ||||
							
								
								
									
										11
									
								
								.builds/.openbsd.yaml
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										11
									
								
								.builds/.openbsd.yaml
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,11 @@ | ||||
| image: openbsd/6.5 | ||||
| packages: | ||||
|   - gmake | ||||
| tasks: | ||||
|   - build: | | ||||
|       cd janet | ||||
|       gmake | ||||
|       gmake test | ||||
|       doas gmake install | ||||
|       gmake test-install | ||||
|       gmake test-amalg | ||||
| @@ -1,12 +0,0 @@ | ||||
| image: freebsd/12.x | ||||
| sources: | ||||
| - https://git.sr.ht/~bakpakin/janet | ||||
| packages: | ||||
| - gmake | ||||
| tasks: | ||||
| - build: | | ||||
|     cd janet | ||||
|     gmake | ||||
|     gmake test | ||||
|     sudo gmake install | ||||
|     gmake test-install | ||||
| @@ -1,23 +0,0 @@ | ||||
| image: archlinux | ||||
| sources: | ||||
| - https://git.sr.ht/~bakpakin/janet | ||||
| packages: | ||||
| - meson | ||||
| tasks: | ||||
| - with-epoll: | | ||||
|     cd janet | ||||
|     meson setup with-epoll --buildtype=release | ||||
|     cd with-epoll | ||||
|     meson configure -Depoll=true | ||||
|     ninja | ||||
|     ninja test | ||||
| - no-epoll: | | ||||
|     cd janet | ||||
|     meson setup no-epoll --buildtype=release | ||||
|     cd no-epoll | ||||
|     meson configure -Depoll=false | ||||
|     ninja | ||||
|     ninja test | ||||
|     sudo ninja install | ||||
|     sudo jpm --verbose install circlet | ||||
|     sudo jpm --verbose install spork | ||||
| @@ -1,33 +0,0 @@ | ||||
| image: openbsd/latest | ||||
| sources: | ||||
| - https://git.sr.ht/~bakpakin/janet | ||||
| packages: | ||||
| - gmake | ||||
| - meson | ||||
| tasks: | ||||
| - gmake: | | ||||
|     cd janet | ||||
|     gmake | ||||
|     gmake test | ||||
|     doas gmake install | ||||
|     gmake test-install | ||||
| - meson_min: | | ||||
|     cd janet | ||||
|     meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dtyped_array=false -Dreduced_os=true | ||||
|     cd build_meson_min | ||||
|     ninja | ||||
| - meson_prf: | | ||||
|     cd janet | ||||
|     meson setup build_meson_prf --buildtype=release -Dprf=true | ||||
|     cd build_meson_prf | ||||
|     ninja | ||||
|     ninja test | ||||
| - meson_default: | | ||||
|     cd janet | ||||
|     meson setup build_meson_default --buildtype=release | ||||
|     cd build_meson_default | ||||
|     ninja | ||||
|     ninja test | ||||
|     doas ninja install | ||||
|     doas jpm --verbose install circlet | ||||
|  | ||||
							
								
								
									
										12
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										12
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							| @@ -1,10 +1,2 @@ | ||||
| *.janet linguist-language=Clojure | ||||
|  | ||||
| *.janet text eol=lf | ||||
| *.c text eol=lf | ||||
| *.h text eol=lf | ||||
| *.md text eol=lf | ||||
| *.yml text eol=lf | ||||
| *.build text eol=lf | ||||
| *.txt text eol=lf | ||||
| *.sh text eol=lf | ||||
| # Use an approximate language for syntax highlighting (clojure is pretty close) | ||||
| *.janet linguist-language=clojure | ||||
|   | ||||
							
								
								
									
										22
									
								
								.gitignore
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										22
									
								
								.gitignore
									
									
									
									
										vendored
									
									
								
							| @@ -13,12 +13,6 @@ janet | ||||
| janet-*.tar.gz | ||||
| dist | ||||
|  | ||||
| # jpm lockfile | ||||
| lockfile.janet | ||||
|  | ||||
| # Kakoune (fzf via fd) | ||||
| .fdignore | ||||
|  | ||||
| # VSCode | ||||
| .vscode | ||||
|  | ||||
| @@ -26,16 +20,9 @@ lockfile.janet | ||||
| .project | ||||
| .cproject | ||||
|  | ||||
| # Gnome Builder | ||||
| .buildconfig | ||||
|  | ||||
| # Local directory for testing | ||||
| local | ||||
|  | ||||
| # Common test files I use. | ||||
| temp.janet | ||||
| scratch.janet | ||||
|  | ||||
| # Emscripten | ||||
| *.bc | ||||
| janet.js | ||||
| @@ -47,7 +34,6 @@ janet.wasm | ||||
|  | ||||
| # Generate test files | ||||
| *.out | ||||
| .orig | ||||
|  | ||||
| # Tools | ||||
| xxd | ||||
| @@ -55,7 +41,6 @@ xxd.exe | ||||
|  | ||||
| # VSCode | ||||
| .vs | ||||
| .clangd | ||||
|  | ||||
| # Swap files | ||||
| *.swp | ||||
| @@ -67,10 +52,6 @@ tags | ||||
| vgcore.* | ||||
| *.out.* | ||||
|  | ||||
| # Wix artifacts | ||||
| *.msi | ||||
| *.wixpdb | ||||
|  | ||||
| # Created by https://www.gitignore.io/api/c | ||||
|  | ||||
| ### C ### | ||||
| @@ -141,6 +122,3 @@ compile_commands.json | ||||
| CTestTestfile.cmake | ||||
|  | ||||
| # End of https://www.gitignore.io/api/cmake | ||||
|  | ||||
| # Astyle | ||||
| *.orig | ||||
|   | ||||
| @@ -4,7 +4,8 @@ script: | ||||
| - make test | ||||
| - sudo make install | ||||
| - make test-install | ||||
| - JANET_DIST_DIR=janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME} make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz | ||||
| - make test-amalg | ||||
| - make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz | ||||
| compiler: | ||||
| - clang | ||||
| - gcc | ||||
|   | ||||
							
								
								
									
										516
									
								
								CHANGELOG.md
									
									
									
									
									
								
							
							
						
						
									
										516
									
								
								CHANGELOG.md
									
									
									
									
									
								
							| @@ -1,520 +1,8 @@ | ||||
| # Changelog | ||||
| All notable changes to this project will be documented in this file. | ||||
|  | ||||
| ## 1.16.1 - 2021-06-09 | ||||
| - Add `maclintf` - a utility for adding linting messages when inside macros. | ||||
| - Print source code of offending line on compiler warnings and errors. | ||||
| - Fix some issues with linting and re-add missing `make docs`. | ||||
| - Allow controlling linting with dynamic bindings `:lint-warn`, `:lint-error`, and `:lint-levels`. | ||||
| - Add `-w` and `-x` command line flags to the `janet` binary to set linting thresholds. | ||||
|   linting thresholds are as follows: | ||||
|     - :none - will never be trigger. | ||||
|     - :relaxed - will only trigger on `:relaxed` lints. | ||||
|     - :normal - will trigger on `:relaxed` and `:normal` lints. | ||||
|     - :strict - will trigger on `:strict`, `:normal`, and `:relaxed` lints. This will catch the most issues | ||||
|       but can be distracting. | ||||
| ## 0.6.0 - ?? | ||||
|  | ||||
| ## 1.16.0 - 2021-05-30 | ||||
| - Add color documentation to the `doc` macro - enable/disable with `(dyn :doc-color)`. | ||||
| - Remove simpler HTML docs from distribution - use website or built-in documentation instead. | ||||
| - Add compiler warnings and deprecation levels. | ||||
| - Add `as-macro` to make using macros within quasiquote easier to do hygienically. | ||||
| - Expose `JANET_OUT_OF_MEMORY` as part of the Janet API. | ||||
| - Add `native-deps` option to `decalre-native` in `jpm`. This lets native libraries link to other | ||||
|   native libraries when building with jpm. | ||||
| - Remove the `tarray` module. The functionality of typed arrays will be moved to an external module | ||||
|   that can be installed via `jpm`. | ||||
| - Add `from-pairs` to core. | ||||
| - Add `JPM_OS_WHICH` environment variable to jpm to allow changing auto-detection behavior. | ||||
| - The flychecker will consider any top-level calls of functions that start with `define-` to | ||||
|   be safe to execute and execute them. This allows certain patterns (like spork/path) to be | ||||
|   better processed by the flychecker. | ||||
|  | ||||
| ## 1.15.5 - 2021-04-25 | ||||
| - Add `declare-headers` to jpm. | ||||
| - Fix error using unix pipes on BSDs. | ||||
| - Support .cc and .cxx extensions in `jpm` for C++ code. | ||||
| - Change networking code to not create as many HUP errors. | ||||
| - Add `net/shutdown` to close sockets in one direction without hang ups. | ||||
| - Update code for printing the debug repl | ||||
|  | ||||
| ## 1.15.4 - 2021-03-16 | ||||
| - Increase default nesting depth of pretty printing to `JANET_RECURSION_GUARD` | ||||
| - Update meson.build | ||||
| - Add option to automatically add shebang line in installed scripts with `jpm`. | ||||
| - Add `partition-by` and `group-by` to the core. | ||||
| - Sort keys in pretty printing output. | ||||
|  | ||||
| ## 1.15.3 - 2021-02-28 | ||||
| - Fix a fiber bug that occured in deeply nested fibers | ||||
| - Add `unref` combinator to pegs. | ||||
| - Small docstring changes. | ||||
|  | ||||
| ## 1.15.2 - 2021-02-15 | ||||
| - Fix bug in windows version of `os/spawn` and `os/execute` with setting environment variables. | ||||
| - Fix documentation typos. | ||||
| - Fix peg integer reading combinators when used with capture tags. | ||||
|  | ||||
| ## 1.15.0 - 2021-02-08 | ||||
| - Fix `gtim` and `ltim` bytecode instructions on non-integer values. | ||||
| - Clean up output of flychecking to be the same as the repl. | ||||
| - Change behavior of `debug/stacktrace` with a nil error value. | ||||
| - Add optional argument to `parser/produce`. | ||||
| - Add `no-core` option to creating standalone binaries to make execution faster. | ||||
| - Fix bug where a buffer overflow could be confused with an out of memory error. | ||||
| - Change error output to `file:line:column: message`. Column is in bytes - tabs | ||||
|   are considered to have width 1 (instead of 8). | ||||
|  | ||||
| ## 1.14.2 - 2021-01-23 | ||||
| - Allow `JANET_PROFILE` env variable to load a profile before loading the repl. | ||||
| - Update `tracev` macro to allow `def` and `var` inside to work as expected. | ||||
| - Use `(dyn :peg-grammar)` for passing a default grammar to `peg/compile` instead of loading | ||||
|   `default-peg-grammar` directly from the root environment. | ||||
| - Add `ev/thread` for combining threading with the event loop. | ||||
| - Add `ev/do-thread` to make `ev/thread` easier to use. | ||||
| - Automatically set supervisor channel in `net/accept-loop` and `net/server` correctly. | ||||
|  | ||||
| ## 1.14.1 - 2021-01-18 | ||||
| - Add `doc-of` for reverse documentation lookup. | ||||
| - Add `ev/give-supervsior` to send a message to the supervising channel. | ||||
| - Add `ev/gather` and `chan` argument to `ev/go`. This new argument allows "supervisor channels" | ||||
|   for fibers to enable structured concurrency. | ||||
| - Make `-k` flag work on stdin if no files are given. | ||||
| - Add `flycheck` function to core. | ||||
| - Make `backmatch` and `backref` more expressive in pegs. | ||||
| - Fix buggy `string/split`. | ||||
| - Add `fiber/last-value` to get the value that was last yielded, errored, or signaled | ||||
|   by a fiber. | ||||
| - Remove `:generate` verb from `loop` macros. Instead, use the `:in` verb | ||||
|   which will now work on fibers as well as other data structures. | ||||
| - Define `next`, `get`, and `in` for fibers. This lets | ||||
|   `each`, `map`, and similar iteration macros can now iterate over fibers. | ||||
| - Remove macro `eachy`, which can be replaced by `each`. | ||||
| - Add `dflt` argument to find-index. | ||||
| - Deprecate `file/popen` in favor of `os/spawn`. | ||||
| - Add `:all` keyword to `ev/read` and `net/read` to make them more like `file/read`. However, we | ||||
|   do not provide any `:line` option as that requires buffering. | ||||
| - Change repl behavior to make Ctrl-C raise SIGINT on posix. The old behavior for Ctrl-C, | ||||
|   to clear the current line buffer, has been moved to Ctrl-Q. | ||||
| - Importing modules that start with `/` is now the only way to import from project root. | ||||
|   Before, this would import from / on disk. Previous imports that did not start with `.` or `/` | ||||
|   are now unambiguously importing from the syspath, instead of checking both the syspath and | ||||
|   the project root. This is backwards incompatible and dependencies should be updated for this. | ||||
| - Change hash function for numbers. | ||||
| - Improve error handling of `dofile`. | ||||
| - Bug fixes in networking and subprocess code. | ||||
| - Use markdown formatting in more places for docstrings. | ||||
|  | ||||
| ## 1.13.1 - 2020-12-13 | ||||
| - Pretty printing a table with a prototype will look for `:_name` instead of `:name` | ||||
|   in the prototype table to tag the output. | ||||
| - `match` macro implementation changed to be tail recursive. | ||||
| - Adds a :preload loader which allows one to manually put things into `module/cache`. | ||||
| - Add `buffer/push` function. | ||||
| - Backtick delimited strings and buffers are now reindented based on the column of the | ||||
|   opening delimiter. Whitespace in columns to the left of the starting column is ignored unless | ||||
|   there are non-space/non-newline characters in that region, in which case the old behavior is preserved. | ||||
| - Argument to `(error)` combinator in PEGs is now optional. | ||||
| - Add `(line)` and `(column)` combinators to PEGs to capture source line and column. | ||||
|   This should make error reporting a bit easier. | ||||
| - Add `merge-module` to core. | ||||
| - During installation and release, merge janetconf.h into janet.h for easier install. | ||||
| - Add `upscope` special form. | ||||
| - `os/execute` and `os/spawn` can take streams for redirecting IO. | ||||
| - Add `:parser` and `:read` parameters to `run-context`. | ||||
| - Add `os/open` if ev is enabled. | ||||
| - Add `os/pipe` if ev is enabled. | ||||
| - Add `janet_thread_current(void)` to C API | ||||
| - Add integer parsing forms to pegs. This makes parsing many binary protocols easier. | ||||
| - Lots of updates to networking code - now can use epoll (or poll) on linux and IOCP on windows. | ||||
| - Add `ev/` module. This exposes a fiber scheduler, queues, timeouts, and other functionality to users | ||||
|   for single threaded cooperative scheduling and asynchronous IO. | ||||
| - Add `net/accept-loop` and `net/listen`. These functions break down `net/server` into it's essential parts | ||||
|   and are more flexible. They also allow further improvements to these utility functions. | ||||
| - Various small bug fixes. | ||||
|  | ||||
| ## 1.12.2 - 2020-09-20 | ||||
| - Add janet\_try and janet\_restore to C API. | ||||
| - Fix `os/execute` regression on windows. | ||||
| - Add :pipe option to `os/spawn`. | ||||
| - Fix docstring typos. | ||||
|  | ||||
| ## 1.12.1 - 2020-09-07 | ||||
| - Make `zero?`, `one?`, `pos?`, and `neg?` polymorphic. | ||||
| - Add C++ support to jpm and improve C++ interop in janet.h. | ||||
| - Add `%t` formatter to `printf`, `string/format`, and other formatter functions. | ||||
| - Expose `janet_cfuns_prefix` in C API. | ||||
| - Add `os/proc-wait` and `os/proc-kill` for interacting with processes. | ||||
| - Add `janet_getjfile` to C API. | ||||
| - Allow redirection of stdin, stdout, and stderr by passing keywords in the env table in `os/spawn` and `os/execute`. | ||||
| - Add `os/spawn` to get a core/process back instead of an exit code as in `os/execute`. | ||||
|   When called like this, `os/execute` returns immediately. | ||||
| - Add `:x` flag to os/execute to raise error when exit code is non-zero. | ||||
| - Don't run `main` when flychecking. | ||||
| - Add `:n` flag to `file/open` to raise an error if file cannot be opened. | ||||
| - Fix import macro to not try and coerce everything to a string. | ||||
| - Allow passing a second argument to `disasm`. | ||||
| - Add `cancel`. Resumes a fiber but makes it immediately error at the yield point. | ||||
| - Allow multi-line paste into built in repl. | ||||
| - Add `(curenv)`. | ||||
| - Change `net/read`, `net/chunk`, and `net/write` to raise errors in the case of failures. | ||||
| - Add `janet_continue_signal` to C API. This indirectly enables C functions that yield to the event loop | ||||
|   to raise errors or other signals. | ||||
| - Update meson build script to fix bug on Debian's version of meson | ||||
| - Add `xprint`, `xprin`, `xprintf`, and `xprinf`. | ||||
| - `net/write` now raises an error message if write fails. | ||||
| - Fix issue with SIGPIPE on macOS and BSDs. | ||||
|  | ||||
| ## 1.11.3 - 2020-08-03 | ||||
| - Add `JANET_HASHSEED` environment variable when `JANET_PRF` is enabled. | ||||
| - Expose `janet_cryptorand` in C API. | ||||
| - Properly initialize PRF in default janet program | ||||
| - Add `index-of` to core library. | ||||
| - Add `-fPIC` back to core CFLAGS (non-optional when compiling default client with Makefile) | ||||
| - Fix defaults on Windows for ARM | ||||
| - Fix defaults on NetBSD. | ||||
|  | ||||
| ## 1.11.1 - 2020-07-25 | ||||
| - Fix jpm and git with multiple git installs on Windows | ||||
| - Fix importing a .so file in the current directory | ||||
| - Allow passing byte sequence types directly to typed-array constructors. | ||||
| - Fix bug sending files between threads. | ||||
| - Disable PRF by default. | ||||
| - Update the soname. | ||||
|  | ||||
| ## 1.11.0 - 2020-07-18 | ||||
| - Add `forever` macro. | ||||
| - Add `any?` predicate to core. | ||||
| - Add `jpm list-pkgs` subcommand to see which package aliases are in the listing. | ||||
| - Add `jpm list-installed` subcommand to see which packages are installed. | ||||
| - Add `math/int-min`, `math/int-max`, `math/int32-min`, and `math/int32-max` for getting integer limits. | ||||
| - The gc interval is now autotuned, to prevent very bad gc behavior. | ||||
| - Improvements to the bytecode compiler, Janet will now generate more efficient bytecode. | ||||
| - Add `peg/find`, `peg/find-all`, `peg/replace`, and `peg/replace-all` | ||||
| - Add `math/nan` | ||||
| - Add `forv` macro | ||||
| - Add `symbol/slice` | ||||
| - Add `keyword/slice` | ||||
| - Allow cross compilation with Makefile. | ||||
| - Change `compare-primitve` to `cmp` and make it more efficient. | ||||
| - Add `reverse!` for reversing an array or buffer in place. | ||||
| - `janet_dobytes` and `janet_dostring` return parse errors in \*out | ||||
| - Add `repeat` macro for iterating something n times. | ||||
| - Add `eachy` (each yield) macro for iterating a fiber. | ||||
| - Fix `:generate` verb in loop macro to accept non symbols as bindings. | ||||
| - Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexidecimal digits. | ||||
| - Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf). | ||||
|  | ||||
| ## 1.10.1 - 2020-06-18 | ||||
| - Expose `janet_table_clear` in API. | ||||
| - Respect `JANET_NO_PROCESSES` define when building | ||||
| - Fix `jpm` rules having multiple copies of the same dependency. | ||||
| - Fix `jpm` install in some cases. | ||||
| - Add `array/trim` and `buffer/trim` to shrink the backing capacity of these types | ||||
|   to their current length. | ||||
|  | ||||
| ## 1.10.0 - 2020-06-14 | ||||
| - Hardcode default jpm paths on install so env variables are needed in fewer cases. | ||||
| - Add `:no-compile` to `create-executable` option for jpm. | ||||
| - Fix bug with the `trace` function. | ||||
| - Add `:h`, `:a`, and `:c` flags to `thread/new` for creating new kinds of threads. | ||||
|   By default, threads will now consume much less memory per thread, but sending data between | ||||
|   threads may cost more. | ||||
| - Fix flychecking when using the `use` macro. | ||||
| - CTRL-C no longer exits the repl, and instead cancels the current form. | ||||
| - Various small bug fixes | ||||
| - New MSI installer instead of NSIS based installer. | ||||
| - Make `os/realpath` work on windows. | ||||
| - Add polymorphic `compare` functions for comparing numbers. | ||||
| - Add `to` and `thru` peg combinators. | ||||
| - Add `JANET_GIT` environment variable to jpm to use a specific git binary (useful mainly on windows). | ||||
| - `asm` and `disasm` functions now use keywords instead of macros for keys. Also | ||||
|   some slight changes to the way constants are encoded (remove wrapping `quote` in some cases). | ||||
| - Expose current macro form inside macros as (dyn :macro-form) | ||||
| - Add `tracev` macro. | ||||
| - Fix compiler bug that emitted incorrect code in some cases for while loops that create closures. | ||||
| - Add `:fresh` option to `(import ...)` to overwrite the module cache. | ||||
| - `(range x y 0)` will return an empty array instead of hanging forever. | ||||
| - Rename `jpm repl` to `jpm debug-repl`. | ||||
|  | ||||
| ## 1.9.1 - 2020-05-12 | ||||
| - Add :prefix option to declare-source | ||||
| - Re-enable minimal builds with the debugger. | ||||
| - Add several flags for configuring Janet on different platforms. | ||||
| - Fix broken meson build from 1.9.0 and add meson to CI. | ||||
| - Fix compilation issue when nanboxing is disabled. | ||||
|  | ||||
| ## 1.9.0 - 2020-05-10 | ||||
| - Add `:ldflags` option to many jpm declare functions. | ||||
| - Add `errorf` to core. | ||||
| - Add `lenprefix` combinator to PEGs. | ||||
| - Add `%M`, `%m`, `%N`, and `%n` formatters to formatting functions. These are the | ||||
|   same as `%Q`, `%q`, `%P`, and `%p`, but will not truncate long values. | ||||
| - Add `fiber/root`. | ||||
| - Add beta `net/` module to core for socket based networking. | ||||
| - Add the `parse` function to parse strings of source code more conveniently. | ||||
| - Add `jpm rule-tree` subcommand. | ||||
| - Add `--offline` flag to jpm to force use of the cache. | ||||
| - Allow sending pointers and C functions across threads via `thread/send`. | ||||
| - Fix bug in `getline`. | ||||
| - Add `sh-rule` and `sh-phony` to jpm's dialect of Janet. | ||||
| - Change C api's `janet_formatb` -> `janet_formatbv`, and add new function `janet_formatb` to C api. | ||||
| - Add `edefer` macro to core. | ||||
| - A struct/table literal/constructor with duplicate keys will use the last value given. | ||||
|   Previously, this was inconsistent between tables and structs, literals and constructor functions. | ||||
| - Add debugger to core. The debugger functions are only available | ||||
|   in a debug repl, and are prefixed by a `.`. | ||||
| - Add `sort-by` and `sorted-by` to core. | ||||
| - Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXX`. | ||||
| - Add `math/erf` | ||||
| - Add `math/erfc` | ||||
| - Add `math/log1p` | ||||
| - Add `math/next` | ||||
| - Add os/umask | ||||
| - Add os/perm-int | ||||
| - Add os/perm-string | ||||
| - Add :int-permissions option for os/stat. | ||||
| - Add `jpm repl` subcommand, as well as `post-deps` macro in project.janet files. | ||||
| - Various bug fixes. | ||||
|  | ||||
| ## 1.8.1 - 2020-03-31 | ||||
| - Fix bugs for big endian systems | ||||
| - Fix 1.8.0 regression on BSDs | ||||
|  | ||||
| ## 1.8.0 - 2020-03-29 | ||||
| - Add `reduce2`, `accumulate`, and `accumulate2`. | ||||
| - Add lockfiles to `jpm` via `jpm make-lockfile` and `jpm load-lockfile`. | ||||
| - Add `os/realpath` (Not supported on windows). | ||||
| - Add `os/chmod`. | ||||
| - Add `chr` macro. | ||||
| - Allow `_` in the `match` macro to match anything without creating a binding | ||||
|   or doing unification. Also change behavior of matching nil. | ||||
| - Add `:range-to` and `:down-to` verbs in the `loop` macro. | ||||
| - Fix `and` and `or` macros returning nil instead of false in some cases. | ||||
| - Allow matching successfully against nil values in the `match` macro. | ||||
| - Improve `janet_formatc` and `janet_panicf` formatters to be more like `string/format`. | ||||
|   This makes it easier to make nice error messages from C. | ||||
| - Add `signal` | ||||
| - Add `fiber/can-resume?` | ||||
| - Allow fiber functions to accept arguments that are passed in via `resume`. | ||||
| - Make flychecking slightly less strict but more useful | ||||
| - Correct arity for `next` | ||||
| - Correct arity for `marshal` | ||||
| - Add `flush` and `eflush` | ||||
| - Add `prompt` and `return` on top of signal for user friendly delimited continuations. | ||||
| - Fix bug in buffer/blit when using the offset-src argument. | ||||
| - Fix segfault with malformed pegs. | ||||
|  | ||||
| ## 1.7.0 - 2020-02-01 | ||||
| - Remove `file/fileno` and `file/fdopen`. | ||||
| - Remove `==`, `not==`, `order<`, `order>`, `order<=`, and `order>=`. Instead, use the normal | ||||
|   comparison and equality functions. | ||||
| - Let abstract types define a hash function and comparison/equality semantics. This lets | ||||
|   abstract types much better represent value types. This adds more fields to abstract types, which | ||||
|   will generate warnings when compiled against other versions. | ||||
| - Remove Emscripten build. Instead, use the amalgamated source code with a custom toolchain. | ||||
| - Update documentation. | ||||
| - Add `var-` | ||||
| - Add `module/add-paths` | ||||
| - Add `file/temp` | ||||
| - Add `mod` function to core. | ||||
| - Small bug fixes | ||||
| - Allow signaling from C functions (yielding) via janet\_signalv. This | ||||
|   makes it easy to write C functions that work with event loops, such as | ||||
|   in libuv or embedded in a game. | ||||
| - Add '%j' formatting option to the format family of functions. | ||||
| - Add `defer` | ||||
| - Add `assert` | ||||
| - Add `when-with` | ||||
| - Add `if-with` | ||||
| - Add completion to the default repl based on currently defined bindings. Also generally improve | ||||
|   the repl keybindings. | ||||
| - Add `eachk` | ||||
| - Add `eachp` | ||||
| - Improve functionality of the `next` function. `next` now works on many different | ||||
|   types, not just tables and structs. This allows for more generic data processing. | ||||
| - Fix thread module issue where sometimes decoding a message failed. | ||||
| - Fix segfault regression when macros are called with bad arity. | ||||
|  | ||||
| ## 1.6.0 - 2019-12-22 | ||||
| - Add `thread/` module to the core. | ||||
| - Allow seeding RNGs with any sequence of bytes. This provides | ||||
|   a wider key space for the RNG. Exposed in C as `janet_rng_longseed`. | ||||
| - Fix issue in `resume` and similar functions that could cause breakpoints to be skipped. | ||||
| - Add a number of new math functions. | ||||
| - Improve debugger experience and capabilities. See examples/debugger.janet | ||||
|   for what an interactive debugger could look like. | ||||
| - Add `debug/step` (janet\_step in the C API) for single stepping Janet bytecode. | ||||
| - The built in repl now can enter the debugger on any signal (errors, yields, | ||||
|   user signals, and debug signals). To enable this, type (setdyn :debug true) | ||||
|   in the repl environment. | ||||
| - When exiting the debugger, the fiber being debugged is resumed with the exit value | ||||
|   of the debug session (the value returned by `(quit return-value)`, or nil if user typed Ctrl-D). | ||||
| - `(quit)` can take an optional argument that is the return value. If a module | ||||
|   contains `(quit some-value)`, the value of that module returned to `(require "somemod")` | ||||
|   is the return value. This lets module writers completely customize a module without writing | ||||
|   a loader. | ||||
| - Add nested quasiquotation. | ||||
| - Add `os/cryptorand` | ||||
| - Add `prinf` and `eprinf` to be have like `printf` and `eprintf`. The latter two functions | ||||
|   now including a trailing newline, like the other print functions. | ||||
| - Add nan? | ||||
| - Add `janet_in` to C API. | ||||
| - Add `truthy?` | ||||
| - Add `os/environ` | ||||
| - Add `buffer/fill` and `array/fill` | ||||
| - Add `array/new-filled` | ||||
| - Use `(doc)` with no arguments to see available bindings and dynamic bindings. | ||||
| - `jpm` will use `CC` and `AR` environment variables when compiling programs. | ||||
| - Add `comptime` macro for compile time evaluation. | ||||
| - Run `main` functions in scripts if they exist, just like jpm standalone binaries. | ||||
| - Add `protect` macro. | ||||
| - Add `root-env` to get the root environment table. | ||||
| - Change marshalling protocol with regard to abstract types. | ||||
| - Add `show-paths` to `jpm`. | ||||
| - Add several default patterns, like `:d` and `:s+`, to PEGs. | ||||
| - Update `jpm` path settings to make using `jpm` easier on non-global module trees. | ||||
| - Numerous small bug fixes and usability improvements. | ||||
|  | ||||
| ### 1.5.1 - 2019-11-16 | ||||
| - Fix bug when printing buffer to self in some edge cases. | ||||
| - Fix bug with `jpm` on windows. | ||||
| - Fix `update` return value. | ||||
|  | ||||
| ## 1.5.0 - 2019-11-10 | ||||
| - `os/date` now defaults to UTC. | ||||
| - Add `--test` flag to jpm to test libraries on installation. | ||||
| - Add `math/rng`, `math/rng-int`, and `math/rng-uniform`. | ||||
| - Add `in` function to index in a stricter manner. Conversely, `get` will | ||||
|   now not throw errors on bad keys. | ||||
| - Indexed types and byte sequences will now error when indexed out of range or | ||||
|   with bad keys. | ||||
| - Add rng functions to Janet. This also replaces the RNG behind `math/random` | ||||
|   and `math/seedrandom` with a consistent, platform independent RNG. | ||||
| - Add `with-vars` macro. | ||||
| - Add the `quickbin` command to jpm. | ||||
| - Create shell.c when making the amalgamated source. This can be compiled with | ||||
|   janet.c to make the janet interpreter. | ||||
| - Add `cli-main` function to the core, which invokes Janet's CLI interface. | ||||
|   This basically moves what was init.janet into boot.janet. | ||||
| - Improve flychecking, and fix flychecking bugs introduced in 1.4.0. | ||||
| - Add `prin`, `eprint`, `eprintf` and `eprin` functions. The | ||||
|   functions prefix with e print to `(dyn :err stderr)` | ||||
| - Print family of functions can now also print to buffers | ||||
|   (before, they could only print to files.) Output can also | ||||
|   be completely disabled with `(setdyn :out false)`. | ||||
| - `printf` is now a c function for optimizations in the case | ||||
|   of printing to buffers. | ||||
|  | ||||
| ## 1.4.0 - 2019-10-14 | ||||
| - Add `quit` function to exit from a repl, but not always exit the entire | ||||
|   application. | ||||
| - Add `update-pkgs` to jpm. | ||||
| - Integrate jpm with https://github.com/janet-lang/pkgs.git. jpm can now | ||||
|   install packages based on their short names in the package listing, which | ||||
|   can be customized via an env variable. | ||||
| - Add `varfn` macro | ||||
| - Add compile time arity checking when function in function call is known. | ||||
| - Added `slice` to the core library. | ||||
| - The `*/slice` family of functions now can take nil as start or end to get | ||||
|   the same behavior as the defaults (0 and -1) for those parameters. | ||||
| - `string/` functions that take a pattern to search for will throw an error | ||||
|   when receiving the empty string. | ||||
| - Replace (start:end) style stacktrace source position information with | ||||
|   line, column. This should be more readable for humans. Also, range information | ||||
|   can be recovered by re-parsing source. | ||||
|  | ||||
| ## 1.3.1 - 2019-09-21 | ||||
| - Fix some linking issues when creating executables with native dependencies. | ||||
| - jpm now runs each test script in a new interpreter. | ||||
| - Fix an issue that prevent some valid programs from compiling. | ||||
| - Add `mean` to core. | ||||
| - Abstract types that implement the `:+`, `:-`, `:*`, `:/`, `:>`, `:==`, `:<`, | ||||
|   `:<=`, and `:>=` methods will work with the corresponding built-in | ||||
|   arithmetic functions. This means built-in integer types can now be used as | ||||
|   normal number values in many contexts. | ||||
| - Allow (length x) on typed arrays an other abstract types that implement | ||||
|   the :length method. | ||||
|  | ||||
| ## 1.3.0 - 2019-09-05 | ||||
| - Add `get-in`, `put-in`, `update-in`, and `freeze` to core. | ||||
| - Add `jpm run rule` and `jpm rules` to jpm to improve utility and discoverability of jpm. | ||||
| - Remove `cook` module and move `path` module to https://github.com/janet-lang/path.git. | ||||
|   The functionality in `cook` is now bundled directly in the `jpm` script. | ||||
| - Add `buffer/format` and `string/format` format flags `Q` and `q` to print colored and | ||||
|   non-colored single-line values, similar to `P` and `p`. | ||||
| - Change default repl to print long sequences on one line and color stacktraces if color is enabled. | ||||
| - Add `backmatch` pattern for PEGs. | ||||
| - jpm detects if not in a Developer Command prompt on windows for a better error message. | ||||
| - jpm install git submodules in dependencies | ||||
| - Change default fiber stack limit to the maximum value of a 32 bit signed integer. | ||||
| - Some bug fixes with `jpm` | ||||
| - Fix bugs with pegs. | ||||
| - Add `os/arch` to get ISA that janet was compiled for | ||||
| - Add color to stacktraces via `(dyn :err-color)` | ||||
|  | ||||
| ## 1.2.0 - 2019-08-08 | ||||
| - Add `take` and `drop` functions that are easier to use compared to the | ||||
|   existing slice functions. | ||||
| - Add optional default value to `get`. | ||||
| - Add function literal short-hand via `|` reader macro, which maps to the | ||||
|   `short-fn` macro. | ||||
| - Add `int?` and `nat?` functions to the core. | ||||
| - Add `(dyn :executable)` at top level to get what used to be | ||||
|   `(process/args 0)`. | ||||
| - Add `:linux` to platforms returned by `(os/which)`. | ||||
| - Update jpm to build standalone executables. Use `declare-executable` for this. | ||||
| - Add `use` macro. | ||||
| - Remove `process/args` in favor of `(dyn :args)`. | ||||
| - Fix bug with Nanbox implementation allowing users to created | ||||
|   custom values of any type with typed array and marshal modules, which | ||||
|   was unsafe. | ||||
| - Add `janet_wrap_number_safe` to API, for converting numbers to Janets | ||||
|   where the number could be any 64 bit, user provided bit pattern. Certain | ||||
|   NaN values (which a machine will never generate as a result of a floating | ||||
|   point operation) are guarded against and converted to a default NaN value. | ||||
|  | ||||
| ## 1.1.0 - 2019-07-08 | ||||
| - Change semantics of `-l` flag to be import rather than dofile. | ||||
| - Fix compiler regression in top level defs with destructuring. | ||||
| - Add `table/clone`. | ||||
| - Improve `jpm` tool with git and dependency capabilities, as well as better | ||||
|   module uninstalls. | ||||
|  | ||||
| ## 1.0.0 - 2019-07-01 | ||||
| - Add `with` macro for resource handling. | ||||
| - Add `propagate` function so we can "rethrow" signals after they are | ||||
|   intercepted. This makes signals even more flexible. | ||||
| - Add `JANET_NO_DOCSTRINGS` and `JANET_NO_SOURCEMAPS` defines in janetconf.h | ||||
|   for shrinking binary size. | ||||
|   This seems to save about 50kB in most builds, so it's not usually worth it. | ||||
| - Update module system to allow relative imports. The `:cur:` pattern | ||||
|   in `module/expand-path` will expand to the directory part of the current file, or | ||||
|   whatever the value of `(dyn :current-file)` is. The `:dir:` pattern gets | ||||
|   the directory part of the input path name. | ||||
| - Remove `:native:` pattern in `module/paths`. | ||||
| - Add `module/expand-path` | ||||
| - Remove `module/*syspath*` and `module/*headerpath*` in favor of dynamic | ||||
|   bindings `:syspath` and `:headerpath`. | ||||
| - Compiled PEGs can now be marshaled and unmarshaled. | ||||
| - Change signature to `parser/state` | ||||
| - Add `:until` verb to loop. | ||||
| - Add `:p` flag to `fiber/new`. | ||||
| - Add `file/{fdopen,fileno}` functions. | ||||
| - Add `parser/clone` function. | ||||
| - Add optional argument to `parser/where` to set parser byte index. | ||||
| - Add optional `env` argument to `all-bindings` and `all-dynamics`. | ||||
| - Add scratch memory C API functions for auto-released memory on next gc. | ||||
|   Scratch memory differs from normal GCed memory as it can also be freed normally | ||||
|   for better performance. | ||||
| - Add API compatibility checking for modules. This will let native modules not load | ||||
|   when the host program is not of a compatible version or configuration. | ||||
| - Change signature of `os/execute` to be much more flexible. | ||||
|  | ||||
| ## 0.6.0 - 2019-05-29 | ||||
| - `file/close` returns exit code when closing file opened with `file/popen`. | ||||
| - Add `os/rename` | ||||
| - Update windows installer to include tools like `jpm`. | ||||
| - Add `jpm` tool for building and managing projects. | ||||
| - Change interface to `cook` tool. | ||||
| - Add optional filters to `module/paths` to further refine import methods. | ||||
| @@ -593,7 +81,7 @@ All notable changes to this project will be documented in this file. | ||||
| - Disallow NaNs as table or struct keys | ||||
| - Update module resolution paths and format | ||||
|  | ||||
| ## 0.3.0 - 2019-01-26 | ||||
| ## 0.3.0 - 2019-26-01 | ||||
| - Add amalgamated build to janet for easier embedding. | ||||
| - Add os/date function | ||||
| - Add slurp and spit to core library. | ||||
|   | ||||
| @@ -14,6 +14,7 @@ Please read this document before making contributions. | ||||
|   on how to reproduce it. If it is a compiler or language bug, please try to include a minimal | ||||
|   example. This means don't post all 200 lines of code from your project, but spend some time | ||||
|   distilling the problem to just the relevant code. | ||||
| * Add the `bug` tag to the issue. | ||||
|  | ||||
| ## Contributing Changes | ||||
|  | ||||
| @@ -29,13 +30,13 @@ may require changes before being merged. | ||||
|   the test folder and make sure it is run when`make test` is invoked. | ||||
| * Be consistent with the style. For C this means follow the indentation and style in | ||||
|   other files (files have MIT license at top, 4 spaces indentation, no trailing | ||||
|   whitespace, cuddled brackets, etc.) Use `make format` to automatically format your C code with | ||||
|           whitespace, cuddled brackets, etc.) Use `make format` to | ||||
|   automatically format your C code with | ||||
|   [astyle](http://astyle.sourceforge.net/astyle.html). You will probably need | ||||
|   to install this, but it can be installed with most package managers. | ||||
|  | ||||
|   For janet code, use lisp indentation with 2 spaces. One can use janet.vim to | ||||
|   do this indentation, or approximate as close as possible. There is a janet formatter | ||||
|   in [spork](https://github.com/janet-lang/spork.git) that can be used to format code as well. | ||||
|   For janet code, the use lisp indentation with 2 spaces. One can use janet.vim to | ||||
|   do this indentation, or approximate as close as possible. | ||||
|  | ||||
| ## C style | ||||
|  | ||||
| @@ -73,3 +74,4 @@ timely manner. In short, if you want extra functionality now, then build it. | ||||
|  | ||||
| * Include a good description of the problem that is being solved | ||||
| * Include descriptions of potential solutions if you have some in mind. | ||||
| * Add the appropriate tags to the issue. For new features, add the `enhancement` tag. | ||||
|   | ||||
							
								
								
									
										2
									
								
								LICENSE
									
									
									
									
									
								
							
							
						
						
									
										2
									
								
								LICENSE
									
									
									
									
									
								
							| @@ -1,4 +1,4 @@ | ||||
| Copyright (c) 2021 Calvin Rose and contributors | ||||
| Copyright (c) 2019 Calvin Rose and contributors | ||||
|  | ||||
| Permission is hereby granted, free of charge, to any person obtaining a copy of | ||||
| this software and associated documentation files (the "Software"), to deal in | ||||
|   | ||||
							
								
								
									
										315
									
								
								Makefile
									
									
									
									
									
								
							
							
						
						
									
										315
									
								
								Makefile
									
									
									
									
									
								
							| @@ -1,4 +1,4 @@ | ||||
| # Copyright (c) 2021 Calvin Rose | ||||
| # Copyright (c) 2019 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 | ||||
| @@ -24,60 +24,45 @@ | ||||
|  | ||||
| PREFIX?=/usr/local | ||||
|  | ||||
| INCLUDEDIR?=$(PREFIX)/include | ||||
| BINDIR?=$(PREFIX)/bin | ||||
| LIBDIR?=$(PREFIX)/lib | ||||
| JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 2> /dev/null || echo local)\"" | ||||
| CLIBS=-lm -lpthread | ||||
| INCLUDEDIR=$(PREFIX)/include | ||||
| BINDIR=$(PREFIX)/bin | ||||
| LIBDIR=$(PREFIX)/lib | ||||
| JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\"" | ||||
| CLIBS=-lm | ||||
| JANET_TARGET=build/janet | ||||
| JANET_LIBRARY=build/libjanet.so | ||||
| JANET_STATIC_LIBRARY=build/libjanet.a | ||||
| JANET_PATH?=$(LIBDIR)/janet | ||||
| JANET_MANPATH?=$(PREFIX)/share/man/man1/ | ||||
| JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig | ||||
| JANET_DIST_DIR?=janet-dist | ||||
| JANET_PATH?=$(PREFIX)/lib/janet | ||||
| MANPATH?=$(PREFIX)/share/man/man1/ | ||||
| PKG_CONFIG_PATH?=$(PREFIX)/lib/pkgconfig | ||||
| DEBUGGER=gdb | ||||
| SONAME_SETTER=-Wl,-soname, | ||||
|  | ||||
| # For cross compilation | ||||
| HOSTCC?=$(CC) | ||||
| HOSTAR?=$(AR) | ||||
| CFLAGS?=-O2 | ||||
| LDFLAGS?=-rdynamic | ||||
|  | ||||
| COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC | ||||
| BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 -g $(COMMON_CFLAGS) | ||||
| BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS) | ||||
|  | ||||
| # For installation | ||||
| LDCONFIG:=ldconfig "$(LIBDIR)" | ||||
| CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden \ | ||||
| 	   -DJANET_BUILD=$(JANET_BUILD) | ||||
| LDFLAGS=-rdynamic | ||||
|  | ||||
| # Check OS | ||||
| UNAME:=$(shell uname -s) | ||||
| ifeq ($(UNAME), Darwin) | ||||
| 	CLIBS:=$(CLIBS) -ldl | ||||
| 	SONAME_SETTER:=-Wl,-install_name, | ||||
| 	LDCONFIG:=true | ||||
| else ifeq ($(UNAME), Linux) | ||||
| 	CLIBS:=$(CLIBS) -lrt -ldl | ||||
| endif | ||||
| # For other unix likes, add flags here! | ||||
| ifeq ($(UNAME), Haiku) | ||||
| 	LDCONFIG:=true | ||||
| ifeq ($(UNAME),Haiku) | ||||
| 	LDFLAGS=-Wl,--export-dynamic | ||||
| endif | ||||
|  | ||||
| $(shell mkdir -p build/core build/c build/boot) | ||||
| all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h | ||||
| $(shell mkdir -p build/core build/mainclient build/webclient build/boot) | ||||
| all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) | ||||
|  | ||||
| ###################### | ||||
| ##### Name Files ##### | ||||
| ###################### | ||||
|  | ||||
| JANET_HEADERS=src/include/janet.h src/conf/janetconf.h | ||||
| JANET_HEADERS=src/include/janet.h src/include/janetconf.h | ||||
|  | ||||
| JANET_LOCAL_HEADERS=src/core/features.h \ | ||||
| 					src/core/util.h \ | ||||
| JANET_LOCAL_HEADERS=src/core/util.h \ | ||||
| 					src/core/state.h \ | ||||
| 					src/core/gc.h \ | ||||
| 					src/core/vector.h \ | ||||
| @@ -98,14 +83,12 @@ JANET_CORE_SOURCES=src/core/abstract.c \ | ||||
| 				   src/core/corelib.c \ | ||||
| 				   src/core/debug.c \ | ||||
| 				   src/core/emit.c \ | ||||
| 				   src/core/ev.c \ | ||||
| 				   src/core/fiber.c \ | ||||
| 				   src/core/gc.c \ | ||||
| 				   src/core/inttypes.c \ | ||||
| 				   src/core/io.c \ | ||||
| 				   src/core/marsh.c \ | ||||
| 				   src/core/math.c \ | ||||
| 				   src/core/net.c \ | ||||
| 				   src/core/os.c \ | ||||
| 				   src/core/parse.c \ | ||||
| 				   src/core/peg.c \ | ||||
| @@ -118,8 +101,8 @@ JANET_CORE_SOURCES=src/core/abstract.c \ | ||||
| 				   src/core/struct.c \ | ||||
| 				   src/core/symcache.c \ | ||||
| 				   src/core/table.c \ | ||||
| 				   src/core/thread.c \ | ||||
| 				   src/core/tuple.c \ | ||||
| 				   src/core/typedarray.c \ | ||||
| 				   src/core/util.c \ | ||||
| 				   src/core/value.c \ | ||||
| 				   src/core/vector.c \ | ||||
| @@ -132,63 +115,114 @@ JANET_BOOT_SOURCES=src/boot/array_test.c \ | ||||
| 				   src/boot/number_test.c \ | ||||
| 				   src/boot/system_test.c \ | ||||
| 				   src/boot/table_test.c | ||||
| JANET_BOOT_HEADERS=src/boot/tests.h | ||||
|  | ||||
| ########################################################## | ||||
| ##### The bootstrap interpreter that creates janet.c ##### | ||||
| ########################################################## | ||||
| JANET_MAINCLIENT_SOURCES=src/mainclient/line.c src/mainclient/main.c | ||||
|  | ||||
| JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES)) | ||||
| JANET_WEBCLIENT_SOURCES=src/webclient/main.c | ||||
|  | ||||
| $(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS) | ||||
| ################################################################## | ||||
| ##### The bootstrap interpreter that compiles the core image ##### | ||||
| ################################################################## | ||||
|  | ||||
| build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile | ||||
| 	$(CC) $(BOOT_CFLAGS) -o $@ -c $< | ||||
| JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES)) \ | ||||
| 	build/boot.gen.o | ||||
|  | ||||
| build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) | ||||
| 	$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ -c $< | ||||
|  | ||||
| build/janet_boot: $(JANET_BOOT_OBJECTS) | ||||
| 	$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS) | ||||
| 	$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ $^ $(CLIBS) | ||||
|  | ||||
| # Now the reason we bootstrap in the first place | ||||
| build/c/janet.c: build/janet_boot src/boot/boot.janet | ||||
| 	build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@ | ||||
| 	cksum $@ | ||||
| build/core_image.c: build/janet_boot | ||||
| 	build/janet_boot $@ JANET_PATH $(JANET_PATH) JANET_HEADERPATH $(INCLUDEDIR)/janet | ||||
|  | ||||
| ########################################################## | ||||
| ##### The main interpreter program and shared object ##### | ||||
| ########################################################## | ||||
|  | ||||
| JANET_CORE_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_CORE_SOURCES)) build/core_image.o | ||||
| JANET_MAINCLIENT_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_MAINCLIENT_SOURCES)) build/init.gen.o | ||||
|  | ||||
| # Compile the core image generated by the bootstrap build | ||||
| build/core_image.o: build/core_image.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) | ||||
| 	$(CC) $(CFLAGS) -o $@ -c $< | ||||
|  | ||||
| build/%.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) | ||||
| 	$(CC) $(CFLAGS) -o $@ -c $< | ||||
|  | ||||
| $(JANET_TARGET): $(JANET_CORE_OBJECTS) $(JANET_MAINCLIENT_OBJECTS) | ||||
| 	$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS) | ||||
|  | ||||
| $(JANET_LIBRARY): $(JANET_CORE_OBJECTS) | ||||
| 	$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS) | ||||
|  | ||||
| $(JANET_STATIC_LIBRARY): $(JANET_CORE_OBJECTS) | ||||
| 	$(AR) rcs $@ $^ | ||||
|  | ||||
| ###################### | ||||
| ##### Emscripten ##### | ||||
| ###################### | ||||
|  | ||||
| EMCC=emcc | ||||
| EMCFLAGS=-std=c99 -Wall -Wextra -Isrc/include -O2 \ | ||||
| 		  -s EXTRA_EXPORTED_RUNTIME_METHODS='["cwrap"]' \ | ||||
| 		  -s ALLOW_MEMORY_GROWTH=1 \ | ||||
| 		  -s AGGRESSIVE_VARIABLE_ELIMINATION=1 \ | ||||
| 		  -DJANET_BUILD=$(JANET_BUILD) | ||||
| JANET_EMTARGET=build/janet.js | ||||
| JANET_WEB_SOURCES=$(JANET_CORE_SOURCES) $(JANET_WEBCLIENT_SOURCES) | ||||
| JANET_EMOBJECTS=$(patsubst src/%.c,build/%.bc,$(JANET_WEB_SOURCES)) \ | ||||
| 				build/webinit.gen.bc build/core_image.bc | ||||
|  | ||||
| %.gen.bc: %.gen.c | ||||
| 	$(EMCC) $(EMCFLAGS) -o $@ -c $< | ||||
|  | ||||
| build/core_image.bc: build/core_image.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) | ||||
| 	$(EMCC) $(EMCFLAGS) -o $@ -c $< | ||||
|  | ||||
| build/%.bc: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) | ||||
| 	$(EMCC) $(EMCFLAGS) -o $@ -c $< | ||||
|  | ||||
| $(JANET_EMTARGET): $(JANET_EMOBJECTS) | ||||
| 	$(EMCC) $(EMCFLAGS) -shared -o $@ $^ | ||||
|  | ||||
| emscripten: $(JANET_EMTARGET) | ||||
|  | ||||
| ############################# | ||||
| ##### Generated C files ##### | ||||
| ############################# | ||||
|  | ||||
| %.gen.o: %.gen.c | ||||
| 	$(CC) $(CFLAGS) -o $@ -c $< | ||||
|  | ||||
| build/xxd: tools/xxd.c | ||||
| 	$(CC) $< -o $@ | ||||
|  | ||||
| build/init.gen.c: src/mainclient/init.janet build/xxd | ||||
| 	build/xxd $< $@ janet_gen_init | ||||
| build/webinit.gen.c: src/webclient/webinit.janet build/xxd | ||||
| 	build/xxd $< $@ janet_gen_webinit | ||||
| build/boot.gen.c: src/boot/boot.janet build/xxd | ||||
| 	build/xxd $< $@ janet_gen_boot | ||||
|  | ||||
| ######################## | ||||
| ##### Amalgamation ##### | ||||
| ######################## | ||||
|  | ||||
| SONAME=libjanet.so.1.16 | ||||
| amalg: build/janet.c build/janet.h build/core_image.c | ||||
|  | ||||
| build/c/shell.c: src/mainclient/shell.c | ||||
| AMALG_SOURCE=$(JANET_LOCAL_HEADERS) $(JANET_CORE_SOURCES) build/core_image.c | ||||
| build/janet.c: $(AMALG_SOURCE) tools/amalg.janet $(JANET_TARGET) | ||||
| 	$(JANET_TARGET) tools/amalg.janet $(AMALG_SOURCE) > $@ | ||||
|  | ||||
| build/janet.h: src/include/janet.h | ||||
| 	cp $< $@ | ||||
|  | ||||
| build/janet.h: $(JANET_TARGET) src/include/janet.h src/conf/janetconf.h | ||||
| 	./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h src/conf/janetconf.h $@ | ||||
|  | ||||
| build/janetconf.h: src/conf/janetconf.h | ||||
| 	cp $< $@ | ||||
|  | ||||
| build/janet.o: build/c/janet.c src/conf/janetconf.h src/include/janet.h | ||||
| 	$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ | ||||
|  | ||||
| build/shell.o: build/c/shell.c src/conf/janetconf.h src/include/janet.h | ||||
| 	$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ | ||||
|  | ||||
| $(JANET_TARGET): build/janet.o build/shell.o | ||||
| 	$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS) | ||||
|  | ||||
| $(JANET_LIBRARY): build/janet.o build/shell.o | ||||
| 	$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS) | ||||
|  | ||||
| $(JANET_STATIC_LIBRARY): build/janet.o build/shell.o | ||||
| 	$(HOSTAR) rcs $@ $^ | ||||
|  | ||||
| ################### | ||||
| ##### Testing ##### | ||||
| ################### | ||||
|  | ||||
| # Testing assumes HOSTCC=CC | ||||
|  | ||||
| TEST_SCRIPTS=$(wildcard test/suite*.janet) | ||||
|  | ||||
| repl: $(JANET_TARGET) | ||||
| @@ -204,13 +238,9 @@ valgrind: $(JANET_TARGET) | ||||
|  | ||||
| test: $(JANET_TARGET) $(TEST_PROGRAMS) | ||||
| 	for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done | ||||
| 	for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done | ||||
| 	./$(JANET_TARGET) -k jpm | ||||
|  | ||||
| valtest: $(JANET_TARGET) $(TEST_PROGRAMS) | ||||
| 	for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done | ||||
| 	for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done | ||||
| 	$(VALGRIND_COMMAND) ./$(JANET_TARGET) -k jpm | ||||
|  | ||||
| callgrind: $(JANET_TARGET) | ||||
| 	for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done | ||||
| @@ -222,22 +252,10 @@ callgrind: $(JANET_TARGET) | ||||
| dist: build/janet-dist.tar.gz | ||||
|  | ||||
| build/janet-%.tar.gz: $(JANET_TARGET) \ | ||||
| 	build/janet.h \ | ||||
| 	jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \ | ||||
| 	README.md build/c/janet.c build/c/shell.c jpm | ||||
| 	mkdir -p build/$(JANET_DIST_DIR)/bin | ||||
| 	cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/ | ||||
| 	cp jpm build/$(JANET_DIST_DIR)/bin/ | ||||
| 	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/ | ||||
| 	mkdir -p build/$(JANET_DIST_DIR)/man/man1/ | ||||
| 	cp janet.1 jpm.1 build/$(JANET_DIST_DIR)/man/man1/ | ||||
| 	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) | ||||
| 	src/include/janet.h src/include/janetconf.h \ | ||||
| 	janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \ | ||||
| 	build/doc.html README.md build/janet.c | ||||
| 	tar -czvf $@ $^ | ||||
|  | ||||
| ######################### | ||||
| ##### Documentation ##### | ||||
| @@ -252,12 +270,11 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet | ||||
| ##### Installation ##### | ||||
| ######################## | ||||
|  | ||||
| build/jpm: jpm $(JANET_TARGET) | ||||
| 	$(JANET_TARGET) tools/patch-jpm.janet jpm build/jpm "--libpath=$(LIBDIR)" "--headerpath=$(INCLUDEDIR)/janet" "--binpath=$(BINDIR)" | ||||
| 	chmod +x build/jpm | ||||
| SONAME=libjanet.so.1 | ||||
|  | ||||
| .INTERMEDIATE: build/janet.pc | ||||
| build/janet.pc: $(JANET_TARGET) | ||||
| .PHONY: $(PKG_CONFIG_PATH)/janet.pc | ||||
| $(PKG_CONFIG_PATH)/janet.pc: $(JANET_TARGET) | ||||
| 	mkdir -p $(PKG_CONFIG_PATH) | ||||
| 	echo 'prefix=$(PREFIX)' > $@ | ||||
| 	echo 'exec_prefix=$${prefix}' >> $@ | ||||
| 	echo 'includedir=$(INCLUDEDIR)/janet' >> $@ | ||||
| @@ -268,37 +285,27 @@ build/janet.pc: $(JANET_TARGET) | ||||
| 	echo "Description: Library for the Janet programming language." >> $@ | ||||
| 	$(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@ | ||||
| 	echo 'Cflags: -I$${includedir}' >> $@ | ||||
| 	echo 'Libs: -L$${libdir} -ljanet' >> $@ | ||||
| 	echo 'Libs: -L$${libdir} -ljanet $(LDFLAGS)' >> $@ | ||||
| 	echo 'Libs.private: $(CLIBS)' >> $@ | ||||
|  | ||||
| install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/jpm build/janet.h | ||||
| 	mkdir -p '$(DESTDIR)$(BINDIR)' | ||||
| 	cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet' | ||||
| 	mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet' | ||||
| 	cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet' | ||||
| 	mkdir -p '$(DESTDIR)$(JANET_PATH)' | ||||
| 	mkdir -p '$(DESTDIR)$(LIBDIR)' | ||||
| 	cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')' | ||||
| 	cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a' | ||||
| 	ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so' | ||||
| 	ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME) | ||||
| 	cp -rf build/jpm '$(DESTDIR)$(BINDIR)' | ||||
| 	mkdir -p '$(DESTDIR)$(JANET_MANPATH)' | ||||
| 	cp janet.1 '$(DESTDIR)$(JANET_MANPATH)' | ||||
| 	cp jpm.1 '$(DESTDIR)$(JANET_MANPATH)' | ||||
| 	mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)' | ||||
| 	cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc' | ||||
| 	[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true | ||||
|  | ||||
| uninstall: | ||||
| 	-rm '$(DESTDIR)$(BINDIR)/janet' | ||||
| 	-rm '$(DESTDIR)$(BINDIR)/jpm' | ||||
| 	-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet' | ||||
| 	-rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.* | ||||
| 	-rm '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc' | ||||
| 	-rm '$(DESTDIR)$(JANET_MANPATH)/janet.1' | ||||
| 	-rm '$(DESTDIR)$(JANET_MANPATH)/jpm.1' | ||||
| 	# -rm -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here | ||||
| install: $(JANET_TARGET) $(PKG_CONFIG_PATH)/janet.pc | ||||
| 	mkdir -p $(BINDIR) | ||||
| 	cp $(JANET_TARGET) $(BINDIR)/janet | ||||
| 	mkdir -p $(INCLUDEDIR)/janet | ||||
| 	cp -rf $(JANET_HEADERS) $(INCLUDEDIR)/janet | ||||
| 	mkdir -p $(JANET_PATH) | ||||
| 	mkdir -p $(LIBDIR) | ||||
| 	cp $(JANET_LIBRARY) $(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') | ||||
| 	cp $(JANET_STATIC_LIBRARY) $(LIBDIR)/libjanet.a | ||||
| 	ln -sf $(SONAME) $(LIBDIR)/libjanet.so | ||||
| 	ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME) | ||||
| 	cp tools/cook.janet $(JANET_PATH) | ||||
| 	cp tools/jpm $(BINDIR)/jpm | ||||
| 	cp tools/highlight.janet $(JANET_PATH) | ||||
| 	cp tools/bars.janet $(JANET_PATH) | ||||
| 	mkdir -p $(MANPATH) | ||||
| 	cp janet.1 $(MANPATH) | ||||
| 	-ldconfig $(LIBDIR) | ||||
|  | ||||
| ################# | ||||
| ##### Other ##### | ||||
| @@ -311,49 +318,25 @@ grammar: build/janet.tmLanguage | ||||
| build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET) | ||||
| 	$(JANET_TARGET) $< > $@ | ||||
|  | ||||
| compile-commands: | ||||
| 	# Requires pip install copmiledb | ||||
| 	compiledb make | ||||
|  | ||||
| clean: | ||||
| 	-rm -rf build vgcore.* callgrind.* | ||||
| 	-rm -rf test/install/build test/install/modpath | ||||
|  | ||||
| test-install: | ||||
| 	cd test/install \ | ||||
| 		&& rm -rf build .cache .manifests \ | ||||
| 		&& jpm --verbose build \ | ||||
| 		&& jpm --verbose test \ | ||||
| 		&& build/testexec \ | ||||
| 		&& jpm --verbose quickbin testexec.janet build/testexec2 \ | ||||
| 		&& build/testexec2 \ | ||||
| 		&& mkdir -p modpath \ | ||||
| 		&& jpm --verbose --testdeps --modpath=./modpath install https://github.com/janet-lang/json.git | ||||
| 	cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/jhydro.git | ||||
| 	cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/path.git | ||||
| 	cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/argparse.git | ||||
| 	cd test/install && rm -rf build && jpm build && jpm test | ||||
|  | ||||
| help: | ||||
| 	@echo | ||||
| 	@echo 'Janet: A Dynamic Language & Bytecode VM' | ||||
| 	@echo | ||||
| 	@echo Usage: | ||||
| 	@echo '   make            Build Janet' | ||||
| 	@echo '   make repl       Start a REPL from a built Janet' | ||||
| 	@echo | ||||
| 	@echo '   make test       Test a built Janet' | ||||
| 	@echo '   make valgrind   Assess Janet with Valgrind' | ||||
| 	@echo '   make callgrind  Assess Janet with Valgrind, using Callgrind' | ||||
| 	@echo '   make valtest    Run the test suite with Valgrind to check for memory leaks' | ||||
| 	@echo '   make dist       Create a distribution tarball' | ||||
| 	@echo '   make docs       Generate documentation' | ||||
| 	@echo '   make debug      Run janet with GDB or LLDB' | ||||
| 	@echo '   make install    Install into the current filesystem' | ||||
| 	@echo '   make uninstall  Uninstall from the current filesystem' | ||||
| 	@echo '   make clean      Clean intermediate build artifacts' | ||||
| 	@echo "   make format     Format Janet's own source files" | ||||
| 	@echo '   make grammar    Generate a TextMate language grammar' | ||||
| 	@echo | ||||
| build/embed_janet.o: build/janet.c $(JANET_HEADERS) | ||||
| 	$(CC) $(CFLAGS) -c $< -o $@ | ||||
| build/embed_main.o: test/amalg/main.c $(JANET_HEADERS) | ||||
| 	$(CC) $(CFLAGS) -c $< -o $@ | ||||
| build/embed_test: build/embed_janet.o build/embed_main.o | ||||
| 	$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS) | ||||
|  | ||||
| .PHONY: clean install repl debug valgrind test \ | ||||
| 	valtest dist uninstall docs grammar format help compile-commands | ||||
| test-amalg: build/embed_test | ||||
| 	./build/embed_test | ||||
|  | ||||
| uninstall: | ||||
| 	-rm $(BINDIR)/../$(JANET_TARGET) | ||||
| 	-rm -rf $(INCLUDEDIR) | ||||
|  | ||||
| .PHONY: clean install repl debug valgrind test amalg \ | ||||
| 	valtest emscripten dist uninstall docs grammar format | ||||
|   | ||||
							
								
								
									
										198
									
								
								README.md
									
									
									
									
									
								
							
							
						
						
									
										198
									
								
								README.md
									
									
									
									
									
								
							| @@ -2,53 +2,48 @@ | ||||
|   | ||||
| [](https://ci.appveyor.com/project/bakpakin/janet/branch/master) | ||||
| [](https://travis-ci.org/janet-lang/janet) | ||||
| [](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?) | ||||
| [](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?) | ||||
| [](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml?) | ||||
| [](https://builds.sr.ht/~bakpakin/janet/.openbsd.yaml?) | ||||
|  | ||||
| <img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left"> | ||||
|  | ||||
| **Janet** is a functional and imperative programming language and bytecode interpreter. It is a | ||||
| lisp-like language, but lists are replaced | ||||
| by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples). | ||||
| modern lisp, but lists are replaced | ||||
| by other data structures with better utility and performance (arrays, tables, structs, tuples). | ||||
| The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly. | ||||
|  | ||||
| There is a REPL for trying out the language, as well as the ability | ||||
| There is a repl for trying out the language, as well as the ability | ||||
| to run script files. This client program is separate from the core runtime, so | ||||
| Janet can be embedded in other programs. Try Janet in your browser at | ||||
| janet could be embedded into other programs. Try janet in your browser at | ||||
| [https://janet-lang.org](https://janet-lang.org). | ||||
|  | ||||
| If you'd like to financially support the ongoing development of Janet, consider | ||||
| [sponsoring its primary author](https://github.com/sponsors/bakpakin) through GitHub. | ||||
|  | ||||
| <br> | ||||
|  | ||||
| ## Use Cases | ||||
|  | ||||
| Janet makes a good system scripting language, or a language to embed in other programs. | ||||
| It's like Lua and Guile in that regard. It has more built-in functionality and a richer core language than | ||||
| Lua, but smaller than GNU Guile or Python. | ||||
| Janet makes a good system scripting language, or a language to embed in other programs. Think Lua or Guile. | ||||
|  | ||||
| ## Features | ||||
|  | ||||
| * Minimal setup - one binary and you are good to go! | ||||
| * First-class closures | ||||
| * First class closures | ||||
| * Garbage collection | ||||
| * First-class green threads (continuations) | ||||
| * Python-style generators (implemented as a plain macro) | ||||
| * First class green threads (continuations) | ||||
| * Python style generators (implemented as a plain macro) | ||||
| * Mutable and immutable arrays (array/tuple) | ||||
| * Mutable and immutable hashtables (table/struct) | ||||
| * Mutable and immutable strings (buffer/string) | ||||
| * Macros | ||||
| * Lisp Macros | ||||
| * Byte code interpreter with an assembly interface, as well as bytecode verification | ||||
| * Tail call Optimization | ||||
| * Tailcall Optimization | ||||
| * Direct interop with C via abstract types and C functions | ||||
| * Dynamically load C libraries | ||||
| * Functional and imperative standard library | ||||
| * Lexical scoping | ||||
| * Imperative programming as well as functional | ||||
| * REPL | ||||
| * Parsing Expression Grammars built into the core library | ||||
| * 400+ functions and macros in the core library | ||||
| * Parsing Expression Grammars built in to the core library | ||||
| * 300+ functions and macros in the core library | ||||
| * Embedding Janet in other programs | ||||
| * Interactive environment with detailed stack traces | ||||
|  | ||||
| @@ -57,18 +52,16 @@ Lua, but smaller than GNU Guile or Python. | ||||
| * For a quick tutorial, see [the introduction](https://janet-lang.org/docs/index.html) for more details. | ||||
| * For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html) | ||||
|  | ||||
| Documentation is also available locally in the REPL. | ||||
| Documentation is also available locally in the repl. | ||||
| Use the `(doc symbol-name)` macro to get API | ||||
| documentation for symbols in the core library. For example, | ||||
| ``` | ||||
| (doc apply) | ||||
| (doc doc) | ||||
| ``` | ||||
| Shows documentation for the `apply` function. | ||||
| Shows documentation for the doc macro. | ||||
|  | ||||
| To get a list of all bindings in the default | ||||
| environment, use the `(all-bindings)` function. You | ||||
| can also use the `(doc)` macro with no arguments if you are in the REPL | ||||
| to show bound symbols. | ||||
| environment, use the `(all-symbols)` function. | ||||
|  | ||||
| ## Source | ||||
|  | ||||
| @@ -78,9 +71,7 @@ the SourceHut mirror is actively maintained. | ||||
|  | ||||
| ## Building | ||||
|  | ||||
| ### macOS and Unix-like | ||||
|  | ||||
| The Makefile is non-portable and requires GNU-flavored make. | ||||
| ### macos and Unix-like | ||||
|  | ||||
| ``` | ||||
| cd somewhere/my/projects/janet | ||||
| @@ -89,11 +80,9 @@ make test | ||||
| make repl | ||||
| ``` | ||||
|  | ||||
| Find out more about the available make targets by running `make help`. | ||||
|  | ||||
| ### 32-bit Haiku | ||||
|  | ||||
| 32-bit Haiku build instructions are the same as the UNIX-like build instructions, | ||||
| 32-bit Haiku build instructions are the same as the unix-like build instructions, | ||||
| but you need to specify an alternative compiler, such as `gcc-x86`. | ||||
|  | ||||
| ``` | ||||
| @@ -105,7 +94,7 @@ make repl | ||||
|  | ||||
| ### FreeBSD | ||||
|  | ||||
| FreeBSD build instructions are the same as the UNIX-like build instructions, | ||||
| FreeBSD build instructions are the same as the unix-like build instuctions, | ||||
| but you need `gmake` to compile. Alternatively, install directly from | ||||
| packages, using `pkg install lang/janet`. | ||||
|  | ||||
| @@ -116,11 +105,6 @@ gmake test | ||||
| gmake repl | ||||
| ``` | ||||
|  | ||||
| ### NetBSD | ||||
|  | ||||
| NetBSD build instructions are the same as the FreeBSD build instructions. | ||||
| Alternatively, install directly from packages, using `pkgin install janet`. | ||||
|  | ||||
| ### Windows | ||||
|  | ||||
| 1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#) | ||||
| @@ -128,153 +112,93 @@ Alternatively, install directly from packages, using `pkgin install janet`. | ||||
| 3. Run `build_win` to compile janet. | ||||
| 4. Run `build_win test` to make sure everything is working. | ||||
|  | ||||
| To build an `.msi` installer executable, in addition to the above steps, you will have to: | ||||
| ### Emscripten | ||||
|  | ||||
| 5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases) | ||||
| 6. run `build_win dist` | ||||
|  | ||||
| Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself. | ||||
| To build janet for the web via [Emscripten](https://kripken.github.io/emscripten-site/), make sure you | ||||
| have `emcc` installed and on your path. On a linux or macOS system, use `make emscripten` to build | ||||
| `janet.js` and `janet.wasm` - both are needed to run janet in a browser or in node. | ||||
| The JavaScript build is what runs the repl on the main website, | ||||
| but really serves mainly as a proof of concept. Janet will run slower in a browser. | ||||
| Building with emscripten on windows is currently unsupported. | ||||
|  | ||||
| ### Meson | ||||
|  | ||||
| Janet also has a build file for [Meson](https://mesonbuild.com/), a cross-platform build | ||||
| system. Although Meson has a Python dependency, Meson is a very complete build system that | ||||
| is maybe more convenient and flexible for integrating into existing pipelines. | ||||
| Meson also provides much better IDE integration than Make or batch files, as well as support | ||||
| for cross-compilation. | ||||
|  | ||||
| For the impatient, building with Meson is as follows. The options provided to | ||||
| `meson setup` below emulate Janet's Makefile. | ||||
|  | ||||
| ```sh | ||||
| git clone https://github.com/janet-lang/janet.git | ||||
| cd janet | ||||
| meson setup build \ | ||||
|           --buildtype release \ | ||||
|           --optimization 2 \ | ||||
|           --libdir /usr/local/lib \ | ||||
|           -Dgit_hash=$(git log --pretty=format:'%h' -n 1) | ||||
| ninja -C build | ||||
|  | ||||
| # Run the binary | ||||
| build/janet | ||||
|  | ||||
| # Installation | ||||
| ninja -C build install | ||||
| ``` | ||||
|  | ||||
| ## Development | ||||
|  | ||||
| Janet can be hacked on with pretty much any environment you like, but for IDE | ||||
| lovers, [Gnome Builder](https://wiki.gnome.org/Apps/Builder) is probably the | ||||
| best option, as it has excellent meson integration. It also offers code completion | ||||
| for Janet's C API right out of the box, which is very useful for exploring. VSCode, Vim, | ||||
| Emacs, and Atom will have syntax packages for the Janet language, though. | ||||
| Janet also has a build file for [Meson](https://mesonbuild.com/), a cross platform build | ||||
| system. This is not currently the main supported build system, but should work on any | ||||
| system that supports meson. Meson also provides much better IDE integration than Make or batch files. | ||||
|  | ||||
| ## Installation | ||||
|  | ||||
| See the [Introduction](https://janet-lang.org/docs/index.html) for more details. If you just want | ||||
| to try out the language, you don't need to install anything. You can also move the `janet` executable wherever you want on your system and run it. | ||||
| See [the Introduction](https://janet-lang.org/introduction.html) for more details. | ||||
|  | ||||
| ## Usage | ||||
|  | ||||
| A REPL is launched when the binary is invoked with no arguments. Pass the -h flag | ||||
| A repl is launched when the binary is invoked with no arguments. Pass the -h flag | ||||
| to display the usage information. Individual scripts can be run with `./janet myscript.janet` | ||||
|  | ||||
| If you are looking to explore, you can print a list of all available macros, functions, and constants | ||||
| by entering the command `(all-bindings)` into the REPL. | ||||
| by entering the command `(all-bindings)` into the repl. | ||||
|  | ||||
| ``` | ||||
| $ janet | ||||
| Janet 1.7.1-dev-951e10f  Copyright (C) 2017-2020 Calvin Rose | ||||
| $ ./janet | ||||
| Janet 0.0.0 alpha  Copyright (C) 2017-2018 Calvin Rose | ||||
| janet:1:> (+ 1 2 3) | ||||
| 6 | ||||
| janet:2:> (print "Hello, World!") | ||||
| Hello, World! | ||||
| nil | ||||
| janet:3:> (os/exit) | ||||
| $ janet -h | ||||
| usage: build/janet [options] script args... | ||||
| $ ./janet -h | ||||
| usage: ./janet [options] scripts... | ||||
| Options are: | ||||
|   -h : Show this help | ||||
|   -v : Print the version string | ||||
|   -s : Use raw stdin instead of getline like functionality | ||||
|   -e code : Execute a string of janet | ||||
|   -r : Enter the REPL after running all scripts | ||||
|   -p : Keep on executing if there is a top-level error (persistent) | ||||
|   -q : Hide prompt, logo, and REPL output (quiet) | ||||
|   -k : Compile scripts but do not execute (flycheck) | ||||
|   -m syspath : Set system path for loading global modules | ||||
|   -c source output : Compile janet source code into an image | ||||
|   -n : Disable ANSI color output in the REPL | ||||
|   -l path : Execute code in a file before running the main script | ||||
|   -- : Stop handling options | ||||
|   -h Show this help | ||||
|   -v Print the version string | ||||
|   -s Use raw stdin instead of getline like functionality | ||||
|   -e Execute a string of janet | ||||
|   -r Enter the repl after running all scripts | ||||
|   -p Keep on executing if there is a top level error (persistent) | ||||
|   -- Stop handling option | ||||
| $ | ||||
| ``` | ||||
|  | ||||
| If installed, you can also run `man janet` and `man jpm` to get usage information. | ||||
| If installed, you can also run `man janet` to get usage information. | ||||
|  | ||||
| ## Embedding | ||||
|  | ||||
| Janet can be embedded in a host program very easily. The normal build | ||||
| will create a file `build/janet.c`, which is a single C file | ||||
| The C API for Janet is not yet documented but coming soon. | ||||
|  | ||||
| Janet can be embedded in a host program very easily. There is a make target | ||||
| `make amalg` which creates the file `build/janet.c`, which is a single C file | ||||
| that contains all the source to Janet. This file, along with | ||||
| `src/include/janet.h` and `src/conf/janetconf.h` can be dragged into any C | ||||
| `src/include/janet.h` and `src/include/janetconf.h` can dragged into any C | ||||
| project and compiled into the project. Janet should be compiled with `-std=c99` | ||||
| on most compilers, and will need to be linked to the math library, `-lm`, and | ||||
| the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If | ||||
| there is no need for dynamic modules, add the define | ||||
| `-DJANET_NO_DYNAMIC_MODULES` to the compiler options. | ||||
|  | ||||
| See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the website for more information. | ||||
|  | ||||
| ## Examples | ||||
|  | ||||
| See the examples directory for some example janet code. | ||||
|  | ||||
| ## 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 discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community). | ||||
| Alternatively, check out [the #janet channel on Freenode](https://webchat.freenode.net/) | ||||
|  | ||||
| ## FAQ | ||||
|  | ||||
| ### Why is my terminal spitting out junk when I run the REPL? | ||||
| ### Why is my terminal is spitting out junk when I run the repl? | ||||
|  | ||||
| Make sure your terminal supports ANSI escape codes. Most modern terminals will | ||||
| support these, but some older terminals, Windows consoles, or embedded terminals | ||||
| will not. If your terminal does not support ANSI escape codes, run the REPL with | ||||
| support these, but some older terminals, windows consoles, or embedded terminals | ||||
| will not. If your terminal does not support ANSI escape codes, run the repl with | ||||
| the `-n` flag, which disables color output. You can also try the `-s` if further issues | ||||
| ensue. | ||||
|  | ||||
| ### Where is (favorite feature from other language)? | ||||
|  | ||||
| It may exist, it may not. If you want to propose major language features, go ahead and open an issue, but | ||||
| they will likely by closed as "will not implement". Often, such features make one usecase simpler at the expense | ||||
| of 5 others by making the language more complicated. | ||||
|  | ||||
| ### Where is the example code? | ||||
|  | ||||
| In the examples directory. | ||||
|  | ||||
| ### Is this a Clojure port? | ||||
|  | ||||
| No. It's similar to Clojure superficially because I like Lisps and I like the asthetics. | ||||
| Internally, Janet is not at all like Clojure. | ||||
|  | ||||
| ### Are the immutable data structures (tuples and structs) implemented as hash tries? | ||||
|  | ||||
| No. They are immutable arrays and hash tables. Don't try and use them like Clojure's vectors | ||||
| and maps, instead they work well as table keys or other identifiers. | ||||
|  | ||||
| ### Why can't we add (feature from Clojure) into the core? | ||||
|  | ||||
| Usually, one of a few reasons: | ||||
| - Often, it already exists in a different form and the Clojure port would be redundant. | ||||
| - Clojure programs often generate a lot of garbage and rely on the JVM to clean it up. | ||||
|   Janet does not run on the JVM. We admittedly have a much more primitive GC. | ||||
| - We want to keep the Janet core small. With Lisps, usually a feature can be added as a library | ||||
|   without feeling "bolted on", especially when compared to ALGOL like languages. | ||||
|  | ||||
| ## Why is it called "Janet"? | ||||
| ## Why Janet | ||||
|  | ||||
| Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place). | ||||
|  | ||||
| <img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-the-good-place.gif" alt="Janet logo" width="115px" align="left"> | ||||
|  | ||||
|   | ||||
							
								
								
									
										42
									
								
								appveyor.yml
									
									
									
									
									
								
							
							
						
						
									
										42
									
								
								appveyor.yml
									
									
									
									
									
								
							| @@ -1,12 +1,12 @@ | ||||
| version: build-{build} | ||||
| clone_folder: c:\projects\janet | ||||
| image: | ||||
| - Visual Studio 2019 | ||||
| - Visual Studio 2017 | ||||
| configuration: | ||||
| - Release | ||||
| - Debug | ||||
| platform: | ||||
| - x64 | ||||
| - x86 | ||||
| environment: | ||||
|   matrix: | ||||
|   - arch: Win64 | ||||
| @@ -15,33 +15,25 @@ matrix: | ||||
|  | ||||
| # skip unsupported combinations | ||||
| init: | ||||
|     - call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform% | ||||
| - call "C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\VC\Auxiliary\Build\vcvars64.bat" | ||||
|  | ||||
| install: | ||||
|     - set JANET_BUILD=%appveyor_repo_commit:~0,7% | ||||
|     - build_win all | ||||
|     - refreshenv | ||||
|     # We need to reload vcvars after refreshing | ||||
|     - call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform% | ||||
|     - build_win test-install | ||||
|     - set janet_outname=%appveyor_repo_tag_name% | ||||
|     - if "%janet_outname%"=="" set /P janet_outname=<build\version.txt | ||||
|     - build_win | ||||
|     - build_win test | ||||
|     - choco install nsis -y -pre | ||||
|     - build_win dist | ||||
|     - call "C:\Program Files (x86)\NSIS\makensis.exe" janet-installer.nsi  | ||||
|      | ||||
| build: off | ||||
|  | ||||
| only_commits: | ||||
|   files: | ||||
|     - appveyor.yml | ||||
|     - src/ | ||||
|  | ||||
| artifacts: | ||||
|     - name: janet.c | ||||
|       path: dist\janet.c | ||||
|       type: File | ||||
|     - name: janet.h | ||||
|       path: dist\janet.h | ||||
|       type: File | ||||
|     - name: shell.c | ||||
|       path: dist\shell.c | ||||
|       type: File | ||||
|     - name: "janet-$(janet_outname)-windows-%platform%" | ||||
|       path: dist | ||||
|       type: Zip | ||||
|     - path: "janet-$(janet_outname)-windows-%platform%-installer.msi" | ||||
|     - path: janet-installer.exe | ||||
|       name: janet-windows-installer.exe | ||||
|       type: File | ||||
|  | ||||
| deploy: | ||||
| @@ -49,7 +41,7 @@ deploy: | ||||
|   provider: GitHub | ||||
|   auth_token: | ||||
|     secure: lwEXy09qhj2jSH9s1C/KvCkAUqJSma8phFR+0kbsfUc3rVxpNK5uD3z9Md0SjYRx | ||||
|   artifact: /(janet|shell).*/ | ||||
|   artifact: janet-windows | ||||
|   draft: true | ||||
|   on: | ||||
|       APPVEYOR_REPO_TAG: true | ||||
|   | ||||
							
								
								
									
										
											BIN
										
									
								
								assets/janet-the-good-place.gif
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										
											BIN
										
									
								
								assets/janet-the-good-place.gif
									
									
									
									
									
										Normal file
									
								
							
										
											Binary file not shown.
										
									
								
							| After Width: | Height: | Size: 109 KiB | 
							
								
								
									
										164
									
								
								build_win.bat
									
									
									
									
									
								
							
							
						
						
									
										164
									
								
								build_win.bat
									
									
									
									
									
								
							| @@ -13,55 +13,78 @@ | ||||
| @if "%1"=="clean" goto CLEAN | ||||
| @if "%1"=="test" goto TEST | ||||
| @if "%1"=="dist" goto DIST | ||||
| @if "%1"=="install" goto INSTALL | ||||
| @if "%1"=="test-install" goto TESTINSTALL | ||||
| @if "%1"=="all" goto ALL | ||||
|  | ||||
| @rem Set compile and link options here | ||||
| @setlocal | ||||
| @set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD | ||||
| @set JANET_COMPILE=cl /nologo /Isrc\include /c /O2 /W3 /LD /D_CRT_SECURE_NO_WARNINGS | ||||
| @set JANET_LINK=link /nologo | ||||
| @set JANET_LINK_STATIC=lib /nologo | ||||
|  | ||||
| @rem Add janet build tag | ||||
| if not "%JANET_BUILD%" == "" ( | ||||
|     @set JANET_COMPILE=%JANET_COMPILE% /DJANET_BUILD="\"%JANET_BUILD%\"" | ||||
| ) | ||||
| mkdir build | ||||
| mkdir build\core | ||||
| mkdir build\mainclient | ||||
| mkdir build\boot | ||||
|  | ||||
| if not exist build mkdir build | ||||
| if not exist build\core mkdir build\core | ||||
| if not exist build\c mkdir build\c | ||||
| if not exist build\boot mkdir build\boot | ||||
| @rem Build the xxd tool for generating sources | ||||
| @cl /nologo /c tools/xxd.c /Fobuild\xxd.obj | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
| @link /nologo /out:build\xxd.exe build\xxd.obj | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
|  | ||||
| @rem Build the bootstrap interpreter | ||||
| @rem Generate the embedded sources | ||||
| @build\xxd.exe src\mainclient\init.janet build\init.gen.c janet_gen_init | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
| @build\xxd.exe src\boot\boot.janet build\boot.gen.c janet_gen_boot | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
|  | ||||
| @rem Build the generated sources | ||||
| @%JANET_COMPILE% /Fobuild\mainclient\init.gen.obj build\init.gen.c | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
| @%JANET_COMPILE% /Fobuild\boot\boot.gen.obj build\boot.gen.c | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
|  | ||||
| @rem Build the bootstrap interpretter | ||||
| for %%f in (src\core\*.c) do ( | ||||
|     %JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f | ||||
|     @%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f | ||||
|     @if errorlevel 1 goto :BUILDFAIL | ||||
| ) | ||||
| for %%f in (src\boot\*.c) do ( | ||||
|     %JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f | ||||
|     @%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f | ||||
|     @if errorlevel 1 goto :BUILDFAIL | ||||
| ) | ||||
| %JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
| build\janet_boot . > build\c\janet.c | ||||
| build\janet_boot build\core_image.c | ||||
|  | ||||
| @rem Build the core image | ||||
| @%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
|  | ||||
| @rem Build the sources | ||||
| %JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
| %JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
| for %%f in (src\core\*.c) do ( | ||||
|     @%JANET_COMPILE% /Fobuild\core\%%~nf.obj %%f | ||||
|     @if errorlevel 1 goto :BUILDFAIL | ||||
| ) | ||||
|  | ||||
| @rem Build the resources | ||||
| rc /nologo /fobuild\janet_win.res janet_win.rc | ||||
|  | ||||
| @rem Build the main client | ||||
| for %%f in (src\mainclient\*.c) do ( | ||||
|     @%JANET_COMPILE% /Fobuild\mainclient\%%~nf.obj %%f | ||||
|     @if errorlevel 1 goto :BUILDFAIL | ||||
| ) | ||||
|  | ||||
| @rem Link everything to main client | ||||
| %JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res | ||||
| %JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj build\core_image.obj build\janet_win.res | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
|  | ||||
| @rem Build static library (libjanet.a) | ||||
| %JANET_LINK_STATIC% /out:build\libjanet.lib build\janet.obj | ||||
| @if errorlevel 1 goto :BUILDFAIL | ||||
| @rem Gen amlag | ||||
| setlocal enabledelayedexpansion | ||||
| set "amalg_files=" | ||||
| for %%f in (src\core\*.c) do ( | ||||
|     set "amalg_files=!amalg_files! %%f" | ||||
| ) | ||||
| janet.exe tools\amalg.janet src\core\util.h src\core\state.h src\core\gc.h src\core\vector.h src\core\fiber.h src\core\regalloc.h src\core\compile.h src\core\emit.h src\core\symcache.h %amalg_files% build\core_image.c > build\janet.c | ||||
|  | ||||
| echo === Successfully built janet.exe for Windows === | ||||
| echo === Run 'build_win test' to run tests. == | ||||
| @@ -84,16 +107,15 @@ exit /b 0 | ||||
|  | ||||
| @rem Clean build artifacts  | ||||
| :CLEAN | ||||
| del *.exe *.lib *.exp | ||||
| del janet.exe janet.exp janet.lib | ||||
| rd /s /q build | ||||
| 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 errorlevel 1 goto :TESTFAIL | ||||
| ) | ||||
| exit /b 0 | ||||
|  | ||||
| @@ -101,91 +123,19 @@ exit /b 0 | ||||
| :DIST | ||||
| mkdir dist | ||||
| janet.exe tools\gendoc.janet > dist\doc.html | ||||
| janet.exe tools\removecr.janet dist\doc.html | ||||
| janet.exe tools\removecr.janet build\c\janet.c | ||||
|  | ||||
| copy build\c\janet.c dist\janet.c | ||||
| copy src\mainclient\shell.c dist\shell.c | ||||
| copy build\janet.c dist\janet.c | ||||
| copy janet.exe dist\janet.exe | ||||
| copy LICENSE dist\LICENSE | ||||
| copy README.md dist\README.md | ||||
|  | ||||
| copy janet.lib dist\janet.lib | ||||
| copy janet.exp dist\janet.exp | ||||
|  | ||||
| janet.exe tools\patch-header.janet src\include\janet.h src\conf\janetconf.h build\janet.h | ||||
| copy build\janet.h dist\janet.h | ||||
| copy build\libjanet.lib dist\libjanet.lib | ||||
|  | ||||
| copy .\jpm dist\jpm | ||||
|  | ||||
| @rem Create installer | ||||
| janet.exe -e "(->> janet/version (peg/match ''(* :d+ `.` :d+ `.` :d+)) first print)" > build\version.txt | ||||
| janet.exe -e "(print (os/arch))" > build\arch.txt | ||||
| set /p JANET_VERSION= < build\version.txt | ||||
| set /p BUILDARCH= < build\arch.txt | ||||
| echo "JANET_VERSION is %JANET_VERSION%" | ||||
| if defined APPVEYOR_REPO_TAG_NAME ( | ||||
|     set RELEASE_VERSION=%APPVEYOR_REPO_TAG_NAME% | ||||
| ) else ( | ||||
|     set RELEASE_VERSION=%JANET_VERSION% | ||||
| ) | ||||
| if defined CI ( | ||||
|     set WIXBIN="c:\Program Files (x86)\WiX Toolset v3.11\bin\" | ||||
| ) else ( | ||||
|     set WIXBIN= | ||||
| ) | ||||
| %WIXBIN%candle.exe tools\msi\janet.wxs -arch %BUILDARCH% -out build\ | ||||
| %WIXBIN%light.exe "-sice:ICE38" -b tools\msi -ext WixUIExtension build\janet.wixobj -out janet-%RELEASE_VERSION%-windows-%BUILDARCH%-installer.msi | ||||
| exit /b 0 | ||||
|  | ||||
| @rem Run the installer. (Installs to the local user with default settings) | ||||
| :INSTALL | ||||
| FOR %%a in (janet-*-windows-*-installer.msi) DO ( | ||||
|     @echo Running Installer %%a... | ||||
|     %%a /QN | ||||
| ) | ||||
| exit /b 0 | ||||
|  | ||||
| @rem Test the installation. | ||||
| :TESTINSTALL | ||||
| pushd test\install | ||||
| call jpm clean | ||||
| @if errorlevel 1 goto :TESTINSTALLFAIL | ||||
| call jpm test | ||||
| @if errorlevel 1 goto :TESTINSTALLFAIL | ||||
| call jpm --verbose --modpath=. install https://github.com/janet-lang/json.git | ||||
| @if errorlevel 1 goto :TESTINSTALLFAIL | ||||
| call build\testexec | ||||
| @if errorlevel 1 goto :TESTINSTALLFAIL | ||||
| call jpm --verbose quickbin testexec.janet build\testexec2.exe | ||||
| @if errorlevel 1 goto :TESTINSTALLFAIL | ||||
| call build\testexec2.exe | ||||
| @if errorlevel 1 goto :TESTINSTALLFAIL | ||||
| call jpm --verbose --test --modpath=. install https://github.com/janet-lang/jhydro.git | ||||
| @if errorlevel 1 goto :TESTINSTALLFAIL | ||||
| call jpm --verbose --test --modpath=. install https://github.com/janet-lang/path.git | ||||
| @if errorlevel 1 goto :TESTINSTALLFAIL | ||||
| call jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git | ||||
| @if errorlevel 1 goto :TESTINSTALLFAIL | ||||
| popd | ||||
| exit /b 0 | ||||
|  | ||||
| :TESTINSTALLFAIL | ||||
| popd | ||||
| goto :TESTFAIL | ||||
|  | ||||
| @rem build, test, dist, install. Useful for local dev. | ||||
| :ALL | ||||
| call %0 build | ||||
| @if errorlevel 1 exit /b 1 | ||||
| call %0 test | ||||
| @if errorlevel 1 exit /b 1 | ||||
| call %0 dist | ||||
| @if errorlevel 1 exit /b 1 | ||||
| call %0 install | ||||
| @if errorlevel 1 exit /b 1 | ||||
| @echo Done! | ||||
| copy src\include\janet.h dist\janet.h | ||||
| copy src\include\janetconf.h dist\janetconf.h | ||||
| copy tools\cook.janet dist\cook.janet | ||||
| copy tools\highlight.janet dist\highlight.janet | ||||
| copy tools\jpm dist\jpm | ||||
| copy tools\jpm.bat dist\jpm.bat | ||||
| exit /b 0 | ||||
|  | ||||
| :TESTFAIL | ||||
|   | ||||
| @@ -1,22 +1,23 @@ | ||||
| # Example of dst bytecode assembly | ||||
|  | ||||
| # Fibonacci sequence, implemented with naive recursion. | ||||
| (def fibasm | ||||
|   (asm | ||||
|     '{:arity 1 | ||||
|       :bytecode @[(ltim 1 0 0x2)   # $1 = $0 < 2 | ||||
|                   (jmpif 1 :done)  # if ($1) goto :done | ||||
|                   (lds 1)          # $1 = self | ||||
|                   (addim 0 0 -0x1) # $0 = $0 - 1 | ||||
|                   (push 0)         # push($0), push argument for next function call | ||||
|                   (call 2 1)       # $2 = call($1) | ||||
|                   (addim 0 0 -0x1) # $0 = $0 - 1 | ||||
|                   (push 0)         # push($0) | ||||
|                   (call 0 1)       # $0 = call($1) | ||||
|                   (add 0 0 2)      # $0 = $0 + $2 (integers) | ||||
|                   :done | ||||
|                   (ret 0)          # return $0 | ||||
| ]})) | ||||
| (def fibasm (asm '{ | ||||
|   arity 1 | ||||
|   bytecode [ | ||||
|     (ltim 1 0 0x2)      # $1 = $0 < 2 | ||||
|     (jmpif 1 :done)     # if ($1) goto :done | ||||
|     (lds 1)             # $1 = self | ||||
|     (addim 0 0 -0x1)    # $0 = $0 - 1 | ||||
|     (push 0)            # push($0), push argument for next function call | ||||
|     (call 2 1)          # $2 = call($1) | ||||
|     (addim 0 0 -0x1)    # $0 = $0 - 1 | ||||
|     (push 0)            # push($0) | ||||
|     (call 0 1)          # $0 = call($1) | ||||
|     (add 0 0 2)        # $0 = $0 + $2 (integers) | ||||
|     :done | ||||
|     (ret 0)             # return $0 | ||||
|   ] | ||||
| })) | ||||
|  | ||||
| # Test it | ||||
|  | ||||
|   | ||||
| @@ -1,22 +0,0 @@ | ||||
| (defn dowork [name n] | ||||
|   (print name " starting work...") | ||||
|   (os/execute [(dyn :executable) "-e" (string "(os/sleep " n ")")]) | ||||
|   (print name " finished work!")) | ||||
|  | ||||
| # Will be done in parallel | ||||
| (print "starting group A") | ||||
| (ev/call dowork "A 2" 2) | ||||
| (ev/call dowork "A 1" 1) | ||||
| (ev/call dowork "A 3" 3) | ||||
|  | ||||
| (ev/sleep 4) | ||||
|  | ||||
| # Will also be done in parallel | ||||
| (print "starting group B") | ||||
| (ev/call dowork "B 2" 2) | ||||
| (ev/call dowork "B 1" 1) | ||||
| (ev/call dowork "B 3" 3) | ||||
|  | ||||
| (ev/sleep 4) | ||||
|  | ||||
| (print "all work done") | ||||
| @@ -1,15 +0,0 @@ | ||||
| (def c (ev/chan 4)) | ||||
|  | ||||
| (defn writer [] | ||||
|   (for i 0 10 | ||||
|     (ev/sleep 0.1) | ||||
|     (print "writer giving item " i "...") | ||||
|     (ev/give c (string "item " i)))) | ||||
|  | ||||
| (defn reader [name] | ||||
|   (forever | ||||
|     (print "reader " name " got " (ev/take c)))) | ||||
|  | ||||
| (ev/call writer) | ||||
| (each letter [:a :b :c :d :e :f :g] | ||||
|   (ev/call reader letter)) | ||||
| @@ -1,11 +0,0 @@ | ||||
| # Load this file and run (myfn) to see the debugger | ||||
|  | ||||
| (defn myfn | ||||
|   [] | ||||
|   (debug) | ||||
|   (for i 0 10 (print i))) | ||||
|  | ||||
| (debug/fbreak myfn 3) | ||||
|  | ||||
| # Enable debugging in repl with | ||||
| # (setdyn :debug true) | ||||
| @@ -1,151 +0,0 @@ | ||||
| ### | ||||
| ### A useful debugger library for Janet. Should be used | ||||
| ### inside a debug repl. This has been moved into the core. | ||||
| ### | ||||
|  | ||||
| (defn .fiber | ||||
|   "Get the current fiber being debugged." | ||||
|   [] | ||||
|   (dyn :fiber)) | ||||
|  | ||||
| (defn .stack | ||||
|   "Print the current fiber stack" | ||||
|   [] | ||||
|   (print) | ||||
|   (with-dyns [:err-color false] (debug/stacktrace (.fiber) "")) | ||||
|   (print)) | ||||
|  | ||||
| (defn .frame | ||||
|   "Show a stack frame" | ||||
|   [&opt n] | ||||
|   (def stack (debug/stack (.fiber))) | ||||
|   (in stack (or n 0))) | ||||
|  | ||||
| (defn .fn | ||||
|   "Get the current function" | ||||
|   [&opt n] | ||||
|   (in (.frame n) :function)) | ||||
|  | ||||
| (defn .slots | ||||
|   "Get an array of slots in a stack frame" | ||||
|   [&opt n] | ||||
|   (in (.frame n) :slots)) | ||||
|  | ||||
| (defn .slot | ||||
|   "Get the value of the nth slot." | ||||
|   [&opt nth frame-idx] | ||||
|   (in (.slots frame-idx) (or nth 0))) | ||||
|  | ||||
| (defn .quit | ||||
|   "Resume (dyn :fiber) with the value passed to it after exiting the debugger." | ||||
|   [&opt val] | ||||
|   (setdyn :exit true) | ||||
|   (setdyn :resume-value val) | ||||
|   nil) | ||||
|  | ||||
| (defn .disasm | ||||
|   "Gets the assembly for the current function." | ||||
|   [&opt n] | ||||
|   (def frame (.frame n)) | ||||
|   (def func (frame :function)) | ||||
|   (disasm func)) | ||||
|  | ||||
| (defn .bytecode | ||||
|   "Get the bytecode for the current function." | ||||
|   [&opt n] | ||||
|   ((.disasm n) 'bytecode)) | ||||
|  | ||||
| (defn .ppasm | ||||
|   "Pretty prints the assembly for the current function" | ||||
|   [&opt n] | ||||
|   (def frame (.frame n)) | ||||
|   (def func (frame :function)) | ||||
|   (def dasm (disasm func)) | ||||
|   (def bytecode (dasm 'bytecode)) | ||||
|   (def pc (frame :pc)) | ||||
|   (def sourcemap (dasm 'sourcemap)) | ||||
|   (var last-loc [-2 -2]) | ||||
|   (print "\n  function:   " (dasm 'name) " [" (in dasm 'source "") "]") | ||||
|   (when-let [constants (dasm 'constants)] | ||||
|     (printf "  constants:  %.4Q" constants)) | ||||
|   (printf "  slots:      %.4Q\n" (frame :slots)) | ||||
|   (def padding (string/repeat " " 20)) | ||||
|   (loop [i :range [0 (length bytecode)] | ||||
|          :let [instr (bytecode i)]] | ||||
|     (prin (if (= (tuple/type instr) :brackets) "*" " ")) | ||||
|     (prin (if (= i pc) "> " "  ")) | ||||
|     (prinf "\e[33m%.20s\e[0m" (string (string/join (map string instr) " ") padding)) | ||||
|     (when sourcemap | ||||
|       (let [[sl sc] (sourcemap i) | ||||
|             loc [sl sc]] | ||||
|         (when (not= loc last-loc) | ||||
|           (set last-loc loc) | ||||
|           (prin " # line " sl ", column " sc)))) | ||||
|     (print)) | ||||
|   (print)) | ||||
|  | ||||
| (defn .source | ||||
|   "Show the source code for the function being debugged." | ||||
|   [&opt n] | ||||
|   (def frame (.frame n)) | ||||
|   (def s (frame :source)) | ||||
|   (def all-source (slurp s)) | ||||
|   (print "\n\e[33m" all-source "\e[0m\n")) | ||||
|  | ||||
| (defn .breakall | ||||
|   "Set breakpoints on all instructions in the current function." | ||||
|   [&opt n] | ||||
|   (def fun (.fn n)) | ||||
|   (def bytecode (.bytecode n)) | ||||
|   (for i 0 (length bytecode) | ||||
|     (debug/fbreak fun i)) | ||||
|   (print "Set " (length bytecode) " breakpoints in " fun)) | ||||
|  | ||||
| (defn .clearall | ||||
|   "Clear all breakpoints on the current function." | ||||
|   [&opt n] | ||||
|   (def fun (.fn n)) | ||||
|   (def bytecode (.bytecode n)) | ||||
|   (for i 0 (length bytecode) | ||||
|     (debug/unfbreak fun i)) | ||||
|   (print "Cleared " (length bytecode) " breakpoints in " fun)) | ||||
|  | ||||
| (defn .break | ||||
|   "Set breakpoint at the current pc." | ||||
|   [] | ||||
|   (def frame (.frame)) | ||||
|   (def fun (frame :function)) | ||||
|   (def pc (frame :pc)) | ||||
|   (debug/fbreak fun pc) | ||||
|   (print "Set breakpoint in " fun " at pc=" pc)) | ||||
|  | ||||
| (defn .clear | ||||
|   "Clear the current breakpoint" | ||||
|   [] | ||||
|   (def frame (.frame)) | ||||
|   (def fun (frame :function)) | ||||
|   (def pc (frame :pc)) | ||||
|   (debug/unfbreak fun pc) | ||||
|   (print "Cleared breakpoint in " fun " at pc=" pc)) | ||||
|  | ||||
| (defn .next | ||||
|   "Go to the next breakpoint." | ||||
|   [&opt n] | ||||
|   (var res nil) | ||||
|   (for i 0 (or n 1) | ||||
|     (set res (resume (.fiber)))) | ||||
|   res) | ||||
|  | ||||
| (defn .nextc | ||||
|   "Go to the next breakpoint, clearing the current breakpoint." | ||||
|   [&opt n] | ||||
|   (.clear) | ||||
|   (.next n)) | ||||
|  | ||||
| (defn .step | ||||
|   "Execute the next n instructions." | ||||
|   [&opt n] | ||||
|   (var res nil) | ||||
|   (for i 0 (or n 1) | ||||
|     (set res (debug/step (.fiber)))) | ||||
|   res) | ||||
| @@ -1,5 +0,0 @@ | ||||
| (with [conn (net/connect "127.0.0.1" 8000)] | ||||
|   (print "writing abcdefg...") | ||||
|   (:write conn "abcdefg") | ||||
|   (print "reading...") | ||||
|   (printf "got: %v" (:read conn 1024))) | ||||
| @@ -1,15 +0,0 @@ | ||||
| (defn handler | ||||
|   "Simple handler for connections." | ||||
|   [stream] | ||||
|   (defer (:close stream) | ||||
|     (def id (gensym)) | ||||
|     (def b @"") | ||||
|     (print "Connection " id "!") | ||||
|     (while (:read stream 1024 b) | ||||
|       (printf " %v -> %v" id b) | ||||
|       (:write stream b) | ||||
|       (buffer/clear b)) | ||||
|     (printf "Done %v!" id) | ||||
|     (ev/sleep 0.5))) | ||||
|  | ||||
| (net/server "127.0.0.1" "8000" handler) | ||||
| @@ -1,12 +0,0 @@ | ||||
| (defn worker | ||||
|   "Run for a number of iterations." | ||||
|   [name iterations] | ||||
|   (for i 0 iterations | ||||
|     (ev/sleep 1) | ||||
|     (print "worker " name " iteration " i))) | ||||
|  | ||||
| (ev/call worker :a 10) | ||||
| (ev/sleep 0.2) | ||||
| (ev/call worker :b 5) | ||||
| (ev/sleep 0.3) | ||||
| (ev/call worker :c 12) | ||||
| @@ -1,19 +0,0 @@ | ||||
| (def f | ||||
|   (coro | ||||
|     (for i 0 10 | ||||
|       (yield (string "yield " i)) | ||||
|       (os/sleep 0)))) | ||||
|  | ||||
| (print "simple yielding") | ||||
| (each item f (print "got: " item ", now " (fiber/status f))) | ||||
|  | ||||
| (def f | ||||
|   (coro | ||||
|     (for i 0 10 | ||||
|       (yield (string "yield " i)) | ||||
|       (ev/sleep 0)))) | ||||
|  | ||||
| (print "complex yielding") | ||||
| (each item f (print "got: " item ", now " (fiber/status f))) | ||||
|  | ||||
| (print (fiber/status f)) | ||||
| @@ -1,4 +1,10 @@ | ||||
| (import build/numarray) | ||||
| (import cook) | ||||
| 
 | ||||
| (cook/make-native | ||||
|     :name "numarray" | ||||
|     :source @["numarray.c"]) | ||||
| 
 | ||||
| (import build/numarray :as numarray) | ||||
| 
 | ||||
| (def a (numarray/new 30)) | ||||
| (print (get a 20)) | ||||
| @@ -7,13 +7,13 @@ typedef struct { | ||||
| } num_array; | ||||
|  | ||||
| static num_array *num_array_init(num_array *array, size_t size) { | ||||
|     array->data = (double *)janet_calloc(size, sizeof(double)); | ||||
|     array->data = (double *)calloc(size, sizeof(double)); | ||||
|     array->size = size; | ||||
|     return array; | ||||
| } | ||||
|  | ||||
| static void num_array_deinit(num_array *array) { | ||||
|     janet_free(array->data); | ||||
|     free(array->data); | ||||
| } | ||||
|  | ||||
| static int num_array_gc(void *p, size_t s) { | ||||
| @@ -23,7 +23,7 @@ static int num_array_gc(void *p, size_t s) { | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| int num_array_get(void *p, Janet key, Janet *out); | ||||
| Janet num_array_get(void *p, Janet key); | ||||
| void num_array_put(void *p, Janet key, Janet value); | ||||
|  | ||||
| static const JanetAbstractType num_array_type = { | ||||
| @@ -31,8 +31,7 @@ static const JanetAbstractType num_array_type = { | ||||
|     num_array_gc, | ||||
|     NULL, | ||||
|     num_array_get, | ||||
|     num_array_put, | ||||
|     JANET_ATEND_PUT | ||||
|     num_array_put | ||||
| }; | ||||
|  | ||||
| static Janet num_array_new(int32_t argc, Janet *argv) { | ||||
| @@ -82,20 +81,21 @@ static const JanetMethod methods[] = { | ||||
|     {NULL, NULL} | ||||
| }; | ||||
|  | ||||
| int num_array_get(void *p, Janet key, Janet *out) { | ||||
| Janet num_array_get(void *p, Janet key) { | ||||
|     size_t index; | ||||
|     Janet value; | ||||
|     num_array *array = (num_array *)p; | ||||
|     if (janet_checktype(key, JANET_KEYWORD)) | ||||
|         return janet_getmethod(janet_unwrap_keyword(key), methods, out); | ||||
|         return janet_getmethod(janet_unwrap_keyword(key), methods); | ||||
|     if (!janet_checkint(key)) | ||||
|         janet_panic("expected integer key"); | ||||
|     index = (size_t)janet_unwrap_integer(key); | ||||
|     if (index >= array->size) { | ||||
|         return 0; | ||||
|         value = janet_wrap_nil(); | ||||
|     } else { | ||||
|         *out = janet_wrap_number(array->data[index]); | ||||
|         value = janet_wrap_number(array->data[index]); | ||||
|     } | ||||
|     return 1; | ||||
|     return value; | ||||
| } | ||||
|  | ||||
| static const JanetReg cfuns[] = { | ||||
|   | ||||
| @@ -1,7 +0,0 @@ | ||||
| (declare-project | ||||
|   :name "numarray" | ||||
|   :description "Example c lib with abstract type") | ||||
|  | ||||
| (declare-native | ||||
|   :name "numarray" | ||||
|   :source @["numarray.c"]) | ||||
| @@ -1,11 +0,0 @@ | ||||
| # How random is the RNG really? | ||||
|  | ||||
| (def counts (seq [_ :range [0 100]] 0)) | ||||
|  | ||||
| (for i 0 1000000 | ||||
|   (let [x (math/random) | ||||
|         intrange (math/floor (* 100 x)) | ||||
|         oldcount (counts intrange)] | ||||
|     (put counts intrange (if oldcount (+ 1 oldcount) 1)))) | ||||
|  | ||||
| (pp counts) | ||||
| @@ -1,23 +0,0 @@ | ||||
| (def channels | ||||
|   (seq [:repeat 5] (ev/chan 4))) | ||||
|  | ||||
| (defn writer [c] | ||||
|   (for i 0 3 | ||||
|     (def item (string i ":" (mod (hash c) 999))) | ||||
|     (ev/sleep 0.1) | ||||
|     (print "writer giving item " item " to " c "...") | ||||
|     (ev/give c item)) | ||||
|   (print "Done!")) | ||||
|  | ||||
| (defn reader [name] | ||||
|   (forever | ||||
|     (def [_ c x] (ev/rselect ;channels)) | ||||
|     (print "reader " name " got " x " from " c))) | ||||
|  | ||||
| # Readers | ||||
| (each letter [:a :b :c :d :e :f :g] | ||||
|   (ev/call reader letter)) | ||||
|  | ||||
| # Writers | ||||
| (each c channels | ||||
|   (ev/call writer c)) | ||||
| @@ -1,37 +0,0 @@ | ||||
| ### | ||||
| ### examples/select2.janet | ||||
| ### | ||||
| ### Mix reads and writes in select. | ||||
| ### | ||||
|  | ||||
| (def c1 (ev/chan 40)) | ||||
| (def c2 (ev/chan 40)) | ||||
| (def c3 (ev/chan 40)) | ||||
| (def c4 (ev/chan 40)) | ||||
|  | ||||
| (def c5 (ev/chan 4)) | ||||
|  | ||||
| (defn worker | ||||
|   [c n x] | ||||
|   (forever | ||||
|     (ev/sleep n) | ||||
|     (ev/give c x))) | ||||
|  | ||||
| (defn writer-worker | ||||
|   [c] | ||||
|   (forever | ||||
|     (ev/sleep 0.2) | ||||
|     (print "writing " (ev/take c)))) | ||||
|  | ||||
| (ev/call worker c1 1 :item1) | ||||
| (ev/sleep 0.2) | ||||
| (ev/call worker c2 1 :item2) | ||||
| (ev/sleep 0.1) | ||||
| (ev/call worker c3 1 :item3) | ||||
| (ev/sleep 0.2) | ||||
| (ev/call worker c4 1 :item4) | ||||
| (ev/sleep 0.1) | ||||
| (ev/call worker c4 1 :item5) | ||||
| (ev/call writer-worker c5) | ||||
|  | ||||
| (forever (pp (ev/rselect c1 c2 c3 c4 [c5 :thing]))) | ||||
							
								
								
									
										83
									
								
								examples/tarray.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										83
									
								
								examples/tarray.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,83 @@ | ||||
| # naive matrix implementation for testing typed array | ||||
|  | ||||
| (defmacro printf [& xs] ['print ['string/format (splice xs)]]) | ||||
|  | ||||
| (defn matrix [nrow ncol] {:nrow nrow :ncol ncol :array (tarray/new :float64 (* nrow ncol))}) | ||||
|  | ||||
| (defn matrix/row [mat i] | ||||
|   (def {:nrow nrow :ncol ncol :array array} mat) | ||||
|   (tarray/new :float64 ncol 1 (* i ncol)  array)) | ||||
|  | ||||
| (defn matrix/column [mat j] | ||||
|   (def {:nrow nrow :ncol ncol :array array} mat) | ||||
|   (tarray/new :float64 nrow ncol j array)) | ||||
|  | ||||
| (defn matrix/set [mat i j value] | ||||
|   (def {:nrow nrow :ncol ncol :array array} mat) | ||||
|   (set (array (+ (* i ncol) j)) value)) | ||||
|  | ||||
| (defn matrix/get [mat i j value] | ||||
|   (def {:nrow nrow :ncol ncol :array array} mat) | ||||
|   (array (+ (* i ncol) j))) | ||||
|  | ||||
|  | ||||
| # other variants to test rows and cols views | ||||
|  | ||||
| (defn matrix/set* [mat i j value] | ||||
|   (set ((matrix/row mat i) j) value)) | ||||
|  | ||||
| (defn matrix/set** [mat i j value] | ||||
|   (set ((matrix/column mat j) i) value)) | ||||
|  | ||||
|  | ||||
| (defn matrix/get* [mat i j value] | ||||
|   ((matrix/row mat i) j)) | ||||
|  | ||||
| (defn matrix/get** [mat i j value] | ||||
|   ((matrix/column j) i)) | ||||
|  | ||||
|  | ||||
| (defn tarray/print [array] | ||||
|   (def size (tarray/length array)) | ||||
|   (def buf @"") | ||||
|   (buffer/format buf "[%2i]" size) | ||||
|   (for i 0 size | ||||
|        (buffer/format buf " %+6.3f " (array i))) | ||||
|   (print buf)) | ||||
|         | ||||
| (defn matrix/print [mat] | ||||
|   (def {:nrow nrow :ncol ncol :array tarray} mat) | ||||
|   (printf "matrix %iX%i %p" nrow ncol tarray) | ||||
|   (for i 0 nrow | ||||
|        (tarray/print (matrix/row mat i)))) | ||||
|  | ||||
|  | ||||
| (def nr 5) | ||||
| (def nc 4) | ||||
| (def A (matrix nr nc)) | ||||
|  | ||||
| (loop (i :range (0 nr) j :range (0 nc))  | ||||
|       (matrix/set A i j i)) | ||||
| (matrix/print A) | ||||
|  | ||||
| (loop (i :range (0 nr) j :range (0 nc))  | ||||
|       (matrix/set* A i j i)) | ||||
| (matrix/print A) | ||||
|  | ||||
| (loop (i :range (0 nr) j :range (0 nc))  | ||||
|       (matrix/set** A i j i)) | ||||
| (matrix/print A) | ||||
|  | ||||
|  | ||||
| (printf "properties:\n%p" (tarray/properties (A :array))) | ||||
| (for i 0 nr   | ||||
|      (printf "row properties:[%i]\n%p" i (tarray/properties (matrix/row A i)))) | ||||
| (for i 0 nc   | ||||
|      (printf "col properties:[%i]\n%p" i (tarray/properties (matrix/column A i)))) | ||||
|  | ||||
|  | ||||
|  | ||||
|  | ||||
|  | ||||
|  | ||||
|  | ||||
| @@ -1,6 +0,0 @@ | ||||
| (with [conn (net/connect "127.0.0.1" "8000")] | ||||
|   (printf "Connected to %q!" conn) | ||||
|   (:write conn "Echo...") | ||||
|   (print "Wrote to connection...") | ||||
|   (def res (:read conn 1024)) | ||||
|   (pp res)) | ||||
| @@ -1,20 +0,0 @@ | ||||
| (defn handler | ||||
|   "Simple handler for connections." | ||||
|   [stream] | ||||
|   (defer (:close stream) | ||||
|     (def id (gensym)) | ||||
|     (def b @"") | ||||
|     (print "Connection " id "!") | ||||
|     (while (:read stream 1024 b) | ||||
|       (repeat 10 (print "work for " id " ...") (ev/sleep 0.1)) | ||||
|       (:write stream b) | ||||
|       (buffer/clear b)) | ||||
|     (printf "Done %v!" id))) | ||||
|  | ||||
| # Run server. | ||||
| (let [server (net/server "127.0.0.1" "8000")] | ||||
|   (print "Starting echo server on 127.0.0.1:8000") | ||||
|   (forever | ||||
|     (if-let [conn (:accept server)] | ||||
|       (ev/call handler conn) | ||||
|       (print "no new connections")))) | ||||
| @@ -1,68 +0,0 @@ | ||||
| (defn worker-main | ||||
|   "Sends 11 messages back to parent" | ||||
|   [parent] | ||||
|   (def name (thread/receive)) | ||||
|   (def interval (thread/receive)) | ||||
|   (for i 0 10 | ||||
|     (os/sleep interval) | ||||
|     (:send parent (string/format "thread %s wakeup no. %d" name i))) | ||||
|   (:send parent name)) | ||||
|  | ||||
| (defn make-worker | ||||
|   [name interval] | ||||
|   (-> (thread/new worker-main) | ||||
|       (:send name) | ||||
|       (:send interval))) | ||||
|  | ||||
| (def bob (make-worker "bob" 0.02)) | ||||
| (def joe (make-worker "joe" 0.03)) | ||||
| (def sam (make-worker "sam" 0.05)) | ||||
|  | ||||
| # Receive out of order | ||||
| (for i 0 33 | ||||
|   (print (thread/receive))) | ||||
|  | ||||
| # | ||||
| # Recursive Thread Tree - should pause for a bit, and then print a cool zigzag. | ||||
| # | ||||
|  | ||||
| (def rng (math/rng (os/cryptorand 16))) | ||||
|  | ||||
| (defn choose [& xs] | ||||
|   (in xs (:int rng (length xs)))) | ||||
|  | ||||
| (defn worker-tree | ||||
|   [parent] | ||||
|   (def name (thread/receive)) | ||||
|   (def depth (thread/receive)) | ||||
|   (if (< depth 5) | ||||
|     (do | ||||
|     (defn subtree [] | ||||
|       (-> (thread/new worker-tree) | ||||
|           (:send (string name "/" (choose "bob" "marley" "harry" "suki" "anna" "yu"))) | ||||
|           (:send (inc depth)))) | ||||
|     (let [l (subtree) | ||||
|           r (subtree) | ||||
|           lrep (thread/receive) | ||||
|           rrep (thread/receive)] | ||||
|       (:send parent [name ;lrep ;rrep]))) | ||||
|     (do | ||||
|       (:send parent [name])))) | ||||
|  | ||||
| (-> (thread/new worker-tree) (:send "adam") (:send 0)) | ||||
| (def lines (thread/receive)) | ||||
| (map print lines) | ||||
|  | ||||
| # | ||||
| # Receive timeout | ||||
| # | ||||
|  | ||||
| (def slow (make-worker "slow-loras" 0.5)) | ||||
| (for i 0 50 | ||||
|   (try | ||||
|     (let [msg (thread/receive 0.1)] | ||||
|       (print "\n" msg)) | ||||
|     ([err] (prin ".") (:flush stdout)))) | ||||
|  | ||||
| (print "\ndone timing, timeouts ending.") | ||||
| (try (while true (print (thread/receive))) ([err] (print "done"))) | ||||
| @@ -1,5 +0,0 @@ | ||||
| (def conn (net/connect "127.0.0.1" "8009" :datagram)) | ||||
| (:write conn (string/format "%q" (os/cryptorand 16))) | ||||
| (def x (:read conn 1024)) | ||||
| (pp x) | ||||
|  | ||||
| @@ -1,6 +0,0 @@ | ||||
| (def server (net/listen "127.0.0.1" "8009" :datagram)) | ||||
| (while true | ||||
|   (def buf @"") | ||||
|   (def who (:recv-from server 1024 buf)) | ||||
|   (printf "got %q from %v, echoing!" buf who) | ||||
|   (:send-to server who buf)) | ||||
							
								
								
									
										163
									
								
								janet-installer.nsi
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										163
									
								
								janet-installer.nsi
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,163 @@ | ||||
| # Use the modern UI | ||||
| !define MULTIUSER_EXECUTIONLEVEL Highest | ||||
| !define MULTIUSER_MUI | ||||
| !define MULTIUSER_INSTALLMODE_COMMANDLINE | ||||
| !include "MultiUser.nsh" | ||||
| !include "MUI2.nsh" | ||||
| !include ".\tools\EnvVarUpdate.nsh" | ||||
|  | ||||
| # Basics | ||||
| Name "Janet" | ||||
| OutFile "janet-installer.exe" | ||||
|  | ||||
| # Some Configuration | ||||
| !define APPNAME "Janet" | ||||
| !define DESCRIPTION "The Janet Programming Language" | ||||
| !define HELPURL "http://janet-lang.org" | ||||
| BrandingText "Janet Installer" | ||||
|  | ||||
| # MUI Configuration | ||||
| !define MUI_ICON "assets\icon.ico" | ||||
| !define MUI_UNICON "assets\icon.ico" | ||||
| !define MUI_HEADERIMAGE | ||||
| !define MUI_HEADERIMAGE_BITMAP "assets\janet-w200.png" | ||||
| !define MUI_HEADERIMAGE_RIGHT | ||||
|  | ||||
| # Show a welcome page first | ||||
| !insertmacro MUI_PAGE_WELCOME | ||||
|  | ||||
| # License page | ||||
| !insertmacro MUI_PAGE_LICENSE "LICENSE" | ||||
|  | ||||
| # Pick Install Directory | ||||
| !insertmacro MULTIUSER_PAGE_INSTALLMODE | ||||
| !insertmacro MUI_PAGE_DIRECTORY | ||||
|  | ||||
| page instfiles | ||||
|  | ||||
| # Need to set a language. | ||||
| !insertmacro MUI_LANGUAGE "English" | ||||
|   | ||||
| function .onInit | ||||
| 	setShellVarContext all | ||||
| functionEnd | ||||
|  | ||||
| section "install" | ||||
|     createDirectory "$INSTDIR\Library" | ||||
|     createDirectory "$INSTDIR\C" | ||||
|     createDirectory "$INSTDIR\bin" | ||||
| 	setOutPath $INSTDIR | ||||
|      | ||||
|     file /oname=bin\janet.exe dist\janet.exe | ||||
|     file /oname=logo.ico assets\icon.ico | ||||
|      | ||||
|     file /oname=Library\cook.janet dist\cook.janet | ||||
|      | ||||
|     file /oname=C\janet.h dist\janet.h | ||||
|     file /oname=C\janetconf.h dist\janetconf.h | ||||
|     file /oname=C\janet.lib dist\janet.lib | ||||
|     file /oname=C\janet.exp dist\janet.exp | ||||
|     file /oname=C\janet.c dist\janet.c | ||||
|      | ||||
|     file /oname=bin\jpm.janet dist\jpm | ||||
|     file /oname=bin\jpm.bat dist\jpm.bat | ||||
|   | ||||
| 	# Uninstaller - See function un.onInit and section "uninstall" for configuration | ||||
| 	writeUninstaller "$INSTDIR\uninstall.exe" | ||||
|   | ||||
| 	# Start Menu | ||||
| 	createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico" | ||||
|      | ||||
|     # HKLM (all users) vs HKCU (current user) | ||||
|     WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_PATH "$INSTDIR\Library" | ||||
|     WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_HEADERPATH "$INSTDIR\C" | ||||
|     WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_BINDIR "$INSTDIR\bin" | ||||
|  | ||||
|     WriteRegExpandStr HKCU "Environment" JANET_PATH "$INSTDIR\Library" | ||||
|     WriteRegExpandStr HKCU "Environment" JANET_HEADERPATH "$INSTDIR\C" | ||||
|     WriteRegExpandStr HKCU "Environment" JANET_BINDIR "$INSTDIR\bin" | ||||
|  | ||||
|     SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000 | ||||
|      | ||||
|     # Update path | ||||
|     ${EnvVarUpdate} $0 "PATH" "A" "HKCU" "$INSTDIR\bin" ; Append | ||||
|     ${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append   | ||||
|   | ||||
| 	# Registry information for add/remove programs | ||||
| 	WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "DisplayName" "Janet" | ||||
| 	WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "UninstallString" "$INSTDIR\uninstall.exe" | ||||
| 	WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "QuietUninstallString" "$INSTDIR\uninstall.exe /S" | ||||
| 	WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "InstallLocation" "$INSTDIR" | ||||
| 	WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "DisplayIcon" "$INSTDIR\logo.ico" | ||||
| 	WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "Publisher" "Janet-Lang.org" | ||||
| 	WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "HelpLink" "${HELPURL}" | ||||
| 	WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "URLUpdateInfo" "${HELPURL}" | ||||
| 	WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "URLInfoAbout" "${HELPURL}" | ||||
| 	WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "DisplayVersion" "0.6.0" | ||||
| 	WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "VersionMajor" 0 | ||||
| 	WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "VersionMinor" 6 | ||||
| 	# There is no option for modifying or repairing the install | ||||
| 	WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "NoModify" 1 | ||||
| 	WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "NoRepair" 1 | ||||
| 	# Set the INSTALLSIZE constant (!defined at the top of this script) so Add/Remove Programs can accurately report the size | ||||
| 	WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "EstimatedSize" 1000 | ||||
| sectionEnd | ||||
|   | ||||
| # Uninstaller | ||||
|   | ||||
| function un.onInit | ||||
| 	SetShellVarContext all | ||||
|   | ||||
| 	#Verify the uninstaller - last chance to back out | ||||
| 	MessageBox MB_OKCANCEL "Permanantly remove Janet?" IDOK next | ||||
| 		Abort | ||||
| 	next: | ||||
| functionEnd | ||||
|   | ||||
| section "uninstall" | ||||
|   | ||||
| 	# Remove Start Menu launcher | ||||
| 	delete "$SMPROGRAMS\Janet.lnk" | ||||
|   | ||||
| 	# Remove files | ||||
|     delete $INSTDIR\logo.ico | ||||
|      | ||||
|     delete $INSTDIR\C\janet.c | ||||
|     delete $INSTDIR\C\janet.h | ||||
|     delete $INSTDIR\C\janet.lib | ||||
|     delete $INSTDIR\C\janet.exp | ||||
|     delete $INSTDIR\C\janetconf.h | ||||
|      | ||||
|     delete $INSTDIR\bin\jpm.janet | ||||
|     delete $INSTDIR\bin\jpm.bat | ||||
|     delete $INSTDIR\bin\janet.exe | ||||
|  | ||||
|     delete $INSTDIR\Library\cook.janet | ||||
|      | ||||
|     # Remove env vars | ||||
|  | ||||
|     DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_PATH | ||||
|     DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_HEADERPATH | ||||
|     DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_BINDIR | ||||
|  | ||||
|     DeleteRegValue HKCU "Environment" JANET_PATH | ||||
|     DeleteRegValue HKCU "Environment" JANET_HEADERPATH | ||||
|     DeleteRegValue HKCU "Environment" JANET_BINDIR | ||||
|  | ||||
|     # Unset PATH | ||||
|     ${un.EnvVarUpdate} $0 "PATH" "R" "HKCU" "$INSTDIR\bin" ; Remove | ||||
|     ${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove  | ||||
|      | ||||
|     # make sure windows knows about the change | ||||
|     SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000 | ||||
|       | ||||
| 	# Always delete uninstaller as the last action | ||||
| 	delete $INSTDIR\uninstall.exe | ||||
|   | ||||
|     rmDir "$INSTDIR\Library" | ||||
| 	rmDir "$INSTDIR\C" | ||||
|     rmDir "$INSTDIR\bin" | ||||
|   | ||||
| 	# Remove uninstaller information from the registry | ||||
| 	DeleteRegKey HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" | ||||
| sectionEnd | ||||
							
								
								
									
										167
									
								
								janet.1
									
									
									
									
									
								
							
							
						
						
									
										167
									
								
								janet.1
									
									
									
									
									
								
							| @@ -8,15 +8,13 @@ janet \- run the Janet language abstract machine | ||||
| [\fB\-l\fR \fIMODULE\fR] | ||||
| [\fB\-m\fR \fIPATH\fR] | ||||
| [\fB\-c\fR \fIMODULE JIMAGE\fR] | ||||
| [\fB\-w\fR \fILEVEL\fR] | ||||
| [\fB\-x\fR \fILEVEL\fR] | ||||
| [\fB\-\-\fR] | ||||
| .BR script | ||||
| .BR args ... | ||||
| .IR script | ||||
| .IR args ... | ||||
| .SH DESCRIPTION | ||||
| Janet is a functional and imperative programming language and bytecode interpreter. | ||||
| It is a Lisp-like language, but lists are replaced by other data structures | ||||
| (arrays, tables, structs, tuples). The language also features bridging | ||||
| It is a modern lisp, but lists are replaced by other data structures with better utility | ||||
| and performance (arrays, tables, structs, tuples). The language also bridging bridging | ||||
| to native code written in C, meta-programming with macros, and bytecode assembly. | ||||
|  | ||||
| There is a repl for trying out the language, as well as the ability to run script files. | ||||
| @@ -27,118 +25,6 @@ Implemented in mostly standard C99, Janet runs on Windows, Linux and macOS. | ||||
| The few features that are not standard C99 (dynamic library loading, compiler | ||||
| specific optimizations), are fairly straight forward. Janet can be easily ported to | ||||
| most new platforms. | ||||
|  | ||||
| .SH REPL KEY-BINDINGS | ||||
|  | ||||
| .TP 16 | ||||
| .BR Home | ||||
| Move cursor to the beginning of input line. | ||||
|  | ||||
| .TP 16 | ||||
| .BR End | ||||
| Move cursor to the end of input line. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Left/Right | ||||
| Move cursor in input line. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Up/Down | ||||
| Go backwards and forwards through history. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Tab | ||||
| Complete current symbol, or show available completions. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Delete | ||||
| Delete one character after the cursor. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Backspace | ||||
| Delete one character before the cursor. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Ctrl\-A | ||||
| Move cursor to the beginning of input line. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Ctrl\-B | ||||
| Move cursor one character to the left. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Ctrl\-D | ||||
| If on a newline, indicate end of stream and exit the repl. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Ctrl\-E | ||||
| Move cursor to the end of input line. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Ctrl\-F | ||||
| Move cursor one character to the right. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Ctrl\-H | ||||
| Delete one character before the cursor. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Ctrl\-K | ||||
| Delete everything after the cursor on the input line. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Ctrl\-L | ||||
| Clear the screen. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Ctrl\-N/Ctrl\-P | ||||
| Go forwards and backwards through history. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Ctrl\-U | ||||
| Delete everything before the cursor on the input line. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Ctrl\-W | ||||
| Delete one word before the cursor. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Ctrl\-G | ||||
| Show documentation for the current symbol under the cursor. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Ctrl\-Q | ||||
| Clear the current command, including already typed lines. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Alt\-B/Alt\-F | ||||
| Move cursor backwards and forwards one word. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Alt\-D | ||||
| Delete one word after the cursor. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Alt\-, | ||||
| Go to earliest item in history. | ||||
|  | ||||
| .TP 16 | ||||
| .BR Alt\-. | ||||
| Go to last item in history. | ||||
|  | ||||
| .LP | ||||
|  | ||||
| The repl keybindings are loosely based on a subset of GNU readline, although | ||||
| Janet does not use GNU readline internally for the repl. It is a limited | ||||
| substitute for GNU readline, and does not handle | ||||
| utf-8 input or other mutlibyte input well. | ||||
|  | ||||
| To disable the built-in repl input handling, pass the \fB\-s\fR option to Janet, and | ||||
| use a program like rlwrap with Janet to provide input. | ||||
|  | ||||
| For key bindings that operate on words, a word is considered to be a sequence | ||||
| of characters that does not contain whitespace. | ||||
|  | ||||
| .SH DOCUMENTATION | ||||
|  | ||||
| For more complete API documentation, run a REPL (Read Eval Print Loop), and use the doc macro to | ||||
| @@ -162,12 +48,6 @@ Read raw input from stdin and forgo prompt history and other readline-like featu | ||||
| Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier | ||||
| arguments are executed before later ones. | ||||
|  | ||||
| .TP | ||||
| .BR \-d | ||||
| Enable debug mode. On all terminating signals as well the debug signal, this will | ||||
| cause the debugger to come up in the REPL. Same as calling (setdyn :debug true) in a | ||||
| default repl. | ||||
|  | ||||
| .TP | ||||
| .BR \-n | ||||
| Disable ANSI colors in the repl. Has no effect if no repl is run. | ||||
| @@ -177,10 +57,6 @@ Disable ANSI colors in the repl. Has no effect if no repl is run. | ||||
| Open a REPL (Read Eval Print Loop) after executing all sources. By default, if Janet is called with no | ||||
| arguments, a REPL is opened. | ||||
|  | ||||
| .TP | ||||
| .BR \-R | ||||
| If using the REPL, disable loading the user profile from the JANET_PROFILE environment variable. | ||||
|  | ||||
| .TP | ||||
| .BR \-p | ||||
| Turn on the persistent flag. By default, when Janet is executing commands from a file and encounters an error, | ||||
| @@ -189,7 +65,7 @@ after an error. Persistent mode can be good for debugging and testing. | ||||
|  | ||||
| .TP | ||||
| .BR \-q | ||||
| Hide the logo in the repl. | ||||
| Quiet output. Don't print a repl prompt or expression results to stdout. | ||||
|  | ||||
| .TP | ||||
| .BR \-k | ||||
| @@ -197,7 +73,7 @@ Don't execute a script, only compile it to check for errors. Useful for linting | ||||
|  | ||||
| .TP | ||||
| .BR \-m\ syspath | ||||
| Set the dynamic binding :syspath to the string syspath so that Janet will load system modules | ||||
| Set the variable module/*syspath* to the string syspath so that Janet will load system modules | ||||
| from a directory different than the default. The default is set when Janet is built, and defaults to | ||||
| /usr/local/lib/janet on Linux/Posix, and C:/Janet/Library on Windows. This option supersedes JANET_PATH. | ||||
|  | ||||
| @@ -208,22 +84,11 @@ Source should be a path to the Janet module to compile, and output should be the | ||||
| resulting image. Output should usually end with the .jimage extension. | ||||
|  | ||||
| .TP | ||||
| .BR \-l\ lib | ||||
| Import a Janet module before running a script or repl. Multiple files can be loaded | ||||
| .BR \-l\ path | ||||
| Load a Janet file before running a script or repl. Multiple files can be loaded | ||||
| in this manner, and exports from each file will be made available to the script | ||||
| or repl. | ||||
| .TP | ||||
| .BR \-w\ level | ||||
| Set the warning linting level for Janet. | ||||
| This linting level should be one of :relaxed, :none, :strict, :normal, or a | ||||
| Janet number. Any linting message that is of a greater lint level than this setting will be displayed as | ||||
| a warning, but not stop compilation or execution. | ||||
| .TP | ||||
| .BR \-x\ level | ||||
| Set the error linting level for Janet. | ||||
| This linting level should be one of :relaxed, :none, :strict, :normal, or a | ||||
| Janet number. Any linting message that is of a greater lint level will cause a compilation error | ||||
| and stop compilation. | ||||
|  | ||||
| .TP | ||||
| .BR \-\- | ||||
| Stop parsing command line arguments. All arguments after this one will be considered file names | ||||
| @@ -238,19 +103,5 @@ find native and source code modules. If no JANET_PATH is set, Janet will look in | ||||
| the default location set at compile time. | ||||
| .RE | ||||
|  | ||||
| .B JANET_PROFILE | ||||
| .RS | ||||
| Path to a profile file that the interpreter will load before entering the REPL. This profile file will | ||||
| not run for scripts, though. This behavior can be disabled with the -R option. | ||||
| .RE | ||||
|  | ||||
| .B JANET_HASHSEED | ||||
| .RS | ||||
| To disable randomization of Janet's PRF on start up, one can set this variable. This can have the | ||||
| effect of making programs deterministic that otherwise would depend on the random seed chosen at program start. | ||||
| This variable does nothing in the default configuration of Janet, as PRF is disabled by default. Also, JANET_REDUCED_OS | ||||
| cannot be defined for this variable to have an effect. | ||||
| .RE | ||||
|  | ||||
| .SH AUTHOR | ||||
| Written by Calvin Rose <calsrose@gmail.com> | ||||
|   | ||||
							
								
								
									
										298
									
								
								jpm.1
									
									
									
									
									
								
							
							
						
						
									
										298
									
								
								jpm.1
									
									
									
									
									
								
							| @@ -1,298 +0,0 @@ | ||||
| .TH JPM 1 | ||||
| .SH NAME | ||||
| jpm \- the Janet Project Manager, a build tool for Janet  | ||||
| .SH SYNOPSIS | ||||
| .B jpm | ||||
| [\fB\-\-flag ...\fR] | ||||
| [\fB\-\-option=value ...\fR] | ||||
| .IR command | ||||
| .IR args ... | ||||
| .SH DESCRIPTION | ||||
| jpm is the build tool that ships with a standard Janet install. It is | ||||
| used for building Janet projects, installing dependencies, installing | ||||
| projects, building native modules, and exporting your Janet project to a | ||||
| standalone executable. Although not required for working with Janet, it | ||||
| removes much of the boilerplate with installing dependencies and | ||||
| building native modules. jpm requires only Janet to run, and uses git | ||||
| to install dependencies (jpm will work without git installed). | ||||
| .SH DOCUMENTATION | ||||
|  | ||||
| jpm has several subcommands, each used for managing either a single Janet project or | ||||
| all Janet modules installed on the system. Global commands, those that manage modules | ||||
| at the system level, do things like install and uninstall packages, as well as clear the cache. | ||||
| More interesting are the local commands. For more information on jpm usage, see https://janet-lang.org/docs/index.html | ||||
|  | ||||
| .SH FLAGS | ||||
|  | ||||
| .TP | ||||
| .BR \-\-nocolor | ||||
| Disable color in the jpm debug repl. | ||||
|  | ||||
| .TP | ||||
| .BR \-\-verbose | ||||
| Print detailed messages of what jpm is doing, including compilation commands and other shell commands. | ||||
|  | ||||
| .TP | ||||
| .BR \-\-test | ||||
| If passed to jpm install, runs tests before installing. Will run tests recursively on dependencies. | ||||
|  | ||||
| .TP | ||||
| .BR \-\-offline | ||||
| Prevents jpm from going to network to get dependencies - all dependencies should be in the cache or this command will fail. | ||||
| Use this flag with the deps and update-pkgs subcommands. This is not a surefire way to prevent a build script from accessing | ||||
| the network, for example, a build script that invokes curl will still have network access. | ||||
|  | ||||
| .TP | ||||
| .BR \-\-auto\-shebang | ||||
| Prepends installed scripts with a generated shebang line, such that they will use a janet binary located in JANET_BINPATH. | ||||
|  | ||||
| .SH OPTIONS | ||||
|  | ||||
| .TP | ||||
| .BR \-\-modpath=/some/path | ||||
| Set the path to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath) in that order. You most likely don't need this. | ||||
|  | ||||
| .TP | ||||
| .BR \-\-headerpath=/some/path | ||||
| Set the path the jpm will include when building C source code. This lets | ||||
| you specify the location of janet.h and janetconf.h on your system. On a | ||||
| normal install, this option is not needed. | ||||
|  | ||||
| .TP | ||||
| .BR \-\-binpath=/some/path | ||||
| Set the path that jpm will install scripts and standalone executables to. Executables | ||||
| defined via declare-execuatble or scripts declared via declare-binscript will be installed | ||||
| here when jpm install is run. Defaults to $JANET_BINPATH, or a reasonable default for the system. | ||||
| See JANET_BINPATH for more. | ||||
|  | ||||
| .TP | ||||
| .BR \-\-libpath=/some/path | ||||
| Sets the path jpm will use to look for libjanet.a for building standalone executables. libjanet.so | ||||
| is \fBnot\fR used for building native modules or standalone executables, only | ||||
| for linking into applications that want to embed janet as a dynamic module. | ||||
| Linking statically might be a better idea, even in that case. Defaults to | ||||
| $JANET_LIBPATH, or a reasonable default. See JANET_LIBPATH for more. | ||||
|  | ||||
| .TP | ||||
| .BR \-\-compiler=$CC | ||||
| Sets the C compiler used for compiling native modules and standalone executables. Defaults | ||||
| to cc. | ||||
|  | ||||
| .TP | ||||
| .BR \-\-cpp\-compiler=$CXX | ||||
| Sets the C++ compiler used for compiling native modules and standalone executables. Defaults | ||||
| to c++.. | ||||
|  | ||||
| .TP | ||||
| .BR \-\-linker | ||||
| Sets the linker used to create native modules and executables. Only used on windows, where | ||||
| it defaults to link.exe. | ||||
|  | ||||
| .TP | ||||
| .BR \-\-pkglist=https://github.com/janet-lang/pkgs.git | ||||
| Sets the git repository for the package listing used to resolve shorthand package names. | ||||
|  | ||||
| .TP | ||||
| .BR \-\-archiver=$AR | ||||
| Sets the command used for creating static libraries, use for linking into the standalone executable. | ||||
| Native modules are compiled twice, once a normal native module (shared object), and once as an | ||||
| archive. Defaults to ar. | ||||
|  | ||||
| .SH COMMANDS | ||||
| .TP | ||||
| .BR help | ||||
| Shows the usage text and exits immediately. | ||||
|  | ||||
| .TP | ||||
| .BR build | ||||
| Builds all artifacts specified in the project.janet file in the current directory. Artifacts will | ||||
| be created in the ./build/ directory. | ||||
|  | ||||
| .TP | ||||
| .BR install\ [\fBrepo...\fR] | ||||
| When run with no arguments, installs all installable artifacts in the current project to | ||||
| the current JANET_MODPATH for modules and JANET_BINPATH for executables and scripts. Can also | ||||
| take an optional git repository URL and will install all artifacts in that repository instead. | ||||
| When run with an argument, install does not need to be run from a jpm project directory. Will also | ||||
| install multiple dependencies in one command. | ||||
|  | ||||
| .TP | ||||
| .BR uninstall\ [\fBname...\fR] | ||||
| Uninstall a project installed with install. uninstall expects the name of the project, not the | ||||
| repository url, path to installed file, or executable name. The name of the project must be specified | ||||
| at the top of the project.janet file in the declare-project form. If no name is given, uninstalls | ||||
| the current project if installed. Will also uninstall multiple packages in one command. | ||||
|  | ||||
| .TP | ||||
| .BR clean | ||||
| Remove all artifacts created by jpm. This just deletes the build folder. | ||||
|  | ||||
| .TP | ||||
| .BR test | ||||
| Runs jpm tests. jpm will run all janet source files in the test directory as tests. A test | ||||
| is considered failing if it exits with a non-zero exit code. | ||||
|  | ||||
| .TP | ||||
| .BR deps | ||||
| Install all dependencies that this project requires recursively. jpm does not | ||||
| resolve dependency issues, like conflicting versions of the same module are required, or | ||||
| different modules with the same name. Dependencies are installed with git, so deps requires | ||||
| git to be on the PATH. | ||||
|  | ||||
| .TP | ||||
| .BR clear-cache | ||||
| jpm caches git repositories that are needed to install modules from a remote | ||||
| source in a global cache ($JANET_PATH/.cache). If these dependencies are out of | ||||
| date or too large, clear-cache will remove the cache and jpm will rebuild it | ||||
| when needed. clear-cache is a global command, so a project.janet is not | ||||
| required. | ||||
|  | ||||
| .TP | ||||
| .BR list-installed | ||||
| List all installed packages in the current syspath. | ||||
|  | ||||
| .TP | ||||
| .BR list-pkgs\ [\fBsearch\fR] | ||||
| List all package aliases in the current package listing that contain the given search string. | ||||
| If no search string is given, prints the entire listing. | ||||
|  | ||||
| .TP | ||||
| .BR clear-manifest | ||||
| jpm creates a manifest directory that contains a list of all installed files. | ||||
| By deleting this directory, jpm will think that nothing is installed and will | ||||
| try reinstalling everything on the jpm deps or jpm load-lockfile commands. Be careful with | ||||
| this command, as it may leave extra files on your system and shouldn't be needed | ||||
| most of the time in a healthy install. | ||||
|  | ||||
| .TP | ||||
| .BR run\ [\fBrule\fR] | ||||
| Run a given rule defined in project.janet. Project definitions files (project.janet) usually | ||||
| contain a few artifact declarations, which set up rules that jpm can then resolve, or execute. | ||||
| A project.janet can also create custom rules to create arbitrary files or run arbitrary code, much | ||||
| like make. run will run a single rule or build a single file. | ||||
|  | ||||
| .TP | ||||
| .BR rules | ||||
| List all rules that can be run via run. This is useful for exploring rules in the project. | ||||
|  | ||||
| .TP | ||||
| .BR rule-tree\ [\fBroot\fR]\ [\fBdepth\fR] | ||||
| Show rule dependency tree in a pretty format. Optionally provide a rule to use as the tree | ||||
| root, as well as a max depth to print. By default, prints the full tree for all rules. This | ||||
| can be quite long, so it is recommended to give a root rule. | ||||
|  | ||||
| .TP | ||||
| .BR show-paths | ||||
| Show all of the paths used when installing and building artifacts. | ||||
|  | ||||
| .TP | ||||
| .BR update-pkgs | ||||
| Update the package listing by installing the 'pkgs' package. Same as jpm install pkgs | ||||
|  | ||||
| .TP | ||||
| .BR quickbin\ [\fBentry\fR]\ [\fBexecutable\fR] | ||||
| Create a standalone, statically linked executable from a Janet source file that contains a main function. | ||||
| The main function is the entry point of the program and will receive command line arguments | ||||
| as function arguments. The entry file can import other modules, including native C modules, and | ||||
| jpm will attempt to include the dependencies into the generated executable. | ||||
|  | ||||
| .TP | ||||
| .BR debug-repl | ||||
| Load the current project.janet file and start a repl in it's environment. This lets a user better | ||||
| debug the project file, as well as run rules manually. | ||||
|  | ||||
| .TP | ||||
| .BR make-lockfile\ [\fBfilename\fR] | ||||
| Create a lockfile. A lockfile is a record that describes what dependencies were installed at the | ||||
| time of the lockfile's creation, including exact versions. A lockfile can then be later used | ||||
| to set up that environment on a different machine via load-lockfile. By default, the lockfile | ||||
| is created at lockfile.jdn, although any path can be used. | ||||
|  | ||||
| .TP | ||||
| .BR load-lockfile\ [\fBfilename\fR] | ||||
| Install dependencies from a lockfile previously created with make-lockfile. By default, will look | ||||
| for a lockfile at lockfile.jdn, although any path can be used. | ||||
|  | ||||
| .SH ENVIRONMENT | ||||
|  | ||||
| .B JANET_PATH | ||||
| .RS | ||||
| The location to look for Janet libraries. This is the only environment variable Janet needs to | ||||
| find native and source code modules. If no JANET_PATH is set, Janet will look in | ||||
| the default location set at compile time, which can be determined with (dyn :syspath) | ||||
| .RE | ||||
|  | ||||
| .B JANET_MODPATH | ||||
| .RS | ||||
| The location that jpm will use to install libraries to. Defaults to JANET_PATH, but you could | ||||
| set this to a different directory if you want to. Doing so would let you import Janet modules | ||||
| on the normal system path (JANET_PATH or (dyn :syspath)), but install to a different directory. It is also a more reliable way to install. | ||||
| This variable is overwritten by the --modpath=/some/path if it is provided. | ||||
| .RE | ||||
|  | ||||
| .B JANET_HEADERPATH | ||||
| .RS | ||||
| The location that jpm will look for janet header files (janet.h and janetconf.h) that are used | ||||
| to build native modules and standalone executables. If janet.h and janetconf.h are available as | ||||
| default includes on your system, this value is not required. If not provided, will default to | ||||
| <jpm script location>/../include/janet. The --headerpath=/some/path option will override this | ||||
| variable. | ||||
| .RE | ||||
|  | ||||
| .B JANET_LIBPATH | ||||
| .RS | ||||
| Similar to JANET_HEADERPATH, this path is where jpm will look for | ||||
| libjanet.a for creating standalone executables. This does not need to be | ||||
| set on a normal install.  | ||||
| If not provided, this will default to <jpm script location>/../lib. | ||||
| The --libpath=/some/path option will override this variable. | ||||
| .RE | ||||
|  | ||||
| .B JANET_BINPATH | ||||
| .RS | ||||
| The directory where jpm will install binary scripts and executables to. | ||||
| Defaults to | ||||
| (dyn :syspath)/bin | ||||
| The --binpath=/some/path will override this variable. | ||||
| .RE | ||||
|  | ||||
| .B JANET_PKGLIST | ||||
| .RS | ||||
| The git repository URL that contains a listing of packages. This allows installing packages with shortnames, which | ||||
| is mostly a convenience. However, package dependencies can use short names, package listings | ||||
| can be used to choose a particular set of dependency versions for a whole project. | ||||
| .RE | ||||
|  | ||||
| .B JANET_GIT | ||||
| .RS | ||||
| An optional path to a git executable to use to clone git dependencies. By default, uses "git" on the current $PATH. You shouldn't need to set this | ||||
| if you have a normal install of git. | ||||
| .RE | ||||
|  | ||||
| .B JPM_OS_WHICH | ||||
| .RS | ||||
| Use this option to override the C compiler and build system auto-detection for the host operating system. For example, set this | ||||
| environment variable to "posix" to make sure that on platforms like MinGW, you will use GCC instead of MSVC. On most platforms, users will not need to | ||||
| set this environment variable. Set this to one of the following | ||||
| strings: | ||||
| .IP | ||||
| \- windows | ||||
| .IP | ||||
| \- macos | ||||
| .IP | ||||
| \- linux | ||||
| .IP | ||||
| \- freebsd | ||||
| .IP | ||||
| \- openbsd | ||||
| .IP | ||||
| \- netbsd | ||||
| .IP | ||||
| \- bsd | ||||
| .IP | ||||
| \- posix | ||||
| .RE | ||||
|  | ||||
|  | ||||
| .SH AUTHOR | ||||
| Written by Calvin Rose <calsrose@gmail.com> | ||||
							
								
								
									
										209
									
								
								meson.build
									
									
									
									
									
								
							
							
						
						
									
										209
									
								
								meson.build
									
									
									
									
									
								
							| @@ -1,4 +1,4 @@ | ||||
| # Copyright (c) 2021 Calvin Rose and contributors | ||||
| # Copyright (c) 2019 Calvin Rose and contributors | ||||
| # | ||||
| # Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| # of this software and associated documentation files (the "Software"), to | ||||
| @@ -18,9 +18,7 @@ | ||||
| # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS | ||||
| # IN THE SOFTWARE. | ||||
|  | ||||
| project('janet', 'c', | ||||
|   default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'], | ||||
|   version : '1.16.1') | ||||
| project('janet', 'c', default_options : ['c_std=c99']) | ||||
|  | ||||
| # Global settings | ||||
| janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') | ||||
| @@ -30,65 +28,24 @@ header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet' | ||||
| cc = meson.get_compiler('c') | ||||
| m_dep = cc.find_library('m', required : false) | ||||
| dl_dep = cc.find_library('dl', required : false) | ||||
| thread_dep = dependency('threads') | ||||
|  | ||||
| # Link options | ||||
| if get_option('default_library') != 'static' and build_machine.system() != 'windows' | ||||
|     add_project_link_arguments('-rdynamic', language : 'c') | ||||
| endif | ||||
|  | ||||
| # Generate custom janetconf.h | ||||
| conf = configuration_data() | ||||
| version_parts = meson.project_version().split('.') | ||||
| last_parts = version_parts[2].split('-') | ||||
| if last_parts.length() > 1 | ||||
|   conf.set_quoted('JANET_VERSION_EXTRA', '-' + last_parts[1]) | ||||
| else | ||||
|   conf.set_quoted('JANET_VERSION_EXTRA', '') | ||||
| endif | ||||
| conf.set('JANET_VERSION_MAJOR', version_parts[0].to_int()) | ||||
| conf.set('JANET_VERSION_MINOR', version_parts[1].to_int()) | ||||
| conf.set('JANET_VERSION_PATCH', last_parts[0].to_int()) | ||||
| conf.set_quoted('JANET_VERSION', meson.project_version()) | ||||
| # Use options | ||||
| conf.set_quoted('JANET_BUILD', get_option('git_hash')) | ||||
| conf.set('JANET_NO_NANBOX', not get_option('nanbox')) | ||||
| conf.set('JANET_SINGLE_THREADED', get_option('single_threaded')) | ||||
| conf.set('JANET_NO_DYNAMIC_MODULES', not get_option('dynamic_modules')) | ||||
| conf.set('JANET_NO_DOCSTRINGS', not get_option('docstrings')) | ||||
| 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_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')) | ||||
| conf.set('JANET_PRF', get_option('prf')) | ||||
| conf.set('JANET_RECURSION_GUARD', get_option('recursion_guard')) | ||||
| conf.set('JANET_MAX_PROTO_DEPTH', get_option('max_proto_depth')) | ||||
| conf.set('JANET_MAX_MACRO_EXPAND', get_option('max_macro_expand')) | ||||
| conf.set('JANET_STACK_MAX', get_option('stack_max')) | ||||
| conf.set('JANET_NO_UMASK', not get_option('umask')) | ||||
| conf.set('JANET_NO_REALPATH', not get_option('realpath')) | ||||
| conf.set('JANET_NO_PROCESSES', not get_option('processes')) | ||||
| conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline')) | ||||
| conf.set('JANET_EV_EPOLL', get_option('epoll')) | ||||
| if get_option('os_name') != '' | ||||
|   conf.set('JANET_OS_NAME', get_option('os_name')) | ||||
| endif | ||||
| if get_option('arch_name') != '' | ||||
|   conf.set('JANET_ARCH_NAME', get_option('arch_name')) | ||||
| endif | ||||
| jconf = configure_file(output : 'janetconf.h', | ||||
|   configuration : conf) | ||||
| # Some options | ||||
| add_project_link_arguments('-rdynamic', language : 'c') | ||||
|  | ||||
| # Include directories | ||||
| incdir = include_directories(['src/include', '.']) | ||||
| incdir = include_directories('src/include') | ||||
|  | ||||
| # Building generated sources | ||||
| xxd = executable('xxd', 'tools/xxd.c') | ||||
| gen = generator(xxd, | ||||
|   output : '@BASENAME@.gen.c', | ||||
|   arguments : ['@INPUT@', '@OUTPUT@', '@EXTRA_ARGS@']) | ||||
| boot_gen = gen.process('src/boot/boot.janet', extra_args: 'janet_gen_boot') | ||||
| init_gen = gen.process('src/mainclient/init.janet', extra_args: 'janet_gen_init') | ||||
|  | ||||
| # Order is important here, as some headers | ||||
| # depend on other headers for the amalg target | ||||
| core_headers = [ | ||||
|   'src/core/features.h', | ||||
|   'src/core/util.h', | ||||
|   'src/core/state.h', | ||||
|   'src/core/gc.h', | ||||
| @@ -112,14 +69,12 @@ core_src = [ | ||||
|   'src/core/corelib.c', | ||||
|   'src/core/debug.c', | ||||
|   'src/core/emit.c', | ||||
|   'src/core/ev.c', | ||||
|   'src/core/fiber.c', | ||||
|   'src/core/gc.c', | ||||
|   'src/core/inttypes.c', | ||||
|   'src/core/io.c', | ||||
|   'src/core/marsh.c', | ||||
|   'src/core/math.c', | ||||
|   'src/core/net.c', | ||||
|   'src/core/os.c', | ||||
|   'src/core/parse.c', | ||||
|   'src/core/peg.c', | ||||
| @@ -132,8 +87,8 @@ core_src = [ | ||||
|   'src/core/struct.c', | ||||
|   'src/core/symcache.c', | ||||
|   'src/core/table.c', | ||||
|   'src/core/thread.c', | ||||
|   'src/core/tuple.c', | ||||
|   'src/core/typedarray.c', | ||||
|   'src/core/util.c', | ||||
|   'src/core/value.c', | ||||
|   'src/core/vector.c', | ||||
| @@ -151,125 +106,75 @@ boot_src = [ | ||||
| ] | ||||
|  | ||||
| mainclient_src = [ | ||||
|   'src/mainclient/shell.c' | ||||
|   'src/mainclient/line.c', | ||||
|   'src/mainclient/main.c' | ||||
| ] | ||||
|  | ||||
| # Build boot binary | ||||
| janet_boot = executable('janet-boot', core_src, boot_src, | ||||
| janet_boot = executable('janet-boot', core_src, boot_src, boot_gen, | ||||
|   include_directories : incdir, | ||||
|   c_args : '-DJANET_BOOTSTRAP', | ||||
|   dependencies : [m_dep, dl_dep, thread_dep], | ||||
|   native : true) | ||||
|   dependencies : [m_dep, dl_dep]) | ||||
|  | ||||
| # Build janet.c | ||||
| janetc = custom_target('janetc', | ||||
| # Build core image | ||||
| core_image = custom_target('core_image', | ||||
|   input : [janet_boot], | ||||
|   output : 'janet.c', | ||||
|   capture : true, | ||||
|   command : [ | ||||
|     janet_boot, meson.current_source_dir(), | ||||
|     'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path | ||||
|   ]) | ||||
|   output : 'core_image.gen.c', | ||||
|   command : [janet_boot, '@OUTPUT@', 'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path]) | ||||
|  | ||||
| janet_dependencies = [m_dep, dl_dep] | ||||
| if not get_option('single_threaded') | ||||
|   janet_dependencies += thread_dep | ||||
| endif | ||||
|  | ||||
| libjanet = library('janet', janetc, | ||||
| libjanet = shared_library('janet', core_src, core_image, | ||||
|   include_directories : incdir, | ||||
|   dependencies : janet_dependencies, | ||||
|   version: meson.project_version(), | ||||
|   soversion: version_parts[0] + '.' + version_parts[1], | ||||
|   dependencies : [m_dep, dl_dep], | ||||
|   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'] | ||||
| else | ||||
|   extra_cflags = [] | ||||
| endif | ||||
| janet_mainclient = executable('janet', janetc, mainclient_src, | ||||
| janet_mainclient = executable('janet', core_src, core_image, init_gen, mainclient_src, | ||||
|   include_directories : incdir, | ||||
|   dependencies : janet_dependencies, | ||||
|   c_args : extra_cflags, | ||||
|   dependencies : [m_dep, dl_dep], | ||||
|   install : true) | ||||
|  | ||||
| if meson.is_cross_build() | ||||
|   native_cc = meson.get_compiler('c', native: true) | ||||
|   if native_cc.has_argument('-fvisibility=hidden') | ||||
|     extra_native_cflags = ['-fvisibility=hidden'] | ||||
|   else | ||||
|     extra_native_cflags = [] | ||||
|   endif | ||||
|   janet_nativeclient = executable('janet-native', janetc, mainclient_src, | ||||
|     include_directories : incdir, | ||||
|     dependencies : janet_dependencies, | ||||
|     c_args : extra_native_cflags, | ||||
|     native : true) | ||||
| else | ||||
|   janet_nativeclient = janet_mainclient | ||||
| endif | ||||
| janet_jpm = install_data('tools/jpm', install_dir : 'bin') | ||||
|  | ||||
| # Documentation | ||||
| docs = custom_target('docs', | ||||
|   input : ['tools/gendoc.janet'], | ||||
|   output : ['doc.html'], | ||||
|   capture : true, | ||||
|   command : [janet_nativeclient, '@INPUT@']) | ||||
|   command : [janet_mainclient, '@INPUT@']) | ||||
|  | ||||
| # Amalgamated source | ||||
| amalg = custom_target('amalg', | ||||
|   input : ['tools/amalg.janet', core_headers, core_src, core_image], | ||||
|   output : ['janet.c'], | ||||
|   capture : true, | ||||
|   command : [janet_mainclient, '@INPUT@']) | ||||
|  | ||||
| # Amalgamated client | ||||
| janet_amalgclient = executable('janet-amalg', amalg, init_gen, mainclient_src, | ||||
|   include_directories : incdir, | ||||
|   dependencies : [m_dep, dl_dep], | ||||
|   build_by_default : false) | ||||
|  | ||||
| # Tests | ||||
| test_files = [ | ||||
|   'test/suite0000.janet', | ||||
|   'test/suite0001.janet', | ||||
|   'test/suite0002.janet', | ||||
|   'test/suite0003.janet', | ||||
|   'test/suite0004.janet', | ||||
|   'test/suite0005.janet', | ||||
|   'test/suite0006.janet', | ||||
|   'test/suite0007.janet', | ||||
|   'test/suite0008.janet', | ||||
|   'test/suite0009.janet', | ||||
|   'test/suite0010.janet' | ||||
|   'test/suite0.janet', | ||||
|   'test/suite1.janet', | ||||
|   'test/suite2.janet', | ||||
|   'test/suite3.janet', | ||||
|   'test/suite4.janet', | ||||
|   'test/suite5.janet', | ||||
|   'test/suite6.janet' | ||||
| ] | ||||
| foreach t : test_files | ||||
|   test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir()) | ||||
|   test(t, janet_mainclient, args : files([t]), workdir : meson.current_source_dir()) | ||||
| endforeach | ||||
|  | ||||
| # Repl | ||||
| run_target('repl', command : [janet_nativeclient]) | ||||
|  | ||||
| # For use as meson subproject (wrap) | ||||
| 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.') | ||||
| run_target('repl', command : [janet_mainclient]) | ||||
|  | ||||
| # Installation | ||||
| install_man('janet.1') | ||||
| install_data(sources : ['tools/.keep'], install_dir : join_paths(get_option('libdir'), 'janet')) | ||||
| patched_janet = custom_target('patched-janeth', | ||||
|   input : ['tools/patch-header.janet', 'src/include/janet.h', jconf], | ||||
|   install : true, | ||||
|   install_dir : join_paths(get_option('includedir'), 'janet'), | ||||
|   build_by_default : true, | ||||
|   output : ['janet.h'], | ||||
|   command : [janet_nativeclient, '@INPUT@', '@OUTPUT@']) | ||||
| if get_option('peg') and not get_option('reduced_os') and get_option('processes') | ||||
|   install_man('jpm.1') | ||||
|   patched_jpm = custom_target('patched-jpm', | ||||
|     input : ['tools/patch-jpm.janet', 'jpm'], | ||||
|     install : true, | ||||
|     install_dir : get_option('bindir'), | ||||
|     build_by_default : true, | ||||
|     output : ['jpm'], | ||||
|     command : [janet_nativeclient, '@INPUT@', '@OUTPUT@', | ||||
|       '--binpath=' + join_paths(get_option('prefix'), get_option('bindir')), | ||||
|       '--libpath=' + join_paths(get_option('prefix'), get_option('libdir')), | ||||
|       '--headerpath=' + join_paths(get_option('prefix'), get_option('includedir'))]) | ||||
| endif | ||||
| install_headers('src/include/janet.h', 'src/include/janetconf.h', subdir: 'janet') | ||||
| janet_libs = [ | ||||
|   'tools/bars.janet', | ||||
|   'tools/cook.janet', | ||||
|   'tools/highlight.janet' | ||||
| ] | ||||
| install_data(sources : janet_libs, install_dir : janet_path) | ||||
|   | ||||
| @@ -1,27 +0,0 @@ | ||||
| option('git_hash', type : 'string', value : 'meson') | ||||
|  | ||||
| option('single_threaded', type : 'boolean', value : false) | ||||
| option('nanbox', type : 'boolean', value : true) | ||||
| option('dynamic_modules', type : 'boolean', value : true) | ||||
| option('docstrings', type : 'boolean', value : true) | ||||
| option('sourcemaps', type : 'boolean', value : true) | ||||
| option('reduced_os', type : 'boolean', value : false) | ||||
| option('assembler', type : 'boolean', value : true) | ||||
| 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('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('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024) | ||||
| option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200) | ||||
| option('max_macro_expand', type : 'integer', min : 1, max : 8000, value : 200) | ||||
| option('stack_max', type : 'integer', min : 8096, max : 0x7fffffff, value : 0x7fffffff) | ||||
|  | ||||
| option('arch_name', type : 'string', value: '') | ||||
| option('os_name', type : 'string', value: '') | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -23,13 +23,6 @@ | ||||
| #include <janet.h> | ||||
| #include "tests.h" | ||||
|  | ||||
| #ifdef JANET_WINDOWS | ||||
| #include <direct.h> | ||||
| #define chdir(x) _chdir(x) | ||||
| #else | ||||
| #include <unistd.h> | ||||
| #endif | ||||
|  | ||||
| extern const unsigned char *janet_gen_boot; | ||||
| extern int32_t janet_gen_boot_size; | ||||
|  | ||||
| @@ -57,55 +50,10 @@ int main(int argc, const char **argv) { | ||||
|     JanetArray *args = janet_array(argc); | ||||
|     for (int i = 0; i < argc; i++) | ||||
|         janet_array_push(args, janet_cstringv(argv[i])); | ||||
|     janet_def(env, "boot/args", janet_wrap_array(args), "Command line arguments."); | ||||
|  | ||||
|     /* Add in options from janetconf.h so boot.janet can configure the image as needed. */ | ||||
|     JanetTable *opts = janet_table(0); | ||||
| #ifdef JANET_NO_DOCSTRINGS | ||||
|     janet_table_put(opts, janet_ckeywordv("no-docstrings"), janet_wrap_true()); | ||||
| #endif | ||||
| #ifdef JANET_NO_SOURCEMAPS | ||||
|     janet_table_put(opts, janet_ckeywordv("no-sourcemaps"), janet_wrap_true()); | ||||
| #endif | ||||
|     janet_def(env, "boot/config", janet_wrap_table(opts), "Boot options"); | ||||
|     janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments."); | ||||
|  | ||||
|     /* Run bootstrap script to generate core image */ | ||||
|     const char *boot_filename; | ||||
| #ifdef JANET_NO_SOURCEMAPS | ||||
|     boot_filename = NULL; | ||||
| #else | ||||
|     boot_filename = "boot.janet"; | ||||
| #endif | ||||
|  | ||||
|     int chdir_status = chdir(argv[1]); | ||||
|     if (chdir_status) { | ||||
|         fprintf(stderr, "Could not change to directory %s\n", argv[1]); | ||||
|         exit(1); | ||||
|     } | ||||
|  | ||||
|     FILE *boot_file = fopen("src/boot/boot.janet", "rb"); | ||||
|     if (NULL == boot_file) { | ||||
|         fprintf(stderr, "Could not open src/boot/boot.janet\n"); | ||||
|         exit(1); | ||||
|     } | ||||
|  | ||||
|     /* Slurp file into buffer */ | ||||
|     fseek(boot_file, 0, SEEK_END); | ||||
|     size_t boot_size = ftell(boot_file); | ||||
|     fseek(boot_file, 0, SEEK_SET); | ||||
|     unsigned char *boot_buffer = janet_malloc(boot_size); | ||||
|     if (NULL == boot_buffer) { | ||||
|         fprintf(stderr, "Failed to allocate boot buffer\n"); | ||||
|         exit(1); | ||||
|     } | ||||
|     if (!fread(boot_buffer, 1, boot_size, boot_file)) { | ||||
|         fprintf(stderr, "Failed to read into boot buffer\n"); | ||||
|         exit(1); | ||||
|     } | ||||
|     fclose(boot_file); | ||||
|  | ||||
|     status = janet_dobytes(env, boot_buffer, (int32_t) boot_size, boot_filename, NULL); | ||||
|     janet_free(boot_buffer); | ||||
|     status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, "boot.janet", NULL); | ||||
|  | ||||
|     /* Deinitialize vm */ | ||||
|     janet_deinit(); | ||||
|   | ||||
							
								
								
									
										3586
									
								
								src/boot/boot.janet
									
									
									
									
									
								
							
							
						
						
									
										3586
									
								
								src/boot/boot.janet
									
									
									
									
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -23,7 +23,6 @@ | ||||
| #include <janet.h> | ||||
| #include <assert.h> | ||||
| #include <stdio.h> | ||||
| #include <math.h> | ||||
|  | ||||
| #include "tests.h" | ||||
|  | ||||
| @@ -45,31 +44,11 @@ int system_test() { | ||||
|     assert(janet_equals(janet_wrap_integer(INT32_MIN), janet_wrap_integer(INT32_MIN))); | ||||
|     assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4))); | ||||
|     assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265))); | ||||
| #ifdef NAN | ||||
|     assert(janet_checktype(janet_wrap_number(NAN), JANET_NUMBER)); | ||||
| #else | ||||
|     assert(janet_checktype(janet_wrap_number(0.0 / 0.0), JANET_NUMBER)); | ||||
| #endif | ||||
|  | ||||
|     assert(NULL != &janet_wrap_nil); | ||||
|  | ||||
|     assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string."))); | ||||
|     assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym"))); | ||||
|  | ||||
|     Janet *t1 = janet_tuple_begin(3); | ||||
|     t1[0] = janet_wrap_nil(); | ||||
|     t1[1] = janet_wrap_integer(4); | ||||
|     t1[2] = janet_cstringv("hi"); | ||||
|     Janet tuple1 = janet_wrap_tuple(janet_tuple_end(t1)); | ||||
|  | ||||
|     Janet *t2 = janet_tuple_begin(3); | ||||
|     t2[0] = janet_wrap_nil(); | ||||
|     t2[1] = janet_wrap_integer(4); | ||||
|     t2[2] = janet_cstringv("hi"); | ||||
|     Janet tuple2 = janet_wrap_tuple(janet_tuple_end(t2)); | ||||
|  | ||||
|     assert(janet_equals(tuple1, tuple2)); | ||||
|  | ||||
|  | ||||
|     return 0; | ||||
| } | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -61,11 +61,5 @@ int table_test() { | ||||
|     assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10))); | ||||
|     assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100))); | ||||
|  | ||||
|     assert(t2->count == 4); | ||||
|     assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10))); | ||||
|     assert(t2->count == 3); | ||||
|     assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100))); | ||||
|     assert(t2->count == 2); | ||||
|  | ||||
|     return 0; | ||||
| } | ||||
|   | ||||
| @@ -1,61 +0,0 @@ | ||||
| /* This will be generated by the build system if this file is not used */ | ||||
|  | ||||
| #ifndef JANETCONF_H | ||||
| #define JANETCONF_H | ||||
|  | ||||
| #define JANET_VERSION_MAJOR 1 | ||||
| #define JANET_VERSION_MINOR 16 | ||||
| #define JANET_VERSION_PATCH 1 | ||||
| #define JANET_VERSION_EXTRA "" | ||||
| #define JANET_VERSION "1.16.1" | ||||
|  | ||||
| /* #define JANET_BUILD "local" */ | ||||
|  | ||||
| /* These settings all affect linking, so use cautiously. */ | ||||
| /* #define JANET_SINGLE_THREADED */ | ||||
| /* #define JANET_NO_DYNAMIC_MODULES */ | ||||
| /* #define JANET_NO_NANBOX */ | ||||
| /* #define JANET_API __attribute__((visibility ("default"))) */ | ||||
|  | ||||
| /* These settings should be specified before amalgamation is | ||||
|  * built. Any build with these set should be considered non-standard, and | ||||
|  * certain Janet libraries should be expected not to work. */ | ||||
| /* #define JANET_NO_DOCSTRINGS */ | ||||
| /* #define JANET_NO_SOURCEMAPS */ | ||||
| /* #define JANET_REDUCED_OS */ | ||||
| /* #define JANET_NO_PROCESSES */ | ||||
| /* #define JANET_NO_ASSEMBLER */ | ||||
| /* #define JANET_NO_PEG */ | ||||
| /* #define JANET_NO_NET */ | ||||
| /* #define JANET_NO_INT_TYPES */ | ||||
| /* #define JANET_NO_EV */ | ||||
| /* #define JANET_NO_REALPATH */ | ||||
| /* #define JANET_NO_SYMLINKS */ | ||||
| /* #define JANET_NO_UMASK */ | ||||
|  | ||||
| /* Other settings */ | ||||
| /* #define JANET_DEBUG */ | ||||
| /* #define JANET_PRF */ | ||||
| /* #define JANET_NO_UTC_MKTIME */ | ||||
| /* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */ | ||||
| /* #define JANET_EXIT(msg) do { printf("C assert failed executing janet: %s\n", msg); exit(1); } while (0) */ | ||||
| /* #define JANET_TOP_LEVEL_SIGNAL(msg) call_my_function((msg), stderr) */ | ||||
| /* #define JANET_RECURSION_GUARD 1024 */ | ||||
| /* #define JANET_MAX_PROTO_DEPTH 200 */ | ||||
| /* #define JANET_MAX_MACRO_EXPAND 200 */ | ||||
| /* #define JANET_STACK_MAX 16384 */ | ||||
| /* #define JANET_OS_NAME my-custom-os */ | ||||
| /* #define JANET_ARCH_NAME pdp-8 */ | ||||
| /* #define JANET_EV_EPOLL */ | ||||
|  | ||||
| /* Custom vm allocator support */ | ||||
| /* #include <mimalloc.h> */ | ||||
| /* #define janet_malloc(X) mi_malloc((X)) */ | ||||
| /* #define janet_realloc(X, Y) mi_realloc((X), (Y)) */ | ||||
| /* #define janet_calloc(X, Y) mi_calloc((X), (Y)) */ | ||||
| /* #define janet_free(X) mi_free((X)) */ | ||||
|  | ||||
| /* Main client settings, does not affect library code */ | ||||
| /* #define JANET_SIMPLE_GETLINE */ | ||||
|  | ||||
| #endif /* end of include guard: JANETCONF_H */ | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,25 +21,15 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "gc.h" | ||||
| #endif | ||||
|  | ||||
| /* Create new userdata */ | ||||
| void *janet_abstract_begin(const JanetAbstractType *atype, size_t size) { | ||||
|     JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_NONE, | ||||
| void *janet_abstract(const JanetAbstractType *atype, size_t size) { | ||||
|     JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_ABSTRACT, | ||||
|                                 sizeof(JanetAbstractHead) + size); | ||||
|     header->size = size; | ||||
|     header->type = atype; | ||||
|     return (void *) & (header->data); | ||||
| } | ||||
|  | ||||
| void *janet_abstract_end(void *x) { | ||||
|     janet_gc_settype((void *)(janet_abstract_head(x)), JANET_MEMORY_ABSTRACT); | ||||
|     return x; | ||||
| } | ||||
|  | ||||
| void *janet_abstract(const JanetAbstractType *atype, size_t size) { | ||||
|     return janet_abstract_end(janet_abstract_begin(atype, size)); | ||||
| } | ||||
|   | ||||
							
								
								
									
										151
									
								
								src/core/array.c
									
									
									
									
									
								
							
							
						
						
									
										151
									
								
								src/core/array.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,22 +21,18 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "gc.h" | ||||
| #include "util.h" | ||||
| #include "state.h" | ||||
| #endif | ||||
|  | ||||
| #include <string.h> | ||||
|  | ||||
| /* Creates a new array */ | ||||
| JanetArray *janet_array(int32_t capacity) { | ||||
|     JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray)); | ||||
| /* Initializes an array */ | ||||
| JanetArray *janet_array_init(JanetArray *array, int32_t capacity) { | ||||
|     Janet *data = NULL; | ||||
|     if (capacity > 0) { | ||||
|         janet_vm_next_collection += capacity * sizeof(Janet); | ||||
|         data = (Janet *) janet_malloc(sizeof(Janet) * (size_t) capacity); | ||||
|         data = (Janet *) malloc(sizeof(Janet) * capacity); | ||||
|         if (NULL == data) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
| @@ -47,16 +43,26 @@ JanetArray *janet_array(int32_t capacity) { | ||||
|     return array; | ||||
| } | ||||
|  | ||||
| void janet_array_deinit(JanetArray *array) { | ||||
|     free(array->data); | ||||
| } | ||||
|  | ||||
| /* Creates a new array */ | ||||
| JanetArray *janet_array(int32_t capacity) { | ||||
|     JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray)); | ||||
|     return janet_array_init(array, capacity); | ||||
| } | ||||
|  | ||||
| /* Creates a new array from n elements. */ | ||||
| JanetArray *janet_array_n(const Janet *elements, int32_t n) { | ||||
|     JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray)); | ||||
|     array->capacity = n; | ||||
|     array->count = n; | ||||
|     array->data = janet_malloc(sizeof(Janet) * (size_t) n); | ||||
|     array->data = malloc(sizeof(Janet) * n); | ||||
|     if (!array->data) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
|     safe_memcpy(array->data, elements, sizeof(Janet) * n); | ||||
|     memcpy(array->data, elements, sizeof(Janet) * n); | ||||
|     return array; | ||||
| } | ||||
|  | ||||
| @@ -65,14 +71,11 @@ void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth) { | ||||
|     Janet *newData; | ||||
|     Janet *old = array->data; | ||||
|     if (capacity <= array->capacity) return; | ||||
|     int64_t new_capacity = ((int64_t) capacity) * growth; | ||||
|     if (new_capacity > INT32_MAX) new_capacity = INT32_MAX; | ||||
|     capacity = (int32_t) new_capacity; | ||||
|     newData = janet_realloc(old, capacity * sizeof(Janet)); | ||||
|     capacity *= growth; | ||||
|     newData = realloc(old, capacity * sizeof(Janet)); | ||||
|     if (NULL == newData) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
|     janet_vm_next_collection += (capacity - array->capacity) * sizeof(Janet); | ||||
|     array->data = newData; | ||||
|     array->capacity = capacity; | ||||
| } | ||||
| @@ -93,9 +96,6 @@ void janet_array_setcount(JanetArray *array, int32_t count) { | ||||
|  | ||||
| /* Push a value to the top of the array */ | ||||
| void janet_array_push(JanetArray *array, Janet x) { | ||||
|     if (array->count == INT32_MAX) { | ||||
|         janet_panic("array overflow"); | ||||
|     } | ||||
|     int32_t newcount = array->count + 1; | ||||
|     janet_array_ensure(array, newcount, 2); | ||||
|     array->data[array->count] = x; | ||||
| @@ -129,28 +129,6 @@ static Janet cfun_array_new(int32_t argc, Janet *argv) { | ||||
|     return janet_wrap_array(array); | ||||
| } | ||||
|  | ||||
| static Janet cfun_array_new_filled(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     int32_t count = janet_getinteger(argv, 0); | ||||
|     Janet x = (argc == 2) ? argv[1] : janet_wrap_nil(); | ||||
|     JanetArray *array = janet_array(count); | ||||
|     for (int32_t i = 0; i < count; i++) { | ||||
|         array->data[i] = x; | ||||
|     } | ||||
|     array->count = count; | ||||
|     return janet_wrap_array(array); | ||||
| } | ||||
|  | ||||
| static Janet cfun_array_fill(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     JanetArray *array = janet_getarray(argv, 0); | ||||
|     Janet x = (argc == 2) ? argv[1] : janet_wrap_nil(); | ||||
|     for (int32_t i = 0; i < array->count; i++) { | ||||
|         array->data[i] = x; | ||||
|     } | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static Janet cfun_array_pop(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetArray *array = janet_getarray(argv, 0); | ||||
| @@ -166,12 +144,9 @@ static Janet cfun_array_peek(int32_t argc, Janet *argv) { | ||||
| static Janet cfun_array_push(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, -1); | ||||
|     JanetArray *array = janet_getarray(argv, 0); | ||||
|     if (INT32_MAX - argc + 1 <= array->count) { | ||||
|         janet_panic("array overflow"); | ||||
|     } | ||||
|     int32_t newcount = array->count - 1 + argc; | ||||
|     janet_array_ensure(array, newcount, 2); | ||||
|     if (argc > 1) memcpy(array->data + array->count, argv + 1, (size_t)(argc - 1) * sizeof(Janet)); | ||||
|     if (argc > 1) memcpy(array->data + array->count, argv + 1, (argc - 1) * sizeof(Janet)); | ||||
|     array->count = newcount; | ||||
|     return argv[0]; | ||||
| } | ||||
| @@ -187,8 +162,8 @@ static Janet cfun_array_ensure(int32_t argc, Janet *argv) { | ||||
| } | ||||
|  | ||||
| static Janet cfun_array_slice(int32_t argc, Janet *argv) { | ||||
|     JanetView view = janet_getindexed(argv, 0); | ||||
|     JanetRange range = janet_getslice(argc, argv); | ||||
|     JanetView view = janet_getindexed(argv, 0); | ||||
|     JanetArray *array = janet_array(range.end - range.start); | ||||
|     if (array->data) | ||||
|         memcpy(array->data, view.items + range.start, sizeof(Janet) * (range.end - range.start)); | ||||
| @@ -231,16 +206,11 @@ static Janet cfun_array_insert(int32_t argc, Janet *argv) { | ||||
|         janet_panicf("insertion index %d out of range [0,%d]", at, array->count); | ||||
|     chunksize = (argc - 2) * sizeof(Janet); | ||||
|     restsize = (array->count - at) * sizeof(Janet); | ||||
|     if (INT32_MAX - (argc - 2) < array->count) { | ||||
|         janet_panic("array overflow"); | ||||
|     } | ||||
|     janet_array_ensure(array, array->count + argc - 2, 2); | ||||
|     if (restsize) { | ||||
|         memmove(array->data + at + argc - 2, | ||||
|                 array->data + at, | ||||
|                 restsize); | ||||
|     } | ||||
|     safe_memcpy(array->data + at, argv + 2, chunksize); | ||||
|     memmove(array->data + at + argc - 2, | ||||
|             array->data + at, | ||||
|             restsize); | ||||
|     memcpy(array->data + at, argv + 2, chunksize); | ||||
|     array->count += (argc - 2); | ||||
|     return argv[0]; | ||||
| } | ||||
| @@ -270,33 +240,6 @@ static Janet cfun_array_remove(int32_t argc, Janet *argv) { | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static Janet cfun_array_trim(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetArray *array = janet_getarray(argv, 0); | ||||
|     if (array->count) { | ||||
|         if (array->count < array->capacity) { | ||||
|             Janet *newData = janet_realloc(array->data, array->count * sizeof(Janet)); | ||||
|             if (NULL == newData) { | ||||
|                 JANET_OUT_OF_MEMORY; | ||||
|             } | ||||
|             array->data = newData; | ||||
|             array->capacity = array->count; | ||||
|         } | ||||
|     } else { | ||||
|         array->capacity = 0; | ||||
|         janet_free(array->data); | ||||
|         array->data = NULL; | ||||
|     } | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static Janet cfun_array_clear(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetArray *array = janet_getarray(argv, 0); | ||||
|     array->count = 0; | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static const JanetReg array_cfuns[] = { | ||||
|     { | ||||
|         "array/new", cfun_array_new, | ||||
| @@ -304,17 +247,6 @@ static const JanetReg array_cfuns[] = { | ||||
|              "Creates a new empty array with a pre-allocated capacity. The same as " | ||||
|              "(array) but can be more efficient if the maximum size of an array is known.") | ||||
|     }, | ||||
|     { | ||||
|         "array/new-filled", cfun_array_new_filled, | ||||
|         JDOC("(array/new-filled count &opt value)\n\n" | ||||
|              "Creates a new array of count elements, all set to value, which defaults to nil. Returns the new array.") | ||||
|     }, | ||||
|     { | ||||
|         "array/fill", cfun_array_fill, | ||||
|         JDOC("(array/fill arr &opt value)\n\n" | ||||
|              "Replace all elements of an array with value (defaulting to nil) without changing the length of the array. " | ||||
|              "Returns the modified array.") | ||||
|     }, | ||||
|     { | ||||
|         "array/pop", cfun_array_pop, | ||||
|         JDOC("(array/pop arr)\n\n" | ||||
| @@ -333,56 +265,43 @@ static const JanetReg array_cfuns[] = { | ||||
|     }, | ||||
|     { | ||||
|         "array/ensure", cfun_array_ensure, | ||||
|         JDOC("(array/ensure arr capacity growth)\n\n" | ||||
|         JDOC("(array/ensure arr capacity)\n\n" | ||||
|              "Ensures that the memory backing the array is large enough for capacity " | ||||
|              "items at the given rate of growth. Capacity and growth must be integers. " | ||||
|              "If the backing capacity is already enough, then this function does nothing. " | ||||
|              "Otherwise, the backing memory will be reallocated so that there is enough space.") | ||||
|              "items. Capacity must be an integer. If the backing capacity is already enough, " | ||||
|              "then this function does nothing. Otherwise, the backing memory will be reallocated " | ||||
|              "so that there is enough space.") | ||||
|     }, | ||||
|     { | ||||
|         "array/slice", cfun_array_slice, | ||||
|         JDOC("(array/slice arrtup &opt start end)\n\n" | ||||
|         JDOC("(array/slice arrtup [, start=0 [, end=(length arrtup)]])\n\n" | ||||
|              "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 " | ||||
|              "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 " | ||||
|              "negative slice range. Returns a new array.") | ||||
|              "Returns a new array.") | ||||
|     }, | ||||
|     { | ||||
|         "array/concat", cfun_array_concat, | ||||
|         JDOC("(array/concat arr & parts)\n\n" | ||||
|              "Concatenates a variable number of arrays (and tuples) into the first argument " | ||||
|              "which must be an array. If any of the parts are arrays or tuples, their elements will " | ||||
|              "Concatenates a variadic number of arrays (and tuples) into the first argument " | ||||
|              "which must an array. If any of the parts are arrays or tuples, their elements will " | ||||
|              "be inserted into the array. Otherwise, each part in parts will be appended to arr in order. " | ||||
|              "Return the modified array arr.") | ||||
|     }, | ||||
|     { | ||||
|         "array/insert", cfun_array_insert, | ||||
|         JDOC("(array/insert arr at & xs)\n\n" | ||||
|              "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 " | ||||
|              "Insert all of xs into array arr at index at. at should be an integer " | ||||
|              "0 and the length of the array. A negative value for at will index from " | ||||
|              "the end of the array, such that inserting at -1 appends to the array. " | ||||
|              "Returns the array.") | ||||
|     }, | ||||
|     { | ||||
|         "array/remove", cfun_array_remove, | ||||
|         JDOC("(array/remove arr at &opt n)\n\n" | ||||
|         JDOC("(array/remove arr at [, n=1])\n\n" | ||||
|              "Remove up to n elements starting at index at in array arr. at can index from " | ||||
|              "the end of the array with a negative index, and n must be a non-negative integer. " | ||||
|              "By default, n is 1. " | ||||
|              "Returns the array.") | ||||
|     }, | ||||
|     { | ||||
|         "array/trim", cfun_array_trim, | ||||
|         JDOC("(array/trim arr)\n\n" | ||||
|              "Set the backing capacity of an array to its current length. Returns the modified array.") | ||||
|     }, | ||||
|     { | ||||
|         "array/clear", cfun_array_clear, | ||||
|         JDOC("(array/clear arr)\n\n" | ||||
|              "Empties an array, setting it's count to 0 but does not free the backing capacity. " | ||||
|              "Returns the modified array.") | ||||
|     }, | ||||
|     {NULL, NULL, NULL} | ||||
| }; | ||||
|  | ||||
|   | ||||
							
								
								
									
										393
									
								
								src/core/asm.c
									
									
									
									
									
								
							
							
						
						
									
										393
									
								
								src/core/asm.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,7 +21,6 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "util.h" | ||||
| #endif | ||||
| @@ -53,6 +52,7 @@ struct JanetAssembler { | ||||
|  | ||||
|     Janet name; | ||||
|     JanetTable labels; /* keyword -> bytecode index */ | ||||
|     JanetTable constants; /* symbol -> constant index */ | ||||
|     JanetTable slots; /* symbol -> slot index */ | ||||
|     JanetTable envs; /* symbol -> environment index */ | ||||
|     JanetTable defs; /* symbol -> funcdefs index */ | ||||
| @@ -73,22 +73,20 @@ static const JanetInstructionDef janet_ops[] = { | ||||
|     {"call", JOP_CALL}, | ||||
|     {"clo", JOP_CLOSURE}, | ||||
|     {"cmp", JOP_COMPARE}, | ||||
|     {"cncl", JOP_CANCEL}, | ||||
|     {"div", JOP_DIVIDE}, | ||||
|     {"divim", JOP_DIVIDE_IMMEDIATE}, | ||||
|     {"eq", JOP_EQUALS}, | ||||
|     {"eqim", JOP_EQUALS_IMMEDIATE}, | ||||
|     {"eqn", JOP_NUMERIC_EQUAL}, | ||||
|     {"err", JOP_ERROR}, | ||||
|     {"get", JOP_GET}, | ||||
|     {"geti", JOP_GET_INDEX}, | ||||
|     {"gt", JOP_GREATER_THAN}, | ||||
|     {"gte", JOP_GREATER_THAN_EQUAL}, | ||||
|     {"gten", JOP_NUMERIC_GREATER_THAN_EQUAL}, | ||||
|     {"gtim", JOP_GREATER_THAN_IMMEDIATE}, | ||||
|     {"in", JOP_IN}, | ||||
|     {"gtn", JOP_NUMERIC_GREATER_THAN}, | ||||
|     {"jmp", JOP_JUMP}, | ||||
|     {"jmpif", JOP_JUMP_IF}, | ||||
|     {"jmpni", JOP_JUMP_IF_NIL}, | ||||
|     {"jmpnn", JOP_JUMP_IF_NOT_NIL}, | ||||
|     {"jmpno", JOP_JUMP_IF_NOT}, | ||||
|     {"ldc", JOP_LOAD_CONSTANT}, | ||||
|     {"ldf", JOP_LOAD_FALSE}, | ||||
| @@ -99,8 +97,9 @@ static const JanetInstructionDef janet_ops[] = { | ||||
|     {"ldu", JOP_LOAD_UPVALUE}, | ||||
|     {"len", JOP_LENGTH}, | ||||
|     {"lt", JOP_LESS_THAN}, | ||||
|     {"lte", JOP_LESS_THAN_EQUAL}, | ||||
|     {"lten", JOP_NUMERIC_LESS_THAN_EQUAL}, | ||||
|     {"ltim", JOP_LESS_THAN_IMMEDIATE}, | ||||
|     {"ltn", JOP_NUMERIC_LESS_THAN}, | ||||
|     {"mkarr", JOP_MAKE_ARRAY}, | ||||
|     {"mkbtp", JOP_MAKE_BRACKET_TUPLE}, | ||||
|     {"mkbuf", JOP_MAKE_BUFFER}, | ||||
| @@ -108,23 +107,17 @@ static const JanetInstructionDef janet_ops[] = { | ||||
|     {"mkstu", JOP_MAKE_STRUCT}, | ||||
|     {"mktab", JOP_MAKE_TABLE}, | ||||
|     {"mktup", JOP_MAKE_TUPLE}, | ||||
|     {"mod", JOP_MODULO}, | ||||
|     {"movf", JOP_MOVE_FAR}, | ||||
|     {"movn", JOP_MOVE_NEAR}, | ||||
|     {"mul", JOP_MULTIPLY}, | ||||
|     {"mulim", JOP_MULTIPLY_IMMEDIATE}, | ||||
|     {"neq", JOP_NOT_EQUALS}, | ||||
|     {"neqim", JOP_NOT_EQUALS_IMMEDIATE}, | ||||
|     {"next", JOP_NEXT}, | ||||
|     {"noop", JOP_NOOP}, | ||||
|     {"prop", JOP_PROPAGATE}, | ||||
|     {"push", JOP_PUSH}, | ||||
|     {"push2", JOP_PUSH_2}, | ||||
|     {"push3", JOP_PUSH_3}, | ||||
|     {"pusha", JOP_PUSH_ARRAY}, | ||||
|     {"put", JOP_PUT}, | ||||
|     {"puti", JOP_PUT_INDEX}, | ||||
|     {"rem", JOP_REMAINDER}, | ||||
|     {"res", JOP_RESUME}, | ||||
|     {"ret", JOP_RETURN}, | ||||
|     {"retn", JOP_RETURN_NIL}, | ||||
| @@ -174,28 +167,21 @@ static void janet_asm_deinit(JanetAssembler *a) { | ||||
|     janet_table_deinit(&a->slots); | ||||
|     janet_table_deinit(&a->labels); | ||||
|     janet_table_deinit(&a->envs); | ||||
|     janet_table_deinit(&a->constants); | ||||
|     janet_table_deinit(&a->defs); | ||||
| } | ||||
|  | ||||
| static void janet_asm_longjmp(JanetAssembler *a) { | ||||
| #if defined(JANET_BSD) || defined(JANET_APPLE) | ||||
|     _longjmp(a->on_error, 1); | ||||
| #else | ||||
|     longjmp(a->on_error, 1); | ||||
| #endif | ||||
| } | ||||
|  | ||||
| /* Throw some kind of assembly error */ | ||||
| static void janet_asm_error(JanetAssembler *a, const char *message) { | ||||
|     a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex); | ||||
|     janet_asm_longjmp(a); | ||||
|     longjmp(a->on_error, 1); | ||||
| } | ||||
| #define janet_asm_assert(a, c, m) do { if (!(c)) janet_asm_error((a), (m)); } while (0) | ||||
|  | ||||
| /* Throw some kind of assembly error */ | ||||
| static void janet_asm_errorv(JanetAssembler *a, const uint8_t *m) { | ||||
|     a->errmessage = m; | ||||
|     janet_asm_longjmp(a); | ||||
|     longjmp(a->on_error, 1); | ||||
| } | ||||
|  | ||||
| /* Add a closure environment to the assembler. Sub funcdefs may need | ||||
| @@ -224,7 +210,7 @@ static int32_t janet_asm_addenv(JanetAssembler *a, Janet envname) { | ||||
|     janet_table_put(&a->envs, envname, janet_wrap_number(envindex)); | ||||
|     if (envindex >= a->environments_capacity) { | ||||
|         int32_t newcap = 2 * envindex; | ||||
|         def->environments = janet_realloc(def->environments, newcap * sizeof(int32_t)); | ||||
|         def->environments = realloc(def->environments, newcap * sizeof(int32_t)); | ||||
|         if (NULL == def->environments) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
| @@ -253,6 +239,9 @@ static int32_t doarg_1( | ||||
|         case JANET_OAT_ENVIRONMENT: | ||||
|             c = &a->envs; | ||||
|             break; | ||||
|         case JANET_OAT_CONSTANT: | ||||
|             c = &a->constants; | ||||
|             break; | ||||
|         case JANET_OAT_LABEL: | ||||
|             c = &a->labels; | ||||
|             break; | ||||
| @@ -504,19 +493,16 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int | ||||
|     a.defs_capacity = 0; | ||||
|     a.name = janet_wrap_nil(); | ||||
|     janet_table_init(&a.labels, 0); | ||||
|     janet_table_init(&a.constants, 0); | ||||
|     janet_table_init(&a.slots, 0); | ||||
|     janet_table_init(&a.envs, 0); | ||||
|     janet_table_init(&a.defs, 0); | ||||
|  | ||||
|     /* Set error jump */ | ||||
| #if defined(JANET_BSD) || defined(JANET_APPLE) | ||||
|     if (_setjmp(a.on_error)) { | ||||
| #else | ||||
|     if (setjmp(a.on_error)) { | ||||
| #endif | ||||
|         if (NULL != a.parent) { | ||||
|             janet_asm_deinit(&a); | ||||
|             janet_asm_longjmp(a.parent); | ||||
|             longjmp(a.parent->on_error, 1); | ||||
|         } | ||||
|         result.funcdef = NULL; | ||||
|         result.error = a.errmessage; | ||||
| @@ -531,34 +517,34 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int | ||||
|                      "expected struct or table for assembly source"); | ||||
|  | ||||
|     /* Check for function name */ | ||||
|     a.name = janet_get1(s, janet_ckeywordv("name")); | ||||
|     a.name = janet_get1(s, janet_csymbolv("name")); | ||||
|     if (!janet_checktype(a.name, JANET_NIL)) { | ||||
|         def->name = janet_to_string(a.name); | ||||
|     } | ||||
|  | ||||
|     /* Set function arity */ | ||||
|     x = janet_get1(s, janet_ckeywordv("arity")); | ||||
|     x = janet_get1(s, janet_csymbolv("arity")); | ||||
|     def->arity = janet_checkint(x) ? janet_unwrap_integer(x) : 0; | ||||
|     janet_asm_assert(&a, def->arity >= 0, "arity must be non-negative"); | ||||
|  | ||||
|     x = janet_get1(s, janet_ckeywordv("max-arity")); | ||||
|     x = janet_get1(s, janet_csymbolv("max-arity")); | ||||
|     def->max_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity; | ||||
|     janet_asm_assert(&a, def->max_arity >= def->arity, "max-arity must be greater than or equal to arity"); | ||||
|  | ||||
|     x = janet_get1(s, janet_ckeywordv("min-arity")); | ||||
|     x = janet_get1(s, janet_csymbolv("min-arity")); | ||||
|     def->min_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity; | ||||
|     janet_asm_assert(&a, def->min_arity <= def->arity, "min-arity must be less than or equal to arity"); | ||||
|  | ||||
|     /* Check vararg */ | ||||
|     x = janet_get1(s, janet_ckeywordv("vararg")); | ||||
|     x = janet_get1(s, janet_csymbolv("vararg")); | ||||
|     if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG; | ||||
|  | ||||
|     /* Check source */ | ||||
|     x = janet_get1(s, janet_ckeywordv("source")); | ||||
|     x = janet_get1(s, janet_csymbolv("source")); | ||||
|     if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x); | ||||
|  | ||||
|     /* Create slot aliases */ | ||||
|     x = janet_get1(s, janet_ckeywordv("slots")); | ||||
|     x = janet_get1(s, janet_csymbolv("slots")); | ||||
|     if (janet_indexed_view(x, &arr, &count)) { | ||||
|         for (i = 0; i < count; i++) { | ||||
|             Janet v = arr[i]; | ||||
| @@ -579,16 +565,34 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int | ||||
|     } | ||||
|  | ||||
|     /* Parse constants */ | ||||
|     x = janet_get1(s, janet_ckeywordv("constants")); | ||||
|     x = janet_get1(s, janet_csymbolv("constants")); | ||||
|     if (janet_indexed_view(x, &arr, &count)) { | ||||
|         def->constants_length = count; | ||||
|         def->constants = janet_malloc(sizeof(Janet) * (size_t) count); | ||||
|         def->constants = malloc(sizeof(Janet) * count); | ||||
|         if (NULL == def->constants) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|         for (i = 0; i < count; i++) { | ||||
|             Janet ct = arr[i]; | ||||
|             def->constants[i] = ct; | ||||
|             if (janet_checktype(ct, JANET_TUPLE) && | ||||
|                     janet_tuple_length(janet_unwrap_tuple(ct)) > 1 && | ||||
|                     janet_checktype(janet_unwrap_tuple(ct)[0], JANET_SYMBOL)) { | ||||
|                 const Janet *t = janet_unwrap_tuple(ct); | ||||
|                 int32_t tcount = janet_tuple_length(t); | ||||
|                 const uint8_t *macro = janet_unwrap_symbol(t[0]); | ||||
|                 if (0 == janet_cstrcmp(macro, "quote")) { | ||||
|                     def->constants[i] = t[1]; | ||||
|                 } else if (tcount == 3 && | ||||
|                            janet_checktype(t[1], JANET_SYMBOL) && | ||||
|                            0 == janet_cstrcmp(macro, "def")) { | ||||
|                     def->constants[i] = t[2]; | ||||
|                     janet_table_put(&a.constants, t[1], janet_wrap_integer(i)); | ||||
|                 } else { | ||||
|                     janet_asm_errorv(&a, janet_formatc("could not parse constant \"%v\"", ct)); | ||||
|                 } | ||||
|             } else { | ||||
|                 def->constants[i] = ct; | ||||
|             } | ||||
|         } | ||||
|     } else { | ||||
|         def->constants = NULL; | ||||
| @@ -596,7 +600,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int | ||||
|     } | ||||
|  | ||||
|     /* Parse sub funcdefs */ | ||||
|     x = janet_get1(s, janet_ckeywordv("closures")); | ||||
|     x = janet_get1(s, janet_csymbolv("closures")); | ||||
|     if (janet_indexed_view(x, &arr, &count)) { | ||||
|         int32_t i; | ||||
|         for (i = 0; i < count; i++) { | ||||
| @@ -607,14 +611,14 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int | ||||
|             if (subres.status != JANET_ASSEMBLE_OK) { | ||||
|                 janet_asm_errorv(&a, subres.error); | ||||
|             } | ||||
|             subname = janet_get1(arr[i], janet_ckeywordv("name")); | ||||
|             subname = janet_get1(arr[i], janet_csymbolv("name")); | ||||
|             if (!janet_checktype(subname, JANET_NIL)) { | ||||
|                 janet_table_put(&a.defs, subname, janet_wrap_integer(def->defs_length)); | ||||
|             } | ||||
|             newlen = def->defs_length + 1; | ||||
|             if (a.defs_capacity < newlen) { | ||||
|                 int32_t newcap = newlen; | ||||
|                 def->defs = janet_realloc(def->defs, newcap * sizeof(JanetFuncDef *)); | ||||
|                 def->defs = realloc(def->defs, newcap * sizeof(JanetFuncDef *)); | ||||
|                 if (NULL == def->defs) { | ||||
|                     JANET_OUT_OF_MEMORY; | ||||
|                 } | ||||
| @@ -626,7 +630,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int | ||||
|     } | ||||
|  | ||||
|     /* Parse bytecode and labels */ | ||||
|     x = janet_get1(s, janet_ckeywordv("bytecode")); | ||||
|     x = janet_get1(s, janet_csymbolv("bytecode")); | ||||
|     if (janet_indexed_view(x, &arr, &count)) { | ||||
|         /* Do labels and find length */ | ||||
|         int32_t blength = 0; | ||||
| @@ -643,7 +647,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int | ||||
|         } | ||||
|         /* Allocate bytecode array */ | ||||
|         def->bytecode_length = blength; | ||||
|         def->bytecode = janet_malloc(sizeof(uint32_t) * (size_t) blength); | ||||
|         def->bytecode = malloc(sizeof(uint32_t) * blength); | ||||
|         if (NULL == def->bytecode) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
| @@ -682,13 +686,10 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int | ||||
|     a.errindex = -1; | ||||
|  | ||||
|     /* Check for source mapping */ | ||||
|     x = janet_get1(s, janet_ckeywordv("sourcemap")); | ||||
|     x = janet_get1(s, janet_csymbolv("sourcemap")); | ||||
|     if (janet_indexed_view(x, &arr, &count)) { | ||||
|         janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode"); | ||||
|         def->sourcemap = janet_malloc(sizeof(JanetSourceMapping) * (size_t) count); | ||||
|         if (NULL == def->sourcemap) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|         def->sourcemap = malloc(sizeof(JanetSourceMapping) * count); | ||||
|         for (i = 0; i < count; i++) { | ||||
|             const Janet *tup; | ||||
|             Janet entry = arr[i]; | ||||
| @@ -703,27 +704,21 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int | ||||
|             if (!janet_checkint(tup[1])) { | ||||
|                 janet_asm_error(&a, "expected integer"); | ||||
|             } | ||||
|             mapping.line = janet_unwrap_integer(tup[0]); | ||||
|             mapping.column = janet_unwrap_integer(tup[1]); | ||||
|             mapping.start = janet_unwrap_integer(tup[0]); | ||||
|             mapping.end = janet_unwrap_integer(tup[1]); | ||||
|             def->sourcemap[i] = mapping; | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     /* Set environments */ | ||||
|     def->environments = | ||||
|         janet_realloc(def->environments, def->environments_length * sizeof(int32_t)); | ||||
|     if (NULL == def->environments) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
|         realloc(def->environments, def->environments_length * sizeof(int32_t)); | ||||
|  | ||||
|     /* Verify the func def */ | ||||
|     if (janet_verify(def)) { | ||||
|         janet_asm_error(&a, "invalid assembly"); | ||||
|     } | ||||
|  | ||||
|     /* Add final flags */ | ||||
|     janet_def_addflags(def); | ||||
|  | ||||
|     /* Finish everything and return funcdef */ | ||||
|     janet_asm_deinit(&a); | ||||
|     result.error = NULL; | ||||
| @@ -753,31 +748,31 @@ static const JanetInstructionDef *janet_asm_reverse_lookup(uint32_t instr) { | ||||
| } | ||||
|  | ||||
| /* Create some constant sized tuples */ | ||||
| static const Janet *tup1(Janet x) { | ||||
| static Janet tup1(Janet x) { | ||||
|     Janet *tup = janet_tuple_begin(1); | ||||
|     tup[0] = x; | ||||
|     return janet_tuple_end(tup); | ||||
|     return janet_wrap_tuple(janet_tuple_end(tup)); | ||||
| } | ||||
| static const Janet *tup2(Janet x, Janet y) { | ||||
| static Janet tup2(Janet x, Janet y) { | ||||
|     Janet *tup = janet_tuple_begin(2); | ||||
|     tup[0] = x; | ||||
|     tup[1] = y; | ||||
|     return janet_tuple_end(tup); | ||||
|     return janet_wrap_tuple(janet_tuple_end(tup)); | ||||
| } | ||||
| static const Janet *tup3(Janet x, Janet y, Janet z) { | ||||
| static Janet tup3(Janet x, Janet y, Janet z) { | ||||
|     Janet *tup = janet_tuple_begin(3); | ||||
|     tup[0] = x; | ||||
|     tup[1] = y; | ||||
|     tup[2] = z; | ||||
|     return janet_tuple_end(tup); | ||||
|     return janet_wrap_tuple(janet_tuple_end(tup)); | ||||
| } | ||||
| static const Janet *tup4(Janet w, Janet x, Janet y, Janet z) { | ||||
| static Janet tup4(Janet w, Janet x, Janet y, Janet z) { | ||||
|     Janet *tup = janet_tuple_begin(4); | ||||
|     tup[0] = w; | ||||
|     tup[1] = x; | ||||
|     tup[2] = y; | ||||
|     tup[3] = z; | ||||
|     return janet_tuple_end(tup); | ||||
|     return janet_wrap_tuple(janet_tuple_end(tup)); | ||||
| } | ||||
|  | ||||
| /* Given an argument, convert it to the appropriate integer or symbol */ | ||||
| @@ -788,163 +783,130 @@ Janet janet_asm_decode_instruction(uint32_t instr) { | ||||
|         return janet_wrap_integer((int32_t)instr); | ||||
|     } | ||||
|     name = janet_csymbolv(def->name); | ||||
|     const Janet *ret = NULL; | ||||
| #define oparg(shift, mask) ((instr >> ((shift) << 3)) & (mask)) | ||||
|     switch (janet_instructions[def->opcode]) { | ||||
|         case JINT_0: | ||||
|             ret = tup1(name); | ||||
|             break; | ||||
|             return tup1(name); | ||||
|         case JINT_S: | ||||
|             ret = tup2(name, janet_wrap_integer(oparg(1, 0xFFFFFF))); | ||||
|             break; | ||||
|             return tup2(name, janet_wrap_integer(oparg(1, 0xFFFFFF))); | ||||
|         case JINT_L: | ||||
|             ret = tup2(name, janet_wrap_integer((int32_t)instr >> 8)); | ||||
|             break; | ||||
|             return tup2(name, janet_wrap_integer((int32_t)instr >> 8)); | ||||
|         case JINT_SS: | ||||
|         case JINT_ST: | ||||
|         case JINT_SC: | ||||
|         case JINT_SU: | ||||
|         case JINT_SD: | ||||
|             ret = tup3(name, | ||||
|                        janet_wrap_integer(oparg(1, 0xFF)), | ||||
|                        janet_wrap_integer(oparg(2, 0xFFFF))); | ||||
|             break; | ||||
|             return tup3(name, | ||||
|                         janet_wrap_integer(oparg(1, 0xFF)), | ||||
|                         janet_wrap_integer(oparg(2, 0xFFFF))); | ||||
|         case JINT_SI: | ||||
|         case JINT_SL: | ||||
|             ret =  tup3(name, | ||||
|             return tup3(name, | ||||
|                         janet_wrap_integer(oparg(1, 0xFF)), | ||||
|                         janet_wrap_integer((int32_t)instr >> 16)); | ||||
|             break; | ||||
|         case JINT_SSS: | ||||
|         case JINT_SES: | ||||
|         case JINT_SSU: | ||||
|             ret = tup4(name, | ||||
|                        janet_wrap_integer(oparg(1, 0xFF)), | ||||
|                        janet_wrap_integer(oparg(2, 0xFF)), | ||||
|                        janet_wrap_integer(oparg(3, 0xFF))); | ||||
|             break; | ||||
|             return tup4(name, | ||||
|                         janet_wrap_integer(oparg(1, 0xFF)), | ||||
|                         janet_wrap_integer(oparg(2, 0xFF)), | ||||
|                         janet_wrap_integer(oparg(3, 0xFF))); | ||||
|         case JINT_SSI: | ||||
|             ret = tup4(name, | ||||
|                        janet_wrap_integer(oparg(1, 0xFF)), | ||||
|                        janet_wrap_integer(oparg(2, 0xFF)), | ||||
|                        janet_wrap_integer((int32_t)instr >> 24)); | ||||
|             break; | ||||
|             return tup4(name, | ||||
|                         janet_wrap_integer(oparg(1, 0xFF)), | ||||
|                         janet_wrap_integer(oparg(2, 0xFF)), | ||||
|                         janet_wrap_integer((int32_t)instr >> 24)); | ||||
|     } | ||||
| #undef oparg | ||||
|     if (ret) { | ||||
|         /* Check if break point set */ | ||||
|         if (instr & 0x80) { | ||||
|             janet_tuple_flag(ret) |= JANET_TUPLE_FLAG_BRACKETCTOR; | ||||
|         } | ||||
|         return janet_wrap_tuple(ret); | ||||
|     } | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| /* | ||||
|  * Disasm sections | ||||
|  */ | ||||
|  | ||||
| static Janet janet_disasm_arity(JanetFuncDef *def) { | ||||
|     return janet_wrap_integer(def->arity); | ||||
| } | ||||
|  | ||||
| static Janet janet_disasm_min_arity(JanetFuncDef *def) { | ||||
|     return janet_wrap_integer(def->min_arity); | ||||
| } | ||||
|  | ||||
| static Janet janet_disasm_max_arity(JanetFuncDef *def) { | ||||
|     return janet_wrap_integer(def->max_arity); | ||||
| } | ||||
|  | ||||
| static Janet janet_disasm_slotcount(JanetFuncDef *def) { | ||||
|     return janet_wrap_integer(def->slotcount); | ||||
| } | ||||
|  | ||||
| static Janet janet_disasm_bytecode(JanetFuncDef *def) { | ||||
|     JanetArray *bcode = janet_array(def->bytecode_length); | ||||
|     for (int32_t i = 0; i < def->bytecode_length; i++) { | ||||
|         bcode->data[i] = janet_asm_decode_instruction(def->bytecode[i]); | ||||
|     } | ||||
|     bcode->count = def->bytecode_length; | ||||
|     return janet_wrap_array(bcode); | ||||
| } | ||||
|  | ||||
| static Janet janet_disasm_source(JanetFuncDef *def) { | ||||
|     if (def->source != NULL) return janet_wrap_string(def->source); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| static Janet janet_disasm_name(JanetFuncDef *def) { | ||||
|     if (def->name != NULL) return janet_wrap_string(def->name); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| static Janet janet_disasm_vararg(JanetFuncDef *def) { | ||||
|     return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_VARARG); | ||||
| } | ||||
|  | ||||
| static Janet janet_disasm_constants(JanetFuncDef *def) { | ||||
|     JanetArray *constants = janet_array(def->constants_length); | ||||
|     for (int32_t i = 0; i < def->constants_length; i++) { | ||||
|         constants->data[i] = def->constants[i]; | ||||
|     } | ||||
|     constants->count = def->constants_length; | ||||
|     return janet_wrap_array(constants); | ||||
| } | ||||
|  | ||||
| static Janet janet_disasm_sourcemap(JanetFuncDef *def) { | ||||
|     if (NULL == def->sourcemap) return janet_wrap_nil(); | ||||
|     JanetArray *sourcemap = janet_array(def->bytecode_length); | ||||
|     for (int32_t i = 0; i < def->bytecode_length; i++) { | ||||
|         Janet *t = janet_tuple_begin(2); | ||||
|         JanetSourceMapping mapping = def->sourcemap[i]; | ||||
|         t[0] = janet_wrap_integer(mapping.line); | ||||
|         t[1] = janet_wrap_integer(mapping.column); | ||||
|         sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t)); | ||||
|     } | ||||
|     sourcemap->count = def->bytecode_length; | ||||
|     return janet_wrap_array(sourcemap); | ||||
| } | ||||
|  | ||||
| static Janet janet_disasm_environments(JanetFuncDef *def) { | ||||
|     JanetArray *envs = janet_array(def->environments_length); | ||||
|     for (int32_t i = 0; i < def->environments_length; i++) { | ||||
|         envs->data[i] = janet_wrap_integer(def->environments[i]); | ||||
|     } | ||||
|     envs->count = def->environments_length; | ||||
|     return janet_wrap_array(envs); | ||||
| } | ||||
|  | ||||
| static Janet janet_disasm_defs(JanetFuncDef *def) { | ||||
|     JanetArray *defs = janet_array(def->defs_length); | ||||
|     for (int32_t i = 0; i < def->defs_length; i++) { | ||||
|         defs->data[i] = janet_disasm(def->defs[i]); | ||||
|     } | ||||
|     defs->count = def->defs_length; | ||||
|     return janet_wrap_array(defs); | ||||
| } | ||||
|  | ||||
| Janet janet_disasm(JanetFuncDef *def) { | ||||
|     int32_t i; | ||||
|     JanetArray *bcode = janet_array(def->bytecode_length); | ||||
|     JanetArray *constants; | ||||
|     JanetTable *ret = janet_table(10); | ||||
|     janet_table_put(ret, janet_ckeywordv("arity"), janet_disasm_arity(def)); | ||||
|     janet_table_put(ret, janet_ckeywordv("min-arity"), janet_disasm_min_arity(def)); | ||||
|     janet_table_put(ret, janet_ckeywordv("max-arity"), janet_disasm_max_arity(def)); | ||||
|     janet_table_put(ret, janet_ckeywordv("bytecode"), janet_disasm_bytecode(def)); | ||||
|     janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def)); | ||||
|     janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(def)); | ||||
|     janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def)); | ||||
|     janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def)); | ||||
|     janet_table_put(ret, janet_ckeywordv("constants"), janet_disasm_constants(def)); | ||||
|     janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_disasm_sourcemap(def)); | ||||
|     janet_table_put(ret, janet_ckeywordv("environments"), janet_disasm_environments(def)); | ||||
|     janet_table_put(ret, janet_ckeywordv("defs"), janet_disasm_defs(def)); | ||||
|     janet_table_put(ret, janet_csymbolv("arity"), janet_wrap_integer(def->arity)); | ||||
|     janet_table_put(ret, janet_csymbolv("min-arity"), janet_wrap_integer(def->min_arity)); | ||||
|     janet_table_put(ret, janet_csymbolv("max-arity"), janet_wrap_integer(def->max_arity)); | ||||
|     janet_table_put(ret, janet_csymbolv("bytecode"), janet_wrap_array(bcode)); | ||||
|     if (NULL != def->source) { | ||||
|         janet_table_put(ret, janet_csymbolv("source"), janet_wrap_string(def->source)); | ||||
|     } | ||||
|     if (def->flags & JANET_FUNCDEF_FLAG_VARARG) { | ||||
|         janet_table_put(ret, janet_csymbolv("vararg"), janet_wrap_true()); | ||||
|     } | ||||
|     if (NULL != def->name) { | ||||
|         janet_table_put(ret, janet_csymbolv("name"), janet_wrap_string(def->name)); | ||||
|     } | ||||
|  | ||||
|     /* Add constants */ | ||||
|     if (def->constants_length > 0) { | ||||
|         constants = janet_array(def->constants_length); | ||||
|         janet_table_put(ret, janet_csymbolv("constants"), janet_wrap_array(constants)); | ||||
|         for (i = 0; i < def->constants_length; i++) { | ||||
|             Janet src = def->constants[i]; | ||||
|             Janet dest; | ||||
|             if (janet_checktype(src, JANET_TUPLE)) { | ||||
|                 dest = tup2(janet_csymbolv("quote"), src); | ||||
|             } else { | ||||
|                 dest = src; | ||||
|             } | ||||
|             constants->data[i] = dest; | ||||
|         } | ||||
|         constants->count = def->constants_length; | ||||
|     } | ||||
|  | ||||
|     /* Add bytecode */ | ||||
|     for (i = 0; i < def->bytecode_length; i++) { | ||||
|         bcode->data[i] = janet_asm_decode_instruction(def->bytecode[i]); | ||||
|     } | ||||
|     bcode->count = def->bytecode_length; | ||||
|  | ||||
|     /* Add source map */ | ||||
|     if (NULL != def->sourcemap) { | ||||
|         JanetArray *sourcemap = janet_array(def->bytecode_length); | ||||
|         for (i = 0; i < def->bytecode_length; i++) { | ||||
|             Janet *t = janet_tuple_begin(2); | ||||
|             JanetSourceMapping mapping = def->sourcemap[i]; | ||||
|             t[0] = janet_wrap_integer(mapping.start); | ||||
|             t[1] = janet_wrap_integer(mapping.end); | ||||
|             sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t)); | ||||
|         } | ||||
|         sourcemap->count = def->bytecode_length; | ||||
|         janet_table_put(ret, janet_csymbolv("sourcemap"), janet_wrap_array(sourcemap)); | ||||
|     } | ||||
|  | ||||
|     /* Add environments */ | ||||
|     if (NULL != def->environments) { | ||||
|         JanetArray *envs = janet_array(def->environments_length); | ||||
|         for (i = 0; i < def->environments_length; i++) { | ||||
|             envs->data[i] = janet_wrap_integer(def->environments[i]); | ||||
|         } | ||||
|         envs->count = def->environments_length; | ||||
|         janet_table_put(ret, janet_csymbolv("environments"), janet_wrap_array(envs)); | ||||
|     } | ||||
|  | ||||
|     /* Add closures */ | ||||
|     /* Funcdefs cannot be recursive */ | ||||
|     if (NULL != def->defs) { | ||||
|         JanetArray *defs = janet_array(def->defs_length); | ||||
|         for (i = 0; i < def->defs_length; i++) { | ||||
|             defs->data[i] = janet_disasm(def->defs[i]); | ||||
|         } | ||||
|         defs->count = def->defs_length; | ||||
|         janet_table_put(ret, janet_csymbolv("defs"), janet_wrap_array(defs)); | ||||
|     } | ||||
|  | ||||
|     /* Add slotcount */ | ||||
|     janet_table_put(ret, janet_csymbolv("slotcount"), janet_wrap_integer(def->slotcount)); | ||||
|  | ||||
|     return janet_wrap_struct(janet_table_to_struct(ret)); | ||||
| } | ||||
|  | ||||
| /* C Function for assembly */ | ||||
| static Janet cfun_asm(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     janet_arity(argc, 1, 1); | ||||
|     JanetAssembleResult res; | ||||
|     res = janet_asm(argv[0], 0); | ||||
|     if (res.status != JANET_ASSEMBLE_OK) { | ||||
| @@ -954,26 +916,9 @@ static Janet cfun_asm(int32_t argc, Janet *argv) { | ||||
| } | ||||
|  | ||||
| static Janet cfun_disasm(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     janet_arity(argc, 1, 1); | ||||
|     JanetFunction *f = janet_getfunction(argv, 0); | ||||
|     if (argc == 2) { | ||||
|         JanetKeyword kw = janet_getkeyword(argv, 1); | ||||
|         if (!janet_cstrcmp(kw, "arity")) return janet_disasm_arity(f->def); | ||||
|         if (!janet_cstrcmp(kw, "min-arity")) return janet_disasm_min_arity(f->def); | ||||
|         if (!janet_cstrcmp(kw, "max-arity")) return janet_disasm_max_arity(f->def); | ||||
|         if (!janet_cstrcmp(kw, "bytecode")) return janet_disasm_bytecode(f->def); | ||||
|         if (!janet_cstrcmp(kw, "source")) return janet_disasm_source(f->def); | ||||
|         if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def); | ||||
|         if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def); | ||||
|         if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def); | ||||
|         if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def); | ||||
|         if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def); | ||||
|         if (!janet_cstrcmp(kw, "environments")) return janet_disasm_environments(f->def); | ||||
|         if (!janet_cstrcmp(kw, "defs")) return janet_disasm_defs(f->def); | ||||
|         janet_panicf("unknown disasm key %v", argv[1]); | ||||
|     } else { | ||||
|         return janet_disasm(f->def); | ||||
|     } | ||||
|     return janet_disasm(f->def); | ||||
| } | ||||
|  | ||||
| static const JanetReg asm_cfuns[] = { | ||||
| @@ -981,29 +926,15 @@ static const JanetReg asm_cfuns[] = { | ||||
|         "asm", cfun_asm, | ||||
|         JDOC("(asm assembly)\n\n" | ||||
|              "Returns a new function that is the compiled result of the assembly.\n" | ||||
|              "The syntax for the assembly can be found on the Janet website, and should correspond\n" | ||||
|              "to the return value of disasm. Will throw an\n" | ||||
|              "The syntax for the assembly can be found on the janet wiki. Will throw an\n" | ||||
|              "error on invalid assembly.") | ||||
|     }, | ||||
|     { | ||||
|         "disasm", cfun_disasm, | ||||
|         JDOC("(disasm func &opt field)\n\n" | ||||
|              "Returns assembly that could be used to compile the given function.\n" | ||||
|         JDOC("(disasm func)\n\n" | ||||
|              "Returns assembly that could be used be compile the given function.\n" | ||||
|              "func must be a function, not a c function. Will throw on error on a badly\n" | ||||
|              "typed argument. If given a field name, will only return that part of the function assembly.\n" | ||||
|              "Possible fields are:\n\n" | ||||
|              "* :arity - number of required and optional arguments.\n\n" | ||||
|              "* :min-arity - minimum number of arguments function can be called with.\n\n" | ||||
|              "* :max-arity - maximum number of arguments function can be called with.\n\n" | ||||
|              "* :vararg - true if function can take a variable number of arguments.\n\n" | ||||
|              "* :bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n\n" | ||||
|              "* :source - name of source file that this function was compiled from.\n\n" | ||||
|              "* :name - name of function.\n\n" | ||||
|              "* :slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n\n" | ||||
|              "* :constants - an array of constants referenced by this function.\n\n" | ||||
|              "* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n\n" | ||||
|              "* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n\n" | ||||
|              "* :defs - other function definitions that this function may instantiate.\n") | ||||
|              "typed argument.") | ||||
|     }, | ||||
|     {NULL, NULL, NULL} | ||||
| }; | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,21 +21,19 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "gc.h" | ||||
| #include "util.h" | ||||
| #include "state.h" | ||||
| #endif | ||||
|  | ||||
| /* Initialize a buffer */ | ||||
| JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) { | ||||
|     uint8_t *data = NULL; | ||||
|     if (capacity < 4) capacity = 4; | ||||
|     janet_gcpressure(capacity); | ||||
|     data = janet_malloc(sizeof(uint8_t) * (size_t) capacity); | ||||
|     if (NULL == data) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     if (capacity > 0) { | ||||
|         data = malloc(sizeof(uint8_t) * capacity); | ||||
|         if (NULL == data) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|     } | ||||
|     buffer->count = 0; | ||||
|     buffer->capacity = capacity; | ||||
| @@ -45,7 +43,7 @@ JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) { | ||||
|  | ||||
| /* Deinitialize a buffer (free data memory) */ | ||||
| void janet_buffer_deinit(JanetBuffer *buffer) { | ||||
|     janet_free(buffer->data); | ||||
|     free(buffer->data); | ||||
| } | ||||
|  | ||||
| /* Initialize a buffer */ | ||||
| @@ -59,10 +57,9 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth) | ||||
|     uint8_t *new_data; | ||||
|     uint8_t *old = buffer->data; | ||||
|     if (capacity <= buffer->capacity) return; | ||||
|     int64_t big_capacity = ((int64_t) capacity) * growth; | ||||
|     int64_t big_capacity = capacity * growth; | ||||
|     capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity; | ||||
|     janet_gcpressure(capacity - buffer->capacity); | ||||
|     new_data = janet_realloc(old, (size_t) capacity * sizeof(uint8_t)); | ||||
|     new_data = realloc(old, capacity * sizeof(uint8_t)); | ||||
|     if (NULL == new_data) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
| @@ -91,9 +88,8 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) { | ||||
|     } | ||||
|     int32_t new_size = buffer->count + n; | ||||
|     if (new_size > buffer->capacity) { | ||||
|         int32_t new_capacity = (new_size > (INT32_MAX / 2)) ? INT32_MAX : (new_size * 2); | ||||
|         uint8_t *new_data = janet_realloc(buffer->data, new_capacity * sizeof(uint8_t)); | ||||
|         janet_gcpressure(new_capacity - buffer->capacity); | ||||
|         int32_t new_capacity = new_size * 2; | ||||
|         uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t)); | ||||
|         if (NULL == new_data) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
| @@ -111,7 +107,6 @@ void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) { | ||||
|  | ||||
| /* Push multiple bytes into the buffer */ | ||||
| void janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t length) { | ||||
|     if (0 == length) return; | ||||
|     janet_buffer_extra(buffer, length); | ||||
|     memcpy(buffer->data + buffer->count, string, length); | ||||
|     buffer->count += length; | ||||
| @@ -183,34 +178,6 @@ static Janet cfun_buffer_new_filled(int32_t argc, Janet *argv) { | ||||
|     return janet_wrap_buffer(buffer); | ||||
| } | ||||
|  | ||||
| static Janet cfun_buffer_fill(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     JanetBuffer *buffer = janet_getbuffer(argv, 0); | ||||
|     int32_t byte = 0; | ||||
|     if (argc == 2) { | ||||
|         byte = janet_getinteger(argv, 1) & 0xFF; | ||||
|     } | ||||
|     if (buffer->count) { | ||||
|         memset(buffer->data, byte, buffer->count); | ||||
|     } | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static Janet cfun_buffer_trim(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetBuffer *buffer = janet_getbuffer(argv, 0); | ||||
|     if (buffer->count < buffer->capacity) { | ||||
|         int32_t newcap = buffer->count > 4 ? buffer->count : 4; | ||||
|         uint8_t *newData = janet_realloc(buffer->data, newcap); | ||||
|         if (NULL == newData) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|         buffer->data = newData; | ||||
|         buffer->capacity = newcap; | ||||
|     } | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static Janet cfun_buffer_u8(int32_t argc, Janet *argv) { | ||||
|     int32_t i; | ||||
|     janet_arity(argc, 1, -1); | ||||
| @@ -250,26 +217,6 @@ static Janet cfun_buffer_chars(int32_t argc, Janet *argv) { | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static Janet cfun_buffer_push(int32_t argc, Janet *argv) { | ||||
|     int32_t i; | ||||
|     janet_arity(argc, 1, -1); | ||||
|     JanetBuffer *buffer = janet_getbuffer(argv, 0); | ||||
|     for (i = 1; i < argc; i++) { | ||||
|         if (janet_checktype(argv[i], JANET_NUMBER)) { | ||||
|             janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF)); | ||||
|         } else { | ||||
|             JanetByteView view = janet_getbytes(argv, i); | ||||
|             if (view.bytes == buffer->data) { | ||||
|                 janet_buffer_ensure(buffer, buffer->count + view.len, 2); | ||||
|                 view.bytes = buffer->data; | ||||
|             } | ||||
|             janet_buffer_push_bytes(buffer, view.bytes, view.len); | ||||
|         } | ||||
|     } | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
|  | ||||
| static Janet cfun_buffer_clear(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetBuffer *buffer = janet_getbuffer(argv, 0); | ||||
| @@ -291,8 +238,8 @@ static Janet cfun_buffer_popn(int32_t argc, Janet *argv) { | ||||
| } | ||||
|  | ||||
| static Janet cfun_buffer_slice(int32_t argc, Janet *argv) { | ||||
|     JanetByteView view = janet_getbytes(argv, 0); | ||||
|     JanetRange range = janet_getslice(argc, argv); | ||||
|     JanetByteView view = janet_getbytes(argv, 0); | ||||
|     JanetBuffer *buffer = janet_buffer(range.end - range.start); | ||||
|     if (buffer->data) | ||||
|         memcpy(buffer->data, view.bytes + range.start, range.end - range.start); | ||||
| @@ -368,20 +315,16 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) { | ||||
|     } else { | ||||
|         length_src = src.len - offset_src; | ||||
|     } | ||||
|     int64_t last = (int64_t) offset_dest + length_src; | ||||
|     int64_t last = ((int64_t) offset_dest - offset_src) + length_src; | ||||
|     if (last > INT32_MAX) | ||||
|         janet_panic("buffer blit out of range"); | ||||
|     int32_t last32 = (int32_t) last; | ||||
|     janet_buffer_ensure(dest, last32, 2); | ||||
|     if (last32 > dest->count) dest->count = last32; | ||||
|     if (length_src) { | ||||
|         if (same_buf) { | ||||
|             /* janet_buffer_ensure may have invalidated src */ | ||||
|             src.bytes = dest->data; | ||||
|             memmove(dest->data + offset_dest, src.bytes + offset_src, length_src); | ||||
|         } else { | ||||
|             memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src); | ||||
|         } | ||||
|     janet_buffer_ensure(dest, (int32_t) last, 2); | ||||
|     if (last > dest->count) dest->count = (int32_t) last; | ||||
|     if (same_buf) { | ||||
|         src.bytes = dest->data; | ||||
|         memmove(dest->data + offset_dest, src.bytes + offset_src, length_src); | ||||
|     } else { | ||||
|         memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src); | ||||
|     } | ||||
|     return argv[0]; | ||||
| } | ||||
| @@ -398,55 +341,33 @@ static const JanetReg buffer_cfuns[] = { | ||||
|     { | ||||
|         "buffer/new", cfun_buffer_new, | ||||
|         JDOC("(buffer/new capacity)\n\n" | ||||
|              "Creates a new, empty buffer with enough backing memory for capacity bytes. " | ||||
|              "Returns a new buffer of length 0.") | ||||
|              "Creates a new, empty buffer with enough memory for capacity bytes. " | ||||
|              "Returns a new buffer.") | ||||
|     }, | ||||
|     { | ||||
|         "buffer/new-filled", cfun_buffer_new_filled, | ||||
|         JDOC("(buffer/new-filled count &opt byte)\n\n" | ||||
|              "Creates a new buffer of length count filled with byte. By default, byte is 0. " | ||||
|         JDOC("(buffer/new-filled count [, byte=0])\n\n" | ||||
|              "Creates a new buffer of length count filled with byte. " | ||||
|              "Returns the new buffer.") | ||||
|     }, | ||||
|     { | ||||
|         "buffer/fill", cfun_buffer_fill, | ||||
|         JDOC("(buffer/fill buffer &opt byte)\n\n" | ||||
|              "Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. " | ||||
|              "Returns the modified buffer.") | ||||
|     }, | ||||
|     { | ||||
|         "buffer/trim", cfun_buffer_trim, | ||||
|         JDOC("(buffer/trim buffer)\n\n" | ||||
|              "Set the backing capacity of the buffer to the current length of the buffer. Returns the " | ||||
|              "modified buffer.") | ||||
|     }, | ||||
|     { | ||||
|         "buffer/push-byte", cfun_buffer_u8, | ||||
|         JDOC("(buffer/push-byte buffer & xs)\n\n" | ||||
|              "Append bytes to a buffer. Will expand the buffer as necessary. " | ||||
|         JDOC("(buffer/push-byte buffer x)\n\n" | ||||
|              "Append a byte to a buffer. Will expand the buffer as necessary. " | ||||
|              "Returns the modified buffer. Will throw an error if the buffer overflows.") | ||||
|     }, | ||||
|     { | ||||
|         "buffer/push-word", cfun_buffer_word, | ||||
|         JDOC("(buffer/push-word buffer & xs)\n\n" | ||||
|              "Append machine words to a buffer. The 4 bytes of the integer are appended " | ||||
|              "in twos complement, little endian order, unsigned for all x. Returns the modified buffer. Will " | ||||
|         JDOC("(buffer/push-word buffer x)\n\n" | ||||
|              "Append a machine word to a buffer. The 4 bytes of the integer are appended " | ||||
|              "in twos complement, big endian order, unsigned. Returns the modified buffer. Will " | ||||
|              "throw an error if the buffer overflows.") | ||||
|     }, | ||||
|     { | ||||
|         "buffer/push-string", cfun_buffer_chars, | ||||
|         JDOC("(buffer/push-string buffer & xs)\n\n" | ||||
|              "Push byte sequences onto the end of a buffer. " | ||||
|              "Will accept any of strings, keywords, symbols, and buffers. " | ||||
|              "Returns the modified buffer. " | ||||
|              "Will throw an error if the buffer overflows.") | ||||
|     }, | ||||
|     { | ||||
|         "buffer/push", cfun_buffer_push, | ||||
|         JDOC("(buffer/push buffer & xs)\n\n" | ||||
|              "Push both individual bytes and byte sequences to a buffer. For each x in xs, " | ||||
|              "push the byte if x is an integer, otherwise push the bytesequence to the buffer. " | ||||
|              "Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. " | ||||
|              "Returns the modified buffer. " | ||||
|         JDOC("(buffer/push-string buffer str)\n\n" | ||||
|              "Push a string onto the end of a buffer. Non string values will be converted " | ||||
|              "to strings before being pushed. Returns the modified buffer. " | ||||
|              "Will throw an error if the buffer overflows.") | ||||
|     }, | ||||
|     { | ||||
| @@ -462,7 +383,7 @@ static const JanetReg buffer_cfuns[] = { | ||||
|     }, | ||||
|     { | ||||
|         "buffer/slice", cfun_buffer_slice, | ||||
|         JDOC("(buffer/slice bytes &opt start end)\n\n" | ||||
|         JDOC("(buffer/slice bytes [, start=0 [, end=(length bytes)]])\n\n" | ||||
|              "Takes a slice of a byte sequence from start to end. The range is half open, " | ||||
|              "[start, end). Indexes can also be negative, indicating indexing from the end of the " | ||||
|              "end of the array. By default, start is 0 and end is the length of the buffer. " | ||||
| @@ -490,7 +411,7 @@ static const JanetReg buffer_cfuns[] = { | ||||
|     }, | ||||
|     { | ||||
|         "buffer/blit", cfun_buffer_blit, | ||||
|         JDOC("(buffer/blit dest src &opt dest-start src-start src-end)\n\n" | ||||
|         JDOC("(buffer/blit dest src [, dest-start=0 [, src-start=0 [, src-end=-1]]])\n\n" | ||||
|              "Insert the contents of src into dest. Can optionally take indices that " | ||||
|              "indicate which part of src to copy into which part of dest. Indices can be " | ||||
|              "negative to index from the end of src or dest. Returns dest.") | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,7 +21,6 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "gc.h" | ||||
| #include "util.h" | ||||
| @@ -41,8 +40,6 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = { | ||||
|     JINT_SSS, /* JOP_MULTIPLY, */ | ||||
|     JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */ | ||||
|     JINT_SSS, /* JOP_DIVIDE, */ | ||||
|     JINT_SSS, /* JOP_MODULO, */ | ||||
|     JINT_SSS, /* JOP_REMAINDER, */ | ||||
|     JINT_SSS, /* JOP_BAND, */ | ||||
|     JINT_SSS, /* JOP_BOR, */ | ||||
|     JINT_SSS, /* JOP_BXOR, */ | ||||
| @@ -58,8 +55,6 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = { | ||||
|     JINT_L, /* JOP_JUMP, */ | ||||
|     JINT_SL, /* JOP_JUMP_IF, */ | ||||
|     JINT_SL, /* JOP_JUMP_IF_NOT, */ | ||||
|     JINT_SL, /* JOP_JUMP_IF_NIL, */ | ||||
|     JINT_SL, /* JOP_JUMP_IF_NOT_NIL, */ | ||||
|     JINT_SSS, /* JOP_GREATER_THAN, */ | ||||
|     JINT_SSI, /* JOP_GREATER_THAN_IMMEDIATE, */ | ||||
|     JINT_SSS, /* JOP_LESS_THAN, */ | ||||
| @@ -84,8 +79,6 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = { | ||||
|     JINT_S, /* JOP_TAILCALL, */ | ||||
|     JINT_SSS, /* JOP_RESUME, */ | ||||
|     JINT_SSU, /* JOP_SIGNAL, */ | ||||
|     JINT_SSS, /* JOP_PROPAGATE */ | ||||
|     JINT_SSS, /* JOP_IN, */ | ||||
|     JINT_SSS, /* JOP_GET, */ | ||||
|     JINT_SSS, /* JOP_PUT, */ | ||||
|     JINT_SSU, /* JOP_GET_INDEX, */ | ||||
| @@ -98,16 +91,15 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = { | ||||
|     JINT_S, /* JOP_MAKE_TABLE */ | ||||
|     JINT_S, /* JOP_MAKE_TUPLE */ | ||||
|     JINT_S, /* JOP_MAKE_BRACKET_TUPLE */ | ||||
|     JINT_SSS, /* JOP_GREATER_THAN_EQUAL */ | ||||
|     JINT_SSS, /* JOP_LESS_THAN_EQUAL */ | ||||
|     JINT_SSS, /* JOP_NEXT */ | ||||
|     JINT_SSS, /* JOP_NOT_EQUALS, */ | ||||
|     JINT_SSI, /* JOP_NOT_EQUALS_IMMEDIATE, */ | ||||
|     JINT_SSS /* JOP_CANCEL, */ | ||||
|     JINT_SSS, /* JOP_NUMERIC_LESS_THAN */ | ||||
|     JINT_SSS, /* JOP_NUMERIC_LESS_THAN_EQUAL */ | ||||
|     JINT_SSS, /* JOP_NUMERIC_GREATER_THAN */ | ||||
|     JINT_SSS, /* JOP_NUMERIC_GREATER_THAN_EQUAL */ | ||||
|     JINT_SSS /* JOP_NUMERIC_EQUAL */ | ||||
| }; | ||||
|  | ||||
| /* Verify some bytecode */ | ||||
| int janet_verify(JanetFuncDef *def) { | ||||
| int32_t janet_verify(JanetFuncDef *def) { | ||||
|     int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG); | ||||
|     int32_t i; | ||||
|     int32_t maxslot = def->arity + vargs; | ||||
| @@ -210,12 +202,11 @@ int janet_verify(JanetFuncDef *def) { | ||||
|  | ||||
| /* Allocate an empty funcdef. This function may have added functionality | ||||
|  * as commonalities between asm and compile arise. */ | ||||
| JanetFuncDef *janet_funcdef_alloc(void) { | ||||
| JanetFuncDef *janet_funcdef_alloc() { | ||||
|     JanetFuncDef *def = janet_gcalloc(JANET_MEMORY_FUNCDEF, sizeof(JanetFuncDef)); | ||||
|     def->environments = NULL; | ||||
|     def->constants = NULL; | ||||
|     def->bytecode = NULL; | ||||
|     def->closure_bitset = NULL; | ||||
|     def->flags = 0; | ||||
|     def->slotcount = 0; | ||||
|     def->arity = 0; | ||||
|   | ||||
							
								
								
									
										267
									
								
								src/core/capi.c
									
									
									
									
									
								
							
							
						
						
									
										267
									
								
								src/core/capi.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,56 +21,21 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "state.h" | ||||
| #include "fiber.h" | ||||
| #endif | ||||
|  | ||||
| #ifndef JANET_SINGLE_THREADED | ||||
| #ifndef JANET_WINDOWS | ||||
| #include <pthread.h> | ||||
| #else | ||||
| #include <windows.h> | ||||
| #endif | ||||
| #endif | ||||
|  | ||||
| JANET_NO_RETURN static void janet_top_level_signal(const char *msg) { | ||||
| #ifdef JANET_TOP_LEVEL_SIGNAL | ||||
|     JANET_TOP_LEVEL_SIGNAL(msg); | ||||
| #else | ||||
|     fputs(msg, stdout); | ||||
| # ifdef JANET_SINGLE_THREADED | ||||
|     exit(-1); | ||||
| # elif defined(JANET_WINDOWS) | ||||
|     ExitThread(-1); | ||||
| # else | ||||
|     pthread_exit(NULL); | ||||
| # endif | ||||
| #endif | ||||
| } | ||||
|  | ||||
| void janet_signalv(JanetSignal sig, Janet message) { | ||||
| void janet_panicv(Janet message) { | ||||
|     if (janet_vm_return_reg != NULL) { | ||||
|         *janet_vm_return_reg = message; | ||||
|         if (NULL != janet_vm_fiber) { | ||||
|             janet_vm_fiber->flags |= JANET_FIBER_DID_LONGJUMP; | ||||
|         } | ||||
| #if defined(JANET_BSD) || defined(JANET_APPLE) | ||||
|         _longjmp(*janet_vm_jmp_buf, sig); | ||||
| #else | ||||
|         longjmp(*janet_vm_jmp_buf, sig); | ||||
| #endif | ||||
|         longjmp(*janet_vm_jmp_buf, 1); | ||||
|     } else { | ||||
|         const char *str = (const char *)janet_formatc("janet top level signal - %v\n", message); | ||||
|         janet_top_level_signal(str); | ||||
|         fputs((const char *)janet_formatc("janet top level panic - %v\n", message), stdout); | ||||
|         exit(1); | ||||
|     } | ||||
| } | ||||
|  | ||||
| void janet_panicv(Janet message) { | ||||
|     janet_signalv(JANET_SIGNAL_ERROR, message); | ||||
| } | ||||
|  | ||||
| void janet_panicf(const char *format, ...) { | ||||
|     va_list args; | ||||
|     const uint8_t *ret; | ||||
| @@ -79,13 +44,26 @@ void janet_panicf(const char *format, ...) { | ||||
|     while (format[len]) len++; | ||||
|     janet_buffer_init(&buffer, len); | ||||
|     va_start(args, format); | ||||
|     janet_formatbv(&buffer, format, args); | ||||
|     janet_formatb(&buffer, format, args); | ||||
|     va_end(args); | ||||
|     ret = janet_string(buffer.data, buffer.count); | ||||
|     janet_buffer_deinit(&buffer); | ||||
|     janet_panics(ret); | ||||
| } | ||||
|  | ||||
| void janet_printf(const char *format, ...) { | ||||
|     va_list args; | ||||
|     JanetBuffer buffer; | ||||
|     int32_t len = 0; | ||||
|     while (format[len]) len++; | ||||
|     janet_buffer_init(&buffer, len); | ||||
|     va_start(args, format); | ||||
|     janet_formatb(&buffer, format, args); | ||||
|     va_end(args); | ||||
|     fwrite(buffer.data, buffer.count, 1, stdout); | ||||
|     janet_buffer_deinit(&buffer); | ||||
| } | ||||
|  | ||||
| void janet_panic(const char *message) { | ||||
|     janet_panicv(janet_cstringv(message)); | ||||
| } | ||||
| @@ -123,47 +101,14 @@ type janet_get##name(const Janet *argv, int32_t n) { \ | ||||
|     return janet_unwrap_##name(x); \ | ||||
| } | ||||
|  | ||||
| #define DEFINE_OPT(name, NAME, type) \ | ||||
| type janet_opt##name(const Janet *argv, int32_t argc, int32_t n, type dflt) { \ | ||||
|     if (n >= argc) return dflt; \ | ||||
|     if (janet_checktype(argv[n], JANET_NIL)) return dflt; \ | ||||
|     return janet_get##name(argv, n); \ | ||||
| } | ||||
|  | ||||
| #define DEFINE_OPTLEN(name, NAME, type) \ | ||||
| type janet_opt##name(const Janet *argv, int32_t argc, int32_t n, int32_t dflt_len) { \ | ||||
|     if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {\ | ||||
|         return janet_##name(dflt_len); \ | ||||
|     }\ | ||||
|     return janet_get##name(argv, n); \ | ||||
| } | ||||
|  | ||||
| int janet_getmethod(const uint8_t *method, const JanetMethod *methods, Janet *out) { | ||||
| Janet janet_getmethod(const uint8_t *method, const JanetMethod *methods) { | ||||
|     while (methods->name) { | ||||
|         if (!janet_cstrcmp(method, methods->name)) { | ||||
|             *out = janet_wrap_cfunction(methods->cfun); | ||||
|             return 1; | ||||
|         } | ||||
|         if (!janet_cstrcmp(method, methods->name)) | ||||
|             return janet_wrap_cfunction(methods->cfun); | ||||
|         methods++; | ||||
|     } | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| Janet janet_nextmethod(const JanetMethod *methods, Janet key) { | ||||
|     if (!janet_checktype(key, JANET_NIL)) { | ||||
|         while (methods->name) { | ||||
|             if (janet_keyeq(key, methods->name)) { | ||||
|                 methods++; | ||||
|                 break; | ||||
|             } | ||||
|             methods++; | ||||
|         } | ||||
|     } | ||||
|     if (methods->name) { | ||||
|         return janet_ckeywordv(methods->name); | ||||
|     } else { | ||||
|         return janet_wrap_nil(); | ||||
|     } | ||||
|     janet_panicf("unknown method %S invoked", method); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| DEFINE_GETTER(number, NUMBER, double) | ||||
| @@ -181,33 +126,6 @@ DEFINE_GETTER(cfunction, CFUNCTION, JanetCFunction) | ||||
| DEFINE_GETTER(boolean, BOOLEAN, int) | ||||
| DEFINE_GETTER(pointer, POINTER, void *) | ||||
|  | ||||
| DEFINE_OPT(number, NUMBER, double) | ||||
| DEFINE_OPT(tuple, TUPLE, const Janet *) | ||||
| DEFINE_OPT(struct, STRUCT, const JanetKV *) | ||||
| DEFINE_OPT(string, STRING, const uint8_t *) | ||||
| DEFINE_OPT(keyword, KEYWORD, const uint8_t *) | ||||
| DEFINE_OPT(symbol, SYMBOL, const uint8_t *) | ||||
| DEFINE_OPT(fiber, FIBER, JanetFiber *) | ||||
| DEFINE_OPT(function, FUNCTION, JanetFunction *) | ||||
| DEFINE_OPT(cfunction, CFUNCTION, JanetCFunction) | ||||
| DEFINE_OPT(boolean, BOOLEAN, int) | ||||
| DEFINE_OPT(pointer, POINTER, void *) | ||||
|  | ||||
| DEFINE_OPTLEN(buffer, BUFFER, JanetBuffer *) | ||||
| DEFINE_OPTLEN(table, TABLE, JanetTable *) | ||||
| DEFINE_OPTLEN(array, ARRAY, JanetArray *) | ||||
|  | ||||
| const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const char *dflt) { | ||||
|     if (n >= argc || janet_checktype(argv[n], JANET_NIL)) { | ||||
|         return dflt; | ||||
|     } | ||||
|     return janet_getcstring(argv, n); | ||||
| } | ||||
|  | ||||
| #undef DEFINE_GETTER | ||||
| #undef DEFINE_OPT | ||||
| #undef DEFINE_OPTLEN | ||||
|  | ||||
| const char *janet_getcstring(const Janet *argv, int32_t n) { | ||||
|     const uint8_t *jstr = janet_getstring(argv, n); | ||||
|     const char *cstr = (const char *)jstr; | ||||
| @@ -217,44 +135,10 @@ const char *janet_getcstring(const Janet *argv, int32_t n) { | ||||
|     return cstr; | ||||
| } | ||||
|  | ||||
| int32_t janet_getnat(const Janet *argv, int32_t n) { | ||||
|     Janet x = argv[n]; | ||||
|     if (!janet_checkint(x)) goto bad; | ||||
|     int32_t ret = janet_unwrap_integer(x); | ||||
|     if (ret < 0) goto bad; | ||||
|     return ret; | ||||
| bad: | ||||
|     janet_panicf("bad slot #%d, expected non-negative 32 bit signed integer, got %v", n, x); | ||||
| } | ||||
|  | ||||
| JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at) { | ||||
|     if (!janet_checktype(x, JANET_ABSTRACT)) return NULL; | ||||
|     JanetAbstract a = janet_unwrap_abstract(x); | ||||
|     if (janet_abstract_type(a) != at) return NULL; | ||||
|     return a; | ||||
| } | ||||
|  | ||||
| static int janet_strlike_cmp(JanetType type, Janet x, const char *cstring) { | ||||
|     if (janet_type(x) != type) return 0; | ||||
|     return !janet_cstrcmp(janet_unwrap_string(x), cstring); | ||||
| } | ||||
|  | ||||
| int janet_keyeq(Janet x, const char *cstring) { | ||||
|     return janet_strlike_cmp(JANET_KEYWORD, x, cstring); | ||||
| } | ||||
|  | ||||
| int janet_streq(Janet x, const char *cstring) { | ||||
|     return janet_strlike_cmp(JANET_STRING, x, cstring); | ||||
| } | ||||
|  | ||||
| int janet_symeq(Janet x, const char *cstring) { | ||||
|     return janet_strlike_cmp(JANET_SYMBOL, x, cstring); | ||||
| } | ||||
|  | ||||
| int32_t janet_getinteger(const Janet *argv, int32_t n) { | ||||
|     Janet x = argv[n]; | ||||
|     if (!janet_checkint(x)) { | ||||
|         janet_panicf("bad slot #%d, expected 32 bit signed integer, got %v", n, x); | ||||
|         janet_panicf("bad slot #%d, expected integer, got %v", n, x); | ||||
|     } | ||||
|     return janet_unwrap_integer(x); | ||||
| } | ||||
| @@ -262,7 +146,7 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) { | ||||
| int64_t janet_getinteger64(const Janet *argv, int32_t n) { | ||||
|     Janet x = argv[n]; | ||||
|     if (!janet_checkint64(x)) { | ||||
|         janet_panicf("bad slot #%d, expected 64 bit signed integer, got %v", n, x); | ||||
|         janet_panicf("bad slot #%d, expected 64 bit integer, got %v", n, x); | ||||
|     } | ||||
|     return (int64_t) janet_unwrap_number(x); | ||||
| } | ||||
| @@ -277,20 +161,18 @@ size_t janet_getsize(const Janet *argv, int32_t n) { | ||||
|  | ||||
| int32_t janet_gethalfrange(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 + 1; | ||||
|     if (not_raw < 0 || not_raw > length) | ||||
|         janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length); | ||||
|     return not_raw; | ||||
|     if (raw < 0) raw += length + 1; | ||||
|     if (raw < 0 || raw > length) | ||||
|         janet_panicf("%s index %d out of range [0,%d]", which, raw, length); | ||||
|     return raw; | ||||
| } | ||||
|  | ||||
| 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); | ||||
|     return not_raw; | ||||
|     if (raw < 0) raw += length; | ||||
|     if (raw < 0 || raw > length) | ||||
|         janet_panicf("%s index %d out of range [0,%d)", which, raw, length); | ||||
|     return raw; | ||||
| } | ||||
|  | ||||
| JanetView janet_getindexed(const Janet *argv, int32_t n) { | ||||
| @@ -340,17 +222,11 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) { | ||||
|         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.start = 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"); | ||||
|         range.start = janet_gethalfrange(argv, 1, length, "start"); | ||||
|         range.end = janet_gethalfrange(argv, 2, length, "end"); | ||||
|         if (range.end < range.start) | ||||
|             range.end = range.start; | ||||
|     } | ||||
| @@ -358,10 +234,7 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) { | ||||
| } | ||||
|  | ||||
| Janet janet_dyn(const char *name) { | ||||
|     if (!janet_vm_fiber) { | ||||
|         if (!janet_vm_top_dyns) return janet_wrap_nil(); | ||||
|         return janet_table_get(janet_vm_top_dyns, janet_ckeywordv(name)); | ||||
|     } | ||||
|     if (!janet_vm_fiber) return janet_wrap_nil(); | ||||
|     if (janet_vm_fiber->env) { | ||||
|         return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name)); | ||||
|     } else { | ||||
| @@ -370,67 +243,11 @@ Janet janet_dyn(const char *name) { | ||||
| } | ||||
|  | ||||
| void janet_setdyn(const char *name, Janet value) { | ||||
|     if (!janet_vm_fiber) { | ||||
|         if (!janet_vm_top_dyns) janet_vm_top_dyns = janet_table(10); | ||||
|         janet_table_put(janet_vm_top_dyns, janet_ckeywordv(name), value); | ||||
|     } else { | ||||
|         if (!janet_vm_fiber->env) { | ||||
|             janet_vm_fiber->env = janet_table(1); | ||||
|         } | ||||
|         janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value); | ||||
|     if (!janet_vm_fiber) return; | ||||
|     if (!janet_vm_fiber->env) { | ||||
|         janet_vm_fiber->env = janet_table(1); | ||||
|     } | ||||
| } | ||||
|  | ||||
| uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) { | ||||
|     uint64_t ret = 0; | ||||
|     const uint8_t *keyw = janet_getkeyword(argv, n); | ||||
|     int32_t klen = janet_string_length(keyw); | ||||
|     int32_t flen = (int32_t) strlen(flags); | ||||
|     if (flen > 64) { | ||||
|         flen = 64; | ||||
|     } | ||||
|     for (int32_t j = 0; j < klen; j++) { | ||||
|         for (int32_t i = 0; i < flen; i++) { | ||||
|             if (((uint8_t) flags[i]) == keyw[j]) { | ||||
|                 ret |= 1ULL << i; | ||||
|                 goto found; | ||||
|             } | ||||
|         } | ||||
|         janet_panicf("unexpected flag %c, expected one of \"%s\"", (char) keyw[j], flags); | ||||
|     found: | ||||
|         ; | ||||
|     } | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| int32_t janet_optnat(const Janet *argv, int32_t argc, int32_t n, int32_t dflt) { | ||||
|     if (argc <= n) return dflt; | ||||
|     if (janet_checktype(argv[n], JANET_NIL)) return dflt; | ||||
|     return janet_getnat(argv, n); | ||||
| } | ||||
|  | ||||
| int32_t janet_optinteger(const Janet *argv, int32_t argc, int32_t n, int32_t dflt) { | ||||
|     if (argc <= n) return dflt; | ||||
|     if (janet_checktype(argv[n], JANET_NIL)) return dflt; | ||||
|     return janet_getinteger(argv, n); | ||||
| } | ||||
|  | ||||
| int64_t janet_optinteger64(const Janet *argv, int32_t argc, int32_t n, int64_t dflt) { | ||||
|     if (argc <= n) return dflt; | ||||
|     if (janet_checktype(argv[n], JANET_NIL)) return dflt; | ||||
|     return janet_getinteger64(argv, n); | ||||
| } | ||||
|  | ||||
| size_t janet_optsize(const Janet *argv, int32_t argc, int32_t n, size_t dflt) { | ||||
|     if (argc <= n) return dflt; | ||||
|     if (janet_checktype(argv[n], JANET_NIL)) return dflt; | ||||
|     return janet_getsize(argv, n); | ||||
| } | ||||
|  | ||||
| void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetAbstractType *at, void *dflt) { | ||||
|     if (argc <= n) return dflt; | ||||
|     if (janet_checktype(argv[n], JANET_NIL)) return dflt; | ||||
|     return janet_getabstract(argv, n, at); | ||||
|     janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value); | ||||
| } | ||||
|  | ||||
| /* Some definitions for function-like macros */ | ||||
|   | ||||
							
								
								
									
										227
									
								
								src/core/cfuns.c
									
									
									
									
									
								
							
							
						
						
									
										227
									
								
								src/core/cfuns.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,31 +21,20 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "compile.h" | ||||
| #include "emit.h" | ||||
| #include "vector.h" | ||||
| #endif | ||||
|  | ||||
| static int arity1or2(JanetFopts opts, JanetSlot *args) { | ||||
| static int fixarity0(JanetFopts opts, JanetSlot *args) { | ||||
|     (void) opts; | ||||
|     int32_t arity = janet_v_count(args); | ||||
|     return arity == 1 || arity == 2; | ||||
| } | ||||
| static int arity2or3(JanetFopts opts, JanetSlot *args) { | ||||
|     (void) opts; | ||||
|     int32_t arity = janet_v_count(args); | ||||
|     return arity == 2 || arity == 3; | ||||
|     return janet_v_count(args) == 0; | ||||
| } | ||||
| static int fixarity1(JanetFopts opts, JanetSlot *args) { | ||||
|     (void) opts; | ||||
|     return janet_v_count(args) == 1; | ||||
| } | ||||
| static int maxarity1(JanetFopts opts, JanetSlot *args) { | ||||
|     (void) opts; | ||||
|     return janet_v_count(args) <= 1; | ||||
| } | ||||
| static int minarity2(JanetFopts opts, JanetSlot *args) { | ||||
|     (void) opts; | ||||
|     return janet_v_count(args) >= 2; | ||||
| @@ -73,139 +62,43 @@ static JanetSlot genericSSI(JanetFopts opts, int op, JanetSlot s, int32_t imm) { | ||||
|     return target; | ||||
| } | ||||
|  | ||||
| /* Emit an insruction that implements a form by itself. */ | ||||
| static JanetSlot opfunction( | ||||
|     JanetFopts opts, | ||||
|     JanetSlot *args, | ||||
|     int op, | ||||
|     Janet defaultArg2) { | ||||
|     JanetCompiler *c = opts.compiler; | ||||
|     int32_t len; | ||||
|     len = janet_v_count(args); | ||||
|     JanetSlot t; | ||||
|     if (len == 1) { | ||||
|         t = janetc_gettarget(opts); | ||||
|         janetc_emit_sss(c, op, t, args[0], janetc_cslot(defaultArg2), 1); | ||||
|         return t; | ||||
|     } else { | ||||
|         /* len == 2 */ | ||||
|         t = janetc_gettarget(opts); | ||||
|         janetc_emit_sss(c, op, t, args[0], args[1], 1); | ||||
|     } | ||||
|     return t; | ||||
| } | ||||
|  | ||||
| /* Check if a value can be coerced to an immediate value */ | ||||
| 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; | ||||
|     *out = (int8_t) integer; | ||||
|     return 1; | ||||
| } | ||||
|  | ||||
| /* Check if a slot can be coerced to an immediate value */ | ||||
| static int can_slot_be_imm(JanetSlot s, int8_t *out) { | ||||
|     if (!(s.flags & JANET_SLOT_CONSTANT)) return 0; | ||||
|     return can_be_imm(s.constant, out); | ||||
| } | ||||
|  | ||||
| /* Emit a series of instructions instead of a function call to a math op */ | ||||
| static JanetSlot opreduce( | ||||
|     JanetFopts opts, | ||||
|     JanetSlot *args, | ||||
|     int op, | ||||
|     int opim, | ||||
|     Janet nullary) { | ||||
|     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) { | ||||
|         return janetc_cslot(nullary); | ||||
|     } else if (len == 1) { | ||||
|         t = janetc_gettarget(opts); | ||||
|         /* Special case subtract to be times -1 */ | ||||
|         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(nullary), 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); | ||||
|     } 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); | ||||
|         } else { | ||||
|             janetc_emit_sss(c, op, t, t, args[i], 1); | ||||
|         } | ||||
|     } | ||||
|     janetc_emit_sss(c, op, t, args[0], args[1], 1); | ||||
|     for (i = 2; i < len; i++) | ||||
|         janetc_emit_sss(c, op, t, t, args[i], 1); | ||||
|     return t; | ||||
| } | ||||
|  | ||||
| /* Function optimizers */ | ||||
|  | ||||
| static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil()); | ||||
| } | ||||
| static JanetSlot do_error(JanetFopts opts, JanetSlot *args) { | ||||
|     janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0); | ||||
|     return janetc_cslot(janet_wrap_nil()); | ||||
| } | ||||
| static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) { | ||||
|     (void)args; | ||||
|     int32_t len = janet_v_count(args); | ||||
|     JanetSlot t = janetc_gettarget(opts); | ||||
|     janetc_emit_ssu(opts.compiler, JOP_SIGNAL, t, | ||||
|                     (len == 1) ? args[0] : janetc_cslot(janet_wrap_nil()), | ||||
|                     JANET_SIGNAL_DEBUG, | ||||
|                     1); | ||||
|     return t; | ||||
| } | ||||
| static JanetSlot do_in(JanetFopts opts, JanetSlot *args) { | ||||
|     return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil()); | ||||
|     janetc_emit(opts.compiler, JOP_SIGNAL | (2 << 24)); | ||||
|     return janetc_cslot(janet_wrap_nil()); | ||||
| } | ||||
| static JanetSlot do_get(JanetFopts opts, JanetSlot *args) { | ||||
|     if (janet_v_count(args) == 3) { | ||||
|         JanetCompiler *c = opts.compiler; | ||||
|         JanetSlot t = janetc_gettarget(opts); | ||||
|         int target_is_default = janetc_sequal(t, args[2]); | ||||
|         JanetSlot dflt_slot = args[2]; | ||||
|         if (target_is_default) { | ||||
|             dflt_slot = janetc_farslot(c); | ||||
|             janetc_copy(c, dflt_slot, t); | ||||
|         } | ||||
|         janetc_emit_sss(c, JOP_GET, t, args[0], args[1], 1); | ||||
|         int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT_NIL, t, 0, 0); | ||||
|         janetc_copy(c, t, dflt_slot); | ||||
|         if (target_is_default) janetc_freeslot(c, dflt_slot); | ||||
|         int32_t current = janet_v_count(c->buffer); | ||||
|         c->buffer[label] |= (current - label) << 16; | ||||
|         return t; | ||||
|     } else { | ||||
|         return opreduce(opts, args, JOP_GET, 0, 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_GET, janet_wrap_nil()); | ||||
| } | ||||
| static JanetSlot do_put(JanetFopts opts, JanetSlot *args) { | ||||
|     if (opts.flags & JANET_FOPTS_DROP) { | ||||
| @@ -222,17 +115,10 @@ static JanetSlot do_length(JanetFopts opts, JanetSlot *args) { | ||||
|     return genericSS(opts, JOP_LENGTH, args[0]); | ||||
| } | ||||
| static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) { | ||||
|     if (janet_v_count(args) == 0) { | ||||
|         return genericSSI(opts, JOP_SIGNAL, janetc_cslot(janet_wrap_nil()), 3); | ||||
|     } else { | ||||
|         return genericSSI(opts, JOP_SIGNAL, args[0], 3); | ||||
|     } | ||||
|     return genericSSI(opts, JOP_SIGNAL, args[0], 3); | ||||
| } | ||||
| static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) { | ||||
|     return opfunction(opts, args, JOP_RESUME, janet_wrap_nil()); | ||||
| } | ||||
| static JanetSlot do_cancel(JanetFopts opts, JanetSlot *args) { | ||||
|     return opfunction(opts, args, JOP_CANCEL, janet_wrap_nil()); | ||||
|     return opreduce(opts, args, JOP_RESUME, janet_wrap_nil()); | ||||
| } | ||||
| static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) { | ||||
|     /* Push phase */ | ||||
| @@ -262,34 +148,34 @@ 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, janet_wrap_integer(1)); | ||||
| } | ||||
| static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) { | ||||
|     return genericSS(opts, JOP_BNOT, args[0]); | ||||
| @@ -300,11 +186,9 @@ static JanetSlot compreduce( | ||||
|     JanetFopts opts, | ||||
|     JanetSlot *args, | ||||
|     int op, | ||||
|     int opim, | ||||
|     int invert) { | ||||
|     JanetCompiler *c = opts.compiler; | ||||
|     int32_t i, len; | ||||
|     int8_t imm = 0; | ||||
|     len = janet_v_count(args); | ||||
|     int32_t *labels = NULL; | ||||
|     JanetSlot t; | ||||
| @@ -315,17 +199,19 @@ static JanetSlot compreduce( | ||||
|     } | ||||
|     t = janetc_gettarget(opts); | ||||
|     for (i = 1; i < len; i++) { | ||||
|         if (opim && can_slot_be_imm(args[i], &imm)) { | ||||
|             janetc_emit_ssi(c, opim, t, args[i - 1], imm, 1); | ||||
|         } else { | ||||
|             janetc_emit_sss(c, op, t, args[i - 1], args[i], 1); | ||||
|         } | ||||
|         janetc_emit_sss(c, op, t, args[i - 1], args[i], 1); | ||||
|         if (i != (len - 1)) { | ||||
|             int32_t label = janetc_emit_si(c, invert ? JOP_JUMP_IF : JOP_JUMP_IF_NOT, t, 0, 1); | ||||
|             int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT, t, 0, 1); | ||||
|             janet_v_push(labels, label); | ||||
|         } | ||||
|     } | ||||
|     int32_t end = janet_v_count(c->buffer); | ||||
|     if (invert) { | ||||
|         janetc_emit_si(c, JOP_JUMP_IF, t, 3, 0); | ||||
|         janetc_emit_s(c, JOP_LOAD_TRUE, t, 1); | ||||
|         janetc_emit(c, JOP_JUMP | (2 << 8)); | ||||
|         janetc_emit_s(c, JOP_LOAD_FALSE, t, 1); | ||||
|     } | ||||
|     for (i = 0; i < janet_v_count(labels); i++) { | ||||
|         int32_t label = labels[i]; | ||||
|         c->buffer[label] |= ((end - label) << 16); | ||||
| @@ -334,33 +220,51 @@ static JanetSlot compreduce( | ||||
|     return t; | ||||
| } | ||||
|  | ||||
| static JanetSlot do_order_gt(JanetFopts opts, JanetSlot *args) { | ||||
|     return compreduce(opts, args, JOP_GREATER_THAN, 0); | ||||
| } | ||||
| static JanetSlot do_order_lt(JanetFopts opts, JanetSlot *args) { | ||||
|     return compreduce(opts, args, JOP_LESS_THAN, 0); | ||||
| } | ||||
| static JanetSlot do_order_gte(JanetFopts opts, JanetSlot *args) { | ||||
|     return compreduce(opts, args, JOP_LESS_THAN, 1); | ||||
| } | ||||
| static JanetSlot do_order_lte(JanetFopts opts, JanetSlot *args) { | ||||
|     return compreduce(opts, args, JOP_GREATER_THAN, 1); | ||||
| } | ||||
| static JanetSlot do_order_eq(JanetFopts opts, JanetSlot *args) { | ||||
|     return compreduce(opts, args, JOP_EQUALS, 0); | ||||
| } | ||||
| static JanetSlot do_order_neq(JanetFopts opts, JanetSlot *args) { | ||||
|     return compreduce(opts, args, JOP_EQUALS, 1); | ||||
| } | ||||
| static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) { | ||||
|     return compreduce(opts, args, JOP_GREATER_THAN, JOP_GREATER_THAN_IMMEDIATE, 0); | ||||
|     return compreduce(opts, args, JOP_NUMERIC_GREATER_THAN, 0); | ||||
| } | ||||
| static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) { | ||||
|     return compreduce(opts, args, JOP_LESS_THAN, JOP_LESS_THAN_IMMEDIATE, 0); | ||||
|     return compreduce(opts, args, JOP_NUMERIC_LESS_THAN, 0); | ||||
| } | ||||
| static JanetSlot do_gte(JanetFopts opts, JanetSlot *args) { | ||||
|     return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0, 0); | ||||
|     return compreduce(opts, args, JOP_NUMERIC_GREATER_THAN_EQUAL, 0); | ||||
| } | ||||
| static JanetSlot do_lte(JanetFopts opts, JanetSlot *args) { | ||||
|     return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0, 0); | ||||
|     return compreduce(opts, args, JOP_NUMERIC_LESS_THAN_EQUAL, 0); | ||||
| } | ||||
| static JanetSlot do_eq(JanetFopts opts, JanetSlot *args) { | ||||
|     return compreduce(opts, args, JOP_EQUALS, JOP_EQUALS_IMMEDIATE, 0); | ||||
|     return compreduce(opts, args, JOP_NUMERIC_EQUAL, 0); | ||||
| } | ||||
| static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) { | ||||
|     return compreduce(opts, args, JOP_NOT_EQUALS, JOP_NOT_EQUALS_IMMEDIATE, 1); | ||||
|     return compreduce(opts, args, JOP_NUMERIC_EQUAL, 1); | ||||
| } | ||||
|  | ||||
| /* Arranged by tag */ | ||||
| static const JanetFunOptimizer optimizers[] = { | ||||
|     {maxarity1, do_debug}, | ||||
|     {fixarity0, do_debug}, | ||||
|     {fixarity1, do_error}, | ||||
|     {minarity2, do_apply}, | ||||
|     {maxarity1, do_yield}, | ||||
|     {arity1or2, do_resume}, | ||||
|     {fixarity2, do_in}, | ||||
|     {fixarity1, do_yield}, | ||||
|     {fixarity2, do_resume}, | ||||
|     {fixarity2, do_get}, | ||||
|     {fixarity3, do_put}, | ||||
|     {fixarity1, do_length}, | ||||
|     {NULL, do_add}, | ||||
| @@ -374,19 +278,18 @@ static const JanetFunOptimizer optimizers[] = { | ||||
|     {NULL, do_rshift}, | ||||
|     {NULL, do_rshiftu}, | ||||
|     {fixarity1, do_bnot}, | ||||
|     {NULL, do_order_gt}, | ||||
|     {NULL, do_order_lt}, | ||||
|     {NULL, do_order_gte}, | ||||
|     {NULL, do_order_lte}, | ||||
|     {NULL, do_order_eq}, | ||||
|     {NULL, do_order_neq}, | ||||
|     {NULL, do_gt}, | ||||
|     {NULL, do_lt}, | ||||
|     {NULL, do_gte}, | ||||
|     {NULL, do_lte}, | ||||
|     {NULL, do_eq}, | ||||
|     {NULL, do_neq}, | ||||
|     {fixarity2, do_propagate}, | ||||
|     {arity2or3, do_get}, | ||||
|     {arity1or2, do_next}, | ||||
|     {fixarity2, do_modulo}, | ||||
|     {fixarity2, do_remainder}, | ||||
|     {fixarity2, do_cmp}, | ||||
|     {fixarity2, do_cancel}, | ||||
|     {NULL, do_neq} | ||||
| }; | ||||
|  | ||||
| const JanetFunOptimizer *janetc_funopt(uint32_t flags) { | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,7 +21,6 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "compile.h" | ||||
| #include "emit.h" | ||||
| @@ -53,36 +52,6 @@ void janetc_cerror(JanetCompiler *c, const char *m) { | ||||
|     janetc_error(c, janet_cstring(m)); | ||||
| } | ||||
|  | ||||
| static const char *janet_lint_level_names[] = { | ||||
|     "relaxed", | ||||
|     "normal", | ||||
|     "strict" | ||||
| }; | ||||
|  | ||||
| /* Emit compiler linter messages */ | ||||
| void janetc_lintf(JanetCompiler *c, JanetCompileLintLevel level, const char *format, ...) { | ||||
|     if (NULL != c->lints) { | ||||
|         /* format message */ | ||||
|         va_list args; | ||||
|         JanetBuffer buffer; | ||||
|         int32_t len = 0; | ||||
|         while (format[len]) len++; | ||||
|         janet_buffer_init(&buffer, len); | ||||
|         va_start(args, format); | ||||
|         janet_formatbv(&buffer, format, args); | ||||
|         va_end(args); | ||||
|         const uint8_t *str = janet_string(buffer.data, buffer.count); | ||||
|         janet_buffer_deinit(&buffer); | ||||
|         /* construct linting payload */ | ||||
|         Janet *payload = janet_tuple_begin(4); | ||||
|         payload[0] = janet_ckeywordv(janet_lint_level_names[level]); | ||||
|         payload[1] = c->current_mapping.line == -1 ? janet_wrap_nil() : janet_wrap_integer(c->current_mapping.line); | ||||
|         payload[2] = c->current_mapping.column == -1 ? janet_wrap_nil() : janet_wrap_integer(c->current_mapping.column); | ||||
|         payload[3] = janet_wrap_string(str); | ||||
|         janet_array_push(c->lints, janet_wrap_tuple(janet_tuple_end(payload))); | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Free a slot */ | ||||
| void janetc_freeslot(JanetCompiler *c, JanetSlot s) { | ||||
|     if (s.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF | JANET_SLOT_NAMED)) return; | ||||
| @@ -132,7 +101,6 @@ void janetc_scope(JanetScope *s, JanetCompiler *c, int flags, const char *name) | ||||
|     scope.bytecode_start = janet_v_count(c->buffer); | ||||
|     scope.flags = flags; | ||||
|     scope.parent = c->scope; | ||||
|     janetc_regalloc_init(&scope.ua); | ||||
|     /* Inherit slots */ | ||||
|     if ((!(flags & JANET_SCOPE_FUNCTION)) && c->scope) { | ||||
|         janetc_regalloc_clone(&scope.ra, &(c->scope->ra)); | ||||
| @@ -180,7 +148,6 @@ void janetc_popscope(JanetCompiler *c) { | ||||
|     janet_v_free(oldscope->envs); | ||||
|     janet_v_free(oldscope->defs); | ||||
|     janetc_regalloc_deinit(&oldscope->ra); | ||||
|     janetc_regalloc_deinit(&oldscope->ua); | ||||
|     /* Update pointer */ | ||||
|     if (newscope) | ||||
|         newscope->child = NULL; | ||||
| @@ -229,41 +196,24 @@ JanetSlot janetc_resolve( | ||||
|  | ||||
|     /* Symbol not found - check for global */ | ||||
|     { | ||||
|         JanetBinding binding = janet_resolve_ext(c->env, sym); | ||||
|         switch (binding.type) { | ||||
|         Janet check; | ||||
|         JanetBindingType btype = janet_resolve(c->env, sym, &check); | ||||
|         switch (btype) { | ||||
|             default: | ||||
|             case JANET_BINDING_NONE: | ||||
|                 janetc_error(c, janet_formatc("unknown symbol %q", janet_wrap_symbol(sym))); | ||||
|                 janetc_error(c, janet_formatc("unknown symbol %q", sym)); | ||||
|                 return janetc_cslot(janet_wrap_nil()); | ||||
|             case JANET_BINDING_DEF: | ||||
|             case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */ | ||||
|                 ret = janetc_cslot(binding.value); | ||||
|                 break; | ||||
|                 return janetc_cslot(check); | ||||
|             case JANET_BINDING_VAR: { | ||||
|                 ret = janetc_cslot(binding.value); | ||||
|                 JanetSlot ret = janetc_cslot(check); | ||||
|                 /* TODO save type info */ | ||||
|                 ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY; | ||||
|                 ret.flags &= ~JANET_SLOT_CONSTANT; | ||||
|                 break; | ||||
|                 return ret; | ||||
|             } | ||||
|         } | ||||
|         JanetCompileLintLevel depLevel = JANET_C_LINT_RELAXED; | ||||
|         switch (binding.deprecation) { | ||||
|             case JANET_BINDING_DEP_NONE: | ||||
|                 break; | ||||
|             case JANET_BINDING_DEP_RELAXED: | ||||
|                 depLevel = JANET_C_LINT_RELAXED; | ||||
|                 break; | ||||
|             case JANET_BINDING_DEP_NORMAL: | ||||
|                 depLevel = JANET_C_LINT_NORMAL; | ||||
|                 break; | ||||
|             case JANET_BINDING_DEP_STRICT: | ||||
|                 depLevel = JANET_C_LINT_STRICT; | ||||
|                 break; | ||||
|         } | ||||
|         if (binding.deprecation != JANET_BINDING_DEP_NONE) { | ||||
|             janetc_lintf(c, depLevel, "%q is deprecated", janet_wrap_symbol(sym)); | ||||
|         } | ||||
|         return ret; | ||||
|     } | ||||
|  | ||||
|     /* Symbol was found */ | ||||
| @@ -285,11 +235,6 @@ found: | ||||
|         scope = scope->parent; | ||||
|     janet_assert(scope, "invalid scopes"); | ||||
|     scope->flags |= JANET_SCOPE_ENV; | ||||
|  | ||||
|     /* In the function scope, allocate the slot as an upvalue */ | ||||
|     janetc_regalloc_touch(&scope->ua, ret.index); | ||||
|  | ||||
|     /* Iterate through child scopes and make sure environment is propagated */ | ||||
|     scope = scope->child; | ||||
|  | ||||
|     /* Propagate env up to current scope */ | ||||
| @@ -375,46 +320,33 @@ JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) { | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| /* Push slots loaded via janetc_toslots. Return the minimum number of slots pushed, | ||||
|  * or -1 - min_arity if there is a splice. (if there is no splice, min_arity is also | ||||
|  * the maximum possible arity). */ | ||||
| int32_t janetc_pushslots(JanetCompiler *c, JanetSlot *slots) { | ||||
| /* Push slots load via janetc_toslots. */ | ||||
| void janetc_pushslots(JanetCompiler *c, JanetSlot *slots) { | ||||
|     int32_t i; | ||||
|     int32_t count = janet_v_count(slots); | ||||
|     int32_t min_arity = 0; | ||||
|     int has_splice = 0; | ||||
|     for (i = 0; i < count;) { | ||||
|         if (slots[i].flags & JANET_SLOT_SPLICED) { | ||||
|             janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i], 0); | ||||
|             i++; | ||||
|             has_splice = 1; | ||||
|         } else if (i + 1 == count) { | ||||
|             janetc_emit_s(c, JOP_PUSH, slots[i], 0); | ||||
|             i++; | ||||
|             min_arity++; | ||||
|         } else if (slots[i + 1].flags & JANET_SLOT_SPLICED) { | ||||
|             janetc_emit_s(c, JOP_PUSH, slots[i], 0); | ||||
|             janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 1], 0); | ||||
|             i += 2; | ||||
|             min_arity++; | ||||
|             has_splice = 1; | ||||
|         } else if (i + 2 == count) { | ||||
|             janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0); | ||||
|             i += 2; | ||||
|             min_arity += 2; | ||||
|         } else if (slots[i + 2].flags & JANET_SLOT_SPLICED) { | ||||
|             janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0); | ||||
|             janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 2], 0); | ||||
|             i += 3; | ||||
|             min_arity += 2; | ||||
|             has_splice = 1; | ||||
|         } else { | ||||
|             janetc_emit_sss(c, JOP_PUSH_3, slots[i], slots[i + 1], slots[i + 2], 0); | ||||
|             i += 3; | ||||
|             min_arity += 3; | ||||
|         } | ||||
|     } | ||||
|     return has_splice ? (-1 - min_arity) : min_arity; | ||||
| } | ||||
|  | ||||
| /* Check if a list of slots has any spliced slots */ | ||||
| @@ -446,7 +378,6 @@ void janetc_throwaway(JanetFopts opts, Janet x) { | ||||
|     int32_t mapbufstart = janet_v_count(c->mapbuffer); | ||||
|     janetc_scope(&unusedScope, c, JANET_SCOPE_UNUSED, "unusued"); | ||||
|     janetc_value(opts, x); | ||||
|     janetc_lintf(c, JANET_C_LINT_STRICT, "dead code, consider removing %.2q", x); | ||||
|     janetc_popscope(c); | ||||
|     if (c->buffer) { | ||||
|         janet_v__cnt(c->buffer) = bufstart; | ||||
| @@ -472,68 +403,7 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) { | ||||
|         /* TODO janet function inlining (no c functions)*/ | ||||
|     } | ||||
|     if (!specialized) { | ||||
|         int32_t min_arity = janetc_pushslots(c, slots); | ||||
|         /* Check for provably incorrect function calls */ | ||||
|         if (fun.flags & JANET_SLOT_CONSTANT) { | ||||
|  | ||||
|             /* Check for bad arity type if fun is a constant */ | ||||
|             switch (janet_type(fun.constant)) { | ||||
|                 case JANET_FUNCTION: { | ||||
|                     JanetFunction *f = janet_unwrap_function(fun.constant); | ||||
|                     int32_t min = f->def->min_arity; | ||||
|                     int32_t max = f->def->max_arity; | ||||
|                     if (min_arity < 0) { | ||||
|                         /* Call has splices */ | ||||
|                         min_arity = -1 - min_arity; | ||||
|                         if (min_arity > max && max >= 0) { | ||||
|                             const uint8_t *es = janet_formatc( | ||||
|                                                     "%v expects at most %d argument%s, got at least %d", | ||||
|                                                     fun.constant, max, max == 1 ? "" : "s", min_arity); | ||||
|                             janetc_error(c, es); | ||||
|                         } | ||||
|                     } else { | ||||
|                         /* Call has no splices */ | ||||
|                         if (min_arity > max && max >= 0) { | ||||
|                             const uint8_t *es = janet_formatc( | ||||
|                                                     "%v expects at most %d argument%s, got %d", | ||||
|                                                     fun.constant, max, max == 1 ? "" : "s", min_arity); | ||||
|                             janetc_error(c, es); | ||||
|                         } | ||||
|                         if (min_arity < min) { | ||||
|                             const uint8_t *es = janet_formatc( | ||||
|                                                     "%v expects at least %d argument%s, got %d", | ||||
|                                                     fun.constant, min, min == 1 ? "" : "s", min_arity); | ||||
|                             janetc_error(c, es); | ||||
|                         } | ||||
|                     } | ||||
|                 } | ||||
|                 break; | ||||
|                 case JANET_CFUNCTION: | ||||
|                 case JANET_ABSTRACT: | ||||
|                 case JANET_NIL: | ||||
|                     break; | ||||
|                 case JANET_KEYWORD: | ||||
|                     if (min_arity == 0) { | ||||
|                         const uint8_t *es = janet_formatc("%v expects at least 1 argument, got 0", | ||||
|                                                           fun.constant); | ||||
|                         janetc_error(c, es); | ||||
|                     } | ||||
|                     break; | ||||
|                 default: | ||||
|                     if (min_arity > 1 || min_arity == 0) { | ||||
|                         const uint8_t *es = janet_formatc("%v expects 1 argument, got %d", | ||||
|                                                           fun.constant, min_arity); | ||||
|                         janetc_error(c, es); | ||||
|                     } | ||||
|                     if (min_arity < -2) { | ||||
|                         const uint8_t *es = janet_formatc("%v expects 1 argument, got at least %d", | ||||
|                                                           fun.constant, -1 - min_arity); | ||||
|                         janetc_error(c, es); | ||||
|                     } | ||||
|                     break; | ||||
|             } | ||||
|         } | ||||
|  | ||||
|         janetc_pushslots(c, slots); | ||||
|         if ((opts.flags & JANET_FOPTS_TAIL) && | ||||
|                 /* Prevent top level tail calls for better errors */ | ||||
|                 !(c->scope->flags & JANET_SCOPE_TOP)) { | ||||
| @@ -552,40 +422,10 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) { | ||||
| static JanetSlot janetc_maker(JanetFopts opts, JanetSlot *slots, int op) { | ||||
|     JanetCompiler *c = opts.compiler; | ||||
|     JanetSlot retslot; | ||||
|  | ||||
|     /* Check if this structure is composed entirely of constants */ | ||||
|     int can_inline = 1; | ||||
|     for (int32_t i = 0; i < janet_v_count(slots); i++) { | ||||
|         if (!(slots[i].flags & JANET_SLOT_CONSTANT) || | ||||
|                 (slots[i].flags & JANET_SLOT_SPLICED)) { | ||||
|             can_inline = 0; | ||||
|             break; | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     if (can_inline && (op == JOP_MAKE_STRUCT)) { | ||||
|         JanetKV *st = janet_struct_begin(janet_v_count(slots) / 2); | ||||
|         for (int32_t i = 0; i < janet_v_count(slots); i += 2) { | ||||
|             Janet k = slots[i].constant; | ||||
|             Janet v = slots[i + 1].constant; | ||||
|             janet_struct_put(st, k, v); | ||||
|         } | ||||
|         retslot = janetc_cslot(janet_wrap_struct(janet_struct_end(st))); | ||||
|         janetc_freeslots(c, slots); | ||||
|     } else if (can_inline && (op == JOP_MAKE_TUPLE)) { | ||||
|         Janet *tup = janet_tuple_begin(janet_v_count(slots)); | ||||
|         for (int32_t i = 0; i < janet_v_count(slots); i++) { | ||||
|             tup[i] = slots[i].constant; | ||||
|         } | ||||
|         retslot = janetc_cslot(janet_wrap_tuple(janet_tuple_end(tup))); | ||||
|         janetc_freeslots(c, slots); | ||||
|     } else { | ||||
|         janetc_pushslots(c, slots); | ||||
|         janetc_freeslots(c, slots); | ||||
|         retslot = janetc_gettarget(opts); | ||||
|         janetc_emit_s(c, op, retslot, 1); | ||||
|     } | ||||
|  | ||||
|     janetc_pushslots(c, slots); | ||||
|     janetc_freeslots(c, slots); | ||||
|     retslot = janetc_gettarget(opts); | ||||
|     janetc_emit_s(c, op, retslot, 1); | ||||
|     return retslot; | ||||
| } | ||||
|  | ||||
| @@ -634,9 +474,9 @@ static int macroexpand1( | ||||
|     if (janet_tuple_length(form) == 0) | ||||
|         return 0; | ||||
|     /* Source map - only set when we get a tuple */ | ||||
|     if (janet_tuple_sm_line(form) >= 0) { | ||||
|         c->current_mapping.line = janet_tuple_sm_line(form); | ||||
|         c->current_mapping.column = janet_tuple_sm_column(form); | ||||
|     if (janet_tuple_sm_start(form) >= 0) { | ||||
|         c->current_mapping.start = janet_tuple_sm_start(form); | ||||
|         c->current_mapping.end = janet_tuple_sm_end(form); | ||||
|     } | ||||
|     /* Bracketed tuples are not specials or macros! */ | ||||
|     if (janet_tuple_flag(form) & JANET_TUPLE_FLAG_BRACKETCTOR) | ||||
| @@ -656,40 +496,22 @@ static int macroexpand1( | ||||
|         return 0; | ||||
|  | ||||
|     /* Evaluate macro */ | ||||
|     JanetFiber *fiberp = NULL; | ||||
|     JanetFunction *macro = janet_unwrap_function(macroval); | ||||
|     int32_t arity = janet_tuple_length(form) - 1; | ||||
|     JanetFiber *fiberp = janet_fiber(macro, 64, arity, form + 1); | ||||
|     if (NULL == fiberp) { | ||||
|         int32_t minar = macro->def->min_arity; | ||||
|         int32_t maxar = macro->def->max_arity; | ||||
|         const uint8_t *es = NULL; | ||||
|         if (minar >= 0 && arity < minar) | ||||
|             es = janet_formatc("macro arity mismatch, expected at least %d, got %d", minar, arity); | ||||
|         if (maxar >= 0 && arity > maxar) | ||||
|             es = janet_formatc("macro arity mismatch, expected at most %d, got %d", maxar, arity); | ||||
|         c->result.macrofiber = NULL; | ||||
|         janetc_error(c, es); | ||||
|         return 0; | ||||
|     } | ||||
|     /* Set env */ | ||||
|     fiberp->env = c->env; | ||||
|     int lock = janet_gclock(); | ||||
|     Janet mf_kw = janet_ckeywordv("macro-form"); | ||||
|     janet_table_put(c->env, mf_kw, x); | ||||
|     Janet tempOut; | ||||
|     JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut); | ||||
|     janet_table_put(c->env, mf_kw, janet_wrap_nil()); | ||||
|     if (c->lints) { | ||||
|         janet_table_put(c->env, janet_ckeywordv("macro-lints"), janet_wrap_array(c->lints)); | ||||
|     } | ||||
|     JanetSignal status = janet_pcall( | ||||
|                              macro, | ||||
|                              janet_tuple_length(form) - 1, | ||||
|                              form + 1, | ||||
|                              &x, | ||||
|                              &fiberp); | ||||
|     janet_gcunlock(lock); | ||||
|     if (status != JANET_SIGNAL_OK) { | ||||
|         const uint8_t *es = janet_formatc("(macro) %V", tempOut); | ||||
|         const uint8_t *es = janet_formatc("(macro) %V", x); | ||||
|         c->result.macrofiber = fiberp; | ||||
|         janetc_error(c, es); | ||||
|         return 0; | ||||
|     } else { | ||||
|         *out = tempOut; | ||||
|         *out = x; | ||||
|     } | ||||
|  | ||||
|     return 1; | ||||
| @@ -733,7 +555,7 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) { | ||||
|                 const Janet *tup = janet_unwrap_tuple(x); | ||||
|                 /* Empty tuple is tuple literal */ | ||||
|                 if (janet_tuple_length(tup) == 0) { | ||||
|                     ret = janetc_cslot(janet_wrap_tuple(janet_tuple_n(NULL, 0))); | ||||
|                     ret = janetc_cslot(x); | ||||
|                 } else if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) { /* [] tuples are not function call */ | ||||
|                     ret = janetc_tuple(opts, x); | ||||
|                 } else { | ||||
| @@ -779,32 +601,7 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) { | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| /* Add function flags to janet functions */ | ||||
| void janet_def_addflags(JanetFuncDef *def) { | ||||
|     int32_t set_flags = 0; | ||||
|     int32_t unset_flags = 0; | ||||
|     /* pos checks */ | ||||
|     if (def->name)            set_flags |= JANET_FUNCDEF_FLAG_HASNAME; | ||||
|     if (def->source)          set_flags |= JANET_FUNCDEF_FLAG_HASSOURCE; | ||||
|     if (def->defs)            set_flags |= JANET_FUNCDEF_FLAG_HASDEFS; | ||||
|     if (def->environments)    set_flags |= JANET_FUNCDEF_FLAG_HASENVS; | ||||
|     if (def->sourcemap)       set_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP; | ||||
|     if (def->closure_bitset)  set_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET; | ||||
|     /* negative checks */ | ||||
|     if (!def->name)           unset_flags |= JANET_FUNCDEF_FLAG_HASNAME; | ||||
|     if (!def->source)         unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCE; | ||||
|     if (!def->defs)           unset_flags |= JANET_FUNCDEF_FLAG_HASDEFS; | ||||
|     if (!def->environments)   unset_flags |= JANET_FUNCDEF_FLAG_HASENVS; | ||||
|     if (!def->sourcemap)      unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP; | ||||
|     if (!def->closure_bitset) unset_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET; | ||||
|     /* Update flags */ | ||||
|     def->flags |= set_flags; | ||||
|     def->flags &= ~unset_flags; | ||||
| } | ||||
|  | ||||
| /* Compile a funcdef */ | ||||
| /* Once the various other settings of the FuncDef have been tweaked, | ||||
|  * call janet_def_addflags to set the proper flags for the funcdef */ | ||||
| JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) { | ||||
|     JanetScope *scope = c->scope; | ||||
|     JanetFuncDef *def = janet_funcdef_alloc(); | ||||
| @@ -825,20 +622,20 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) { | ||||
|     /* Copy bytecode (only last chunk) */ | ||||
|     def->bytecode_length = janet_v_count(c->buffer) - scope->bytecode_start; | ||||
|     if (def->bytecode_length) { | ||||
|         size_t s = sizeof(int32_t) * (size_t) def->bytecode_length; | ||||
|         def->bytecode = janet_malloc(s); | ||||
|         size_t s = sizeof(int32_t) * def->bytecode_length; | ||||
|         def->bytecode = malloc(s); | ||||
|         if (NULL == def->bytecode) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|         safe_memcpy(def->bytecode, c->buffer + scope->bytecode_start, s); | ||||
|         memcpy(def->bytecode, c->buffer + scope->bytecode_start, s); | ||||
|         janet_v__cnt(c->buffer) = scope->bytecode_start; | ||||
|         if (NULL != c->mapbuffer && c->source) { | ||||
|             size_t s = sizeof(JanetSourceMapping) * (size_t) def->bytecode_length; | ||||
|             def->sourcemap = janet_malloc(s); | ||||
|         if (NULL != c->mapbuffer) { | ||||
|             size_t s = sizeof(JanetSourceMapping) * def->bytecode_length; | ||||
|             def->sourcemap = malloc(s); | ||||
|             if (NULL == def->sourcemap) { | ||||
|                 JANET_OUT_OF_MEMORY; | ||||
|             } | ||||
|             safe_memcpy(def->sourcemap, c->mapbuffer + scope->bytecode_start, s); | ||||
|             memcpy(def->sourcemap, c->mapbuffer + scope->bytecode_start, s); | ||||
|             janet_v__cnt(c->mapbuffer) = scope->bytecode_start; | ||||
|         } | ||||
|     } | ||||
| @@ -853,22 +650,6 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) { | ||||
|         def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV; | ||||
|     } | ||||
|  | ||||
|     /* Copy upvalue bitset */ | ||||
|     if (scope->ua.count) { | ||||
|         /* Number of u32s we need to create a bitmask for all slots */ | ||||
|         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); | ||||
|         if (NULL == chunks) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|         memcpy(chunks, scope->ua.chunks, sizeof(uint32_t) * numchunks); | ||||
|         /* Register allocator preallocates some registers [240-255, high 16 bits of chunk index 7], we can ignore those. */ | ||||
|         if (scope->ua.count > 7) chunks[7] &= 0xFFFFU; | ||||
|         def->closure_bitset = chunks; | ||||
|     } | ||||
|  | ||||
|     /* Pop the scope */ | ||||
|     janetc_popscope(c); | ||||
|  | ||||
| @@ -876,23 +657,22 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) { | ||||
| } | ||||
|  | ||||
| /* Initialize a compiler */ | ||||
| static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where, JanetArray *lints) { | ||||
| static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where) { | ||||
|     c->scope = NULL; | ||||
|     c->buffer = NULL; | ||||
|     c->mapbuffer = NULL; | ||||
|     c->recursion_guard = JANET_RECURSION_GUARD; | ||||
|     c->env = env; | ||||
|     c->source = where; | ||||
|     c->current_mapping.line = -1; | ||||
|     c->current_mapping.column = -1; | ||||
|     c->lints = lints; | ||||
|     c->current_mapping.start = -1; | ||||
|     c->current_mapping.end = -1; | ||||
|     /* Init result */ | ||||
|     c->result.error = NULL; | ||||
|     c->result.status = JANET_COMPILE_OK; | ||||
|     c->result.funcdef = NULL; | ||||
|     c->result.macrofiber = NULL; | ||||
|     c->result.error_mapping.line = -1; | ||||
|     c->result.error_mapping.column = -1; | ||||
|     c->result.error_mapping.start = -1; | ||||
|     c->result.error_mapping.end = -1; | ||||
| } | ||||
|  | ||||
| /* Deinitialize a compiler struct */ | ||||
| @@ -903,13 +683,12 @@ static void janetc_deinit(JanetCompiler *c) { | ||||
| } | ||||
|  | ||||
| /* Compile a form. */ | ||||
| JanetCompileResult janet_compile_lint(Janet source, | ||||
|                                       JanetTable *env, const uint8_t *where, JanetArray *lints) { | ||||
| JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) { | ||||
|     JanetCompiler c; | ||||
|     JanetScope rootscope; | ||||
|     JanetFopts fopts; | ||||
|  | ||||
|     janetc_init(&c, env, where, lints); | ||||
|     janetc_init(&c, env, where); | ||||
|  | ||||
|     /* Push a function scope */ | ||||
|     janetc_scope(&rootscope, &c, JANET_SCOPE_FUNCTION | JANET_SCOPE_TOP, "root"); | ||||
| @@ -925,7 +704,6 @@ JanetCompileResult janet_compile_lint(Janet source, | ||||
|     if (c.result.status == JANET_COMPILE_OK) { | ||||
|         JanetFuncDef *def = janetc_pop_funcdef(&c); | ||||
|         def->name = janet_cstring("_thunk"); | ||||
|         janet_def_addflags(def); | ||||
|         c.result.funcdef = def; | ||||
|     } else { | ||||
|         c.result.error_mapping = c.current_mapping; | ||||
| @@ -937,35 +715,26 @@ JanetCompileResult janet_compile_lint(Janet source, | ||||
|     return c.result; | ||||
| } | ||||
|  | ||||
| JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) { | ||||
|     return janet_compile_lint(source, env, where, NULL); | ||||
| } | ||||
|  | ||||
| /* C Function for compiling */ | ||||
| static Janet cfun(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 4); | ||||
|     janet_arity(argc, 1, 3); | ||||
|     JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm_fiber->env; | ||||
|     if (NULL == env) { | ||||
|         env = janet_table(0); | ||||
|         janet_vm_fiber->env = env; | ||||
|     } | ||||
|     const uint8_t *source = NULL; | ||||
|     if (argc >= 3) { | ||||
|     if (argc == 3) { | ||||
|         source = janet_getstring(argv, 2); | ||||
|     } | ||||
|     JanetArray *lints = (argc >= 4) ? janet_getarray(argv, 3) : NULL; | ||||
|     JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints); | ||||
|     JanetCompileResult res = janet_compile(argv[0], env, source); | ||||
|     if (res.status == JANET_COMPILE_OK) { | ||||
|         return janet_wrap_function(janet_thunk(res.funcdef)); | ||||
|     } else { | ||||
|         JanetTable *t = janet_table(4); | ||||
|         janet_table_put(t, janet_ckeywordv("error"), janet_wrap_string(res.error)); | ||||
|         if (res.error_mapping.line > 0) { | ||||
|             janet_table_put(t, janet_ckeywordv("line"), janet_wrap_integer(res.error_mapping.line)); | ||||
|         } | ||||
|         if (res.error_mapping.column > 0) { | ||||
|             janet_table_put(t, janet_ckeywordv("column"), janet_wrap_integer(res.error_mapping.column)); | ||||
|         } | ||||
|         janet_table_put(t, janet_ckeywordv("start"), janet_wrap_integer(res.error_mapping.start)); | ||||
|         janet_table_put(t, janet_ckeywordv("end"), janet_wrap_integer(res.error_mapping.end)); | ||||
|         if (res.macrofiber) { | ||||
|             janet_table_put(t, janet_ckeywordv("fiber"), janet_wrap_fiber(res.macrofiber)); | ||||
|         } | ||||
| @@ -976,13 +745,11 @@ static Janet cfun(int32_t argc, Janet *argv) { | ||||
| static const JanetReg compile_cfuns[] = { | ||||
|     { | ||||
|         "compile", cfun, | ||||
|         JDOC("(compile ast &opt env source lints)\n\n" | ||||
|              "Compiles an Abstract Syntax Tree (ast) into a function. " | ||||
|         JDOC("(compile ast &opt env source)\n\n" | ||||
|              "Compiles an Abstract Syntax Tree (ast) into a janet function. " | ||||
|              "Pair the compile function with parsing functionality to implement " | ||||
|              "eval. Returns a new function and does not modify ast. Returns an error " | ||||
|              "struct with keys :line, :column, and :error if compilation fails. " | ||||
|              "If a `lints` array is given, linting messages will be appended to the array. " | ||||
|              "Each message will be a tuple of the form `(level line col message)`.") | ||||
|              "eval. Returns a janet function and does not modify ast. Throws an " | ||||
|              "error if the ast cannot be compiled.") | ||||
|     }, | ||||
|     {NULL, NULL, NULL} | ||||
| }; | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -24,25 +24,17 @@ | ||||
| #define JANET_COMPILE_H | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "regalloc.h" | ||||
| #endif | ||||
|  | ||||
| /* Levels for compiler warnings */ | ||||
| typedef enum { | ||||
|     JANET_C_LINT_RELAXED, | ||||
|     JANET_C_LINT_NORMAL, | ||||
|     JANET_C_LINT_STRICT | ||||
| } JanetCompileLintLevel; | ||||
|  | ||||
| /* Tags for some functions for the prepared inliner */ | ||||
| #define JANET_FUN_DEBUG 1 | ||||
| #define JANET_FUN_ERROR 2 | ||||
| #define JANET_FUN_APPLY 3 | ||||
| #define JANET_FUN_YIELD 4 | ||||
| #define JANET_FUN_RESUME 5 | ||||
| #define JANET_FUN_IN 6 | ||||
| #define JANET_FUN_GET 6 | ||||
| #define JANET_FUN_PUT 7 | ||||
| #define JANET_FUN_LENGTH 8 | ||||
| #define JANET_FUN_ADD 9 | ||||
| @@ -56,19 +48,18 @@ typedef enum { | ||||
| #define JANET_FUN_RSHIFT 17 | ||||
| #define JANET_FUN_RSHIFTU 18 | ||||
| #define JANET_FUN_BNOT 19 | ||||
| #define JANET_FUN_GT 20 | ||||
| #define JANET_FUN_LT 21 | ||||
| #define JANET_FUN_GTE 22 | ||||
| #define JANET_FUN_LTE 23 | ||||
| #define JANET_FUN_EQ 24 | ||||
| #define JANET_FUN_NEQ 25 | ||||
| #define JANET_FUN_PROP 26 | ||||
| #define JANET_FUN_GET 27 | ||||
| #define JANET_FUN_NEXT 28 | ||||
| #define JANET_FUN_MODULO 29 | ||||
| #define JANET_FUN_REMAINDER 30 | ||||
| #define JANET_FUN_CMP 31 | ||||
| #define JANET_FUN_CANCEL 32 | ||||
| #define JANET_FUN_ORDER_GT 20 | ||||
| #define JANET_FUN_ORDER_LT 21 | ||||
| #define JANET_FUN_ORDER_GTE 22 | ||||
| #define JANET_FUN_ORDER_LTE 23 | ||||
| #define JANET_FUN_ORDER_EQ 24 | ||||
| #define JANET_FUN_ORDER_NEQ 25 | ||||
| #define JANET_FUN_GT 26 | ||||
| #define JANET_FUN_LT 27 | ||||
| #define JANET_FUN_GTE 28 | ||||
| #define JANET_FUN_LTE 29 | ||||
| #define JANET_FUN_EQ 30 | ||||
| #define JANET_FUN_NEQ 31 | ||||
|  | ||||
| /* Compiler typedefs */ | ||||
| typedef struct JanetCompiler JanetCompiler; | ||||
| @@ -85,10 +76,10 @@ typedef struct JanetSpecial JanetSpecial; | ||||
| #define JANET_SLOT_MUTABLE 0x40000 | ||||
| #define JANET_SLOT_REF 0x80000 | ||||
| #define JANET_SLOT_RETURNED 0x100000 | ||||
| #define JANET_SLOT_DEP_NOTE 0x200000 | ||||
| #define JANET_SLOT_DEP_WARN 0x400000 | ||||
| #define JANET_SLOT_DEP_ERROR 0x800000 | ||||
| #define JANET_SLOT_SPLICED 0x1000000 | ||||
| /* Needed for handling single element arrays as global vars. */ | ||||
|  | ||||
| /* Used for unquote-splicing */ | ||||
| #define JANET_SLOT_SPLICED 0x200000 | ||||
|  | ||||
| #define JANET_SLOTTYPE_ANY 0xFFFF | ||||
|  | ||||
| @@ -136,10 +127,7 @@ struct JanetScope { | ||||
|     /* Regsiter allocator */ | ||||
|     JanetcRegisterAllocator ra; | ||||
|  | ||||
|     /* Upvalue allocator */ | ||||
|     JanetcRegisterAllocator ua; | ||||
|  | ||||
|     /* Referenced closure environments. The values at each index correspond | ||||
|     /* Referenced closure environents. The values at each index correspond | ||||
|      * to which index to get the environment from in the parent. The environment | ||||
|      * that corresponds to the direct parent's stack will always have value 0. */ | ||||
|     int32_t *envs; | ||||
| @@ -171,9 +159,6 @@ struct JanetCompiler { | ||||
|  | ||||
|     /* Prevent unbounded recursion */ | ||||
|     int recursion_guard; | ||||
|  | ||||
|     /* Collect linting results */ | ||||
|     JanetArray *lints; | ||||
| }; | ||||
|  | ||||
| #define JANET_FOPTS_TAIL 0x10000 | ||||
| @@ -228,7 +213,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len); | ||||
| JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds); | ||||
|  | ||||
| /* Push slots load via janetc_toslots. */ | ||||
| int32_t janetc_pushslots(JanetCompiler *c, JanetSlot *slots); | ||||
| void janetc_pushslots(JanetCompiler *c, JanetSlot *slots); | ||||
|  | ||||
| /* Free slots loaded via janetc_toslots */ | ||||
| void janetc_freeslots(JanetCompiler *c, JanetSlot *slots); | ||||
| @@ -240,9 +225,6 @@ JanetSlot janetc_return(JanetCompiler *c, JanetSlot s); | ||||
| void janetc_error(JanetCompiler *c, const uint8_t *m); | ||||
| void janetc_cerror(JanetCompiler *c, const char *m); | ||||
|  | ||||
| /* Linting */ | ||||
| void janetc_lintf(JanetCompiler *C, JanetCompileLintLevel level, const char *format, ...); | ||||
|  | ||||
| /* Dispatch to correct form compiler */ | ||||
| JanetSlot janetc_value(JanetFopts opts, Janet x); | ||||
|  | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,9 +21,7 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include <math.h> | ||||
| #include "compile.h" | ||||
| #include "state.h" | ||||
| #include "util.h" | ||||
| @@ -47,14 +45,7 @@ typedef int Clib; | ||||
| typedef HINSTANCE Clib; | ||||
| #define load_clib(name) LoadLibrary((name)) | ||||
| #define symbol_clib(lib, sym) GetProcAddress((lib), (sym)) | ||||
| static char error_clib_buf[256]; | ||||
| static char *error_clib(void) { | ||||
|     FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, | ||||
|                    NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), | ||||
|                    error_clib_buf, sizeof(error_clib_buf), NULL); | ||||
|     error_clib_buf[strlen(error_clib_buf) - 1] = '\0'; | ||||
|     return error_clib_buf; | ||||
| } | ||||
| #define error_clib() "could not load dynamic library" | ||||
| #else | ||||
| #include <dlfcn.h> | ||||
| typedef void *Clib; | ||||
| @@ -63,209 +54,21 @@ typedef void *Clib; | ||||
| #define error_clib() dlerror() | ||||
| #endif | ||||
|  | ||||
| static char *get_processed_name(const char *name) { | ||||
|     if (name[0] == '.') return (char *) name; | ||||
|     const char *c; | ||||
|     for (c = name; *c; c++) { | ||||
|         if (*c == '/') return (char *) name; | ||||
|     } | ||||
|     size_t l = (size_t)(c - name); | ||||
|     char *ret = janet_malloc(l + 3); | ||||
|     if (NULL == ret) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
|     ret[0] = '.'; | ||||
|     ret[1] = '/'; | ||||
|     memcpy(ret + 2, name, l + 1); | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| JanetModule janet_native(const char *name, const uint8_t **error) { | ||||
|     char *processed_name = get_processed_name(name); | ||||
|     Clib lib = load_clib(processed_name); | ||||
|     Clib lib = load_clib(name); | ||||
|     JanetModule init; | ||||
|     JanetModconf getter; | ||||
|     if (name != processed_name) janet_free(processed_name); | ||||
|     if (!lib) { | ||||
|         *error = janet_cstring(error_clib()); | ||||
|         return NULL; | ||||
|     } | ||||
|     init = (JanetModule) symbol_clib(lib, "_janet_init"); | ||||
|     if (!init) { | ||||
|         *error = janet_cstring("could not find the _janet_init symbol"); | ||||
|         return NULL; | ||||
|     } | ||||
|     getter = (JanetModconf) symbol_clib(lib, "_janet_mod_config"); | ||||
|     if (!getter) { | ||||
|         *error = janet_cstring("could not find the _janet_mod_config symbol"); | ||||
|         return NULL; | ||||
|     } | ||||
|     JanetBuildConfig modconf = getter(); | ||||
|     JanetBuildConfig host = janet_config_current(); | ||||
|     if (host.major != modconf.major || | ||||
|             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); | ||||
|         *error = janet_cstring(errbuf); | ||||
|         *error = janet_cstring("could not find _janet_init symbol"); | ||||
|         return NULL; | ||||
|     } | ||||
|     return init; | ||||
| } | ||||
|  | ||||
| static const char *janet_dyncstring(const char *name, const char *dflt) { | ||||
|     Janet x = janet_dyn(name); | ||||
|     if (janet_checktype(x, JANET_NIL)) return dflt; | ||||
|     if (!janet_checktype(x, JANET_STRING)) { | ||||
|         janet_panicf("expected string, got %v", x); | ||||
|     } | ||||
|     const uint8_t *jstr = janet_unwrap_string(x); | ||||
|     const char *cstr = (const char *)jstr; | ||||
|     if (strlen(cstr) != (size_t) janet_string_length(jstr)) { | ||||
|         janet_panicf("string %v contains embedded 0s"); | ||||
|     } | ||||
|     return cstr; | ||||
| } | ||||
|  | ||||
| static int is_path_sep(char c) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     if (c == '\\') return 1; | ||||
| #endif | ||||
|     return c == '/'; | ||||
| } | ||||
|  | ||||
| /* Used for module system. */ | ||||
| static Janet janet_core_expand_path(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 2); | ||||
|     const char *input = janet_getcstring(argv, 0); | ||||
|     const char *template = janet_getcstring(argv, 1); | ||||
|     const char *curfile = janet_dyncstring("current-file", ""); | ||||
|     const char *syspath = janet_dyncstring("syspath", ""); | ||||
|     JanetBuffer *out = janet_buffer(0); | ||||
|     size_t tlen = strlen(template); | ||||
|  | ||||
|     /* Calculate name */ | ||||
|     const char *name = input + strlen(input); | ||||
|     while (name > input) { | ||||
|         if (is_path_sep(*(name - 1))) break; | ||||
|         name--; | ||||
|     } | ||||
|  | ||||
|     /* Calculate dirpath from current file */ | ||||
|     const char *curname = curfile + strlen(curfile); | ||||
|     while (curname > curfile) { | ||||
|         if (is_path_sep(*curname)) break; | ||||
|         curname--; | ||||
|     } | ||||
|     const char *curdir; | ||||
|     int32_t curlen; | ||||
|     if (curname == curfile) { | ||||
|         /* Current file has one or zero path segments, so | ||||
|          * we are in the . directory. */ | ||||
|         curdir = "."; | ||||
|         curlen = 1; | ||||
|     } else { | ||||
|         /* Current file has 2 or more segments, so we | ||||
|          * can cut off the last segment. */ | ||||
|         curdir = curfile; | ||||
|         curlen = (int32_t)(curname - curfile); | ||||
|     } | ||||
|  | ||||
|     for (size_t i = 0; i < tlen; i++) { | ||||
|         if (template[i] == ':') { | ||||
|             if (strncmp(template + i, ":all:", 5) == 0) { | ||||
|                 janet_buffer_push_cstring(out, input); | ||||
|                 i += 4; | ||||
|             } else if (strncmp(template + i, ":cur:", 5) == 0) { | ||||
|                 janet_buffer_push_bytes(out, (const uint8_t *)curdir, curlen); | ||||
|                 i += 4; | ||||
|             } else if (strncmp(template + i, ":dir:", 5) == 0) { | ||||
|                 janet_buffer_push_bytes(out, (const uint8_t *)input, | ||||
|                                         (int32_t)(name - input)); | ||||
|                 i += 4; | ||||
|             } else if (strncmp(template + i, ":sys:", 5) == 0) { | ||||
|                 janet_buffer_push_cstring(out, syspath); | ||||
|                 i += 4; | ||||
|             } else if (strncmp(template + i, ":name:", 6) == 0) { | ||||
|                 janet_buffer_push_cstring(out, name); | ||||
|                 i += 5; | ||||
|             } else if (strncmp(template + i, ":native:", 8) == 0) { | ||||
| #ifdef JANET_WINDOWS | ||||
|                 janet_buffer_push_cstring(out, ".dll"); | ||||
| #else | ||||
|                 janet_buffer_push_cstring(out, ".so"); | ||||
| #endif | ||||
|                 i += 7; | ||||
|             } else { | ||||
|                 janet_buffer_push_u8(out, (uint8_t) template[i]); | ||||
|             } | ||||
|         } else { | ||||
|             janet_buffer_push_u8(out, (uint8_t) template[i]); | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     /* Normalize */ | ||||
|     uint8_t *scan = out->data; | ||||
|     uint8_t *print = scan; | ||||
|     uint8_t *scanend = scan + out->count; | ||||
|     int normal_section_count = 0; | ||||
|     int dot_count = 0; | ||||
|     while (scan < scanend) { | ||||
|         if (*scan == '.') { | ||||
|             if (dot_count >= 0) { | ||||
|                 dot_count++; | ||||
|             } else { | ||||
|                 *print++ = '.'; | ||||
|             } | ||||
|         } else if (is_path_sep(*scan)) { | ||||
|             if (dot_count == 1) { | ||||
|                 ; | ||||
|             } else if (dot_count == 2) { | ||||
|                 if (normal_section_count > 0) { | ||||
|                     /* unprint last separator */ | ||||
|                     print--; | ||||
|                     /* unprint last section */ | ||||
|                     while (print > out->data && !is_path_sep(*(print - 1))) | ||||
|                         print--; | ||||
|                     normal_section_count--; | ||||
|                 } else { | ||||
|                     *print++ = '.'; | ||||
|                     *print++ = '.'; | ||||
|                     *print++ = '/'; | ||||
|                 } | ||||
|             } else if (scan == out->data || dot_count != 0) { | ||||
|                 while (dot_count > 0) { | ||||
|                     --dot_count; | ||||
|                     *print++ = '.'; | ||||
|                 } | ||||
|                 if (scan > out->data) { | ||||
|                     normal_section_count++; | ||||
|                 } | ||||
|                 *print++ = '/'; | ||||
|             } | ||||
|             dot_count = 0; | ||||
|         } else { | ||||
|             while (dot_count > 0) { | ||||
|                 --dot_count; | ||||
|                 *print++ = '.'; | ||||
|             } | ||||
|             dot_count = -1; | ||||
|             *print++ = *scan; | ||||
|         } | ||||
|         scan++; | ||||
|     } | ||||
|     out->count = (int32_t)(print - out->data); | ||||
|     return janet_wrap_buffer(out); | ||||
| } | ||||
|  | ||||
| static Janet janet_core_dyn(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     Janet value; | ||||
| @@ -305,7 +108,6 @@ static Janet janet_core_native(int32_t argc, Janet *argv) { | ||||
|         janet_panicf("could not load native %S: %S", path, error); | ||||
|     } | ||||
|     init(env); | ||||
|     janet_table_put(env, janet_ckeywordv("native"), argv[0]); | ||||
|     return janet_wrap_table(env); | ||||
| } | ||||
|  | ||||
| @@ -365,25 +167,10 @@ static Janet janet_core_tuple(int32_t argc, Janet *argv) { | ||||
| static Janet janet_core_array(int32_t argc, Janet *argv) { | ||||
|     JanetArray *array = janet_array(argc); | ||||
|     array->count = argc; | ||||
|     safe_memcpy(array->data, argv, argc * sizeof(Janet)); | ||||
|     memcpy(array->data, argv, argc * sizeof(Janet)); | ||||
|     return janet_wrap_array(array); | ||||
| } | ||||
|  | ||||
| static Janet janet_core_slice(int32_t argc, Janet *argv) { | ||||
|     JanetRange range; | ||||
|     JanetByteView bview; | ||||
|     JanetView iview; | ||||
|     if (janet_bytes_view(argv[0], &bview.bytes, &bview.len)) { | ||||
|         range = janet_getslice(argc, argv); | ||||
|         return janet_stringv(bview.bytes + range.start, range.end - range.start); | ||||
|     } else if (janet_indexed_view(argv[0], &iview.items, &iview.len)) { | ||||
|         range = janet_getslice(argc, argv); | ||||
|         return janet_wrap_tuple(janet_tuple_n(iview.items + range.start, range.end - range.start)); | ||||
|     } else { | ||||
|         janet_panic_type(argv[0], 0, JANET_TFLAG_BYTES | JANET_TFLAG_INDEXED); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static Janet janet_core_table(int32_t argc, Janet *argv) { | ||||
|     int32_t i; | ||||
|     if (argc & 1) | ||||
| @@ -421,21 +208,17 @@ static Janet janet_core_gccollect(int32_t argc, Janet *argv) { | ||||
|  | ||||
| static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     size_t s = janet_getsize(argv, 0); | ||||
|     /* limit interval to 48 bits */ | ||||
| #ifdef JANET_64 | ||||
|     if (s >> 48) { | ||||
|         janet_panic("interval too large"); | ||||
|     } | ||||
| #endif | ||||
|     janet_vm_gc_interval = s; | ||||
|     int32_t val = janet_getinteger(argv, 0); | ||||
|     if (val < 0) | ||||
|         janet_panic("expected non-negative integer"); | ||||
|     janet_vm_gc_interval = val; | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| static Janet janet_core_gcinterval(int32_t argc, Janet *argv) { | ||||
|     (void) argv; | ||||
|     janet_fixarity(argc, 0); | ||||
|     return janet_wrap_number((double) janet_vm_gc_interval); | ||||
|     return janet_wrap_number(janet_vm_gc_interval); | ||||
| } | ||||
|  | ||||
| static Janet janet_core_type(int32_t argc, Janet *argv) { | ||||
| @@ -448,27 +231,39 @@ static Janet janet_core_type(int32_t argc, Janet *argv) { | ||||
|     } | ||||
| } | ||||
|  | ||||
| static Janet janet_core_next(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 2); | ||||
|     JanetDictView view = janet_getdictionary(argv, 0); | ||||
|     const JanetKV *end = view.kvs + view.cap; | ||||
|     const JanetKV *kv = janet_checktype(argv[1], JANET_NIL) | ||||
|                         ? view.kvs | ||||
|                         : janet_dict_find(view.kvs, view.cap, argv[1]) + 1; | ||||
|     while (kv < end) { | ||||
|         if (!janet_checktype(kv->key, JANET_NIL)) return kv->key; | ||||
|         kv++; | ||||
|     } | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| static Janet janet_core_hash(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     return janet_wrap_number(janet_hash(argv[0])); | ||||
| } | ||||
|  | ||||
| static Janet janet_core_getline(int32_t argc, Janet *argv) { | ||||
|     FILE *in = janet_dynfile("in", stdin); | ||||
|     FILE *out = janet_dynfile("out", stdout); | ||||
|     janet_arity(argc, 0, 3); | ||||
|     janet_arity(argc, 0, 2); | ||||
|     JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10); | ||||
|     if (argc >= 1) { | ||||
|         const char *prompt = (const char *) janet_getstring(argv, 0); | ||||
|         fprintf(out, "%s", prompt); | ||||
|         fflush(out); | ||||
|         printf("%s", prompt); | ||||
|         fflush(stdout); | ||||
|     } | ||||
|     { | ||||
|         buf->count = 0; | ||||
|         int c; | ||||
|         for (;;) { | ||||
|             c = fgetc(in); | ||||
|             if (feof(in) || c < 0) { | ||||
|             c = fgetc(stdin); | ||||
|             if (feof(stdin) || c < 0) { | ||||
|                 break; | ||||
|             } | ||||
|             janet_buffer_push_u8(buf, (uint8_t) c); | ||||
| @@ -492,53 +287,10 @@ static Janet janet_core_untrace(int32_t argc, Janet *argv) { | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static Janet janet_core_check_int(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false; | ||||
|     double num = janet_unwrap_number(argv[0]); | ||||
|     return janet_wrap_boolean(num == (double)((int32_t)num)); | ||||
| ret_false: | ||||
|     return janet_wrap_false(); | ||||
| } | ||||
|  | ||||
| static Janet janet_core_check_nat(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false; | ||||
|     double num = janet_unwrap_number(argv[0]); | ||||
|     return janet_wrap_boolean(num >= 0 && (num == (double)((int32_t)num))); | ||||
| ret_false: | ||||
|     return janet_wrap_false(); | ||||
| } | ||||
|  | ||||
| static Janet janet_core_signal(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     int sig; | ||||
|     if (janet_checkint(argv[0])) { | ||||
|         int32_t s = janet_unwrap_integer(argv[0]); | ||||
|         if (s < 0 || s > 9) { | ||||
|             janet_panicf("expected user signal between 0 and 9, got %d", s); | ||||
|         } | ||||
|         sig = JANET_SIGNAL_USER0 + s; | ||||
|     } else { | ||||
|         JanetKeyword kw = janet_getkeyword(argv, 0); | ||||
|         if (!janet_cstrcmp(kw, "yield")) { | ||||
|             sig = JANET_SIGNAL_YIELD; | ||||
|         } else if (!janet_cstrcmp(kw, "error")) { | ||||
|             sig = JANET_SIGNAL_ERROR; | ||||
|         } else if (!janet_cstrcmp(kw, "debug")) { | ||||
|             sig = JANET_SIGNAL_DEBUG; | ||||
|         } else { | ||||
|             janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]); | ||||
|         } | ||||
|     } | ||||
|     Janet payload = argc == 2 ? argv[1] : janet_wrap_nil(); | ||||
|     janet_signalv(sig, payload); | ||||
| } | ||||
|  | ||||
| static const JanetReg corelib_cfuns[] = { | ||||
|     { | ||||
|         "native", janet_core_native, | ||||
|         JDOC("(native path &opt env)\n\n" | ||||
|         JDOC("(native path [,env])\n\n" | ||||
|              "Load a native module from the given path. The path " | ||||
|              "must be an absolute or relative path on the file system, and is " | ||||
|              "usually a .so file on Unix systems, and a .dll file on Windows. " | ||||
| @@ -548,35 +300,35 @@ static const JanetReg corelib_cfuns[] = { | ||||
|     { | ||||
|         "describe", janet_core_describe, | ||||
|         JDOC("(describe x)\n\n" | ||||
|              "Returns a string that is a human-readable description of a value x.") | ||||
|              "Returns a string that is a human readable description of a value x.") | ||||
|     }, | ||||
|     { | ||||
|         "string", janet_core_string, | ||||
|         JDOC("(string & xs)\n\n" | ||||
|              "Creates a string by concatenating the elements of `xs` together. If an " | ||||
|              "element is not a byte sequence, it is converted to bytes via `describe`. " | ||||
|         JDOC("(string & parts)\n\n" | ||||
|              "Creates a string by concatenating values together. Values are " | ||||
|              "converted to bytes via describe if they are not byte sequences. " | ||||
|              "Returns the new string.") | ||||
|     }, | ||||
|     { | ||||
|         "symbol", janet_core_symbol, | ||||
|         JDOC("(symbol & xs)\n\n" | ||||
|              "Creates a symbol by concatenating the elements of `xs` together. If an " | ||||
|              "element is not a byte sequence, it is converted to bytes via `describe`. " | ||||
|              "Returns the new symbol.") | ||||
|              "Creates a symbol by concatenating values together. Values are " | ||||
|              "converted to bytes via describe if they are not byte sequences. Returns " | ||||
|              "the new symbol.") | ||||
|     }, | ||||
|     { | ||||
|         "keyword", janet_core_keyword, | ||||
|         JDOC("(keyword & xs)\n\n" | ||||
|              "Creates a keyword by concatenating the elements of `xs` together. If an " | ||||
|              "element is not a byte sequence, it is converted to bytes via `describe`. " | ||||
|              "Returns the new keyword.") | ||||
|              "Creates a keyword by concatenating values together. Values are " | ||||
|              "converted to bytes via describe if they are not byte sequences. Returns " | ||||
|              "the new keyword.") | ||||
|     }, | ||||
|     { | ||||
|         "buffer", janet_core_buffer, | ||||
|         JDOC("(buffer & xs)\n\n" | ||||
|              "Creates a buffer by concatenating the elements of `xs` together. If an " | ||||
|              "element is not a byte sequence, it is converted to bytes via `describe`. " | ||||
|              "Returns the new buffer.") | ||||
|              "Creates a new buffer by concatenating values together. Values are " | ||||
|              "converted to bytes via describe if they are not byte sequences. Returns " | ||||
|              "the new buffer.") | ||||
|     }, | ||||
|     { | ||||
|         "abstract?", janet_core_is_abstract, | ||||
| @@ -633,7 +385,7 @@ static const JanetReg corelib_cfuns[] = { | ||||
|         "gcsetinterval", janet_core_gcsetinterval, | ||||
|         JDOC("(gcsetinterval interval)\n\n" | ||||
|              "Set an integer number of bytes to allocate before running garbage collection. " | ||||
|              "Low values for interval will be slower but use less memory. " | ||||
|              "Low valuesi for interval will be slower but use less memory. " | ||||
|              "High values will be faster but use more memory.") | ||||
|     }, | ||||
|     { | ||||
| @@ -645,42 +397,49 @@ static const JanetReg corelib_cfuns[] = { | ||||
|     { | ||||
|         "type", janet_core_type, | ||||
|         JDOC("(type x)\n\n" | ||||
|              "Returns the type of `x` as a keyword. `x` is one of:\n\n" | ||||
|              "* :nil\n\n" | ||||
|              "* :boolean\n\n" | ||||
|              "* :number\n\n" | ||||
|              "* :array\n\n" | ||||
|              "* :tuple\n\n" | ||||
|              "* :table\n\n" | ||||
|              "* :struct\n\n" | ||||
|              "* :string\n\n" | ||||
|              "* :buffer\n\n" | ||||
|              "* :symbol\n\n" | ||||
|              "* :keyword\n\n" | ||||
|              "* :function\n\n" | ||||
|              "* :cfunction\n\n" | ||||
|              "* :fiber\n\n" | ||||
|              "or another keyword for an abstract type.") | ||||
|              "Returns the type of x as a keyword symbol. x is one of\n" | ||||
|              "\t:nil\n" | ||||
|              "\t:boolean\n" | ||||
|              "\t:integer\n" | ||||
|              "\t:real\n" | ||||
|              "\t:array\n" | ||||
|              "\t:tuple\n" | ||||
|              "\t:table\n" | ||||
|              "\t:struct\n" | ||||
|              "\t:string\n" | ||||
|              "\t:buffer\n" | ||||
|              "\t:symbol\n" | ||||
|              "\t:keyword\n" | ||||
|              "\t:function\n" | ||||
|              "\t:cfunction\n\n" | ||||
|              "or another symbol for an abstract type.") | ||||
|     }, | ||||
|     { | ||||
|         "next", janet_core_next, | ||||
|         JDOC("(next dict key)\n\n" | ||||
|              "Gets the next key in a struct or table. 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 " | ||||
|              "during iteration. If key is nil, next returns the first key. If next " | ||||
|              "returns nil, there are no more keys to iterate through. ") | ||||
|     }, | ||||
|     { | ||||
|         "hash", janet_core_hash, | ||||
|         JDOC("(hash value)\n\n" | ||||
|              "Gets a hash for any value. The hash is an integer can be used " | ||||
|              "as a cheap hash function for all values. If two values are strictly equal, " | ||||
|              "Gets a hash value for any janet value. The hash is an integer can be used " | ||||
|              "as a cheap hash function for all janet objects. If two values are strictly equal, " | ||||
|              "then they will have the same hash value.") | ||||
|     }, | ||||
|     { | ||||
|         "getline", janet_core_getline, | ||||
|         JDOC("(getline &opt prompt buf env)\n\n" | ||||
|              "Reads a line of input into a buffer, including the newline character, using a prompt. " | ||||
|              "An optional environment table can be provided for auto-complete. " | ||||
|              "Returns the modified buffer. " | ||||
|         JDOC("(getline [, prompt=\"\" [, buffer=@\"\"]])\n\n" | ||||
|              "Reads a line of input into a buffer, including the newline character, using a prompt. Returns the modified buffer. " | ||||
|              "Use this function to implement a simple interface for a terminal program.") | ||||
|     }, | ||||
|     { | ||||
|         "dyn", janet_core_dyn, | ||||
|         JDOC("(dyn key &opt default)\n\n" | ||||
|              "Get a dynamic binding. Returns the default value (or nil) if no binding found.") | ||||
|         JDOC("(dyn key [, default=nil])\n\n" | ||||
|              "Get a dynamic binding. Returns the default value if no binding found.") | ||||
|     }, | ||||
|     { | ||||
|         "setdyn", janet_core_setdyn, | ||||
| @@ -697,40 +456,6 @@ static const JanetReg corelib_cfuns[] = { | ||||
|         JDOC("(untrace func)\n\n" | ||||
|              "Disables tracing on a function. Returns the function.") | ||||
|     }, | ||||
|     { | ||||
|         "module/expand-path", janet_core_expand_path, | ||||
|         JDOC("(module/expand-path path template)\n\n" | ||||
|              "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" | ||||
|              "* :all: -- the value of path verbatim\n\n" | ||||
|              "* :cur: -- the current file, or (dyn :current-file)\n\n" | ||||
|              "* :dir: -- the directory containing the current file\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)") | ||||
|     }, | ||||
|     { | ||||
|         "int?", janet_core_check_int, | ||||
|         JDOC("(int? x)\n\n" | ||||
|              "Check if x can be exactly represented as a 32 bit signed two's complement integer.") | ||||
|     }, | ||||
|     { | ||||
|         "nat?", janet_core_check_nat, | ||||
|         JDOC("(nat? x)\n\n" | ||||
|              "Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.") | ||||
|     }, | ||||
|     { | ||||
|         "slice", janet_core_slice, | ||||
|         JDOC("(slice x &opt start end)\n\n" | ||||
|              "Extract a sub-range of an indexed data structure or byte sequence.") | ||||
|     }, | ||||
|     { | ||||
|         "signal", janet_core_signal, | ||||
|         JDOC("(signal what x)\n\n" | ||||
|              "Raise a signal with payload x. ") | ||||
|     }, | ||||
|     {NULL, NULL, NULL} | ||||
| }; | ||||
|  | ||||
| @@ -754,18 +479,17 @@ static void janet_quick_asm( | ||||
|     def->max_arity = max_arity; | ||||
|     def->flags = flags; | ||||
|     def->slotcount = slots; | ||||
|     def->bytecode = janet_malloc(bytecode_size); | ||||
|     def->bytecode = malloc(bytecode_size); | ||||
|     def->bytecode_length = (int32_t)(bytecode_size / sizeof(uint32_t)); | ||||
|     def->name = janet_cstring(name); | ||||
|     if (!def->bytecode) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
|     memcpy(def->bytecode, bytecode, bytecode_size); | ||||
|     janet_def_addflags(def); | ||||
|     janet_def(env, name, janet_wrap_function(janet_thunk(def)), doc); | ||||
| } | ||||
|  | ||||
| /* Macros for easier inline assembly */ | ||||
| /* Macros for easier inline janet assembly */ | ||||
| #define SSS(op, a, b, c) ((op) | ((a) << 8) | ((b) << 16) | ((c) << 24)) | ||||
| #define SS(op, a, b) ((op) | ((a) << 8) | ((b) << 16)) | ||||
| #define SSI(op, a, b, I) ((op) | ((a) << 8) | ((b) << 16) | ((uint32_t)(I) << 24)) | ||||
| @@ -813,7 +537,7 @@ static void templatize_varop( | ||||
|         SSI(JOP_GET_INDEX, 3, 0, 0), /* accum = args[0] */ | ||||
|         SI(JOP_LOAD_INTEGER, 5, 1), /* i = 1 */ | ||||
|         /* Main loop */ | ||||
|         SSS(JOP_IN, 4, 0, 5), /* operand = args[i] */ | ||||
|         SSS(JOP_GET, 4, 0, 5), /* operand = args[i] */ | ||||
|         SSS(op, 3, 3, 4), /* accum = accum op operand */ | ||||
|         SSI(JOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */ | ||||
|         SSI(JOP_EQUALS, 2, 5, 1), /* jump? = (i == argn) */ | ||||
| @@ -861,7 +585,7 @@ static void templatize_comparator( | ||||
|         SI(JOP_LOAD_INTEGER, 5, 1), /* i = 1 */ | ||||
|  | ||||
|         /* Main loop */ | ||||
|         SSS(JOP_IN, 4, 0, 5), /* next = args[i] */ | ||||
|         SSS(JOP_GET, 4, 0, 5), /* next = args[i] */ | ||||
|         SSS(op, 2, 3, 4), /* jump? = last compare next */ | ||||
|         SI(JOP_JUMP_IF_NOT, 2, 7), /* if not jump? goto fail (return false) */ | ||||
|         SSI(JOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */ | ||||
| @@ -908,7 +632,7 @@ static void make_apply(JanetTable *env) { | ||||
|         SI(JOP_LOAD_INTEGER, 4, 0), /* i = 0 */ | ||||
|  | ||||
|         /* Main loop */ | ||||
|         SSS(JOP_IN, 5, 1, 4), /* x = args[i] */ | ||||
|         SSS(JOP_GET, 5, 1, 4), /* x = args[i] */ | ||||
|         SSI(JOP_ADD_IMMEDIATE, 4, 4, 1), /* i++ */ | ||||
|         SSI(JOP_EQUALS, 3, 4, 2), /* jump? = (i == argn) */ | ||||
|         SI(JOP_JUMP_IF, 3, 3), /* if jump? go forward 3 */ | ||||
| @@ -937,7 +661,7 @@ static const uint32_t error_asm[] = { | ||||
| }; | ||||
| static const uint32_t debug_asm[] = { | ||||
|     JOP_SIGNAL | (2 << 24), | ||||
|     JOP_RETURN | ||||
|     JOP_RETURN_NIL | ||||
| }; | ||||
| static const uint32_t yield_asm[] = { | ||||
|     JOP_SIGNAL | (3 << 24), | ||||
| @@ -947,25 +671,9 @@ static const uint32_t resume_asm[] = { | ||||
|     JOP_RESUME | (1 << 24), | ||||
|     JOP_RETURN | ||||
| }; | ||||
| static const uint32_t cancel_asm[] = { | ||||
|     JOP_CANCEL | (1 << 24), | ||||
|     JOP_RETURN | ||||
| }; | ||||
| static const uint32_t in_asm[] = { | ||||
|     JOP_IN | (1 << 24), | ||||
|     JOP_LOAD_NIL | (3 << 8), | ||||
|     JOP_EQUALS | (3 << 8) | (3 << 24), | ||||
|     JOP_JUMP_IF | (3 << 8) | (2 << 16), | ||||
|     JOP_RETURN, | ||||
|     JOP_RETURN | (2 << 8) | ||||
| }; | ||||
| static const uint32_t get_asm[] = { | ||||
|     JOP_GET | (1 << 24), | ||||
|     JOP_LOAD_NIL | (3 << 8), | ||||
|     JOP_EQUALS | (3 << 8) | (3 << 24), | ||||
|     JOP_JUMP_IF | (3 << 8) | (2 << 16), | ||||
|     JOP_RETURN, | ||||
|     JOP_RETURN | (2 << 8) | ||||
|     JOP_RETURN | ||||
| }; | ||||
| static const uint32_t put_asm[] = { | ||||
|     JOP_PUT | (1 << 16) | (2 << 24), | ||||
| @@ -979,120 +687,28 @@ static const uint32_t bnot_asm[] = { | ||||
|     JOP_BNOT, | ||||
|     JOP_RETURN | ||||
| }; | ||||
| static const uint32_t propagate_asm[] = { | ||||
|     JOP_PROPAGATE | (1 << 24), | ||||
|     JOP_RETURN | ||||
| }; | ||||
| 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 | ||||
| }; | ||||
| #endif /* ifdef JANET_BOOTSTRAP */ | ||||
|  | ||||
| /* | ||||
|  * Setup Environment | ||||
|  */ | ||||
|  | ||||
| static void janet_load_libs(JanetTable *env) { | ||||
|     janet_core_cfuns(env, NULL, corelib_cfuns); | ||||
|     janet_lib_io(env); | ||||
|     janet_lib_math(env); | ||||
|     janet_lib_array(env); | ||||
|     janet_lib_tuple(env); | ||||
|     janet_lib_buffer(env); | ||||
|     janet_lib_table(env); | ||||
|     janet_lib_fiber(env); | ||||
|     janet_lib_os(env); | ||||
|     janet_lib_parse(env); | ||||
|     janet_lib_compile(env); | ||||
|     janet_lib_debug(env); | ||||
|     janet_lib_string(env); | ||||
|     janet_lib_marsh(env); | ||||
| #ifdef JANET_PEG | ||||
|     janet_lib_peg(env); | ||||
| #endif | ||||
| #ifdef JANET_ASSEMBLER | ||||
|     janet_lib_asm(env); | ||||
| #endif | ||||
| #ifdef JANET_INT_TYPES | ||||
|     janet_lib_inttypes(env); | ||||
| #endif | ||||
| #ifdef JANET_THREADS | ||||
|     janet_lib_thread(env); | ||||
| #endif | ||||
| #ifdef JANET_EV | ||||
|     janet_lib_ev(env); | ||||
| #endif | ||||
| #ifdef JANET_NET | ||||
|     janet_lib_net(env); | ||||
| #endif | ||||
| } | ||||
|  | ||||
| #ifdef JANET_BOOTSTRAP | ||||
| #endif /* ifndef JANET_NO_BOOTSTRAP */ | ||||
|  | ||||
| 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" | ||||
|                          "Returns -1 if x is strictly less than y, 1 if y is strictly greater " | ||||
|                          "than x, and 0 otherwise. To return 0, x and y must be the exact same type.")); | ||||
|     janet_quick_asm(env, JANET_FUN_NEXT, | ||||
|                     "next", 2, 1, 2, 2, next_asm, sizeof(next_asm), | ||||
|                     JDOC("(next ds &opt key)\n\n" | ||||
|                          "Gets the next key in a data structure. Can be used to iterate through " | ||||
|                          "the keys of a data structure in an unspecified order. Keys are guaranteed " | ||||
|                          "to be seen only once per iteration if they 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.")); | ||||
|     janet_core_cfuns(env, NULL, corelib_cfuns); | ||||
|  | ||||
| #ifdef JANET_BOOTSTRAP | ||||
|     janet_quick_asm(env, JANET_FUN_DEBUG, | ||||
|                     "debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm), | ||||
|                     JDOC("(debug &opt x)\n\n" | ||||
|                     "debug", 0, 0, 0, 1, debug_asm, sizeof(debug_asm), | ||||
|                     JDOC("(debug)\n\n" | ||||
|                          "Throws a debug signal that can be caught by a parent fiber and used to inspect " | ||||
|                          "the running state of the current fiber. Returns the value passed in by resume.")); | ||||
|                          "the running state of the current fiber. Returns nil.")); | ||||
|     janet_quick_asm(env, JANET_FUN_ERROR, | ||||
|                     "error", 1, 1, 1, 1, error_asm, sizeof(error_asm), | ||||
|                     JDOC("(error e)\n\n" | ||||
|                          "Throws an error e that can be caught and handled by a parent fiber.")); | ||||
|     janet_quick_asm(env, JANET_FUN_YIELD, | ||||
|                     "yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm), | ||||
|                     JDOC("(yield &opt x)\n\n" | ||||
|                     JDOC("(yield x)\n\n" | ||||
|                          "Yield a value to a parent fiber. When a fiber yields, its execution is paused until " | ||||
|                          "another thread resumes it. The fiber will then resume, and the last yield call will " | ||||
|                          "return the value that was passed to resume.")); | ||||
|     janet_quick_asm(env, JANET_FUN_CANCEL, | ||||
|                     "cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm), | ||||
|                     JDOC("(cancel fiber err)\n\n" | ||||
|                          "Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. " | ||||
|                          "Returns the same result as resume.")); | ||||
|     janet_quick_asm(env, JANET_FUN_RESUME, | ||||
|                     "resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm), | ||||
|                     JDOC("(resume fiber &opt x)\n\n" | ||||
| @@ -1100,20 +716,14 @@ JanetTable *janet_core_env(JanetTable *replacements) { | ||||
|                          "will be returned to the last yield in the case of a pending fiber, or the argument to " | ||||
|                          "the dispatch function in the case of a new fiber. Returns either the return result of " | ||||
|                          "the fiber's dispatch function, or the value from the next yield call in fiber.")); | ||||
|     janet_quick_asm(env, JANET_FUN_IN, | ||||
|                     "in", 3, 2, 3, 4, in_asm, sizeof(in_asm), | ||||
|                     JDOC("(in ds key &opt dflt)\n\n" | ||||
|                          "Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, " | ||||
|                          "strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, " | ||||
|                          "and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can " | ||||
|                          "take any value as a key except nil and will return nil or dflt if not found.")); | ||||
|     janet_quick_asm(env, JANET_FUN_GET, | ||||
|                     "get", 3, 2, 3, 4, get_asm, sizeof(in_asm), | ||||
|                     JDOC("(get ds key &opt dflt)\n\n" | ||||
|                          "Get the value mapped to key in data structure ds, and return dflt or nil if not found. " | ||||
|                          "Similar to in, but will not throw an error if the key is invalid for the data structure " | ||||
|                          "unless the data structure is an abstract type. In that case, the abstract type getter may throw " | ||||
|                          "an error.")); | ||||
|                     "get", 2, 2, 2, 2, get_asm, sizeof(get_asm), | ||||
|                     JDOC("(get ds key)\n\n" | ||||
|                          "Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, " | ||||
|                          "symbols, and buffers are all associative and can be used with get. Order structures, name " | ||||
|                          "arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can " | ||||
|                          "take any value as a key except nil and return a value except nil. Byte sequences will return " | ||||
|                          "integer representations of bytes as result of a get call.")); | ||||
|     janet_quick_asm(env, JANET_FUN_PUT, | ||||
|                     "put", 3, 3, 3, 3, put_asm, sizeof(put_asm), | ||||
|                     JDOC("(put ds key value)\n\n" | ||||
| @@ -1149,7 +759,7 @@ JanetTable *janet_core_env(JanetTable *replacements) { | ||||
|                      JDOC("(/ & xs)\n\n" | ||||
|                           "Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns " | ||||
|                           "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " | ||||
|                           "values.")); | ||||
|                           "values. Division by two integers uses truncating division.")); | ||||
|     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.")); | ||||
| @@ -1174,102 +784,98 @@ JanetTable *janet_core_env(JanetTable *replacements) { | ||||
|                           "for positive shifts the return value will always be positive.")); | ||||
|  | ||||
|     /* Variadic comparators */ | ||||
|     templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN, | ||||
|                           JDOC("(> & xs)\n\n" | ||||
|                                "Check if xs is in descending order. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN, | ||||
|                           JDOC("(< & xs)\n\n" | ||||
|                                "Check if xs is in ascending order. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL, | ||||
|                           JDOC("(>= & xs)\n\n" | ||||
|                                "Check if xs is in non-ascending order. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL, | ||||
|                           JDOC("(<= & xs)\n\n" | ||||
|                                "Check if xs is in non-descending order. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS, | ||||
|     templatize_comparator(env, JANET_FUN_ORDER_GT, "order>", 0, JOP_GREATER_THAN, | ||||
|                           JDOC("(order> & xs)\n\n" | ||||
|                                "Check if xs is strictly descending according to a total order " | ||||
|                                "over all values. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_ORDER_LT, "order<", 0, JOP_LESS_THAN, | ||||
|                           JDOC("(order< & xs)\n\n" | ||||
|                                "Check if xs is strictly increasing according to a total order " | ||||
|                                "over all values. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_ORDER_GTE, "order>=", 1, JOP_LESS_THAN, | ||||
|                           JDOC("(order>= & xs)\n\n" | ||||
|                                "Check if xs is not increasing according to a total order " | ||||
|                                "over all values. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_ORDER_LTE, "order<=", 1, JOP_GREATER_THAN, | ||||
|                           JDOC("(order<= & xs)\n\n" | ||||
|                                "Check if xs is not decreasing according to a total order " | ||||
|                                "over all values. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_ORDER_EQ, "=", 0, JOP_EQUALS, | ||||
|                           JDOC("(= & xs)\n\n" | ||||
|                                "Check if all values in xs are equal. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS, | ||||
|                                "Returns true if all values in xs are the same, false otherwise.")); | ||||
|     templatize_comparator(env, JANET_FUN_ORDER_NEQ, "not=", 1, JOP_EQUALS, | ||||
|                           JDOC("(not= & xs)\n\n" | ||||
|                                "Check if any values in xs are not equal. Returns a boolean.")); | ||||
|                                "Return true if any values in xs are not equal, otherwise false.")); | ||||
|     templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_NUMERIC_GREATER_THAN, | ||||
|                           JDOC("(> & xs)\n\n" | ||||
|                                "Check if xs is in numerically descending order. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_NUMERIC_LESS_THAN, | ||||
|                           JDOC("(< & xs)\n\n" | ||||
|                                "Check if xs is in numerically ascending order. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_NUMERIC_GREATER_THAN_EQUAL, | ||||
|                           JDOC("(>= & xs)\n\n" | ||||
|                                "Check if xs is in numerically non-ascending order. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_NUMERIC_LESS_THAN_EQUAL, | ||||
|                           JDOC("(<= & xs)\n\n" | ||||
|                                "Check if xs is in numerically non-descending order. Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_EQ, "==", 0, JOP_NUMERIC_EQUAL, | ||||
|                           JDOC("(== & xs)\n\n" | ||||
|                                "Check if all values in xs are numerically equal (4.0 == 4). Returns a boolean.")); | ||||
|     templatize_comparator(env, JANET_FUN_NEQ, "not==", 1, JOP_NUMERIC_EQUAL, | ||||
|                           JDOC("(not== & xs)\n\n" | ||||
|                                "Check if any values in xs are not numerically equal (3.0 not== 4). Returns a boolean.")); | ||||
|  | ||||
|     /* Platform detection */ | ||||
|     janet_def(env, "janet/version", janet_cstringv(JANET_VERSION), | ||||
|               JDOC("The version number of the running janet program.")); | ||||
|     janet_def(env, "janet/build", janet_cstringv(JANET_BUILD), | ||||
|               JDOC("The build identifier of the running janet program.")); | ||||
|     janet_def(env, "janet/config-bits", janet_wrap_integer(JANET_CURRENT_CONFIG_BITS), | ||||
|               JDOC("The flag set of config options from janetconf.h which is used to check " | ||||
|                    "if native modules are compatible with the host program.")); | ||||
|  | ||||
|     /* Allow references to the environment */ | ||||
|     janet_def(env, "root-env", janet_wrap_table(env), | ||||
|               JDOC("The root environment used to create environments with (make-env).")); | ||||
|     janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope.")); | ||||
|  | ||||
|     janet_load_libs(env); | ||||
|     /* Set as gc root */ | ||||
|     janet_gcroot(janet_wrap_table(env)); | ||||
|     return env; | ||||
| } | ||||
| #endif | ||||
|  | ||||
| #else | ||||
|     /* Load auxiliary envs */ | ||||
|     janet_lib_io(env); | ||||
|     janet_lib_math(env); | ||||
|     janet_lib_array(env); | ||||
|     janet_lib_tuple(env); | ||||
|     janet_lib_buffer(env); | ||||
|     janet_lib_table(env); | ||||
|     janet_lib_fiber(env); | ||||
|     janet_lib_os(env); | ||||
|     janet_lib_parse(env); | ||||
|     janet_lib_compile(env); | ||||
|     janet_lib_debug(env); | ||||
|     janet_lib_string(env); | ||||
|     janet_lib_marsh(env); | ||||
| #ifdef JANET_PEG | ||||
|     janet_lib_peg(env); | ||||
| #endif | ||||
| #ifdef JANET_ASSEMBLER | ||||
|     janet_lib_asm(env); | ||||
| #endif | ||||
| #ifdef JANET_TYPED_ARRAY | ||||
|     janet_lib_typed_array(env); | ||||
| #endif | ||||
| #ifdef JANET_INT_TYPES | ||||
|     janet_lib_inttypes(env); | ||||
| #endif | ||||
|  | ||||
| JanetTable *janet_core_env(JanetTable *replacements) { | ||||
|     /* Memoize core env, ignoring replacements the second time around. */ | ||||
|     if (NULL != janet_vm_core_env) { | ||||
|         return janet_vm_core_env; | ||||
|     } | ||||
|  | ||||
|     JanetTable *dict = janet_core_lookup_table(replacements); | ||||
|  | ||||
|     /* Unmarshal bytecode */ | ||||
| #ifndef JANET_BOOTSTRAP | ||||
|     /* Unmarshal from core image */ | ||||
|     Janet marsh_out = janet_unmarshal( | ||||
|                           janet_core_image, | ||||
|                           janet_core_image_size, | ||||
|                           0, | ||||
|                           dict, | ||||
|                           env, | ||||
|                           NULL); | ||||
|  | ||||
|     /* Memoize */ | ||||
|     janet_gcroot(marsh_out); | ||||
|     JanetTable *env = janet_unwrap_table(marsh_out); | ||||
|     janet_vm_core_env = env; | ||||
|  | ||||
|     /* Invert image dict manually here. We can't do this in boot.janet as it | ||||
|      * breaks deterministic builds */ | ||||
|     Janet lidv, midv; | ||||
|     lidv = midv = janet_wrap_nil(); | ||||
|     janet_resolve(env, janet_csymbol("load-image-dict"), &lidv); | ||||
|     janet_resolve(env, janet_csymbol("make-image-dict"), &midv); | ||||
|     JanetTable *lid = janet_unwrap_table(lidv); | ||||
|     JanetTable *mid = janet_unwrap_table(midv); | ||||
|     for (int32_t i = 0; i < lid->capacity; i++) { | ||||
|         const JanetKV *kv = lid->data + i; | ||||
|         if (!janet_checktype(kv->key, JANET_NIL)) { | ||||
|             janet_table_put(mid, kv->value, kv->key); | ||||
|         } | ||||
|     } | ||||
|     env = janet_unwrap_table(marsh_out); | ||||
| #endif | ||||
|  | ||||
|     return env; | ||||
| } | ||||
|  | ||||
| #endif | ||||
|  | ||||
| JanetTable *janet_core_lookup_table(JanetTable *replacements) { | ||||
|     JanetTable *dict = janet_table(512); | ||||
|     janet_load_libs(dict); | ||||
|  | ||||
|     /* Add replacements */ | ||||
|     if (replacements != NULL) { | ||||
|         for (int32_t i = 0; i < replacements->capacity; i++) { | ||||
|             JanetKV kv = replacements->data[i]; | ||||
|             if (!janet_checktype(kv.key, JANET_NIL)) { | ||||
|                 janet_table_put(dict, kv.key, kv.value); | ||||
|                 if (janet_checktype(kv.value, JANET_CFUNCTION)) { | ||||
|                     janet_table_put(janet_vm_registry, kv.value, kv.key); | ||||
|                 } | ||||
|             } | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     return dict; | ||||
| } | ||||
|   | ||||
							
								
								
									
										150
									
								
								src/core/debug.c
									
									
									
									
									
								
							
							
						
						
									
										150
									
								
								src/core/debug.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,7 +21,6 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "gc.h" | ||||
| #include "state.h" | ||||
| @@ -53,35 +52,31 @@ void janet_debug_unbreak(JanetFuncDef *def, int32_t pc) { | ||||
|  */ | ||||
| void janet_debug_find( | ||||
|     JanetFuncDef **def_out, int32_t *pc_out, | ||||
|     const uint8_t *source, int32_t sourceLine, int32_t sourceColumn) { | ||||
|     const uint8_t *source, int32_t offset) { | ||||
|     /* Scan the heap for right func def */ | ||||
|     JanetGCObject *current = janet_vm_blocks; | ||||
|     /* Keep track of the best source mapping we have seen so far */ | ||||
|     int32_t besti = -1; | ||||
|     int32_t best_line = -1; | ||||
|     int32_t best_column = -1; | ||||
|     int32_t best_range = INT32_MAX; | ||||
|     JanetFuncDef *best_def = NULL; | ||||
|     while (NULL != current) { | ||||
|         if ((current->flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_FUNCDEF) { | ||||
|             JanetFuncDef *def = (JanetFuncDef *)(current); | ||||
|             JanetFuncDef *def = (JanetFuncDef *)(current + 1); | ||||
|             if (def->sourcemap && | ||||
|                     def->source && | ||||
|                     !janet_string_compare(source, def->source)) { | ||||
|                 /* Correct source file, check mappings. The chosen | ||||
|                  * pc index is the instruction closest to the given line column, but | ||||
|                  * not after. */ | ||||
|                  * pc index is the first match with the smallest range. */ | ||||
|                 int32_t i; | ||||
|                 for (i = 0; i < def->bytecode_length; i++) { | ||||
|                     int32_t line = def->sourcemap[i].line; | ||||
|                     int32_t column = def->sourcemap[i].column; | ||||
|                     if (line <= sourceLine && line >= best_line) { | ||||
|                         if (column <= sourceColumn && | ||||
|                                 (line > best_line || column > best_column)) { | ||||
|                             best_line = line; | ||||
|                             best_column = column; | ||||
|                             besti = i; | ||||
|                             best_def = def; | ||||
|                         } | ||||
|                     int32_t start = def->sourcemap[i].start; | ||||
|                     int32_t end = def->sourcemap[i].end; | ||||
|                     if (end - start < best_range && | ||||
|                             start <= offset && | ||||
|                             end >= offset) { | ||||
|                         best_range = end - start; | ||||
|                         besti = i; | ||||
|                         best_def = def; | ||||
|                     } | ||||
|                 } | ||||
|             } | ||||
| @@ -100,14 +95,10 @@ void janet_debug_find( | ||||
|  * consitency with the top level code it is defined once. */ | ||||
| void janet_stacktrace(JanetFiber *fiber, Janet err) { | ||||
|     int32_t fi; | ||||
|     FILE *out = janet_dynfile("err", stderr); | ||||
|     const char *errstr = (const char *)janet_to_string(err); | ||||
|     JanetFiber **fibers = NULL; | ||||
|  | ||||
|     /* Don't print error line if it is nil. */ | ||||
|     int wrote_error = janet_checktype(err, JANET_NIL); | ||||
|  | ||||
|     int print_color = janet_truthy(janet_dyn("err-color")); | ||||
|     if (print_color) janet_eprintf("\x1b[31m"); | ||||
|     int wrote_error = 0; | ||||
|  | ||||
|     while (fiber) { | ||||
|         janet_v_push(fibers, fiber); | ||||
| @@ -126,48 +117,46 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) { | ||||
|             if (!wrote_error) { | ||||
|                 JanetFiberStatus status = janet_fiber_status(fiber); | ||||
|                 const char *prefix = status == JANET_STATUS_ERROR ? "" : "status "; | ||||
|                 janet_eprintf("%s%s: %s\n", | ||||
|                               prefix, | ||||
|                               janet_status_names[status], | ||||
|                               errstr); | ||||
|                 fprintf(out, "%s%s: %s\n", | ||||
|                         prefix, | ||||
|                         janet_status_names[status], | ||||
|                         errstr); | ||||
|                 wrote_error = 1; | ||||
|             } | ||||
|  | ||||
|             janet_eprintf("  in"); | ||||
|             fprintf(out, "  in"); | ||||
|  | ||||
|             if (frame->func) { | ||||
|                 def = frame->func->def; | ||||
|                 janet_eprintf(" %s", def->name ? (const char *)def->name : "<anonymous>"); | ||||
|                 fprintf(out, " %s", def->name ? (const char *)def->name : "<anonymous>"); | ||||
|                 if (def->source) { | ||||
|                     janet_eprintf(" [%s]", (const char *)def->source); | ||||
|                     fprintf(out, " [%s]", (const char *)def->source); | ||||
|                 } | ||||
|             } else { | ||||
|                 JanetCFunction cfun = (JanetCFunction)(frame->pc); | ||||
|                 if (cfun) { | ||||
|                     Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun)); | ||||
|                     if (!janet_checktype(name, JANET_NIL)) | ||||
|                         janet_eprintf(" %s", (const char *)janet_to_string(name)); | ||||
|                         fprintf(out, " %s", (const char *)janet_to_string(name)); | ||||
|                     else | ||||
|                         janet_eprintf(" <cfunction>"); | ||||
|                         fprintf(out, " <cfunction>"); | ||||
|                 } | ||||
|             } | ||||
|             if (frame->flags & JANET_STACKFRAME_TAILCALL) | ||||
|                 janet_eprintf(" (tailcall)"); | ||||
|                 fprintf(out, " (tailcall)"); | ||||
|             if (frame->func && frame->pc) { | ||||
|                 int32_t off = (int32_t)(frame->pc - def->bytecode); | ||||
|                 if (def->sourcemap) { | ||||
|                     JanetSourceMapping mapping = def->sourcemap[off]; | ||||
|                     janet_eprintf(" on line %d, column %d", mapping.line, mapping.column); | ||||
|                     fprintf(out, " at (%d:%d)", mapping.start, mapping.end); | ||||
|                 } else { | ||||
|                     janet_eprintf(" pc=%d", off); | ||||
|                     fprintf(out, " pc=%d", off); | ||||
|                 } | ||||
|             } | ||||
|             janet_eprintf("\n"); | ||||
|             fprintf(out, "\n"); | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     if (print_color) janet_eprintf("\x1b[0m"); | ||||
|  | ||||
|     janet_v_free(fibers); | ||||
| } | ||||
|  | ||||
| @@ -178,11 +167,10 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) { | ||||
| /* Helper to find funcdef and bytecode offset to insert or remove breakpoints. | ||||
|  * Takes a source file name and byte offset. */ | ||||
| static void helper_find(int32_t argc, Janet *argv, JanetFuncDef **def, int32_t *bytecode_offset) { | ||||
|     janet_fixarity(argc, 3); | ||||
|     janet_fixarity(argc, 2); | ||||
|     const uint8_t *source = janet_getstring(argv, 0); | ||||
|     int32_t line = janet_getinteger(argv, 1); | ||||
|     int32_t col = janet_getinteger(argv, 2); | ||||
|     janet_debug_find(def, bytecode_offset, source, line, col); | ||||
|     int32_t source_offset = janet_getinteger(argv, 1); | ||||
|     janet_debug_find(def, bytecode_offset, source, source_offset); | ||||
| } | ||||
|  | ||||
| /* Helper to find funcdef and bytecode offset to insert or remove breakpoints. | ||||
| @@ -269,15 +257,15 @@ static Janet doframe(JanetStackFrame *frame) { | ||||
|         janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off)); | ||||
|         if (def->sourcemap) { | ||||
|             JanetSourceMapping mapping = def->sourcemap[off]; | ||||
|             janet_table_put(t, janet_ckeywordv("source-line"), janet_wrap_integer(mapping.line)); | ||||
|             janet_table_put(t, janet_ckeywordv("source-column"), janet_wrap_integer(mapping.column)); | ||||
|             janet_table_put(t, janet_ckeywordv("source-start"), janet_wrap_integer(mapping.start)); | ||||
|             janet_table_put(t, janet_ckeywordv("source-end"), janet_wrap_integer(mapping.end)); | ||||
|         } | ||||
|         if (def->source) { | ||||
|             janet_table_put(t, janet_ckeywordv("source"), janet_wrap_string(def->source)); | ||||
|         } | ||||
|         /* Add stack arguments */ | ||||
|         slots = janet_array(def->slotcount); | ||||
|         safe_memcpy(slots->data, stack, sizeof(Janet) * def->slotcount); | ||||
|         memcpy(slots->data, stack, sizeof(Janet) * def->slotcount); | ||||
|         slots->count = def->slotcount; | ||||
|         janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots)); | ||||
|     } | ||||
| @@ -301,10 +289,9 @@ static Janet cfun_debug_stack(int32_t argc, Janet *argv) { | ||||
| } | ||||
|  | ||||
| static Janet cfun_debug_stacktrace(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     janet_fixarity(argc, 2); | ||||
|     JanetFiber *fiber = janet_getfiber(argv, 0); | ||||
|     Janet x = argc == 1 ? janet_wrap_nil() : argv[1]; | ||||
|     janet_stacktrace(fiber, x); | ||||
|     janet_stacktrace(fiber, argv[1]); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| @@ -317,41 +304,33 @@ static Janet cfun_debug_argstack(int32_t argc, Janet *argv) { | ||||
|     return janet_wrap_array(array); | ||||
| } | ||||
|  | ||||
| static Janet cfun_debug_step(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     JanetFiber *fiber = janet_getfiber(argv, 0); | ||||
|     Janet out = janet_wrap_nil(); | ||||
|     janet_step(fiber, argc == 1 ? janet_wrap_nil() : argv[1], &out); | ||||
|     return out; | ||||
| } | ||||
|  | ||||
| static const JanetReg debug_cfuns[] = { | ||||
|     { | ||||
|         "debug/break", cfun_debug_break, | ||||
|         JDOC("(debug/break source line col)\n\n" | ||||
|              "Sets a breakpoint in `source` at a given line and column. " | ||||
|              "Will throw an error if the breakpoint location " | ||||
|         JDOC("(debug/break source byte-offset)\n\n" | ||||
|              "Sets a breakpoint with source a key at a given byte offset. An offset " | ||||
|              "of 0 is the first byte in a file. Will throw an error if the breakpoint location " | ||||
|              "cannot be found. For example\n\n" | ||||
|              "\t(debug/break \"core.janet\" 10 4)\n\n" | ||||
|              "wil set a breakpoint at line 10, 4th column of the file core.janet.") | ||||
|              "\t(debug/break \"core.janet\" 1000)\n\n" | ||||
|              "wil set a breakpoint at the 1000th byte of the file core.janet.") | ||||
|     }, | ||||
|     { | ||||
|         "debug/unbreak", cfun_debug_unbreak, | ||||
|         JDOC("(debug/unbreak source line column)\n\n" | ||||
|              "Remove a breakpoint with a source key at a given line and column. " | ||||
|              "Will throw an error if the breakpoint " | ||||
|         JDOC("(debug/unbreak source byte-offset)\n\n" | ||||
|              "Remove a breakpoint with a source key at a given byte offset. An offset " | ||||
|              "of 0 is the first byte in a file. Will throw an error if the breakpoint " | ||||
|              "cannot be found.") | ||||
|     }, | ||||
|     { | ||||
|         "debug/fbreak", cfun_debug_fbreak, | ||||
|         JDOC("(debug/fbreak fun &opt pc)\n\n" | ||||
|         JDOC("(debug/fbreak fun [,pc=0])\n\n" | ||||
|              "Set a breakpoint in a given function. pc is an optional offset, which " | ||||
|              "is in bytecode instructions. fun is a function value. Will throw an error " | ||||
|              "if the offset is too large or negative.") | ||||
|     }, | ||||
|     { | ||||
|         "debug/unfbreak", cfun_debug_unfbreak, | ||||
|         JDOC("(debug/unfbreak fun &opt pc)\n\n" | ||||
|         JDOC("(debug/unfbreak fun [,pc=0])\n\n" | ||||
|              "Unset a breakpoint set with debug/fbreak.") | ||||
|     }, | ||||
|     { | ||||
| @@ -365,25 +344,25 @@ static const JanetReg debug_cfuns[] = { | ||||
|         "debug/stack", cfun_debug_stack, | ||||
|         JDOC("(debug/stack fib)\n\n" | ||||
|              "Gets information about the stack as an array of tables. Each table " | ||||
|              "in the array contains information about a stack frame. The top-most, current " | ||||
|              "stack frame is the first table in the array, and the bottom-most stack frame " | ||||
|              "in the array contains information about a stack frame. The top most, current " | ||||
|              "stack frame is the first table in the array, and the bottom most stack frame " | ||||
|              "is the last value. Each stack frame contains some of the following attributes:\n\n" | ||||
|              "* :c - true if the stack frame is a c function invocation\n\n" | ||||
|              "* :column - the current source column of the stack frame\n\n" | ||||
|              "* :function - the function that the stack frame represents\n\n" | ||||
|              "* :line - the current source line of the stack frame\n\n" | ||||
|              "* :name - the human-friendly name of the function\n\n" | ||||
|              "* :pc - integer indicating the location of the program counter\n\n" | ||||
|              "* :source - string with the file path or other identifier for the source code\n\n" | ||||
|              "* :slots - array of all values in each slot\n\n" | ||||
|              "* :tail - boolean indicating a tail call") | ||||
|              "\t:c - true if the stack frame is a c function invocation\n" | ||||
|              "\t:column - the current source column of the stack frame\n" | ||||
|              "\t:function - the function that the stack frame represents\n" | ||||
|              "\t:line - the current source line of the stack frame\n" | ||||
|              "\t:name - the human friendly name of the function\n" | ||||
|              "\t:pc - integer indicating the location of the program counter\n" | ||||
|              "\t:source - string with the file path or other identifier for the source code\n" | ||||
|              "\t:slots - array of all values in each slot\n" | ||||
|              "\t:tail - boolean indicating a tail call") | ||||
|     }, | ||||
|     { | ||||
|         "debug/stacktrace", cfun_debug_stacktrace, | ||||
|         JDOC("(debug/stacktrace fiber &opt err)\n\n" | ||||
|              "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, will skipp the error line. Returns the fiber.") | ||||
|         JDOC("(debug/stacktrace fiber err)\n\n" | ||||
|              "Prints a nice looking stacktrace for a fiber. The error message " | ||||
|              "err must be passed to the function as fiber's do not keep track of " | ||||
|              "the last error they have thrown. Returns the fiber.") | ||||
|     }, | ||||
|     { | ||||
|         "debug/lineage", cfun_debug_lineage, | ||||
| @@ -393,13 +372,6 @@ static const JanetReg debug_cfuns[] = { | ||||
|              "the fiber handling the error can see which fiber raised the signal. This function should " | ||||
|              "be used mostly for debugging purposes.") | ||||
|     }, | ||||
|     { | ||||
|         "debug/step", cfun_debug_step, | ||||
|         JDOC("(debug/step fiber &opt x)\n\n" | ||||
|              "Run a fiber for one virtual instruction of the Janet machine. Can optionally " | ||||
|              "pass in a value that will be passed as the resuming value. Returns the signal value, " | ||||
|              "which will usually be nil, as breakpoints raise nil signals.") | ||||
|     }, | ||||
|     {NULL, NULL, NULL} | ||||
| }; | ||||
|  | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,7 +21,6 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "emit.h" | ||||
| #include "vector.h" | ||||
| @@ -37,7 +36,7 @@ int32_t janetc_allocfar(JanetCompiler *c) { | ||||
|     return reg; | ||||
| } | ||||
|  | ||||
| /* Get a register less than 256 for temporary use. */ | ||||
| /* Get a register less than 256 */ | ||||
| int32_t janetc_allocnear(JanetCompiler *c, JanetcRegisterTemp tag) { | ||||
|     return janetc_regalloc_temp(&c->scope->ra, tag); | ||||
| } | ||||
| @@ -205,7 +204,7 @@ static int32_t janetc_regnear(JanetCompiler *c, JanetSlot s, JanetcRegisterTemp | ||||
| } | ||||
|  | ||||
| /* Check if two slots are equal */ | ||||
| int janetc_sequal(JanetSlot lhs, JanetSlot rhs) { | ||||
| static int janetc_sequal(JanetSlot lhs, JanetSlot rhs) { | ||||
|     if ((lhs.flags & ~JANET_SLOTTYPE_ANY) == (rhs.flags & ~JANET_SLOTTYPE_ANY) && | ||||
|             lhs.index == rhs.index && | ||||
|             lhs.envindex == rhs.envindex) { | ||||
| @@ -245,8 +244,8 @@ void janetc_copy( | ||||
|     janetc_moveback(c, dest, nearreg); | ||||
|     /* Cleanup */ | ||||
|     janetc_regalloc_freetemp(&c->scope->ra, nearreg, JANETC_REGTEMP_3); | ||||
| } | ||||
|  | ||||
| } | ||||
| /* Instruction templated emitters */ | ||||
|  | ||||
| static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) { | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -42,9 +42,6 @@ int32_t janetc_emit_ssi(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2 | ||||
| int32_t janetc_emit_ssu(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, uint8_t immediate, int wr); | ||||
| int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, JanetSlot s3, int wr); | ||||
|  | ||||
| /* Check if two slots are equivalent */ | ||||
| int janetc_sequal(JanetSlot x, JanetSlot y); | ||||
|  | ||||
| /* Move value from one slot to another. Cannot copy to constant slots. */ | ||||
| void janetc_copy(JanetCompiler *c, JanetSlot dest, JanetSlot src); | ||||
|  | ||||
|   | ||||
							
								
								
									
										2334
									
								
								src/core/ev.c
									
									
									
									
									
								
							
							
						
						
									
										2334
									
								
								src/core/ev.c
									
									
									
									
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							| @@ -1,55 +0,0 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 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. | ||||
| */ | ||||
|  | ||||
| /* Feature test macros */ | ||||
|  | ||||
| #ifndef JANET_FEATURES_H_defined | ||||
| #define JANET_FEATURES_H_defined | ||||
|  | ||||
| #if defined(__NetBSD__) || defined(__APPLE__) || defined(__OpenBSD__) \ | ||||
|     || defined(__bsdi__) || defined(__DragonFly__) | ||||
| /* Use BSD source on any BSD systems, include OSX */ | ||||
| # define _BSD_SOURCE | ||||
| #else | ||||
| /* Use POSIX feature flags */ | ||||
| # ifndef _POSIX_C_SOURCE | ||||
| # define _POSIX_C_SOURCE 200809L | ||||
| # endif | ||||
| #endif | ||||
|  | ||||
| #if defined(WIN32) || defined(_WIN32) | ||||
| #define WIN32_LEAN_AND_MEAN | ||||
| #endif | ||||
|  | ||||
| /* Needed for realpath on linux */ | ||||
| #if !defined(_XOPEN_SOURCE) && (defined(__linux__) || defined(__EMSCRIPTEN__)) | ||||
| #define _XOPEN_SOURCE 500 | ||||
| #endif | ||||
|  | ||||
| /* Needed for timegm and other extensions when building with -std=c99. | ||||
|  * It also defines realpath, etc, which would normally require | ||||
|  * _XOPEN_SOURCE >= 500. */ | ||||
| #if !defined(_NETBSD_SOURCE) && defined(__NetBSD__) | ||||
| #define _NETBSD_SOURCE | ||||
| #endif | ||||
|  | ||||
| #endif | ||||
							
								
								
									
										268
									
								
								src/core/fiber.c
									
									
									
									
									
								
							
							
						
						
									
										268
									
								
								src/core/fiber.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,7 +21,6 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "fiber.h" | ||||
| #include "state.h" | ||||
| @@ -35,14 +34,8 @@ static void fiber_reset(JanetFiber *fiber) { | ||||
|     fiber->stackstart = JANET_FRAME_SIZE; | ||||
|     fiber->stacktop = JANET_FRAME_SIZE; | ||||
|     fiber->child = NULL; | ||||
|     fiber->flags = JANET_FIBER_MASK_YIELD | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP; | ||||
|     fiber->flags = JANET_FIBER_MASK_YIELD; | ||||
|     fiber->env = NULL; | ||||
|     fiber->last_value = janet_wrap_nil(); | ||||
| #ifdef JANET_EV | ||||
|     fiber->waiting = NULL; | ||||
|     fiber->sched_id = 0; | ||||
|     fiber->supervisor_channel = NULL; | ||||
| #endif | ||||
|     janet_fiber_set_status(fiber, JANET_STATUS_NEW); | ||||
| } | ||||
|  | ||||
| @@ -53,11 +46,10 @@ static JanetFiber *fiber_alloc(int32_t capacity) { | ||||
|         capacity = 32; | ||||
|     } | ||||
|     fiber->capacity = capacity; | ||||
|     data = janet_malloc(sizeof(Janet) * (size_t) capacity); | ||||
|     data = malloc(sizeof(Janet) * capacity); | ||||
|     if (NULL == data) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
|     janet_vm_next_collection += sizeof(Janet) * capacity; | ||||
|     fiber->data = data; | ||||
|     return fiber; | ||||
| } | ||||
| @@ -71,22 +63,11 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t | ||||
|         if (newstacktop >= fiber->capacity) { | ||||
|             janet_fiber_setcapacity(fiber, 2 * newstacktop); | ||||
|         } | ||||
|         if (argv) { | ||||
|             memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet)); | ||||
|         } else { | ||||
|             /* If argv not given, fill with nil */ | ||||
|             for (int32_t i = 0; i < argc; i++) { | ||||
|                 fiber->data[fiber->stacktop + i] = janet_wrap_nil(); | ||||
|             } | ||||
|         } | ||||
|         memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet)); | ||||
|         fiber->stacktop = newstacktop; | ||||
|     } | ||||
|     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; | ||||
| } | ||||
|  | ||||
| @@ -95,56 +76,29 @@ JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, c | ||||
|     return janet_fiber_reset(fiber_alloc(capacity), callee, argc, argv); | ||||
| } | ||||
|  | ||||
| #ifdef JANET_DEBUG | ||||
| /* Test for memory issues by reallocating fiber every time we push a stack frame */ | ||||
| static void janet_fiber_refresh_memory(JanetFiber *fiber) { | ||||
|     int32_t n = fiber->capacity; | ||||
|     if (n) { | ||||
|         Janet *newData = janet_malloc(sizeof(Janet) * n); | ||||
|         if (NULL == newData) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|         memcpy(newData, fiber->data, fiber->capacity * sizeof(Janet)); | ||||
|         janet_free(fiber->data); | ||||
|         fiber->data = newData; | ||||
|     } | ||||
| } | ||||
| #endif | ||||
|  | ||||
| /* Ensure that the fiber has enough extra capacity */ | ||||
| void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) { | ||||
|     int32_t old_size = fiber->capacity; | ||||
|     int32_t diff = n - old_size; | ||||
|     Janet *newData = janet_realloc(fiber->data, sizeof(Janet) * n); | ||||
|     Janet *newData = realloc(fiber->data, sizeof(Janet) * n); | ||||
|     if (NULL == newData) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
|     fiber->data = newData; | ||||
|     fiber->capacity = n; | ||||
|     janet_vm_next_collection += sizeof(Janet) * diff; | ||||
| } | ||||
|  | ||||
| /* Grow fiber if needed */ | ||||
| static void janet_fiber_grow(JanetFiber *fiber, int32_t needed) { | ||||
|     int32_t cap = needed > (INT32_MAX / 2) ? INT32_MAX : 2 * needed; | ||||
|     janet_fiber_setcapacity(fiber, cap); | ||||
| } | ||||
|  | ||||
| /* Push a value on the next stack frame */ | ||||
| void janet_fiber_push(JanetFiber *fiber, Janet x) { | ||||
|     if (fiber->stacktop == INT32_MAX) janet_panic("stack overflow"); | ||||
|     if (fiber->stacktop >= fiber->capacity) { | ||||
|         janet_fiber_grow(fiber, fiber->stacktop); | ||||
|         janet_fiber_setcapacity(fiber, 2 * fiber->stacktop); | ||||
|     } | ||||
|     fiber->data[fiber->stacktop++] = x; | ||||
| } | ||||
|  | ||||
| /* Push 2 values on the next stack frame */ | ||||
| void janet_fiber_push2(JanetFiber *fiber, Janet x, Janet y) { | ||||
|     if (fiber->stacktop >= INT32_MAX - 1) janet_panic("stack overflow"); | ||||
|     int32_t newtop = fiber->stacktop + 2; | ||||
|     if (newtop > fiber->capacity) { | ||||
|         janet_fiber_grow(fiber, newtop); | ||||
|         janet_fiber_setcapacity(fiber, 2 * newtop); | ||||
|     } | ||||
|     fiber->data[fiber->stacktop] = x; | ||||
|     fiber->data[fiber->stacktop + 1] = y; | ||||
| @@ -153,10 +107,9 @@ void janet_fiber_push2(JanetFiber *fiber, Janet x, Janet y) { | ||||
|  | ||||
| /* Push 3 values on the next stack frame */ | ||||
| void janet_fiber_push3(JanetFiber *fiber, Janet x, Janet y, Janet z) { | ||||
|     if (fiber->stacktop >= INT32_MAX - 2) janet_panic("stack overflow"); | ||||
|     int32_t newtop = fiber->stacktop + 3; | ||||
|     if (newtop > fiber->capacity) { | ||||
|         janet_fiber_grow(fiber, newtop); | ||||
|         janet_fiber_setcapacity(fiber, 2 * newtop); | ||||
|     } | ||||
|     fiber->data[fiber->stacktop] = x; | ||||
|     fiber->data[fiber->stacktop + 1] = y; | ||||
| @@ -166,12 +119,11 @@ void janet_fiber_push3(JanetFiber *fiber, Janet x, Janet y, Janet z) { | ||||
|  | ||||
| /* Push an array on the next stack frame */ | ||||
| void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) { | ||||
|     if (fiber->stacktop > INT32_MAX - n) janet_panic("stack overflow"); | ||||
|     int32_t newtop = fiber->stacktop + n; | ||||
|     if (newtop > fiber->capacity) { | ||||
|         janet_fiber_grow(fiber, newtop); | ||||
|         janet_fiber_setcapacity(fiber, 2 * newtop); | ||||
|     } | ||||
|     safe_memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet)); | ||||
|     memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet)); | ||||
|     fiber->stacktop = newtop; | ||||
| } | ||||
|  | ||||
| @@ -202,10 +154,6 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) { | ||||
|  | ||||
|     if (fiber->capacity < nextstacktop) { | ||||
|         janet_fiber_setcapacity(fiber, 2 * nextstacktop); | ||||
| #ifdef JANET_DEBUG | ||||
|     } else { | ||||
|         janet_fiber_refresh_memory(fiber); | ||||
| #endif | ||||
|     } | ||||
|  | ||||
|     /* Nil unset stack arguments (Needed for gc correctness) */ | ||||
| @@ -251,79 +199,17 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) { | ||||
| static void janet_env_detach(JanetFuncEnv *env) { | ||||
|     /* Check for closure environment */ | ||||
|     if (env) { | ||||
|         janet_env_valid(env); | ||||
|         int32_t len = env->length; | ||||
|         size_t s = sizeof(Janet) * (size_t) len; | ||||
|         Janet *vmem = janet_malloc(s); | ||||
|         janet_vm_next_collection += (uint32_t) s; | ||||
|         size_t s = sizeof(Janet) * env->length; | ||||
|         Janet *vmem = malloc(s); | ||||
|         if (NULL == vmem) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|         Janet *values = env->as.fiber->data + env->offset; | ||||
|         safe_memcpy(vmem, values, s); | ||||
|         uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset; | ||||
|         if (bitset) { | ||||
|             /* Clear unneeded references in closure environment */ | ||||
|             for (int32_t i = 0; i < len; i += 32) { | ||||
|                 uint32_t mask = ~(bitset[i >> 5]); | ||||
|                 int32_t maxj = i + 32 > len ? len : i + 32; | ||||
|                 for (int32_t j = i; j < maxj; j++) { | ||||
|                     if (mask & 1) vmem[j] = janet_wrap_nil(); | ||||
|                     mask >>= 1; | ||||
|                 } | ||||
|             } | ||||
|         } | ||||
|         memcpy(vmem, env->as.fiber->data + env->offset, s); | ||||
|         env->offset = 0; | ||||
|         env->as.values = vmem; | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Validate potentially untrusted func env (unmarshalled envs are difficult to verify) */ | ||||
| int janet_env_valid(JanetFuncEnv *env) { | ||||
|     if (env->offset < 0) { | ||||
|         int32_t real_offset = -(env->offset); | ||||
|         JanetFiber *fiber = env->as.fiber; | ||||
|         int32_t i = fiber->frame; | ||||
|         while (i > 0) { | ||||
|             JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE); | ||||
|             if (real_offset == i && | ||||
|                     frame->env == env && | ||||
|                     frame->func && | ||||
|                     frame->func->def->slotcount == env->length) { | ||||
|                 env->offset = real_offset; | ||||
|                 return 1; | ||||
|             } | ||||
|             i = frame->prevframe; | ||||
|         } | ||||
|         /* Invalid, set to empty off-stack variant. */ | ||||
|         env->offset = 0; | ||||
|         env->length = 0; | ||||
|         env->as.values = NULL; | ||||
|         return 0; | ||||
|     } else { | ||||
|         return 1; | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Detach a fiber from the env if the target fiber has stopped mutating */ | ||||
| void janet_env_maybe_detach(JanetFuncEnv *env) { | ||||
|     /* Check for detachable closure envs */ | ||||
|     janet_env_valid(env); | ||||
|     if (env->offset > 0) { | ||||
|         JanetFiberStatus s = janet_fiber_status(env->as.fiber); | ||||
|         int isFinished = s == JANET_STATUS_DEAD || | ||||
|                          s == JANET_STATUS_ERROR || | ||||
|                          s == JANET_STATUS_USER0 || | ||||
|                          s == JANET_STATUS_USER1 || | ||||
|                          s == JANET_STATUS_USER2 || | ||||
|                          s == JANET_STATUS_USER3 || | ||||
|                          s == JANET_STATUS_USER4; | ||||
|         if (isFinished) { | ||||
|             janet_env_detach(env); | ||||
|         } | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Create a tail frame for a function */ | ||||
| int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) { | ||||
|     int32_t i; | ||||
| @@ -338,10 +224,6 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) { | ||||
|  | ||||
|     if (fiber->capacity < nextstacktop) { | ||||
|         janet_fiber_setcapacity(fiber, 2 * nextstacktop); | ||||
| #ifdef JANET_DEBUG | ||||
|     } else { | ||||
|         janet_fiber_refresh_memory(fiber); | ||||
| #endif | ||||
|     } | ||||
|  | ||||
|     Janet *stack = fiber->data + fiber->frame; | ||||
| @@ -404,10 +286,6 @@ void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) { | ||||
|  | ||||
|     if (fiber->capacity < nextstacktop) { | ||||
|         janet_fiber_setcapacity(fiber, 2 * nextstacktop); | ||||
| #ifdef JANET_DEBUG | ||||
|     } else { | ||||
|         janet_fiber_refresh_memory(fiber); | ||||
| #endif | ||||
|     } | ||||
|  | ||||
|     /* Set the next frame */ | ||||
| @@ -423,7 +301,8 @@ void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) { | ||||
|     newframe->flags = 0; | ||||
| } | ||||
|  | ||||
| /* Pop a stack frame from the fiber. */ | ||||
| /* Pop a stack frame from the fiber. Returns the new stack frame, or | ||||
|  * NULL if there are no more frames */ | ||||
| void janet_fiber_popframe(JanetFiber *fiber) { | ||||
|     JanetStackFrame *frame = janet_fiber_frame(fiber); | ||||
|     if (fiber->frame == 0) return; | ||||
| @@ -445,10 +324,6 @@ JanetFiber *janet_current_fiber(void) { | ||||
|     return janet_vm_fiber; | ||||
| } | ||||
|  | ||||
| JanetFiber *janet_root_fiber(void) { | ||||
|     return janet_vm_root_fiber; | ||||
| } | ||||
|  | ||||
| /* CFuns */ | ||||
|  | ||||
| static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) { | ||||
| @@ -474,14 +349,14 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     JanetFunction *func = janet_getfunction(argv, 0); | ||||
|     JanetFiber *fiber; | ||||
|     if (func->def->min_arity > 1) { | ||||
|         janet_panicf("fiber function must accept 0 or 1 arguments"); | ||||
|     if (func->def->min_arity != 0) { | ||||
|         janet_panic("expected nullary function in fiber constructor"); | ||||
|     } | ||||
|     fiber = janet_fiber(func, 64, func->def->min_arity, NULL); | ||||
|     fiber = janet_fiber(func, 64, 0, NULL); | ||||
|     if (argc == 2) { | ||||
|         int32_t i; | ||||
|         JanetByteView view = janet_getbytes(argv, 1); | ||||
|         fiber->flags = JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP; | ||||
|         fiber->flags = 0; | ||||
|         janet_fiber_set_status(fiber, JANET_STATUS_NEW); | ||||
|         for (i = 0; i < view.len; i++) { | ||||
|             if (view.bytes[i] >= '0' && view.bytes[i] <= '9') { | ||||
| @@ -489,7 +364,7 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) { | ||||
|             } else { | ||||
|                 switch (view.bytes[i]) { | ||||
|                     default: | ||||
|                         janet_panicf("invalid flag %c, expected a, t, d, e, u, y, i, or p", view.bytes[i]); | ||||
|                         janet_panicf("invalid flag %c, expected a, d, e, u, or y", view.bytes[i]); | ||||
|                         break; | ||||
|                     case 'a': | ||||
|                         fiber->flags |= | ||||
| @@ -498,15 +373,6 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) { | ||||
|                             JANET_FIBER_MASK_USER | | ||||
|                             JANET_FIBER_MASK_YIELD; | ||||
|                         break; | ||||
|                     case 't': | ||||
|                         fiber->flags |= | ||||
|                             JANET_FIBER_MASK_ERROR | | ||||
|                             JANET_FIBER_MASK_USER0 | | ||||
|                             JANET_FIBER_MASK_USER1 | | ||||
|                             JANET_FIBER_MASK_USER2 | | ||||
|                             JANET_FIBER_MASK_USER3 | | ||||
|                             JANET_FIBER_MASK_USER4; | ||||
|                         break; | ||||
|                     case 'd': | ||||
|                         fiber->flags |= JANET_FIBER_MASK_DEBUG; | ||||
|                         break; | ||||
| @@ -525,13 +391,6 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) { | ||||
|                         } | ||||
|                         fiber->env = janet_vm_fiber->env; | ||||
|                         break; | ||||
|                     case 'p': | ||||
|                         if (!janet_vm_fiber->env) { | ||||
|                             janet_vm_fiber->env = janet_table(0); | ||||
|                         } | ||||
|                         fiber->env = janet_table(0); | ||||
|                         fiber->env->proto = janet_vm_fiber->env; | ||||
|                         break; | ||||
|                 } | ||||
|             } | ||||
|         } | ||||
| @@ -552,12 +411,6 @@ static Janet cfun_fiber_current(int32_t argc, Janet *argv) { | ||||
|     return janet_wrap_fiber(janet_vm_fiber); | ||||
| } | ||||
|  | ||||
| static Janet cfun_fiber_root(int32_t argc, Janet *argv) { | ||||
|     (void) argv; | ||||
|     janet_fixarity(argc, 0); | ||||
|     return janet_wrap_fiber(janet_vm_root_fiber); | ||||
| } | ||||
|  | ||||
| static Janet cfun_fiber_maxstack(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetFiber *fiber = janet_getfiber(argv, 0); | ||||
| @@ -575,70 +428,37 @@ static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) { | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetFiber *fiber = janet_getfiber(argv, 0); | ||||
|     JanetFiberStatus s = janet_fiber_status(fiber); | ||||
|     int isFinished = s == JANET_STATUS_DEAD || | ||||
|                      s == JANET_STATUS_ERROR || | ||||
|                      s == JANET_STATUS_USER0 || | ||||
|                      s == JANET_STATUS_USER1 || | ||||
|                      s == JANET_STATUS_USER2 || | ||||
|                      s == JANET_STATUS_USER3 || | ||||
|                      s == JANET_STATUS_USER4; | ||||
|     return janet_wrap_boolean(!isFinished); | ||||
| } | ||||
|  | ||||
| static Janet cfun_fiber_last_value(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetFiber *fiber = janet_getfiber(argv, 0); | ||||
|     return fiber->last_value; | ||||
| } | ||||
|  | ||||
| static const JanetReg fiber_cfuns[] = { | ||||
|     { | ||||
|         "fiber/new", cfun_fiber_new, | ||||
|         JDOC("(fiber/new func &opt sigmask)\n\n" | ||||
|         JDOC("(fiber/new func [,sigmask])\n\n" | ||||
|              "Create a new fiber with function body func. Can optionally " | ||||
|              "take a set of signals to block from the current parent fiber " | ||||
|              "when called. The mask is specified as a keyword where each character " | ||||
|              "is used to indicate a signal to block. If the ev module is enabled, and " | ||||
|              "this fiber is used as an argument to `ev/go`, these \"blocked\" signals " | ||||
|              "will result in messages being sent to the supervisor channel. " | ||||
|              "The default sigmask is :y. " | ||||
|              "For example,\n\n" | ||||
|              "    (fiber/new myfun :e123)\n\n" | ||||
|              "is used to indicate a signal to block. The default sigmask is :y. " | ||||
|              "For example, \n\n" | ||||
|              "\t(fiber/new myfun :e123)\n\n" | ||||
|              "blocks error signals and user signals 1, 2 and 3. The signals are " | ||||
|              "as follows:\n\n" | ||||
|              "* :a - block all signals\n" | ||||
|              "* :d - block debug signals\n" | ||||
|              "* :e - block error signals\n" | ||||
|              "* :t - block termination signals: error + user[0-4]\n" | ||||
|              "* :u - block user signals\n" | ||||
|              "* :y - block yield signals\n" | ||||
|              "* :0-9 - block a specific user signal\n\n" | ||||
|              "The sigmask argument also can take environment flags. If any mutually " | ||||
|              "exclusive flags are present, the last flag takes precedence.\n\n" | ||||
|              "* :i - inherit the environment from the current fiber\n" | ||||
|              "* :p - the environment table's prototype is the current environment table") | ||||
|              "as follows: \n\n" | ||||
|              "\ta - block all signals\n" | ||||
|              "\td - block debug signals\n" | ||||
|              "\te - block error signals\n" | ||||
|              "\tu - block user signals\n" | ||||
|              "\ty - block yield signals\n" | ||||
|              "\t0-9 - block a specific user signal\n" | ||||
|              "\ti - inherit the environment from the current fiber (not related to signals)") | ||||
|     }, | ||||
|     { | ||||
|         "fiber/status", cfun_fiber_status, | ||||
|         JDOC("(fiber/status fib)\n\n" | ||||
|              "Get the status of a fiber. The status will be one of:\n\n" | ||||
|              "* :dead - the fiber has finished\n" | ||||
|              "* :error - the fiber has errored out\n" | ||||
|              "* :debug - the fiber is suspended in debug mode\n" | ||||
|              "* :pending - the fiber has been yielded\n" | ||||
|              "* :user(0-9) - the fiber is suspended by a user signal\n" | ||||
|              "* :alive - the fiber is currently running and cannot be resumed\n" | ||||
|              "* :new - the fiber has just been created and not yet run") | ||||
|     }, | ||||
|     { | ||||
|         "fiber/root", cfun_fiber_root, | ||||
|         JDOC("(fiber/root)\n\n" | ||||
|              "Returns the current root fiber. The root fiber is the oldest ancestor " | ||||
|              "that does not have a parent.") | ||||
|              "\t:dead - the fiber has finished\n" | ||||
|              "\t:error - the fiber has errored out\n" | ||||
|              "\t:debug - the fiber is suspended in debug mode\n" | ||||
|              "\t:pending - the fiber has been yielded\n" | ||||
|              "\t:user(0-9) - the fiber is suspended by a user signal\n" | ||||
|              "\t:alive - the fiber is currently running and cannot be resumed\n" | ||||
|              "\t:new - the fiber has just been created and not yet run") | ||||
|     }, | ||||
|     { | ||||
|         "fiber/current", cfun_fiber_current, | ||||
| @@ -670,16 +490,6 @@ static const JanetReg fiber_cfuns[] = { | ||||
|              "Sets the environment table for a fiber. Set to nil to remove the current " | ||||
|              "environment.") | ||||
|     }, | ||||
|     { | ||||
|         "fiber/can-resume?", cfun_fiber_can_resume, | ||||
|         JDOC("(fiber/can-resume? fiber)\n\n" | ||||
|              "Check if a fiber is finished and cannot be resumed.") | ||||
|     }, | ||||
|     { | ||||
|         "fiber/last-value", cfun_fiber_last_value, | ||||
|         JDOC("(fiber/last-value\n\n" | ||||
|              "Get the last value returned or signaled from the fiber.") | ||||
|     }, | ||||
|     {NULL, NULL, NULL} | ||||
| }; | ||||
|  | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -27,36 +27,6 @@ | ||||
| #include <janet.h> | ||||
| #endif | ||||
|  | ||||
| /* Fiber signal masks. */ | ||||
| #define JANET_FIBER_MASK_ERROR 2 | ||||
| #define JANET_FIBER_MASK_DEBUG 4 | ||||
| #define JANET_FIBER_MASK_YIELD 8 | ||||
|  | ||||
| #define JANET_FIBER_MASK_USER0 (16 << 0) | ||||
| #define JANET_FIBER_MASK_USER1 (16 << 1) | ||||
| #define JANET_FIBER_MASK_USER2 (16 << 2) | ||||
| #define JANET_FIBER_MASK_USER3 (16 << 3) | ||||
| #define JANET_FIBER_MASK_USER4 (16 << 4) | ||||
| #define JANET_FIBER_MASK_USER5 (16 << 5) | ||||
| #define JANET_FIBER_MASK_USER6 (16 << 6) | ||||
| #define JANET_FIBER_MASK_USER7 (16 << 7) | ||||
| #define JANET_FIBER_MASK_USER8 (16 << 8) | ||||
| #define JANET_FIBER_MASK_USER9 (16 << 9) | ||||
|  | ||||
| #define JANET_FIBER_MASK_USERN(N) (16 << (N)) | ||||
| #define JANET_FIBER_MASK_USER 0x3FF0 | ||||
|  | ||||
| #define JANET_FIBER_STATUS_MASK 0x3F0000 | ||||
| #define JANET_FIBER_FLAG_SCHEDULED 0x800000 | ||||
| #define JANET_FIBER_RESUME_SIGNAL 0x400000 | ||||
| #define JANET_FIBER_STATUS_OFFSET 16 | ||||
|  | ||||
| #define JANET_FIBER_BREAKPOINT       0x1000000 | ||||
| #define JANET_FIBER_RESUME_NO_USEVAL 0x2000000 | ||||
| #define JANET_FIBER_RESUME_NO_SKIP   0x4000000 | ||||
| #define JANET_FIBER_DID_LONGJUMP     0x8000000 | ||||
| #define JANET_FIBER_FLAG_MASK        0xF000000 | ||||
|  | ||||
| extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber; | ||||
|  | ||||
| #define janet_fiber_set_status(f, s) do {\ | ||||
| @@ -75,11 +45,5 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func); | ||||
| int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func); | ||||
| void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun); | ||||
| void janet_fiber_popframe(JanetFiber *fiber); | ||||
| void janet_env_maybe_detach(JanetFuncEnv *env); | ||||
| int janet_env_valid(JanetFuncEnv *env); | ||||
|  | ||||
| #ifdef JANET_EV | ||||
| void janet_fiber_did_resume(JanetFiber *fiber); | ||||
| #endif | ||||
|  | ||||
| #endif | ||||
|   | ||||
							
								
								
									
										198
									
								
								src/core/gc.c
									
									
									
									
									
								
							
							
						
						
									
										198
									
								
								src/core/gc.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,37 +21,23 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "state.h" | ||||
| #include "symcache.h" | ||||
| #include "gc.h" | ||||
| #include "util.h" | ||||
| #include "fiber.h" | ||||
| #include "vector.h" | ||||
| #endif | ||||
|  | ||||
| struct JanetScratch { | ||||
|     JanetScratchFinalizer finalize; | ||||
|     long long mem[]; /* for proper alignment */ | ||||
| }; | ||||
|  | ||||
| /* GC State */ | ||||
| JANET_THREAD_LOCAL void *janet_vm_blocks; | ||||
| JANET_THREAD_LOCAL size_t janet_vm_gc_interval; | ||||
| JANET_THREAD_LOCAL size_t janet_vm_next_collection; | ||||
| JANET_THREAD_LOCAL size_t janet_vm_block_count; | ||||
| JANET_THREAD_LOCAL uint32_t janet_vm_gc_interval; | ||||
| JANET_THREAD_LOCAL uint32_t janet_vm_next_collection; | ||||
| JANET_THREAD_LOCAL int janet_vm_gc_suspend = 0; | ||||
|  | ||||
| /* Roots */ | ||||
| JANET_THREAD_LOCAL Janet *janet_vm_roots; | ||||
| JANET_THREAD_LOCAL size_t janet_vm_root_count; | ||||
| JANET_THREAD_LOCAL size_t janet_vm_root_capacity; | ||||
|  | ||||
| /* Scratch Memory */ | ||||
| JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem; | ||||
| JANET_THREAD_LOCAL size_t janet_scratch_cap; | ||||
| JANET_THREAD_LOCAL size_t janet_scratch_len; | ||||
| JANET_THREAD_LOCAL uint32_t janet_vm_root_count; | ||||
| JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity; | ||||
|  | ||||
| /* Helpers for marking the various gc types */ | ||||
| static void janet_mark_funcenv(JanetFuncEnv *env); | ||||
| @@ -66,14 +52,9 @@ static void janet_mark_string(const uint8_t *str); | ||||
| static void janet_mark_fiber(JanetFiber *fiber); | ||||
| static void janet_mark_abstract(void *adata); | ||||
|  | ||||
| /* Local state that is only temporary for gc */ | ||||
| /* Local state that is only temporary */ | ||||
| static JANET_THREAD_LOCAL uint32_t depth = JANET_RECURSION_GUARD; | ||||
| static JANET_THREAD_LOCAL size_t orig_rootcount; | ||||
|  | ||||
| /* Hint to the GC that we may need to collect */ | ||||
| void janet_gcpressure(size_t s) { | ||||
|     janet_vm_next_collection += s; | ||||
| } | ||||
| static JANET_THREAD_LOCAL uint32_t orig_rootcount; | ||||
|  | ||||
| /* Mark a value */ | ||||
| void janet_mark(Janet x) { | ||||
| @@ -192,10 +173,7 @@ static void janet_mark_funcenv(JanetFuncEnv *env) { | ||||
|     if (janet_gc_reachable(env)) | ||||
|         return; | ||||
|     janet_gc_mark(env); | ||||
|     /* If closure env references a dead fiber, we can just copy out the stack frame we need so | ||||
|      * we don't need to keep around the whole dead fiber. */ | ||||
|     janet_env_maybe_detach(env); | ||||
|     if (env->offset > 0) { | ||||
|     if (env->offset) { | ||||
|         /* On stack */ | ||||
|         janet_mark_fiber(env->as.fiber); | ||||
|     } else { | ||||
| @@ -226,14 +204,11 @@ static void janet_mark_function(JanetFunction *func) { | ||||
|     if (janet_gc_reachable(func)) | ||||
|         return; | ||||
|     janet_gc_mark(func); | ||||
|     if (NULL != func->def) { | ||||
|         /* this should always be true, except if function is only partially constructed */ | ||||
|         numenvs = func->def->environments_length; | ||||
|         for (i = 0; i < numenvs; ++i) { | ||||
|             janet_mark_funcenv(func->envs[i]); | ||||
|         } | ||||
|         janet_mark_funcdef(func->def); | ||||
|     numenvs = func->def->environments_length; | ||||
|     for (i = 0; i < numenvs; ++i) { | ||||
|         janet_mark_funcenv(func->envs[i]); | ||||
|     } | ||||
|     janet_mark_funcdef(func->def); | ||||
| } | ||||
|  | ||||
| static void janet_mark_fiber(JanetFiber *fiber) { | ||||
| @@ -244,8 +219,6 @@ recur: | ||||
|         return; | ||||
|     janet_gc_mark(fiber); | ||||
|  | ||||
|     janet_mark(fiber->last_value); | ||||
|  | ||||
|     /* Mark values on the argument stack */ | ||||
|     janet_mark_many(fiber->data + fiber->stackstart, | ||||
|                     fiber->stacktop - fiber->stackstart); | ||||
| @@ -267,12 +240,6 @@ recur: | ||||
|     if (fiber->env) | ||||
|         janet_mark_table(fiber->env); | ||||
|  | ||||
| #ifdef JANET_EV | ||||
|     if (fiber->supervisor_channel) { | ||||
|         janet_mark_abstract(fiber->supervisor_channel); | ||||
|     } | ||||
| #endif | ||||
|  | ||||
|     /* Explicit tail recursion */ | ||||
|     if (fiber->child) { | ||||
|         fiber = fiber->child; | ||||
| @@ -290,13 +257,13 @@ static void janet_deinit_block(JanetGCObject *mem) { | ||||
|             janet_symbol_deinit(((JanetStringHead *) mem)->data); | ||||
|             break; | ||||
|         case JANET_MEMORY_ARRAY: | ||||
|             janet_free(((JanetArray *) mem)->data); | ||||
|             janet_array_deinit((JanetArray *) mem); | ||||
|             break; | ||||
|         case JANET_MEMORY_TABLE: | ||||
|             janet_free(((JanetTable *) mem)->data); | ||||
|             janet_table_deinit((JanetTable *) mem); | ||||
|             break; | ||||
|         case JANET_MEMORY_FIBER: | ||||
|             janet_free(((JanetFiber *)mem)->data); | ||||
|             free(((JanetFiber *)mem)->data); | ||||
|             break; | ||||
|         case JANET_MEMORY_BUFFER: | ||||
|             janet_buffer_deinit((JanetBuffer *) mem); | ||||
| @@ -311,18 +278,17 @@ static void janet_deinit_block(JanetGCObject *mem) { | ||||
|         case JANET_MEMORY_FUNCENV: { | ||||
|             JanetFuncEnv *env = (JanetFuncEnv *)mem; | ||||
|             if (0 == env->offset) | ||||
|                 janet_free(env->as.values); | ||||
|                 free(env->as.values); | ||||
|         } | ||||
|         break; | ||||
|         case JANET_MEMORY_FUNCDEF: { | ||||
|             JanetFuncDef *def = (JanetFuncDef *)mem; | ||||
|             /* TODO - get this all with one alloc and one free */ | ||||
|             janet_free(def->defs); | ||||
|             janet_free(def->environments); | ||||
|             janet_free(def->constants); | ||||
|             janet_free(def->bytecode); | ||||
|             janet_free(def->sourcemap); | ||||
|             janet_free(def->closure_bitset); | ||||
|             free(def->defs); | ||||
|             free(def->environments); | ||||
|             free(def->constants); | ||||
|             free(def->bytecode); | ||||
|             free(def->sourcemap); | ||||
|         } | ||||
|         break; | ||||
|     } | ||||
| @@ -340,14 +306,13 @@ void janet_sweep() { | ||||
|             previous = current; | ||||
|             current->flags &= ~JANET_MEM_REACHABLE; | ||||
|         } else { | ||||
|             janet_vm_block_count--; | ||||
|             janet_deinit_block(current); | ||||
|             if (NULL != previous) { | ||||
|                 previous->next = next; | ||||
|             } else { | ||||
|                 janet_vm_blocks = next; | ||||
|             } | ||||
|             janet_free(current); | ||||
|             free(current); | ||||
|         } | ||||
|         current = next; | ||||
|     } | ||||
| @@ -359,7 +324,7 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) { | ||||
|  | ||||
|     /* Make sure everything is inited */ | ||||
|     janet_assert(NULL != janet_vm_cache, "please initialize janet before use"); | ||||
|     mem = janet_malloc(size); | ||||
|     mem = malloc(size); | ||||
|  | ||||
|     /* Check for bad malloc */ | ||||
|     if (NULL == mem) { | ||||
| @@ -370,52 +335,19 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) { | ||||
|     mem->flags = type; | ||||
|  | ||||
|     /* Prepend block to heap list */ | ||||
|     janet_vm_next_collection += size; | ||||
|     janet_vm_next_collection += (int32_t) size; | ||||
|     mem->next = janet_vm_blocks; | ||||
|     janet_vm_blocks = mem; | ||||
|     janet_vm_block_count++; | ||||
|  | ||||
|     return (void *)mem; | ||||
| } | ||||
|  | ||||
| static void free_one_scratch(JanetScratch *s) { | ||||
|     if (NULL != s->finalize) { | ||||
|         s->finalize((char *) s->mem); | ||||
|     } | ||||
|     janet_free(s); | ||||
| } | ||||
|  | ||||
| /* Free all allocated scratch memory */ | ||||
| static void janet_free_all_scratch(void) { | ||||
|     for (size_t i = 0; i < janet_scratch_len; i++) { | ||||
|         free_one_scratch(janet_scratch_mem[i]); | ||||
|     } | ||||
|     janet_scratch_len = 0; | ||||
| } | ||||
|  | ||||
| static JanetScratch *janet_mem2scratch(void *mem) { | ||||
|     JanetScratch *s = (JanetScratch *)mem; | ||||
|     return s - 1; | ||||
| } | ||||
|  | ||||
| /* Run garbage collection */ | ||||
| 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. | ||||
|      * 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 | ||||
|      * heuristic for automatically changing the gc interval */ | ||||
|     if (janet_vm_block_count * 8 > janet_vm_gc_interval) { | ||||
|         janet_vm_gc_interval = janet_vm_block_count * sizeof(JanetGCObject); | ||||
|     } | ||||
|     orig_rootcount = janet_vm_root_count; | ||||
| #ifdef JANET_EV | ||||
|     janet_ev_mark(); | ||||
| #endif | ||||
|     janet_mark_fiber(janet_vm_root_fiber); | ||||
|     for (i = 0; i < orig_rootcount; i++) | ||||
|         janet_mark(janet_vm_roots[i]); | ||||
|     while (orig_rootcount < janet_vm_root_count) { | ||||
| @@ -424,17 +356,16 @@ void janet_collect(void) { | ||||
|     } | ||||
|     janet_sweep(); | ||||
|     janet_vm_next_collection = 0; | ||||
|     janet_free_all_scratch(); | ||||
| } | ||||
|  | ||||
| /* Add a root value to the GC. This prevents the GC from removing a value | ||||
|  * and all of its children. If gcroot is called on a value n times, unroot | ||||
|  * must also be called n times to remove it as a gc root. */ | ||||
| void janet_gcroot(Janet root) { | ||||
|     size_t newcount = janet_vm_root_count + 1; | ||||
|     uint32_t newcount = janet_vm_root_count + 1; | ||||
|     if (newcount > janet_vm_root_capacity) { | ||||
|         size_t newcap = 2 * newcount; | ||||
|         janet_vm_roots = janet_realloc(janet_vm_roots, sizeof(Janet) * newcap); | ||||
|         uint32_t newcap = 2 * newcount; | ||||
|         janet_vm_roots = realloc(janet_vm_roots, sizeof(Janet) * newcap); | ||||
|         if (NULL == janet_vm_roots) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
| @@ -494,12 +425,10 @@ void janet_clear_memory(void) { | ||||
|     while (NULL != current) { | ||||
|         janet_deinit_block(current); | ||||
|         JanetGCObject *next = current->next; | ||||
|         janet_free(current); | ||||
|         free(current); | ||||
|         current = next; | ||||
|     } | ||||
|     janet_vm_blocks = NULL; | ||||
|     janet_free_all_scratch(); | ||||
|     janet_free(janet_scratch_mem); | ||||
| } | ||||
|  | ||||
| /* Primitives for suspending GC. */ | ||||
| @@ -509,74 +438,3 @@ int janet_gclock(void) { | ||||
| void janet_gcunlock(int handle) { | ||||
|     janet_vm_gc_suspend = handle; | ||||
| } | ||||
|  | ||||
| /* Scratch memory API */ | ||||
|  | ||||
| void *janet_smalloc(size_t size) { | ||||
|     JanetScratch *s = janet_malloc(sizeof(JanetScratch) + size); | ||||
|     if (NULL == s) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
|     s->finalize = NULL; | ||||
|     if (janet_scratch_len == janet_scratch_cap) { | ||||
|         size_t newcap = 2 * janet_scratch_cap + 2; | ||||
|         JanetScratch **newmem = (JanetScratch **) janet_realloc(janet_scratch_mem, newcap * sizeof(JanetScratch)); | ||||
|         if (NULL == newmem) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|         janet_scratch_cap = newcap; | ||||
|         janet_scratch_mem = newmem; | ||||
|     } | ||||
|     janet_scratch_mem[janet_scratch_len++] = s; | ||||
|     return (char *)(s->mem); | ||||
| } | ||||
|  | ||||
| void *janet_scalloc(size_t nmemb, size_t size) { | ||||
|     if (nmemb && size > SIZE_MAX / nmemb) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
|     size_t n = nmemb * size; | ||||
|     void *p = janet_smalloc(n); | ||||
|     memset(p, 0, n); | ||||
|     return p; | ||||
| } | ||||
|  | ||||
| void *janet_srealloc(void *mem, size_t size) { | ||||
|     if (NULL == mem) return janet_smalloc(size); | ||||
|     JanetScratch *s = janet_mem2scratch(mem); | ||||
|     if (janet_scratch_len) { | ||||
|         for (size_t i = janet_scratch_len - 1; ; i--) { | ||||
|             if (janet_scratch_mem[i] == s) { | ||||
|                 JanetScratch *news = janet_realloc(s, size + sizeof(JanetScratch)); | ||||
|                 if (NULL == news) { | ||||
|                     JANET_OUT_OF_MEMORY; | ||||
|                 } | ||||
|                 janet_scratch_mem[i] = news; | ||||
|                 return (char *)(news->mem); | ||||
|             } | ||||
|             if (i == 0) break; | ||||
|         } | ||||
|     } | ||||
|     JANET_EXIT("invalid janet_srealloc"); | ||||
| } | ||||
|  | ||||
| void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer) { | ||||
|     JanetScratch *s = janet_mem2scratch(mem); | ||||
|     s->finalize = finalizer; | ||||
| } | ||||
|  | ||||
| void janet_sfree(void *mem) { | ||||
|     if (NULL == mem) return; | ||||
|     JanetScratch *s = janet_mem2scratch(mem); | ||||
|     if (janet_scratch_len) { | ||||
|         for (size_t i = janet_scratch_len - 1; ; i--) { | ||||
|             if (janet_scratch_mem[i] == s) { | ||||
|                 janet_scratch_mem[i] = janet_scratch_mem[--janet_scratch_len]; | ||||
|                 free_one_scratch(s); | ||||
|                 return; | ||||
|             } | ||||
|             if (i == 0) break; | ||||
|         } | ||||
|     } | ||||
|     JANET_EXIT("invalid janet_sfree"); | ||||
| } | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -24,7 +24,6 @@ | ||||
| #define JANET_GC_H | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #endif | ||||
|  | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose & contributors | ||||
| * Copyright (c) 2019 Calvin Rose & contributors | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -20,70 +20,46 @@ | ||||
| * IN THE SOFTWARE. | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "util.h" | ||||
| #endif | ||||
|  | ||||
| #include <errno.h> | ||||
| #include <stdlib.h> | ||||
| #include <limits.h> | ||||
| #include <inttypes.h> | ||||
| #include <math.h> | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include <janet.h> | ||||
| #include "util.h" | ||||
| #endif | ||||
|  | ||||
| /* Conditional compilation */ | ||||
| #ifdef JANET_INT_TYPES | ||||
|  | ||||
| #define MAX_INT_IN_DBL 9007199254740992ULL /* 2^53 */ | ||||
|  | ||||
| static int it_s64_get(void *p, Janet key, Janet *out); | ||||
| static int it_u64_get(void *p, Janet key, Janet *out); | ||||
| static Janet janet_int64_next(void *p, Janet key); | ||||
| static Janet janet_uint64_next(void *p, Janet key); | ||||
|  | ||||
| static int32_t janet_int64_hash(void *p1, size_t size) { | ||||
|     (void) size; | ||||
|     int32_t *words = p1; | ||||
|     return words[0] ^ words[1]; | ||||
| } | ||||
|  | ||||
| static int janet_int64_compare(void *p1, void *p2) { | ||||
|     int64_t x = *((int64_t *)p1); | ||||
|     int64_t y = *((int64_t *)p2); | ||||
|     return x == y ? 0 : x < y ? -1 : 1; | ||||
| } | ||||
|  | ||||
| static int janet_uint64_compare(void *p1, void *p2) { | ||||
|     uint64_t x = *((uint64_t *)p1); | ||||
|     uint64_t y = *((uint64_t *)p2); | ||||
|     return x == y ? 0 : x < y ? -1 : 1; | ||||
| } | ||||
| static Janet it_s64_get(void *p, Janet key); | ||||
| static Janet it_u64_get(void *p, Janet key); | ||||
|  | ||||
| static void int64_marshal(void *p, JanetMarshalContext *ctx) { | ||||
|     janet_marshal_abstract(ctx, p); | ||||
|     janet_marshal_int64(ctx, *((int64_t *)p)); | ||||
| } | ||||
|  | ||||
| static void *int64_unmarshal(JanetMarshalContext *ctx) { | ||||
|     int64_t *p = janet_unmarshal_abstract(ctx, sizeof(int64_t)); | ||||
|     p[0] = janet_unmarshal_int64(ctx); | ||||
|     return p; | ||||
| static void int64_unmarshal(void *p, JanetMarshalContext *ctx) { | ||||
|     *((int64_t *)p) = janet_unmarshal_int64(ctx); | ||||
| } | ||||
|  | ||||
| static void it_s64_tostring(void *p, JanetBuffer *buffer) { | ||||
|     char str[32]; | ||||
|     sprintf(str, "%" PRId64, *((int64_t *)p)); | ||||
|     sprintf(str, "<core/s64 %" 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)); | ||||
|     sprintf(str, "<core/u64 %" PRIu64 ">", *((uint64_t *)p)); | ||||
|     janet_buffer_push_cstring(buffer, str); | ||||
| } | ||||
|  | ||||
| const JanetAbstractType janet_s64_type = { | ||||
| static const JanetAbstractType it_s64_type = { | ||||
|     "core/s64", | ||||
|     NULL, | ||||
|     NULL, | ||||
| @@ -91,14 +67,10 @@ const JanetAbstractType janet_s64_type = { | ||||
|     NULL, | ||||
|     int64_marshal, | ||||
|     int64_unmarshal, | ||||
|     it_s64_tostring, | ||||
|     janet_int64_compare, | ||||
|     janet_int64_hash, | ||||
|     janet_int64_next, | ||||
|     JANET_ATEND_NEXT | ||||
|     it_s64_tostring | ||||
| }; | ||||
|  | ||||
| const JanetAbstractType janet_u64_type = { | ||||
| static const JanetAbstractType it_u64_type = { | ||||
|     "core/u64", | ||||
|     NULL, | ||||
|     NULL, | ||||
| @@ -106,11 +78,7 @@ const JanetAbstractType janet_u64_type = { | ||||
|     NULL, | ||||
|     int64_marshal, | ||||
|     int64_unmarshal, | ||||
|     it_u64_tostring, | ||||
|     janet_uint64_compare, | ||||
|     janet_int64_hash, | ||||
|     janet_uint64_next, | ||||
|     JANET_ATEND_NEXT | ||||
|     it_u64_tostring | ||||
| }; | ||||
|  | ||||
| int64_t janet_unwrap_s64(Janet x) { | ||||
| @@ -132,13 +100,13 @@ int64_t janet_unwrap_s64(Janet x) { | ||||
|         } | ||||
|         case JANET_ABSTRACT: { | ||||
|             void *abst = janet_unwrap_abstract(x); | ||||
|             if (janet_abstract_type(abst) == &janet_s64_type || | ||||
|                     (janet_abstract_type(abst) == &janet_u64_type)) | ||||
|             if (janet_abstract_type(abst) == &it_s64_type || | ||||
|                     (janet_abstract_type(abst) == &it_u64_type)) | ||||
|                 return *(int64_t *)abst; | ||||
|             break; | ||||
|         } | ||||
|     } | ||||
|     janet_panicf("bad s64 initializer: %t", x); | ||||
|     janet_panic("bad s64 initializer"); | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| @@ -148,9 +116,7 @@ uint64_t janet_unwrap_u64(Janet x) { | ||||
|             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) | ||||
|             if ((dbl >= 0) && (dbl <= MAX_INT_IN_DBL)) | ||||
|                 return (uint64_t)dbl; | ||||
|             break; | ||||
|         } | ||||
| @@ -163,32 +129,32 @@ uint64_t janet_unwrap_u64(Janet x) { | ||||
|         } | ||||
|         case JANET_ABSTRACT: { | ||||
|             void *abst = janet_unwrap_abstract(x); | ||||
|             if (janet_abstract_type(abst) == &janet_s64_type || | ||||
|                     (janet_abstract_type(abst) == &janet_u64_type)) | ||||
|             if (janet_abstract_type(abst) == &it_s64_type || | ||||
|                     (janet_abstract_type(abst) == &it_u64_type)) | ||||
|                 return *(uint64_t *)abst; | ||||
|             break; | ||||
|         } | ||||
|     } | ||||
|     janet_panicf("bad u64 initializer: %t", x); | ||||
|     janet_panic("bad u64 initializer"); | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| JanetIntType janet_is_int(Janet x) { | ||||
|     if (!janet_checktype(x, JANET_ABSTRACT)) return JANET_INT_NONE; | ||||
|     const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x)); | ||||
|     return (at == &janet_s64_type) ? JANET_INT_S64 : | ||||
|            ((at == &janet_u64_type) ? JANET_INT_U64 : | ||||
|     return (at == &it_s64_type) ? JANET_INT_S64 : | ||||
|            ((at == &it_u64_type) ? JANET_INT_U64 : | ||||
|             JANET_INT_NONE); | ||||
| } | ||||
|  | ||||
| Janet janet_wrap_s64(int64_t x) { | ||||
|     int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); | ||||
|     int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t)); | ||||
|     *box = (int64_t)x; | ||||
|     return janet_wrap_abstract(box); | ||||
| } | ||||
|  | ||||
| Janet janet_wrap_u64(uint64_t x) { | ||||
|     uint64_t *box = janet_abstract(&janet_u64_type, sizeof(uint64_t)); | ||||
|     uint64_t *box = janet_abstract(&it_u64_type, sizeof(uint64_t)); | ||||
|     *box = (uint64_t)x; | ||||
|     return janet_wrap_abstract(box); | ||||
| } | ||||
| @@ -203,169 +169,54 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) { | ||||
|     return janet_wrap_u64(janet_unwrap_u64(argv[0])); | ||||
| } | ||||
|  | ||||
| /* | ||||
|  * Code to support polymorphic comparison. | ||||
|  * int/u64 and int/s64 support a "compare" method that allows | ||||
|  * comparison to each other, and to Janet numbers, using the | ||||
|  * "compare" "compare<" ... functions. | ||||
|  * In the following code explicit casts are sometimes used to help | ||||
|  * make it clear when int/float conversions are happening. | ||||
|  */ | ||||
| static int compare_double_double(double x, double y) { | ||||
|     return (x < y) ? -1 : ((x > y) ? 1 : 0); | ||||
| } | ||||
|  | ||||
| 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))) { | ||||
|         double dx = (double) x; | ||||
|         return compare_double_double(dx, y); | ||||
|     } else if (y > ((double) INT64_MAX)) { | ||||
|         return -1; | ||||
|     } else if (y < ((double) INT64_MIN)) { | ||||
|         return 1; | ||||
|     } else { | ||||
|         int64_t yi = (int64_t) y; | ||||
|         return (x < yi) ? -1 : ((x > yi) ? 1 : 0); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static int compare_uint64_double(uint64_t x, double y) { | ||||
|     if (isnan(y)) { | ||||
|         return 0; // clojure and python do this | ||||
|     } else if (y < 0) { | ||||
|         return 1; | ||||
|     } else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) { | ||||
|         double dx = (double) x; | ||||
|         return compare_double_double(dx, y); | ||||
|     } else if (y > ((double) UINT64_MAX)) { | ||||
|         return -1; | ||||
|     } else { | ||||
|         uint64_t yi = (uint64_t) y; | ||||
|         return (x < yi) ? -1 : ((x > yi) ? 1 : 0); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 2); | ||||
|     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: | ||||
|             break; | ||||
|         case JANET_NUMBER : { | ||||
|             double y = janet_unwrap_number(argv[1]); | ||||
|             return janet_wrap_number(compare_int64_double(x, y)); | ||||
|         } | ||||
|         case JANET_ABSTRACT: { | ||||
|             void *abst = janet_unwrap_abstract(argv[1]); | ||||
|             if (janet_abstract_type(abst) == &janet_s64_type) { | ||||
|                 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); | ||||
|                 } else if (y > INT64_MAX) { | ||||
|                     return janet_wrap_number(-1); | ||||
|                 } else { | ||||
|                     int64_t y2 = (int64_t) y; | ||||
|                     return janet_wrap_number((x < y2) ? -1 : (x > y2 ? 1 : 0)); | ||||
|                 } | ||||
|             } | ||||
|             break; | ||||
|         } | ||||
|     } | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| 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? | ||||
|         janet_panic("compare method requires int/u64 as first argument"); | ||||
|     uint64_t x = janet_unwrap_u64(argv[0]); | ||||
|     switch (janet_type(argv[1])) { | ||||
|         default: | ||||
|             break; | ||||
|         case JANET_NUMBER : { | ||||
|             double y = janet_unwrap_number(argv[1]); | ||||
|             return janet_wrap_number(compare_uint64_double(x, y)); | ||||
|         } | ||||
|         case JANET_ABSTRACT: { | ||||
|             void *abst = janet_unwrap_abstract(argv[1]); | ||||
|             if (janet_abstract_type(abst) == &janet_u64_type) { | ||||
|                 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); | ||||
|                 } else if (x > INT64_MAX) { | ||||
|                     return janet_wrap_number(1); | ||||
|                 } else { | ||||
|                     int64_t x2 = (int64_t) x; | ||||
|                     return janet_wrap_number((x2 < y) ? -1 : (x2 > y ? 1 : 0)); | ||||
|                 } | ||||
|             } | ||||
|             break; | ||||
|         } | ||||
|     } | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| #define OPMETHOD(T, type, name, oper) \ | ||||
| static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ | ||||
|     janet_arity(argc, 2, -1); \ | ||||
|     T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ | ||||
|     T *box = janet_abstract(&it_##type##_type, sizeof(T)); \ | ||||
|     *box = janet_unwrap_##type(argv[0]); \ | ||||
|     for (int32_t i = 1; i < argc; i++) \ | ||||
|     for (int i = 1; i < argc; i++) \ | ||||
|         *box oper##= janet_unwrap_##type(argv[i]); \ | ||||
|     return janet_wrap_abstract(box); \ | ||||
| } \ | ||||
|  | ||||
| #define OPMETHODINVERT(T, type, name, oper) \ | ||||
| static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ | ||||
|     janet_fixarity(argc, 2); \ | ||||
|     T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ | ||||
|     *box = janet_unwrap_##type(argv[1]); \ | ||||
|     *box oper##= janet_unwrap_##type(argv[0]); \ | ||||
|  \ | ||||
| static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \ | ||||
|     janet_arity(argc, 2, -1); \ | ||||
|     T *box = janet_getabstract(argv,0,&it_##type##_type); \ | ||||
|     for (int i = 1; i < argc; i++) \ | ||||
|         *box oper##= janet_unwrap_##type(argv[i]); \ | ||||
|     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);                       \ | ||||
|     T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ | ||||
|     T *box = janet_abstract(&it_##type##_type, sizeof(T)); \ | ||||
|     *box = janet_unwrap_##type(argv[0]); \ | ||||
|     for (int32_t i = 1; i < argc; i++) { \ | ||||
|     for (int i = 1; i < argc; i++) { \ | ||||
|       T value = janet_unwrap_##type(argv[i]); \ | ||||
|       if (value == 0) janet_panic("division by zero"); \ | ||||
|       *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) { \ | ||||
|     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"); \ | ||||
|     *box oper##= value; \ | ||||
|  \ | ||||
| static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \ | ||||
|     janet_arity(argc, 2, -1); \ | ||||
|     T *box = janet_getabstract(argv,0,&it_##type##_type); \ | ||||
|     for (int i = 1; i < argc; i++) { \ | ||||
|       T value =  janet_unwrap_##type(argv[i]); \ | ||||
|       if (value == 0) janet_panic("division by zero"); \ | ||||
|       *box oper##= value; \ | ||||
|     } \ | ||||
|     return janet_wrap_abstract(box); \ | ||||
| } \ | ||||
| } | ||||
|  | ||||
| #define DIVMETHOD_SIGNED(T, type, name, oper) \ | ||||
| static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ | ||||
|     janet_arity(argc, 2, -1);                       \ | ||||
|     T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ | ||||
|     T *box = janet_abstract(&it_##type##_type, sizeof(T)); \ | ||||
|     *box = janet_unwrap_##type(argv[0]); \ | ||||
|     for (int32_t i = 1; i < argc; i++) { \ | ||||
|     for (int i = 1; i < argc; i++) { \ | ||||
|       T value = janet_unwrap_##type(argv[i]); \ | ||||
|       if (value == 0) janet_panic("division by zero"); \ | ||||
|       if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \ | ||||
| @@ -373,136 +224,142 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ | ||||
|     } \ | ||||
|     return janet_wrap_abstract(box); \ | ||||
| } \ | ||||
|  | ||||
| #define DIVMETHODINVERT_SIGNED(T, type, name, oper) \ | ||||
| static Janet cfun_it_##type##_##name(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 == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \ | ||||
|     *box oper##= value; \ | ||||
|  \ | ||||
| static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \ | ||||
|     janet_arity(argc, 2, -1); \ | ||||
|     T *box = janet_getabstract(argv,0,&it_##type##_type); \ | ||||
|     for (int i = 1; i < argc; i++) { \ | ||||
|       T value = janet_unwrap_##type(argv[i]); \ | ||||
|       if (value == 0) janet_panic("division by zero"); \ | ||||
|       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_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); | ||||
|     return janet_wrap_abstract(box); | ||||
| #define COMPMETHOD(T, type, name, oper) \ | ||||
| static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ | ||||
|     janet_fixarity(argc, 2); \ | ||||
|     T v1 = janet_unwrap_##type(argv[0]); \ | ||||
|     T v2 = janet_unwrap_##type(argv[1]); \ | ||||
|     return janet_wrap_boolean(v1 oper v2); \ | ||||
| } | ||||
|  | ||||
| OPMETHOD(int64_t, s64, add, +) | ||||
| OPMETHOD(int64_t, s64, sub, -) | ||||
| OPMETHODINVERT(int64_t, s64, subi, -) | ||||
| OPMETHOD(int64_t, s64, mul, *) | ||||
| DIVMETHOD_SIGNED(int64_t, s64, div, /) | ||||
| DIVMETHOD_SIGNED(int64_t, s64, rem, %) | ||||
| DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /) | ||||
| DIVMETHOD_SIGNED(int64_t, s64, mod, %) | ||||
| OPMETHOD(int64_t, s64, and, &) | ||||
| OPMETHOD(int64_t, s64, or, |) | ||||
| OPMETHOD(int64_t, s64, xor, ^) | ||||
| OPMETHOD(int64_t, s64, lshift, <<) | ||||
| OPMETHOD(int64_t, s64, rshift, >>) | ||||
| COMPMETHOD(int64_t, s64, lt, <) | ||||
| COMPMETHOD(int64_t, s64, gt, >) | ||||
| COMPMETHOD(int64_t, s64, le, <=) | ||||
| COMPMETHOD(int64_t, s64, ge, >=) | ||||
| COMPMETHOD(int64_t, s64, eq, ==) | ||||
| COMPMETHOD(int64_t, s64, ne, !=) | ||||
|  | ||||
| OPMETHOD(uint64_t, u64, add, +) | ||||
| OPMETHOD(uint64_t, u64, sub, -) | ||||
| OPMETHODINVERT(uint64_t, u64, subi, -) | ||||
| OPMETHOD(uint64_t, u64, mul, *) | ||||
| DIVMETHOD(uint64_t, u64, div, /) | ||||
| DIVMETHOD(uint64_t, u64, mod, %) | ||||
| DIVMETHODINVERT(uint64_t, u64, divi, /) | ||||
| OPMETHOD(uint64_t, u64, and, &) | ||||
| OPMETHOD(uint64_t, u64, or, |) | ||||
| OPMETHOD(uint64_t, u64, xor, ^) | ||||
| OPMETHOD(uint64_t, u64, lshift, <<) | ||||
| OPMETHOD(uint64_t, u64, rshift, >>) | ||||
| COMPMETHOD(uint64_t, u64, lt, <) | ||||
| COMPMETHOD(uint64_t, u64, gt, >) | ||||
| COMPMETHOD(uint64_t, u64, le, <=) | ||||
| COMPMETHOD(uint64_t, u64, ge, >=) | ||||
| COMPMETHOD(uint64_t, u64, eq, ==) | ||||
| COMPMETHOD(uint64_t, u64, ne, !=) | ||||
|  | ||||
| #undef OPMETHOD | ||||
| #undef DIVMETHOD | ||||
| #undef DIVMETHOD_SIGNED | ||||
| #undef COMPMETHOD | ||||
|  | ||||
|  | ||||
| static JanetMethod it_s64_methods[] = { | ||||
|     {"+", cfun_it_s64_add}, | ||||
|     {"r+", cfun_it_s64_add}, | ||||
|     {"-", cfun_it_s64_sub}, | ||||
|     {"r-", cfun_it_s64_subi}, | ||||
|     {"*", cfun_it_s64_mul}, | ||||
|     {"r*", cfun_it_s64_mul}, | ||||
|     {"/", cfun_it_s64_div}, | ||||
|     {"r/", cfun_it_s64_divi}, | ||||
|     {"mod", cfun_it_s64_mod}, | ||||
|     {"rmod", cfun_it_s64_mod}, | ||||
|     {"%", cfun_it_s64_rem}, | ||||
|     {"r%", cfun_it_s64_rem}, | ||||
|     {"%", cfun_it_s64_mod}, | ||||
|     {"<", cfun_it_s64_lt}, | ||||
|     {">", cfun_it_s64_gt}, | ||||
|     {"<=", cfun_it_s64_le}, | ||||
|     {">=", cfun_it_s64_ge}, | ||||
|     {"==", cfun_it_s64_eq}, | ||||
|     {"!=", cfun_it_s64_ne}, | ||||
|     {"&", cfun_it_s64_and}, | ||||
|     {"r&", cfun_it_s64_and}, | ||||
|     {"|", cfun_it_s64_or}, | ||||
|     {"r|", cfun_it_s64_or}, | ||||
|     {"^", cfun_it_s64_xor}, | ||||
|     {"r^", cfun_it_s64_xor}, | ||||
|     {"<<", cfun_it_s64_lshift}, | ||||
|     {">>", cfun_it_s64_rshift}, | ||||
|     {"compare", cfun_it_s64_compare}, | ||||
|  | ||||
|     {"+!", cfun_it_s64_add_mut}, | ||||
|     {"-!", cfun_it_s64_sub_mut}, | ||||
|     {"*!", cfun_it_s64_mul_mut}, | ||||
|     {"/!", cfun_it_s64_div_mut}, | ||||
|     {"%!", cfun_it_s64_mod_mut}, | ||||
|     {"&!", cfun_it_s64_and_mut}, | ||||
|     {"|!", cfun_it_s64_or_mut}, | ||||
|     {"^!", cfun_it_s64_xor_mut}, | ||||
|     {"<<!", cfun_it_s64_lshift_mut}, | ||||
|     {">>!", cfun_it_s64_rshift_mut}, | ||||
|  | ||||
|     {NULL, NULL} | ||||
| }; | ||||
|  | ||||
| static JanetMethod it_u64_methods[] = { | ||||
|     {"+", cfun_it_u64_add}, | ||||
|     {"r+", cfun_it_u64_add}, | ||||
|     {"-", cfun_it_u64_sub}, | ||||
|     {"r-", cfun_it_u64_subi}, | ||||
|     {"*", cfun_it_u64_mul}, | ||||
|     {"r*", cfun_it_u64_mul}, | ||||
|     {"/", cfun_it_u64_div}, | ||||
|     {"r/", cfun_it_u64_divi}, | ||||
|     {"mod", cfun_it_u64_mod}, | ||||
|     {"rmod", cfun_it_u64_mod}, | ||||
|     {"%", cfun_it_u64_mod}, | ||||
|     {"r%", cfun_it_u64_mod}, | ||||
|     {"<", cfun_it_u64_lt}, | ||||
|     {">", cfun_it_u64_gt}, | ||||
|     {"<=", cfun_it_u64_le}, | ||||
|     {">=", cfun_it_u64_ge}, | ||||
|     {"==", cfun_it_u64_eq}, | ||||
|     {"!=", cfun_it_u64_ne}, | ||||
|     {"&", 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_lshift}, | ||||
|     {">>", cfun_it_u64_rshift}, | ||||
|     {"compare", cfun_it_u64_compare}, | ||||
|  | ||||
|     {"+!", cfun_it_u64_add_mut}, | ||||
|     {"-!", cfun_it_u64_sub_mut}, | ||||
|     {"*!", cfun_it_u64_mul_mut}, | ||||
|     {"/!", cfun_it_u64_div_mut}, | ||||
|     {"%!", cfun_it_u64_mod_mut}, | ||||
|     {"&!", cfun_it_u64_and_mut}, | ||||
|     {"|!", cfun_it_u64_or_mut}, | ||||
|     {"^!", cfun_it_u64_xor_mut}, | ||||
|     {"<<!", cfun_it_u64_lshift_mut}, | ||||
|     {">>!", cfun_it_u64_rshift_mut}, | ||||
|  | ||||
|     {NULL, NULL} | ||||
| }; | ||||
|  | ||||
| static Janet janet_int64_next(void *p, Janet key) { | ||||
|     (void) p; | ||||
|     return janet_nextmethod(it_s64_methods, key); | ||||
| } | ||||
|  | ||||
| static Janet janet_uint64_next(void *p, Janet key) { | ||||
|     (void) p; | ||||
|     return janet_nextmethod(it_u64_methods, key); | ||||
| } | ||||
|  | ||||
| static int it_s64_get(void *p, Janet key, Janet *out) { | ||||
| static Janet it_s64_get(void *p, Janet key) { | ||||
|     (void) p; | ||||
|     if (!janet_checktype(key, JANET_KEYWORD)) | ||||
|         return 0; | ||||
|     return janet_getmethod(janet_unwrap_keyword(key), it_s64_methods, out); | ||||
|         janet_panicf("expected keyword, got %v", key); | ||||
|     return janet_getmethod(janet_unwrap_keyword(key), it_s64_methods); | ||||
| } | ||||
|  | ||||
| static int it_u64_get(void *p, Janet key, Janet *out) { | ||||
| static Janet it_u64_get(void *p, Janet key) { | ||||
|     (void) p; | ||||
|     if (!janet_checktype(key, JANET_KEYWORD)) | ||||
|         return 0; | ||||
|     return janet_getmethod(janet_unwrap_keyword(key), it_u64_methods, out); | ||||
|         janet_panicf("expected keyword, got %v", key); | ||||
|     return janet_getmethod(janet_unwrap_keyword(key), it_u64_methods); | ||||
| } | ||||
|  | ||||
| static const JanetReg it_cfuns[] = { | ||||
| @@ -522,8 +379,8 @@ static const JanetReg it_cfuns[] = { | ||||
| /* Module entry point */ | ||||
| void janet_lib_inttypes(JanetTable *env) { | ||||
|     janet_core_cfuns(env, NULL, it_cfuns); | ||||
|     janet_register_abstract_type(&janet_s64_type); | ||||
|     janet_register_abstract_type(&janet_u64_type); | ||||
|     janet_register_abstract_type(&it_s64_type); | ||||
|     janet_register_abstract_type(&it_u64_type); | ||||
| } | ||||
|  | ||||
| #endif | ||||
|   | ||||
							
								
								
									
										711
									
								
								src/core/io.c
									
									
									
									
									
								
							
							
						
						
									
										711
									
								
								src/core/io.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -20,160 +20,149 @@ | ||||
| * IN THE SOFTWARE. | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "util.h" | ||||
| #endif | ||||
| /* Compiler feature test macros for things */ | ||||
| #define _DEFAULT_SOURCE | ||||
| #define _BSD_SOURCE | ||||
|  | ||||
| #include <stdio.h> | ||||
| #include <errno.h> | ||||
|  | ||||
| #ifndef JANET_WINDOWS | ||||
| #include <fcntl.h> | ||||
| #include <sys/wait.h> | ||||
| #include <unistd.h> | ||||
| #ifndef JANET_AMALG | ||||
| #include <janet.h> | ||||
| #include "util.h" | ||||
| #endif | ||||
|  | ||||
| static int cfun_io_gc(void *p, size_t len); | ||||
| static int io_file_get(void *p, Janet key, Janet *out); | ||||
| 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); | ||||
| #define IO_WRITE 1 | ||||
| #define IO_READ 2 | ||||
| #define IO_APPEND 4 | ||||
| #define IO_UPDATE 8 | ||||
| #define IO_NOT_CLOSEABLE 16 | ||||
| #define IO_CLOSED 32 | ||||
| #define IO_BINARY 64 | ||||
| #define IO_SERIALIZABLE 128 | ||||
| #define IO_PIPED 256 | ||||
|  | ||||
| const JanetAbstractType janet_file_type = { | ||||
| typedef struct IOFile IOFile; | ||||
| struct IOFile { | ||||
|     FILE *file; | ||||
|     int flags; | ||||
| }; | ||||
|  | ||||
| static int cfun_io_gc(void *p, size_t len); | ||||
| static Janet io_file_get(void *p, Janet); | ||||
|  | ||||
| JanetAbstractType cfun_io_filetype = { | ||||
|     "core/file", | ||||
|     cfun_io_gc, | ||||
|     NULL, | ||||
|     io_file_get, | ||||
|     NULL, | ||||
|     io_file_marshal, | ||||
|     io_file_unmarshal, | ||||
|     NULL, /* tostring */ | ||||
|     NULL, /* compare */ | ||||
|     NULL, /* hash */ | ||||
|     io_file_next, | ||||
|     JANET_ATEND_NEXT | ||||
|     NULL, | ||||
|     NULL, | ||||
|     NULL | ||||
| }; | ||||
|  | ||||
| /* Check arguments to fopen */ | ||||
| static int32_t checkflags(const uint8_t *str) { | ||||
|     int32_t flags = 0; | ||||
| static int checkflags(const uint8_t *str) { | ||||
|     int flags = 0; | ||||
|     int32_t i; | ||||
|     int32_t len = janet_string_length(str); | ||||
|     if (!len || len > 10) | ||||
|         janet_panic("file mode must have a length between 1 and 10"); | ||||
|     if (!len || len > 3) | ||||
|         janet_panic("file mode must have a length between 1 and 3"); | ||||
|     switch (*str) { | ||||
|         default: | ||||
|             janet_panicf("invalid flag %c, expected w, a, or r", *str); | ||||
|             break; | ||||
|         case 'w': | ||||
|             flags |= JANET_FILE_WRITE; | ||||
|             flags |= IO_WRITE; | ||||
|             break; | ||||
|         case 'a': | ||||
|             flags |= JANET_FILE_APPEND; | ||||
|             flags |= IO_APPEND; | ||||
|             break; | ||||
|         case 'r': | ||||
|             flags |= JANET_FILE_READ; | ||||
|             flags |= IO_READ; | ||||
|             break; | ||||
|     } | ||||
|     for (i = 1; i < len; i++) { | ||||
|         switch (str[i]) { | ||||
|             default: | ||||
|                 janet_panicf("invalid flag %c, expected +, b, or n", str[i]); | ||||
|                 janet_panicf("invalid flag %c, expected + or b", str[i]); | ||||
|                 break; | ||||
|             case '+': | ||||
|                 if (flags & JANET_FILE_UPDATE) return -1; | ||||
|                 flags |= JANET_FILE_UPDATE; | ||||
|                 if (flags & IO_UPDATE) return -1; | ||||
|                 flags |= IO_UPDATE; | ||||
|                 break; | ||||
|             case 'b': | ||||
|                 if (flags & JANET_FILE_BINARY) return -1; | ||||
|                 flags |= JANET_FILE_BINARY; | ||||
|                 break; | ||||
|             case 'n': | ||||
|                 if (flags & JANET_FILE_NONIL) return -1; | ||||
|                 flags |= JANET_FILE_NONIL; | ||||
|                 if (flags & IO_BINARY) return -1; | ||||
|                 flags |= IO_BINARY; | ||||
|                 break; | ||||
|         } | ||||
|     } | ||||
|     return flags; | ||||
| } | ||||
|  | ||||
| static void *makef(FILE *f, int32_t flags) { | ||||
|     JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile)); | ||||
| static Janet makef(FILE *f, int flags) { | ||||
|     IOFile *iof = (IOFile *) janet_abstract(&cfun_io_filetype, sizeof(IOFile)); | ||||
|     iof->file = f; | ||||
|     iof->flags = flags; | ||||
| #ifndef JANET_WINDOWS | ||||
|     /* While we would like fopen to set cloexec by default (like O_CLOEXEC) with the e flag, that is | ||||
|      * not standard. */ | ||||
|     if (!(flags & JANET_FILE_NOT_CLOSEABLE)) | ||||
|         fcntl(fileno(f), F_SETFD, FD_CLOEXEC); | ||||
| #endif | ||||
|     return iof; | ||||
|     return janet_wrap_abstract(iof); | ||||
| } | ||||
|  | ||||
| /* Open a process */ | ||||
| #ifndef JANET_NO_PROCESSES | ||||
| #ifdef __EMSCRIPTEN__ | ||||
| static Janet cfun_io_popen(int32_t argc, Janet *argv) { | ||||
|     (void) argc; | ||||
|     (void) argv; | ||||
|     janet_panic("not implemented on this platform"); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
| #else | ||||
| static Janet cfun_io_popen(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     const uint8_t *fname = janet_getstring(argv, 0); | ||||
|     const uint8_t *fmode = NULL; | ||||
|     int32_t flags; | ||||
|     int flags; | ||||
|     if (argc == 2) { | ||||
|         fmode = janet_getkeyword(argv, 1); | ||||
|         flags = JANET_FILE_PIPED | checkflags(fmode); | ||||
|         if (flags & (JANET_FILE_UPDATE | JANET_FILE_BINARY | JANET_FILE_APPEND)) { | ||||
|             janet_panicf("invalid popen file mode :%S, expected :r or :w", fmode); | ||||
|         if (janet_string_length(fmode) != 1 || | ||||
|                 !(fmode[0] == 'r' || fmode[0] == 'w')) { | ||||
|             janet_panicf("invalid file mode :%S, expected :r or :w", fmode); | ||||
|         } | ||||
|         fmode = (const uint8_t *)((fmode[0] == 'r') ? "r" : "w"); | ||||
|         flags = IO_PIPED | (fmode[0] == 'r' ? IO_READ : IO_WRITE); | ||||
|     } else { | ||||
|         fmode = (const uint8_t *)"r"; | ||||
|         flags = JANET_FILE_PIPED | JANET_FILE_READ; | ||||
|         flags = IO_PIPED | IO_READ; | ||||
|     } | ||||
| #ifdef JANET_WINDOWS | ||||
| #define popen _popen | ||||
| #endif | ||||
|     FILE *f = popen((const char *)fname, (const char *)fmode); | ||||
|     if (!f) { | ||||
|         if (flags & JANET_FILE_NONIL) | ||||
|             janet_panicf("failed to popen %s: %s", fname, strerror(errno)); | ||||
|         return janet_wrap_nil(); | ||||
|     } | ||||
|     return janet_makefile(f, flags); | ||||
|     return makef(f, flags); | ||||
| } | ||||
| #endif | ||||
|  | ||||
| static Janet cfun_io_temp(int32_t argc, Janet *argv) { | ||||
|     (void)argv; | ||||
|     janet_fixarity(argc, 0); | ||||
|     // 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)); | ||||
|     return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY); | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_fopen(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     const uint8_t *fname = janet_getstring(argv, 0); | ||||
|     const uint8_t *fmode; | ||||
|     int32_t flags; | ||||
|     int flags; | ||||
|     if (argc == 2) { | ||||
|         fmode = janet_getkeyword(argv, 1); | ||||
|         flags = checkflags(fmode); | ||||
|     } else { | ||||
|         fmode = (const uint8_t *)"r"; | ||||
|         flags = JANET_FILE_READ; | ||||
|         flags = IO_READ; | ||||
|     } | ||||
|     FILE *f = fopen((const char *)fname, (const char *)fmode); | ||||
|     return f ? janet_makefile(f, flags) | ||||
|            : (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil()) | ||||
|            : janet_wrap_nil(); | ||||
|     return f ? makef(f, flags) : janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| /* Read up to n bytes into buffer. */ | ||||
| static void read_chunk(JanetFile *iof, JanetBuffer *buffer, int32_t nBytesMax) { | ||||
|     if (!(iof->flags & (JANET_FILE_READ | JANET_FILE_UPDATE))) | ||||
| static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) { | ||||
|     if (!(iof->flags & (IO_READ | IO_UPDATE))) | ||||
|         janet_panic("file is not readable"); | ||||
|     janet_buffer_extra(buffer, nBytesMax); | ||||
|     size_t ntoread = nBytesMax; | ||||
| @@ -186,8 +175,8 @@ static void read_chunk(JanetFile *iof, JanetBuffer *buffer, int32_t nBytesMax) { | ||||
| /* Read a certain number of bytes into memory */ | ||||
| static Janet cfun_io_fread(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 2, 3); | ||||
|     JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type); | ||||
|     if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed"); | ||||
|     IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype); | ||||
|     if (iof->flags & IO_CLOSED) janet_panic("file is closed"); | ||||
|     JanetBuffer *buffer; | ||||
|     if (argc == 2) { | ||||
|         buffer = janet_buffer(0); | ||||
| @@ -198,11 +187,27 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) { | ||||
|     if (janet_checktype(argv[1], JANET_KEYWORD)) { | ||||
|         const uint8_t *sym = janet_unwrap_keyword(argv[1]); | ||||
|         if (!janet_cstrcmp(sym, "all")) { | ||||
|             int32_t sizeBefore; | ||||
|             do { | ||||
|                 sizeBefore = buffer->count; | ||||
|                 read_chunk(iof, buffer, 4096); | ||||
|             } while (sizeBefore < buffer->count); | ||||
|             /* Read whole file */ | ||||
|             int status = fseek(iof->file, 0, SEEK_SET); | ||||
|             if (status) { | ||||
|                 /* backwards fseek did not work (stream like popen) */ | ||||
|                 int32_t sizeBefore; | ||||
|                 do { | ||||
|                     sizeBefore = buffer->count; | ||||
|                     read_chunk(iof, buffer, 1024); | ||||
|                 } while (sizeBefore < buffer->count); | ||||
|             } else { | ||||
|                 fseek(iof->file, 0, SEEK_END); | ||||
|                 long fsize = ftell(iof->file); | ||||
|                 if (fsize < 0) { | ||||
|                     janet_panicf("could not get file size of %v", argv[0]); | ||||
|                 } | ||||
|                 if (fsize > (INT32_MAX)) { | ||||
|                     janet_panic("file to large to read into buffer"); | ||||
|                 } | ||||
|                 fseek(iof->file, 0, SEEK_SET); | ||||
|                 read_chunk(iof, buffer, (int32_t) fsize); | ||||
|             } | ||||
|             /* Never return nil for :all */ | ||||
|             return janet_wrap_buffer(buffer); | ||||
|         } else if (!janet_cstrcmp(sym, "line")) { | ||||
| @@ -226,10 +231,10 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) { | ||||
| /* Write bytes to a file */ | ||||
| static Janet cfun_io_fwrite(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, -1); | ||||
|     JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type); | ||||
|     if (iof->flags & JANET_FILE_CLOSED) | ||||
|     IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype); | ||||
|     if (iof->flags & IO_CLOSED) | ||||
|         janet_panic("file is closed"); | ||||
|     if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE))) | ||||
|     if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE))) | ||||
|         janet_panic("file is not writeable"); | ||||
|     int32_t i; | ||||
|     /* Verify all arguments before writing to file */ | ||||
| @@ -249,79 +254,51 @@ static Janet cfun_io_fwrite(int32_t argc, Janet *argv) { | ||||
| /* Flush the bytes in the file */ | ||||
| static Janet cfun_io_fflush(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type); | ||||
|     if (iof->flags & JANET_FILE_CLOSED) | ||||
|     IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype); | ||||
|     if (iof->flags & IO_CLOSED) | ||||
|         janet_panic("file is closed"); | ||||
|     if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE))) | ||||
|     if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE))) | ||||
|         janet_panic("file is not writeable"); | ||||
|     if (fflush(iof->file)) | ||||
|         janet_panic("could not flush file"); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| #ifdef JANET_WINDOWS | ||||
| #define pclose _pclose | ||||
| #define WEXITSTATUS(x) x | ||||
| #endif | ||||
|  | ||||
| /* For closing files from C API */ | ||||
| int janet_file_close(JanetFile *file) { | ||||
|     int ret = 0; | ||||
|     if (!(file->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) { | ||||
| #ifndef JANET_NO_PROCESSES | ||||
|         if (file->flags & JANET_FILE_PIPED) { | ||||
|             ret = pclose(file->file); | ||||
|         } else | ||||
| #endif | ||||
|         { | ||||
|             ret = fclose(file->file); | ||||
|         } | ||||
|         file->flags |= JANET_FILE_CLOSED; | ||||
|         return ret; | ||||
|     } | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| /* Cleanup a file */ | ||||
| static int cfun_io_gc(void *p, size_t len) { | ||||
|     (void) len; | ||||
|     JanetFile *iof = (JanetFile *)p; | ||||
|     janet_file_close(iof); | ||||
|     IOFile *iof = (IOFile *)p; | ||||
|     if (!(iof->flags & (IO_NOT_CLOSEABLE | IO_CLOSED))) { | ||||
|         return fclose(iof->file); | ||||
|     } | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| /* Close a file */ | ||||
| static Janet cfun_io_fclose(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type); | ||||
|     if (iof->flags & JANET_FILE_CLOSED) | ||||
|         return janet_wrap_nil(); | ||||
|     if (iof->flags & (JANET_FILE_NOT_CLOSEABLE)) | ||||
|     IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype); | ||||
|     if (iof->flags & IO_CLOSED) | ||||
|         janet_panic("file is closed"); | ||||
|     if (iof->flags & (IO_NOT_CLOSEABLE)) | ||||
|         janet_panic("file not closable"); | ||||
|     if (iof->flags & JANET_FILE_PIPED) { | ||||
| #ifndef JANET_NO_PROCESSES | ||||
|         int status = pclose(iof->file); | ||||
|         iof->flags |= JANET_FILE_CLOSED; | ||||
|         if (status == -1) janet_panic("could not close file"); | ||||
|         return janet_wrap_integer(WEXITSTATUS(status)); | ||||
| #else | ||||
|         return janet_wrap_nil(); | ||||
|     if (iof->flags & IO_PIPED) { | ||||
| #ifdef JANET_WINDOWS | ||||
| #define pclose _pclose | ||||
| #endif | ||||
|         if (pclose(iof->file)) janet_panic("could not close file"); | ||||
|     } else { | ||||
|         if (fclose(iof->file)) { | ||||
|             iof->flags |= JANET_FILE_NOT_CLOSEABLE; | ||||
|             janet_panic("could not close file"); | ||||
|         } | ||||
|         iof->flags |= JANET_FILE_CLOSED; | ||||
|         if (fclose(iof->file)) janet_panic("could not close file"); | ||||
|     } | ||||
|     return janet_wrap_nil(); | ||||
|     iof->flags |= IO_CLOSED; | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| /* Seek a file */ | ||||
| static Janet cfun_io_fseek(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 2, 3); | ||||
|     JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type); | ||||
|     if (iof->flags & JANET_FILE_CLOSED) | ||||
|     IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype); | ||||
|     if (iof->flags & IO_CLOSED) | ||||
|         janet_panic("file is closed"); | ||||
|     long int offset = 0; | ||||
|     int whence = SEEK_CUR; | ||||
| @@ -346,430 +323,83 @@ static Janet cfun_io_fseek(int32_t argc, Janet *argv) { | ||||
|  | ||||
| static JanetMethod io_file_methods[] = { | ||||
|     {"close", cfun_io_fclose}, | ||||
|     {"flush", cfun_io_fflush}, | ||||
|     {"read", cfun_io_fread}, | ||||
|     {"seek", cfun_io_fseek}, | ||||
|     {"write", cfun_io_fwrite}, | ||||
|     {"flush", cfun_io_fflush}, | ||||
|     {"seek", cfun_io_fseek}, | ||||
|     {NULL, NULL} | ||||
| }; | ||||
|  | ||||
| static int io_file_get(void *p, Janet key, Janet *out) { | ||||
| static Janet io_file_get(void *p, Janet key) { | ||||
|     (void) p; | ||||
|     if (!janet_checktype(key, JANET_KEYWORD)) | ||||
|         return 0; | ||||
|     return janet_getmethod(janet_unwrap_keyword(key), io_file_methods, out); | ||||
| } | ||||
|  | ||||
| static Janet io_file_next(void *p, Janet key) { | ||||
|     (void) p; | ||||
|     return janet_nextmethod(io_file_methods, key); | ||||
| } | ||||
|  | ||||
| static void io_file_marshal(void *p, JanetMarshalContext *ctx) { | ||||
|     JanetFile *iof = (JanetFile *)p; | ||||
|     if (ctx->flags & JANET_MARSHAL_UNSAFE) { | ||||
|         janet_marshal_abstract(ctx, p); | ||||
| #ifdef JANET_WINDOWS | ||||
|         janet_marshal_int(ctx, _fileno(iof->file)); | ||||
| #else | ||||
|         janet_marshal_int(ctx, fileno(iof->file)); | ||||
| #endif | ||||
|         janet_marshal_int(ctx, iof->flags); | ||||
|     } else { | ||||
|         janet_panic("cannot marshal file in safe mode"); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static void *io_file_unmarshal(JanetMarshalContext *ctx) { | ||||
|     if (ctx->flags & JANET_MARSHAL_UNSAFE) { | ||||
|         JanetFile *iof = janet_unmarshal_abstract(ctx, sizeof(JanetFile)); | ||||
|         int32_t fd = janet_unmarshal_int(ctx); | ||||
|         int32_t flags = janet_unmarshal_int(ctx); | ||||
|         char fmt[4] = {0}; | ||||
|         int index = 0; | ||||
|         if (flags & JANET_FILE_READ) fmt[index++] = 'r'; | ||||
|         if (flags & JANET_FILE_APPEND) { | ||||
|             fmt[index++] = 'a'; | ||||
|         } else if (flags & JANET_FILE_WRITE) { | ||||
|             fmt[index++] = 'w'; | ||||
|         } | ||||
| #ifdef JANET_WINDOWS | ||||
|         iof->file = _fdopen(fd, fmt); | ||||
| #else | ||||
|         iof->file = fdopen(fd, fmt); | ||||
| #endif | ||||
|         if (iof->file == NULL) { | ||||
|             iof->flags = JANET_FILE_CLOSED; | ||||
|         } else { | ||||
|             iof->flags = flags; | ||||
|         } | ||||
|         return iof; | ||||
|     } else { | ||||
|         janet_panic("cannot unmarshal file in safe mode"); | ||||
|     } | ||||
|         janet_panicf("expected keyword, got %v", key); | ||||
|     return janet_getmethod(janet_unwrap_keyword(key), io_file_methods); | ||||
| } | ||||
|  | ||||
| FILE *janet_dynfile(const char *name, FILE *def) { | ||||
|     Janet x = janet_dyn(name); | ||||
|     if (!janet_checktype(x, JANET_ABSTRACT)) return def; | ||||
|     void *abstract = janet_unwrap_abstract(x); | ||||
|     if (janet_abstract_type(abstract) != &janet_file_type) return def; | ||||
|     JanetFile *iofile = abstract; | ||||
|     if (janet_abstract_type(abstract) != &cfun_io_filetype) return def; | ||||
|     IOFile *iofile = abstract; | ||||
|     return iofile->file; | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline, | ||||
|                                   FILE *dflt_file, int32_t offset, Janet x) { | ||||
|     FILE *f; | ||||
|     switch (janet_type(x)) { | ||||
|         default: | ||||
|             janet_panicf("cannot print to %v", x); | ||||
|         case JANET_BUFFER: { | ||||
|             /* Special case buffer */ | ||||
|             JanetBuffer *buf = janet_unwrap_buffer(x); | ||||
|             for (int32_t i = offset; i < argc; ++i) { | ||||
|                 janet_to_string_b(buf, argv[i]); | ||||
|             } | ||||
|             if (newline) | ||||
|                 janet_buffer_push_u8(buf, '\n'); | ||||
|             return janet_wrap_nil(); | ||||
|         } | ||||
|         case JANET_NIL: | ||||
|             f = dflt_file; | ||||
|             if (f == NULL) janet_panic("cannot print to nil"); | ||||
|             break; | ||||
|         case JANET_ABSTRACT: { | ||||
|             void *abstract = janet_unwrap_abstract(x); | ||||
|             if (janet_abstract_type(abstract) != &janet_file_type) | ||||
|                 return janet_wrap_nil(); | ||||
|             JanetFile *iofile = abstract; | ||||
|             f = iofile->file; | ||||
|             break; | ||||
|         } | ||||
|     } | ||||
|     for (int32_t i = offset; i < argc; ++i) { | ||||
|         int32_t len; | ||||
|         const uint8_t *vstr; | ||||
|         if (janet_checktype(argv[i], JANET_BUFFER)) { | ||||
|             JanetBuffer *b = janet_unwrap_buffer(argv[i]); | ||||
|             vstr = b->data; | ||||
|             len = b->count; | ||||
|         } else { | ||||
|             vstr = janet_to_string(argv[i]); | ||||
|             len = janet_string_length(vstr); | ||||
|         } | ||||
|         if (len) { | ||||
|             if (1 != fwrite(vstr, len, 1, f)) { | ||||
|                 if (f == dflt_file) { | ||||
|                     janet_panicf("cannot print %d bytes", len); | ||||
|                 } else { | ||||
|                     janet_panicf("cannot print %d bytes to %v", len, x); | ||||
|                 } | ||||
|             } | ||||
|         } | ||||
|     } | ||||
|     if (newline) | ||||
|         putc('\n', f); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
|  | ||||
| static Janet cfun_io_print_impl(int32_t argc, Janet *argv, | ||||
|                                 int newline, const char *name, FILE *dflt_file) { | ||||
|     Janet x = janet_dyn(name); | ||||
|     return cfun_io_print_impl_x(argc, argv, newline, dflt_file, 0, x); | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_print(int32_t argc, Janet *argv) { | ||||
|     return cfun_io_print_impl(argc, argv, 1, "out", stdout); | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_prin(int32_t argc, Janet *argv) { | ||||
|     return cfun_io_print_impl(argc, argv, 0, "out", stdout); | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_eprint(int32_t argc, Janet *argv) { | ||||
|     return cfun_io_print_impl(argc, argv, 1, "err", stderr); | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_eprin(int32_t argc, Janet *argv) { | ||||
|     return cfun_io_print_impl(argc, argv, 0, "err", stderr); | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_xprint(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, -1); | ||||
|     return cfun_io_print_impl_x(argc, argv, 1, NULL, 1, argv[0]); | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_xprin(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, -1); | ||||
|     return cfun_io_print_impl_x(argc, argv, 0, NULL, 1, argv[0]); | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline, | ||||
|                                    FILE *dflt_file, int32_t offset, Janet x) { | ||||
|     FILE *f; | ||||
|     const char *fmt = janet_getcstring(argv, offset); | ||||
|     switch (janet_type(x)) { | ||||
|         default: | ||||
|             janet_panicf("cannot print to %v", x); | ||||
|         case JANET_BUFFER: { | ||||
|             /* Special case buffer */ | ||||
|             JanetBuffer *buf = janet_unwrap_buffer(x); | ||||
|             janet_buffer_format(buf, fmt, offset, argc, argv); | ||||
|             if (newline) janet_buffer_push_u8(buf, '\n'); | ||||
|             return janet_wrap_nil(); | ||||
|         } | ||||
|         case JANET_NIL: | ||||
|             f = dflt_file; | ||||
|             if (f == NULL) janet_panic("cannot print to nil"); | ||||
|             break; | ||||
|         case JANET_ABSTRACT: { | ||||
|             void *abstract = janet_unwrap_abstract(x); | ||||
|             if (janet_abstract_type(abstract) != &janet_file_type) | ||||
|                 return janet_wrap_nil(); | ||||
|             JanetFile *iofile = abstract; | ||||
|             f = iofile->file; | ||||
|             break; | ||||
|     FILE *f = janet_dynfile("out", stdout); | ||||
|     for (int32_t i = 0; i < argc; ++i) { | ||||
|         int32_t j, len; | ||||
|         const uint8_t *vstr = janet_to_string(argv[i]); | ||||
|         len = janet_string_length(vstr); | ||||
|         for (j = 0; j < len; ++j) { | ||||
|             putc(vstr[j], f); | ||||
|         } | ||||
|     } | ||||
|     JanetBuffer *buf = janet_buffer(10); | ||||
|     janet_buffer_format(buf, fmt, offset, argc, argv); | ||||
|     if (newline) janet_buffer_push_u8(buf, '\n'); | ||||
|     if (buf->count) { | ||||
|         if (1 != fwrite(buf->data, buf->count, 1, f)) { | ||||
|             janet_panicf("could not print %d bytes to file", buf->count); | ||||
|         } | ||||
|     } | ||||
|     /* Clear buffer to make things easier for GC */ | ||||
|     buf->count = 0; | ||||
|     buf->capacity = 0; | ||||
|     janet_free(buf->data); | ||||
|     buf->data = NULL; | ||||
|     putc('\n', f); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline, | ||||
|                                  const char *name, FILE *dflt_file) { | ||||
|     janet_arity(argc, 1, -1); | ||||
|     Janet x = janet_dyn(name); | ||||
|     return cfun_io_printf_impl_x(argc, argv, newline, dflt_file, 0, x); | ||||
|  | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_printf(int32_t argc, Janet *argv) { | ||||
|     return cfun_io_printf_impl(argc, argv, 1, "out", stdout); | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_prinf(int32_t argc, Janet *argv) { | ||||
|     return cfun_io_printf_impl(argc, argv, 0, "out", stdout); | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_eprintf(int32_t argc, Janet *argv) { | ||||
|     return cfun_io_printf_impl(argc, argv, 1, "err", stderr); | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_eprinf(int32_t argc, Janet *argv) { | ||||
|     return cfun_io_printf_impl(argc, argv, 0, "err", stderr); | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_xprintf(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 2, -1); | ||||
|     return cfun_io_printf_impl_x(argc, argv, 1, NULL, 1, argv[0]); | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_xprinf(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 2, -1); | ||||
|     return cfun_io_printf_impl_x(argc, argv, 0, NULL, 1, argv[0]); | ||||
| } | ||||
|  | ||||
| static void janet_flusher(const char *name, FILE *dflt_file) { | ||||
|     Janet x = janet_dyn(name); | ||||
|     switch (janet_type(x)) { | ||||
|         default: | ||||
|             break; | ||||
|         case JANET_NIL: | ||||
|             fflush(dflt_file); | ||||
|             break; | ||||
|         case JANET_ABSTRACT: { | ||||
|             void *abstract = janet_unwrap_abstract(x); | ||||
|             if (janet_abstract_type(abstract) != &janet_file_type) break; | ||||
|             JanetFile *iofile = abstract; | ||||
|             fflush(iofile->file); | ||||
|             break; | ||||
|         } | ||||
|     } | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_flush(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 0); | ||||
|     (void) argv; | ||||
|     janet_flusher("out", stdout); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| static Janet cfun_io_eflush(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 0); | ||||
|     (void) argv; | ||||
|     janet_flusher("err", stderr); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) { | ||||
|     va_list args; | ||||
|     va_start(args, format); | ||||
|     Janet x = janet_dyn(name); | ||||
|     JanetType xtype = janet_type(x); | ||||
|     switch (xtype) { | ||||
|         default: | ||||
|             /* Other values simply do nothing */ | ||||
|             break; | ||||
|         case JANET_NIL: | ||||
|         case JANET_ABSTRACT: { | ||||
|             FILE *f = dflt_file; | ||||
|             JanetBuffer buffer; | ||||
|             int32_t len = 0; | ||||
|             while (format[len]) len++; | ||||
|             janet_buffer_init(&buffer, len); | ||||
|             janet_formatbv(&buffer, format, args); | ||||
|             if (xtype == JANET_ABSTRACT) { | ||||
|                 void *abstract = janet_unwrap_abstract(x); | ||||
|                 if (janet_abstract_type(abstract) != &janet_file_type) | ||||
|                     break; | ||||
|                 JanetFile *iofile = abstract; | ||||
|                 f = iofile->file; | ||||
|             } | ||||
|             fwrite(buffer.data, buffer.count, 1, f); | ||||
|             janet_buffer_deinit(&buffer); | ||||
|             break; | ||||
|         } | ||||
|         case JANET_BUFFER: | ||||
|             janet_formatbv(janet_unwrap_buffer(x), format, args); | ||||
|             break; | ||||
|     } | ||||
|     va_end(args); | ||||
|     return; | ||||
| } | ||||
|  | ||||
| static const JanetReg io_cfuns[] = { | ||||
|     { | ||||
|         "print", cfun_io_print, | ||||
|         JDOC("(print & xs)\n\n" | ||||
|              "Print values to the console (standard out). Value are converted " | ||||
|              "to strings if they are not already. After printing all values, a " | ||||
|              "newline character is printed. Use the value of (dyn :out stdout) to determine " | ||||
|              "what to push characters to. Expects (dyn :out stdout) to be either a core/file or " | ||||
|              "a buffer. Returns nil.") | ||||
|     }, | ||||
|     { | ||||
|         "prin", cfun_io_prin, | ||||
|         JDOC("(prin & xs)\n\n" | ||||
|              "Same as print, but does not add trailing newline.") | ||||
|     }, | ||||
|     { | ||||
|         "printf", cfun_io_printf, | ||||
|         JDOC("(printf fmt & xs)\n\n" | ||||
|              "Prints output formatted as if with (string/format fmt ;xs) to (dyn :out stdout) with a trailing newline.") | ||||
|     }, | ||||
|     { | ||||
|         "prinf", cfun_io_prinf, | ||||
|         JDOC("(prinf fmt & xs)\n\n" | ||||
|              "Like printf but with no trailing newline.") | ||||
|     }, | ||||
|     { | ||||
|         "eprin", cfun_io_eprin, | ||||
|         JDOC("(eprin & xs)\n\n" | ||||
|              "Same as prin, but uses (dyn :err stderr) instead of (dyn :out stdout).") | ||||
|     }, | ||||
|     { | ||||
|         "eprint", cfun_io_eprint, | ||||
|         JDOC("(eprint & xs)\n\n" | ||||
|              "Same as print, but uses (dyn :err stderr) instead of (dyn :out stdout).") | ||||
|     }, | ||||
|     { | ||||
|         "eprintf", cfun_io_eprintf, | ||||
|         JDOC("(eprintf fmt & xs)\n\n" | ||||
|              "Prints output formatted as if with (string/format fmt ;xs) to (dyn :err stderr) with a trailing newline.") | ||||
|     }, | ||||
|     { | ||||
|         "eprinf", cfun_io_eprinf, | ||||
|         JDOC("(eprinf fmt & xs)\n\n" | ||||
|              "Like eprintf but with no trailing newline.") | ||||
|     }, | ||||
|     { | ||||
|         "xprint", cfun_io_xprint, | ||||
|         JDOC("(xprint to & xs)\n\n" | ||||
|              "Print to a file or other value explicitly (no dynamic bindings) with a trailing " | ||||
|              "newline character. The value to print " | ||||
|              "to is the first argument, and is otherwise the same as print. Returns nil.") | ||||
|     }, | ||||
|     { | ||||
|         "xprin", cfun_io_xprin, | ||||
|         JDOC("(xprin to & xs)\n\n" | ||||
|              "Print to a file or other value explicitly (no dynamic bindings). The value to print " | ||||
|              "to is the first argument, and is otherwise the same as prin. Returns nil.") | ||||
|     }, | ||||
|     { | ||||
|         "xprintf", cfun_io_xprintf, | ||||
|         JDOC("(xprint to fmt & xs)\n\n" | ||||
|              "Like printf but prints to an explicit file or value to. Returns nil.") | ||||
|     }, | ||||
|     { | ||||
|         "xprinf", cfun_io_xprinf, | ||||
|         JDOC("(xprin to fmt & xs)\n\n" | ||||
|              "Like prinf but prints to an explicit file or value to. Returns nil.") | ||||
|     }, | ||||
|     { | ||||
|         "flush", cfun_io_flush, | ||||
|         JDOC("(flush)\n\n" | ||||
|              "Flush (dyn :out stdout) if it is a file, otherwise do nothing.") | ||||
|     }, | ||||
|     { | ||||
|         "eflush", cfun_io_eflush, | ||||
|         JDOC("(eflush)\n\n" | ||||
|              "Flush (dyn :err stderr) if it is a file, otherwise do nothing.") | ||||
|     }, | ||||
|     { | ||||
|         "file/temp", cfun_io_temp, | ||||
|         JDOC("(file/temp)\n\n" | ||||
|              "Open an anonymous temporary file that is removed on close. " | ||||
|              "Raises an error on failure.") | ||||
|              "newline character is printed. Returns nil.") | ||||
|     }, | ||||
|     { | ||||
|         "file/open", cfun_io_fopen, | ||||
|         JDOC("(file/open path &opt mode)\n\n" | ||||
|              "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 " | ||||
|         JDOC("(file/open path [,mode])\n\n" | ||||
|              "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 " | ||||
|              "cannot be opened, returns nil, otherwise returns the new file handle. " | ||||
|              "Mode flags:\n\n" | ||||
|              "* r - allow reading from the file\n\n" | ||||
|              "* w - allow writing to the file\n\n" | ||||
|              "* a - append to the file\n\n" | ||||
|              "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") | ||||
|              "\tr - allow reading from the file\n" | ||||
|              "\tw - allow writing to the file\n" | ||||
|              "\ta - append to the file\n" | ||||
|              "\tb - open the file in binary mode (rather than text mode)\n" | ||||
|              "\t+ - append to the file instead of overwriting it") | ||||
|     }, | ||||
|     { | ||||
|         "file/close", cfun_io_fclose, | ||||
|         JDOC("(file/close f)\n\n" | ||||
|              "Close a file and release all related resources. When you are " | ||||
|              "done reading a file, close it to prevent a resource leak and let " | ||||
|              "other processes read the file. If the file is the result of a file/popen " | ||||
|              "call, close waits for and returns the process exit status.") | ||||
|              "other processes read the file.") | ||||
|     }, | ||||
|     { | ||||
|         "file/read", cfun_io_fread, | ||||
|         JDOC("(file/read f what &opt buf)\n\n" | ||||
|              "Read a number of bytes from a file `f` into a buffer. A buffer `buf` can " | ||||
|              "be provided as an optional third argument, otherwise a new buffer " | ||||
|              "is created. `what` can either be an integer or a keyword. Returns the " | ||||
|         JDOC("(file/read f what [,buf])\n\n" | ||||
|              "Read a number of bytes from a file into a buffer. A buffer can " | ||||
|              "be provided as an optional fourth argument, otherwise a new buffer " | ||||
|              "is created. 'what' can either be an integer or a keyword. Returns the " | ||||
|              "buffer with file contents. " | ||||
|              "Values for `what`:\n\n" | ||||
|              "* :all - read the whole file\n\n" | ||||
|              "* :line - read up to and including the next newline character\n\n" | ||||
|              "* n (integer) - read up to n bytes from the file") | ||||
|              "Values for 'what':\n\n" | ||||
|              "\t:all - read the whole file\n" | ||||
|              "\t:line - read up to and including the next newline character\n" | ||||
|              "\tn (integer) - read up to n bytes from the file") | ||||
|     }, | ||||
|     { | ||||
|         "file/write", cfun_io_fwrite, | ||||
| @@ -785,54 +415,30 @@ static const JanetReg io_cfuns[] = { | ||||
|     }, | ||||
|     { | ||||
|         "file/seek", cfun_io_fseek, | ||||
|         JDOC("(file/seek f &opt whence n)\n\n" | ||||
|              "Jump to a relative location in the file `f`. `whence` must be one of:\n\n" | ||||
|              "* :cur - jump relative to the current file location\n\n" | ||||
|              "* :set - jump relative to the beginning of the file\n\n" | ||||
|              "* :end - jump relative to the end of the file\n\n" | ||||
|              "By default, `whence` is :cur. Optionally a value `n` may be passed " | ||||
|              "for the relative number of bytes to seek in the file. `n` may be a real " | ||||
|              "number to handle large files of more than 4GB. Returns the file handle.") | ||||
|         JDOC("(file/seek f [,whence [,n]])\n\n" | ||||
|              "Jump to a relative location in the file. 'whence' must be one of\n\n" | ||||
|              "\t:cur - jump relative to the current file location\n" | ||||
|              "\t:set - jump relative to the beginning of the file\n" | ||||
|              "\t:end - jump relative to the end of the file\n\n" | ||||
|              "By default, 'whence' is :cur. Optionally a value n may be passed " | ||||
|              "for the relative number of bytes to seek in the file. n may be a real " | ||||
|              "number to handle large files of more the 4GB. Returns the file handle.") | ||||
|     }, | ||||
| #ifndef JANET_NO_PROCESSES | ||||
|     { | ||||
|         "file/popen", cfun_io_popen, | ||||
|         JDOC("(file/popen command &opt mode) (DEPRECATED for os/spawn)\n\n" | ||||
|         JDOC("(file/popen path [,mode])\n\n" | ||||
|              "Open a file that is backed by a process. The file must be opened in either " | ||||
|              "the :r (read) or the :w (write) mode. In :r mode, the stdout of the " | ||||
|              "process can be read from the file. In :w mode, the stdin of the process " | ||||
|              "can be written to. Returns the new file.") | ||||
|     }, | ||||
| #endif | ||||
|     {NULL, NULL, NULL} | ||||
| }; | ||||
|  | ||||
| /* C API */ | ||||
|  | ||||
| JanetFile *janet_getjfile(const Janet *argv, int32_t n) { | ||||
|     return janet_getabstract(argv, n, &janet_file_type); | ||||
| } | ||||
|  | ||||
| FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) { | ||||
|     JanetFile *iof = janet_getabstract(argv, n, &janet_file_type); | ||||
|     if (NULL != flags) *flags = iof->flags; | ||||
|     return iof->file; | ||||
| } | ||||
|  | ||||
| JanetFile *janet_makejfile(FILE *f, int flags) { | ||||
|     return makef(f, flags); | ||||
| } | ||||
|  | ||||
| Janet janet_makefile(FILE *f, int flags) { | ||||
|     return janet_wrap_abstract(makef(f, flags)); | ||||
| } | ||||
|  | ||||
| JanetAbstract janet_checkfile(Janet j) { | ||||
|     return janet_checkabstract(j, &janet_file_type); | ||||
| } | ||||
|  | ||||
| FILE *janet_unwrapfile(Janet j, int *flags) { | ||||
|     JanetFile *iof = janet_unwrap_abstract(j); | ||||
|     IOFile *iof = janet_getabstract(argv, n, &cfun_io_filetype); | ||||
|     if (NULL != flags) *flags = iof->flags; | ||||
|     return iof->file; | ||||
| } | ||||
| @@ -840,19 +446,18 @@ FILE *janet_unwrapfile(Janet j, int *flags) { | ||||
| /* Module entry point */ | ||||
| void janet_lib_io(JanetTable *env) { | ||||
|     janet_core_cfuns(env, NULL, io_cfuns); | ||||
|     janet_register_abstract_type(&janet_file_type); | ||||
|     int default_flags = JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE; | ||||
|  | ||||
|     /* stdout */ | ||||
|     janet_core_def(env, "stdout", | ||||
|                    janet_makefile(stdout, JANET_FILE_APPEND | default_flags), | ||||
|                    makef(stdout, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE), | ||||
|                    JDOC("The standard output file.")); | ||||
|     /* stderr */ | ||||
|     janet_core_def(env, "stderr", | ||||
|                    janet_makefile(stderr, JANET_FILE_APPEND | default_flags), | ||||
|                    makef(stderr, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE), | ||||
|                    JDOC("The standard error file.")); | ||||
|     /* stdin */ | ||||
|     janet_core_def(env, "stdin", | ||||
|                    janet_makefile(stdin, JANET_FILE_READ | default_flags), | ||||
|                    makef(stdin, IO_READ | IO_NOT_CLOSEABLE | IO_SERIALIZABLE), | ||||
|                    JDOC("The standard input file.")); | ||||
|  | ||||
| } | ||||
|   | ||||
							
								
								
									
										513
									
								
								src/core/marsh.c
									
									
									
									
									
								
							
							
						
						
									
										513
									
								
								src/core/marsh.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,7 +21,6 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "state.h" | ||||
| #include "vector.h" | ||||
| @@ -42,28 +41,26 @@ typedef struct { | ||||
| /* Lead bytes in marshaling protocol */ | ||||
| enum { | ||||
|     LB_REAL = 200, | ||||
|     LB_NIL, /* 201 */ | ||||
|     LB_FALSE, /* 202 */ | ||||
|     LB_TRUE,  /* 203 */ | ||||
|     LB_FIBER, /* 204 */ | ||||
|     LB_INTEGER, /* 205 */ | ||||
|     LB_STRING, /* 206 */ | ||||
|     LB_SYMBOL, /* 207 */ | ||||
|     LB_KEYWORD, /* 208 */ | ||||
|     LB_ARRAY, /* 209 */ | ||||
|     LB_TUPLE, /* 210 */ | ||||
|     LB_TABLE, /* 211 */ | ||||
|     LB_TABLE_PROTO, /* 212 */ | ||||
|     LB_STRUCT, /* 213 */ | ||||
|     LB_BUFFER, /* 214 */ | ||||
|     LB_FUNCTION, /* 215 */ | ||||
|     LB_REGISTRY, /* 216 */ | ||||
|     LB_ABSTRACT, /* 217 */ | ||||
|     LB_REFERENCE, /* 218 */ | ||||
|     LB_FUNCENV_REF, /* 219 */ | ||||
|     LB_FUNCDEF_REF, /* 220 */ | ||||
|     LB_UNSAFE_CFUNCTION, /* 221 */ | ||||
|     LB_UNSAFE_POINTER /* 222 */ | ||||
|     LB_NIL, | ||||
|     LB_FALSE, | ||||
|     LB_TRUE, | ||||
|     LB_FIBER, | ||||
|     LB_INTEGER, | ||||
|     LB_STRING, | ||||
|     LB_SYMBOL, | ||||
|     LB_KEYWORD, | ||||
|     LB_ARRAY, | ||||
|     LB_TUPLE, | ||||
|     LB_TABLE, | ||||
|     LB_TABLE_PROTO, | ||||
|     LB_STRUCT, | ||||
|     LB_BUFFER, | ||||
|     LB_FUNCTION, | ||||
|     LB_REGISTRY, | ||||
|     LB_ABSTRACT, | ||||
|     LB_REFERENCE, | ||||
|     LB_FUNCENV_REF, | ||||
|     LB_FUNCDEF_REF | ||||
| } LeadBytes; | ||||
|  | ||||
| /* Helper to look inside an entry in an environment */ | ||||
| @@ -87,36 +84,19 @@ static Janet entry_getval(Janet env_entry) { | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Merge values from an environment into an existing lookup table. */ | ||||
| void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix, int recurse) { | ||||
|     while (env) { | ||||
|         for (int32_t i = 0; i < env->capacity; i++) { | ||||
|             if (janet_checktype(env->data[i].key, JANET_SYMBOL)) { | ||||
|                 if (prefix) { | ||||
|                     int32_t prelen = (int32_t) strlen(prefix); | ||||
|                     const uint8_t *oldsym = janet_unwrap_symbol(env->data[i].key); | ||||
|                     int32_t oldlen = janet_string_length(oldsym); | ||||
|                     uint8_t *symbuf = janet_smalloc(prelen + oldlen); | ||||
|                     safe_memcpy(symbuf, prefix, prelen); | ||||
|                     safe_memcpy(symbuf + prelen, oldsym, oldlen); | ||||
|                     Janet s = janet_symbolv(symbuf, prelen + oldlen); | ||||
|                     janet_sfree(symbuf); | ||||
|                     janet_table_put(renv, s, entry_getval(env->data[i].value)); | ||||
|                 } else { | ||||
|                     janet_table_put(renv, | ||||
|                                     env->data[i].key, | ||||
|                                     entry_getval(env->data[i].value)); | ||||
|                 } | ||||
|             } | ||||
|         } | ||||
|         env = recurse ? env->proto : NULL; | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Make a forward lookup table from an environment (for unmarshaling) */ | ||||
| JanetTable *janet_env_lookup(JanetTable *env) { | ||||
|     JanetTable *renv = janet_table(env->count); | ||||
|     janet_env_lookup_into(renv, env, NULL, 1); | ||||
|     while (env) { | ||||
|         for (int32_t i = 0; i < env->capacity; i++) { | ||||
|             if (janet_checktype(env->data[i].key, JANET_SYMBOL)) { | ||||
|                 janet_table_put(renv, | ||||
|                                 env->data[i].key, | ||||
|                                 entry_getval(env->data[i].value)); | ||||
|             } | ||||
|         } | ||||
|         env = env->proto; | ||||
|     } | ||||
|     return renv; | ||||
| } | ||||
|  | ||||
| @@ -185,43 +165,26 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) { | ||||
|             return; | ||||
|         } | ||||
|     } | ||||
|     janet_env_valid(env); | ||||
|     janet_v_push(st->seen_envs, env); | ||||
|     if (env->offset > 0 && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) { | ||||
|         pushint(st, 0); | ||||
|         pushint(st, env->length); | ||||
|         Janet *values = env->as.fiber->data + env->offset; | ||||
|         uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset; | ||||
|         for (int32_t i = 0; i < env->length; i++) { | ||||
|             if (1 & (bitset[i >> 5] >> (i & 0x1F))) { | ||||
|                 marshal_one(st, values[i], flags + 1); | ||||
|             } else { | ||||
|                 pushbyte(st, LB_NIL); | ||||
|             } | ||||
|         } | ||||
|     pushint(st, env->offset); | ||||
|     pushint(st, env->length); | ||||
|     if (env->offset) { | ||||
|         /* On stack variant */ | ||||
|         marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1); | ||||
|     } else { | ||||
|         janet_env_maybe_detach(env); | ||||
|         pushint(st, env->offset); | ||||
|         pushint(st, env->length); | ||||
|         if (env->offset > 0) { | ||||
|             /* On stack variant */ | ||||
|             marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1); | ||||
|         } else { | ||||
|             /* Off stack variant */ | ||||
|             for (int32_t i = 0; i < env->length; i++) | ||||
|                 marshal_one(st, env->as.values[i], flags + 1); | ||||
|         } | ||||
|         /* Off stack variant */ | ||||
|         for (int32_t i = 0; i < env->length; i++) | ||||
|             marshal_one(st, env->as.values[i], flags + 1); | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Marshal a sequence of u32s */ | ||||
| static void janet_marshal_u32s(MarshalState *st, const uint32_t *u32s, int32_t n) { | ||||
|     for (int32_t i = 0; i < n; i++) { | ||||
|         pushbyte(st, u32s[i] & 0xFF); | ||||
|         pushbyte(st, (u32s[i] >> 8) & 0xFF); | ||||
|         pushbyte(st, (u32s[i] >> 16) & 0xFF); | ||||
|         pushbyte(st, (u32s[i] >> 24) & 0xFF); | ||||
|     } | ||||
| /* Add function flags to janet functions */ | ||||
| static void janet_func_addflags(JanetFuncDef *def) { | ||||
|     if (def->name) def->flags |= JANET_FUNCDEF_FLAG_HASNAME; | ||||
|     if (def->source) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCE; | ||||
|     if (def->defs) def->flags |= JANET_FUNCDEF_FLAG_HASDEFS; | ||||
|     if (def->environments) def->flags |= JANET_FUNCDEF_FLAG_HASENVS; | ||||
|     if (def->sourcemap) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP; | ||||
| } | ||||
|  | ||||
| /* Marshal a function def */ | ||||
| @@ -234,6 +197,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) { | ||||
|             return; | ||||
|         } | ||||
|     } | ||||
|     janet_func_addflags(def); | ||||
|     /* Add to lookup */ | ||||
|     janet_v_push(st->seen_defs, def); | ||||
|     pushint(st, def->flags); | ||||
| @@ -257,7 +221,12 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) { | ||||
|         marshal_one(st, def->constants[i], flags); | ||||
|  | ||||
|     /* marshal the bytecode */ | ||||
|     janet_marshal_u32s(st, def->bytecode, def->bytecode_length); | ||||
|     for (int32_t i = 0; i < def->bytecode_length; i++) { | ||||
|         pushbyte(st, def->bytecode[i] & 0xFF); | ||||
|         pushbyte(st, (def->bytecode[i] >> 8) & 0xFF); | ||||
|         pushbyte(st, (def->bytecode[i] >> 16) & 0xFF); | ||||
|         pushbyte(st, (def->bytecode[i] >> 24) & 0xFF); | ||||
|     } | ||||
|  | ||||
|     /* marshal the environments if needed */ | ||||
|     for (int32_t i = 0; i < def->environments_length; i++) | ||||
| @@ -272,21 +241,16 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) { | ||||
|         int32_t current = 0; | ||||
|         for (int32_t i = 0; i < def->bytecode_length; i++) { | ||||
|             JanetSourceMapping map = def->sourcemap[i]; | ||||
|             pushint(st, map.line - current); | ||||
|             pushint(st, map.column); | ||||
|             current = map.line; | ||||
|             pushint(st, map.start - current); | ||||
|             pushint(st, map.end - map.start); | ||||
|             current = map.end; | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     /* Marshal closure bitset, if needed */ | ||||
|     if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) { | ||||
|         janet_marshal_u32s(st, def->closure_bitset, ((def->slotcount + 31) >> 5)); | ||||
|     } | ||||
| } | ||||
|  | ||||
| #define JANET_FIBER_FLAG_HASCHILD (1 << 29) | ||||
| #define JANET_FIBER_FLAG_HASENV   (1 << 30) | ||||
| #define JANET_STACKFRAME_HASENV   (INT32_MIN) | ||||
| #define JANET_FIBER_FLAG_HASENV (1 << 28) | ||||
| #define JANET_STACKFRAME_HASENV (1 << 30) | ||||
|  | ||||
| /* Marshal a fiber */ | ||||
| static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) { | ||||
| @@ -357,13 +321,6 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) { | ||||
|     marshal_one(st, x, ctx->flags + 1); | ||||
| } | ||||
|  | ||||
| void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) { | ||||
|     MarshalState *st = (MarshalState *)(ctx->m_state); | ||||
|     janet_table_put(&st->seen, | ||||
|                     janet_wrap_abstract(abstract), | ||||
|                     janet_wrap_integer(st->nextid++)); | ||||
| } | ||||
|  | ||||
| #define MARK_SEEN() \ | ||||
|     janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)) | ||||
|  | ||||
| @@ -371,9 +328,11 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) { | ||||
|     void *abstract = janet_unwrap_abstract(x); | ||||
|     const JanetAbstractType *at = janet_abstract_type(abstract); | ||||
|     if (at->marshal) { | ||||
|         MARK_SEEN(); | ||||
|         JanetMarshalContext context = {st, NULL, flags, NULL}; | ||||
|         pushbyte(st, LB_ABSTRACT); | ||||
|         marshal_one(st, janet_csymbolv(at->name), flags + 1); | ||||
|         JanetMarshalContext context = {st, NULL, flags, NULL, at}; | ||||
|         push64(st, (uint64_t) janet_abstract_size(abstract)); | ||||
|         at->marshal(abstract, &context); | ||||
|     } else { | ||||
|         janet_panicf("try to marshal unregistered abstract type, cannot marshal %p", x); | ||||
| @@ -542,10 +501,9 @@ static void marshal_one(MarshalState *st, Janet x, int flags) { | ||||
|         case JANET_FUNCTION: { | ||||
|             pushbyte(st, LB_FUNCTION); | ||||
|             JanetFunction *func = janet_unwrap_function(x); | ||||
|             /* Mark seen before reading def */ | ||||
|             MARK_SEEN(); | ||||
|             pushint(st, func->def->environments_length); | ||||
|             marshal_one_def(st, func->def, flags); | ||||
|             /* Mark seen after reading def, but before envs */ | ||||
|             MARK_SEEN(); | ||||
|             for (int32_t i = 0; i < func->def->environments_length; i++) | ||||
|                 marshal_one_env(st, func->envs[i], flags + 1); | ||||
|             return; | ||||
| @@ -556,25 +514,9 @@ static void marshal_one(MarshalState *st, Janet x, int flags) { | ||||
|             marshal_one_fiber(st, janet_unwrap_fiber(x), flags + 1); | ||||
|             return; | ||||
|         } | ||||
|         case JANET_CFUNCTION: { | ||||
|             if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry; | ||||
|             MARK_SEEN(); | ||||
|             pushbyte(st, LB_UNSAFE_CFUNCTION); | ||||
|             JanetCFunction cfn = janet_unwrap_cfunction(x); | ||||
|             pushbytes(st, (uint8_t *) &cfn, sizeof(JanetCFunction)); | ||||
|             return; | ||||
|         } | ||||
|         case JANET_POINTER: { | ||||
|             if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry; | ||||
|             MARK_SEEN(); | ||||
|             pushbyte(st, LB_UNSAFE_POINTER); | ||||
|             void *ptr = janet_unwrap_pointer(x); | ||||
|             pushbytes(st, (uint8_t *) &ptr, sizeof(void *)); | ||||
|             return; | ||||
|         } | ||||
|     no_registry: | ||||
|         default: { | ||||
|             janet_panicf("no registry value and cannot marshal %p", x); | ||||
|             return; | ||||
|         } | ||||
|     } | ||||
| #undef MARK_SEEN | ||||
| @@ -593,6 +535,7 @@ void janet_marshal( | ||||
|     st.rreg = rreg; | ||||
|     janet_table_init(&st.seen, 0); | ||||
|     marshal_one(&st, x, flags); | ||||
|     /* Clean up. See comment in janet_unmarshal about autoreleasing memory on panics.*/ | ||||
|     janet_table_deinit(&st.seen); | ||||
|     janet_v_free(st.seen_envs); | ||||
|     janet_v_free(st.seen_defs); | ||||
| @@ -600,7 +543,7 @@ void janet_marshal( | ||||
|  | ||||
| typedef struct { | ||||
|     jmp_buf err; | ||||
|     Janet *lookup; | ||||
|     JanetArray lookup; | ||||
|     JanetTable *reg; | ||||
|     JanetFuncEnv **lookup_envs; | ||||
|     JanetFuncDef **lookup_defs; | ||||
| @@ -644,15 +587,6 @@ static int32_t readint(UnmarshalState *st, const uint8_t **atdata) { | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| /* Helper to read a natural number (int >= 0). */ | ||||
| static int32_t readnat(UnmarshalState *st, const uint8_t **atdata) { | ||||
|     int32_t ret = readint(st, atdata); | ||||
|     if (ret < 0) { | ||||
|         janet_panicf("expected integer >= 0, got %d", ret); | ||||
|     } | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| /* Helper to read a size_t (up to 8 bytes unsigned). */ | ||||
| static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) { | ||||
|     uint64_t ret; | ||||
| @@ -721,51 +655,36 @@ static const uint8_t *unmarshal_one_env( | ||||
|         JanetFuncEnv *env = janet_gcalloc(JANET_MEMORY_FUNCENV, sizeof(JanetFuncEnv)); | ||||
|         env->length = 0; | ||||
|         env->offset = 0; | ||||
|         env->as.values = NULL; | ||||
|         janet_v_push(st->lookup_envs, env); | ||||
|         int32_t offset = readnat(st, &data); | ||||
|         int32_t length = readnat(st, &data); | ||||
|         if (offset > 0) { | ||||
|         int32_t offset = readint(st, &data); | ||||
|         int32_t length = readint(st, &data); | ||||
|         if (offset) { | ||||
|             Janet fiberv; | ||||
|             /* On stack variant */ | ||||
|             data = unmarshal_one(st, data, &fiberv, flags); | ||||
|             janet_asserttype(fiberv, JANET_FIBER); | ||||
|             env->as.fiber = janet_unwrap_fiber(fiberv); | ||||
|             /* Negative offset indicates untrusted input */ | ||||
|             env->offset = -offset; | ||||
|             /* Unmarshalling fiber may set values */ | ||||
|             if (env->offset != 0 && env->offset != offset) | ||||
|                 janet_panic("invalid funcenv offset"); | ||||
|             if (env->length != 0 && env->length != length) | ||||
|                 janet_panic("invalid funcenv length"); | ||||
|         } else { | ||||
|             /* Off stack variant */ | ||||
|             if (length == 0) { | ||||
|                 janet_panic("invalid funcenv length"); | ||||
|             } | ||||
|             env->as.values = janet_malloc(sizeof(Janet) * (size_t) length); | ||||
|             env->as.values = malloc(sizeof(Janet) * length); | ||||
|             if (!env->as.values) { | ||||
|                 JANET_OUT_OF_MEMORY; | ||||
|             } | ||||
|             env->offset = 0; | ||||
|             for (int32_t i = 0; i < length; i++) | ||||
|                 data = unmarshal_one(st, data, env->as.values + i, flags); | ||||
|         } | ||||
|         env->offset = offset; | ||||
|         env->length = length; | ||||
|         *out = env; | ||||
|     } | ||||
|     return data; | ||||
| } | ||||
|  | ||||
| /* Unmarshal a series of u32s */ | ||||
| static const uint8_t *janet_unmarshal_u32s(UnmarshalState *st, const uint8_t *data, uint32_t *into, int32_t n) { | ||||
|     for (int32_t i = 0; i < n; i++) { | ||||
|         MARSH_EOS(st, data + 3); | ||||
|         into[i] = | ||||
|             (uint32_t)(data[0]) | | ||||
|             ((uint32_t)(data[1]) << 8) | | ||||
|             ((uint32_t)(data[2]) << 16) | | ||||
|             ((uint32_t)(data[3]) << 24); | ||||
|         data += 4; | ||||
|     } | ||||
|     return data; | ||||
| } | ||||
|  | ||||
| /* Unmarshal a funcdef */ | ||||
| static const uint8_t *unmarshal_one_def( | ||||
|     UnmarshalState *st, | ||||
| @@ -789,12 +708,6 @@ static const uint8_t *unmarshal_one_def( | ||||
|         def->bytecode_length = 0; | ||||
|         def->name = NULL; | ||||
|         def->source = NULL; | ||||
|         def->closure_bitset = NULL; | ||||
|         def->defs = NULL; | ||||
|         def->environments = NULL; | ||||
|         def->constants = NULL; | ||||
|         def->bytecode = NULL; | ||||
|         def->sourcemap = NULL; | ||||
|         janet_v_push(st->lookup_defs, def); | ||||
|  | ||||
|         /* Set default lengths to zero */ | ||||
| @@ -805,18 +718,18 @@ static const uint8_t *unmarshal_one_def( | ||||
|  | ||||
|         /* Read flags and other fixed values */ | ||||
|         def->flags = readint(st, &data); | ||||
|         def->slotcount = readnat(st, &data); | ||||
|         def->arity = readnat(st, &data); | ||||
|         def->min_arity = readnat(st, &data); | ||||
|         def->max_arity = readnat(st, &data); | ||||
|         def->slotcount = readint(st, &data); | ||||
|         def->arity = readint(st, &data); | ||||
|         def->min_arity = readint(st, &data); | ||||
|         def->max_arity = readint(st, &data); | ||||
|  | ||||
|         /* Read some lengths */ | ||||
|         constants_length = readnat(st, &data); | ||||
|         bytecode_length = readnat(st, &data); | ||||
|         constants_length = readint(st, &data); | ||||
|         bytecode_length = readint(st, &data); | ||||
|         if (def->flags & JANET_FUNCDEF_FLAG_HASENVS) | ||||
|             environments_length = readnat(st, &data); | ||||
|             environments_length = readint(st, &data); | ||||
|         if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS) | ||||
|             defs_length = readnat(st, &data); | ||||
|             defs_length = readint(st, &data); | ||||
|  | ||||
|         /* Check name and source (optional) */ | ||||
|         if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) { | ||||
| @@ -834,7 +747,7 @@ static const uint8_t *unmarshal_one_def( | ||||
|  | ||||
|         /* Unmarshal constants */ | ||||
|         if (constants_length) { | ||||
|             def->constants = janet_malloc(sizeof(Janet) * constants_length); | ||||
|             def->constants = malloc(sizeof(Janet) * constants_length); | ||||
|             if (!def->constants) { | ||||
|                 JANET_OUT_OF_MEMORY; | ||||
|             } | ||||
| @@ -846,16 +759,24 @@ static const uint8_t *unmarshal_one_def( | ||||
|         def->constants_length = constants_length; | ||||
|  | ||||
|         /* Unmarshal bytecode */ | ||||
|         def->bytecode = janet_malloc(sizeof(uint32_t) * bytecode_length); | ||||
|         def->bytecode = malloc(sizeof(uint32_t) * bytecode_length); | ||||
|         if (!def->bytecode) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|         data = janet_unmarshal_u32s(st, data, def->bytecode, bytecode_length); | ||||
|         for (int32_t i = 0; i < bytecode_length; i++) { | ||||
|             MARSH_EOS(st, data + 3); | ||||
|             def->bytecode[i] = | ||||
|                 (uint32_t)(data[0]) | | ||||
|                 ((uint32_t)(data[1]) << 8) | | ||||
|                 ((uint32_t)(data[2]) << 16) | | ||||
|                 ((uint32_t)(data[3]) << 24); | ||||
|             data += 4; | ||||
|         } | ||||
|         def->bytecode_length = bytecode_length; | ||||
|  | ||||
|         /* Unmarshal environments */ | ||||
|         if (def->flags & JANET_FUNCDEF_FLAG_HASENVS) { | ||||
|             def->environments = janet_calloc(1, sizeof(int32_t) * (size_t) environments_length); | ||||
|             def->environments = calloc(1, sizeof(int32_t) * environments_length); | ||||
|             if (!def->environments) { | ||||
|                 JANET_OUT_OF_MEMORY; | ||||
|             } | ||||
| @@ -869,7 +790,7 @@ static const uint8_t *unmarshal_one_def( | ||||
|  | ||||
|         /* Unmarshal sub funcdefs */ | ||||
|         if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS) { | ||||
|             def->defs = janet_calloc(1, sizeof(JanetFuncDef *) * (size_t) defs_length); | ||||
|             def->defs = calloc(1, sizeof(JanetFuncDef *) * defs_length); | ||||
|             if (!def->defs) { | ||||
|                 JANET_OUT_OF_MEMORY; | ||||
|             } | ||||
| @@ -884,29 +805,20 @@ static const uint8_t *unmarshal_one_def( | ||||
|         /* Unmarshal source maps if needed */ | ||||
|         if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) { | ||||
|             int32_t current = 0; | ||||
|             def->sourcemap = janet_malloc(sizeof(JanetSourceMapping) * (size_t) bytecode_length); | ||||
|             def->sourcemap = malloc(sizeof(JanetSourceMapping) * bytecode_length); | ||||
|             if (!def->sourcemap) { | ||||
|                 JANET_OUT_OF_MEMORY; | ||||
|             } | ||||
|             for (int32_t i = 0; i < bytecode_length; i++) { | ||||
|                 current += readint(st, &data); | ||||
|                 def->sourcemap[i].line = current; | ||||
|                 def->sourcemap[i].column = readint(st, &data); | ||||
|                 def->sourcemap[i].start = current; | ||||
|                 current += readint(st, &data); | ||||
|                 def->sourcemap[i].end = current; | ||||
|             } | ||||
|         } else { | ||||
|             def->sourcemap = NULL; | ||||
|         } | ||||
|  | ||||
|         /* Unmarshal closure bitset if needed */ | ||||
|         if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) { | ||||
|             int32_t n = (def->slotcount + 31) >> 5; | ||||
|             def->closure_bitset = janet_malloc(sizeof(uint32_t) * (size_t) n); | ||||
|             if (NULL == def->closure_bitset) { | ||||
|                 JANET_OUT_OF_MEMORY; | ||||
|             } | ||||
|             data = janet_unmarshal_u32s(st, data, def->closure_bitset, n); | ||||
|         } | ||||
|  | ||||
|         /* Validate */ | ||||
|         if (janet_verify(def)) | ||||
|             janet_panic("funcdef has invalid bytecode"); | ||||
| @@ -924,7 +836,7 @@ static const uint8_t *unmarshal_one_fiber( | ||||
|     JanetFiber **out, | ||||
|     int flags) { | ||||
|  | ||||
|     /* Initialize a new fiber with gc friendly defaults */ | ||||
|     /* Initialize a new fiber */ | ||||
|     JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber)); | ||||
|     fiber->flags = 0; | ||||
|     fiber->frame = 0; | ||||
| @@ -935,50 +847,46 @@ static const uint8_t *unmarshal_one_fiber( | ||||
|     fiber->data = NULL; | ||||
|     fiber->child = NULL; | ||||
|     fiber->env = NULL; | ||||
| #ifdef JANET_EV | ||||
|     fiber->waiting = NULL; | ||||
|     fiber->sched_id = 0; | ||||
|     fiber->supervisor_channel = NULL; | ||||
| #endif | ||||
|  | ||||
|     /* Push fiber to seen stack */ | ||||
|     janet_v_push(st->lookup, janet_wrap_fiber(fiber)); | ||||
|     janet_array_push(&st->lookup, janet_wrap_fiber(fiber)); | ||||
|  | ||||
|     /* Set frame later so fiber can be GCed at anytime if unmarshalling fails */ | ||||
|     int32_t frame = 0; | ||||
|     int32_t stack = 0; | ||||
|     int32_t stacktop = 0; | ||||
|  | ||||
|     /* Read ints */ | ||||
|     int32_t fiber_flags = readint(st, &data); | ||||
|     int32_t frame = readnat(st, &data); | ||||
|     int32_t fiber_stackstart = readnat(st, &data); | ||||
|     int32_t fiber_stacktop = readnat(st, &data); | ||||
|     int32_t fiber_maxstack = readnat(st, &data); | ||||
|     JanetTable *fiber_env = NULL; | ||||
|     fiber->flags = readint(st, &data); | ||||
|     frame = readint(st, &data); | ||||
|     fiber->stackstart = readint(st, &data); | ||||
|     fiber->stacktop = readint(st, &data); | ||||
|     fiber->maxstack = readint(st, &data); | ||||
|  | ||||
|     /* Check for bad flags and ints */ | ||||
|     if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber_stackstart || | ||||
|             fiber_stackstart > fiber_stacktop || | ||||
|             fiber_stacktop > fiber_maxstack) { | ||||
|     if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber->stackstart || | ||||
|             fiber->stackstart > fiber->stacktop || | ||||
|             fiber->stacktop > fiber->maxstack) { | ||||
|         janet_panic("fiber has incorrect stack setup"); | ||||
|     } | ||||
|  | ||||
|     /* Allocate stack memory */ | ||||
|     fiber->capacity = fiber_stacktop + 10; | ||||
|     fiber->data = janet_malloc(sizeof(Janet) * fiber->capacity); | ||||
|     fiber->capacity = fiber->stacktop + 10; | ||||
|     fiber->data = malloc(sizeof(Janet) * fiber->capacity); | ||||
|     if (!fiber->data) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
|     for (int32_t i = 0; i < fiber->capacity; i++) { | ||||
|         fiber->data[i] = janet_wrap_nil(); | ||||
|     } | ||||
|  | ||||
|     /* get frames */ | ||||
|     int32_t stack = frame; | ||||
|     int32_t stacktop = fiber_stackstart - JANET_FRAME_SIZE; | ||||
|     stack = frame; | ||||
|     stacktop = fiber->stackstart - JANET_FRAME_SIZE; | ||||
|     while (stack > 0) { | ||||
|         JanetFunction *func = NULL; | ||||
|         JanetFuncDef *def = NULL; | ||||
|         JanetFuncEnv *env = NULL; | ||||
|         int32_t frameflags = readint(st, &data); | ||||
|         int32_t prevframe = readnat(st, &data); | ||||
|         int32_t pcdiff = readnat(st, &data); | ||||
|         int32_t prevframe = readint(st, &data); | ||||
|         int32_t pcdiff = readint(st, &data); | ||||
|  | ||||
|         /* Get frame items */ | ||||
|         Janet *framestack = fiber->data + stack; | ||||
| @@ -994,7 +902,15 @@ static const uint8_t *unmarshal_one_fiber( | ||||
|         /* Check env */ | ||||
|         if (frameflags & JANET_STACKFRAME_HASENV) { | ||||
|             frameflags &= ~JANET_STACKFRAME_HASENV; | ||||
|             int32_t offset = stack; | ||||
|             int32_t length = stacktop - stack; | ||||
|             data = unmarshal_one_env(st, data, &env, flags + 1); | ||||
|             if (env->offset != 0 && env->offset != offset) | ||||
|                 janet_panic("funcenv offset does not match fiber frame"); | ||||
|             if (env->length != 0 && env->length != length) | ||||
|                 janet_panic("funcenv length does not match fiber frame"); | ||||
|             env->offset = offset; | ||||
|             env->length = length; | ||||
|         } | ||||
|  | ||||
|         /* Error checking */ | ||||
| @@ -1002,11 +918,11 @@ static const uint8_t *unmarshal_one_fiber( | ||||
|         if (expected_framesize != stacktop - stack) { | ||||
|             janet_panic("fiber stackframe size mismatch"); | ||||
|         } | ||||
|         if (pcdiff >= def->bytecode_length) { | ||||
|         if (pcdiff < 0 || pcdiff >= def->bytecode_length) { | ||||
|             janet_panic("fiber stackframe has invalid pc"); | ||||
|         } | ||||
|         if ((int32_t)(prevframe + JANET_FRAME_SIZE) > stack) { | ||||
|             janet_panic("fiber stackframe does not align with previous frame"); | ||||
|             janet_panic("fibre stackframe does not align with previous frame"); | ||||
|         } | ||||
|  | ||||
|         /* Get stack items */ | ||||
| @@ -1029,46 +945,29 @@ static const uint8_t *unmarshal_one_fiber( | ||||
|     } | ||||
|  | ||||
|     /* Check for fiber env */ | ||||
|     if (fiber_flags & JANET_FIBER_FLAG_HASENV) { | ||||
|     if (fiber->flags & JANET_FIBER_FLAG_HASENV) { | ||||
|         Janet envv; | ||||
|         fiber_flags &= ~JANET_FIBER_FLAG_HASENV; | ||||
|         fiber->flags &= ~JANET_FIBER_FLAG_HASENV; | ||||
|         data = unmarshal_one(st, data, &envv, flags + 1); | ||||
|         janet_asserttype(envv, JANET_TABLE); | ||||
|         fiber_env = janet_unwrap_table(envv); | ||||
|         fiber->env = janet_unwrap_table(envv); | ||||
|     } | ||||
|  | ||||
|     /* Check for child fiber */ | ||||
|     if (fiber_flags & JANET_FIBER_FLAG_HASCHILD) { | ||||
|     if (fiber->flags & JANET_FIBER_FLAG_HASCHILD) { | ||||
|         Janet fiberv; | ||||
|         fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD; | ||||
|         fiber->flags &= ~JANET_FIBER_FLAG_HASCHILD; | ||||
|         data = unmarshal_one(st, data, &fiberv, flags + 1); | ||||
|         janet_asserttype(fiberv, JANET_FIBER); | ||||
|         fiber->child = janet_unwrap_fiber(fiberv); | ||||
|     } | ||||
|  | ||||
|     /* We have valid fiber, finally construct remaining fields. */ | ||||
|     fiber->frame = frame; | ||||
|     fiber->flags = fiber_flags; | ||||
|     fiber->stackstart = fiber_stackstart; | ||||
|     fiber->stacktop = fiber_stacktop; | ||||
|     fiber->maxstack = fiber_maxstack; | ||||
|     fiber->env = fiber_env; | ||||
|  | ||||
|     int status = janet_fiber_status(fiber); | ||||
|     if (status < 0 || status > JANET_STATUS_ALIVE) { | ||||
|         janet_panic("invalid fiber status"); | ||||
|     } | ||||
|  | ||||
|     /* Return data */ | ||||
|     fiber->frame = frame; | ||||
|     *out = fiber; | ||||
|     return data; | ||||
| } | ||||
|  | ||||
| void janet_unmarshal_ensure(JanetMarshalContext *ctx, size_t size) { | ||||
|     UnmarshalState *st = (UnmarshalState *)(ctx->u_state); | ||||
|     MARSH_EOS(st, ctx->data + size); | ||||
| } | ||||
|  | ||||
| int32_t janet_unmarshal_int(JanetMarshalContext *ctx) { | ||||
|     UnmarshalState *st = (UnmarshalState *)(ctx->u_state); | ||||
|     return readint(st, &(ctx->data)); | ||||
| @@ -1092,7 +991,7 @@ uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) { | ||||
| void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len) { | ||||
|     UnmarshalState *st = (UnmarshalState *)(ctx->u_state); | ||||
|     MARSH_EOS(st, ctx->data + len - 1); | ||||
|     safe_memcpy(dest, ctx->data, len); | ||||
|     memcpy(dest, ctx->data, len); | ||||
|     ctx->data += len; | ||||
| } | ||||
|  | ||||
| @@ -1103,32 +1002,19 @@ Janet janet_unmarshal_janet(JanetMarshalContext *ctx) { | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) { | ||||
|     UnmarshalState *st = (UnmarshalState *)(ctx->u_state); | ||||
|     if (ctx->at == NULL) { | ||||
|         janet_panicf("janet_unmarshal_abstract called more than once"); | ||||
|     } | ||||
|     void *p = janet_abstract(ctx->at, size); | ||||
|     janet_v_push(st->lookup, janet_wrap_abstract(p)); | ||||
|     ctx->at = NULL; | ||||
|     return p; | ||||
| } | ||||
|  | ||||
| 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); | ||||
|     const JanetAbstractType *at = janet_get_abstract_type(key); | ||||
|     if (at == NULL) goto oops; | ||||
|     if (at == NULL) return NULL; | ||||
|     if (at->unmarshal) { | ||||
|         JanetMarshalContext context = {NULL, st, flags, data, at}; | ||||
|         *out = janet_wrap_abstract(at->unmarshal(&context)); | ||||
|         if (context.at != NULL) { | ||||
|             janet_panicf("janet_unmarshal_abstract not called"); | ||||
|         } | ||||
|         return context.data; | ||||
|         void *p = janet_abstract(at, (size_t) read64(st, &data)); | ||||
|         JanetMarshalContext context = {NULL, st, flags, data}; | ||||
|         at->unmarshal(p, &context); | ||||
|         *out = janet_wrap_abstract(p); | ||||
|         return data; | ||||
|     } | ||||
| oops: | ||||
|     janet_panic("invalid abstract type"); | ||||
|     return NULL; | ||||
| } | ||||
|  | ||||
| static const uint8_t *unmarshal_one( | ||||
| @@ -1140,7 +1026,7 @@ static const uint8_t *unmarshal_one( | ||||
|     MARSH_STACKCHECK; | ||||
|     MARSH_EOS(st, data); | ||||
|     lead = data[0]; | ||||
|     if (lead < LB_REAL) { | ||||
|     if (lead < 200) { | ||||
|         *out = janet_wrap_integer(readint(st, &data)); | ||||
|         return data; | ||||
|     } | ||||
| @@ -1176,7 +1062,7 @@ static const uint8_t *unmarshal_one( | ||||
|             u.bytes[0] = data[8]; | ||||
|             u.bytes[1] = data[7]; | ||||
|             u.bytes[2] = data[6]; | ||||
|             u.bytes[3] = data[5]; | ||||
|             u.bytes[5] = data[5]; | ||||
|             u.bytes[4] = data[4]; | ||||
|             u.bytes[5] = data[3]; | ||||
|             u.bytes[6] = data[2]; | ||||
| @@ -1184,8 +1070,8 @@ static const uint8_t *unmarshal_one( | ||||
| #else | ||||
|             memcpy(&u.bytes, data + 1, sizeof(double)); | ||||
| #endif | ||||
|             *out = janet_wrap_number_safe(u.d); | ||||
|             janet_v_push(st->lookup, *out); | ||||
|             *out = janet_wrap_number(u.d); | ||||
|             janet_array_push(&st->lookup, *out); | ||||
|             return data + 9; | ||||
|         } | ||||
|         case LB_STRING: | ||||
| @@ -1194,7 +1080,7 @@ static const uint8_t *unmarshal_one( | ||||
|         case LB_KEYWORD: | ||||
|         case LB_REGISTRY: { | ||||
|             data++; | ||||
|             int32_t len = readnat(st, &data); | ||||
|             int32_t len = readint(st, &data); | ||||
|             MARSH_EOS(st, data - 1 + len); | ||||
|             if (lead == LB_STRING) { | ||||
|                 const uint8_t *str = janet_string(data, len); | ||||
| @@ -1215,10 +1101,10 @@ static const uint8_t *unmarshal_one( | ||||
|             } else { /* (lead == LB_BUFFER) */ | ||||
|                 JanetBuffer *buffer = janet_buffer(len); | ||||
|                 buffer->count = len; | ||||
|                 safe_memcpy(buffer->data, data, len); | ||||
|                 memcpy(buffer->data, data, len); | ||||
|                 *out = janet_wrap_buffer(buffer); | ||||
|             } | ||||
|             janet_v_push(st->lookup, *out); | ||||
|             janet_array_push(&st->lookup, *out); | ||||
|             return data + len; | ||||
|         } | ||||
|         case LB_FIBER: { | ||||
| @@ -1230,20 +1116,12 @@ static const uint8_t *unmarshal_one( | ||||
|         case LB_FUNCTION: { | ||||
|             JanetFunction *func; | ||||
|             JanetFuncDef *def; | ||||
|             data++; | ||||
|             int32_t len = readnat(st, &data); | ||||
|             if (len > 255) { | ||||
|                 janet_panicf("invalid function"); | ||||
|             } | ||||
|             data = unmarshal_one_def(st, data + 1, &def, flags + 1); | ||||
|             func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) + | ||||
|                                  len * sizeof(JanetFuncEnv)); | ||||
|             *out = janet_wrap_function(func); | ||||
|             janet_v_push(st->lookup, *out); | ||||
|             data = unmarshal_one_def(st, data, &def, flags + 1); | ||||
|             if (def->environments_length != len) { | ||||
|                 janet_panicf("invalid function"); | ||||
|             } | ||||
|                                  def->environments_length * sizeof(JanetFuncEnv)); | ||||
|             func->def = def; | ||||
|             *out = janet_wrap_function(func); | ||||
|             janet_array_push(&st->lookup, *out); | ||||
|             for (int32_t i = 0; i < def->environments_length; i++) { | ||||
|                 data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1); | ||||
|             } | ||||
| @@ -1262,17 +1140,13 @@ static const uint8_t *unmarshal_one( | ||||
|             /* Things that open with integers */ | ||||
|         { | ||||
|             data++; | ||||
|             int32_t len = readnat(st, &data); | ||||
|             /* DOS check */ | ||||
|             if (lead != LB_REFERENCE) { | ||||
|                 MARSH_EOS(st, data - 1 + len); | ||||
|             } | ||||
|             int32_t len = readint(st, &data); | ||||
|             if (lead == LB_ARRAY) { | ||||
|                 /* Array */ | ||||
|                 JanetArray *array = janet_array(len); | ||||
|                 array->count = len; | ||||
|                 *out = janet_wrap_array(array); | ||||
|                 janet_v_push(st->lookup, *out); | ||||
|                 janet_array_push(&st->lookup, *out); | ||||
|                 for (int32_t i = 0; i < len; i++) { | ||||
|                     data = unmarshal_one(st, data, array->data + i, flags + 1); | ||||
|                 } | ||||
| @@ -1285,7 +1159,7 @@ static const uint8_t *unmarshal_one( | ||||
|                     data = unmarshal_one(st, data, tup + i, flags + 1); | ||||
|                 } | ||||
|                 *out = janet_wrap_tuple(janet_tuple_end(tup)); | ||||
|                 janet_v_push(st->lookup, *out); | ||||
|                 janet_array_push(&st->lookup, *out); | ||||
|             } else if (lead == LB_STRUCT) { | ||||
|                 /* Struct */ | ||||
|                 JanetKV *struct_ = janet_struct_begin(len); | ||||
| @@ -1296,16 +1170,16 @@ static const uint8_t *unmarshal_one( | ||||
|                     janet_struct_put(struct_, key, value); | ||||
|                 } | ||||
|                 *out = janet_wrap_struct(janet_struct_end(struct_)); | ||||
|                 janet_v_push(st->lookup, *out); | ||||
|                 janet_array_push(&st->lookup, *out); | ||||
|             } else if (lead == LB_REFERENCE) { | ||||
|                 if (len >= janet_v_count(st->lookup)) | ||||
|                 if (len < 0 || len >= st->lookup.count) | ||||
|                     janet_panicf("invalid reference %d", len); | ||||
|                 *out = st->lookup[len]; | ||||
|                 *out = st->lookup.data[len]; | ||||
|             } else { | ||||
|                 /* Table */ | ||||
|                 JanetTable *t = janet_table(len); | ||||
|                 *out = janet_wrap_table(t); | ||||
|                 janet_v_push(st->lookup, *out); | ||||
|                 janet_array_push(&st->lookup, *out); | ||||
|                 if (lead == LB_TABLE_PROTO) { | ||||
|                     Janet proto; | ||||
|                     data = unmarshal_one(st, data, &proto, flags + 1); | ||||
| @@ -1321,42 +1195,6 @@ static const uint8_t *unmarshal_one( | ||||
|             } | ||||
|             return data; | ||||
|         } | ||||
|         case LB_UNSAFE_POINTER: { | ||||
|             MARSH_EOS(st, data + sizeof(void *)); | ||||
|             data++; | ||||
|             if (!(flags & JANET_MARSHAL_UNSAFE)) { | ||||
|                 janet_panicf("unsafe flag not given, " | ||||
|                              "will not unmarshal raw pointer at index %d", | ||||
|                              (int)(data - st->start)); | ||||
|             } | ||||
|             union { | ||||
|                 void *ptr; | ||||
|                 uint8_t bytes[sizeof(void *)]; | ||||
|             } u; | ||||
|             memcpy(u.bytes, data, sizeof(void *)); | ||||
|             data += sizeof(void *); | ||||
|             *out = janet_wrap_pointer(u.ptr); | ||||
|             janet_v_push(st->lookup, *out); | ||||
|             return data; | ||||
|         } | ||||
|         case LB_UNSAFE_CFUNCTION: { | ||||
|             MARSH_EOS(st, data + sizeof(JanetCFunction)); | ||||
|             data++; | ||||
|             if (!(flags & JANET_MARSHAL_UNSAFE)) { | ||||
|                 janet_panicf("unsafe flag not given, " | ||||
|                              "will not unmarshal function pointer at index %d", | ||||
|                              (int)(data - st->start)); | ||||
|             } | ||||
|             union { | ||||
|                 JanetCFunction ptr; | ||||
|                 uint8_t bytes[sizeof(JanetCFunction)]; | ||||
|             } u; | ||||
|             memcpy(u.bytes, data, sizeof(JanetCFunction)); | ||||
|             data += sizeof(JanetCFunction); | ||||
|             *out = janet_wrap_cfunction(u.ptr); | ||||
|             janet_v_push(st->lookup, *out); | ||||
|             return data; | ||||
|         } | ||||
|         default: { | ||||
|             janet_panicf("unknown byte %x at index %d", | ||||
|                          *data, | ||||
| @@ -1378,14 +1216,17 @@ Janet janet_unmarshal( | ||||
|     st.end = bytes + len; | ||||
|     st.lookup_defs = NULL; | ||||
|     st.lookup_envs = NULL; | ||||
|     st.lookup = NULL; | ||||
|     st.reg = reg; | ||||
|     janet_array_init(&st.lookup, 0); | ||||
|     Janet out; | ||||
|     const uint8_t *nextbytes = unmarshal_one(&st, bytes, &out, flags); | ||||
|     if (next) *next = nextbytes; | ||||
|     /* Clean up - this should be auto released on panics, TODO. We should | ||||
|      * change the vector implementation to track allocations for auto release, and | ||||
|      * make st.lookup auto release as well, or move to heap. */ | ||||
|     janet_array_deinit(&st.lookup); | ||||
|     janet_v_free(st.lookup_defs); | ||||
|     janet_v_free(st.lookup_envs); | ||||
|     janet_v_free(st.lookup); | ||||
|     return out; | ||||
| } | ||||
|  | ||||
| @@ -1398,7 +1239,7 @@ static Janet cfun_env_lookup(int32_t argc, Janet *argv) { | ||||
| } | ||||
|  | ||||
| static Janet cfun_marshal(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 3); | ||||
|     janet_arity(argc, 1, 2); | ||||
|     JanetBuffer *buffer; | ||||
|     JanetTable *rreg = NULL; | ||||
|     if (argc > 1) { | ||||
| @@ -1426,18 +1267,18 @@ static Janet cfun_unmarshal(int32_t argc, Janet *argv) { | ||||
| static const JanetReg marsh_cfuns[] = { | ||||
|     { | ||||
|         "marshal", cfun_marshal, | ||||
|         JDOC("(marshal x &opt reverse-lookup buffer)\n\n" | ||||
|              "Marshal a value into a buffer and return the buffer. The buffer " | ||||
|              "can then later be unmarshalled to reconstruct the initial value. " | ||||
|         JDOC("(marshal x [,reverse-lookup [,buffer]])\n\n" | ||||
|              "Marshal a janet value into a buffer and return the buffer. The buffer " | ||||
|              "can the later be unmarshalled to reconstruct the initial value. " | ||||
|              "Optionally, one can pass in a reverse lookup table to not marshal " | ||||
|              "aliased values that are found in the table. Then a forward " | ||||
|              "lookup table can be used to recover the original value when " | ||||
|              "aliased values that are found in the table. Then a forward" | ||||
|              "lookup table can be used to recover the original janet value when " | ||||
|              "unmarshalling.") | ||||
|     }, | ||||
|     { | ||||
|         "unmarshal", cfun_unmarshal, | ||||
|         JDOC("(unmarshal buffer &opt lookup)\n\n" | ||||
|              "Unmarshal a value from a buffer. An optional lookup table " | ||||
|         JDOC("(unmarshal buffer [,lookup])\n\n" | ||||
|              "Unmarshal a janet value from a buffer. An optional lookup table " | ||||
|              "can be provided to allow for aliases to be resolved. Returns the value " | ||||
|              "unmarshalled from the buffer.") | ||||
|     }, | ||||
|   | ||||
							
								
								
									
										353
									
								
								src/core/math.c
									
									
									
									
									
								
							
							
						
						
									
										353
									
								
								src/core/math.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -20,219 +20,36 @@ | ||||
| * IN THE SOFTWARE. | ||||
| */ | ||||
|  | ||||
| #include <math.h> | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "util.h" | ||||
| #endif | ||||
|  | ||||
| #include <math.h> | ||||
|  | ||||
| static JANET_THREAD_LOCAL JanetRNG janet_vm_rng = {0, 0, 0, 0, 0}; | ||||
|  | ||||
| static int janet_rng_get(void *p, Janet key, Janet *out); | ||||
| static Janet janet_rng_next(void *p, Janet key); | ||||
|  | ||||
| static void janet_rng_marshal(void *p, JanetMarshalContext *ctx) { | ||||
|     JanetRNG *rng = (JanetRNG *)p; | ||||
|     janet_marshal_abstract(ctx, p); | ||||
|     janet_marshal_int(ctx, (int32_t) rng->a); | ||||
|     janet_marshal_int(ctx, (int32_t) rng->b); | ||||
|     janet_marshal_int(ctx, (int32_t) rng->c); | ||||
|     janet_marshal_int(ctx, (int32_t) rng->d); | ||||
|     janet_marshal_int(ctx, (int32_t) rng->counter); | ||||
| } | ||||
|  | ||||
| static void *janet_rng_unmarshal(JanetMarshalContext *ctx) { | ||||
|     JanetRNG *rng = janet_unmarshal_abstract(ctx, sizeof(JanetRNG)); | ||||
|     rng->a = (uint32_t) janet_unmarshal_int(ctx); | ||||
|     rng->b = (uint32_t) janet_unmarshal_int(ctx); | ||||
|     rng->c = (uint32_t) janet_unmarshal_int(ctx); | ||||
|     rng->d = (uint32_t) janet_unmarshal_int(ctx); | ||||
|     rng->counter = (uint32_t) janet_unmarshal_int(ctx); | ||||
|     return rng; | ||||
| } | ||||
|  | ||||
| const JanetAbstractType janet_rng_type = { | ||||
|     "core/rng", | ||||
|     NULL, | ||||
|     NULL, | ||||
|     janet_rng_get, | ||||
|     NULL, | ||||
|     janet_rng_marshal, | ||||
|     janet_rng_unmarshal, | ||||
|     NULL, /* tostring */ | ||||
|     NULL, /* compare */ | ||||
|     NULL, /* hash */ | ||||
|     janet_rng_next, | ||||
|     JANET_ATEND_NEXT | ||||
| }; | ||||
|  | ||||
| JanetRNG *janet_default_rng(void) { | ||||
|     return &janet_vm_rng; | ||||
| } | ||||
|  | ||||
| void janet_rng_seed(JanetRNG *rng, uint32_t seed) { | ||||
|     rng->a = seed; | ||||
|     rng->b = 0x97654321u; | ||||
|     rng->c = 123871873u; | ||||
|     rng->d = 0xf23f56c8u; | ||||
|     rng->counter = 0u; | ||||
|     /* First several numbers aren't that random. */ | ||||
|     for (int i = 0; i < 16; i++) janet_rng_u32(rng); | ||||
| } | ||||
|  | ||||
| void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len) { | ||||
|     uint8_t state[16] = {0}; | ||||
|     for (int32_t i = 0; i < len; i++) | ||||
|         state[i & 0xF] ^= bytes[i]; | ||||
|     rng->a = state[0] + (state[1] << 8) + (state[2] << 16) + (state[3] << 24); | ||||
|     rng->b = state[4] + (state[5] << 8) + (state[6] << 16) + (state[7] << 24); | ||||
|     rng->c = state[8] + (state[9] << 8) + (state[10] << 16) + (state[11] << 24); | ||||
|     rng->d = state[12] + (state[13] << 8) + (state[14] << 16) + (state[15] << 24); | ||||
|     rng->counter = 0u; | ||||
|     /* a, b, c, d can't all be 0 */ | ||||
|     if (rng->a == 0) rng->a = 1u; | ||||
|     for (int i = 0; i < 16; i++) janet_rng_u32(rng); | ||||
| } | ||||
|  | ||||
| uint32_t janet_rng_u32(JanetRNG *rng) { | ||||
|     /* Algorithm "xorwow" from p. 5 of Marsaglia, "Xorshift RNGs" */ | ||||
|     uint32_t t = rng->d; | ||||
|     uint32_t const s = rng->a; | ||||
|     rng->d = rng->c; | ||||
|     rng->c = rng->b; | ||||
|     rng->b = s; | ||||
|     t ^= t >> 2; | ||||
|     t ^= t << 1; | ||||
|     t ^= s ^ (s << 4); | ||||
|     rng->a = t; | ||||
|     rng->counter += 362437; | ||||
|     return t + rng->counter; | ||||
| } | ||||
|  | ||||
| double janet_rng_double(JanetRNG *rng) { | ||||
|     uint32_t hi = janet_rng_u32(rng); | ||||
|     uint32_t lo = janet_rng_u32(rng); | ||||
|     uint64_t big = (uint64_t)(lo) | (((uint64_t) hi) << 32); | ||||
|     return ldexp((double)(big >> (64 - 52)), -52); | ||||
| } | ||||
|  | ||||
| static Janet cfun_rng_make(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 0, 1); | ||||
|     JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG)); | ||||
|     if (argc == 1) { | ||||
|         if (janet_checkint(argv[0])) { | ||||
|             uint32_t seed = (uint32_t)(janet_getinteger(argv, 0)); | ||||
|             janet_rng_seed(rng, seed); | ||||
|         } else { | ||||
|             JanetByteView bytes = janet_getbytes(argv, 0); | ||||
|             janet_rng_longseed(rng, bytes.bytes, bytes.len); | ||||
|         } | ||||
|     } else { | ||||
|         janet_rng_seed(rng, 0); | ||||
|     } | ||||
|     return janet_wrap_abstract(rng); | ||||
| } | ||||
|  | ||||
| static Janet cfun_rng_uniform(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type); | ||||
|     return janet_wrap_number(janet_rng_double(rng)); | ||||
| } | ||||
|  | ||||
| static Janet cfun_rng_int(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type); | ||||
|     if (argc == 1) { | ||||
|         uint32_t word = janet_rng_u32(rng) >> 1; | ||||
|         return janet_wrap_integer(word); | ||||
|     } else { | ||||
|         int32_t max = janet_optnat(argv, argc, 1, INT32_MAX); | ||||
|         if (max == 0) return janet_wrap_number(0.0); | ||||
|         uint32_t modulo = (uint32_t) max; | ||||
|         uint32_t maxgen = INT32_MAX; | ||||
|         uint32_t maxword = maxgen - (maxgen % modulo); | ||||
|         uint32_t word; | ||||
|         do { | ||||
|             word = janet_rng_u32(rng) >> 1; | ||||
|         } while (word > maxword); | ||||
|         return janet_wrap_integer(word % modulo); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) { | ||||
|     uint32_t word = janet_rng_u32(rng); | ||||
|     buf[0] = word & 0xFF; | ||||
|     buf[1] = (word >> 8) & 0xFF; | ||||
|     buf[2] = (word >> 16) & 0xFF; | ||||
|     buf[3] = (word >> 24) & 0xFF; | ||||
| } | ||||
|  | ||||
| static Janet cfun_rng_buffer(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 2, 3); | ||||
|     JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type); | ||||
|     int32_t n = janet_getnat(argv, 1); | ||||
|     JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, n); | ||||
|  | ||||
|     /* Split into first part (that is divisible by 4), and rest */ | ||||
|     int32_t first_part = n & ~3; | ||||
|     int32_t second_part = n - first_part; | ||||
|  | ||||
|     /* Get first part in chunks of 4 bytes */ | ||||
|     janet_buffer_extra(buffer, n); | ||||
|     uint8_t *buf = buffer->data + buffer->count; | ||||
|     for (int32_t i = 0; i < first_part; i += 4) rng_get_4bytes(rng, buf + i); | ||||
|     buffer->count += first_part; | ||||
|  | ||||
|     /* Get remaining 0 - 3 bytes */ | ||||
|     if (second_part) { | ||||
|         uint8_t wordbuf[4] = {0}; | ||||
|         rng_get_4bytes(rng, wordbuf); | ||||
|         janet_buffer_push_bytes(buffer, wordbuf, second_part); | ||||
|     } | ||||
|  | ||||
|     return janet_wrap_buffer(buffer); | ||||
| } | ||||
|  | ||||
| static const JanetMethod rng_methods[] = { | ||||
|     {"uniform", cfun_rng_uniform}, | ||||
|     {"int", cfun_rng_int}, | ||||
|     {"buffer", cfun_rng_buffer}, | ||||
|     {NULL, NULL} | ||||
| }; | ||||
|  | ||||
| static int janet_rng_get(void *p, Janet key, Janet *out) { | ||||
|     (void) p; | ||||
|     if (!janet_checktype(key, JANET_KEYWORD)) return 0; | ||||
|     return janet_getmethod(janet_unwrap_keyword(key), rng_methods, out); | ||||
| } | ||||
|  | ||||
| static Janet janet_rng_next(void *p, Janet key) { | ||||
|     (void) p; | ||||
|     return janet_nextmethod(rng_methods, key); | ||||
| } | ||||
|  | ||||
| /* Get a random number */ | ||||
| static Janet janet_rand(int32_t argc, Janet *argv) { | ||||
|     (void) argv; | ||||
|     janet_fixarity(argc, 0); | ||||
|     return janet_wrap_number(janet_rng_double(&janet_vm_rng)); | ||||
|     double r = (rand() % RAND_MAX) / ((double) RAND_MAX); | ||||
|     return janet_wrap_number(r); | ||||
| } | ||||
|  | ||||
| /* Seed the random number generator */ | ||||
| static Janet janet_srand(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     if (janet_checkint(argv[0])) { | ||||
|         uint32_t seed = (uint32_t)(janet_getinteger(argv, 0)); | ||||
|         janet_rng_seed(&janet_vm_rng, seed); | ||||
|     } else { | ||||
|         JanetByteView bytes = janet_getbytes(argv, 0); | ||||
|         janet_rng_longseed(&janet_vm_rng, bytes.bytes, bytes.len); | ||||
|     } | ||||
|     int32_t x = janet_getinteger(argv, 0); | ||||
|     srand((unsigned) x); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| static Janet janet_remainder(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 2); | ||||
|     double x = janet_getnumber(argv, 0); | ||||
|     double y = janet_getnumber(argv, 1); | ||||
|     return janet_wrap_number(fmod(x, y)); | ||||
| } | ||||
|  | ||||
| #define JANET_DEFINE_MATHOP(name, fop)\ | ||||
| static Janet janet_##name(int32_t argc, Janet *argv) {\ | ||||
|     janet_fixarity(argc, 1); \ | ||||
| @@ -245,30 +62,17 @@ JANET_DEFINE_MATHOP(asin, asin) | ||||
| JANET_DEFINE_MATHOP(atan, atan) | ||||
| JANET_DEFINE_MATHOP(cos, cos) | ||||
| JANET_DEFINE_MATHOP(cosh, cosh) | ||||
| JANET_DEFINE_MATHOP(acosh, acosh) | ||||
| JANET_DEFINE_MATHOP(sin, sin) | ||||
| JANET_DEFINE_MATHOP(sinh, sinh) | ||||
| JANET_DEFINE_MATHOP(asinh, asinh) | ||||
| JANET_DEFINE_MATHOP(tan, tan) | ||||
| JANET_DEFINE_MATHOP(tanh, tanh) | ||||
| JANET_DEFINE_MATHOP(atanh, atanh) | ||||
| JANET_DEFINE_MATHOP(exp, exp) | ||||
| JANET_DEFINE_MATHOP(exp2, exp2) | ||||
| JANET_DEFINE_MATHOP(expm1, expm1) | ||||
| JANET_DEFINE_MATHOP(log, log) | ||||
| JANET_DEFINE_MATHOP(log10, log10) | ||||
| JANET_DEFINE_MATHOP(log2, log2) | ||||
| JANET_DEFINE_MATHOP(sqrt, sqrt) | ||||
| JANET_DEFINE_MATHOP(cbrt, cbrt) | ||||
| JANET_DEFINE_MATHOP(ceil, ceil) | ||||
| JANET_DEFINE_MATHOP(fabs, fabs) | ||||
| JANET_DEFINE_MATHOP(floor, floor) | ||||
| JANET_DEFINE_MATHOP(trunc, trunc) | ||||
| JANET_DEFINE_MATHOP(round, round) | ||||
| JANET_DEFINE_MATHOP(gamma, lgamma) | ||||
| JANET_DEFINE_MATHOP(log1p, log1p) | ||||
| JANET_DEFINE_MATHOP(erf, erf) | ||||
| JANET_DEFINE_MATHOP(erfc, erfc) | ||||
|  | ||||
| #define JANET_DEFINE_MATH2OP(name, fop)\ | ||||
| static Janet janet_##name(int32_t argc, Janet *argv) {\ | ||||
| @@ -280,8 +84,6 @@ static Janet janet_##name(int32_t argc, Janet *argv) {\ | ||||
|  | ||||
| JANET_DEFINE_MATH2OP(atan2, atan2) | ||||
| JANET_DEFINE_MATH2OP(pow, pow) | ||||
| JANET_DEFINE_MATH2OP(hypot, hypot) | ||||
| JANET_DEFINE_MATH2OP(nextafter, nextafter) | ||||
|  | ||||
| static Janet janet_not(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
| @@ -289,6 +91,11 @@ static Janet janet_not(int32_t argc, Janet *argv) { | ||||
| } | ||||
|  | ||||
| static const JanetReg math_cfuns[] = { | ||||
|     { | ||||
|         "%", janet_remainder, | ||||
|         JDOC("(% dividend divisor)\n\n" | ||||
|              "Returns the remainder of dividend / divisor.") | ||||
|     }, | ||||
|     { | ||||
|         "not", janet_not, | ||||
|         JDOC("(not x)\n\nReturns the boolean inverse of x.") | ||||
| @@ -301,8 +108,8 @@ static const JanetReg math_cfuns[] = { | ||||
|     { | ||||
|         "math/seedrandom", janet_srand, | ||||
|         JDOC("(math/seedrandom seed)\n\n" | ||||
|              "Set the seed for the random number generator. seed should be " | ||||
|              "an integer or a buffer.") | ||||
|              "Set the seed for the random number generator. 'seed' should be an " | ||||
|              "an integer.") | ||||
|     }, | ||||
|     { | ||||
|         "math/cos", janet_cos, | ||||
| @@ -342,28 +149,18 @@ static const JanetReg math_cfuns[] = { | ||||
|     { | ||||
|         "math/log", janet_log, | ||||
|         JDOC("(math/log x)\n\n" | ||||
|              "Returns log base natural number of x.") | ||||
|              "Returns log base 2 of x.") | ||||
|     }, | ||||
|     { | ||||
|         "math/log10", janet_log10, | ||||
|         JDOC("(math/log10 x)\n\n" | ||||
|              "Returns log base 10 of x.") | ||||
|     }, | ||||
|     { | ||||
|         "math/log2", janet_log2, | ||||
|         JDOC("(math/log2 x)\n\n" | ||||
|              "Returns log base 2 of x.") | ||||
|     }, | ||||
|     { | ||||
|         "math/sqrt", janet_sqrt, | ||||
|         JDOC("(math/sqrt x)\n\n" | ||||
|              "Returns the square root of x.") | ||||
|     }, | ||||
|     { | ||||
|         "math/cbrt", janet_cbrt, | ||||
|         JDOC("(math/cbrt x)\n\n" | ||||
|              "Returns the cube root of x.") | ||||
|     }, | ||||
|     { | ||||
|         "math/floor", janet_floor, | ||||
|         JDOC("(math/floor x)\n\n" | ||||
| @@ -399,107 +196,17 @@ static const JanetReg math_cfuns[] = { | ||||
|         JDOC("(math/tanh x)\n\n" | ||||
|              "Return the hyperbolic tangent of x.") | ||||
|     }, | ||||
|     { | ||||
|         "math/atanh", janet_atanh, | ||||
|         JDOC("(math/atanh x)\n\n" | ||||
|              "Return the hyperbolic arctangent of x.") | ||||
|     }, | ||||
|     { | ||||
|         "math/asinh", janet_asinh, | ||||
|         JDOC("(math/asinh x)\n\n" | ||||
|              "Return the hyperbolic arcsine of x.") | ||||
|     }, | ||||
|     { | ||||
|         "math/acosh", janet_acosh, | ||||
|         JDOC("(math/acosh x)\n\n" | ||||
|              "Return the hyperbolic arccosine of x.") | ||||
|     }, | ||||
|     { | ||||
|         "math/atan2", janet_atan2, | ||||
|         JDOC("(math/atan2 y x)\n\n" | ||||
|              "Return the arctangent of y/x. Works even when x is 0.") | ||||
|     }, | ||||
|     { | ||||
|         "math/rng", cfun_rng_make, | ||||
|         JDOC("(math/rng &opt seed)\n\n" | ||||
|              "Creates a Psuedo-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.") | ||||
|     }, | ||||
|     { | ||||
|         "math/rng-uniform", cfun_rng_uniform, | ||||
|         JDOC("(math/rng-seed rng seed)\n\n" | ||||
|              "Extract a random number in the range [0, 1) from the RNG.") | ||||
|     }, | ||||
|     { | ||||
|         "math/rng-int", cfun_rng_int, | ||||
|         JDOC("(math/rng-int rng &opt max)\n\n" | ||||
|              "Extract a random random integer in the range [0, max] from the RNG. If " | ||||
|              "no max is given, the default is 2^31 - 1.") | ||||
|     }, | ||||
|     { | ||||
|         "math/rng-buffer", cfun_rng_buffer, | ||||
|         JDOC("(math/rng-buffer rng n &opt buf)\n\n" | ||||
|              "Get n random bytes and put them in a buffer. Creates a new buffer if no buffer is " | ||||
|              "provided, otherwise appends to the given buffer. Returns the buffer.") | ||||
|     }, | ||||
|     { | ||||
|         "math/hypot", janet_hypot, | ||||
|         JDOC("(math/hypot a b)\n\n" | ||||
|              "Returns the c from the equation c^2 = a^2 + b^2") | ||||
|     }, | ||||
|     { | ||||
|         "math/exp2", janet_exp2, | ||||
|         JDOC("(math/exp2 x)\n\n" | ||||
|              "Returns 2 to the power of x.") | ||||
|     }, | ||||
|     { | ||||
|         "math/log1p", janet_log1p, | ||||
|         JDOC("(math/log1p x)\n\n" | ||||
|              "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)") | ||||
|     }, | ||||
|     { | ||||
|         "math/gamma", janet_gamma, | ||||
|         JDOC("(math/gamma x)\n\n" | ||||
|              "Returns gamma(x).") | ||||
|     }, | ||||
|     { | ||||
|         "math/erfc", janet_erfc, | ||||
|         JDOC("(math/erfc x)\n\n" | ||||
|              "Returns the complementary error function of x.") | ||||
|     }, | ||||
|     { | ||||
|         "math/erf", janet_erf, | ||||
|         JDOC("(math/erf x)\n\n" | ||||
|              "Returns the error function of x.") | ||||
|     }, | ||||
|     { | ||||
|         "math/expm1", janet_expm1, | ||||
|         JDOC("(math/expm1 x)\n\n" | ||||
|              "Returns e to the power of x minus 1.") | ||||
|     }, | ||||
|     { | ||||
|         "math/trunc", janet_trunc, | ||||
|         JDOC("(math/trunc x)\n\n" | ||||
|              "Returns the integer between x and 0 nearest to x.") | ||||
|     }, | ||||
|     { | ||||
|         "math/round", janet_round, | ||||
|         JDOC("(math/round x)\n\n" | ||||
|              "Returns the integer nearest to x.") | ||||
|     }, | ||||
|     { | ||||
|         "math/next", janet_nextafter, | ||||
|         JDOC("(math/next x y)\n\n" | ||||
|              "Returns the next representable floating point value after x in the direction of y.") | ||||
|     }, | ||||
|     {NULL, NULL, NULL} | ||||
| }; | ||||
|  | ||||
| /* Module entry point */ | ||||
| void janet_lib_math(JanetTable *env) { | ||||
|     janet_core_cfuns(env, NULL, math_cfuns); | ||||
|     janet_register_abstract_type(&janet_rng_type); | ||||
| #ifdef JANET_BOOTSTRAP | ||||
|     janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931), | ||||
|               JDOC("The value pi.")); | ||||
| @@ -507,21 +214,5 @@ void janet_lib_math(JanetTable *env) { | ||||
|               JDOC("The base of the natural log.")); | ||||
|     janet_def(env, "math/inf", janet_wrap_number(INFINITY), | ||||
|               JDOC("The number representing positive infinity")); | ||||
|     janet_def(env, "math/-inf", janet_wrap_number(-INFINITY), | ||||
|               JDOC("The number representing negative infinity")); | ||||
|     janet_def(env, "math/int32-min", janet_wrap_number(INT32_MIN), | ||||
|               JDOC("The minimum contiguous integer representable by a 32 bit signed integer")); | ||||
|     janet_def(env, "math/int32-max", janet_wrap_number(INT32_MAX), | ||||
|               JDOC("The maximum contiguous integer represtenable by a 32 bit signed integer")); | ||||
|     janet_def(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE), | ||||
|               JDOC("The minimum contiguous integer representable by a double (2^53)")); | ||||
|     janet_def(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE), | ||||
|               JDOC("The maximum contiguous integer represtenable by a double (-(2^53))")); | ||||
| #ifdef NAN | ||||
|     janet_def(env, "math/nan", janet_wrap_number(NAN), | ||||
| #else | ||||
|     janet_def(env, "math/nan", janet_wrap_number(0.0 / 0.0), | ||||
| #endif | ||||
|               JDOC("Not a number (IEEE-754 NaN)")); | ||||
| #endif | ||||
| } | ||||
|   | ||||
							
								
								
									
										785
									
								
								src/core/net.c
									
									
									
									
									
								
							
							
						
						
									
										785
									
								
								src/core/net.c
									
									
									
									
									
								
							| @@ -1,785 +0,0 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose and contributors. | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| * deal in the Software without restriction, including without limitation the | ||||
| * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or | ||||
| * sell copies of the Software, and to permit persons to whom the Software is | ||||
| * furnished to do so, subject to the following conditions: | ||||
| * | ||||
| * The above copyright notice and this permission notice shall be included in | ||||
| * all copies or substantial portions of the Software. | ||||
| * | ||||
| * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | ||||
| * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | ||||
| * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE | ||||
| * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | ||||
| * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | ||||
| * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS | ||||
| * IN THE SOFTWARE. | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "util.h" | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_NET | ||||
|  | ||||
| #include <math.h> | ||||
| #ifdef JANET_WINDOWS | ||||
| #include <winsock2.h> | ||||
| #include <windows.h> | ||||
| #include <ws2tcpip.h> | ||||
| #include <mswsock.h> | ||||
| #pragma comment (lib, "Ws2_32.lib") | ||||
| #pragma comment (lib, "Mswsock.lib") | ||||
| #pragma comment (lib, "Advapi32.lib") | ||||
| #else | ||||
| #include <unistd.h> | ||||
| #include <signal.h> | ||||
| #include <sys/ioctl.h> | ||||
| #include <sys/types.h> | ||||
| #include <sys/socket.h> | ||||
| #include <sys/un.h> | ||||
| #include <netinet/in.h> | ||||
| #include <netinet/tcp.h> | ||||
| #include <netdb.h> | ||||
| #include <fcntl.h> | ||||
| #endif | ||||
|  | ||||
| const JanetAbstractType janet_address_type = { | ||||
|     "core/socket-address", | ||||
|     JANET_ATEND_NAME | ||||
| }; | ||||
|  | ||||
| #ifdef JANET_WINDOWS | ||||
| #define JSOCKCLOSE(x) closesocket((SOCKET) x) | ||||
| #define JSOCKDEFAULT INVALID_SOCKET | ||||
| #define JSOCKVALID(x) ((x) != INVALID_SOCKET) | ||||
| #define JSock SOCKET | ||||
| #define JSOCKFLAGS 0 | ||||
| #else | ||||
| #define JSOCKCLOSE(x) close(x) | ||||
| #define JSOCKDEFAULT 0 | ||||
| #define JSOCKVALID(x) ((x) >= 0) | ||||
| #define JSock int | ||||
| #ifdef SOCK_CLOEXEC | ||||
| #define JSOCKFLAGS SOCK_CLOEXEC | ||||
| #else | ||||
| #define JSOCKFLAGS 0 | ||||
| #endif | ||||
| #endif | ||||
|  | ||||
| static JanetStream *make_stream(JSock handle, uint32_t flags); | ||||
|  | ||||
| /* We pass this flag to all send calls to prevent sigpipe */ | ||||
| #ifndef MSG_NOSIGNAL | ||||
| #define MSG_NOSIGNAL 0 | ||||
| #endif | ||||
|  | ||||
| /* Make sure a socket doesn't block */ | ||||
| static void janet_net_socknoblock(JSock s) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     unsigned long arg = 1; | ||||
|     ioctlsocket(s, FIONBIO, &arg); | ||||
| #else | ||||
| #if !defined(SOCK_CLOEXEC) && defined(O_CLOEXEC) | ||||
|     int extra = O_CLOEXEC; | ||||
| #else | ||||
|     int extra = 0; | ||||
| #endif | ||||
|     fcntl(s, F_SETFL, fcntl(s, F_GETFL, 0) | O_NONBLOCK | extra); | ||||
| #ifdef SO_NOSIGPIPE | ||||
|     int enable = 1; | ||||
|     setsockopt(s, SOL_SOCKET, SO_NOSIGPIPE, &enable, sizeof(int)); | ||||
| #endif | ||||
| #endif | ||||
| } | ||||
|  | ||||
| /* State machine for accepting connections. */ | ||||
|  | ||||
| #ifdef JANET_WINDOWS | ||||
|  | ||||
| typedef struct { | ||||
|     JanetListenerState head; | ||||
|     WSAOVERLAPPED overlapped; | ||||
|     JanetFunction *function; | ||||
|     JanetStream *lstream; | ||||
|     JanetStream *astream; | ||||
|     char buf[1024]; | ||||
| } NetStateAccept; | ||||
|  | ||||
| static int net_sched_accept_impl(NetStateAccept *state, Janet *err); | ||||
|  | ||||
| JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) { | ||||
|     NetStateAccept *state = (NetStateAccept *)s; | ||||
|     switch (event) { | ||||
|         default: | ||||
|             break; | ||||
|         case JANET_ASYNC_EVENT_MARK: { | ||||
|             if (state->lstream) janet_mark(janet_wrap_abstract(state->lstream)); | ||||
|             if (state->astream) janet_mark(janet_wrap_abstract(state->astream)); | ||||
|             if (state->function) janet_mark(janet_wrap_abstract(state->function)); | ||||
|             break; | ||||
|         } | ||||
|         case JANET_ASYNC_EVENT_CLOSE: | ||||
|             janet_schedule(s->fiber, janet_wrap_nil()); | ||||
|             return JANET_ASYNC_STATUS_DONE; | ||||
|         case JANET_ASYNC_EVENT_COMPLETE: { | ||||
|             int seconds; | ||||
|             int bytes = sizeof(seconds); | ||||
|             if (NO_ERROR != getsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_CONNECT_TIME, | ||||
|                                        (char *)&seconds, &bytes)) { | ||||
|                 janet_cancel(s->fiber, janet_cstringv("failed to accept connection")); | ||||
|                 return JANET_ASYNC_STATUS_DONE; | ||||
|             } | ||||
|             if (NO_ERROR != setsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_UPDATE_ACCEPT_CONTEXT, | ||||
|                                        (char *) & (state->lstream->handle), sizeof(SOCKET))) { | ||||
|                 janet_cancel(s->fiber, janet_cstringv("failed to accept connection")); | ||||
|                 return JANET_ASYNC_STATUS_DONE; | ||||
|             } | ||||
|  | ||||
|             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()); | ||||
|                 /* 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; | ||||
|                 } | ||||
|             } else { | ||||
|                 janet_schedule(s->fiber, streamv); | ||||
|                 return JANET_ASYNC_STATUS_DONE; | ||||
|             } | ||||
|         } | ||||
|     } | ||||
|     return JANET_ASYNC_STATUS_NOT_DONE; | ||||
| } | ||||
|  | ||||
| JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) { | ||||
|     Janet err; | ||||
|     SOCKET lsock = (SOCKET) stream->handle; | ||||
|     JanetListenerState *s = janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL); | ||||
|     NetStateAccept *state = (NetStateAccept *)s; | ||||
|     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(); | ||||
| } | ||||
|  | ||||
| static int net_sched_accept_impl(NetStateAccept *state, 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) { | ||||
|         *err = janet_ev_lasterr(); | ||||
|         return 1; | ||||
|     } | ||||
|     JanetStream *astream = make_stream(asock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE); | ||||
|     state->astream = astream; | ||||
|     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 */ | ||||
|         *err = janet_ev_lasterr(); | ||||
|         return 1; | ||||
|     } | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| #else | ||||
|  | ||||
| typedef struct { | ||||
|     JanetListenerState head; | ||||
|     JanetFunction *function; | ||||
| } NetStateAccept; | ||||
|  | ||||
| JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) { | ||||
|     NetStateAccept *state = (NetStateAccept *)s; | ||||
|     switch (event) { | ||||
|         default: | ||||
|             break; | ||||
|         case JANET_ASYNC_EVENT_MARK: { | ||||
|             if (state->function) janet_mark(janet_wrap_function(state->function)); | ||||
|             break; | ||||
|         } | ||||
|         case JANET_ASYNC_EVENT_CLOSE: | ||||
|             janet_schedule(s->fiber, janet_wrap_nil()); | ||||
|             return JANET_ASYNC_STATUS_DONE; | ||||
|         case JANET_ASYNC_EVENT_READ: { | ||||
|             JSock connfd = accept(s->stream->handle, NULL, NULL); | ||||
|             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()); | ||||
|                 } else { | ||||
|                     janet_schedule(s->fiber, streamv); | ||||
|                     return JANET_ASYNC_STATUS_DONE; | ||||
|                 } | ||||
|             } | ||||
|             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); | ||||
|     state->function = fun; | ||||
|     janet_await(); | ||||
| } | ||||
|  | ||||
|  | ||||
| #endif | ||||
|  | ||||
| /* Adress info */ | ||||
|  | ||||
| static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) { | ||||
|     JanetKeyword stype = janet_optkeyword(argv, argc, n, NULL); | ||||
|     int socktype = SOCK_DGRAM; | ||||
|     if ((NULL == stype) || !janet_cstrcmp(stype, "stream")) { | ||||
|         socktype = SOCK_STREAM; | ||||
|     } else if (janet_cstrcmp(stype, "datagram")) { | ||||
|         janet_panicf("expected socket type as :stream or :datagram, got %v", argv[n]); | ||||
|     } | ||||
|     return socktype; | ||||
| } | ||||
|  | ||||
| /* Needs argc >= offset + 2 */ | ||||
| /* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1, otherwise 0 */ | ||||
| static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int socktype, int passive, int *is_unix) { | ||||
|     /* Unix socket support - not yet supported on windows. */ | ||||
| #ifndef JANET_WINDOWS | ||||
|     if (janet_keyeq(argv[offset], "unix")) { | ||||
|         const char *path = janet_getcstring(argv, offset + 1); | ||||
|         struct sockaddr_un *saddr = janet_calloc(1, sizeof(struct sockaddr_un)); | ||||
|         if (saddr == NULL) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|         saddr->sun_family = AF_UNIX; | ||||
|         size_t path_size = sizeof(saddr->sun_path); | ||||
| #ifdef JANET_LINUX | ||||
|         if (path[0] == '@') { | ||||
|             saddr->sun_path[0] = '\0'; | ||||
|             snprintf(saddr->sun_path + 1, path_size - 1, "%s", path + 1); | ||||
|         } else | ||||
| #endif | ||||
|         { | ||||
|             snprintf(saddr->sun_path, path_size, "%s", path); | ||||
|         } | ||||
|         *is_unix = 1; | ||||
|         return (struct addrinfo *) saddr; | ||||
|     } | ||||
| #endif | ||||
|     /* Get host and port */ | ||||
|     const char *host = janet_getcstring(argv, offset); | ||||
|     const char *port; | ||||
|     if (janet_checkint(argv[offset + 1])) { | ||||
|         port = (const char *)janet_to_string(argv[offset + 1]); | ||||
|     } else { | ||||
|         port = janet_optcstring(argv, offset + 2, offset + 1, NULL); | ||||
|     } | ||||
|     /* getaddrinfo */ | ||||
|     struct addrinfo *ai = NULL; | ||||
|     struct addrinfo hints; | ||||
|     memset(&hints, 0, sizeof(hints)); | ||||
|     hints.ai_family = AF_UNSPEC; | ||||
|     hints.ai_socktype = socktype; | ||||
|     hints.ai_flags = passive ? AI_PASSIVE : 0; | ||||
|     int status = getaddrinfo(host, port, &hints, &ai); | ||||
|     if (status) { | ||||
|         janet_panicf("could not get address info: %s", gai_strerror(status)); | ||||
|     } | ||||
|     *is_unix = 0; | ||||
|     return ai; | ||||
| } | ||||
|  | ||||
| /* | ||||
|  * C Funs | ||||
|  */ | ||||
|  | ||||
| static Janet cfun_net_sockaddr(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 2, 4); | ||||
|     int socktype = janet_get_sockettype(argv, argc, 2); | ||||
|     int is_unix = 0; | ||||
|     int make_arr = (argc >= 3 && janet_truthy(argv[3])); | ||||
|     struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix); | ||||
| #ifndef JANET_WINDOWS | ||||
|     /* no unix domain socket support on windows yet */ | ||||
|     if (is_unix) { | ||||
|         void *abst = janet_abstract(&janet_address_type, sizeof(struct sockaddr_un)); | ||||
|         memcpy(abst, ai, sizeof(struct sockaddr_un)); | ||||
|         Janet ret = janet_wrap_abstract(abst); | ||||
|         return make_arr ? janet_wrap_array(janet_array_n(&ret, 1)) : ret; | ||||
|     } | ||||
| #endif | ||||
|     if (make_arr) { | ||||
|         /* Select all */ | ||||
|         JanetArray *arr = janet_array(10); | ||||
|         struct addrinfo *iter = ai; | ||||
|         while (NULL != iter) { | ||||
|             void *abst = janet_abstract(&janet_address_type, iter->ai_addrlen); | ||||
|             memcpy(abst, iter->ai_addr, iter->ai_addrlen); | ||||
|             janet_array_push(arr, janet_wrap_abstract(abst)); | ||||
|             iter = iter->ai_next; | ||||
|         } | ||||
|         freeaddrinfo(ai); | ||||
|         return janet_wrap_array(arr); | ||||
|     } else { | ||||
|         /* Select first */ | ||||
|         if (NULL == ai) { | ||||
|             janet_panic("no data for given address"); | ||||
|         } | ||||
|         void *abst = janet_abstract(&janet_address_type, ai->ai_addrlen); | ||||
|         memcpy(abst, ai->ai_addr, ai->ai_addrlen); | ||||
|         freeaddrinfo(ai); | ||||
|         return janet_wrap_abstract(abst); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static Janet cfun_net_connect(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 2, 3); | ||||
|  | ||||
|     int socktype = janet_get_sockettype(argv, argc, 2); | ||||
|     int is_unix = 0; | ||||
|     struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix); | ||||
|  | ||||
|     /* Create socket */ | ||||
|     JSock sock = JSOCKDEFAULT; | ||||
|     void *addr = NULL; | ||||
|     socklen_t addrlen = 0; | ||||
| #ifndef JANET_WINDOWS | ||||
|     if (is_unix) { | ||||
|         sock = socket(AF_UNIX, socktype | JSOCKFLAGS, 0); | ||||
|         if (!JSOCKVALID(sock)) { | ||||
|             janet_panicf("could not create socket: %V", janet_ev_lasterr()); | ||||
|         } | ||||
|         addr = (void *) ai; | ||||
|         addrlen = sizeof(struct sockaddr_un); | ||||
|     } else | ||||
| #endif | ||||
|     { | ||||
|         struct addrinfo *rp = NULL; | ||||
|         for (rp = ai; rp != NULL; rp = rp->ai_next) { | ||||
| #ifdef JANET_WINDOWS | ||||
|             sock = WSASocketW(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol, NULL, 0, WSA_FLAG_OVERLAPPED); | ||||
| #else | ||||
|             sock = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol); | ||||
| #endif | ||||
|             if (JSOCKVALID(sock)) { | ||||
|                 addr = rp->ai_addr; | ||||
|                 addrlen = (socklen_t) rp->ai_addrlen; | ||||
|                 break; | ||||
|             } | ||||
|         } | ||||
|         if (NULL == addr) { | ||||
|             freeaddrinfo(ai); | ||||
|             janet_panicf("could not create socket: %V", janet_ev_lasterr()); | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     /* Connect to socket */ | ||||
| #ifdef JANET_WINDOWS | ||||
|     int status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL); | ||||
|     freeaddrinfo(ai); | ||||
| #else | ||||
|     int status = connect(sock, addr, addrlen); | ||||
|     if (is_unix) { | ||||
|         janet_free(ai); | ||||
|     } else { | ||||
|         freeaddrinfo(ai); | ||||
|     } | ||||
| #endif | ||||
|  | ||||
|     if (status == -1) { | ||||
|         JSOCKCLOSE(sock); | ||||
|         janet_panicf("could not connect to socket: %V", janet_ev_lasterr()); | ||||
|     } | ||||
|  | ||||
|     /* Set up the socket for non-blocking IO after connect - TODO - non-blocking connect? */ | ||||
|     janet_net_socknoblock(sock); | ||||
|  | ||||
|     /* Wrap socket in abstract type JanetStream */ | ||||
|     JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE); | ||||
|     return janet_wrap_abstract(stream); | ||||
| } | ||||
|  | ||||
| static const char *serverify_socket(JSock sfd) { | ||||
|     /* Set various socket options */ | ||||
|     int enable = 1; | ||||
|     if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) { | ||||
|         return "setsockopt(SO_REUSEADDR) failed"; | ||||
|     } | ||||
| #ifdef SO_REUSEPORT | ||||
|     if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) { | ||||
|         return "setsockopt(SO_REUSEPORT) failed"; | ||||
|     } | ||||
| #endif | ||||
|     janet_net_socknoblock(sfd); | ||||
|     return NULL; | ||||
| } | ||||
|  | ||||
| #ifdef JANET_WINDOWS | ||||
| #define JANET_SHUTDOWN_RW SD_BOTH | ||||
| #define JANET_SHUTDOWN_R SD_RECEIVE | ||||
| #define JANET_SHUTDOWN_W SD_SEND | ||||
| #else | ||||
| #define JANET_SHUTDOWN_RW SHUT_RDWR | ||||
| #define JANET_SHUTDOWN_R SHUT_RD | ||||
| #define JANET_SHUTDOWN_W SHUT_WR | ||||
| #endif | ||||
|  | ||||
| static Janet cfun_net_shutdown(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
|     janet_stream_flags(stream, JANET_STREAM_SOCKET); | ||||
|     int shutdown_type = JANET_SHUTDOWN_RW; | ||||
|     if (argc == 2) { | ||||
|         const uint8_t *kw = janet_getkeyword(argv, 1); | ||||
|         if (0 == janet_cstrcmp(kw, "rw")) { | ||||
|             shutdown_type = JANET_SHUTDOWN_RW; | ||||
|         } else if (0 == janet_cstrcmp(kw, "r")) { | ||||
|             shutdown_type = JANET_SHUTDOWN_R; | ||||
|         } else if (0 == janet_cstrcmp(kw, "w")) { | ||||
|             shutdown_type = JANET_SHUTDOWN_W; | ||||
|         } else { | ||||
|             janet_panicf("unexpected keyword %v", argv[1]); | ||||
|         } | ||||
|     } | ||||
|     int status; | ||||
| #ifdef JANET_WINDOWS | ||||
|     status = shutdown((SOCKET) stream->handle, shutdown_type); | ||||
| #else | ||||
|     do { | ||||
|         status = shutdown(stream->handle, shutdown_type); | ||||
|     } while (status == -1 && errno == EINTR); | ||||
| #endif | ||||
|     if (status) { | ||||
|         janet_panicf("could not shutdown socket: %V", janet_ev_lasterr()); | ||||
|     } | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static Janet cfun_net_listen(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 2, 3); | ||||
|  | ||||
|     /* Get host, port, and handler*/ | ||||
|     int socktype = janet_get_sockettype(argv, argc, 2); | ||||
|     int is_unix = 0; | ||||
|     struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 1, &is_unix); | ||||
|  | ||||
|     JSock sfd = JSOCKDEFAULT; | ||||
| #ifndef JANET_WINDOWS | ||||
|     if (is_unix) { | ||||
|         sfd = socket(AF_UNIX, socktype | JSOCKFLAGS, 0); | ||||
|         if (!JSOCKVALID(sfd)) { | ||||
|             janet_free(ai); | ||||
|             janet_panicf("could not create socket: %V", janet_ev_lasterr()); | ||||
|         } | ||||
|         const char *err = serverify_socket(sfd); | ||||
|         if (NULL != err || bind(sfd, (struct sockaddr *)ai, sizeof(struct sockaddr_un))) { | ||||
|             JSOCKCLOSE(sfd); | ||||
|             janet_free(ai); | ||||
|             if (err) { | ||||
|                 janet_panic(err); | ||||
|             } else { | ||||
|                 janet_panicf("could not bind socket: %V", janet_ev_lasterr()); | ||||
|             } | ||||
|         } | ||||
|         janet_free(ai); | ||||
|     } else | ||||
| #endif | ||||
|     { | ||||
|         /* Check all addrinfos in a loop for the first that we can bind to. */ | ||||
|         struct addrinfo *rp = NULL; | ||||
|         for (rp = ai; rp != NULL; rp = rp->ai_next) { | ||||
| #ifdef JANET_WINDOWS | ||||
|             sfd = WSASocketW(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol, NULL, 0, WSA_FLAG_OVERLAPPED); | ||||
| #else | ||||
|             sfd = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol); | ||||
| #endif | ||||
|             if (!JSOCKVALID(sfd)) continue; | ||||
|             const char *err = serverify_socket(sfd); | ||||
|             if (NULL != err) { | ||||
|                 JSOCKCLOSE(sfd); | ||||
|                 continue; | ||||
|             } | ||||
|             /* Bind */ | ||||
|             if (bind(sfd, rp->ai_addr, (int) rp->ai_addrlen) == 0) break; | ||||
|             JSOCKCLOSE(sfd); | ||||
|         } | ||||
|         freeaddrinfo(ai); | ||||
|         if (NULL == rp) { | ||||
|             janet_panic("could not bind to any sockets"); | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     if (socktype == SOCK_DGRAM) { | ||||
|         /* Datagram server (UDP) */ | ||||
|         JanetStream *stream = make_stream(sfd, JANET_STREAM_UDPSERVER | JANET_STREAM_READABLE); | ||||
|         return janet_wrap_abstract(stream); | ||||
|     } else { | ||||
|         /* Stream server (TCP) */ | ||||
|  | ||||
|         /* listen */ | ||||
|         int status = listen(sfd, 1024); | ||||
|         if (status) { | ||||
|             JSOCKCLOSE(sfd); | ||||
|             janet_panicf("could not listen on file descriptor: %V", janet_ev_lasterr()); | ||||
|         } | ||||
|  | ||||
|         /* Put sfd on our loop */ | ||||
|         JanetStream *stream = make_stream(sfd, JANET_STREAM_ACCEPTABLE); | ||||
|         return janet_wrap_abstract(stream); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static Janet cfun_stream_accept_loop(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 2); | ||||
|     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); | ||||
|     janet_sched_accept(stream, fun); | ||||
| } | ||||
|  | ||||
| static Janet cfun_stream_accept(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
|     janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET); | ||||
|     double to = janet_optnumber(argv, argc, 1, INFINITY); | ||||
|     if (to != INFINITY) janet_addtimeout(to); | ||||
|     janet_sched_accept(stream, NULL); | ||||
| } | ||||
|  | ||||
| static Janet cfun_stream_read(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 2, 4); | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
|     janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET); | ||||
|     JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10); | ||||
|     double to = janet_optnumber(argv, argc, 3, INFINITY); | ||||
|     if (janet_keyeq(argv[1], "all")) { | ||||
|         if (to != INFINITY) janet_addtimeout(to); | ||||
|         janet_ev_recvchunk(stream, buffer, INT32_MAX, MSG_NOSIGNAL); | ||||
|     } else { | ||||
|         int32_t n = janet_getnat(argv, 1); | ||||
|         if (to != INFINITY) janet_addtimeout(to); | ||||
|         janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL); | ||||
|     } | ||||
|     janet_await(); | ||||
| } | ||||
|  | ||||
| static Janet cfun_stream_chunk(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 2, 4); | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
|     janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET); | ||||
|     int32_t n = janet_getnat(argv, 1); | ||||
|     JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10); | ||||
|     double to = janet_optnumber(argv, argc, 3, INFINITY); | ||||
|     if (to != INFINITY) janet_addtimeout(to); | ||||
|     janet_ev_recvchunk(stream, buffer, n, MSG_NOSIGNAL); | ||||
|     janet_await(); | ||||
| } | ||||
|  | ||||
| static Janet cfun_stream_recv_from(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 3, 4); | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
|     janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET); | ||||
|     int32_t n = janet_getnat(argv, 1); | ||||
|     JanetBuffer *buffer = janet_getbuffer(argv, 2); | ||||
|     double to = janet_optnumber(argv, argc, 3, INFINITY); | ||||
|     if (to != INFINITY) janet_addtimeout(to); | ||||
|     janet_ev_recvfrom(stream, buffer, n, MSG_NOSIGNAL); | ||||
|     janet_await(); | ||||
| } | ||||
|  | ||||
| static Janet cfun_stream_write(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 2, 3); | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
|     janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET); | ||||
|     double to = janet_optnumber(argv, argc, 2, INFINITY); | ||||
|     if (janet_checktype(argv[1], JANET_BUFFER)) { | ||||
|         if (to != INFINITY) janet_addtimeout(to); | ||||
|         janet_ev_send_buffer(stream, janet_getbuffer(argv, 1), MSG_NOSIGNAL); | ||||
|     } else { | ||||
|         JanetByteView bytes = janet_getbytes(argv, 1); | ||||
|         if (to != INFINITY) janet_addtimeout(to); | ||||
|         janet_ev_send_string(stream, bytes.bytes, MSG_NOSIGNAL); | ||||
|     } | ||||
|     janet_await(); | ||||
| } | ||||
|  | ||||
| static Janet cfun_stream_send_to(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 3, 4); | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
|     janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET); | ||||
|     void *dest = janet_getabstract(argv, 1, &janet_address_type); | ||||
|     double to = janet_optnumber(argv, argc, 3, INFINITY); | ||||
|     if (janet_checktype(argv[2], JANET_BUFFER)) { | ||||
|         if (to != INFINITY) janet_addtimeout(to); | ||||
|         janet_ev_sendto_buffer(stream, janet_getbuffer(argv, 2), dest, MSG_NOSIGNAL); | ||||
|     } else { | ||||
|         JanetByteView bytes = janet_getbytes(argv, 2); | ||||
|         if (to != INFINITY) janet_addtimeout(to); | ||||
|         janet_ev_sendto_string(stream, bytes.bytes, dest, MSG_NOSIGNAL); | ||||
|     } | ||||
|     janet_await(); | ||||
| } | ||||
|  | ||||
| static Janet cfun_stream_flush(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); | ||||
|     janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET); | ||||
|     /* Toggle no delay flag */ | ||||
|     int flag = 1; | ||||
|     setsockopt((JSock) stream->handle, IPPROTO_TCP, TCP_NODELAY, (char *) &flag, sizeof(int)); | ||||
|     flag = 0; | ||||
|     setsockopt((JSock) stream->handle, IPPROTO_TCP, TCP_NODELAY, (char *) &flag, sizeof(int)); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static const JanetMethod net_stream_methods[] = { | ||||
|     {"chunk", cfun_stream_chunk}, | ||||
|     {"close", janet_cfun_stream_close}, | ||||
|     {"read", cfun_stream_read}, | ||||
|     {"write", cfun_stream_write}, | ||||
|     {"flush", cfun_stream_flush}, | ||||
|     {"accept", cfun_stream_accept}, | ||||
|     {"accept-loop", cfun_stream_accept_loop}, | ||||
|     {"send-to", cfun_stream_send_to}, | ||||
|     {"recv-from", cfun_stream_recv_from}, | ||||
|     {"recv-from", cfun_stream_recv_from}, | ||||
|     {"evread", janet_cfun_stream_read}, | ||||
|     {"evchunk", janet_cfun_stream_chunk}, | ||||
|     {"evwrite", janet_cfun_stream_write}, | ||||
|     {"shutdown", cfun_net_shutdown}, | ||||
|     {NULL, NULL} | ||||
| }; | ||||
|  | ||||
| static JanetStream *make_stream(JSock handle, uint32_t flags) { | ||||
|     return janet_stream((JanetHandle) handle, flags | JANET_STREAM_SOCKET, net_stream_methods); | ||||
| } | ||||
|  | ||||
| static const JanetReg net_cfuns[] = { | ||||
|     { | ||||
|         "net/address", cfun_net_sockaddr, | ||||
|         JDOC("(net/address host port &opt type)\n\n" | ||||
|              "Look up the connection information for a given hostname, port, and connection type. Returns " | ||||
|              "a handle that can be used to send datagrams over network without establishing a connection. " | ||||
|              "On Posix platforms, you can use :unix for host to connect to a unix domain socket, where the name is " | ||||
|              "given in the port argument. On Linux, abstract " | ||||
|              "unix domain sockets are specified with a leading '@' character in port.") | ||||
|     }, | ||||
|     { | ||||
|         "net/listen", cfun_net_listen, | ||||
|         JDOC("(net/listen host port &opt type)\n\n" | ||||
|              "Creates a server. Returns a new stream that is neither readable nor " | ||||
|              "writeable. Use net/accept or net/accept-loop be to handle connections and start the server. " | ||||
|              "The type parameter specifies the type of network connection, either " | ||||
|              "a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is " | ||||
|              ":stream. The host and port arguments are the same as in net/address.") | ||||
|     }, | ||||
|     { | ||||
|         "net/accept", cfun_stream_accept, | ||||
|         JDOC("(net/accept stream &opt timeout)\n\n" | ||||
|              "Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. " | ||||
|              "Takes an optional timeout in seconds, after which will return nil. " | ||||
|              "Returns a new duplex stream which represents a connection to the client.") | ||||
|     }, | ||||
|     { | ||||
|         "net/accept-loop", cfun_stream_accept_loop, | ||||
|         JDOC("(net/accept-loop stream handler)\n\n" | ||||
|              "Shorthand for running a server stream that will continuously accept new connections. " | ||||
|              "Blocks the current fiber until the stream is closed, and will return the stream.") | ||||
|     }, | ||||
|     { | ||||
|         "net/read", cfun_stream_read, | ||||
|         JDOC("(net/read stream nbytes &opt buf timeout)\n\n" | ||||
|              "Read up to n bytes from a stream, suspending the current fiber until the bytes are available. " | ||||
|              "`n` can also be the keyword `:all` to read into the buffer until end of stream. " | ||||
|              "If less than n bytes are available (and more than 0), will push those bytes and return early. " | ||||
|              "Takes an optional timeout in seconds, after which will return nil. " | ||||
|              "Returns a buffer with up to n more bytes in it, or raises an error if the read failed.") | ||||
|     }, | ||||
|     { | ||||
|         "net/chunk", cfun_stream_chunk, | ||||
|         JDOC("(net/chunk stream nbytes &opt buf timeout)\n\n" | ||||
|              "Same a net/read, but will wait for all n bytes to arrive rather than return early. " | ||||
|              "Takes an optional timeout in seconds, after which will return nil.") | ||||
|     }, | ||||
|     { | ||||
|         "net/write", cfun_stream_write, | ||||
|         JDOC("(net/write stream data &opt timeout)\n\n" | ||||
|              "Write data to a stream, suspending the current fiber until the write " | ||||
|              "completes. Takes an optional timeout in seconds, after which will return nil. " | ||||
|              "Returns nil, or raises an error if the write failed.") | ||||
|     }, | ||||
|     { | ||||
|         "net/send-to", cfun_stream_send_to, | ||||
|         JDOC("(net/send-to stream dest data &opt timeout)\n\n" | ||||
|              "Writes a datagram to a server stream. dest is a the destination address of the packet. " | ||||
|              "Takes an optional timeout in seconds, after which will return nil. " | ||||
|              "Returns stream.") | ||||
|     }, | ||||
|     { | ||||
|         "net/recv-from", cfun_stream_recv_from, | ||||
|         JDOC("(net/recv-from stream nbytes buf &opt timoeut)\n\n" | ||||
|              "Receives data from a server stream and puts it into a buffer. Returns the socket-address the " | ||||
|              "packet came from. Takes an optional timeout in seconds, after which will return nil.") | ||||
|     }, | ||||
|     { | ||||
|         "net/flush", cfun_stream_flush, | ||||
|         JDOC("(net/flush stream)\n\n" | ||||
|              "Make sure that a stream is not buffering any data. This temporarily disables Nagle's algorithm. " | ||||
|              "Use this to make sure data is sent without delay. Returns stream.") | ||||
|     }, | ||||
|     { | ||||
|         "net/connect", cfun_net_connect, | ||||
|         JDOC("(net/connect host port &opt type)\n\n" | ||||
|              "Open a connection to communicate with a server. Returns a duplex stream " | ||||
|              "that can be used to communicate with the server. Type is an optional keyword " | ||||
|              "to specify a connection type, either :stream or :datagram. The default is :stream. ") | ||||
|     }, | ||||
|     { | ||||
|         "net/shutdown", cfun_net_shutdown, | ||||
|         JDOC("(net/shutdown stream &opt mode)\n\n" | ||||
|              "Stop communication on this socket in a graceful manner, either in both directions or just " | ||||
|              "reading/writing from the stream. The `mode` parameter controls which communication to stop on the socket. " | ||||
|              "\n\n* `:wr` is the default and prevents both reading new data from the socket and writing new data to the socket.\n" | ||||
|              "* `:r` disables reading new data from the socket.\n" | ||||
|              "* `:w` disable writing data to the socket.\n\n" | ||||
|              "Returns the original socket.") | ||||
|     }, | ||||
|     {NULL, NULL, NULL} | ||||
| }; | ||||
|  | ||||
| void janet_lib_net(JanetTable *env) { | ||||
|     janet_core_cfuns(env, NULL, net_cfuns); | ||||
| } | ||||
|  | ||||
| void janet_net_init(void) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     WSADATA wsaData; | ||||
|     janet_assert(!WSAStartup(MAKEWORD(2, 2), &wsaData), "could not start winsock"); | ||||
| #endif | ||||
| } | ||||
|  | ||||
| void janet_net_deinit(void) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     WSACleanup(); | ||||
| #endif | ||||
| } | ||||
|  | ||||
| #endif | ||||
							
								
								
									
										1996
									
								
								src/core/os.c
									
									
									
									
									
								
							
							
						
						
									
										1996
									
								
								src/core/os.c
									
									
									
									
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							
							
								
								
									
										572
									
								
								src/core/parse.c
									
									
									
									
									
								
							
							
						
						
									
										572
									
								
								src/core/parse.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,14 +21,10 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "util.h" | ||||
| #endif | ||||
|  | ||||
| #define JANET_PARSER_DEAD 0x1 | ||||
| #define JANET_PARSER_GENERATED_ERROR 0x2 | ||||
|  | ||||
| /* Check if a character is whitespace */ | ||||
| static int is_whitespace(uint8_t c) { | ||||
|     return c == ' ' | ||||
| @@ -42,11 +38,11 @@ static int is_whitespace(uint8_t c) { | ||||
|  | ||||
| /* Code generated by tools/symcharsgen.c. | ||||
|  * The table contains 256 bits, where each bit is 1 | ||||
|  * if the corresponding ascii code is a symbol char, and 0 | ||||
|  * if the corresponding ascci code is a symbol char, and 0 | ||||
|  * if not. The upper characters are also considered symbol | ||||
|  * chars and are then checked for utf-8 compliance. */ | ||||
| static const uint32_t symchars[8] = { | ||||
|     0x00000000, 0xf7ffec72, 0xc7ffffff, 0x07fffffe, | ||||
|     0x00000000, 0xf7ffec72, 0xc7ffffff, 0x17fffffe, | ||||
|     0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff | ||||
| }; | ||||
|  | ||||
| @@ -110,8 +106,7 @@ struct JanetParseState { | ||||
|     int32_t counter; | ||||
|     int32_t argn; | ||||
|     int flags; | ||||
|     size_t line; | ||||
|     size_t column; | ||||
|     size_t start; | ||||
|     Consumer consumer; | ||||
| }; | ||||
|  | ||||
| @@ -123,7 +118,7 @@ static void NAME(JanetParser *p, T x) { \ | ||||
|     if (newcount > p->STACKCAP) { \ | ||||
|         T *next; \ | ||||
|         size_t newcap = 2 * newcount; \ | ||||
|         next = janet_realloc(p->STACK, sizeof(T) * newcap); \ | ||||
|         next = realloc(p->STACK, sizeof(T) * newcap); \ | ||||
|         if (NULL == next) { \ | ||||
|             JANET_OUT_OF_MEMORY; \ | ||||
|         } \ | ||||
| @@ -149,8 +144,6 @@ DEF_PARSER_STACK(_pushstate, JanetParseState, states, statecount, statecap) | ||||
| #define PFLAG_LONGSTRING 0x4000 | ||||
| #define PFLAG_READERMAC 0x8000 | ||||
| #define PFLAG_ATSYM 0x10000 | ||||
| #define PFLAG_COMMENT 0x20000 | ||||
| #define PFLAG_TOKEN 0x40000 | ||||
|  | ||||
| static void pushstate(JanetParser *p, Consumer consumer, int flags) { | ||||
|     JanetParseState s; | ||||
| @@ -158,8 +151,7 @@ static void pushstate(JanetParser *p, Consumer consumer, int flags) { | ||||
|     s.argn = 0; | ||||
|     s.flags = flags; | ||||
|     s.consumer = consumer; | ||||
|     s.line = p->line; | ||||
|     s.column = p->column; | ||||
|     s.start = p->offset; | ||||
|     _pushstate(p, s); | ||||
| } | ||||
|  | ||||
| @@ -167,22 +159,15 @@ static void popstate(JanetParser *p, Janet val) { | ||||
|     for (;;) { | ||||
|         JanetParseState top = p->states[--p->statecount]; | ||||
|         JanetParseState *newtop = p->states + p->statecount - 1; | ||||
|         /* Source mapping info */ | ||||
|         if (janet_checktype(val, JANET_TUPLE)) { | ||||
|             janet_tuple_sm_line(janet_unwrap_tuple(val)) = (int32_t) top.line; | ||||
|             janet_tuple_sm_column(janet_unwrap_tuple(val)) = (int32_t) top.column; | ||||
|         } | ||||
|         if (newtop->flags & PFLAG_CONTAINER) { | ||||
|             /* Source mapping info */ | ||||
|             if (janet_checktype(val, JANET_TUPLE)) { | ||||
|                 janet_tuple_sm_start(janet_unwrap_tuple(val)) = (int32_t) top.start; | ||||
|                 janet_tuple_sm_end(janet_unwrap_tuple(val)) = (int32_t) p->offset; | ||||
|             } | ||||
|             newtop->argn++; | ||||
|             /* Keep track of number of values in the root state */ | ||||
|             if (p->statecount == 1) { | ||||
|                 p->pending++; | ||||
|                 /* Root items are always wrapped in a tuple for source map info. */ | ||||
|                 const Janet *tup = janet_tuple_n(&val, 1); | ||||
|                 janet_tuple_sm_line(tup) = (int32_t) top.line; | ||||
|                 janet_tuple_sm_column(tup) = (int32_t) top.column; | ||||
|                 val = janet_wrap_tuple(tup); | ||||
|             } | ||||
|             if (p->statecount == 1) p->pending++; | ||||
|             push_arg(p, val); | ||||
|             return; | ||||
|         } else if (newtop->flags & PFLAG_READERMAC) { | ||||
| @@ -192,13 +177,12 @@ static void popstate(JanetParser *p, Janet val) { | ||||
|                 (c == '\'') ? "quote" : | ||||
|                 (c == ',') ? "unquote" : | ||||
|                 (c == ';') ? "splice" : | ||||
|                 (c == '|') ? "short-fn" : | ||||
|                 (c == '~') ? "quasiquote" : "<unknown>"; | ||||
|             t[0] = janet_csymbolv(which); | ||||
|             t[1] = val; | ||||
|             /* Quote source mapping info */ | ||||
|             janet_tuple_sm_line(t) = (int32_t) newtop->line; | ||||
|             janet_tuple_sm_column(t) = (int32_t) newtop->column; | ||||
|             janet_tuple_sm_start(t) = (int32_t) newtop->start; | ||||
|             janet_tuple_sm_end(t) = (int32_t) p->offset; | ||||
|             val = janet_wrap_tuple(janet_tuple_end(t)); | ||||
|         } else { | ||||
|             return; | ||||
| @@ -211,8 +195,6 @@ static int checkescape(uint8_t c) { | ||||
|         default: | ||||
|             return -1; | ||||
|         case 'x': | ||||
|         case 'u': | ||||
|         case 'U': | ||||
|             return 1; | ||||
|         case 'n': | ||||
|             return '\n'; | ||||
| @@ -240,54 +222,16 @@ static int checkescape(uint8_t c) { | ||||
| /* Forward declare */ | ||||
| static int stringchar(JanetParser *p, JanetParseState *state, uint8_t c); | ||||
|  | ||||
| static void write_codepoint(JanetParser *p, int32_t codepoint) { | ||||
|     if (codepoint <= 0x7F) { | ||||
|         push_buf(p, (uint8_t) codepoint); | ||||
|     } else if (codepoint <= 0x7FF) { | ||||
|         push_buf(p, (uint8_t)((codepoint >>  6) & 0x1F) | 0xC0); | ||||
|         push_buf(p, (uint8_t)((codepoint >>  0) & 0x3F) | 0x80); | ||||
|     } else if (codepoint <= 0xFFFF) { | ||||
|         push_buf(p, (uint8_t)((codepoint >> 12) & 0x0F) | 0xE0); | ||||
|         push_buf(p, (uint8_t)((codepoint >>  6) & 0x3F) | 0x80); | ||||
|         push_buf(p, (uint8_t)((codepoint >>  0) & 0x3F) | 0x80); | ||||
|     } else { | ||||
|         push_buf(p, (uint8_t)((codepoint >> 18) & 0x07) | 0xF0); | ||||
|         push_buf(p, (uint8_t)((codepoint >> 12) & 0x3F) | 0x80); | ||||
|         push_buf(p, (uint8_t)((codepoint >>  6) & 0x3F) | 0x80); | ||||
|         push_buf(p, (uint8_t)((codepoint >>  0) & 0x3F) | 0x80); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) { | ||||
|     int digit = to_hex(c); | ||||
|     if (digit < 0) { | ||||
|         p->error = "invalid hex digit in hex escape"; | ||||
|         return 1; | ||||
|     } | ||||
|     state->argn = (state->argn << 4) + digit; | ||||
|     state->argn = (state->argn << 4) + digit;; | ||||
|     state->counter--; | ||||
|     if (!state->counter) { | ||||
|         push_buf(p, (uint8_t)(state->argn & 0xFF)); | ||||
|         state->argn = 0; | ||||
|         state->consumer = stringchar; | ||||
|     } | ||||
|     return 1; | ||||
| } | ||||
|  | ||||
| static int escapeu(JanetParser *p, JanetParseState *state, uint8_t c) { | ||||
|     int digit = to_hex(c); | ||||
|     if (digit < 0) { | ||||
|         p->error = "invalid hex digit in unicode escape"; | ||||
|         return 1; | ||||
|     } | ||||
|     state->argn = (state->argn << 4) + digit; | ||||
|     state->counter--; | ||||
|     if (!state->counter) { | ||||
|         if (state->argn > 0x10FFFF) { | ||||
|             p->error = "invalid unicode codepoint"; | ||||
|             return 1; | ||||
|         } | ||||
|         write_codepoint(p, state->argn); | ||||
|         push_buf(p, (state->argn & 0xFF)); | ||||
|         state->argn = 0; | ||||
|         state->consumer = stringchar; | ||||
|     } | ||||
| @@ -304,10 +248,6 @@ static int escape1(JanetParser *p, JanetParseState *state, uint8_t c) { | ||||
|         state->counter = 2; | ||||
|         state->argn = 0; | ||||
|         state->consumer = escapeh; | ||||
|     } else if (c == 'u' || c == 'U') { | ||||
|         state->counter = c == 'u' ? 4 : 6; | ||||
|         state->argn = 0; | ||||
|         state->consumer = escapeu; | ||||
|     } else { | ||||
|         push_buf(p, (uint8_t) e); | ||||
|         state->consumer = stringchar; | ||||
| @@ -320,48 +260,11 @@ static int stringend(JanetParser *p, JanetParseState *state) { | ||||
|     uint8_t *bufstart = p->buf; | ||||
|     int32_t buflen = (int32_t) p->bufcount; | ||||
|     if (state->flags & PFLAG_LONGSTRING) { | ||||
|         /* Post process to remove leading whitespace */ | ||||
|         JanetParseState top = p->states[p->statecount - 1]; | ||||
|         int32_t indent_col = (int32_t) top.column - 1; | ||||
|         uint8_t *r = bufstart, *end = r + buflen; | ||||
|         /* Check if there are any characters before the start column - | ||||
|          * if so, do not reindent. */ | ||||
|         int reindent = 1; | ||||
|         while (reindent && (r < end)) { | ||||
|             if (*r++ == '\n') { | ||||
|                 for (int32_t j = 0; (r < end) && (*r != '\n') && (j < indent_col); j++, r++) { | ||||
|                     if (*r != ' ') { | ||||
|                         reindent = 0; | ||||
|                         break; | ||||
|                     } | ||||
|                 } | ||||
|             } | ||||
|         /* Check for leading newline character so we can remove it */ | ||||
|         if (bufstart[0] == '\n') { | ||||
|             bufstart++; | ||||
|             buflen--; | ||||
|         } | ||||
|         /* Now reindent if able to, otherwise just drop leading newline. */ | ||||
|         if (!reindent) { | ||||
|             if (buflen > 0 && bufstart[0] == '\n') { | ||||
|                 buflen--; | ||||
|                 bufstart++; | ||||
|             } | ||||
|         } else { | ||||
|             uint8_t *w = bufstart; | ||||
|             r = bufstart; | ||||
|             while (r < end) { | ||||
|                 if (*r == '\n') { | ||||
|                     if (r == bufstart) { | ||||
|                         /* Skip leading newline */ | ||||
|                         r++; | ||||
|                     } else { | ||||
|                         *w++ = *r++; | ||||
|                     } | ||||
|                     for (int32_t j = 0; (r < end) && (*r != '\n') && (j < indent_col); j++, r++); | ||||
|                 } else { | ||||
|                     *w++ = *r++; | ||||
|                 } | ||||
|             } | ||||
|             buflen = (int32_t)(w - bufstart); | ||||
|         } | ||||
|         /* Check for trailing newline character so we can remove it */ | ||||
|         if (buflen > 0 && bufstart[buflen - 1] == '\n') { | ||||
|             buflen--; | ||||
|         } | ||||
| @@ -389,7 +292,7 @@ static int stringchar(JanetParser *p, JanetParseState *state, uint8_t c) { | ||||
|         return stringend(p, state); | ||||
|     } | ||||
|     /* normal char */ | ||||
|     if (c != '\n' && c != '\r') | ||||
|     if (c != '\n') | ||||
|         push_buf(p, c); | ||||
|     return 1; | ||||
| } | ||||
| @@ -421,12 +324,6 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) { | ||||
|     int start_dig = p->buf[0] >= '0' && p->buf[0] <= '9'; | ||||
|     int start_num = start_dig || p->buf[0] == '-' || p->buf[0] == '+' || p->buf[0] == '.'; | ||||
|     if (p->buf[0] == ':') { | ||||
|         /* Don't do full utf-8 check unless we have seen non ascii characters. */ | ||||
|         int valid = (!state->argn) || valid_utf8(p->buf + 1, blen - 1); | ||||
|         if (!valid) { | ||||
|             p->error = "invalid utf-8 in keyword"; | ||||
|             return 0; | ||||
|         } | ||||
|         ret = janet_keywordv(p->buf + 1, blen - 1); | ||||
|     } else if (start_num && !janet_scan_number(p->buf, blen, &numval)) { | ||||
|         ret = janet_wrap_number(numval); | ||||
| @@ -436,7 +333,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) { | ||||
|         ret = janet_wrap_false(); | ||||
|     } else if (!check_str_const("true", p->buf, blen)) { | ||||
|         ret = janet_wrap_true(); | ||||
|     } else { | ||||
|     } else if (p->buf) { | ||||
|         if (start_dig) { | ||||
|             p->error = "symbol literal cannot start with a digit"; | ||||
|             return 0; | ||||
| @@ -449,6 +346,9 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) { | ||||
|             } | ||||
|             ret = janet_symbolv(p->buf, blen); | ||||
|         } | ||||
|     } else { | ||||
|         p->error = "empty symbol invalid"; | ||||
|         return 0; | ||||
|     } | ||||
|     p->bufcount = 0; | ||||
|     popstate(p, ret); | ||||
| @@ -457,12 +357,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) { | ||||
|  | ||||
| static int comment(JanetParser *p, JanetParseState *state, uint8_t c) { | ||||
|     (void) state; | ||||
|     if (c == '\n') { | ||||
|         p->statecount--; | ||||
|         p->bufcount = 0; | ||||
|     } else { | ||||
|         push_buf(p, c); | ||||
|     } | ||||
|     if (c == '\n') p->statecount--; | ||||
|     return 1; | ||||
| } | ||||
|  | ||||
| @@ -484,23 +379,21 @@ static Janet close_array(JanetParser *p, JanetParseState *state) { | ||||
|  | ||||
| static Janet close_struct(JanetParser *p, JanetParseState *state) { | ||||
|     JanetKV *st = janet_struct_begin(state->argn >> 1); | ||||
|     for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) { | ||||
|         Janet key = p->args[i]; | ||||
|         Janet value = p->args[i + 1]; | ||||
|     for (int32_t i = state->argn; i > 0; i -= 2) { | ||||
|         Janet value = p->args[--p->argcount]; | ||||
|         Janet key = p->args[--p->argcount]; | ||||
|         janet_struct_put(st, key, value); | ||||
|     } | ||||
|     p->argcount -= state->argn; | ||||
|     return janet_wrap_struct(janet_struct_end(st)); | ||||
| } | ||||
|  | ||||
| static Janet close_table(JanetParser *p, JanetParseState *state) { | ||||
|     JanetTable *table = janet_table(state->argn >> 1); | ||||
|     for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) { | ||||
|         Janet key = p->args[i]; | ||||
|         Janet value = p->args[i + 1]; | ||||
|     for (int32_t i = state->argn; i > 0; i -= 2) { | ||||
|         Janet value = p->args[--p->argcount]; | ||||
|         Janet key = p->args[--p->argcount]; | ||||
|         janet_table_put(table, key, value); | ||||
|     } | ||||
|     p->argcount -= state->argn; | ||||
|     return janet_wrap_table(table); | ||||
| } | ||||
|  | ||||
| @@ -550,7 +443,7 @@ static int longstring(JanetParser *p, JanetParseState *state, uint8_t c) { | ||||
|  | ||||
| static int root(JanetParser *p, JanetParseState *state, uint8_t c); | ||||
|  | ||||
| static int atsign(JanetParser *p, JanetParseState *state, uint8_t c) { | ||||
| static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) { | ||||
|     (void) state; | ||||
|     p->statecount--; | ||||
|     switch (c) { | ||||
| @@ -572,8 +465,8 @@ static int atsign(JanetParser *p, JanetParseState *state, uint8_t c) { | ||||
|         default: | ||||
|             break; | ||||
|     } | ||||
|     pushstate(p, tokenchar, PFLAG_TOKEN); | ||||
|     push_buf(p, '@'); /* Push the leading at-sign that was dropped */ | ||||
|     pushstate(p, tokenchar, 0); | ||||
|     push_buf(p, '@'); /* Push the leading ampersand that was dropped */ | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| @@ -586,23 +479,22 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) { | ||||
|                 p->error = "unexpected character"; | ||||
|                 return 1; | ||||
|             } | ||||
|             pushstate(p, tokenchar, PFLAG_TOKEN); | ||||
|             pushstate(p, tokenchar, 0); | ||||
|             return 0; | ||||
|         case '\'': | ||||
|         case ',': | ||||
|         case ';': | ||||
|         case '~': | ||||
|         case '|': | ||||
|             pushstate(p, root, PFLAG_READERMAC | c); | ||||
|             return 1; | ||||
|         case '"': | ||||
|             pushstate(p, stringchar, PFLAG_STRING); | ||||
|             return 1; | ||||
|         case '#': | ||||
|             pushstate(p, comment, PFLAG_COMMENT); | ||||
|             pushstate(p, comment, 0); | ||||
|             return 1; | ||||
|         case '@': | ||||
|             pushstate(p, atsign, PFLAG_ATSYM); | ||||
|             pushstate(p, ampersand, 0); | ||||
|             return 1; | ||||
|         case '`': | ||||
|             pushstate(p, longstring, PFLAG_LONGSTRING); | ||||
| @@ -661,16 +553,7 @@ static void janet_parser_checkdead(JanetParser *parser) { | ||||
| void janet_parser_consume(JanetParser *parser, uint8_t c) { | ||||
|     int consumed = 0; | ||||
|     janet_parser_checkdead(parser); | ||||
|     if (c == '\r') { | ||||
|         parser->line++; | ||||
|         parser->column = 0; | ||||
|     } else if (c == '\n') { | ||||
|         parser->column = 0; | ||||
|         if (parser->lookback != '\r') | ||||
|             parser->line++; | ||||
|     } else { | ||||
|         parser->column++; | ||||
|     } | ||||
|     parser->offset++; | ||||
|     while (!consumed && !parser->error) { | ||||
|         JanetParseState *state = parser->states + parser->statecount - 1; | ||||
|         consumed = state->consumer(parser, state, c); | ||||
| @@ -680,34 +563,12 @@ void janet_parser_consume(JanetParser *parser, uint8_t c) { | ||||
|  | ||||
| void janet_parser_eof(JanetParser *parser) { | ||||
|     janet_parser_checkdead(parser); | ||||
|     size_t oldcolumn = parser->column; | ||||
|     size_t oldline = parser->line; | ||||
|     janet_parser_consume(parser, '\n'); | ||||
|     if (parser->statecount > 1) { | ||||
|         JanetParseState *s = parser->states + (parser->statecount - 1); | ||||
|         JanetBuffer *buffer = janet_buffer(40); | ||||
|         janet_buffer_push_cstring(buffer, "unexpected end of source, "); | ||||
|         if (s->flags & PFLAG_PARENS) { | ||||
|             janet_buffer_push_u8(buffer, '('); | ||||
|         } else if (s->flags & PFLAG_SQRBRACKETS) { | ||||
|             janet_buffer_push_u8(buffer, '['); | ||||
|         } else if (s->flags & PFLAG_CURLYBRACKETS) { | ||||
|             janet_buffer_push_u8(buffer, '{'); | ||||
|         } else if (s->flags & PFLAG_STRING) { | ||||
|             janet_buffer_push_u8(buffer, '"'); | ||||
|         } else if (s->flags & PFLAG_LONGSTRING) { | ||||
|             int32_t i; | ||||
|             for (i = 0; i < s->argn; i++) { | ||||
|                 janet_buffer_push_u8(buffer, '`'); | ||||
|             } | ||||
|         } | ||||
|         janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column); | ||||
|         parser->error = (const char *) janet_string(buffer->data, buffer->count); | ||||
|         parser->flag |= JANET_PARSER_GENERATED_ERROR; | ||||
|         parser->error = "unexpected end of source"; | ||||
|     } | ||||
|     parser->line = oldline; | ||||
|     parser->column = oldcolumn; | ||||
|     parser->flag |= JANET_PARSER_DEAD; | ||||
|     parser->offset--; | ||||
|     parser->flag = 1; | ||||
| } | ||||
|  | ||||
| enum JanetParserStatus janet_parser_status(JanetParser *parser) { | ||||
| @@ -729,7 +590,6 @@ const char *janet_parser_error(JanetParser *parser) { | ||||
|     if (status == JANET_PARSE_ERROR) { | ||||
|         const char *e = parser->error; | ||||
|         parser->error = NULL; | ||||
|         parser->flag &= ~JANET_PARSER_GENERATED_ERROR; | ||||
|         janet_parser_flush(parser); | ||||
|         return e; | ||||
|     } | ||||
| @@ -737,19 +597,6 @@ const char *janet_parser_error(JanetParser *parser) { | ||||
| } | ||||
|  | ||||
| Janet janet_parser_produce(JanetParser *parser) { | ||||
|     Janet ret; | ||||
|     size_t i; | ||||
|     if (parser->pending == 0) return janet_wrap_nil(); | ||||
|     ret = janet_unwrap_tuple(parser->args[0])[0]; | ||||
|     for (i = 1; i < parser->argcount; i++) { | ||||
|         parser->args[i - 1] = parser->args[i]; | ||||
|     } | ||||
|     parser->pending--; | ||||
|     parser->argcount--; | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| Janet janet_parser_produce_wrapped(JanetParser *parser) { | ||||
|     Janet ret; | ||||
|     size_t i; | ||||
|     if (parser->pending == 0) return janet_wrap_nil(); | ||||
| @@ -774,8 +621,7 @@ void janet_parser_init(JanetParser *parser) { | ||||
|     parser->statecap = 0; | ||||
|     parser->error = NULL; | ||||
|     parser->lookback = -1; | ||||
|     parser->line = 1; | ||||
|     parser->column = 0; | ||||
|     parser->offset = 0; | ||||
|     parser->pending = 0; | ||||
|     parser->flag = 0; | ||||
|  | ||||
| @@ -783,54 +629,9 @@ void janet_parser_init(JanetParser *parser) { | ||||
| } | ||||
|  | ||||
| void janet_parser_deinit(JanetParser *parser) { | ||||
|     janet_free(parser->args); | ||||
|     janet_free(parser->buf); | ||||
|     janet_free(parser->states); | ||||
| } | ||||
|  | ||||
| void janet_parser_clone(const JanetParser *src, JanetParser *dest) { | ||||
|     /* Misc fields */ | ||||
|     dest->flag = src->flag; | ||||
|     dest->pending = src->pending; | ||||
|     dest->lookback = src->lookback; | ||||
|     dest->line = src->line; | ||||
|     dest->column = src->column; | ||||
|     dest->error = src->error; | ||||
|  | ||||
|     /* Keep counts */ | ||||
|     dest->argcount = src->argcount; | ||||
|     dest->bufcount = src->bufcount; | ||||
|     dest->statecount = src->statecount; | ||||
|  | ||||
|     /* Capacities are equal to counts */ | ||||
|     dest->bufcap = dest->bufcount; | ||||
|     dest->statecap = dest->statecount; | ||||
|     dest->argcap = dest->argcount; | ||||
|  | ||||
|     /* Deep cloned fields */ | ||||
|     dest->args = NULL; | ||||
|     dest->states = NULL; | ||||
|     dest->buf = NULL; | ||||
|     if (dest->bufcap) { | ||||
|         dest->buf = janet_malloc(dest->bufcap); | ||||
|         if (!dest->buf) goto nomem; | ||||
|         memcpy(dest->buf, src->buf, dest->bufcap); | ||||
|     } | ||||
|     if (dest->argcap) { | ||||
|         dest->args = janet_malloc(sizeof(Janet) * dest->argcap); | ||||
|         if (!dest->args) goto nomem; | ||||
|         memcpy(dest->args, src->args, dest->argcap * sizeof(Janet)); | ||||
|     } | ||||
|     if (dest->statecap) { | ||||
|         dest->states = janet_malloc(sizeof(JanetParseState) * dest->statecap); | ||||
|         if (!dest->states) goto nomem; | ||||
|         memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState)); | ||||
|     } | ||||
|  | ||||
|     return; | ||||
|  | ||||
| nomem: | ||||
|     JANET_OUT_OF_MEMORY; | ||||
|     free(parser->args); | ||||
|     free(parser->buf); | ||||
|     free(parser->states); | ||||
| } | ||||
|  | ||||
| int janet_parser_has_more(JanetParser *parser) { | ||||
| @@ -846,9 +647,6 @@ static int parsermark(void *p, size_t size) { | ||||
|     for (i = 0; i < parser->argcount; i++) { | ||||
|         janet_mark(parser->args[i]); | ||||
|     } | ||||
|     if (parser->flag & JANET_PARSER_GENERATED_ERROR) { | ||||
|         janet_mark(janet_wrap_string((const uint8_t *) parser->error)); | ||||
|     } | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| @@ -859,36 +657,31 @@ static int parsergc(void *p, size_t size) { | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| static int parserget(void *p, Janet key, Janet *out); | ||||
| static Janet parsernext(void *p, Janet key); | ||||
| static Janet parserget(void *p, Janet key); | ||||
|  | ||||
| const JanetAbstractType janet_parser_type = { | ||||
| static JanetAbstractType janet_parse_parsertype = { | ||||
|     "core/parser", | ||||
|     parsergc, | ||||
|     parsermark, | ||||
|     parserget, | ||||
|     NULL, /* put */ | ||||
|     NULL, /* marshal */ | ||||
|     NULL, /* unmarshal */ | ||||
|     NULL, /* tostring */ | ||||
|     NULL, /* compare */ | ||||
|     NULL, /* hash */ | ||||
|     parsernext, | ||||
|     JANET_ATEND_NEXT | ||||
|     NULL, | ||||
|     NULL, | ||||
|     NULL, | ||||
|     NULL | ||||
| }; | ||||
|  | ||||
| /* C Function parser */ | ||||
| static Janet cfun_parse_parser(int32_t argc, Janet *argv) { | ||||
|     (void) argv; | ||||
|     janet_fixarity(argc, 0); | ||||
|     JanetParser *p = janet_abstract(&janet_parser_type, sizeof(JanetParser)); | ||||
|     JanetParser *p = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser)); | ||||
|     janet_parser_init(p); | ||||
|     return janet_wrap_abstract(p); | ||||
| } | ||||
|  | ||||
| static Janet cfun_parse_consume(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 2, 3); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); | ||||
|     JanetByteView view = janet_getbytes(argv, 1); | ||||
|     if (argc == 3) { | ||||
|         int32_t offset = janet_getinteger(argv, 2); | ||||
| @@ -913,43 +706,37 @@ static Janet cfun_parse_consume(int32_t argc, Janet *argv) { | ||||
|  | ||||
| static Janet cfun_parse_eof(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); | ||||
|     janet_parser_eof(p); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static Janet cfun_parse_insert(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 2); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); | ||||
|     JanetParseState *s = p->states + p->statecount - 1; | ||||
|     if (s->consumer == tokenchar) { | ||||
|         janet_parser_consume(p, ' '); | ||||
|         p->column--; | ||||
|         p->offset--; | ||||
|         s = p->states + p->statecount - 1; | ||||
|     } | ||||
|     if (s->flags & PFLAG_COMMENT) s--; | ||||
|     if (s->flags & PFLAG_CONTAINER) { | ||||
|         s->argn++; | ||||
|         if (p->statecount == 1) { | ||||
|             p->pending++; | ||||
|             Janet tup = janet_wrap_tuple(janet_tuple_n(argv + 1, 1)); | ||||
|             push_arg(p, tup); | ||||
|         } else { | ||||
|             push_arg(p, argv[1]); | ||||
|         } | ||||
|         if (p->statecount == 1) p->pending++; | ||||
|         push_arg(p, argv[1]); | ||||
|     } else if (s->flags & (PFLAG_STRING | PFLAG_LONGSTRING)) { | ||||
|         const uint8_t *str = janet_to_string(argv[1]); | ||||
|         int32_t slen = janet_string_length(str); | ||||
|         size_t newcount = p->bufcount + slen; | ||||
|         if (p->bufcap < newcount) { | ||||
|             size_t newcap = 2 * newcount; | ||||
|             p->buf = janet_realloc(p->buf, newcap); | ||||
|             p->buf = realloc(p->buf, newcap); | ||||
|             if (p->buf == NULL) { | ||||
|                 JANET_OUT_OF_MEMORY; | ||||
|             } | ||||
|             p->bufcap = newcap; | ||||
|         } | ||||
|         safe_memcpy(p->buf + p->bufcount, str, slen); | ||||
|         memcpy(p->buf + p->bufcount, str, slen); | ||||
|         p->bufcount = newcount; | ||||
|     } else { | ||||
|         janet_panic("cannot insert value into parser"); | ||||
| @@ -959,13 +746,13 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) { | ||||
|  | ||||
| static Janet cfun_parse_has_more(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); | ||||
|     return janet_wrap_boolean(janet_parser_has_more(p)); | ||||
| } | ||||
|  | ||||
| static Janet cfun_parse_byte(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 2); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); | ||||
|     int32_t i = janet_getinteger(argv, 1); | ||||
|     janet_parser_consume(p, 0xFF & i); | ||||
|     return argv[0]; | ||||
| @@ -973,7 +760,7 @@ static Janet cfun_parse_byte(int32_t argc, Janet *argv) { | ||||
|  | ||||
| static Janet cfun_parse_status(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); | ||||
|     const char *stat = NULL; | ||||
|     switch (janet_parser_status(p)) { | ||||
|         case JANET_PARSE_PENDING: | ||||
| @@ -994,131 +781,37 @@ static Janet cfun_parse_status(int32_t argc, Janet *argv) { | ||||
|  | ||||
| static Janet cfun_parse_error(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); | ||||
|     const char *err = janet_parser_error(p); | ||||
|     if (err) { | ||||
|         return (p->flag & JANET_PARSER_GENERATED_ERROR) | ||||
|                ? janet_wrap_string((const uint8_t *) err) | ||||
|                : janet_cstringv(err); | ||||
|     } | ||||
|     if (err) return janet_cstringv(err); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| static Janet cfun_parse_produce(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); | ||||
|     if (argc == 2 && janet_truthy(argv[1])) { | ||||
|         return janet_parser_produce_wrapped(p); | ||||
|     } else { | ||||
|         return janet_parser_produce(p); | ||||
|     } | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); | ||||
|     return janet_parser_produce(p); | ||||
| } | ||||
|  | ||||
| static Janet cfun_parse_flush(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); | ||||
|     janet_parser_flush(p); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static Janet cfun_parse_where(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 3); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); | ||||
|     if (argc > 1) { | ||||
|         int32_t line = janet_getinteger(argv, 1); | ||||
|         if (line < 1) | ||||
|             janet_panicf("invalid line number %d", line); | ||||
|         p->line = (size_t) line; | ||||
|     } | ||||
|     if (argc > 2) { | ||||
|         int32_t column = janet_getinteger(argv, 2); | ||||
|         if (column < 0) | ||||
|             janet_panicf("invalid column number %d", column); | ||||
|         p->column = (size_t) column; | ||||
|     } | ||||
|     Janet *tup = janet_tuple_begin(2); | ||||
|     tup[0] = janet_wrap_integer(p->line); | ||||
|     tup[1] = janet_wrap_integer(p->column); | ||||
|     return janet_wrap_tuple(janet_tuple_end(tup)); | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); | ||||
|     return janet_wrap_integer(p->offset); | ||||
| } | ||||
|  | ||||
| static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args, | ||||
|                                     uint8_t *buff, uint32_t bufcount) { | ||||
|     JanetTable *state = janet_table(0); | ||||
|     const uint8_t *buffer; | ||||
|     int add_buffer = 0; | ||||
|     const char *type = NULL; | ||||
|  | ||||
|     if (s->flags & PFLAG_CONTAINER) { | ||||
|         JanetArray *container_args = janet_array(s->argn); | ||||
|         container_args->count = s->argn; | ||||
|         safe_memcpy(container_args->data, args, sizeof(args[0])*s->argn); | ||||
|         janet_table_put(state, janet_ckeywordv("args"), | ||||
|                         janet_wrap_array(container_args)); | ||||
|     } | ||||
|  | ||||
|     if (s->flags & PFLAG_PARENS || s->flags & PFLAG_SQRBRACKETS) { | ||||
|         if (s->flags & PFLAG_ATSYM) { | ||||
|             type = "array"; | ||||
|         } else { | ||||
|             type = "tuple"; | ||||
|         } | ||||
|     } else if (s->flags & PFLAG_CURLYBRACKETS) { | ||||
|         if (s->flags & PFLAG_ATSYM) { | ||||
|             type = "table"; | ||||
|         } else { | ||||
|             type = "struct"; | ||||
|         } | ||||
|     } else if (s->flags & PFLAG_STRING || s->flags & PFLAG_LONGSTRING) { | ||||
|         if (s->flags & PFLAG_BUFFER) { | ||||
|             type = "buffer"; | ||||
|         } else { | ||||
|             type = "string"; | ||||
|         } | ||||
|         add_buffer = 1; | ||||
|     } else if (s->flags & PFLAG_COMMENT) { | ||||
|         type = "comment"; | ||||
|         add_buffer = 1; | ||||
|     } else if (s->flags & PFLAG_TOKEN) { | ||||
|         type = "token"; | ||||
|         add_buffer = 1; | ||||
|     } else if (s->flags & PFLAG_ATSYM) { | ||||
|         type = "at"; | ||||
|     } else if (s->flags & PFLAG_READERMAC) { | ||||
|         int c = s->flags & 0xFF; | ||||
|         type = (c == '\'') ? "quote" : | ||||
|                (c == ',') ? "unquote" : | ||||
|                (c == ';') ? "splice" : | ||||
|                (c == '~') ? "quasiquote" : "<reader>"; | ||||
|     } else { | ||||
|         type = "root"; | ||||
|     } | ||||
|  | ||||
|     if (type) { | ||||
|         janet_table_put(state, janet_ckeywordv("type"), | ||||
|                         janet_ckeywordv(type)); | ||||
|     } | ||||
|  | ||||
|     if (add_buffer) { | ||||
|         buffer = janet_string(buff, bufcount); | ||||
|         janet_table_put(state, janet_ckeywordv("buffer"), janet_wrap_string(buffer)); | ||||
|     } | ||||
|  | ||||
|     janet_table_put(state, janet_ckeywordv("line"), janet_wrap_integer(s->line)); | ||||
|     janet_table_put(state, janet_ckeywordv("column"), janet_wrap_integer(s->column)); | ||||
|     return janet_wrap_table(state); | ||||
| } | ||||
|  | ||||
| struct ParserStateGetter { | ||||
|     const char *name; | ||||
|     Janet(*fn)(const JanetParser *p); | ||||
| }; | ||||
|  | ||||
| static Janet parser_state_delimiters(const JanetParser *_p) { | ||||
|     JanetParser *p = (JanetParser *)_p; | ||||
| static Janet cfun_parse_state(int32_t argc, Janet *argv) { | ||||
|     size_t i; | ||||
|     const uint8_t *str; | ||||
|     size_t oldcount; | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype); | ||||
|     oldcount = p->bufcount; | ||||
|     for (i = 0; i < p->statecount; i++) { | ||||
|         JanetParseState *s = p->states + i; | ||||
| @@ -1142,67 +835,9 @@ static Janet parser_state_delimiters(const JanetParser *_p) { | ||||
|     return janet_wrap_string(str); | ||||
| } | ||||
|  | ||||
| static Janet parser_state_frames(const JanetParser *p) { | ||||
|     int32_t count = (int32_t) p->statecount; | ||||
|     JanetArray *states = janet_array(count); | ||||
|     states->count = count; | ||||
|     uint8_t *buf = p->buf; | ||||
|     Janet *args = p->args; | ||||
|     for (int32_t i = count - 1; i >= 0; --i) { | ||||
|         JanetParseState *s = p->states + i; | ||||
|         states->data[i] = janet_wrap_parse_state(s, args, buf, (uint32_t) p->bufcount); | ||||
|         args -= s->argn; | ||||
|     } | ||||
|     return janet_wrap_array(states); | ||||
| } | ||||
|  | ||||
| static const struct ParserStateGetter parser_state_getters[] = { | ||||
|     {"frames", parser_state_frames}, | ||||
|     {"delimiters", parser_state_delimiters}, | ||||
|     {NULL, NULL} | ||||
| }; | ||||
|  | ||||
| static Janet cfun_parse_state(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 2); | ||||
|     const uint8_t *key = NULL; | ||||
|     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); | ||||
|     if (argc == 2) { | ||||
|         key = janet_getkeyword(argv, 1); | ||||
|     } | ||||
|  | ||||
|     if (key) { | ||||
|         /* Get one result */ | ||||
|         for (const struct ParserStateGetter *sg = parser_state_getters; | ||||
|                 sg->name != NULL; sg++) { | ||||
|             if (janet_cstrcmp(key, sg->name)) continue; | ||||
|             return sg->fn(p); | ||||
|         } | ||||
|         janet_panicf("unexpected keyword %v", janet_wrap_keyword(key)); | ||||
|         return janet_wrap_nil(); | ||||
|     } else { | ||||
|         /* Put results in table */ | ||||
|         JanetTable *tab = janet_table(0); | ||||
|         for (const struct ParserStateGetter *sg = parser_state_getters; | ||||
|                 sg->name != NULL; sg++) { | ||||
|             janet_table_put(tab, janet_ckeywordv(sg->name), sg->fn(p)); | ||||
|         } | ||||
|         return janet_wrap_table(tab); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static Janet cfun_parse_clone(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetParser *src = janet_getabstract(argv, 0, &janet_parser_type); | ||||
|     JanetParser *dest = janet_abstract(&janet_parser_type, sizeof(JanetParser)); | ||||
|     janet_parser_clone(src, dest); | ||||
|     return janet_wrap_abstract(dest); | ||||
| } | ||||
|  | ||||
| static const JanetMethod parser_methods[] = { | ||||
|     {"byte", cfun_parse_byte}, | ||||
|     {"clone", cfun_parse_clone}, | ||||
|     {"consume", cfun_parse_consume}, | ||||
|     {"eof", cfun_parse_eof}, | ||||
|     {"error", cfun_parse_error}, | ||||
|     {"flush", cfun_parse_flush}, | ||||
|     {"has-more", cfun_parse_has_more}, | ||||
| @@ -1211,18 +846,14 @@ static const JanetMethod parser_methods[] = { | ||||
|     {"state", cfun_parse_state}, | ||||
|     {"status", cfun_parse_status}, | ||||
|     {"where", cfun_parse_where}, | ||||
|     {"eof", cfun_parse_eof}, | ||||
|     {NULL, NULL} | ||||
| }; | ||||
|  | ||||
| static int parserget(void *p, Janet key, Janet *out) { | ||||
| static Janet parserget(void *p, Janet key) { | ||||
|     (void) p; | ||||
|     if (!janet_checktype(key, JANET_KEYWORD)) return 0; | ||||
|     return janet_getmethod(janet_unwrap_keyword(key), parser_methods, out); | ||||
| } | ||||
|  | ||||
| static Janet parsernext(void *p, Janet key) { | ||||
|     (void) p; | ||||
|     return janet_nextmethod(parser_methods, key); | ||||
|     if (!janet_checktype(key, JANET_KEYWORD)) janet_panicf("expected keyword method"); | ||||
|     return janet_getmethod(janet_unwrap_keyword(key), parser_methods); | ||||
| } | ||||
|  | ||||
| static const JanetReg parse_cfuns[] = { | ||||
| @@ -1230,14 +861,7 @@ static const JanetReg parse_cfuns[] = { | ||||
|         "parser/new", cfun_parse_parser, | ||||
|         JDOC("(parser/new)\n\n" | ||||
|              "Creates and returns a new parser object. Parsers are state machines " | ||||
|              "that can receive bytes, and generate a stream of values.") | ||||
|     }, | ||||
|     { | ||||
|         "parser/clone", cfun_parse_clone, | ||||
|         JDOC("(parser/clone p)\n\n" | ||||
|              "Creates a deep clone of a parser that is identical to the input parser. " | ||||
|              "This cloned parser can be used to continue parsing from a good checkpoint " | ||||
|              "if parsing later fails. Returns a new parser.") | ||||
|              "that can receive bytes, and generate a stream of janet values. ") | ||||
|     }, | ||||
|     { | ||||
|         "parser/has-more", cfun_parse_has_more, | ||||
| @@ -1246,16 +870,14 @@ static const JanetReg parse_cfuns[] = { | ||||
|     }, | ||||
|     { | ||||
|         "parser/produce", cfun_parse_produce, | ||||
|         JDOC("(parser/produce parser &opt wrap)\n\n" | ||||
|         JDOC("(parser/produce parser)\n\n" | ||||
|              "Dequeue the next value in the parse queue. Will return nil if " | ||||
|              "no parsed values are in the queue, otherwise will dequeue the " | ||||
|              "next value. If `wrap` is truthy, will return a 1-element tuple that " | ||||
|              "wraps the result. This tuple can be used for source-mapping " | ||||
|              "purposes.") | ||||
|              "next value.") | ||||
|     }, | ||||
|     { | ||||
|         "parser/consume", cfun_parse_consume, | ||||
|         JDOC("(parser/consume parser bytes &opt index)\n\n" | ||||
|         JDOC("(parser/consume parser bytes [, index])\n\n" | ||||
|              "Input bytes into the parser and parse them. Will not throw errors " | ||||
|              "if there is a parse error. Starts at the byte index given by index. Returns " | ||||
|              "the number of bytes read.") | ||||
| @@ -1278,9 +900,9 @@ static const JanetReg parse_cfuns[] = { | ||||
|         JDOC("(parser/status parser)\n\n" | ||||
|              "Gets the current status of the parser state machine. The status will " | ||||
|              "be one of:\n\n" | ||||
|              "* :pending - a value is being parsed.\n\n" | ||||
|              "* :error - a parsing error was encountered.\n\n" | ||||
|              "* :root - the parser can either read more values or safely terminate.") | ||||
|              "\t:pending - a value is being parsed.\n" | ||||
|              "\t:error - a parsing error was encountered.\n" | ||||
|              "\t:root - the parser can either read more values or safely terminate.") | ||||
|     }, | ||||
|     { | ||||
|         "parser/flush", cfun_parse_flush, | ||||
| @@ -1291,22 +913,18 @@ static const JanetReg parse_cfuns[] = { | ||||
|     }, | ||||
|     { | ||||
|         "parser/state", cfun_parse_state, | ||||
|         JDOC("(parser/state parser &opt key)\n\n" | ||||
|              "Returns a representation of the internal state of the parser. If a key is passed, " | ||||
|              "only that information about the state is returned. Allowed keys are:\n\n" | ||||
|              "* :delimiters - Each byte in the string represents a nested data structure. For example, " | ||||
|         JDOC("(parser/state parser)\n\n" | ||||
|              "Returns a string representation of the internal state of the parser. " | ||||
|              "Each byte in the string represents a nested data structure. For example, " | ||||
|              "if the parser state is '([\"', then the parser is in the middle of parsing a " | ||||
|              "string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.\n\n" | ||||
|              "* :frames - Each table in the array represents a 'frame' in the parser state. Frames " | ||||
|              "contain information about the start of the expression being parsed as well as the " | ||||
|              "type of that expression and some type-specific information.") | ||||
|              "string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.") | ||||
|     }, | ||||
|     { | ||||
|         "parser/where", cfun_parse_where, | ||||
|         JDOC("(parser/where parser &opt line col)\n\n" | ||||
|              "Returns the current line number and column of the parser's internal state. If line is " | ||||
|              "provided, the current line number of the parser is first set to that value. If column is " | ||||
|              "also provided, the current column number of the parser is also first set to that value.") | ||||
|         JDOC("(parser/where parser)\n\n" | ||||
|              "Returns the current line number and column number of the parser's location " | ||||
|              "in the byte stream as a tuple (line, column). Lines and columns are counted from " | ||||
|              "1, (the first byte is line 1, column 1) and a newline is considered ASCII 0x0A.") | ||||
|     }, | ||||
|     { | ||||
|         "parser/eof", cfun_parse_eof, | ||||
|   | ||||
							
								
								
									
										936
									
								
								src/core/peg.c
									
									
									
									
									
								
							
							
						
						
									
										936
									
								
								src/core/peg.c
									
									
									
									
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							
							
								
								
									
										628
									
								
								src/core/pp.c
									
									
									
									
									
								
							
							
						
						
									
										628
									
								
								src/core/pp.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -20,36 +20,24 @@ | ||||
| * IN THE SOFTWARE. | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "util.h" | ||||
| #include "state.h" | ||||
| #include <math.h> | ||||
| #endif | ||||
|  | ||||
| #include <string.h> | ||||
| #include <ctype.h> | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include <janet.h> | ||||
| #include "util.h" | ||||
| #include "state.h" | ||||
| #endif | ||||
|  | ||||
| /* Implements a pretty printer for Janet. The pretty printer | ||||
|  * is simple and not that flexible, but fast. */ | ||||
|  * is farily simple and not that flexible, but fast. */ | ||||
|  | ||||
| /* Temporary buffer size */ | ||||
| #define BUFSIZE 64 | ||||
|  | ||||
| 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"; | ||||
|     int count; | ||||
|     if (x == 0.0) { | ||||
|         /* Prevent printing of '-0' */ | ||||
|         count = 1; | ||||
|         buffer->data[buffer->count] = '0'; | ||||
|     } else { | ||||
|         count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, fmt, x); | ||||
|     } | ||||
|     int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, "%g", x); | ||||
|     buffer->count += count; | ||||
| } | ||||
|  | ||||
| @@ -128,6 +116,9 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p | ||||
| #undef POINTSIZE | ||||
| } | ||||
|  | ||||
| #undef HEX | ||||
| #undef BUFSIZE | ||||
|  | ||||
| static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) { | ||||
|     janet_buffer_push_u8(buffer, '"'); | ||||
|     for (int32_t i = 0; i < len; ++i) { | ||||
| @@ -157,11 +148,8 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in | ||||
|             case '\\': | ||||
|                 janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2); | ||||
|                 break; | ||||
|             case '\t': | ||||
|                 janet_buffer_push_bytes(buffer, (const uint8_t *)"\\t", 2); | ||||
|                 break; | ||||
|             default: | ||||
|                 if (c < 32 || c > 126) { | ||||
|                 if (c < 32 || c > 127) { | ||||
|                     uint8_t buf[4]; | ||||
|                     buf[0] = '\\'; | ||||
|                     buf[1] = 'x'; | ||||
| @@ -182,50 +170,53 @@ static void janet_escape_string_b(JanetBuffer *buffer, const uint8_t *str) { | ||||
| } | ||||
|  | ||||
| static void janet_escape_buffer_b(JanetBuffer *buffer, JanetBuffer *bx) { | ||||
|     if (bx == buffer) { | ||||
|         /* Ensures buffer won't resize while escaping */ | ||||
|         janet_buffer_ensure(bx, bx->count + 5 * bx->count + 3, 1); | ||||
|     } | ||||
|     janet_buffer_push_u8(buffer, '@'); | ||||
|     janet_escape_string_impl(buffer, bx->data, bx->count); | ||||
| } | ||||
|  | ||||
| void janet_to_string_b(JanetBuffer *buffer, Janet x) { | ||||
| void janet_description_b(JanetBuffer *buffer, Janet x) { | ||||
|     switch (janet_type(x)) { | ||||
|         case JANET_NIL: | ||||
|             janet_buffer_push_cstring(buffer, ""); | ||||
|             break; | ||||
|             janet_buffer_push_cstring(buffer, "nil"); | ||||
|             return; | ||||
|         case JANET_BOOLEAN: | ||||
|             janet_buffer_push_cstring(buffer, | ||||
|                                       janet_unwrap_boolean(x) ? "true" : "false"); | ||||
|             break; | ||||
|             return; | ||||
|         case JANET_NUMBER: | ||||
|             number_to_string_b(buffer, janet_unwrap_number(x)); | ||||
|             break; | ||||
|         case JANET_STRING: | ||||
|         case JANET_SYMBOL: | ||||
|             return; | ||||
|         case JANET_KEYWORD: | ||||
|             janet_buffer_push_u8(buffer, ':'); | ||||
|         /* fallthrough */ | ||||
|         case JANET_SYMBOL: | ||||
|             janet_buffer_push_bytes(buffer, | ||||
|                                     janet_unwrap_string(x), | ||||
|                                     janet_string_length(janet_unwrap_string(x))); | ||||
|             break; | ||||
|             return; | ||||
|         case JANET_STRING: | ||||
|             janet_escape_string_b(buffer, janet_unwrap_string(x)); | ||||
|             return; | ||||
|         case JANET_BUFFER: { | ||||
|             JanetBuffer *to = janet_unwrap_buffer(x); | ||||
|             /* Prevent resizing buffer while appending */ | ||||
|             if (buffer == to) janet_buffer_extra(buffer, to->count); | ||||
|             janet_buffer_push_bytes(buffer, to->data, to->count); | ||||
|             break; | ||||
|             JanetBuffer *b = janet_unwrap_buffer(x); | ||||
|             if (b == buffer) { | ||||
|                 /* Ensures buffer won't resize while escaping */ | ||||
|                 janet_buffer_ensure(b, 5 * b->count + 3, 1); | ||||
|             } | ||||
|             janet_escape_buffer_b(buffer, b); | ||||
|             return; | ||||
|         } | ||||
|         case JANET_ABSTRACT: { | ||||
|             JanetAbstract p = janet_unwrap_abstract(x); | ||||
|             const JanetAbstractType *t = janet_abstract_type(p); | ||||
|             if (t->tostring != NULL) { | ||||
|                 t->tostring(p, buffer); | ||||
|             void *p = janet_unwrap_abstract(x); | ||||
|             const JanetAbstractType *at = janet_abstract_type(p); | ||||
|             if (at->tostring) { | ||||
|                 at->tostring(p, buffer); | ||||
|             } else { | ||||
|                 string_description_b(buffer, t->name, p); | ||||
|                 const char *n = at->name; | ||||
|                 string_description_b(buffer, n, janet_unwrap_abstract(x)); | ||||
|             } | ||||
|             return; | ||||
|         } | ||||
|         return; | ||||
|         case JANET_CFUNCTION: { | ||||
|             Janet check = janet_table_get(janet_vm_registry, x); | ||||
|             if (janet_checktype(check, JANET_SYMBOL)) { | ||||
| @@ -257,61 +248,24 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) { | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* See parse.c for full table */ | ||||
|  | ||||
| static const uint32_t pp_symchars[8] = { | ||||
|     0x00000000, 0xf7ffec72, 0xc7ffffff, 0x07fffffe, | ||||
|     0x00000000, 0x00000000, 0x00000000, 0x00000000 | ||||
| }; | ||||
|  | ||||
| static int pp_is_symbol_char(uint8_t c) { | ||||
|     return pp_symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F)); | ||||
| } | ||||
|  | ||||
| /* Check if a symbol or keyword contains no symbol characters */ | ||||
| static int contains_bad_chars(const uint8_t *sym, int issym) { | ||||
|     int32_t len = janet_string_length(sym); | ||||
|     if (len && issym && sym[0] >= '0' && sym[0] <= '9') return 1; | ||||
|     for (int32_t i = 0; i < len; i++) { | ||||
|         if (!pp_is_symbol_char(sym[i])) return 1; | ||||
|     } | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| void janet_description_b(JanetBuffer *buffer, Janet x) { | ||||
| void janet_to_string_b(JanetBuffer *buffer, Janet x) { | ||||
|     switch (janet_type(x)) { | ||||
|         default: | ||||
|             janet_description_b(buffer, x); | ||||
|             break; | ||||
|         case JANET_NIL: | ||||
|             janet_buffer_push_cstring(buffer, "nil"); | ||||
|             return; | ||||
|         case JANET_KEYWORD: | ||||
|             janet_buffer_push_u8(buffer, ':'); | ||||
|         case JANET_BUFFER: | ||||
|             janet_buffer_push_bytes(buffer, | ||||
|                                     janet_unwrap_buffer(x)->data, | ||||
|                                     janet_unwrap_buffer(x)->count); | ||||
|             break; | ||||
|         case JANET_STRING: | ||||
|             janet_escape_string_b(buffer, janet_unwrap_string(x)); | ||||
|             return; | ||||
|         case JANET_BUFFER: { | ||||
|             JanetBuffer *b = janet_unwrap_buffer(x); | ||||
|             janet_escape_buffer_b(buffer, b); | ||||
|             return; | ||||
|         } | ||||
|         case JANET_ABSTRACT: { | ||||
|             JanetAbstract p = janet_unwrap_abstract(x); | ||||
|             const JanetAbstractType *t = janet_abstract_type(p); | ||||
|             if (t->tostring != NULL) { | ||||
|                 janet_buffer_push_cstring(buffer, "<"); | ||||
|                 janet_buffer_push_cstring(buffer, t->name); | ||||
|                 janet_buffer_push_cstring(buffer, " "); | ||||
|                 t->tostring(p, buffer); | ||||
|                 janet_buffer_push_cstring(buffer, ">"); | ||||
|             } else { | ||||
|                 string_description_b(buffer, t->name, p); | ||||
|             } | ||||
|             return; | ||||
|         } | ||||
|         case JANET_SYMBOL: | ||||
|         case JANET_KEYWORD: | ||||
|             janet_buffer_push_bytes(buffer, | ||||
|                                     janet_unwrap_string(x), | ||||
|                                     janet_string_length(janet_unwrap_string(x))); | ||||
|             break; | ||||
|     } | ||||
|     janet_to_string_b(buffer, x); | ||||
| } | ||||
|  | ||||
| const uint8_t *janet_description(Janet x) { | ||||
| @@ -351,96 +305,12 @@ struct pretty { | ||||
|     int indent; | ||||
|     int flags; | ||||
|     int32_t bufstartlen; | ||||
|     int32_t *keysort_buffer; | ||||
|     int32_t keysort_capacity; | ||||
|     int32_t keysort_start; | ||||
|     JanetTable seen; | ||||
| }; | ||||
|  | ||||
| /* Print jdn format */ | ||||
| static int print_jdn_one(struct pretty *S, Janet x, int depth) { | ||||
|     if (depth == 0) return 1; | ||||
|     switch (janet_type(x)) { | ||||
|         case JANET_NIL: | ||||
|         case JANET_BOOLEAN: | ||||
|         case JANET_BUFFER: | ||||
|         case JANET_STRING: | ||||
|             janet_description_b(S->buffer, x); | ||||
|             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; | ||||
|             break; | ||||
|         case JANET_SYMBOL: | ||||
|         case JANET_KEYWORD: | ||||
|             if (contains_bad_chars(janet_unwrap_keyword(x), janet_type(x) == JANET_SYMBOL)) return 1; | ||||
|             janet_description_b(S->buffer, x); | ||||
|             break; | ||||
|         case JANET_TUPLE: { | ||||
|             JanetTuple t = janet_unwrap_tuple(x); | ||||
|             int isb = janet_tuple_flag(t) & JANET_TUPLE_FLAG_BRACKETCTOR; | ||||
|             janet_buffer_push_u8(S->buffer, isb ? '[' : '('); | ||||
|             for (int32_t i = 0; i < janet_tuple_length(t); i++) { | ||||
|                 if (i) janet_buffer_push_u8(S->buffer, ' '); | ||||
|                 if (print_jdn_one(S, t[i], depth - 1)) return 1; | ||||
|             } | ||||
|             janet_buffer_push_u8(S->buffer, isb ? ']' : ')'); | ||||
|         } | ||||
|         break; | ||||
|         case JANET_ARRAY: { | ||||
|             janet_table_put(&S->seen, x, janet_wrap_true()); | ||||
|             JanetArray *a = janet_unwrap_array(x); | ||||
|             janet_buffer_push_cstring(S->buffer, "@["); | ||||
|             for (int32_t i = 0; i < a->count; i++) { | ||||
|                 if (i) janet_buffer_push_u8(S->buffer, ' '); | ||||
|                 if (print_jdn_one(S, a->data[i], depth - 1)) return 1; | ||||
|             } | ||||
|             janet_buffer_push_u8(S->buffer, ']'); | ||||
|         } | ||||
|         break; | ||||
|         case JANET_TABLE: { | ||||
|             janet_table_put(&S->seen, x, janet_wrap_true()); | ||||
|             JanetTable *tab = janet_unwrap_table(x); | ||||
|             janet_buffer_push_cstring(S->buffer, "@{"); | ||||
|             int isFirst = 1; | ||||
|             for (int32_t i = 0; i < tab->capacity; i++) { | ||||
|                 const JanetKV *kv = tab->data + i; | ||||
|                 if (janet_checktype(kv->key, JANET_NIL)) continue; | ||||
|                 if (!isFirst) janet_buffer_push_u8(S->buffer, ' '); | ||||
|                 isFirst = 0; | ||||
|                 if (print_jdn_one(S, kv->key, depth - 1)) return 1; | ||||
|                 janet_buffer_push_u8(S->buffer, ' '); | ||||
|                 if (print_jdn_one(S, kv->value, depth - 1)) return 1; | ||||
|             } | ||||
|             janet_buffer_push_u8(S->buffer, '}'); | ||||
|         } | ||||
|         break; | ||||
|         case JANET_STRUCT: { | ||||
|             JanetStruct st = janet_unwrap_struct(x); | ||||
|             janet_buffer_push_u8(S->buffer, '{'); | ||||
|             int isFirst = 1; | ||||
|             for (int32_t i = 0; i < janet_struct_capacity(st); i++) { | ||||
|                 const JanetKV *kv = st + i; | ||||
|                 if (janet_checktype(kv->key, JANET_NIL)) continue; | ||||
|                 if (!isFirst) janet_buffer_push_u8(S->buffer, ' '); | ||||
|                 isFirst = 0; | ||||
|                 if (print_jdn_one(S, kv->key, depth - 1)) return 1; | ||||
|                 janet_buffer_push_u8(S->buffer, ' '); | ||||
|                 if (print_jdn_one(S, kv->value, depth - 1)) return 1; | ||||
|             } | ||||
|             janet_buffer_push_u8(S->buffer, '}'); | ||||
|         } | ||||
|         break; | ||||
|         default: | ||||
|             return 1; | ||||
|     } | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| static void print_newline(struct pretty *S, int just_a_space) { | ||||
|     int i; | ||||
|     if (just_a_space || (S->flags & JANET_PRETTY_ONELINE)) { | ||||
|     if (just_a_space) { | ||||
|         janet_buffer_push_u8(S->buffer, ' '); | ||||
|         return; | ||||
|     } | ||||
| @@ -452,7 +322,6 @@ static void print_newline(struct pretty *S, int just_a_space) { | ||||
|  | ||||
| /* Color coding for types */ | ||||
| static const char janet_cycle_color[] = "\x1B[36m"; | ||||
| static const char janet_class_color[] = "\x1B[34m"; | ||||
| static const char *janet_pretty_colors[] = { | ||||
|     "\x1B[32m", | ||||
|     "\x1B[36m", | ||||
| @@ -464,7 +333,7 @@ static const char *janet_pretty_colors[] = { | ||||
|     "\x1B[36m", | ||||
|     "\x1B[36m", | ||||
|     "\x1B[36m", | ||||
|     "\x1B[36m", | ||||
|     "\x1B[36m" | ||||
|     "\x1B[35m", | ||||
|     "\x1B[36m", | ||||
|     "\x1B[36m", | ||||
| @@ -474,8 +343,6 @@ static const char *janet_pretty_colors[] = { | ||||
|  | ||||
| #define JANET_PRETTY_DICT_ONELINE 4 | ||||
| #define JANET_PRETTY_IND_ONELINE 10 | ||||
| #define JANET_PRETTY_DICT_LIMIT 30 | ||||
| #define JANET_PRETTY_ARRAY_LIMIT 160 | ||||
|  | ||||
| /* Helper for pretty printing */ | ||||
| static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) { | ||||
| @@ -539,25 +406,12 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) { | ||||
|             if (S->depth == 0) { | ||||
|                 janet_buffer_push_cstring(S->buffer, "..."); | ||||
|             } else { | ||||
|                 if (!isarray && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_IND_ONELINE) | ||||
|                 if (!isarray && len >= JANET_PRETTY_IND_ONELINE) | ||||
|                     janet_buffer_push_u8(S->buffer, ' '); | ||||
|                 if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0); | ||||
|                 if (len > JANET_PRETTY_ARRAY_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) { | ||||
|                     for (i = 0; i < 3; i++) { | ||||
|                         if (i) print_newline(S, 0); | ||||
|                         janet_pretty_one(S, arr[i], 0); | ||||
|                     } | ||||
|                     print_newline(S, 0); | ||||
|                     janet_buffer_push_cstring(S->buffer, "..."); | ||||
|                     for (i = 0; i < 3; i++) { | ||||
|                         print_newline(S, 0); | ||||
|                         janet_pretty_one(S, arr[len - 3 + i], 0); | ||||
|                     } | ||||
|                 } else { | ||||
|                     for (i = 0; i < len; i++) { | ||||
|                         if (i) print_newline(S, len < JANET_PRETTY_IND_ONELINE); | ||||
|                         janet_pretty_one(S, arr[i], 0); | ||||
|                     } | ||||
|                 for (i = 0; i < len; i++) { | ||||
|                     if (i) print_newline(S, len < JANET_PRETTY_IND_ONELINE); | ||||
|                     janet_pretty_one(S, arr[i], 0); | ||||
|                 } | ||||
|             } | ||||
|             S->indent -= 2; | ||||
| @@ -575,17 +429,10 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) { | ||||
|                 JanetTable *t = janet_unwrap_table(x); | ||||
|                 JanetTable *proto = t->proto; | ||||
|                 if (NULL != proto) { | ||||
|                     Janet name = janet_table_get(proto, janet_ckeywordv("_name")); | ||||
|                     const uint8_t *n; | ||||
|                     int32_t len; | ||||
|                     if (janet_bytes_view(name, &n, &len)) { | ||||
|                         if (S->flags & JANET_PRETTY_COLOR) { | ||||
|                             janet_buffer_push_cstring(S->buffer, janet_class_color); | ||||
|                         } | ||||
|                         janet_buffer_push_bytes(S->buffer, n, len); | ||||
|                         if (S->flags & JANET_PRETTY_COLOR) { | ||||
|                             janet_buffer_push_cstring(S->buffer, "\x1B[0m"); | ||||
|                         } | ||||
|                     Janet name = janet_table_get(proto, janet_csymbolv(":name")); | ||||
|                     if (janet_checktype(name, JANET_SYMBOL)) { | ||||
|                         const uint8_t *sym = janet_unwrap_symbol(name); | ||||
|                         janet_buffer_push_bytes(S->buffer, sym, janet_string_length(sym)); | ||||
|                     } | ||||
|                 } | ||||
|                 janet_buffer_push_cstring(S->buffer, "{"); | ||||
| @@ -597,55 +444,24 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) { | ||||
|                 janet_buffer_push_cstring(S->buffer, "..."); | ||||
|             } else { | ||||
|                 int32_t i = 0, len = 0, cap = 0; | ||||
|                 int first_kv_pair = 1; | ||||
|                 const JanetKV *kvs = NULL; | ||||
|                 janet_dictionary_view(x, &kvs, &len, &cap); | ||||
|                 if (!istable && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_DICT_ONELINE) | ||||
|                 if (!istable && len >= JANET_PRETTY_DICT_ONELINE) | ||||
|                     janet_buffer_push_u8(S->buffer, ' '); | ||||
|                 if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0); | ||||
|                 int32_t ks_start = S->keysort_start; | ||||
|  | ||||
|                 /* Ensure buffer is large enough to sort keys. */ | ||||
|                 int truncated = 0; | ||||
|                 int64_t mincap = (int64_t) len + (int64_t) ks_start; | ||||
|                 if (mincap > INT32_MAX) { | ||||
|                     truncated = 1; | ||||
|                     len = 0; | ||||
|                     mincap = ks_start; | ||||
|                 } | ||||
|  | ||||
|                 if (S->keysort_capacity < mincap) { | ||||
|                     if (mincap >= INT32_MAX / 2) { | ||||
|                         S->keysort_capacity = INT32_MAX; | ||||
|                     } else { | ||||
|                         S->keysort_capacity = (int32_t)(mincap * 2); | ||||
|                     } | ||||
|                     S->keysort_buffer = janet_srealloc(S->keysort_buffer, sizeof(int32_t) * S->keysort_capacity); | ||||
|                     if (NULL == S->keysort_buffer) { | ||||
|                         JANET_OUT_OF_MEMORY; | ||||
|                 for (i = 0; i < cap; i++) { | ||||
|                     if (!janet_checktype(kvs[i].key, JANET_NIL)) { | ||||
|                         if (first_kv_pair) { | ||||
|                             first_kv_pair = 0; | ||||
|                         } else { | ||||
|                             print_newline(S, len < JANET_PRETTY_DICT_ONELINE); | ||||
|                         } | ||||
|                         janet_pretty_one(S, kvs[i].key, 0); | ||||
|                         janet_buffer_push_u8(S->buffer, ' '); | ||||
|                         janet_pretty_one(S, kvs[i].value, 1); | ||||
|                     } | ||||
|                 } | ||||
|  | ||||
|                 janet_sorted_keys(kvs, cap, S->keysort_buffer + ks_start); | ||||
|                 S->keysort_start += len; | ||||
|                 if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) { | ||||
|                     len = JANET_PRETTY_DICT_LIMIT; | ||||
|                     truncated = 1; | ||||
|                 } | ||||
|  | ||||
|                 for (i = 0; i < len; i++) { | ||||
|                     if (i) print_newline(S, len < JANET_PRETTY_DICT_ONELINE); | ||||
|                     int32_t j = S->keysort_buffer[i + ks_start]; | ||||
|                     janet_pretty_one(S, kvs[j].key, 0); | ||||
|                     janet_buffer_push_u8(S->buffer, ' '); | ||||
|                     janet_pretty_one(S, kvs[j].value, 1); | ||||
|                 } | ||||
|  | ||||
|                 if (truncated) { | ||||
|                     print_newline(S, 0); | ||||
|                     janet_buffer_push_cstring(S->buffer, "..."); | ||||
|                 } | ||||
|  | ||||
|                 S->keysort_start = ks_start; | ||||
|             } | ||||
|             S->indent -= 2; | ||||
|             S->depth++; | ||||
| @@ -668,9 +484,6 @@ static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Jan | ||||
|     S.indent = 0; | ||||
|     S.flags = flags; | ||||
|     S.bufstartlen = startlen; | ||||
|     S.keysort_capacity = 0; | ||||
|     S.keysort_buffer = NULL; | ||||
|     S.keysort_start = 0; | ||||
|     janet_table_init(&S.seen, 10); | ||||
|     janet_pretty_one(&S, x, 0); | ||||
|     janet_table_deinit(&S.seen); | ||||
| @@ -683,32 +496,6 @@ JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x) { | ||||
|     return janet_pretty_(buffer, depth, flags, x, buffer ? buffer->count : 0); | ||||
| } | ||||
|  | ||||
| static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t startlen) { | ||||
|     struct pretty S; | ||||
|     if (NULL == buffer) { | ||||
|         buffer = janet_buffer(0); | ||||
|     } | ||||
|     S.buffer = buffer; | ||||
|     S.depth = depth; | ||||
|     S.indent = 0; | ||||
|     S.flags = 0; | ||||
|     S.bufstartlen = startlen; | ||||
|     S.keysort_capacity = 0; | ||||
|     S.keysort_buffer = NULL; | ||||
|     S.keysort_start = 0; | ||||
|     janet_table_init(&S.seen, 10); | ||||
|     int res = print_jdn_one(&S, x, depth); | ||||
|     janet_table_deinit(&S.seen); | ||||
|     if (res) { | ||||
|         janet_panic("could not print to jdn format"); | ||||
|     } | ||||
|     return S.buffer; | ||||
| } | ||||
|  | ||||
| JanetBuffer *janet_jdn(JanetBuffer *buffer, int depth, Janet x) { | ||||
|     return janet_jdn_(buffer, depth, x, buffer ? buffer->count : 0); | ||||
| } | ||||
|  | ||||
| static const char *typestr(Janet x) { | ||||
|     JanetType t = janet_type(x); | ||||
|     return (t == JANET_ABSTRACT) | ||||
| @@ -733,6 +520,96 @@ static void pushtypes(JanetBuffer *buffer, int types) { | ||||
|     } | ||||
| } | ||||
|  | ||||
| void janet_formatb(JanetBuffer *bufp, const char *format, va_list args) { | ||||
|     for (const char *c = format; *c; c++) { | ||||
|         switch (*c) { | ||||
|             default: | ||||
|                 janet_buffer_push_u8(bufp, *c); | ||||
|                 break; | ||||
|             case '%': { | ||||
|                 if (c[1] == '\0') | ||||
|                     break; | ||||
|                 switch (*++c) { | ||||
|                     default: | ||||
|                         janet_buffer_push_u8(bufp, *c); | ||||
|                         break; | ||||
|                     case 'f': | ||||
|                         number_to_string_b(bufp, va_arg(args, double)); | ||||
|                         break; | ||||
|                     case 'd': | ||||
|                         integer_to_string_b(bufp, va_arg(args, long)); | ||||
|                         break; | ||||
|                     case 'S': { | ||||
|                         const uint8_t *str = va_arg(args, const uint8_t *); | ||||
|                         janet_buffer_push_bytes(bufp, str, janet_string_length(str)); | ||||
|                         break; | ||||
|                     } | ||||
|                     case 's': | ||||
|                         janet_buffer_push_cstring(bufp, va_arg(args, const char *)); | ||||
|                         break; | ||||
|                     case 'c': | ||||
|                         janet_buffer_push_u8(bufp, (uint8_t) va_arg(args, long)); | ||||
|                         break; | ||||
|                     case 'q': { | ||||
|                         const uint8_t *str = va_arg(args, const uint8_t *); | ||||
|                         janet_escape_string_b(bufp, str); | ||||
|                         break; | ||||
|                     } | ||||
|                     case 't': { | ||||
|                         janet_buffer_push_cstring(bufp, typestr(va_arg(args, Janet))); | ||||
|                         break; | ||||
|                     } | ||||
|                     case 'T': { | ||||
|                         int types = va_arg(args, long); | ||||
|                         pushtypes(bufp, types); | ||||
|                         break; | ||||
|                     } | ||||
|                     case 'V': { | ||||
|                         janet_to_string_b(bufp, va_arg(args, Janet)); | ||||
|                         break; | ||||
|                     } | ||||
|                     case 'v': { | ||||
|                         janet_description_b(bufp, va_arg(args, Janet)); | ||||
|                         break; | ||||
|                     } | ||||
|                     case 'p': { | ||||
|                         janet_pretty(bufp, 4, 0, va_arg(args, Janet)); | ||||
|                         break; | ||||
|                     } | ||||
|                     case 'P': { | ||||
|                         janet_pretty(bufp, 4, JANET_PRETTY_COLOR, va_arg(args, Janet)); | ||||
|                         break; | ||||
|                     } | ||||
|                 } | ||||
|             } | ||||
|         } | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Helper function for formatting strings. Useful for generating error messages and the like. | ||||
|  * Similar to printf, but specialized for operating with janet. */ | ||||
| const uint8_t *janet_formatc(const char *format, ...) { | ||||
|     va_list args; | ||||
|     const uint8_t *ret; | ||||
|     JanetBuffer buffer; | ||||
|     int32_t len = 0; | ||||
|  | ||||
|     /* Calculate length, init buffer and args */ | ||||
|     while (format[len]) len++; | ||||
|     janet_buffer_init(&buffer, len); | ||||
|     va_start(args, format); | ||||
|  | ||||
|     /* Run format */ | ||||
|     janet_formatb(&buffer, format, args); | ||||
|  | ||||
|     /* Iterate length */ | ||||
|     va_end(args); | ||||
|  | ||||
|     ret = janet_string(buffer.data, buffer.count); | ||||
|     janet_buffer_deinit(&buffer); | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| /* | ||||
|  * code adapted from lua/lstrlib.c http://lua.org | ||||
|  */ | ||||
| @@ -773,154 +650,6 @@ static const char *scanformat( | ||||
|     return p; | ||||
| } | ||||
|  | ||||
| void janet_formatbv(JanetBuffer *b, const char *format, va_list args) { | ||||
|     const char *format_end = format + strlen(format); | ||||
|     const char *c = format; | ||||
|     int32_t startlen = b->count; | ||||
|     while (c < format_end) { | ||||
|         if (*c != '%') { | ||||
|             janet_buffer_push_u8(b, (uint8_t) *c++); | ||||
|         } else if (*++c == '%') { | ||||
|             janet_buffer_push_u8(b, (uint8_t) *c++); | ||||
|         } else { | ||||
|             char form[MAX_FORMAT], item[MAX_ITEM]; | ||||
|             char width[3], precision[3]; | ||||
|             int nb = 0; /* number of bytes in added item */ | ||||
|             c = scanformat(c, form, width, precision); | ||||
|             switch (*c++) { | ||||
|                 case 'c': { | ||||
|                     int n = va_arg(args, long); | ||||
|                     nb = snprintf(item, MAX_ITEM, form, n); | ||||
|                     break; | ||||
|                 } | ||||
|                 case 'd': | ||||
|                 case 'i': | ||||
|                 case 'o': | ||||
|                 case 'x': | ||||
|                 case 'X': { | ||||
|                     int32_t n = va_arg(args, long); | ||||
|                     nb = snprintf(item, MAX_ITEM, form, n); | ||||
|                     break; | ||||
|                 } | ||||
|                 case 'a': | ||||
|                 case 'A': | ||||
|                 case 'e': | ||||
|                 case 'E': | ||||
|                 case 'f': | ||||
|                 case 'g': | ||||
|                 case 'G': { | ||||
|                     double d = va_arg(args, double); | ||||
|                     nb = snprintf(item, MAX_ITEM, form, d); | ||||
|                     break; | ||||
|                 } | ||||
|                 case 's': | ||||
|                 case 'S': { | ||||
|                     const char *str = va_arg(args, const char *); | ||||
|                     int32_t len = c[-1] == 's' | ||||
|                                   ? (int32_t) strlen(str) | ||||
|                                   : janet_string_length((JanetString) str); | ||||
|                     if (form[2] == '\0') | ||||
|                         janet_buffer_push_bytes(b, (const uint8_t *) str, len); | ||||
|                     else { | ||||
|                         if (len != (int32_t) strlen((const char *) str)) | ||||
|                             janet_panic("string contains zeros"); | ||||
|                         if (!strchr(form, '.') && len >= 100) { | ||||
|                             janet_panic("no precision and string is too long to be formatted"); | ||||
|                         } else { | ||||
|                             nb = snprintf(item, MAX_ITEM, form, str); | ||||
|                         } | ||||
|                     } | ||||
|                     break; | ||||
|                 } | ||||
|                 case 'V': | ||||
|                     janet_to_string_b(b, va_arg(args, Janet)); | ||||
|                     break; | ||||
|                 case 'v': | ||||
|                     janet_description_b(b, va_arg(args, Janet)); | ||||
|                     break; | ||||
|                 case 't': | ||||
|                     janet_buffer_push_cstring(b, typestr(va_arg(args, Janet))); | ||||
|                     break; | ||||
|                 case 'T': { | ||||
|                     int types = va_arg(args, long); | ||||
|                     pushtypes(b, types); | ||||
|                     break; | ||||
|                 } | ||||
|                 case 'M': | ||||
|                 case 'm': | ||||
|                 case 'N': | ||||
|                 case 'n': | ||||
|                 case 'Q': | ||||
|                 case 'q': | ||||
|                 case 'P': | ||||
|                 case 'p': { /* janet pretty , precision = depth */ | ||||
|                     int depth = atoi(precision); | ||||
|                     if (depth < 1) depth = JANET_RECURSION_GUARD; | ||||
|                     char d = c[-1]; | ||||
|                     int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N'); | ||||
|                     int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n'); | ||||
|                     int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n'); | ||||
|                     int flags = 0; | ||||
|                     flags |= has_color ? JANET_PRETTY_COLOR : 0; | ||||
|                     flags |= has_oneline ? JANET_PRETTY_ONELINE : 0; | ||||
|                     flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0; | ||||
|                     janet_pretty_(b, depth, flags, va_arg(args, Janet), startlen); | ||||
|                     break; | ||||
|                 } | ||||
|                 case 'j': { | ||||
|                     int depth = atoi(precision); | ||||
|                     if (depth < 1) | ||||
|                         depth = JANET_RECURSION_GUARD; | ||||
|                     janet_jdn_(b, depth, va_arg(args, Janet), startlen); | ||||
|                     break; | ||||
|                 } | ||||
|                 default: { | ||||
|                     /* also treat cases 'nLlh' */ | ||||
|                     janet_panicf("invalid conversion '%s' to 'format'", | ||||
|                                  form); | ||||
|                 } | ||||
|             } | ||||
|             if (nb >= MAX_ITEM) | ||||
|                 janet_panicf("format buffer overflow", form); | ||||
|             if (nb > 0) | ||||
|                 janet_buffer_push_bytes(b, (uint8_t *) item, nb); | ||||
|         } | ||||
|  | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Helper function for formatting strings. Useful for generating error messages and the like. | ||||
|  * Similar to printf, but specialized for operating with janet. */ | ||||
| const uint8_t *janet_formatc(const char *format, ...) { | ||||
|     va_list args; | ||||
|     const uint8_t *ret; | ||||
|     JanetBuffer buffer; | ||||
|     int32_t len = 0; | ||||
|  | ||||
|     /* Calculate length, init buffer and args */ | ||||
|     while (format[len]) len++; | ||||
|     janet_buffer_init(&buffer, len); | ||||
|     va_start(args, format); | ||||
|  | ||||
|     /* Run format */ | ||||
|     janet_formatbv(&buffer, format, args); | ||||
|  | ||||
|     /* Iterate length */ | ||||
|     va_end(args); | ||||
|  | ||||
|     ret = janet_string(buffer.data, buffer.count); | ||||
|     janet_buffer_deinit(&buffer); | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| JanetBuffer *janet_formatb(JanetBuffer *buffer, const char *format, ...) { | ||||
|     va_list args; | ||||
|     va_start(args, format); | ||||
|     janet_formatbv(buffer, format, args); | ||||
|     va_end(args); | ||||
|     return buffer; | ||||
| } | ||||
|  | ||||
| /* Shared implementation between string/format and | ||||
|  * buffer/format */ | ||||
| void janet_buffer_format( | ||||
| @@ -954,6 +683,7 @@ void janet_buffer_format( | ||||
|                 case 'd': | ||||
|                 case 'i': | ||||
|                 case 'o': | ||||
|                 case 'u': | ||||
|                 case 'x': | ||||
|                 case 'X': { | ||||
|                     int32_t n = janet_getinteger(argv, arg); | ||||
| @@ -995,35 +725,12 @@ void janet_buffer_format( | ||||
|                     janet_description_b(b, argv[arg]); | ||||
|                     break; | ||||
|                 } | ||||
|                 case 't': | ||||
|                     janet_buffer_push_cstring(b, typestr(argv[arg])); | ||||
|                     break; | ||||
|                 case 'M': | ||||
|                 case 'm': | ||||
|                 case 'N': | ||||
|                 case 'n': | ||||
|                 case 'Q': | ||||
|                 case 'q': | ||||
|                 case 'P': | ||||
|                 case 'p': { /* janet pretty , precision = depth */ | ||||
|                     int depth = atoi(precision); | ||||
|                     if (depth < 1) depth = JANET_RECURSION_GUARD; | ||||
|                     char d = strfrmt[-1]; | ||||
|                     int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N'); | ||||
|                     int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n'); | ||||
|                     int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n'); | ||||
|                     int flags = 0; | ||||
|                     flags |= has_color ? JANET_PRETTY_COLOR : 0; | ||||
|                     flags |= has_oneline ? JANET_PRETTY_ONELINE : 0; | ||||
|                     flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0; | ||||
|                     janet_pretty_(b, depth, flags, argv[arg], startlen); | ||||
|                     break; | ||||
|                 } | ||||
|                 case 'j': { | ||||
|                     int depth = atoi(precision); | ||||
|                     if (depth < 1) | ||||
|                         depth = JANET_RECURSION_GUARD; | ||||
|                     janet_jdn_(b, depth, argv[arg], startlen); | ||||
|                         depth = 4; | ||||
|                     janet_pretty_(b, depth, (strfrmt[-1] == 'P') ? JANET_PRETTY_COLOR : 0, argv[arg], startlen); | ||||
|                     break; | ||||
|                 } | ||||
|                 default: { | ||||
| @@ -1039,6 +746,3 @@ void janet_buffer_format( | ||||
|         } | ||||
|     } | ||||
| } | ||||
|  | ||||
| #undef HEX | ||||
| #undef BUFSIZE | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,7 +21,6 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "regalloc.h" | ||||
| #include "util.h" | ||||
| @@ -36,7 +35,7 @@ void janetc_regalloc_init(JanetcRegisterAllocator *ra) { | ||||
| } | ||||
|  | ||||
| void janetc_regalloc_deinit(JanetcRegisterAllocator *ra) { | ||||
|     janet_free(ra->chunks); | ||||
|     free(ra->chunks); | ||||
| } | ||||
|  | ||||
| /* Fallbacks for when ctz not available */ | ||||
| @@ -67,10 +66,10 @@ void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocato | ||||
|     dest->count = src->count; | ||||
|     dest->capacity = src->capacity; | ||||
|     dest->max = src->max; | ||||
|     size = sizeof(uint32_t) * (size_t) dest->capacity; | ||||
|     size = sizeof(uint32_t) * dest->capacity; | ||||
|     dest->regtemps = 0; | ||||
|     if (size) { | ||||
|         dest->chunks = janet_malloc(size); | ||||
|         dest->chunks = malloc(size); | ||||
|         if (!dest->chunks) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
| @@ -87,7 +86,7 @@ static void pushchunk(JanetcRegisterAllocator *ra) { | ||||
|     int32_t newcount = ra->count + 1; | ||||
|     if (newcount > ra->capacity) { | ||||
|         int32_t newcapacity = newcount * 2; | ||||
|         ra->chunks = janet_realloc(ra->chunks, (size_t) newcapacity * sizeof(uint32_t)); | ||||
|         ra->chunks = realloc(ra->chunks, newcapacity * sizeof(uint32_t)); | ||||
|         if (!ra->chunks) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
| @@ -145,7 +144,7 @@ void janetc_regalloc_free(JanetcRegisterAllocator *ra, int32_t reg) { | ||||
| int32_t janetc_regalloc_temp(JanetcRegisterAllocator *ra, JanetcRegisterTemp nth) { | ||||
|     int32_t oldmax = ra->max; | ||||
|     if (ra->regtemps & (1 << nth)) { | ||||
|         JANET_EXIT("regtemp already allocated"); | ||||
|         janet_exit("regtemp already allocated"); | ||||
|     } | ||||
|     ra->regtemps |= 1 << nth; | ||||
|     int32_t reg = janetc_regalloc_1(ra); | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,8 +21,8 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "state.h" | ||||
| #endif | ||||
|  | ||||
| /* Run a string */ | ||||
| @@ -49,42 +49,38 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char | ||||
|                 JanetFiber *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) { | ||||
|                 if (status != JANET_SIGNAL_OK) { | ||||
|                     janet_stacktrace(fiber, ret); | ||||
|                     errflags |= 0x01; | ||||
|                     done = 1; | ||||
|                 } | ||||
|             } else { | ||||
|                 ret = janet_wrap_string(cres.error); | ||||
|                 if (cres.macrofiber) { | ||||
|                     janet_eprintf("compile error in %s: ", sourcePath); | ||||
|                     janet_stacktrace(cres.macrofiber, ret); | ||||
|                 } else { | ||||
|                     janet_eprintf("compile error in %s: %s\n", sourcePath, | ||||
|                                   (const char *)cres.error); | ||||
|                 } | ||||
|                 fprintf(stderr, "compile error in %s: %s\n", sourcePath, | ||||
|                         (const char *)cres.error); | ||||
|                 errflags |= 0x02; | ||||
|                 done = 1; | ||||
|             } | ||||
|         } | ||||
|  | ||||
|         if (done) break; | ||||
|  | ||||
|         /* Dispatch based on parse state */ | ||||
|         switch (janet_parser_status(&parser)) { | ||||
|             case JANET_PARSE_DEAD: | ||||
|                 done = 1; | ||||
|                 break; | ||||
|             case JANET_PARSE_ERROR: { | ||||
|                 const char *e = janet_parser_error(&parser); | ||||
|             case JANET_PARSE_ERROR: | ||||
|                 errflags |= 0x04; | ||||
|                 ret = janet_cstringv(e); | ||||
|                 janet_eprintf("parse error in %s: %s\n", sourcePath, e); | ||||
|                 fprintf(stderr, "parse error in %s: %s\n", | ||||
|                         sourcePath, janet_parser_error(&parser)); | ||||
|                 done = 1; | ||||
|                 break; | ||||
|             } | ||||
|             case JANET_PARSE_ROOT: | ||||
|             case JANET_PARSE_PENDING: | ||||
|                 if (index == len) { | ||||
|                     janet_parser_eof(&parser); | ||||
|                 } else { | ||||
|                     janet_parser_consume(&parser, bytes[index++]); | ||||
|                 } | ||||
|                 break; | ||||
|             case JANET_PARSE_ROOT: | ||||
|                 if (index >= len) { | ||||
|                     janet_parser_eof(&parser); | ||||
|                 } else { | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,7 +21,6 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "compile.h" | ||||
| #include "util.h" | ||||
| @@ -56,11 +55,7 @@ static JanetSlot qq_slots(JanetFopts opts, JanetSlot *slots, int makeop) { | ||||
|     return target; | ||||
| } | ||||
|  | ||||
| static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) { | ||||
|     if (depth == 0) { | ||||
|         janetc_cerror(opts.compiler, "quasiquote too deeply nested"); | ||||
|         return janetc_cslot(janet_wrap_nil()); | ||||
|     } | ||||
| static JanetSlot quasiquote(JanetFopts opts, Janet x) { | ||||
|     JanetSlot *slots = NULL; | ||||
|     switch (janet_type(x)) { | ||||
|         default: | ||||
| @@ -71,18 +66,11 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) { | ||||
|             len = janet_tuple_length(tup); | ||||
|             if (len > 1 && janet_checktype(tup[0], JANET_SYMBOL)) { | ||||
|                 const uint8_t *head = janet_unwrap_symbol(tup[0]); | ||||
|                 if (!janet_cstrcmp(head, "unquote")) { | ||||
|                     if (level == 0) { | ||||
|                         return janetc_value(janetc_fopts_default(opts.compiler), tup[1]); | ||||
|                     } else { | ||||
|                         level--; | ||||
|                     } | ||||
|                 } else if (!janet_cstrcmp(head, "quasiquote")) { | ||||
|                     level++; | ||||
|                 } | ||||
|                 if (!janet_cstrcmp(head, "unquote")) | ||||
|                     return janetc_value(janetc_fopts_default(opts.compiler), tup[1]); | ||||
|             } | ||||
|             for (i = 0; i < len; i++) | ||||
|                 janet_v_push(slots, quasiquote(opts, tup[i], depth - 1, level)); | ||||
|                 janet_v_push(slots, quasiquote(opts, tup[i])); | ||||
|             return qq_slots(opts, slots, (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) | ||||
|                             ? JOP_MAKE_BRACKET_TUPLE | ||||
|                             : JOP_MAKE_TUPLE); | ||||
| @@ -91,7 +79,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) { | ||||
|             int32_t i; | ||||
|             JanetArray *array = janet_unwrap_array(x); | ||||
|             for (i = 0; i < array->count; i++) | ||||
|                 janet_v_push(slots, quasiquote(opts, array->data[i], depth - 1, level)); | ||||
|                 janet_v_push(slots, quasiquote(opts, array->data[i])); | ||||
|             return qq_slots(opts, slots, JOP_MAKE_ARRAY); | ||||
|         } | ||||
|         case JANET_TABLE: | ||||
| @@ -100,8 +88,8 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) { | ||||
|             int32_t len, cap = 0; | ||||
|             janet_dictionary_view(x, &kvs, &len, &cap); | ||||
|             while ((kv = janet_dictionary_next(kvs, cap, kv))) { | ||||
|                 JanetSlot key = quasiquote(opts, kv->key, depth - 1, level); | ||||
|                 JanetSlot value =  quasiquote(opts, kv->value, depth - 1, level); | ||||
|                 JanetSlot key = quasiquote(opts, kv->key); | ||||
|                 JanetSlot value =  quasiquote(opts, kv->value); | ||||
|                 key.flags &= ~JANET_SLOT_SPLICED; | ||||
|                 value.flags &= ~JANET_SLOT_SPLICED; | ||||
|                 janet_v_push(slots, key); | ||||
| @@ -118,7 +106,7 @@ static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *a | ||||
|         janetc_cerror(opts.compiler, "expected 1 argument"); | ||||
|         return janetc_cslot(janet_wrap_nil()); | ||||
|     } | ||||
|     return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0); | ||||
|     return quasiquote(opts, argv[0]); | ||||
| } | ||||
|  | ||||
| static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
| @@ -128,7 +116,7 @@ static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv | ||||
|     return janetc_cslot(janet_wrap_nil()); | ||||
| } | ||||
|  | ||||
| /* Perform destructuring. Be careful to | ||||
| /* Preform destructuring. Be careful to | ||||
|  * keep the order registers are freed. | ||||
|  * Returns if the slot 'right' can be freed. */ | ||||
| static int destructure(JanetCompiler *c, | ||||
| @@ -158,7 +146,7 @@ static int destructure(JanetCompiler *c, | ||||
|                     janetc_emit_ssu(c, JOP_GET_INDEX, nextright, right, (uint8_t) i, 1); | ||||
|                 } else { | ||||
|                     JanetSlot k = janetc_cslot(janet_wrap_integer(i)); | ||||
|                     janetc_emit_sss(c, JOP_IN, nextright, right, k, 1); | ||||
|                     janetc_emit_sss(c, JOP_GET, nextright, right, k, 1); | ||||
|                 } | ||||
|                 if (destructure(c, subval, nextright, leaf, attr)) | ||||
|                     janetc_freeslot(c, nextright); | ||||
| @@ -174,7 +162,7 @@ static int destructure(JanetCompiler *c, | ||||
|                 if (janet_checktype(kvs[i].key, JANET_NIL)) continue; | ||||
|                 JanetSlot nextright = janetc_farslot(c); | ||||
|                 JanetSlot k = janetc_value(janetc_fopts_default(c), kvs[i].key); | ||||
|                 janetc_emit_sss(c, JOP_IN, nextright, right, k, 1); | ||||
|                 janetc_emit_sss(c, JOP_GET, nextright, right, k, 1); | ||||
|                 if (destructure(c, kvs[i].value, nextright, leaf, attr)) | ||||
|                     janetc_freeslot(c, nextright); | ||||
|             } | ||||
| @@ -187,8 +175,8 @@ static int destructure(JanetCompiler *c, | ||||
| static const Janet *janetc_make_sourcemap(JanetCompiler *c) { | ||||
|     Janet *tup = janet_tuple_begin(3); | ||||
|     tup[0] = c->source ? janet_wrap_string(c->source) : janet_wrap_nil(); | ||||
|     tup[1] = janet_wrap_integer(c->current_mapping.line); | ||||
|     tup[2] = janet_wrap_integer(c->current_mapping.column); | ||||
|     tup[1] = janet_wrap_integer(c->current_mapping.start); | ||||
|     tup[2] = janet_wrap_integer(c->current_mapping.end); | ||||
|     return janet_tuple_end(tup); | ||||
| } | ||||
|  | ||||
| @@ -251,9 +239,6 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv) | ||||
|             case JANET_STRING: | ||||
|                 janet_table_put(tab, janet_ckeywordv("doc"), attr); | ||||
|                 break; | ||||
|             case JANET_STRUCT: | ||||
|                 janet_table_merge_struct(tab, janet_unwrap_struct(attr)); | ||||
|                 break; | ||||
|         } | ||||
|     } | ||||
|     return tab; | ||||
| @@ -293,17 +278,18 @@ static int varleaf( | ||||
|     JanetCompiler *c, | ||||
|     const uint8_t *sym, | ||||
|     JanetSlot s, | ||||
|     JanetTable *reftab) { | ||||
|     JanetTable *attr) { | ||||
|     if (c->scope->flags & JANET_SCOPE_TOP) { | ||||
|         /* Global var, generate var */ | ||||
|         JanetSlot refslot; | ||||
|         JanetTable *entry = janet_table_clone(reftab); | ||||
|         JanetTable *reftab = janet_table(1); | ||||
|         reftab->proto = attr; | ||||
|         JanetArray *ref = janet_array(1); | ||||
|         janet_array_push(ref, janet_wrap_nil()); | ||||
|         janet_table_put(entry, janet_ckeywordv("ref"), janet_wrap_array(ref)); | ||||
|         janet_table_put(entry, janet_ckeywordv("source-map"), | ||||
|         janet_table_put(reftab, janet_ckeywordv("ref"), janet_wrap_array(ref)); | ||||
|         janet_table_put(reftab, janet_ckeywordv("source-map"), | ||||
|                         janet_wrap_tuple(janetc_make_sourcemap(c))); | ||||
|         janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry)); | ||||
|         janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(reftab)); | ||||
|         refslot = janetc_cslot(janet_wrap_array(ref)); | ||||
|         janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0); | ||||
|         return 1; | ||||
| @@ -326,21 +312,24 @@ static int defleaf( | ||||
|     JanetCompiler *c, | ||||
|     const uint8_t *sym, | ||||
|     JanetSlot s, | ||||
|     JanetTable *tab) { | ||||
|     JanetTable *attr) { | ||||
|     if (c->scope->flags & JANET_SCOPE_TOP) { | ||||
|         JanetTable *entry = janet_table_clone(tab); | ||||
|         janet_table_put(entry, janet_ckeywordv("source-map"), | ||||
|         JanetTable *tab = janet_table(2); | ||||
|         janet_table_put(tab, janet_ckeywordv("source-map"), | ||||
|                         janet_wrap_tuple(janetc_make_sourcemap(c))); | ||||
|         tab->proto = attr; | ||||
|         JanetSlot valsym = janetc_cslot(janet_ckeywordv("value")); | ||||
|         JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry)); | ||||
|         JanetSlot tabslot = janetc_cslot(janet_wrap_table(tab)); | ||||
|  | ||||
|         /* Add env entry to env */ | ||||
|         janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry)); | ||||
|         janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(tab)); | ||||
|  | ||||
|         /* Put value in table when evaulated */ | ||||
|         janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0); | ||||
|         return 1; | ||||
|     } else { | ||||
|         return namelocal(c, sym, 0, s); | ||||
|     } | ||||
|     return namelocal(c, sym, 0, s); | ||||
| } | ||||
|  | ||||
| static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
| @@ -410,9 +399,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|         right = janetc_value(bodyopts, truebody); | ||||
|         if (!drop && !tail) janetc_copy(c, target, right); | ||||
|         janetc_popscope(c); | ||||
|         if (!janet_checktype(falsebody, JANET_NIL)) { | ||||
|             janetc_throwaway(bodyopts, falsebody); | ||||
|         } | ||||
|         janetc_throwaway(bodyopts, falsebody); | ||||
|         janetc_popscope(c); | ||||
|         return target; | ||||
|     } | ||||
| @@ -473,28 +460,6 @@ static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
|  | ||||
| /* Compile an upscope form. Upscope forms execute their body sequentially and | ||||
|  * evaluate to the last expression in the body, but without lexical scope. */ | ||||
| static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|     int32_t i; | ||||
|     JanetSlot ret = janetc_cslot(janet_wrap_nil()); | ||||
|     JanetCompiler *c = opts.compiler; | ||||
|     JanetFopts subopts = janetc_fopts_default(c); | ||||
|     for (i = 0; i < argn; i++) { | ||||
|         if (i != argn - 1) { | ||||
|             subopts.flags = JANET_FOPTS_DROP; | ||||
|         } else { | ||||
|             subopts = opts; | ||||
|         } | ||||
|         ret = janetc_value(subopts, argv[i]); | ||||
|         if (i != argn - 1) { | ||||
|             janetc_freeslot(c, ret); | ||||
|         } | ||||
|     } | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| /* Add a funcdef to the top most function scope */ | ||||
| static int32_t janetc_addfuncdef(JanetCompiler *c, JanetFuncDef *def) { | ||||
|     JanetScope *scope = c->scope; | ||||
| @@ -563,20 +528,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 | ||||
|  * ... | ||||
| @@ -593,9 +544,6 @@ 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_notnil_form = 0; | ||||
|     uint8_t ifjmp = JOP_JUMP_IF; | ||||
|     uint8_t ifnjmp = JOP_JUMP_IF_NOT; | ||||
|  | ||||
|     if (argn < 2) { | ||||
|         janetc_cerror(c, "expected at least 2 arguments"); | ||||
| @@ -606,26 +554,13 @@ 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 | ||||
|      * jmpnl or jmpnn instructions. This let's us implement `(each ...)` | ||||
|      * more efficiently. */ | ||||
|     Janet condform = argv[0]; | ||||
|     if (janetc_check_notnil_form(condform, &condform)) { | ||||
|         is_notnil_form = 1; | ||||
|         ifjmp = JOP_JUMP_IF_NOT_NIL; | ||||
|         ifnjmp = JOP_JUMP_IF_NIL; | ||||
|     } | ||||
|  | ||||
|     /* Compile condition */ | ||||
|     cond = janetc_value(subopts, condform); | ||||
|     cond = janetc_value(subopts, argv[0]); | ||||
|  | ||||
|     /* Check for constant condition */ | ||||
|     if (cond.flags & JANET_SLOT_CONSTANT) { | ||||
|         /* Loop never executes */ | ||||
|         int never_executes = is_notnil_form | ||||
|                              ? janet_checktype(cond.constant, JANET_NIL) | ||||
|                              : !janet_truthy(cond.constant); | ||||
|         if (never_executes) { | ||||
|         if (!janet_truthy(cond.constant)) { | ||||
|             janetc_popscope(c); | ||||
|             return janetc_cslot(janet_wrap_nil()); | ||||
|         } | ||||
| @@ -636,7 +571,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv) | ||||
|     /* Infinite loop does not need to check condition */ | ||||
|     labelc = infinite | ||||
|              ? 0 | ||||
|              : janetc_emit_si(c, ifnjmp, cond, 0, 0); | ||||
|              : janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0); | ||||
|  | ||||
|     /* Compile body */ | ||||
|     for (i = 1; i < argn; i++) { | ||||
| @@ -647,19 +582,18 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv) | ||||
|     /* Check if closure created in while scope. If so, | ||||
|      * recompile in a function scope. */ | ||||
|     if (tempscope.flags & JANET_SCOPE_CLOSURE) { | ||||
|         subopts = janetc_fopts_default(c); | ||||
|         tempscope.flags |= JANET_SCOPE_UNUSED; | ||||
|         janetc_popscope(c); | ||||
|         if (c->buffer) janet_v__cnt(c->buffer) = labelwt; | ||||
|         if (c->mapbuffer) janet_v__cnt(c->mapbuffer) = labelwt; | ||||
|         janet_v__cnt(c->buffer) = labelwt; | ||||
|         janet_v__cnt(c->mapbuffer) = labelwt; | ||||
|  | ||||
|         janetc_scope(&tempscope, c, JANET_SCOPE_FUNCTION, "while-iife"); | ||||
|  | ||||
|         /* Recompile in the function scope */ | ||||
|         cond = janetc_value(subopts, condform); | ||||
|         cond = janetc_value(subopts, argv[0]); | ||||
|         if (!(cond.flags & JANET_SLOT_CONSTANT)) { | ||||
|             /* If not an infinite loop, return nil when condition false */ | ||||
|             janetc_emit_si(c, ifjmp, cond, 2, 0); | ||||
|             janetc_emit_si(c, JOP_JUMP_IF, cond, 2, 0); | ||||
|             janetc_emit(c, JOP_RETURN_NIL); | ||||
|         } | ||||
|         for (i = 1; i < argn; i++) { | ||||
| @@ -670,17 +604,15 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv) | ||||
|         int32_t tempself = janetc_regalloc_temp(&tempscope.ra, JANETC_REGTEMP_0); | ||||
|         janetc_emit(c, JOP_LOAD_SELF | (tempself << 8)); | ||||
|         janetc_emit(c, JOP_TAILCALL | (tempself << 8)); | ||||
|         janetc_regalloc_freetemp(&c->scope->ra, tempself, JANETC_REGTEMP_0); | ||||
|         /* Compile function */ | ||||
|         JanetFuncDef *def = janetc_pop_funcdef(c); | ||||
|         def->name = janet_cstring("_while"); | ||||
|         janet_def_addflags(def); | ||||
|         int32_t defindex = janetc_addfuncdef(c, def); | ||||
|         /* And then load the closure and call it. */ | ||||
|         int32_t cloreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_0); | ||||
|         janetc_emit(c, JOP_CLOSURE | (cloreg << 8) | (defindex << 16)); | ||||
|         janetc_emit(c, JOP_CALL | (cloreg << 8) | (cloreg << 16)); | ||||
|         janetc_regalloc_freetemp(&c->scope->ra, cloreg, JANETC_REGTEMP_0); | ||||
|         janetc_regalloc_free(&c->scope->ra, cloreg); | ||||
|         c->scope->flags |= JANET_SCOPE_CLOSURE; | ||||
|         return janetc_cslot(janet_wrap_nil()); | ||||
|     } | ||||
| @@ -730,8 +662,8 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|     c->scope->flags |= JANET_SCOPE_CLOSURE; | ||||
|     janetc_scope(&fnscope, c, JANET_SCOPE_FUNCTION, "function"); | ||||
|  | ||||
|     if (argn == 0) { | ||||
|         errmsg = "expected at least 1 argument to function literal"; | ||||
|     if (argn < 2) { | ||||
|         errmsg = "expected at least 2 arguments to function literal"; | ||||
|         goto error; | ||||
|     } | ||||
|  | ||||
| @@ -747,9 +679,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|         goto error; | ||||
|     } | ||||
|  | ||||
|     /* Keep track of destructured parameters */ | ||||
|     JanetSlot *destructed_params = NULL; | ||||
|  | ||||
|     /* Compile function parameters */ | ||||
|     params = janet_unwrap_tuple(argv[parami]); | ||||
|     paramcount = janet_tuple_length(params); | ||||
| @@ -801,22 +730,10 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|                 janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c)); | ||||
|             } | ||||
|         } else { | ||||
|             janet_v_push(destructed_params, janetc_farslot(c)); | ||||
|             destructure(c, param, janetc_farslot(c), defleaf, NULL); | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     /* Compile destructed params */ | ||||
|     int32_t j = 0; | ||||
|     for (i = 0; i < paramcount; i++) { | ||||
|         Janet param = params[i]; | ||||
|         if (!janet_checktype(param, JANET_SYMBOL)) { | ||||
|             JanetSlot reg = destructed_params[j++]; | ||||
|             destructure(c, param, reg, defleaf, NULL); | ||||
|             janetc_freeslot(c, reg); | ||||
|         } | ||||
|     } | ||||
|     janet_v_free(destructed_params); | ||||
|  | ||||
|     max_arity = (vararg || allow_extra) ? INT32_MAX : arity; | ||||
|     if (!seenopt) min_arity = arity; | ||||
|  | ||||
| @@ -849,7 +766,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|     if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG; | ||||
|  | ||||
|     if (selfref) def->name = janet_unwrap_symbol(head); | ||||
|     janet_def_addflags(def); | ||||
|     defindex = janetc_addfuncdef(c, def); | ||||
|  | ||||
|     /* Ensure enough slots for vararg function. */ | ||||
| @@ -879,7 +795,6 @@ static const JanetSpecial janetc_specials[] = { | ||||
|     {"set", janetc_varset}, | ||||
|     {"splice", janetc_splice}, | ||||
|     {"unquote", janetc_unquote}, | ||||
|     {"upscope", janetc_upscope}, | ||||
|     {"var", janetc_var}, | ||||
|     {"while", janetc_while} | ||||
| }; | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -32,21 +32,12 @@ | ||||
|  * be in it. However, thread local global variables for interpreter | ||||
|  * state should allow easy multi-threading. */ | ||||
|  | ||||
| typedef struct JanetScratch JanetScratch; | ||||
|  | ||||
| /* Top level dynamic bindings */ | ||||
| extern JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns; | ||||
|  | ||||
| /* Cache the core environment */ | ||||
| extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env; | ||||
|  | ||||
| /* How many VM stacks have been entered */ | ||||
| extern JANET_THREAD_LOCAL int janet_vm_stackn; | ||||
|  | ||||
| /* The current running fiber on the current thread. | ||||
|  * Set and unset by janet_run. */ | ||||
| extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber; | ||||
| extern JANET_THREAD_LOCAL JanetFiber *janet_vm_root_fiber; | ||||
|  | ||||
| /* The current pointer to the inner most jmp_buf. The current | ||||
|  * return point for panics. */ | ||||
| @@ -57,10 +48,6 @@ extern JANET_THREAD_LOCAL Janet *janet_vm_return_reg; | ||||
|  * along with otherwise bare c function pointers. */ | ||||
| extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry; | ||||
|  | ||||
| /* Registry for abstract abstract types that can be marshalled. | ||||
|  * We need this to look up the constructors when unmarshalling. */ | ||||
| extern JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry; | ||||
|  | ||||
| /* Immutable value cache */ | ||||
| extern JANET_THREAD_LOCAL const uint8_t **janet_vm_cache; | ||||
| extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity; | ||||
| @@ -69,46 +56,13 @@ extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted; | ||||
|  | ||||
| /* Garbage collection */ | ||||
| extern JANET_THREAD_LOCAL void *janet_vm_blocks; | ||||
| extern JANET_THREAD_LOCAL size_t janet_vm_gc_interval; | ||||
| extern JANET_THREAD_LOCAL size_t janet_vm_next_collection; | ||||
| extern JANET_THREAD_LOCAL size_t janet_vm_block_count; | ||||
| extern JANET_THREAD_LOCAL uint32_t janet_vm_gc_interval; | ||||
| extern JANET_THREAD_LOCAL uint32_t janet_vm_next_collection; | ||||
| extern JANET_THREAD_LOCAL int janet_vm_gc_suspend; | ||||
|  | ||||
| /* GC roots */ | ||||
| extern JANET_THREAD_LOCAL Janet *janet_vm_roots; | ||||
| extern JANET_THREAD_LOCAL size_t janet_vm_root_count; | ||||
| extern JANET_THREAD_LOCAL size_t janet_vm_root_capacity; | ||||
|  | ||||
| /* Scratch memory */ | ||||
| extern JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem; | ||||
| extern JANET_THREAD_LOCAL size_t janet_scratch_cap; | ||||
| extern JANET_THREAD_LOCAL size_t janet_scratch_len; | ||||
|  | ||||
| /* Recursionless traversal of data structures */ | ||||
| typedef struct { | ||||
|     JanetGCObject *self; | ||||
|     JanetGCObject *other; | ||||
|     int32_t index; | ||||
|     int32_t index2; | ||||
| } JanetTraversalNode; | ||||
| extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal; | ||||
| extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top; | ||||
| extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base; | ||||
|  | ||||
| /* Setup / teardown */ | ||||
| #ifdef JANET_THREADS | ||||
| void janet_threads_init(void); | ||||
| void janet_threads_deinit(void); | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_NET | ||||
| void janet_net_init(void); | ||||
| void janet_net_deinit(void); | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_EV | ||||
| void janet_ev_init(void); | ||||
| void janet_ev_deinit(void); | ||||
| #endif | ||||
| extern JANET_THREAD_LOCAL uint32_t janet_vm_root_count; | ||||
| extern JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity; | ||||
|  | ||||
| #endif /* JANET_STATE_H_defined */ | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -20,19 +20,18 @@ | ||||
| * IN THE SOFTWARE. | ||||
| */ | ||||
|  | ||||
| #include <string.h> | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "gc.h" | ||||
| #include "util.h" | ||||
| #include "state.h" | ||||
| #endif | ||||
|  | ||||
| #include <string.h> | ||||
|  | ||||
| /* Begin building a string */ | ||||
| uint8_t *janet_string_begin(int32_t length) { | ||||
|     JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + (size_t) length + 1); | ||||
|     JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + length + 1); | ||||
|     head->length = length; | ||||
|     uint8_t *data = (uint8_t *)head->data; | ||||
|     data[length] = 0; | ||||
| @@ -47,11 +46,11 @@ const uint8_t *janet_string_end(uint8_t *str) { | ||||
|  | ||||
| /* Load a buffer as a string */ | ||||
| const uint8_t *janet_string(const uint8_t *buf, int32_t len) { | ||||
|     JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + (size_t) len + 1); | ||||
|     JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + len + 1); | ||||
|     head->length = len; | ||||
|     head->hash = janet_string_calchash(buf, len); | ||||
|     uint8_t *data = (uint8_t *)head->data; | ||||
|     safe_memcpy(data, buf, len); | ||||
|     memcpy(data, buf, len); | ||||
|     data[len] = 0; | ||||
|     return data; | ||||
| } | ||||
| @@ -62,7 +61,7 @@ int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs) { | ||||
|     int32_t ylen = janet_string_length(rhs); | ||||
|     int32_t len = xlen > ylen ? ylen : xlen; | ||||
|     int res = memcmp(lhs, rhs, len); | ||||
|     if (res) return res > 0 ? 1 : -1; | ||||
|     if (res) return res; | ||||
|     if (xlen == ylen) return 0; | ||||
|     return xlen < ylen ? -1 : 1; | ||||
| } | ||||
| @@ -105,10 +104,7 @@ static void kmp_init( | ||||
|     struct kmp_state *s, | ||||
|     const uint8_t *text, int32_t textlen, | ||||
|     const uint8_t *pat, int32_t patlen) { | ||||
|     if (patlen == 0) { | ||||
|         janet_panic("expected non-empty pattern"); | ||||
|     } | ||||
|     int32_t *lookup = janet_calloc(patlen, sizeof(int32_t)); | ||||
|     int32_t *lookup = calloc(patlen, sizeof(int32_t)); | ||||
|     if (!lookup) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
| @@ -131,7 +127,7 @@ static void kmp_init( | ||||
| } | ||||
|  | ||||
| static void kmp_deinit(struct kmp_state *state) { | ||||
|     janet_free(state->lookup); | ||||
|     free(state->lookup); | ||||
| } | ||||
|  | ||||
| static void kmp_seti(struct kmp_state *state, int32_t i) { | ||||
| @@ -171,23 +167,11 @@ static int32_t kmp_next(struct kmp_state *state) { | ||||
| /* CFuns */ | ||||
|  | ||||
| static Janet cfun_string_slice(int32_t argc, Janet *argv) { | ||||
|     JanetByteView view = janet_getbytes(argv, 0); | ||||
|     JanetRange range = janet_getslice(argc, argv); | ||||
|     JanetByteView view = janet_getbytes(argv, 0); | ||||
|     return janet_stringv(view.bytes + range.start, range.end - range.start); | ||||
| } | ||||
|  | ||||
| static Janet cfun_symbol_slice(int32_t argc, Janet *argv) { | ||||
|     JanetByteView view = janet_getbytes(argv, 0); | ||||
|     JanetRange range = janet_getslice(argc, argv); | ||||
|     return janet_symbolv(view.bytes + range.start, range.end - range.start); | ||||
| } | ||||
|  | ||||
| static Janet cfun_keyword_slice(int32_t argc, Janet *argv) { | ||||
|     JanetByteView view = janet_getbytes(argv, 0); | ||||
|     JanetRange range = janet_getslice(argc, argv); | ||||
|     return janet_keywordv(view.bytes + range.start, range.end - range.start); | ||||
| } | ||||
|  | ||||
| static Janet cfun_string_repeat(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 2); | ||||
|     JanetByteView view = janet_getbytes(argv, 0); | ||||
| @@ -199,7 +183,7 @@ static Janet cfun_string_repeat(int32_t argc, Janet *argv) { | ||||
|     uint8_t *newbuf = janet_string_begin((int32_t) mulres); | ||||
|     uint8_t *end = newbuf + mulres; | ||||
|     for (uint8_t *p = newbuf; p < end; p += view.len) { | ||||
|         safe_memcpy(p, view.bytes, view.len); | ||||
|         memcpy(p, view.bytes, view.len); | ||||
|     } | ||||
|     return janet_wrap_string(janet_string_end(newbuf)); | ||||
| } | ||||
| @@ -355,11 +339,11 @@ static Janet cfun_string_replace(int32_t argc, Janet *argv) { | ||||
|         return janet_stringv(s.kmp.text, s.kmp.textlen); | ||||
|     } | ||||
|     buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + s.substlen); | ||||
|     safe_memcpy(buf, s.kmp.text, result); | ||||
|     safe_memcpy(buf + result, s.subst, s.substlen); | ||||
|     safe_memcpy(buf + result + s.substlen, | ||||
|                 s.kmp.text + result + s.kmp.patlen, | ||||
|                 s.kmp.textlen - result - s.kmp.patlen); | ||||
|     memcpy(buf, s.kmp.text, result); | ||||
|     memcpy(buf + result, s.subst, s.substlen); | ||||
|     memcpy(buf + result + s.substlen, | ||||
|            s.kmp.text + result + s.kmp.patlen, | ||||
|            s.kmp.textlen - result - s.kmp.patlen); | ||||
|     kmp_deinit(&s.kmp); | ||||
|     return janet_wrap_string(janet_string_end(buf)); | ||||
| } | ||||
| @@ -394,33 +378,40 @@ static Janet cfun_string_split(int32_t argc, Janet *argv) { | ||||
|     } | ||||
|     findsetup(argc, argv, &state, 1); | ||||
|     array = janet_array(0); | ||||
|     while ((result = kmp_next(&state)) >= 0 && --limit) { | ||||
|     while ((result = kmp_next(&state)) >= 0 && limit--) { | ||||
|         const uint8_t *slice = janet_string(state.text + lastindex, result - lastindex); | ||||
|         janet_array_push(array, janet_wrap_string(slice)); | ||||
|         lastindex = result + state.patlen; | ||||
|         kmp_seti(&state, lastindex); | ||||
|     } | ||||
|     const uint8_t *slice = janet_string(state.text + lastindex, state.textlen - lastindex); | ||||
|     janet_array_push(array, janet_wrap_string(slice)); | ||||
|     { | ||||
|         const uint8_t *slice = janet_string(state.text + lastindex, state.textlen - lastindex); | ||||
|         janet_array_push(array, janet_wrap_string(slice)); | ||||
|     } | ||||
|     kmp_deinit(&state); | ||||
|     return janet_wrap_array(array); | ||||
| } | ||||
|  | ||||
| static Janet cfun_string_checkset(int32_t argc, Janet *argv) { | ||||
|     uint32_t bitset[8] = {0, 0, 0, 0, 0, 0, 0, 0}; | ||||
|     janet_fixarity(argc, 2); | ||||
|     janet_arity(argc, 2, 3); | ||||
|     JanetByteView set = janet_getbytes(argv, 0); | ||||
|     JanetByteView str = janet_getbytes(argv, 1); | ||||
|     /* Populate set */ | ||||
|     for (int32_t i = 0; i < set.len; i++) { | ||||
|         int index = set.bytes[i] >> 5; | ||||
|         uint32_t mask = 1 << (set.bytes[i] & 0x1F); | ||||
|         uint32_t mask = 1 << (set.bytes[i] & 7); | ||||
|         bitset[index] |= mask; | ||||
|     } | ||||
|     if (argc == 3) { | ||||
|         if (janet_getboolean(argv, 2)) { | ||||
|             for (int i = 0; i < 8; i++) | ||||
|                 bitset[i] = ~bitset[i]; | ||||
|         } | ||||
|     } | ||||
|     /* Check set */ | ||||
|     for (int32_t i = 0; i < str.len; i++) { | ||||
|         int index = str.bytes[i] >> 5; | ||||
|         uint32_t mask = 1 << (str.bytes[i] & 0x1F); | ||||
|         uint32_t mask = 1 << (str.bytes[i] & 7); | ||||
|         if (!(bitset[index] & mask)) { | ||||
|             return janet_wrap_false(); | ||||
|         } | ||||
| @@ -458,11 +449,11 @@ static Janet cfun_string_join(int32_t argc, Janet *argv) { | ||||
|         const uint8_t *chunk = NULL; | ||||
|         int32_t chunklen = 0; | ||||
|         if (i) { | ||||
|             safe_memcpy(out, joiner.bytes, joiner.len); | ||||
|             memcpy(out, joiner.bytes, joiner.len); | ||||
|             out += joiner.len; | ||||
|         } | ||||
|         janet_bytes_view(parts.items[i], &chunk, &chunklen); | ||||
|         safe_memcpy(out, chunk, chunklen); | ||||
|         memcpy(out, chunk, chunklen); | ||||
|         out += chunklen; | ||||
|     } | ||||
|     return janet_wrap_string(janet_string_end(buf)); | ||||
| @@ -513,8 +504,6 @@ static Janet cfun_string_trim(int32_t argc, Janet *argv) { | ||||
|     trim_help_args(argc, argv, &str, &set); | ||||
|     int32_t left_edge = trim_help_leftedge(str, set); | ||||
|     int32_t right_edge = trim_help_rightedge(str, set); | ||||
|     if (right_edge < left_edge) | ||||
|         return janet_stringv(NULL, 0); | ||||
|     return janet_stringv(str.bytes + left_edge, right_edge - left_edge); | ||||
| } | ||||
|  | ||||
| @@ -535,22 +524,11 @@ static Janet cfun_string_trimr(int32_t argc, Janet *argv) { | ||||
| static const JanetReg string_cfuns[] = { | ||||
|     { | ||||
|         "string/slice", cfun_string_slice, | ||||
|         JDOC("(string/slice bytes &opt start end)\n\n" | ||||
|         JDOC("(string/slice bytes [,start=0 [,end=(length str)]])\n\n" | ||||
|              "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. ") | ||||
|     }, | ||||
|     { | ||||
|         "keyword/slice", cfun_keyword_slice, | ||||
|         JDOC("(keyword/slice bytes &opt start end)\n\n" | ||||
|              "Same a string/slice, but returns a keyword.") | ||||
|     }, | ||||
|     { | ||||
|         "symbol/slice", cfun_symbol_slice, | ||||
|         JDOC("(symbol/slice bytes &opt start end)\n\n" | ||||
|              "Same a string/slice, but returns a symbol.") | ||||
|              "from the end of the string.") | ||||
|     }, | ||||
|     { | ||||
|         "string/repeat", cfun_string_repeat, | ||||
| @@ -564,8 +542,8 @@ static const JanetReg string_cfuns[] = { | ||||
|     }, | ||||
|     { | ||||
|         "string/from-bytes", cfun_string_frombytes, | ||||
|         JDOC("(string/from-bytes & byte-vals)\n\n" | ||||
|              "Creates a string from integer parameters with byte values. All integers " | ||||
|         JDOC("(string/from-bytes &byte-vals)\n\n" | ||||
|              "Creates a string from integer params with byte values. All integers " | ||||
|              "will be coerced to the range of 1 byte 0-255.") | ||||
|     }, | ||||
|     { | ||||
| @@ -589,18 +567,19 @@ static const JanetReg string_cfuns[] = { | ||||
|     }, | ||||
|     { | ||||
|         "string/find", cfun_string_find, | ||||
|         JDOC("(string/find patt str &opt start-index)\n\n" | ||||
|         JDOC("(string/find patt str)\n\n" | ||||
|              "Searches for the first instance of pattern patt in string " | ||||
|              "str. Returns the index of the first character in patt if found, " | ||||
|              "otherwise returns nil.") | ||||
|     }, | ||||
|     { | ||||
|         "string/find-all", cfun_string_findall, | ||||
|         JDOC("(string/find-all patt str &opt start-index)\n\n" | ||||
|         JDOC("(string/find patt str)\n\n" | ||||
|              "Searches for all instances of pattern patt in string " | ||||
|              "str. Returns an array of all indices of found patterns. Overlapping " | ||||
|              "instances of the pattern are counted individually, meaning a byte in str " | ||||
|              "may contribute to multiple found patterns.") | ||||
|              "instances of the pattern are not counted, meaning a byte in string " | ||||
|              "will only contribute to finding at most on occurrence of pattern. If no " | ||||
|              "occurrences are found, will return an empty array.") | ||||
|     }, | ||||
|     { | ||||
|         "string/has-prefix?", cfun_string_hasprefix, | ||||
| @@ -621,53 +600,49 @@ static const JanetReg string_cfuns[] = { | ||||
|     { | ||||
|         "string/replace-all", cfun_string_replaceall, | ||||
|         JDOC("(string/replace-all patt subst str)\n\n" | ||||
|              "Replace all instances of patt with subst in the string str. Overlapping " | ||||
|              "matches will not be counted, only the first match in such a span will be replaced. " | ||||
|              "Replace all instances of patt with subst in the string str. " | ||||
|              "Will return the new string if patt is found, otherwise returns str.") | ||||
|     }, | ||||
|     { | ||||
|         "string/split", cfun_string_split, | ||||
|         JDOC("(string/split delim str &opt start limit)\n\n" | ||||
|         JDOC("(string/split delim str)\n\n" | ||||
|              "Splits a string str with delimiter delim and returns an array of " | ||||
|              "substrings. The substrings will not contain the delimiter delim. If delim " | ||||
|              "is not found, the returned array will have one element. Will start searching " | ||||
|              "for delim at the index start (if provided), and return up to a maximum " | ||||
|              "of limit results (if provided).") | ||||
|              "is not found, the returned array will have one element.") | ||||
|     }, | ||||
|     { | ||||
|         "string/check-set", cfun_string_checkset, | ||||
|         JDOC("(string/check-set set str)\n\n" | ||||
|              "Checks that the string str only contains bytes that appear in the string set. " | ||||
|              "Returns true if all bytes in str appear in set, false if some bytes in str do " | ||||
|              "not appear in set.") | ||||
|              "Checks if any of the bytes in the string set appear in the string str. " | ||||
|              "Returns true if some bytes in set do appear in str, false if no bytes do.") | ||||
|     }, | ||||
|     { | ||||
|         "string/join", cfun_string_join, | ||||
|         JDOC("(string/join parts &opt sep)\n\n" | ||||
|         JDOC("(string/join parts [,sep])\n\n" | ||||
|              "Joins an array of strings into one string, optionally separated by " | ||||
|              "a separator string sep.") | ||||
|     }, | ||||
|     { | ||||
|         "string/format", cfun_string_format, | ||||
|         JDOC("(string/format format & values)\n\n" | ||||
|              "Similar to snprintf, but specialized for operating with Janet values. Returns " | ||||
|              "Similar to snprintf, but specialized for operating with janet. Returns " | ||||
|              "a new string.") | ||||
|     }, | ||||
|     { | ||||
|         "string/trim", cfun_string_trim, | ||||
|         JDOC("(string/trim str &opt set)\n\n" | ||||
|         JDOC("(string/trim str [,set])\n\n" | ||||
|              "Trim leading and trailing whitespace from a byte sequence. If the argument " | ||||
|              "set is provided, consider only characters in set to be whitespace.") | ||||
|     }, | ||||
|     { | ||||
|         "string/triml", cfun_string_triml, | ||||
|         JDOC("(string/triml str &opt set)\n\n" | ||||
|         JDOC("(string/triml str [,set])\n\n" | ||||
|              "Trim leading whitespace from a byte sequence. If the argument " | ||||
|              "set is provided, consider only characters in set to be whitespace.") | ||||
|     }, | ||||
|     { | ||||
|         "string/trimr", cfun_string_trimr, | ||||
|         JDOC("(string/trimr str &opt set)\n\n" | ||||
|         JDOC("(string/trimr str [,set])\n\n" | ||||
|              "Trim trailing whitespace from a byte sequence. If the argument " | ||||
|              "set is provided, consider only characters in set to be whitespace.") | ||||
|     }, | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -40,15 +40,14 @@ | ||||
|  * '0xdeadbeef'. | ||||
|  */ | ||||
|  | ||||
| #include <math.h> | ||||
| #include <string.h> | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "util.h" | ||||
| #endif | ||||
|  | ||||
| #include <math.h> | ||||
| #include <string.h> | ||||
|  | ||||
| /* Lookup table for getting values of characters when parsing numbers. Handles | ||||
|  * digits 0-9 and a-z (and A-Z). A-Z have values of 10 to 35. */ | ||||
| static uint8_t digit_lookup[128] = { | ||||
| @@ -87,7 +86,7 @@ static uint32_t *bignat_extra(struct BigNat *mant, int32_t n) { | ||||
|     int32_t newn = oldn + n; | ||||
|     if (mant->cap < newn) { | ||||
|         int32_t newcap = 2 * newn; | ||||
|         uint32_t *mem = janet_realloc(mant->digits, (size_t) newcap * sizeof(uint32_t)); | ||||
|         uint32_t *mem = realloc(mant->digits, newcap * sizeof(uint32_t)); | ||||
|         if (NULL == mem) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
| @@ -197,7 +196,7 @@ static double bignat_extract(struct BigNat *mant, int32_t exponent2) { | ||||
|  | ||||
| /* Read in a mantissa and exponent of a certain base, and give | ||||
|  * back the double value. Should properly handle 0s, infinities, and | ||||
|  * denormalized numbers. (When the exponent values are too large or small) */ | ||||
|  * denormalized numbers. (When the exponent values are too large) */ | ||||
| static double convert( | ||||
|     int negative, | ||||
|     struct BigNat *mant, | ||||
| @@ -206,20 +205,11 @@ static double convert( | ||||
|  | ||||
|     int32_t exponent2 = 0; | ||||
|  | ||||
|     /* Approximate exponent in base 2 of mant and exponent. This should get us a good estimate of the final size of the | ||||
|      * number, within * 2^32 or so. */ | ||||
|     int64_t mant_exp2_approx = mant->n * 32 + 16; | ||||
|     int64_t exp_exp2_approx = (int64_t)(floor(log2(base) * exponent)); | ||||
|     int64_t exp2_approx = mant_exp2_approx + exp_exp2_approx; | ||||
|  | ||||
|     /* Short circuit zero, huge, and small numbers. We use the exponent range of valid IEEE754 doubles (-1022, 1023) | ||||
|      * with a healthy buffer to allow for inaccuracies in the approximation and denormailzed numbers. */ | ||||
|     /* Short circuit zero and huge numbers */ | ||||
|     if (mant->n == 0 && mant->first_digit == 0) | ||||
|         return negative ? -0.0 : 0.0; | ||||
|     if (exp2_approx > 1176) | ||||
|     if (exponent > 1023) | ||||
|         return negative ? -INFINITY : INFINITY; | ||||
|     if (exp2_approx < -1175) | ||||
|         return negative ? -0.0 : 0.0; | ||||
|  | ||||
|     /* Final value is X = mant * base ^ exponent * 2 ^ exponent2 | ||||
|      * Get exponent to zero while holding X constant. */ | ||||
| @@ -336,7 +326,7 @@ int janet_scan_number( | ||||
|     /* Read exponent */ | ||||
|     if (str < end && foundexp) { | ||||
|         int eneg = 0; | ||||
|         int32_t ee = 0; | ||||
|         int ee = 0; | ||||
|         seenadigit = 0; | ||||
|         str++; | ||||
|         if (str >= end) goto error; | ||||
| @@ -351,12 +341,10 @@ int janet_scan_number( | ||||
|             str++; | ||||
|             seenadigit = 1; | ||||
|         } | ||||
|         while (str < end) { | ||||
|         while (str < end && ee < (INT32_MAX / 40)) { | ||||
|             int digit = digit_lookup[*str & 0x7F]; | ||||
|             if (*str > 127 || digit >= base) goto error; | ||||
|             if (ee < (INT32_MAX / 40)) { | ||||
|                 ee = base * ee + digit; | ||||
|             } | ||||
|             ee = base * ee + digit; | ||||
|             str++; | ||||
|             seenadigit = 1; | ||||
|         } | ||||
| @@ -368,11 +356,11 @@ int janet_scan_number( | ||||
|         goto error; | ||||
|  | ||||
|     *out = convert(neg, &mant, base, ex); | ||||
|     janet_free(mant.digits); | ||||
|     free(mant.digits); | ||||
|     return 0; | ||||
|  | ||||
| error: | ||||
|     janet_free(mant.digits); | ||||
|     free(mant.digits); | ||||
|     return 1; | ||||
| } | ||||
|  | ||||
| @@ -447,16 +435,12 @@ int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out) { | ||||
|     int neg; | ||||
|     uint64_t bi; | ||||
|     if (scan_uint64(str, len, &bi, &neg)) { | ||||
|         if (neg && bi <= ((UINT64_MAX / 2) + 1)) { | ||||
|             if (bi > INT64_MAX) { | ||||
|                 *out = INT64_MIN; | ||||
|             } else { | ||||
|                 *out = -((int64_t) bi); | ||||
|             } | ||||
|         if (neg && bi <= 0x8000000000000000ULL) { | ||||
|             *out = -((int64_t) bi); | ||||
|             return 1; | ||||
|         } | ||||
|         if (!neg && bi <= INT64_MAX) { | ||||
|             *out = (int64_t) bi; | ||||
|         if (!neg && bi <= 0x7FFFFFFFFFFFFFFFULL) { | ||||
|             *out = bi; | ||||
|             return 1; | ||||
|         } | ||||
|     } | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,7 +21,6 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "gc.h" | ||||
| #include "util.h" | ||||
| @@ -34,7 +33,7 @@ JanetKV *janet_struct_begin(int32_t count) { | ||||
|     int32_t capacity = janet_tablen(2 * count); | ||||
|     if (capacity < 0) capacity = janet_tablen(count + 1); | ||||
|  | ||||
|     size_t size = sizeof(JanetStructHead) + (size_t) capacity * sizeof(JanetKV); | ||||
|     size_t size = sizeof(JanetStructHead) + capacity * sizeof(JanetKV); | ||||
|     JanetStructHead *head = janet_gcalloc(JANET_MEMORY_STRUCT, size); | ||||
|     head->length = count; | ||||
|     head->capacity = capacity; | ||||
| @@ -123,8 +122,7 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) { | ||||
|                 dist = otherdist; | ||||
|                 hash = otherhash; | ||||
|             } else if (status == 0) { | ||||
|                 /* A key was added to the struct more than once - replace old value */ | ||||
|                 kv->value = value; | ||||
|                 /* A key was added to the struct more than once */ | ||||
|                 return; | ||||
|             } | ||||
|         } | ||||
| @@ -167,3 +165,51 @@ JanetTable *janet_struct_to_table(const JanetKV *st) { | ||||
|     } | ||||
|     return table; | ||||
| } | ||||
|  | ||||
| /* Check if two structs are equal */ | ||||
| int janet_struct_equal(const JanetKV *lhs, const JanetKV *rhs) { | ||||
|     int32_t index; | ||||
|     int32_t llen = janet_struct_capacity(lhs); | ||||
|     int32_t rlen = janet_struct_capacity(rhs); | ||||
|     int32_t lhash = janet_struct_hash(lhs); | ||||
|     int32_t rhash = janet_struct_hash(rhs); | ||||
|     if (llen != rlen) | ||||
|         return 0; | ||||
|     if (lhash != rhash) | ||||
|         return 0; | ||||
|     for (index = 0; index < llen; index++) { | ||||
|         const JanetKV *l = lhs + index; | ||||
|         const JanetKV *r = rhs + index; | ||||
|         if (!janet_equals(l->key, r->key)) | ||||
|             return 0; | ||||
|         if (!janet_equals(l->value, r->value)) | ||||
|             return 0; | ||||
|     } | ||||
|     return 1; | ||||
| } | ||||
|  | ||||
| /* Compare structs */ | ||||
| int janet_struct_compare(const JanetKV *lhs, const JanetKV *rhs) { | ||||
|     int32_t i; | ||||
|     int32_t lhash = janet_struct_hash(lhs); | ||||
|     int32_t rhash = janet_struct_hash(rhs); | ||||
|     int32_t llen = janet_struct_capacity(lhs); | ||||
|     int32_t rlen = janet_struct_capacity(rhs); | ||||
|     if (llen < rlen) | ||||
|         return -1; | ||||
|     if (llen > rlen) | ||||
|         return 1; | ||||
|     if (lhash < rhash) | ||||
|         return -1; | ||||
|     if (lhash > rhash) | ||||
|         return 1; | ||||
|     for (i = 0; i < llen; ++i) { | ||||
|         const JanetKV *l = lhs + i; | ||||
|         const JanetKV *r = rhs + i; | ||||
|         int comp = janet_compare(l->key, r->key); | ||||
|         if (comp != 0) return comp; | ||||
|         comp = janet_compare(l->value, r->value); | ||||
|         if (comp != 0) return comp; | ||||
|     } | ||||
|     return 0; | ||||
| } | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| @@ -25,8 +25,9 @@ | ||||
|  * checks, all symbols are interned so that there is a single copy of it in the | ||||
|  * whole program. Equality is then just a pointer check. */ | ||||
|  | ||||
| #include <string.h> | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "state.h" | ||||
| #include "gc.h" | ||||
| @@ -34,8 +35,6 @@ | ||||
| #include "symcache.h" | ||||
| #endif | ||||
|  | ||||
| #include <string.h> | ||||
|  | ||||
| /* Cache state */ | ||||
| JANET_THREAD_LOCAL const uint8_t **janet_vm_cache = NULL; | ||||
| JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity = 0; | ||||
| @@ -45,7 +44,7 @@ JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted = 0; | ||||
| /* Initialize the cache (allocate cache memory) */ | ||||
| void janet_symcache_init() { | ||||
|     janet_vm_cache_capacity = 1024; | ||||
|     janet_vm_cache = janet_calloc(1, (size_t) janet_vm_cache_capacity * sizeof(const uint8_t *)); | ||||
|     janet_vm_cache = calloc(1, janet_vm_cache_capacity * sizeof(const uint8_t *)); | ||||
|     if (NULL == janet_vm_cache) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
| @@ -55,7 +54,7 @@ void janet_symcache_init() { | ||||
|  | ||||
| /* Deinitialize the cache (free the cache memory) */ | ||||
| void janet_symcache_deinit() { | ||||
|     janet_free((void *)janet_vm_cache); | ||||
|     free((void *)janet_vm_cache); | ||||
|     janet_vm_cache = NULL; | ||||
|     janet_vm_cache_capacity = 0; | ||||
|     janet_vm_cache_count = 0; | ||||
| @@ -122,7 +121,7 @@ notfound: | ||||
| static void janet_cache_resize(uint32_t newCapacity) { | ||||
|     uint32_t i, oldCapacity; | ||||
|     const uint8_t **oldCache = janet_vm_cache; | ||||
|     const uint8_t **newCache = janet_calloc(1, (size_t) newCapacity * sizeof(const uint8_t *)); | ||||
|     const uint8_t **newCache = calloc(1, newCapacity * sizeof(const uint8_t *)); | ||||
|     if (newCache == NULL) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
| @@ -145,7 +144,7 @@ static void janet_cache_resize(uint32_t newCapacity) { | ||||
|         } | ||||
|     } | ||||
|     /* Free the old cache */ | ||||
|     janet_free((void *)oldCache); | ||||
|     free((void *)oldCache); | ||||
| } | ||||
|  | ||||
| /* Add an item to the cache */ | ||||
| @@ -179,11 +178,11 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) { | ||||
|     const uint8_t **bucket = janet_symcache_findmem(str, len, hash, &success); | ||||
|     if (success) | ||||
|         return *bucket; | ||||
|     JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + (size_t) len + 1); | ||||
|     JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + len + 1); | ||||
|     head->hash = hash; | ||||
|     head->length = len; | ||||
|     newstr = (uint8_t *)(head->data); | ||||
|     safe_memcpy(newstr, str, len); | ||||
|     memcpy(newstr, str, len); | ||||
|     newstr[len] = 0; | ||||
|     janet_symcache_put((const uint8_t *)newstr, bucket); | ||||
|     return newstr; | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -24,7 +24,6 @@ | ||||
| #define JANET_SYMCACHE_H_defined | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #endif | ||||
|  | ||||
|   | ||||
							
								
								
									
										110
									
								
								src/core/table.c
									
									
									
									
									
								
							
							
						
						
									
										110
									
								
								src/core/table.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,39 +21,20 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "gc.h" | ||||
| #include "util.h" | ||||
| #include <math.h> | ||||
| #endif | ||||
|  | ||||
| #define JANET_TABLE_FLAG_STACK 0x10000 | ||||
|  | ||||
| static void *janet_memalloc_empty_local(int32_t count) { | ||||
|     int32_t i; | ||||
|     void *mem = janet_smalloc((size_t) count * sizeof(JanetKV)); | ||||
|     JanetKV *mmem = (JanetKV *)mem; | ||||
|     for (i = 0; i < count; i++) { | ||||
|         JanetKV *kv = mmem + i; | ||||
|         kv->key = janet_wrap_nil(); | ||||
|         kv->value = janet_wrap_nil(); | ||||
|     } | ||||
|     return mem; | ||||
| } | ||||
|  | ||||
| static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, int stackalloc) { | ||||
| /* Initialize a table */ | ||||
| JanetTable *janet_table_init(JanetTable *table, int32_t capacity) { | ||||
|     JanetKV *data; | ||||
|     capacity = janet_tablen(capacity); | ||||
|     if (stackalloc) table->gc.flags = JANET_TABLE_FLAG_STACK; | ||||
|     if (capacity) { | ||||
|         if (stackalloc) { | ||||
|             data = janet_memalloc_empty_local(capacity); | ||||
|         } else { | ||||
|             data = (JanetKV *) janet_memalloc_empty(capacity); | ||||
|             if (NULL == data) { | ||||
|                 JANET_OUT_OF_MEMORY; | ||||
|             } | ||||
|         data = (JanetKV *) janet_memalloc_empty(capacity); | ||||
|         if (NULL == data) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|         table->data = data; | ||||
|         table->capacity = capacity; | ||||
| @@ -67,20 +48,15 @@ static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, in | ||||
|     return table; | ||||
| } | ||||
|  | ||||
| /* Initialize a table */ | ||||
| JanetTable *janet_table_init(JanetTable *table, int32_t capacity) { | ||||
|     return janet_table_init_impl(table, capacity, 1); | ||||
| } | ||||
|  | ||||
| /* Deinitialize a table */ | ||||
| void janet_table_deinit(JanetTable *table) { | ||||
|     janet_sfree(table->data); | ||||
|     free(table->data); | ||||
| } | ||||
|  | ||||
| /* 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); | ||||
|     return janet_table_init(table, capacity); | ||||
| } | ||||
|  | ||||
| /* Find the bucket that contains the given key. Will also return | ||||
| @@ -92,15 +68,9 @@ JanetKV *janet_table_find(JanetTable *t, Janet key) { | ||||
| /* Resize the dictionary table. */ | ||||
| static void janet_table_rehash(JanetTable *t, int32_t size) { | ||||
|     JanetKV *olddata = t->data; | ||||
|     JanetKV *newdata; | ||||
|     int islocal = t->gc.flags & JANET_TABLE_FLAG_STACK; | ||||
|     if (islocal) { | ||||
|         newdata = (JanetKV *) janet_memalloc_empty_local(size); | ||||
|     } else { | ||||
|         newdata = (JanetKV *) janet_memalloc_empty(size); | ||||
|         if (NULL == newdata) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|     JanetKV *newdata = (JanetKV *) janet_memalloc_empty(size); | ||||
|     if (NULL == newdata) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
|     int32_t i, oldcapacity; | ||||
|     oldcapacity = t->capacity; | ||||
| @@ -114,11 +84,7 @@ static void janet_table_rehash(JanetTable *t, int32_t size) { | ||||
|             *newkv = *kv; | ||||
|         } | ||||
|     } | ||||
|     if (islocal) { | ||||
|         janet_sfree(olddata); | ||||
|     } else { | ||||
|         janet_free(olddata); | ||||
|     } | ||||
|     free(olddata); | ||||
| } | ||||
|  | ||||
| /* Get a value out of the table */ | ||||
| @@ -138,27 +104,6 @@ Janet janet_table_get(JanetTable *t, Janet key) { | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| /* Get a value out of the table, and record which prototype it was from. */ | ||||
| Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which) { | ||||
|     JanetKV *bucket = janet_table_find(t, key); | ||||
|     if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) { | ||||
|         *which = t; | ||||
|         return bucket->value; | ||||
|     } | ||||
|     /* Check prototypes */ | ||||
|     { | ||||
|         int i; | ||||
|         for (i = JANET_MAX_PROTO_DEPTH, t = t->proto; t && i; t = t->proto, --i) { | ||||
|             bucket = janet_table_find(t, key); | ||||
|             if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) { | ||||
|                 *which = t; | ||||
|                 return bucket->value; | ||||
|             } | ||||
|         } | ||||
|     } | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| /* Get a value out of the table. Don't check prototype tables. */ | ||||
| Janet janet_table_rawget(JanetTable *t, Janet key) { | ||||
|     JanetKV *bucket = janet_table_find(t, key); | ||||
| @@ -173,7 +118,7 @@ Janet janet_table_rawget(JanetTable *t, Janet key) { | ||||
| Janet janet_table_remove(JanetTable *t, Janet key) { | ||||
|     JanetKV *bucket = janet_table_find(t, key); | ||||
|     if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) { | ||||
|         Janet ret = bucket->value; | ||||
|         Janet ret = bucket->key; | ||||
|         t->count--; | ||||
|         t->deleted++; | ||||
|         bucket->key = janet_wrap_nil(); | ||||
| @@ -230,21 +175,6 @@ const JanetKV *janet_table_to_struct(JanetTable *t) { | ||||
|     return janet_struct_end(st); | ||||
| } | ||||
|  | ||||
| /* Clone a table. */ | ||||
| JanetTable *janet_table_clone(JanetTable *table) { | ||||
|     JanetTable *newTable = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable)); | ||||
|     newTable->count = table->count; | ||||
|     newTable->capacity = table->capacity; | ||||
|     newTable->deleted = table->deleted; | ||||
|     newTable->proto = table->proto; | ||||
|     newTable->data = janet_malloc(newTable->capacity * sizeof(JanetKV)); | ||||
|     if (NULL == newTable->data) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
|     memcpy(newTable->data, table->data, (size_t) table->capacity * sizeof(JanetKV)); | ||||
|     return newTable; | ||||
| } | ||||
|  | ||||
| /* Merge a table or struct into a table */ | ||||
| static void janet_table_mergekv(JanetTable *table, const JanetKV *kvs, int32_t cap) { | ||||
|     int32_t i; | ||||
| @@ -256,7 +186,7 @@ static void janet_table_mergekv(JanetTable *table, const JanetKV *kvs, int32_t c | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Merge a table into another table */ | ||||
| /* Merge a table other into another table */ | ||||
| void janet_table_merge_table(JanetTable *table, JanetTable *other) { | ||||
|     janet_table_mergekv(table, other->data, other->capacity); | ||||
| } | ||||
| @@ -305,12 +235,6 @@ static Janet cfun_table_rawget(int32_t argc, Janet *argv) { | ||||
|     return janet_table_rawget(table, argv[1]); | ||||
| } | ||||
|  | ||||
| static Janet cfun_table_clone(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetTable *table = janet_gettable(argv, 0); | ||||
|     return janet_wrap_table(janet_table_clone(table)); | ||||
| } | ||||
|  | ||||
| static const JanetReg table_cfuns[] = { | ||||
|     { | ||||
|         "table/new", cfun_table_new, | ||||
| @@ -344,12 +268,6 @@ static const JanetReg table_cfuns[] = { | ||||
|              "If a table tab does not contain t directly, the function will return " | ||||
|              "nil without checking the prototype. Returns the value in the table.") | ||||
|     }, | ||||
|     { | ||||
|         "table/clone", cfun_table_clone, | ||||
|         JDOC("(table/clone tab)\n\n" | ||||
|              "Create a copy of a table. Updates to the new table will not change the old table, " | ||||
|              "and vice versa.") | ||||
|     }, | ||||
|     {NULL, NULL, NULL} | ||||
| }; | ||||
|  | ||||
|   | ||||
| @@ -1,781 +0,0 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| * deal in the Software without restriction, including without limitation the | ||||
| * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or | ||||
| * sell copies of the Software, and to permit persons to whom the Software is | ||||
| * furnished to do so, subject to the following conditions: | ||||
| * | ||||
| * The above copyright notice and this permission notice shall be included in | ||||
| * all copies or substantial portions of the Software. | ||||
| * | ||||
| * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | ||||
| * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | ||||
| * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE | ||||
| * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | ||||
| * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | ||||
| * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS | ||||
| * IN THE SOFTWARE. | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "gc.h" | ||||
| #include "util.h" | ||||
| #include "state.h" | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_THREADS | ||||
|  | ||||
| #include <math.h> | ||||
| #ifdef JANET_WINDOWS | ||||
| #include <windows.h> | ||||
| #else | ||||
| #include <setjmp.h> | ||||
| #include <time.h> | ||||
| #include <pthread.h> | ||||
| #endif | ||||
|  | ||||
| /* typedefed in janet.h */ | ||||
| struct JanetMailbox { | ||||
|  | ||||
|     /* Synchronization */ | ||||
| #ifdef JANET_WINDOWS | ||||
|     CRITICAL_SECTION lock; | ||||
|     CONDITION_VARIABLE cond; | ||||
| #else | ||||
|     pthread_mutex_t lock; | ||||
|     pthread_cond_t cond; | ||||
| #endif | ||||
|  | ||||
|     /* Memory management - reference counting */ | ||||
|     int refCount; | ||||
|     int closed; | ||||
|  | ||||
|     /* Store messages */ | ||||
|     uint16_t messageCapacity; | ||||
|     uint16_t messageCount; | ||||
|     uint16_t messageFirst; | ||||
|     uint16_t messageNext; | ||||
|  | ||||
|     /* Buffers to store messages. These buffers are manually allocated, so | ||||
|      * are not owned by any thread's GC. */ | ||||
|     JanetBuffer messages[]; | ||||
| }; | ||||
|  | ||||
| #define JANET_THREAD_HEAVYWEIGHT 0x1 | ||||
| #define JANET_THREAD_ABSTRACTS 0x2 | ||||
| #define JANET_THREAD_CFUNCTIONS 0x4 | ||||
| static const char janet_thread_flags[] = "hac"; | ||||
|  | ||||
| typedef struct { | ||||
|     JanetMailbox *original; | ||||
|     JanetMailbox *newbox; | ||||
|     uint64_t flags; | ||||
| } JanetMailboxPair; | ||||
|  | ||||
| static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL; | ||||
| static JANET_THREAD_LOCAL JanetThread *janet_vm_thread_current = NULL; | ||||
| static JANET_THREAD_LOCAL JanetTable *janet_vm_thread_decode = NULL; | ||||
|  | ||||
| static JanetTable *janet_thread_get_decode(void) { | ||||
|     if (janet_vm_thread_decode == NULL) { | ||||
|         janet_vm_thread_decode = janet_get_core_table("load-image-dict"); | ||||
|         if (NULL == janet_vm_thread_decode) { | ||||
|             janet_vm_thread_decode = janet_table(0); | ||||
|         } | ||||
|         janet_gcroot(janet_wrap_table(janet_vm_thread_decode)); | ||||
|     } | ||||
|     return janet_vm_thread_decode; | ||||
| } | ||||
|  | ||||
| static JanetMailbox *janet_mailbox_create(int refCount, uint16_t capacity) { | ||||
|     JanetMailbox *mailbox = janet_malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity); | ||||
|     if (NULL == mailbox) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
| #ifdef JANET_WINDOWS | ||||
|     InitializeCriticalSection(&mailbox->lock); | ||||
|     InitializeConditionVariable(&mailbox->cond); | ||||
| #else | ||||
|     pthread_mutex_init(&mailbox->lock, NULL); | ||||
|     pthread_cond_init(&mailbox->cond, NULL); | ||||
| #endif | ||||
|     mailbox->refCount = refCount; | ||||
|     mailbox->closed = 0; | ||||
|     mailbox->messageCount = 0; | ||||
|     mailbox->messageCapacity = capacity; | ||||
|     mailbox->messageFirst = 0; | ||||
|     mailbox->messageNext = 0; | ||||
|     for (uint16_t i = 0; i < capacity; i++) { | ||||
|         janet_buffer_init(mailbox->messages + i, 0); | ||||
|     } | ||||
|     return mailbox; | ||||
| } | ||||
|  | ||||
| static void janet_mailbox_destroy(JanetMailbox *mailbox) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     DeleteCriticalSection(&mailbox->lock); | ||||
| #else | ||||
|     pthread_mutex_destroy(&mailbox->lock); | ||||
|     pthread_cond_destroy(&mailbox->cond); | ||||
| #endif | ||||
|     for (uint16_t i = 0; i < mailbox->messageCapacity; i++) { | ||||
|         janet_buffer_deinit(mailbox->messages + i); | ||||
|     } | ||||
|     janet_free(mailbox); | ||||
| } | ||||
|  | ||||
| static void janet_mailbox_lock(JanetMailbox *mailbox) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     EnterCriticalSection(&mailbox->lock); | ||||
| #else | ||||
|     pthread_mutex_lock(&mailbox->lock); | ||||
| #endif | ||||
| } | ||||
|  | ||||
| static void janet_mailbox_unlock(JanetMailbox *mailbox) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     LeaveCriticalSection(&mailbox->lock); | ||||
| #else | ||||
|     pthread_mutex_unlock(&mailbox->lock); | ||||
| #endif | ||||
| } | ||||
|  | ||||
| /* Assumes you have the mailbox lock already */ | ||||
| static void janet_mailbox_ref_with_lock(JanetMailbox *mailbox, int delta) { | ||||
|     mailbox->refCount += delta; | ||||
|     if (mailbox->refCount <= 0) { | ||||
|         janet_mailbox_unlock(mailbox); | ||||
|         janet_mailbox_destroy(mailbox); | ||||
|     } else { | ||||
|         janet_mailbox_unlock(mailbox); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static void janet_mailbox_ref(JanetMailbox *mailbox, int delta) { | ||||
|     janet_mailbox_lock(mailbox); | ||||
|     janet_mailbox_ref_with_lock(mailbox, delta); | ||||
| } | ||||
|  | ||||
| static void janet_close_thread(JanetThread *thread) { | ||||
|     if (thread->mailbox) { | ||||
|         janet_mailbox_ref(thread->mailbox, -1); | ||||
|         thread->mailbox = NULL; | ||||
|     } | ||||
| } | ||||
|  | ||||
| static int thread_gc(void *p, size_t size) { | ||||
|     (void) size; | ||||
|     JanetThread *thread = (JanetThread *)p; | ||||
|     janet_close_thread(thread); | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| static int thread_mark(void *p, size_t size) { | ||||
|     (void) size; | ||||
|     JanetThread *thread = (JanetThread *)p; | ||||
|     if (thread->encode) { | ||||
|         janet_mark(janet_wrap_table(thread->encode)); | ||||
|     } | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) { | ||||
|     JanetMailboxPair *pair = janet_malloc(sizeof(JanetMailboxPair)); | ||||
|     if (NULL == pair) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
|     pair->original = original; | ||||
|     janet_mailbox_ref(original, 1); | ||||
|     pair->newbox = janet_mailbox_create(1, 16); | ||||
|     pair->flags = flags; | ||||
|     return pair; | ||||
| } | ||||
|  | ||||
| static void destroy_mailbox_pair(JanetMailboxPair *pair) { | ||||
|     janet_mailbox_ref(pair->original, -1); | ||||
|     janet_mailbox_ref(pair->newbox, -1); | ||||
|     janet_free(pair); | ||||
| } | ||||
|  | ||||
| /* Abstract waiting for timeout across windows/posix */ | ||||
| typedef struct { | ||||
|     int timedwait; | ||||
|     int nowait; | ||||
| #ifdef JANET_WINDOWS | ||||
|     DWORD interval; | ||||
|     DWORD ticksLeft; | ||||
| #else | ||||
|     struct timespec ts; | ||||
| #endif | ||||
| } JanetWaiter; | ||||
|  | ||||
| static void janet_waiter_init(JanetWaiter *waiter, double sec) { | ||||
|     waiter->timedwait = 0; | ||||
|     waiter->nowait = 0; | ||||
|  | ||||
|     if (sec <= 0.0 || isnan(sec)) { | ||||
|         waiter->nowait = 1; | ||||
|         return; | ||||
|     } | ||||
|     waiter->timedwait = sec > 0.0 && !isinf(sec); | ||||
|  | ||||
|     /* Set maximum wait time to 30 days */ | ||||
|     if (sec > (60.0 * 60.0 * 24.0 * 30.0)) { | ||||
|         sec = 60.0 * 60.0 * 24.0 * 30.0; | ||||
|     } | ||||
|  | ||||
| #ifdef JANET_WINDOWS | ||||
|     if (waiter->timedwait) { | ||||
|         waiter->ticksLeft = waiter->interval = (DWORD) floor(1000.0 * sec); | ||||
|     } | ||||
| #else | ||||
|     if (waiter->timedwait) { | ||||
|         /* N seconds -> timespec of (now + sec) */ | ||||
|         struct timespec now; | ||||
|         janet_gettime(&now); | ||||
|         time_t tvsec = (time_t) floor(sec); | ||||
|         long tvnsec = (long) floor(1000000000.0 * (sec - ((double) tvsec))); | ||||
|         tvsec += now.tv_sec; | ||||
|         tvnsec += now.tv_nsec; | ||||
|         if (tvnsec >= 1000000000L) { | ||||
|             tvnsec -= 1000000000L; | ||||
|             tvsec += 1; | ||||
|         } | ||||
|         waiter->ts.tv_sec = tvsec; | ||||
|         waiter->ts.tv_nsec = tvnsec; | ||||
|     } | ||||
| #endif | ||||
| } | ||||
|  | ||||
| static int janet_waiter_wait(JanetWaiter *wait, JanetMailbox *mailbox) { | ||||
|     if (wait->nowait) return 1; | ||||
| #ifdef JANET_WINDOWS | ||||
|     if (wait->timedwait) { | ||||
|         if (wait->ticksLeft == 0) return 1; | ||||
|         DWORD startTime = GetTickCount(); | ||||
|         int status = !SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, wait->ticksLeft); | ||||
|         DWORD dTick = GetTickCount() - startTime; | ||||
|         /* Be careful about underflow */ | ||||
|         wait->ticksLeft = dTick > wait->ticksLeft ? 0 : dTick; | ||||
|         return status; | ||||
|     } else { | ||||
|         SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, INFINITE); | ||||
|         return 0; | ||||
|     } | ||||
| #else | ||||
|     if (wait->timedwait) { | ||||
|         return pthread_cond_timedwait(&mailbox->cond, &mailbox->lock, &wait->ts); | ||||
|     } else { | ||||
|         pthread_cond_wait(&mailbox->cond, &mailbox->lock); | ||||
|         return 0; | ||||
|     } | ||||
| #endif | ||||
| } | ||||
|  | ||||
| static void janet_mailbox_wakeup(JanetMailbox *mailbox) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     WakeConditionVariable(&mailbox->cond); | ||||
| #else | ||||
|     pthread_cond_signal(&mailbox->cond); | ||||
| #endif | ||||
| } | ||||
|  | ||||
| static int mailbox_at_capacity(JanetMailbox *mailbox) { | ||||
|     return mailbox->messageCount >= mailbox->messageCapacity; | ||||
| } | ||||
|  | ||||
| /* Returns 1 if could not send (encode error or timeout), 2 for mailbox closed, and | ||||
|  * 0 otherwise. Will not panic.  */ | ||||
| int janet_thread_send(JanetThread *thread, Janet msg, double timeout) { | ||||
|  | ||||
|     /* Ensure mailbox is not closed. */ | ||||
|     JanetMailbox *mailbox = thread->mailbox; | ||||
|     if (NULL == mailbox) return 2; | ||||
|     janet_mailbox_lock(mailbox); | ||||
|     if (mailbox->closed) { | ||||
|         janet_mailbox_ref_with_lock(mailbox, -1); | ||||
|         thread->mailbox = NULL; | ||||
|         return 2; | ||||
|     } | ||||
|  | ||||
|     /* Back pressure */ | ||||
|     if (mailbox_at_capacity(mailbox)) { | ||||
|         JanetWaiter wait; | ||||
|         janet_waiter_init(&wait, timeout); | ||||
|  | ||||
|         if (wait.nowait) { | ||||
|             janet_mailbox_unlock(mailbox); | ||||
|             return 1; | ||||
|         } | ||||
|  | ||||
|         /* Retry loop, as there can be multiple writers */ | ||||
|         while (mailbox_at_capacity(mailbox)) { | ||||
|             if (janet_waiter_wait(&wait, mailbox)) { | ||||
|                 janet_mailbox_unlock(mailbox); | ||||
|                 janet_mailbox_wakeup(mailbox); | ||||
|                 return 1; | ||||
|             } | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     /* Hack to capture all panics from marshalling. This works because | ||||
|      * we know janet_marshal won't mess with other essential global state. */ | ||||
|     jmp_buf buf; | ||||
|     jmp_buf *old_buf = janet_vm_jmp_buf; | ||||
|     janet_vm_jmp_buf = &buf; | ||||
|     int32_t oldmcount = mailbox->messageCount; | ||||
|  | ||||
|     int ret = 0; | ||||
|     if (setjmp(buf)) { | ||||
|         ret = 1; | ||||
|         mailbox->messageCount = oldmcount; | ||||
|     } else { | ||||
|         JanetBuffer *msgbuf = mailbox->messages + mailbox->messageNext; | ||||
|         msgbuf->count = 0; | ||||
|  | ||||
|         /* Start panic zone */ | ||||
|         janet_marshal(msgbuf, msg, thread->encode, JANET_MARSHAL_UNSAFE); | ||||
|         /* End panic zone */ | ||||
|  | ||||
|         mailbox->messageNext = (mailbox->messageNext + 1) % mailbox->messageCapacity; | ||||
|         mailbox->messageCount++; | ||||
|     } | ||||
|  | ||||
|     /* Cleanup */ | ||||
|     janet_vm_jmp_buf = old_buf; | ||||
|     janet_mailbox_unlock(mailbox); | ||||
|  | ||||
|     /* Potentially wake up a blocked thread */ | ||||
|     janet_mailbox_wakeup(mailbox); | ||||
|  | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| /* Returns 0 on successful message. Returns 1 if timedout */ | ||||
| int janet_thread_receive(Janet *msg_out, double timeout) { | ||||
|     JanetMailbox *mailbox = janet_vm_mailbox; | ||||
|     janet_mailbox_lock(mailbox); | ||||
|  | ||||
|     /* For timeouts */ | ||||
|     JanetWaiter wait; | ||||
|     janet_waiter_init(&wait, timeout); | ||||
|  | ||||
|     for (;;) { | ||||
|  | ||||
|         /* Check for messages waiting for us */ | ||||
|         if (mailbox->messageCount > 0) { | ||||
|  | ||||
|             /* Hack to capture all panics from marshalling. This works because | ||||
|              * we know janet_marshal won't mess with other essential global state. */ | ||||
|             jmp_buf buf; | ||||
|             jmp_buf *old_buf = janet_vm_jmp_buf; | ||||
|             janet_vm_jmp_buf = &buf; | ||||
|  | ||||
|             /* Handle errors */ | ||||
|             if (setjmp(buf)) { | ||||
|                 /* Cleanup jmp_buf, return error. | ||||
|                  * Do not ignore bad messages as before. */ | ||||
|                 janet_vm_jmp_buf = old_buf; | ||||
|                 *msg_out = *janet_vm_return_reg; | ||||
|                 janet_mailbox_unlock(mailbox); | ||||
|                 return 2; | ||||
|             } else { | ||||
|                 JanetBuffer *msgbuf = mailbox->messages + mailbox->messageFirst; | ||||
|                 mailbox->messageCount--; | ||||
|                 mailbox->messageFirst = (mailbox->messageFirst + 1) % mailbox->messageCapacity; | ||||
|  | ||||
|                 /* Read from beginning of channel */ | ||||
|                 const uint8_t *nextItem = NULL; | ||||
|                 Janet item = janet_unmarshal( | ||||
|                                  msgbuf->data, msgbuf->count, | ||||
|                                  JANET_MARSHAL_UNSAFE, janet_thread_get_decode(), &nextItem); | ||||
|                 *msg_out = item; | ||||
|  | ||||
|                 /* Cleanup */ | ||||
|                 janet_vm_jmp_buf = old_buf; | ||||
|                 janet_mailbox_unlock(mailbox); | ||||
|  | ||||
|                 /* Potentially wake up pending threads */ | ||||
|                 janet_mailbox_wakeup(mailbox); | ||||
|  | ||||
|                 return 0; | ||||
|             } | ||||
|         } | ||||
|  | ||||
|         if (wait.nowait) { | ||||
|             janet_mailbox_unlock(mailbox); | ||||
|             return 1; | ||||
|         } | ||||
|  | ||||
|         /* Wait for next message */ | ||||
|         if (janet_waiter_wait(&wait, mailbox)) { | ||||
|             janet_mailbox_unlock(mailbox); | ||||
|             return 1; | ||||
|         } | ||||
|     } | ||||
| } | ||||
|  | ||||
| static int janet_thread_getter(void *p, Janet key, Janet *out); | ||||
| static Janet janet_thread_next(void *p, Janet key); | ||||
|  | ||||
| const JanetAbstractType janet_thread_type = { | ||||
|     "core/thread", | ||||
|     thread_gc, | ||||
|     thread_mark, | ||||
|     janet_thread_getter, | ||||
|     NULL, /* put */ | ||||
|     NULL, /* marshal */ | ||||
|     NULL, /* unmarshal */ | ||||
|     NULL, /* tostring */ | ||||
|     NULL, /* compare */ | ||||
|     NULL, /* hash */ | ||||
|     janet_thread_next, | ||||
|     JANET_ATEND_NEXT | ||||
| }; | ||||
|  | ||||
| static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) { | ||||
|     JanetThread *thread = janet_abstract(&janet_thread_type, sizeof(JanetThread)); | ||||
|     janet_mailbox_ref(mailbox, 1); | ||||
|     thread->mailbox = mailbox; | ||||
|     thread->encode = encode; | ||||
|     return thread; | ||||
| } | ||||
|  | ||||
| JanetThread *janet_getthread(const Janet *argv, int32_t n) { | ||||
|     return (JanetThread *) janet_getabstract(argv, n, &janet_thread_type); | ||||
| } | ||||
|  | ||||
| /* Runs in new thread */ | ||||
| static int thread_worker(JanetMailboxPair *pair) { | ||||
|     JanetFiber *fiber = NULL; | ||||
|     Janet out; | ||||
|  | ||||
|     /* Use the mailbox we were given */ | ||||
|     janet_vm_mailbox = pair->newbox; | ||||
|     janet_mailbox_ref(pair->newbox, 1); | ||||
|  | ||||
|     /* Init VM */ | ||||
|     janet_init(); | ||||
|  | ||||
|     /* Get dictionaries for default encode/decode */ | ||||
|     JanetTable *encode; | ||||
|     if (pair->flags & JANET_THREAD_HEAVYWEIGHT) { | ||||
|         encode = janet_get_core_table("make-image-dict"); | ||||
|     } else { | ||||
|         encode = NULL; | ||||
|         janet_vm_thread_decode = janet_table(0); | ||||
|         janet_gcroot(janet_wrap_table(janet_vm_thread_decode)); | ||||
|     } | ||||
|  | ||||
|     /* Create parent thread */ | ||||
|     JanetThread *parent = janet_make_thread(pair->original, encode); | ||||
|     Janet parentv = janet_wrap_abstract(parent); | ||||
|  | ||||
|     /* Unmarshal the abstract registry */ | ||||
|     if (pair->flags & JANET_THREAD_ABSTRACTS) { | ||||
|         Janet reg; | ||||
|         int status = janet_thread_receive(®, INFINITY); | ||||
|         if (status) goto error; | ||||
|         if (!janet_checktype(reg, JANET_TABLE)) goto error; | ||||
|         janet_gcunroot(janet_wrap_table(janet_vm_abstract_registry)); | ||||
|         janet_vm_abstract_registry = janet_unwrap_table(reg); | ||||
|         janet_gcroot(janet_wrap_table(janet_vm_abstract_registry)); | ||||
|     } | ||||
|  | ||||
|     /* Unmarshal the normal registry */ | ||||
|     if (pair->flags & JANET_THREAD_CFUNCTIONS) { | ||||
|         Janet reg; | ||||
|         int status = janet_thread_receive(®, INFINITY); | ||||
|         if (status) goto error; | ||||
|         if (!janet_checktype(reg, JANET_TABLE)) goto error; | ||||
|         janet_gcunroot(janet_wrap_table(janet_vm_registry)); | ||||
|         janet_vm_registry = janet_unwrap_table(reg); | ||||
|         janet_gcroot(janet_wrap_table(janet_vm_registry)); | ||||
|     } | ||||
|  | ||||
|     /* Unmarshal the function */ | ||||
|     Janet funcv; | ||||
|     int status = janet_thread_receive(&funcv, INFINITY); | ||||
|     if (status) goto error; | ||||
|     if (!janet_checktype(funcv, JANET_FUNCTION)) goto error; | ||||
|     JanetFunction *func = janet_unwrap_function(funcv); | ||||
|  | ||||
|     /* Arity check */ | ||||
|     if (func->def->min_arity > 1 || func->def->max_arity < 1) { | ||||
|         goto error; | ||||
|     } | ||||
|  | ||||
|     /* Call function */ | ||||
|     Janet argv[1] = { parentv }; | ||||
|     fiber = janet_fiber(func, 64, 1, argv); | ||||
|     if (pair->flags & JANET_THREAD_HEAVYWEIGHT) { | ||||
|         fiber->env = janet_table(0); | ||||
|         fiber->env->proto = janet_core_env(NULL); | ||||
|     } | ||||
|     JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out); | ||||
|     if (sig != JANET_SIGNAL_OK && sig < JANET_SIGNAL_USER0) { | ||||
|         janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode))); | ||||
|         janet_stacktrace(fiber, out); | ||||
|     } | ||||
|  | ||||
| #ifdef JANET_EV | ||||
|     janet_loop(); | ||||
| #endif | ||||
|  | ||||
|     /* Normal exit */ | ||||
|     destroy_mailbox_pair(pair); | ||||
|     janet_deinit(); | ||||
|     return 0; | ||||
|  | ||||
|     /* Fail to set something up */ | ||||
| error: | ||||
|     destroy_mailbox_pair(pair); | ||||
|     janet_eprintf("\nthread failed to start\n"); | ||||
|     janet_deinit(); | ||||
|     return 1; | ||||
| } | ||||
|  | ||||
| #ifdef JANET_WINDOWS | ||||
|  | ||||
| static DWORD WINAPI janet_create_thread_wrapper(LPVOID param) { | ||||
|     thread_worker((JanetMailboxPair *)param); | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| static int janet_thread_start_child(JanetMailboxPair *pair) { | ||||
|     HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, pair, 0, NULL); | ||||
|     int ret = NULL == handle; | ||||
|     /* Does not kill thread, simply detatches */ | ||||
|     if (!ret) CloseHandle(handle); | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| #else | ||||
|  | ||||
| static void *janet_pthread_wrapper(void *param) { | ||||
|     thread_worker((JanetMailboxPair *)param); | ||||
|     return NULL; | ||||
| } | ||||
|  | ||||
| static int janet_thread_start_child(JanetMailboxPair *pair) { | ||||
|     pthread_t handle; | ||||
|     int error = pthread_create(&handle, NULL, janet_pthread_wrapper, pair); | ||||
|     if (error) { | ||||
|         return 1; | ||||
|     } else { | ||||
|         pthread_detach(handle); | ||||
|         return 0; | ||||
|     } | ||||
| } | ||||
|  | ||||
| #endif | ||||
|  | ||||
| /* | ||||
|  * Setup/Teardown | ||||
|  */ | ||||
|  | ||||
| void janet_threads_init(void) { | ||||
|     if (NULL == janet_vm_mailbox) { | ||||
|         janet_vm_mailbox = janet_mailbox_create(1, 10); | ||||
|     } | ||||
|     janet_vm_thread_decode = NULL; | ||||
|     janet_vm_thread_current = NULL; | ||||
| } | ||||
|  | ||||
| void janet_threads_deinit(void) { | ||||
|     janet_mailbox_lock(janet_vm_mailbox); | ||||
|     janet_vm_mailbox->closed = 1; | ||||
|     janet_mailbox_ref_with_lock(janet_vm_mailbox, -1); | ||||
|     janet_vm_mailbox = NULL; | ||||
|     janet_vm_thread_current = NULL; | ||||
|     janet_vm_thread_decode = NULL; | ||||
| } | ||||
|  | ||||
| JanetThread *janet_thread_current(void) { | ||||
|     if (NULL == janet_vm_thread_current) { | ||||
|         janet_vm_thread_current = janet_make_thread(janet_vm_mailbox, janet_get_core_table("make-image-dict")); | ||||
|         janet_gcroot(janet_wrap_abstract(janet_vm_thread_current)); | ||||
|     } | ||||
|     return janet_vm_thread_current; | ||||
| } | ||||
|  | ||||
| /* | ||||
|  * Cfuns | ||||
|  */ | ||||
|  | ||||
| static Janet cfun_thread_current(int32_t argc, Janet *argv) { | ||||
|     (void) argv; | ||||
|     janet_fixarity(argc, 0); | ||||
|     return janet_wrap_abstract(janet_thread_current()); | ||||
| } | ||||
|  | ||||
| static Janet cfun_thread_new(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 3); | ||||
|     /* Just type checking */ | ||||
|     janet_getfunction(argv, 0); | ||||
|     int32_t cap = janet_optinteger(argv, argc, 1, 10); | ||||
|     if (cap < 1 || cap > UINT16_MAX) { | ||||
|         janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap); | ||||
|     } | ||||
|     uint64_t flags = argc >= 3 ? janet_getflags(argv, 2, janet_thread_flags) : JANET_THREAD_ABSTRACTS; | ||||
|     JanetTable *encode; | ||||
|     if (flags & JANET_THREAD_HEAVYWEIGHT) { | ||||
|         encode = janet_get_core_table("make-image-dict"); | ||||
|     } else { | ||||
|         encode = NULL; | ||||
|     } | ||||
|  | ||||
|     JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox, flags); | ||||
|     JanetThread *thread = janet_make_thread(pair->newbox, encode); | ||||
|     if (janet_thread_start_child(pair)) { | ||||
|         destroy_mailbox_pair(pair); | ||||
|         janet_panic("could not start thread"); | ||||
|     } | ||||
|  | ||||
|     if (flags & JANET_THREAD_ABSTRACTS) { | ||||
|         if (janet_thread_send(thread, janet_wrap_table(janet_vm_abstract_registry), INFINITY)) { | ||||
|             janet_panic("could not send abstract registry to thread"); | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     if (flags & JANET_THREAD_CFUNCTIONS) { | ||||
|         if (janet_thread_send(thread, janet_wrap_table(janet_vm_registry), INFINITY)) { | ||||
|             janet_panic("could not send registry to thread"); | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     /* If thread started, send the worker function. */ | ||||
|     if (janet_thread_send(thread, argv[0], INFINITY)) { | ||||
|         janet_panicf("could not send worker function %v to thread", argv[0]); | ||||
|     } | ||||
|  | ||||
|     return janet_wrap_abstract(thread); | ||||
| } | ||||
|  | ||||
| static Janet cfun_thread_send(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 2, 3); | ||||
|     JanetThread *thread = janet_getthread(argv, 0); | ||||
|     int status = janet_thread_send(thread, argv[1], janet_optnumber(argv, argc, 2, 1.0)); | ||||
|     switch (status) { | ||||
|         default: | ||||
|             break; | ||||
|         case 1: | ||||
|             janet_panicf("failed to send message %v", argv[1]); | ||||
|         case 2: | ||||
|             janet_panic("thread mailbox is closed"); | ||||
|     } | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| static Janet cfun_thread_receive(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 0, 1); | ||||
|     double wait = janet_optnumber(argv, argc, 0, 1.0); | ||||
|     Janet out; | ||||
|     int status = janet_thread_receive(&out, wait); | ||||
|     switch (status) { | ||||
|         default: | ||||
|             break; | ||||
|         case 1: | ||||
|             janet_panicf("timeout after %f seconds", wait); | ||||
|         case 2: | ||||
|             janet_panicf("failed to receive message: %v", out); | ||||
|     } | ||||
|     return out; | ||||
| } | ||||
|  | ||||
| static Janet cfun_thread_close(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetThread *thread = janet_getthread(argv, 0); | ||||
|     janet_close_thread(thread); | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| static Janet cfun_thread_exit(int32_t argc, Janet *argv) { | ||||
|     (void) argv; | ||||
|     janet_arity(argc, 0, 1); | ||||
| #if defined(JANET_WINDOWS) | ||||
|     int32_t flag = janet_optinteger(argv, argc, 0, 0); | ||||
|     ExitThread(flag); | ||||
| #else | ||||
|     pthread_exit(NULL); | ||||
| #endif | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| static const JanetMethod janet_thread_methods[] = { | ||||
|     {"send", cfun_thread_send}, | ||||
|     {"close", cfun_thread_close}, | ||||
|     {NULL, NULL} | ||||
| }; | ||||
|  | ||||
| static int janet_thread_getter(void *p, Janet key, Janet *out) { | ||||
|     (void) p; | ||||
|     if (!janet_checktype(key, JANET_KEYWORD)) return 0; | ||||
|     return janet_getmethod(janet_unwrap_keyword(key), janet_thread_methods, out); | ||||
| } | ||||
|  | ||||
| static Janet janet_thread_next(void *p, Janet key) { | ||||
|     (void) p; | ||||
|     return janet_nextmethod(janet_thread_methods, key); | ||||
| } | ||||
|  | ||||
| static const JanetReg threadlib_cfuns[] = { | ||||
|     { | ||||
|         "thread/current", cfun_thread_current, | ||||
|         JDOC("(thread/current)\n\n" | ||||
|              "Get the current running thread.") | ||||
|     }, | ||||
|     { | ||||
|         "thread/new", cfun_thread_new, | ||||
|         JDOC("(thread/new func &opt capacity flags)\n\n" | ||||
|              "Start a new thread that will start immediately. " | ||||
|              "If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. " | ||||
|              "The capacity must be between 1 and 65535 inclusive, and defaults to 10. " | ||||
|              "Can optionally provide flags to the new thread - supported flags are:\n\n" | ||||
|              "* :h - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n\n" | ||||
|              "* :a - Allow sending over registered abstract types to the new thread\n\n" | ||||
|              "* :c - Send over cfunction information to the new thread.\n\n" | ||||
|              "Returns a handle to the new thread.") | ||||
|     }, | ||||
|     { | ||||
|         "thread/send", cfun_thread_send, | ||||
|         JDOC("(thread/send thread msgi &opt timeout)\n\n" | ||||
|              "Send a message to the thread. By default, the timeout is 1 second, but an optional timeout " | ||||
|              "in seconds can be provided. Use math/inf for no timeout. " | ||||
|              "Will throw an error if there is a problem sending the message.") | ||||
|     }, | ||||
|     { | ||||
|         "thread/receive", cfun_thread_receive, | ||||
|         JDOC("(thread/receive &opt timeout)\n\n" | ||||
|              "Get a message sent to this thread. If timeout (in seconds) is provided, an error " | ||||
|              "will be thrown after the timeout has elapsed but " | ||||
|              "no messages are received. The default timeout is 1 second, and math/inf cam be passed to " | ||||
|              "turn off the timeout.") | ||||
|     }, | ||||
|     { | ||||
|         "thread/close", cfun_thread_close, | ||||
|         JDOC("(thread/close thread)\n\n" | ||||
|              "Close a thread, unblocking it and ending communication with it. Note that closing " | ||||
|              "a thread is idempotent and does not cancel the thread's operation. Returns nil.") | ||||
|     }, | ||||
|     { | ||||
|         "thread/exit", cfun_thread_exit, | ||||
|         JDOC("(thread/exit &opt code)\n\n" | ||||
|              "Exit from the current thread. If no more threads are running, ends the process, but otherwise does " | ||||
|              "not end the current process.") | ||||
|     }, | ||||
|     {NULL, NULL, NULL} | ||||
| }; | ||||
|  | ||||
| /* Module entry point */ | ||||
| void janet_lib_thread(JanetTable *env) { | ||||
|     janet_core_cfuns(env, NULL, threadlib_cfuns); | ||||
|     janet_register_abstract_type(&janet_thread_type); | ||||
| } | ||||
|  | ||||
| #endif | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,7 +21,6 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "symcache.h" | ||||
| #include "gc.h" | ||||
| @@ -32,10 +31,10 @@ | ||||
|  * which should be filled with Janets. The memory will not be collected until | ||||
|  * janet_tuple_end is called. */ | ||||
| Janet *janet_tuple_begin(int32_t length) { | ||||
|     size_t size = sizeof(JanetTupleHead) + ((size_t) length * sizeof(Janet)); | ||||
|     size_t size = sizeof(JanetTupleHead) + (length * sizeof(Janet)); | ||||
|     JanetTupleHead *head = janet_gcalloc(JANET_MEMORY_TUPLE, size); | ||||
|     head->sm_line = -1; | ||||
|     head->sm_column = -1; | ||||
|     head->sm_start = -1; | ||||
|     head->sm_end = -1; | ||||
|     head->length = length; | ||||
|     return (Janet *)(head->data); | ||||
| } | ||||
| @@ -49,10 +48,49 @@ const Janet *janet_tuple_end(Janet *tuple) { | ||||
| /* Build a tuple with n values */ | ||||
| const Janet *janet_tuple_n(const Janet *values, int32_t n) { | ||||
|     Janet *t = janet_tuple_begin(n); | ||||
|     safe_memcpy(t, values, sizeof(Janet) * n); | ||||
|     memcpy(t, values, sizeof(Janet) * n); | ||||
|     return janet_tuple_end(t); | ||||
| } | ||||
|  | ||||
| /* Check if two tuples are equal */ | ||||
| int janet_tuple_equal(const Janet *lhs, const Janet *rhs) { | ||||
|     int32_t index; | ||||
|     int32_t llen = janet_tuple_length(lhs); | ||||
|     int32_t rlen = janet_tuple_length(rhs); | ||||
|     int32_t lhash = janet_tuple_hash(lhs); | ||||
|     int32_t rhash = janet_tuple_hash(rhs); | ||||
|     if (lhash == 0) | ||||
|         lhash = janet_tuple_hash(lhs) = janet_array_calchash(lhs, llen); | ||||
|     if (rhash == 0) | ||||
|         rhash = janet_tuple_hash(rhs) = janet_array_calchash(rhs, rlen); | ||||
|     if (lhash != rhash) | ||||
|         return 0; | ||||
|     if (llen != rlen) | ||||
|         return 0; | ||||
|     for (index = 0; index < llen; index++) { | ||||
|         if (!janet_equals(lhs[index], rhs[index])) | ||||
|             return 0; | ||||
|     } | ||||
|     return 1; | ||||
| } | ||||
|  | ||||
| /* Compare tuples */ | ||||
| int janet_tuple_compare(const Janet *lhs, const Janet *rhs) { | ||||
|     int32_t i; | ||||
|     int32_t llen = janet_tuple_length(lhs); | ||||
|     int32_t rlen = janet_tuple_length(rhs); | ||||
|     int32_t count = llen < rlen ? llen : rlen; | ||||
|     for (i = 0; i < count; ++i) { | ||||
|         int comp = janet_compare(lhs[i], rhs[i]); | ||||
|         if (comp != 0) return comp; | ||||
|     } | ||||
|     if (llen < rlen) | ||||
|         return -1; | ||||
|     else if (llen > rlen) | ||||
|         return 1; | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| /* C Functions */ | ||||
|  | ||||
| static Janet cfun_tuple_brackets(int32_t argc, Janet *argv) { | ||||
| @@ -62,8 +100,8 @@ static Janet cfun_tuple_brackets(int32_t argc, Janet *argv) { | ||||
| } | ||||
|  | ||||
| static Janet cfun_tuple_slice(int32_t argc, Janet *argv) { | ||||
|     JanetView view = janet_getindexed(argv, 0); | ||||
|     JanetRange range = janet_getslice(argc, argv); | ||||
|     JanetView view = janet_getindexed(argv, 0); | ||||
|     return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start)); | ||||
| } | ||||
|  | ||||
| @@ -81,16 +119,16 @@ static Janet cfun_tuple_sourcemap(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     const Janet *tup = janet_gettuple(argv, 0); | ||||
|     Janet contents[2]; | ||||
|     contents[0] = janet_wrap_integer(janet_tuple_head(tup)->sm_line); | ||||
|     contents[1] = janet_wrap_integer(janet_tuple_head(tup)->sm_column); | ||||
|     contents[0] = janet_wrap_integer(janet_tuple_head(tup)->sm_start); | ||||
|     contents[1] = janet_wrap_integer(janet_tuple_head(tup)->sm_end); | ||||
|     return janet_wrap_tuple(janet_tuple_n(contents, 2)); | ||||
| } | ||||
|  | ||||
| static Janet cfun_tuple_setmap(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 3); | ||||
|     const Janet *tup = janet_gettuple(argv, 0); | ||||
|     janet_tuple_head(tup)->sm_line = janet_getinteger(argv, 1); | ||||
|     janet_tuple_head(tup)->sm_column = janet_getinteger(argv, 2); | ||||
|     janet_tuple_head(tup)->sm_start = janet_getinteger(argv, 1); | ||||
|     janet_tuple_head(tup)->sm_end = janet_getinteger(argv, 2); | ||||
|     return argv[0]; | ||||
| } | ||||
|  | ||||
| @@ -105,10 +143,7 @@ static const JanetReg tuple_cfuns[] = { | ||||
|         JDOC("(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n" | ||||
|              "Take a sub sequence of an array or tuple from index start " | ||||
|              "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. " | ||||
|              "they default to 0 and the length of arrtup respectively." | ||||
|              "Returns the new tuple.") | ||||
|     }, | ||||
|     { | ||||
| @@ -123,14 +158,16 @@ static const JanetReg tuple_cfuns[] = { | ||||
|     { | ||||
|         "tuple/sourcemap", cfun_tuple_sourcemap, | ||||
|         JDOC("(tuple/sourcemap tup)\n\n" | ||||
|              "Returns the sourcemap metadata attached to a tuple, " | ||||
|              " which is another tuple (line, column).") | ||||
|              "Returns the sourcemap metadata attached to a tuple. " | ||||
|              "The mapping is represented by a pair of byte offsets into the " | ||||
|              "the source code representing the start and end byte indices where " | ||||
|              "the tuple is. ") | ||||
|     }, | ||||
|     { | ||||
|         "tuple/setmap", cfun_tuple_setmap, | ||||
|         JDOC("(tuple/setmap tup line column)\n\n" | ||||
|              "Set the sourcemap metadata on a tuple. line and column indicate " | ||||
|              "should be integers.") | ||||
|         JDOC("(tuple/setmap tup start end)\n\n" | ||||
|              "Set the sourcemap metadata on a tuple. start and end should " | ||||
|              "be integers representing byte offsets into the file. Returns tup.") | ||||
|     }, | ||||
|     {NULL, NULL, NULL} | ||||
| }; | ||||
|   | ||||
							
								
								
									
										561
									
								
								src/core/typedarray.c
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										561
									
								
								src/core/typedarray.c
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,561 @@ | ||||
| /* | ||||
| * Copyright (c) 2019 Calvin Rose & contributors | ||||
| * | ||||
| * Permission is hereby granted, free of charge, to any person obtaining a copy | ||||
| * of this software and associated documentation files (the "Software"), to | ||||
| * deal in the Software without restriction, including without limitation the | ||||
| * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or | ||||
| * sell copies of the Software, and to permit persons to whom the Software is | ||||
| * furnished to do so, subject to the following conditions: | ||||
| * | ||||
| * The above copyright notice and this permission notice shall be included in | ||||
| * all copies or substantial portions of the Software. | ||||
| * | ||||
| * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | ||||
| * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | ||||
| * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE | ||||
| * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | ||||
| * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING | ||||
| * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS | ||||
| * IN THE SOFTWARE. | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include <janet.h> | ||||
| #include "util.h" | ||||
| #endif | ||||
|  | ||||
| #ifdef JANET_TYPED_ARRAY | ||||
|  | ||||
| static char *ta_type_names[] = { | ||||
|     "uint8", | ||||
|     "int8", | ||||
|     "uint16", | ||||
|     "int16", | ||||
|     "uint32", | ||||
|     "int32", | ||||
|     "uint64", | ||||
|     "int64", | ||||
|     "float32", | ||||
|     "float64", | ||||
|     "?" | ||||
| }; | ||||
|  | ||||
| static size_t ta_type_sizes[] = { | ||||
|     sizeof(uint8_t), | ||||
|     sizeof(int8_t), | ||||
|     sizeof(uint16_t), | ||||
|     sizeof(int16_t), | ||||
|     sizeof(uint32_t), | ||||
|     sizeof(int32_t), | ||||
|     sizeof(uint64_t), | ||||
|     sizeof(int64_t), | ||||
|     sizeof(float), | ||||
|     sizeof(double), | ||||
|     0 | ||||
| }; | ||||
|  | ||||
| #define TA_COUNT_TYPES (JANET_TARRAY_TYPE_F64 + 1) | ||||
| #define TA_ATOM_MAXSIZE 8 | ||||
| #define TA_FLAG_BIG_ENDIAN 1 | ||||
|  | ||||
| static JanetTArrayType get_ta_type_by_name(const uint8_t *name) { | ||||
|     for (int i = 0; i < TA_COUNT_TYPES; i++) { | ||||
|         if (!janet_cstrcmp(name, ta_type_names[i])) | ||||
|             return i; | ||||
|     } | ||||
|     janet_panicf("invalid typed array type %S", name); | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| static JanetTArrayBuffer *ta_buffer_init(JanetTArrayBuffer *buf, size_t size) { | ||||
|     buf->data = NULL; | ||||
|     if (size > 0) { | ||||
|         buf->data = (uint8_t *)calloc(size, sizeof(uint8_t)); | ||||
|         if (buf->data == NULL) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|     } | ||||
|     buf->size = size; | ||||
| #ifdef JANET_BIG_ENDIAN | ||||
|     buf->flags = TA_FLAG_BIG_ENDIAN; | ||||
| #else | ||||
|     buf->flags = 0; | ||||
| #endif | ||||
|     return buf; | ||||
| } | ||||
|  | ||||
| static int ta_buffer_gc(void *p, size_t s) { | ||||
|     (void) s; | ||||
|     JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p; | ||||
|     free(buf->data); | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| static void ta_buffer_marshal(void *p, JanetMarshalContext *ctx) { | ||||
|     JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p; | ||||
|     janet_marshal_size(ctx, buf->size); | ||||
|     janet_marshal_int(ctx, buf->flags); | ||||
|     janet_marshal_bytes(ctx, buf->data, buf->size); | ||||
| } | ||||
|  | ||||
| static void ta_buffer_unmarshal(void *p, JanetMarshalContext *ctx) { | ||||
|     JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p; | ||||
|     size_t size = janet_unmarshal_size(ctx); | ||||
|     ta_buffer_init(buf, size); | ||||
|     buf->flags = janet_unmarshal_int(ctx); | ||||
|     janet_unmarshal_bytes(ctx, buf->data, size); | ||||
| } | ||||
|  | ||||
| static const JanetAbstractType ta_buffer_type = { | ||||
|     "ta/buffer", | ||||
|     ta_buffer_gc, | ||||
|     NULL, | ||||
|     NULL, | ||||
|     NULL, | ||||
|     ta_buffer_marshal, | ||||
|     ta_buffer_unmarshal, | ||||
|     NULL | ||||
| }; | ||||
|  | ||||
| static int ta_mark(void *p, size_t s) { | ||||
|     (void) s; | ||||
|     JanetTArrayView *view = (JanetTArrayView *)p; | ||||
|     janet_mark(janet_wrap_abstract(view->buffer)); | ||||
|     return 0; | ||||
| } | ||||
|  | ||||
| static void ta_view_marshal(void *p, JanetMarshalContext *ctx) { | ||||
|     JanetTArrayView *view = (JanetTArrayView *)p; | ||||
|     size_t offset = (view->buffer->data - view->as.u8); | ||||
|     janet_marshal_size(ctx, view->size); | ||||
|     janet_marshal_size(ctx, view->stride); | ||||
|     janet_marshal_int(ctx, view->type); | ||||
|     janet_marshal_size(ctx, offset); | ||||
|     janet_marshal_janet(ctx, janet_wrap_abstract(view->buffer)); | ||||
| } | ||||
|  | ||||
| static void ta_view_unmarshal(void *p, JanetMarshalContext *ctx) { | ||||
|     JanetTArrayView *view = (JanetTArrayView *)p; | ||||
|     size_t offset; | ||||
|     int32_t atype; | ||||
|     Janet buffer; | ||||
|     view->size = janet_unmarshal_size(ctx); | ||||
|     view->stride = janet_unmarshal_size(ctx); | ||||
|     atype = janet_unmarshal_int(ctx); | ||||
|     if (atype < 0 || atype >= TA_COUNT_TYPES) | ||||
|         janet_panic("bad typed array type"); | ||||
|     view->type = atype; | ||||
|     offset = janet_unmarshal_size(ctx); | ||||
|     buffer = janet_unmarshal_janet(ctx); | ||||
|     if (!janet_checktype(buffer, JANET_ABSTRACT) || | ||||
|             (janet_abstract_type(janet_unwrap_abstract(buffer)) != &ta_buffer_type)) { | ||||
|         janet_panicf("expected typed array buffer"); | ||||
|     } | ||||
|     view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer); | ||||
|     size_t buf_need_size = offset + (ta_type_sizes[view->type]) * ((view->size - 1) * view->stride + 1); | ||||
|     if (view->buffer->size < buf_need_size) | ||||
|         janet_panic("bad typed array offset in marshalled data"); | ||||
|     view->as.u8 = view->buffer->data + offset; | ||||
| } | ||||
|  | ||||
| static Janet ta_getter(void *p, Janet key) { | ||||
|     Janet value; | ||||
|     size_t index, i; | ||||
|     JanetTArrayView *array = p; | ||||
|     if (!janet_checksize(key)) janet_panic("expected size as key"); | ||||
|     index = (size_t) janet_unwrap_number(key); | ||||
|     i = index * array->stride; | ||||
|     if (index >= array->size) { | ||||
|         value = janet_wrap_nil(); | ||||
|     } else { | ||||
|         switch (array->type) { | ||||
|             case JANET_TARRAY_TYPE_U8: | ||||
|                 value = janet_wrap_number(array->as.u8[i]); | ||||
|                 break; | ||||
|             case JANET_TARRAY_TYPE_S8: | ||||
|                 value = janet_wrap_number(array->as.s8[i]); | ||||
|                 break; | ||||
|             case JANET_TARRAY_TYPE_U16: | ||||
|                 value = janet_wrap_number(array->as.u16[i]); | ||||
|                 break; | ||||
|             case JANET_TARRAY_TYPE_S16: | ||||
|                 value = janet_wrap_number(array->as.s16[i]); | ||||
|                 break; | ||||
|             case JANET_TARRAY_TYPE_U32: | ||||
|                 value = janet_wrap_number(array->as.u32[i]); | ||||
|                 break; | ||||
|             case JANET_TARRAY_TYPE_S32: | ||||
|                 value = janet_wrap_number(array->as.s32[i]); | ||||
|                 break; | ||||
| #ifdef JANET_INT_TYPES | ||||
|             case JANET_TARRAY_TYPE_U64: | ||||
|                 value = janet_wrap_u64(array->as.u64[i]); | ||||
|                 break; | ||||
|             case JANET_TARRAY_TYPE_S64: | ||||
|                 value = janet_wrap_s64(array->as.s64[i]); | ||||
|                 break; | ||||
| #endif | ||||
|             case JANET_TARRAY_TYPE_F32: | ||||
|                 value = janet_wrap_number(array->as.f32[i]); | ||||
|                 break; | ||||
|             case JANET_TARRAY_TYPE_F64: | ||||
|                 value = janet_wrap_number(array->as.f64[i]); | ||||
|                 break; | ||||
|             default: | ||||
|                 janet_panicf("cannot get from typed array of type %s", | ||||
|                              ta_type_names[array->type]); | ||||
|                 break; | ||||
|         } | ||||
|     } | ||||
|     return value; | ||||
| } | ||||
|  | ||||
| static void ta_setter(void *p, Janet key, Janet value) { | ||||
|     size_t index, i; | ||||
|     if (!janet_checksize(key)) janet_panic("expected size as key"); | ||||
|     index = (size_t) janet_unwrap_number(key); | ||||
|     JanetTArrayView *array = p; | ||||
|     i = index * array->stride; | ||||
|     if (index >= array->size) { | ||||
|         janet_panic("index out of bounds"); | ||||
|     } | ||||
|     if (!janet_checktype(value, JANET_NUMBER) && | ||||
|             array->type != JANET_TARRAY_TYPE_U64 && | ||||
|             array->type != JANET_TARRAY_TYPE_S64) { | ||||
|         janet_panic("expected number value"); | ||||
|     } | ||||
|     switch (array->type) { | ||||
|         case JANET_TARRAY_TYPE_U8: | ||||
|             array->as.u8[i] = (uint8_t) janet_unwrap_number(value); | ||||
|             break; | ||||
|         case JANET_TARRAY_TYPE_S8: | ||||
|             array->as.s8[i] = (int8_t) janet_unwrap_number(value); | ||||
|             break; | ||||
|         case JANET_TARRAY_TYPE_U16: | ||||
|             array->as.u16[i] = (uint16_t) janet_unwrap_number(value); | ||||
|             break; | ||||
|         case JANET_TARRAY_TYPE_S16: | ||||
|             array->as.s16[i] = (int16_t) janet_unwrap_number(value); | ||||
|             break; | ||||
|         case JANET_TARRAY_TYPE_U32: | ||||
|             array->as.u32[i] = (uint32_t) janet_unwrap_number(value); | ||||
|             break; | ||||
|         case JANET_TARRAY_TYPE_S32: | ||||
|             array->as.s32[i] = (int32_t) janet_unwrap_number(value); | ||||
|             break; | ||||
| #ifdef JANET_INT_TYPES | ||||
|         case JANET_TARRAY_TYPE_U64: | ||||
|             array->as.u64[i] = janet_unwrap_u64(value); | ||||
|             break; | ||||
|         case JANET_TARRAY_TYPE_S64: | ||||
|             array->as.s64[i] = janet_unwrap_s64(value); | ||||
|             break; | ||||
| #endif | ||||
|         case JANET_TARRAY_TYPE_F32: | ||||
|             array->as.f32[i] = (float) janet_unwrap_number(value); | ||||
|             break; | ||||
|         case JANET_TARRAY_TYPE_F64: | ||||
|             array->as.f64[i] = janet_unwrap_number(value); | ||||
|             break; | ||||
|         default: | ||||
|             janet_panicf("cannot set typed array of type %s", | ||||
|                          ta_type_names[array->type]); | ||||
|             break; | ||||
|     } | ||||
| } | ||||
|  | ||||
| static const JanetAbstractType ta_view_type = { | ||||
|     "ta/view", | ||||
|     NULL, | ||||
|     ta_mark, | ||||
|     ta_getter, | ||||
|     ta_setter, | ||||
|     ta_view_marshal, | ||||
|     ta_view_unmarshal, | ||||
|     NULL | ||||
| }; | ||||
|  | ||||
| JanetTArrayBuffer *janet_tarray_buffer(size_t size) { | ||||
|     JanetTArrayBuffer *buf = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer)); | ||||
|     ta_buffer_init(buf, size); | ||||
|     return buf; | ||||
| } | ||||
|  | ||||
| JanetTArrayView *janet_tarray_view( | ||||
|     JanetTArrayType type, | ||||
|     size_t size, | ||||
|     size_t stride, | ||||
|     size_t offset, | ||||
|     JanetTArrayBuffer *buffer) { | ||||
|  | ||||
|     JanetTArrayView *view = janet_abstract(&ta_view_type, sizeof(JanetTArrayView)); | ||||
|  | ||||
|     if ((stride < 1) || (size < 1)) janet_panic("stride and size should be > 0"); | ||||
|     size_t buf_size = offset + ta_type_sizes[type] * ((size - 1) * stride + 1); | ||||
|  | ||||
|     if (NULL == buffer) { | ||||
|         buffer = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer)); | ||||
|         ta_buffer_init(buffer, buf_size); | ||||
|     } | ||||
|  | ||||
|     if (buffer->size < buf_size) { | ||||
|         janet_panicf("bad buffer size, %i bytes allocated < %i required", | ||||
|                      buffer->size, | ||||
|                      buf_size); | ||||
|     } | ||||
|  | ||||
|     view->buffer = buffer; | ||||
|     view->stride = stride; | ||||
|     view->size = size; | ||||
|     view->as.u8 = buffer->data + offset; | ||||
|     view->type = type; | ||||
|  | ||||
|     return view; | ||||
| } | ||||
|  | ||||
| JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) { | ||||
|     return janet_getabstract(argv, n, &ta_buffer_type); | ||||
| } | ||||
|  | ||||
| JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) { | ||||
|     return janet_getabstract(argv, n, &ta_view_type); | ||||
| } | ||||
|  | ||||
| JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) { | ||||
|     JanetTArrayView *view = janet_getabstract(argv, n, &ta_view_type); | ||||
|     if (view->type != type) { | ||||
|         janet_panicf("bad slot #%d, expected typed array of type %s, got %v", | ||||
|                      n, ta_type_names[type], argv[n]); | ||||
|     } | ||||
|     return view; | ||||
| } | ||||
|  | ||||
| static Janet cfun_typed_array_new(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 2, 5); | ||||
|     size_t offset = 0; | ||||
|     size_t stride = 1; | ||||
|     JanetTArrayBuffer *buffer = NULL; | ||||
|     const uint8_t *keyw = janet_getkeyword(argv, 0); | ||||
|     JanetTArrayType type = get_ta_type_by_name(keyw); | ||||
|     size_t size = janet_getsize(argv, 1); | ||||
|     if (argc > 2) | ||||
|         stride = janet_getsize(argv, 2); | ||||
|     if (argc > 3) | ||||
|         offset = janet_getsize(argv, 3); | ||||
|     if (argc > 4) { | ||||
|         if (!janet_checktype(argv[4], JANET_ABSTRACT)) { | ||||
|             janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v", | ||||
|                          4, argv[4]); | ||||
|         } | ||||
|         void *p = janet_unwrap_abstract(argv[4]); | ||||
|         if (janet_abstract_type(p) == &ta_view_type) { | ||||
|             JanetTArrayView *view = (JanetTArrayView *)p; | ||||
|             offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type]; | ||||
|             stride *= view->stride; | ||||
|             buffer = view->buffer; | ||||
|         } else { | ||||
|             buffer = p; | ||||
|         } | ||||
|     } | ||||
|     JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer); | ||||
|     return janet_wrap_abstract(view); | ||||
| } | ||||
|  | ||||
| static JanetTArrayView *ta_is_view(Janet x) { | ||||
|     if (!janet_checktype(x, JANET_ABSTRACT)) return NULL; | ||||
|     void *abst = janet_unwrap_abstract(x); | ||||
|     if (janet_abstract_type(abst) != &ta_view_type) return NULL; | ||||
|     return (JanetTArrayView *)abst; | ||||
| } | ||||
|  | ||||
| static Janet cfun_typed_array_buffer(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetTArrayView *view; | ||||
|     if ((view = ta_is_view(argv[0]))) { | ||||
|         return janet_wrap_abstract(view->buffer); | ||||
|     } | ||||
|     size_t size = janet_getsize(argv, 0); | ||||
|     JanetTArrayBuffer *buf = janet_tarray_buffer(size); | ||||
|     return janet_wrap_abstract(buf); | ||||
| } | ||||
|  | ||||
| static Janet cfun_typed_array_size(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetTArrayView *view; | ||||
|     if ((view = ta_is_view(argv[0]))) { | ||||
|         return janet_wrap_number((double) view->size); | ||||
|     } | ||||
|     JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &ta_buffer_type); | ||||
|     return janet_wrap_number((double) buf->size); | ||||
| } | ||||
|  | ||||
| static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) { | ||||
|     janet_fixarity(argc, 1); | ||||
|     JanetTArrayView *view; | ||||
|     if ((view = ta_is_view(argv[0]))) { | ||||
|         JanetTArrayView *view = janet_unwrap_abstract(argv[0]); | ||||
|         JanetKV *props = janet_struct_begin(6); | ||||
|         ptrdiff_t boffset = view->as.u8 - view->buffer->data; | ||||
|         janet_struct_put(props, janet_ckeywordv("size"), | ||||
|                          janet_wrap_number((double) view->size)); | ||||
|         janet_struct_put(props, janet_ckeywordv("byte-offset"), | ||||
|                          janet_wrap_number((double) boffset)); | ||||
|         janet_struct_put(props, janet_ckeywordv("stride"), | ||||
|                          janet_wrap_number((double) view->stride)); | ||||
|         janet_struct_put(props, janet_ckeywordv("type"), | ||||
|                          janet_ckeywordv(ta_type_names[view->type])); | ||||
|         janet_struct_put(props, janet_ckeywordv("type-size"), | ||||
|                          janet_wrap_number((double) ta_type_sizes[view->type])); | ||||
|         janet_struct_put(props, janet_ckeywordv("buffer"), | ||||
|                          janet_wrap_abstract(view->buffer)); | ||||
|         return janet_wrap_struct(janet_struct_end(props)); | ||||
|     } else { | ||||
|         JanetTArrayBuffer *buffer = janet_gettarray_buffer(argv, 0); | ||||
|         JanetKV *props = janet_struct_begin(2); | ||||
|         janet_struct_put(props, janet_ckeywordv("size"), | ||||
|                          janet_wrap_number((double) buffer->size)); | ||||
|         janet_struct_put(props, janet_ckeywordv("big-endian"), | ||||
|                          janet_wrap_boolean(buffer->flags & TA_FLAG_BIG_ENDIAN)); | ||||
|         return janet_wrap_struct(janet_struct_end(props)); | ||||
|     } | ||||
| } | ||||
|  | ||||
| static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 1, 3); | ||||
|     JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type); | ||||
|     JanetRange range; | ||||
|     int32_t length = (int32_t)src->size; | ||||
|     if (argc == 1) { | ||||
|         range.start = 0; | ||||
|         range.end = length; | ||||
|     } else if (argc == 2) { | ||||
|         range.start = janet_gethalfrange(argv, 1, length, "start"); | ||||
|         range.end = length; | ||||
|     } else { | ||||
|         range.start = janet_gethalfrange(argv, 1, length, "start"); | ||||
|         range.end = janet_gethalfrange(argv, 2, length, "end"); | ||||
|         if (range.end < range.start) | ||||
|             range.end = range.start; | ||||
|     } | ||||
|     JanetArray *array = janet_array(range.end - range.start); | ||||
|     if (array->data) { | ||||
|         for (int32_t i = range.start; i < range.end; i++) { | ||||
|             array->data[i - range.start] = ta_getter(src, janet_wrap_number(i)); | ||||
|         } | ||||
|     } | ||||
|     array->count = range.end - range.start; | ||||
|     return janet_wrap_array(array); | ||||
| } | ||||
|  | ||||
| static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 4, 5); | ||||
|     JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type); | ||||
|     size_t index_src = janet_getsize(argv, 1); | ||||
|     JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type); | ||||
|     size_t index_dst = janet_getsize(argv, 3); | ||||
|     size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1; | ||||
|     size_t src_atom_size = ta_type_sizes[src->type]; | ||||
|     size_t dst_atom_size = ta_type_sizes[dst->type]; | ||||
|     size_t step_src = src->stride * src_atom_size; | ||||
|     size_t step_dst = dst->stride * dst_atom_size; | ||||
|     size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src); | ||||
|     size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst); | ||||
|     uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst; | ||||
|     if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) && | ||||
|             (pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) { | ||||
|         for (size_t i = 0; i < count; i++) { | ||||
|             memmove(pd, ps, src_atom_size); | ||||
|             pd += step_dst; | ||||
|             ps += step_src; | ||||
|         } | ||||
|     } else { | ||||
|         janet_panic("typed array copy out of bounds"); | ||||
|     } | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) { | ||||
|     janet_arity(argc, 4, 5); | ||||
|     JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type); | ||||
|     size_t index_src = janet_getsize(argv, 1); | ||||
|     JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type); | ||||
|     size_t index_dst = janet_getsize(argv, 3); | ||||
|     size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1; | ||||
|     size_t src_atom_size = ta_type_sizes[src->type]; | ||||
|     size_t dst_atom_size = ta_type_sizes[dst->type]; | ||||
|     size_t step_src = src->stride * src_atom_size; | ||||
|     size_t step_dst = dst->stride * dst_atom_size; | ||||
|     size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src); | ||||
|     size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst); | ||||
|     uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst; | ||||
|     uint8_t temp[TA_ATOM_MAXSIZE]; | ||||
|     if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) && | ||||
|             (pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) { | ||||
|         for (size_t i = 0; i < count; i++) { | ||||
|             memcpy(temp, ps, src_atom_size); | ||||
|             memcpy(ps, pd, src_atom_size); | ||||
|             memcpy(pd, temp, src_atom_size); | ||||
|             pd += step_dst; | ||||
|             ps += step_src; | ||||
|         } | ||||
|     } else { | ||||
|         janet_panic("typed array swap out of bounds"); | ||||
|     } | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| static const JanetReg ta_cfuns[] = { | ||||
|     { | ||||
|         "tarray/new", cfun_typed_array_new, | ||||
|         JDOC("(tarray/new type size [stride = 1 [offset = 0 [tarray | buffer]]] )\n\n" | ||||
|              "Create new typed array.") | ||||
|     }, | ||||
|     { | ||||
|         "tarray/buffer", cfun_typed_array_buffer, | ||||
|         JDOC("(tarray/buffer (array | size) )\n\n" | ||||
|              "Return typed array buffer or create a new buffer.") | ||||
|     }, | ||||
|     { | ||||
|         "tarray/length", cfun_typed_array_size, | ||||
|         JDOC("(tarray/length (array | buffer) )\n\n" | ||||
|              "Return typed array or buffer size.") | ||||
|     }, | ||||
|     { | ||||
|         "tarray/properties", cfun_typed_array_properties, | ||||
|         JDOC("(tarray/properties array )\n\n" | ||||
|              "Return typed array properties as a struct.") | ||||
|     }, | ||||
|     { | ||||
|         "tarray/copy-bytes", cfun_typed_array_copy_bytes, | ||||
|         JDOC("(tarray/copy-bytes src sindex dst dindex [count=1])\n\n" | ||||
|              "Copy count elements of src array from index sindex " | ||||
|              "to dst array at position dindex " | ||||
|              "memory can overlap.") | ||||
|     }, | ||||
|     { | ||||
|         "tarray/swap-bytes", cfun_typed_array_swap_bytes, | ||||
|         JDOC("(tarray/swap-bytes src sindex dst dindex [count=1])\n\n" | ||||
|              "Swap count elements between src array from index sindex " | ||||
|              "and dst array at position dindex " | ||||
|              "memory can overlap.") | ||||
|     }, | ||||
|     { | ||||
|         "tarray/slice", cfun_typed_array_slice, | ||||
|         JDOC("(tarray/slice tarr [, start=0 [, end=(size tarr)]])\n\n" | ||||
|              "Takes a slice of a typed array from start to end. The range is half " | ||||
|              "open, [start, end). Indexes can also be negative, indicating indexing " | ||||
|              "from the end of the end of the typed array. By default, start is 0 and end is " | ||||
|              "the size of the typed array. Returns a new janet array.") | ||||
|     }, | ||||
|     {NULL, NULL, NULL} | ||||
| }; | ||||
|  | ||||
| /* Module entry point */ | ||||
| void janet_lib_typed_array(JanetTable *env) { | ||||
|     janet_core_cfuns(env, NULL, ta_cfuns); | ||||
|     janet_register_abstract_type(&ta_buffer_type); | ||||
|     janet_register_abstract_type(&ta_view_type); | ||||
| } | ||||
|  | ||||
| #endif | ||||
							
								
								
									
										474
									
								
								src/core/util.c
									
									
									
									
									
								
							
							
						
						
									
										474
									
								
								src/core/util.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -20,23 +20,14 @@ | ||||
| * IN THE SOFTWARE. | ||||
| */ | ||||
|  | ||||
| #include <inttypes.h> | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include "util.h" | ||||
| #include "state.h" | ||||
| #include "gc.h" | ||||
| #ifdef JANET_WINDOWS | ||||
| #include <windows.h> | ||||
| #else | ||||
| #include <unistd.h> | ||||
| #include <sys/types.h> | ||||
| #include <sys/stat.h> | ||||
| #include <fcntl.h> | ||||
| #endif | ||||
| #endif | ||||
|  | ||||
| #include <inttypes.h> | ||||
|  | ||||
| /* Base 64 lookup table for digits */ | ||||
| const char janet_base64[65] = | ||||
| @@ -102,7 +93,7 @@ const char *const janet_status_names[16] = { | ||||
|     "alive" | ||||
| }; | ||||
|  | ||||
| #ifndef JANET_PRF | ||||
| /* Calculate hash for string */ | ||||
|  | ||||
| int32_t janet_string_calchash(const uint8_t *str, int32_t len) { | ||||
|     const uint8_t *end = str + len; | ||||
| @@ -112,136 +103,22 @@ int32_t janet_string_calchash(const uint8_t *str, int32_t len) { | ||||
|     return (int32_t) hash; | ||||
| } | ||||
|  | ||||
| #else | ||||
|  | ||||
| /* | ||||
|   Public domain siphash implementation sourced from: | ||||
|  | ||||
|   https://raw.githubusercontent.com/veorq/SipHash/master/halfsiphash.c | ||||
|  | ||||
|   We have made a few alterations, such as hardcoding the output size | ||||
|   and then removing dead code. | ||||
| */ | ||||
| #define cROUNDS 2 | ||||
| #define dROUNDS 4 | ||||
|  | ||||
| #define ROTL(x, b) (uint32_t)(((x) << (b)) | ((x) >> (32 - (b)))) | ||||
|  | ||||
| #define U8TO32_LE(p)                                                           \ | ||||
|     (((uint32_t)((p)[0])) | ((uint32_t)((p)[1]) << 8) |                        \ | ||||
|      ((uint32_t)((p)[2]) << 16) | ((uint32_t)((p)[3]) << 24)) | ||||
|  | ||||
| #define SIPROUND                                                               \ | ||||
|     do {                                                                       \ | ||||
|         v0 += v1;                                                              \ | ||||
|         v1 = ROTL(v1, 5);                                                      \ | ||||
|         v1 ^= v0;                                                              \ | ||||
|         v0 = ROTL(v0, 16);                                                     \ | ||||
|         v2 += v3;                                                              \ | ||||
|         v3 = ROTL(v3, 8);                                                      \ | ||||
|         v3 ^= v2;                                                              \ | ||||
|         v0 += v3;                                                              \ | ||||
|         v3 = ROTL(v3, 7);                                                      \ | ||||
|         v3 ^= v0;                                                              \ | ||||
|         v2 += v1;                                                              \ | ||||
|         v1 = ROTL(v1, 13);                                                     \ | ||||
|         v1 ^= v2;                                                              \ | ||||
|         v2 = ROTL(v2, 16);                                                     \ | ||||
|     } while (0) | ||||
|  | ||||
| static uint32_t halfsiphash(const uint8_t *in, const size_t inlen, const uint8_t *k) { | ||||
|  | ||||
|     uint32_t v0 = 0; | ||||
|     uint32_t v1 = 0; | ||||
|     uint32_t v2 = UINT32_C(0x6c796765); | ||||
|     uint32_t v3 = UINT32_C(0x74656462); | ||||
|     uint32_t k0 = U8TO32_LE(k); | ||||
|     uint32_t k1 = U8TO32_LE(k + 4); | ||||
|     uint32_t m; | ||||
|     int i; | ||||
|     const uint8_t *end = in + inlen - (inlen % sizeof(uint32_t)); | ||||
|     const int left = inlen & 3; | ||||
|     uint32_t b = ((uint32_t)inlen) << 24; | ||||
|     v3 ^= k1; | ||||
|     v2 ^= k0; | ||||
|     v1 ^= k1; | ||||
|     v0 ^= k0; | ||||
|  | ||||
|     for (; in != end; in += 4) { | ||||
|         m = U8TO32_LE(in); | ||||
|         v3 ^= m; | ||||
|  | ||||
|         for (i = 0; i < cROUNDS; ++i) | ||||
|             SIPROUND; | ||||
|  | ||||
|         v0 ^= m; | ||||
|     } | ||||
|  | ||||
|     switch (left) { | ||||
|         case 3: | ||||
|             b |= ((uint32_t)in[2]) << 16; | ||||
|         /* fallthrough */ | ||||
|         case 2: | ||||
|             b |= ((uint32_t)in[1]) << 8; | ||||
|         /* fallthrough */ | ||||
|         case 1: | ||||
|             b |= ((uint32_t)in[0]); | ||||
|             break; | ||||
|         case 0: | ||||
|             break; | ||||
|     } | ||||
|  | ||||
|     v3 ^= b; | ||||
|  | ||||
|     for (i = 0; i < cROUNDS; ++i) | ||||
|         SIPROUND; | ||||
|  | ||||
|     v0 ^= b; | ||||
|  | ||||
|     v2 ^= 0xff; | ||||
|  | ||||
|     for (i = 0; i < dROUNDS; ++i) | ||||
|         SIPROUND; | ||||
|  | ||||
|     b = v1 ^ v3; | ||||
|     return b; | ||||
| } | ||||
| /* end of siphash */ | ||||
|  | ||||
| static uint8_t hash_key[JANET_HASH_KEY_SIZE] = {0}; | ||||
|  | ||||
| void janet_init_hash_key(uint8_t new_key[JANET_HASH_KEY_SIZE]) { | ||||
|     memcpy(hash_key, new_key, sizeof(hash_key)); | ||||
| } | ||||
|  | ||||
| /* Calculate hash for string */ | ||||
|  | ||||
| int32_t janet_string_calchash(const uint8_t *str, int32_t len) { | ||||
|     uint32_t hash; | ||||
|     hash = halfsiphash(str, len, hash_key); | ||||
|     return (int32_t)hash; | ||||
| } | ||||
|  | ||||
| #endif | ||||
|  | ||||
| /* Computes hash of an array of values */ | ||||
| int32_t janet_array_calchash(const Janet *array, int32_t len) { | ||||
|     const Janet *end = array + len; | ||||
|     uint32_t hash = 0; | ||||
|     while (array < end) { | ||||
|         uint32_t elem = janet_hash(*array++); | ||||
|         hash ^= elem + 0x9e3779b9 + (hash << 6) + (hash >> 2); | ||||
|     } | ||||
|     uint32_t hash = 5381; | ||||
|     while (array < end) | ||||
|         hash = (hash << 5) + hash + janet_hash(*array++); | ||||
|     return (int32_t) hash; | ||||
| } | ||||
|  | ||||
| /* Computes hash of an array of values */ | ||||
| int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) { | ||||
|     const JanetKV *end = kvs + len; | ||||
|     uint32_t hash = 0; | ||||
|     uint32_t hash = 5381; | ||||
|     while (kvs < end) { | ||||
|         hash ^= janet_hash(kvs->key) + 0x9e3779b9 + (hash << 6) + (hash >> 2); | ||||
|         hash ^= janet_hash(kvs->value) + 0x9e3779b9 + (hash << 6) + (hash >> 2); | ||||
|         hash = (hash << 5) + hash + janet_hash(kvs->key); | ||||
|         hash = (hash << 5) + hash + janet_hash(kvs->value); | ||||
|         kvs++; | ||||
|     } | ||||
|     return (int32_t) hash; | ||||
| @@ -258,12 +135,6 @@ int32_t janet_tablen(int32_t n) { | ||||
|     return n + 1; | ||||
| } | ||||
|  | ||||
| /* Avoid some undefined behavior that was common in the code base. */ | ||||
| void safe_memcpy(void *dest, const void *src, size_t len) { | ||||
|     if (!len) return; | ||||
|     memcpy(dest, src, len); | ||||
| } | ||||
|  | ||||
| /* Helper to find a value in a Janet struct or table. Returns the bucket | ||||
|  * containing the key, or the first empty bucket if there is no such key. */ | ||||
| const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key) { | ||||
| @@ -390,90 +261,88 @@ void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) { | ||||
| } | ||||
|  | ||||
| /* Load many cfunctions at once */ | ||||
| static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns, int defprefix) { | ||||
|     uint8_t *longname_buffer = NULL; | ||||
|     size_t prefixlen = 0; | ||||
|     size_t bufsize = 0; | ||||
|     if (NULL != regprefix) { | ||||
|         prefixlen = strlen(regprefix); | ||||
|         bufsize = prefixlen + 256; | ||||
|         longname_buffer = janet_malloc(bufsize); | ||||
|         if (NULL == longname_buffer) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|         safe_memcpy(longname_buffer, regprefix, prefixlen); | ||||
|         longname_buffer[prefixlen] = '/'; | ||||
|         prefixlen++; | ||||
|     } | ||||
| void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) { | ||||
|     while (cfuns->name) { | ||||
|         Janet name; | ||||
|         if (NULL != regprefix) { | ||||
|         Janet name = janet_csymbolv(cfuns->name); | ||||
|         Janet longname = name; | ||||
|         if (regprefix) { | ||||
|             int32_t reglen = 0; | ||||
|             int32_t nmlen = 0; | ||||
|             while (regprefix[reglen]) reglen++; | ||||
|             while (cfuns->name[nmlen]) nmlen++; | ||||
|             int32_t totallen = (int32_t) prefixlen + nmlen; | ||||
|             if ((size_t) totallen > bufsize) { | ||||
|                 bufsize = (size_t)(totallen) + 128; | ||||
|                 longname_buffer = janet_realloc(longname_buffer, bufsize); | ||||
|                 if (NULL == longname_buffer) { | ||||
|                     JANET_OUT_OF_MEMORY; | ||||
|                 } | ||||
|             } | ||||
|             safe_memcpy(longname_buffer + prefixlen, cfuns->name, nmlen); | ||||
|             name = janet_wrap_symbol(janet_symbol(longname_buffer, totallen)); | ||||
|         } else { | ||||
|             name = janet_csymbolv(cfuns->name); | ||||
|             int32_t symlen = reglen + 1 + nmlen; | ||||
|             uint8_t *longname_buffer = malloc(symlen); | ||||
|             memcpy(longname_buffer, regprefix, reglen); | ||||
|             longname_buffer[reglen] = '/'; | ||||
|             memcpy(longname_buffer + reglen + 1, cfuns->name, nmlen); | ||||
|             longname = janet_wrap_symbol(janet_symbol(longname_buffer, symlen)); | ||||
|             free(longname_buffer); | ||||
|         } | ||||
|         Janet fun = janet_wrap_cfunction(cfuns->cfun); | ||||
|         if (defprefix) { | ||||
|             JanetTable *subt = janet_table(2); | ||||
|             janet_table_put(subt, janet_ckeywordv("value"), fun); | ||||
|             if (cfuns->documentation) | ||||
|                 janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(cfuns->documentation)); | ||||
|             janet_table_put(env, name, janet_wrap_table(subt)); | ||||
|         } else { | ||||
|             janet_def(env, cfuns->name, fun, cfuns->documentation); | ||||
|         } | ||||
|         janet_table_put(janet_vm_registry, fun, name); | ||||
|         janet_def(env, cfuns->name, fun, cfuns->documentation); | ||||
|         janet_table_put(janet_vm_registry, fun, longname); | ||||
|         cfuns++; | ||||
|     } | ||||
|     (janet_free)(longname_buffer); | ||||
| } | ||||
|  | ||||
| void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) { | ||||
|     _janet_cfuns_prefix(env, regprefix, cfuns, 1); | ||||
| } | ||||
|  | ||||
| void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) { | ||||
|     _janet_cfuns_prefix(env, regprefix, cfuns, 0); | ||||
| } | ||||
|  | ||||
| /* Abstract type introspection */ | ||||
|  | ||||
| static const JanetAbstractType type_wrap = { | ||||
|     "core/type-info", | ||||
|     NULL, | ||||
|     NULL, | ||||
|     NULL, | ||||
|     NULL, | ||||
|     NULL, | ||||
|     NULL, | ||||
|     NULL | ||||
| }; | ||||
|  | ||||
| typedef struct { | ||||
|     const JanetAbstractType *at; | ||||
| } JanetAbstractTypeWrap; | ||||
|  | ||||
| void janet_register_abstract_type(const JanetAbstractType *at) { | ||||
|     JanetAbstractTypeWrap *abstract = (JanetAbstractTypeWrap *) | ||||
|                                       janet_abstract(&type_wrap, sizeof(JanetAbstractTypeWrap)); | ||||
|     abstract->at = at; | ||||
|     Janet sym = janet_csymbolv(at->name); | ||||
|     Janet check = janet_table_get(janet_vm_abstract_registry, sym); | ||||
|     if (!janet_checktype(check, JANET_NIL) && at != janet_unwrap_pointer(check)) { | ||||
|     if (!(janet_checktype(janet_table_get(janet_vm_registry, sym), JANET_NIL))) { | ||||
|         janet_panicf("cannot register abstract type %s, " | ||||
|                      "a type with the same name exists", at->name); | ||||
|     } | ||||
|     janet_table_put(janet_vm_abstract_registry, sym, janet_wrap_pointer((void *) at)); | ||||
|     janet_table_put(janet_vm_registry, sym, janet_wrap_abstract(abstract)); | ||||
| } | ||||
|  | ||||
| const JanetAbstractType *janet_get_abstract_type(Janet key) { | ||||
|     Janet wrapped = janet_table_get(janet_vm_abstract_registry, key); | ||||
|     if (janet_checktype(wrapped, JANET_NIL)) { | ||||
|     Janet twrap = janet_table_get(janet_vm_registry, key); | ||||
|     if (janet_checktype(twrap, JANET_NIL)) { | ||||
|         return NULL; | ||||
|     } | ||||
|     return (JanetAbstractType *)(janet_unwrap_pointer(wrapped)); | ||||
|     if (!janet_checktype(twrap, JANET_ABSTRACT) || | ||||
|             (janet_abstract_type(janet_unwrap_abstract(twrap)) != &type_wrap)) { | ||||
|         janet_panic("expected abstract type"); | ||||
|     } | ||||
|     JanetAbstractTypeWrap *w = (JanetAbstractTypeWrap *)janet_unwrap_abstract(twrap); | ||||
|     return w->at; | ||||
| } | ||||
|  | ||||
| #ifndef JANET_BOOTSTRAP | ||||
| void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p) { | ||||
|     (void) p; | ||||
|     Janet key = janet_csymbolv(name); | ||||
|     janet_table_put(env, key, x); | ||||
|     if (janet_checktype(x, JANET_CFUNCTION)) { | ||||
|         janet_table_put(janet_vm_registry, x, key); | ||||
|     Janet value; | ||||
|     /* During init, allow replacing core library cfunctions with values from | ||||
|      * the env. */ | ||||
|     Janet check = janet_table_get(env, key); | ||||
|     if (janet_checktype(check, JANET_NIL)) { | ||||
|         value = x; | ||||
|     } else { | ||||
|         value = check; | ||||
|     } | ||||
|     janet_table_put(env, key, value); | ||||
|     if (janet_checktype(value, JANET_CFUNCTION)) { | ||||
|         janet_table_put(janet_vm_registry, value, key); | ||||
|     } | ||||
| } | ||||
|  | ||||
| @@ -487,68 +356,27 @@ void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cf | ||||
| } | ||||
| #endif | ||||
|  | ||||
| JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) { | ||||
| /* Resolve a symbol in the environment */ | ||||
| JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) { | ||||
|     Janet ref; | ||||
|     JanetTable *entry_table; | ||||
|     Janet entry = janet_table_get(env, janet_wrap_symbol(sym)); | ||||
|     JanetBinding binding = { | ||||
|         JANET_BINDING_NONE, | ||||
|         janet_wrap_nil(), | ||||
|         JANET_BINDING_DEP_NONE | ||||
|     }; | ||||
|  | ||||
|     /* Check environment for entry */ | ||||
|     if (!janet_checktype(entry, JANET_TABLE)) | ||||
|         return binding; | ||||
|         return JANET_BINDING_NONE; | ||||
|     entry_table = janet_unwrap_table(entry); | ||||
|  | ||||
|     /* deprecation check */ | ||||
|     Janet deprecate = janet_table_get(entry_table, janet_ckeywordv("deprecated")); | ||||
|     if (janet_checktype(deprecate, JANET_KEYWORD)) { | ||||
|         JanetKeyword depkw = janet_unwrap_keyword(deprecate); | ||||
|         if (!janet_cstrcmp(depkw, "relaxed")) { | ||||
|             binding.deprecation = JANET_BINDING_DEP_RELAXED; | ||||
|         } else if (!janet_cstrcmp(depkw, "normal")) { | ||||
|             binding.deprecation = JANET_BINDING_DEP_NORMAL; | ||||
|         } else if (!janet_cstrcmp(depkw, "strict")) { | ||||
|             binding.deprecation = JANET_BINDING_DEP_STRICT; | ||||
|         } | ||||
|     } else if (!janet_checktype(deprecate, JANET_NIL)) { | ||||
|         binding.deprecation = JANET_BINDING_DEP_NORMAL; | ||||
|     } | ||||
|  | ||||
|     if (!janet_checktype( | ||||
|                 janet_table_get(entry_table, janet_ckeywordv("macro")), | ||||
|                 JANET_NIL)) { | ||||
|         binding.value = janet_table_get(entry_table, janet_ckeywordv("value")); | ||||
|         binding.type = JANET_BINDING_MACRO; | ||||
|         return binding; | ||||
|         *out = janet_table_get(entry_table, janet_ckeywordv("value")); | ||||
|         return JANET_BINDING_MACRO; | ||||
|     } | ||||
|  | ||||
|     ref = janet_table_get(entry_table, janet_ckeywordv("ref")); | ||||
|     if (janet_checktype(ref, JANET_ARRAY)) { | ||||
|         binding.value = ref; | ||||
|         binding.type = JANET_BINDING_VAR; | ||||
|         return binding; | ||||
|         *out = ref; | ||||
|         return JANET_BINDING_VAR; | ||||
|     } | ||||
|  | ||||
|     binding.value = janet_table_get(entry_table, janet_ckeywordv("value")); | ||||
|     binding.type = JANET_BINDING_DEF; | ||||
|     return binding; | ||||
| } | ||||
|  | ||||
| JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) { | ||||
|     JanetBinding binding = janet_resolve_ext(env, sym); | ||||
|     *out = binding.value; | ||||
|     return binding.type; | ||||
| } | ||||
|  | ||||
| /* Resolve a symbol in the core environment. */ | ||||
| Janet janet_resolve_core(const char *name) { | ||||
|     JanetTable *env = janet_core_env(NULL); | ||||
|     Janet out = janet_wrap_nil(); | ||||
|     janet_resolve(env, janet_csymbol(name), &out); | ||||
|     return out; | ||||
|     *out = janet_table_get(entry_table, janet_ckeywordv("value")); | ||||
|     return JANET_BINDING_DEF; | ||||
| } | ||||
|  | ||||
| /* Read both tuples and arrays as c pointers + int32_t length. Return 1 if the | ||||
| @@ -618,156 +446,6 @@ int janet_checksize(Janet x) { | ||||
|     if (!janet_checktype(x, JANET_NUMBER)) | ||||
|         return 0; | ||||
|     double dval = janet_unwrap_number(x); | ||||
|     if (dval != (double)((size_t) dval)) return 0; | ||||
|     if (SIZE_MAX > JANET_INTMAX_INT64) { | ||||
|         return dval <= JANET_INTMAX_INT64; | ||||
|     } else { | ||||
|         return dval <= SIZE_MAX; | ||||
|     } | ||||
| } | ||||
|  | ||||
| JanetTable *janet_get_core_table(const char *name) { | ||||
|     JanetTable *env = janet_core_env(NULL); | ||||
|     Janet out = janet_wrap_nil(); | ||||
|     JanetBindingType bt = janet_resolve(env, janet_csymbol(name), &out); | ||||
|     if (bt == JANET_BINDING_NONE) return NULL; | ||||
|     if (!janet_checktype(out, JANET_TABLE)) return NULL; | ||||
|     return janet_unwrap_table(out); | ||||
| } | ||||
|  | ||||
| /* Sort keys of a dictionary type */ | ||||
| int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *index_buffer) { | ||||
|  | ||||
|     /* First, put populated indices into index_buffer */ | ||||
|     int32_t next_index = 0; | ||||
|     for (int32_t i = 0; i < cap; i++) { | ||||
|         if (!janet_checktype(dict[i].key, JANET_NIL)) { | ||||
|             index_buffer[next_index++] = i; | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     /* Next, sort those (simple insertion sort here for now) */ | ||||
|     for (int32_t i = 1; i < next_index; i++) { | ||||
|         int32_t index_to_insert = index_buffer[i]; | ||||
|         Janet lhs = dict[index_to_insert].key; | ||||
|         for (int32_t j = i - 1; j >= 0; j--) { | ||||
|             index_buffer[j + 1] = index_buffer[j]; | ||||
|             Janet rhs = dict[index_buffer[j]].key; | ||||
|             if (janet_compare(lhs, rhs) >= 0) { | ||||
|                 index_buffer[j + 1] = index_to_insert; | ||||
|                 break; | ||||
|             } else if (j == 0) { | ||||
|                 index_buffer[0] = index_to_insert; | ||||
|             } | ||||
|         } | ||||
|     } | ||||
|  | ||||
|     /* Return number of indices found */ | ||||
|     return next_index; | ||||
|  | ||||
| } | ||||
|  | ||||
| /* Clock shims for various platforms */ | ||||
| #ifdef JANET_GETTIME | ||||
| /* For macos */ | ||||
| #ifdef __MACH__ | ||||
| #include <mach/clock.h> | ||||
| #include <mach/mach.h> | ||||
| #endif | ||||
| #ifdef JANET_WINDOWS | ||||
| int janet_gettime(struct timespec *spec) { | ||||
|     FILETIME ftime; | ||||
|     GetSystemTimeAsFileTime(&ftime); | ||||
|     int64_t wintime = (int64_t)(ftime.dwLowDateTime) | ((int64_t)(ftime.dwHighDateTime) << 32); | ||||
|     /* Windows epoch is January 1, 1601 apparently */ | ||||
|     wintime -= 116444736000000000LL; | ||||
|     spec->tv_sec  = wintime / 10000000LL; | ||||
|     /* Resolution is 100 nanoseconds. */ | ||||
|     spec->tv_nsec = wintime % 10000000LL * 100; | ||||
|     return 0; | ||||
| } | ||||
| #elif defined(__MACH__) | ||||
| int janet_gettime(struct timespec *spec) { | ||||
|     clock_serv_t cclock; | ||||
|     mach_timespec_t mts; | ||||
|     host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock); | ||||
|     clock_get_time(cclock, &mts); | ||||
|     mach_port_deallocate(mach_task_self(), cclock); | ||||
|     spec->tv_sec = mts.tv_sec; | ||||
|     spec->tv_nsec = mts.tv_nsec; | ||||
|     return 0; | ||||
| } | ||||
| #else | ||||
| int janet_gettime(struct timespec *spec) { | ||||
|     return clock_gettime(CLOCK_REALTIME, spec); | ||||
| } | ||||
| #endif | ||||
| #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) | ||||
| void arc4random_buf(void *buf, size_t nbytes); | ||||
| #endif | ||||
|  | ||||
| int janet_cryptorand(uint8_t *out, size_t n) { | ||||
| #ifdef JANET_WINDOWS | ||||
|     for (size_t i = 0; i < n; i += sizeof(unsigned int)) { | ||||
|         unsigned int v; | ||||
|         if (rand_s(&v)) | ||||
|             return -1; | ||||
|         for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < n); j++) { | ||||
|             out[i + j] = v & 0xff; | ||||
|             v = v >> 8; | ||||
|         } | ||||
|     } | ||||
|     return 0; | ||||
| #elif defined(JANET_LINUX) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) ) | ||||
|     /* 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. | ||||
|        In these cases, use this fallback path for now... */ | ||||
|     int rc; | ||||
|     int randfd; | ||||
|     RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY | O_CLOEXEC)); | ||||
|     if (randfd < 0) | ||||
|         return -1; | ||||
|     while (n > 0) { | ||||
|         ssize_t nread; | ||||
|         RETRY_EINTR(nread, read(randfd, out, n)); | ||||
|         if (nread <= 0) { | ||||
|             RETRY_EINTR(rc, close(randfd)); | ||||
|             return -1; | ||||
|         } | ||||
|         out += nread; | ||||
|         n -= nread; | ||||
|     } | ||||
|     RETRY_EINTR(rc, close(randfd)); | ||||
|     return 0; | ||||
| #elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7) | ||||
|     arc4random_buf(out, n); | ||||
|     return 0; | ||||
| #else | ||||
|     (void) n; | ||||
|     (void) out; | ||||
|     return -1; | ||||
| #endif | ||||
| } | ||||
|  | ||||
|  | ||||
| /* Alloc function macro fills */ | ||||
| void *(janet_malloc)(size_t size) { | ||||
|     return janet_malloc(size); | ||||
| } | ||||
|  | ||||
| void (janet_free)(void *ptr) { | ||||
|     janet_free(ptr); | ||||
| } | ||||
|  | ||||
| void *(janet_calloc)(size_t nmemb, size_t size) { | ||||
|     return janet_calloc(nmemb, size); | ||||
| } | ||||
|  | ||||
| void *(janet_realloc)(void *ptr, size_t size) { | ||||
|     return janet_realloc(ptr, size); | ||||
|     return dval == (double)((size_t) dval) && | ||||
|            dval <= SIZE_MAX; | ||||
| } | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -24,23 +24,14 @@ | ||||
| #define JANET_UTIL_H_defined | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #endif | ||||
|  | ||||
| #include <stdio.h> | ||||
| #include <errno.h> | ||||
|  | ||||
| #if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED) | ||||
| #include <time.h> | ||||
| #define JANET_GETTIME | ||||
| #endif | ||||
|  | ||||
| /* Handle runtime errors */ | ||||
| #ifndef JANET_EXIT | ||||
| #ifndef janet_exit | ||||
| #include <stdio.h> | ||||
| #define JANET_EXIT(m) do { \ | ||||
|     fprintf(stderr, "C runtime error at line %d in file %s: %s\n",\ | ||||
| #define janet_exit(m) do { \ | ||||
|     printf("C runtime error at line %d in file %s: %s\n",\ | ||||
|         __LINE__,\ | ||||
|         __FILE__,\ | ||||
|         (m));\ | ||||
| @@ -49,9 +40,15 @@ | ||||
| #endif | ||||
|  | ||||
| #define janet_assert(c, m) do { \ | ||||
|     if (!(c)) JANET_EXIT((m)); \ | ||||
|     if (!(c)) janet_exit((m)); \ | ||||
| } while (0) | ||||
|  | ||||
| /* What to do when out of memory */ | ||||
| #ifndef JANET_OUT_OF_MEMORY | ||||
| #include <stdio.h> | ||||
| #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) | ||||
| #endif | ||||
|  | ||||
| /* Omit docstrings in some builds */ | ||||
| #ifndef JANET_BOOTSTRAP | ||||
| #define JDOC(x) NULL | ||||
| @@ -67,13 +64,11 @@ int32_t janet_array_calchash(const Janet *array, int32_t len); | ||||
| int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len); | ||||
| int32_t janet_string_calchash(const uint8_t *str, int32_t len); | ||||
| int32_t janet_tablen(int32_t n); | ||||
| void safe_memcpy(void *dest, const void *src, size_t len); | ||||
| void janet_buffer_push_types(JanetBuffer *buffer, int types); | ||||
| const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key); | ||||
| Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key); | ||||
| 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); | ||||
| const void *janet_strbinsearch( | ||||
|     const void *tab, | ||||
|     size_t tabcount, | ||||
| @@ -85,7 +80,6 @@ void janet_buffer_format( | ||||
|     int32_t argstart, | ||||
|     int32_t argc, | ||||
|     Janet *argv); | ||||
| Janet janet_next_impl(Janet ds, Janet key, int is_interpreter); | ||||
|  | ||||
| /* Inside the janet core, defining globals is different | ||||
|  * at bootstrap time and normal runtime */ | ||||
| @@ -97,18 +91,6 @@ void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p); | ||||
| void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns); | ||||
| #endif | ||||
|  | ||||
| /* Clock gettime */ | ||||
| #ifdef JANET_GETTIME | ||||
| int janet_gettime(struct timespec *spec); | ||||
| #endif | ||||
|  | ||||
| /* strdup */ | ||||
| #ifdef JANET_WINDOWS | ||||
| #define strdup(x) _strdup(x) | ||||
| #endif | ||||
|  | ||||
| #define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR) | ||||
|  | ||||
| /* Initialize builtin libraries */ | ||||
| void janet_lib_io(JanetTable *env); | ||||
| void janet_lib_math(JanetTable *env); | ||||
| @@ -135,17 +117,5 @@ void janet_lib_typed_array(JanetTable *env); | ||||
| #ifdef JANET_INT_TYPES | ||||
| void janet_lib_inttypes(JanetTable *env); | ||||
| #endif | ||||
| #ifdef JANET_THREADS | ||||
| void janet_lib_thread(JanetTable *env); | ||||
| #endif | ||||
| #ifdef JANET_NET | ||||
| void janet_lib_net(JanetTable *env); | ||||
| extern const JanetAbstractType janet_address_type; | ||||
| #endif | ||||
| #ifdef JANET_EV | ||||
| void janet_lib_ev(JanetTable *env); | ||||
| void janet_ev_mark(void); | ||||
| int janet_make_pipe(JanetHandle handles[2], int mode); | ||||
| #endif | ||||
|  | ||||
| #endif | ||||
|   | ||||
							
								
								
									
										566
									
								
								src/core/value.c
									
									
									
									
									
								
							
							
						
						
									
										566
									
								
								src/core/value.c
									
									
									
									
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,268 +21,45 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include "util.h" | ||||
| #include "state.h" | ||||
| #include "gc.h" | ||||
| #include "fiber.h" | ||||
| #include <janet.h> | ||||
| #endif | ||||
|  | ||||
| #include <math.h> | ||||
|  | ||||
| JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal = NULL; | ||||
| JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top = NULL; | ||||
| JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base = NULL; | ||||
|  | ||||
| static void push_traversal_node(void *lhs, void *rhs, int32_t index2) { | ||||
|     JanetTraversalNode node; | ||||
|     node.self = (JanetGCObject *) lhs; | ||||
|     node.other = (JanetGCObject *) rhs; | ||||
|     node.index = 0; | ||||
|     node.index2 = index2; | ||||
|     if (janet_vm_traversal + 1 >= janet_vm_traversal_top) { | ||||
|         size_t oldsize = janet_vm_traversal - janet_vm_traversal_base; | ||||
|         size_t newsize = 2 * oldsize + 1; | ||||
|         if (newsize < 128) { | ||||
|             newsize = 128; | ||||
|         } | ||||
|         JanetTraversalNode *tn = janet_realloc(janet_vm_traversal_base, newsize * sizeof(JanetTraversalNode)); | ||||
|         if (tn == NULL) { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|         janet_vm_traversal_base = tn; | ||||
|         janet_vm_traversal_top = janet_vm_traversal_base + newsize; | ||||
|         janet_vm_traversal = janet_vm_traversal_base + oldsize; | ||||
|     } | ||||
|     *(++janet_vm_traversal) = node; | ||||
| } | ||||
|  | ||||
| /* | ||||
|  * Used for travsersing structs and tuples without recursion | ||||
|  * Returns: | ||||
|  * 0 - next node found | ||||
|  * 1 - early stop - lhs < rhs | ||||
|  * 2 - no next node found | ||||
|  * 3 - early stop - lhs > rhs | ||||
|  */ | ||||
| static int traversal_next(Janet *x, Janet *y) { | ||||
|     JanetTraversalNode *t = janet_vm_traversal; | ||||
|     while (t && t > janet_vm_traversal_base) { | ||||
|         JanetGCObject *self = t->self; | ||||
|         JanetTupleHead *tself = (JanetTupleHead *)self; | ||||
|         JanetStructHead *sself = (JanetStructHead *)self; | ||||
|         JanetGCObject *other = t->other; | ||||
|         JanetTupleHead *tother = (JanetTupleHead *)other; | ||||
|         JanetStructHead *sother = (JanetStructHead *)other; | ||||
|         if ((self->flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_TUPLE) { | ||||
|             /* Node is a tuple at index t->index */ | ||||
|             if (t->index < tself->length && t->index < tother->length) { | ||||
|                 int32_t index = t->index++; | ||||
|                 *x = tself->data[index]; | ||||
|                 *y = tother->data[index]; | ||||
|                 janet_vm_traversal = t; | ||||
|                 return 0; | ||||
|             } | ||||
|             if (t->index2 && tself->length != tother->length) { | ||||
|                 return tself->length > tother->length ? 3 : 1; | ||||
|             } | ||||
|         } else { | ||||
|             /* Node is a struct at index t->index: if t->index2 is true, we should return the values. */ | ||||
|             if (t->index2) { | ||||
|                 t->index2 = 0; | ||||
|                 int32_t index = t->index++; | ||||
|                 *x = sself->data[index].value; | ||||
|                 *y = sother->data[index].value; | ||||
|                 janet_vm_traversal = t; | ||||
|                 return 0; | ||||
|             } | ||||
|             for (int32_t i = t->index; i < sself->capacity; i++) { | ||||
|                 t->index2 = 1; | ||||
|                 *x = sself->data[t->index].key; | ||||
|                 *y = sother->data[t->index].key; | ||||
|                 janet_vm_traversal = t; | ||||
|                 return 0; | ||||
|             } | ||||
|         } | ||||
|         t--; | ||||
|     } | ||||
|     janet_vm_traversal = t; | ||||
|     return 2; | ||||
| } | ||||
|  | ||||
| /* | ||||
|  * Define a number of functions that can be used internally on ANY Janet. | ||||
|  */ | ||||
|  | ||||
| Janet janet_next(Janet ds, Janet key) { | ||||
|     return janet_next_impl(ds, key, 0); | ||||
| } | ||||
|  | ||||
| Janet janet_next_impl(Janet ds, Janet key, int is_interpreter) { | ||||
|     JanetType t = janet_type(ds); | ||||
|     switch (t) { | ||||
|         default: | ||||
|             janet_panicf("expected iterable type, got %v", ds); | ||||
|         case JANET_TABLE: | ||||
|         case JANET_STRUCT: { | ||||
|             const JanetKV *start; | ||||
|             int32_t cap; | ||||
|             if (t == JANET_TABLE) { | ||||
|                 JanetTable *tab = janet_unwrap_table(ds); | ||||
|                 cap = tab->capacity; | ||||
|                 start = tab->data; | ||||
|             } else { | ||||
|                 JanetStruct st = janet_unwrap_struct(ds); | ||||
|                 cap = janet_struct_capacity(st); | ||||
|                 start = st; | ||||
|             } | ||||
|             const JanetKV *end = start + cap; | ||||
|             const JanetKV *kv = janet_checktype(key, JANET_NIL) | ||||
|                                 ? start | ||||
|                                 : janet_dict_find(start, cap, key) + 1; | ||||
|             while (kv < end) { | ||||
|                 if (!janet_checktype(kv->key, JANET_NIL)) return kv->key; | ||||
|                 kv++; | ||||
|             } | ||||
|             break; | ||||
|         } | ||||
|         case JANET_STRING: | ||||
|         case JANET_KEYWORD: | ||||
|         case JANET_SYMBOL: | ||||
|         case JANET_BUFFER: | ||||
|         case JANET_ARRAY: | ||||
|         case JANET_TUPLE: { | ||||
|             int32_t i; | ||||
|             if (janet_checktype(key, JANET_NIL)) { | ||||
|                 i = 0; | ||||
|             } else if (janet_checkint(key)) { | ||||
|                 i = janet_unwrap_integer(key) + 1; | ||||
|             } else { | ||||
|                 break; | ||||
|             } | ||||
|             int32_t len; | ||||
|             if (t == JANET_BUFFER) { | ||||
|                 len = janet_unwrap_buffer(ds)->count; | ||||
|             } else if (t == JANET_ARRAY) { | ||||
|                 len = janet_unwrap_array(ds)->count; | ||||
|             } else if (t == JANET_TUPLE) { | ||||
|                 len = janet_tuple_length(janet_unwrap_tuple(ds)); | ||||
|             } else { | ||||
|                 len = janet_string_length(janet_unwrap_string(ds)); | ||||
|             } | ||||
|             if (i < len && i >= 0) { | ||||
|                 return janet_wrap_integer(i); | ||||
|             } | ||||
|             break; | ||||
|         } | ||||
|         case JANET_ABSTRACT: { | ||||
|             JanetAbstract abst = janet_unwrap_abstract(ds); | ||||
|             const JanetAbstractType *at = janet_abstract_type(abst); | ||||
|             if (NULL == at->next) break; | ||||
|             return at->next(abst, key); | ||||
|         } | ||||
|         case JANET_FIBER: { | ||||
|             JanetFiber *child = janet_unwrap_fiber(ds); | ||||
|             Janet retreg; | ||||
|             JanetFiberStatus status = janet_fiber_status(child); | ||||
|             if (status == JANET_STATUS_ALIVE || | ||||
|                     status == JANET_STATUS_DEAD || | ||||
|                     status == JANET_STATUS_ERROR || | ||||
|                     status == JANET_STATUS_USER0 || | ||||
|                     status == JANET_STATUS_USER1 || | ||||
|                     status == JANET_STATUS_USER2 || | ||||
|                     status == JANET_STATUS_USER3 || | ||||
|                     status == JANET_STATUS_USER4) { | ||||
|                 return janet_wrap_nil(); | ||||
|             } | ||||
|             janet_vm_fiber->child = child; | ||||
|             JanetSignal sig = janet_continue(child, janet_wrap_nil(), &retreg); | ||||
|             if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) { | ||||
|                 if (is_interpreter) { | ||||
|                     janet_signalv(sig, retreg); | ||||
|                 } else { | ||||
|                     janet_vm_fiber->child = NULL; | ||||
|                     janet_panicv(retreg); | ||||
|                 } | ||||
|             } | ||||
|             janet_vm_fiber->child = NULL; | ||||
|             if (sig == JANET_SIGNAL_OK || | ||||
|                     sig == JANET_SIGNAL_ERROR || | ||||
|                     sig == JANET_SIGNAL_USER0 || | ||||
|                     sig == JANET_SIGNAL_USER1 || | ||||
|                     sig == JANET_SIGNAL_USER2 || | ||||
|                     sig == JANET_SIGNAL_USER3 || | ||||
|                     sig == JANET_SIGNAL_USER4) { | ||||
|                 /* Fiber cannot be resumed, so discard last value. */ | ||||
|                 return janet_wrap_nil(); | ||||
|             } else { | ||||
|                 return janet_wrap_integer(0); | ||||
|             } | ||||
|         } | ||||
|     } | ||||
|     return janet_wrap_nil(); | ||||
| } | ||||
|  | ||||
| /* Compare two abstract values */ | ||||
| static int janet_compare_abstract(JanetAbstract xx, JanetAbstract yy) { | ||||
|     if (xx == yy) return 0; | ||||
|     const JanetAbstractType *xt = janet_abstract_type(xx); | ||||
|     const JanetAbstractType *yt = janet_abstract_type(yy); | ||||
|     if (xt != yt) { | ||||
|         return xt > yt ? 1 : -1; | ||||
|     } | ||||
|     if (xt->compare == NULL) { | ||||
|         return xx > yy ? 1 : -1; | ||||
|     } | ||||
|     return xt->compare(xx, yy); | ||||
| } | ||||
|  | ||||
| /* Check if two values are equal. This is strict equality with no conversion. */ | ||||
| int janet_equals(Janet x, Janet y) { | ||||
|     janet_vm_traversal = janet_vm_traversal_base; | ||||
|     do { | ||||
|         if (janet_type(x) != janet_type(y)) return 0; | ||||
|     int result = 0; | ||||
|     if (janet_type(x) != janet_type(y)) { | ||||
|         result = 0; | ||||
|     } else { | ||||
|         switch (janet_type(x)) { | ||||
|             case JANET_NIL: | ||||
|                 result = 1; | ||||
|                 break; | ||||
|             case JANET_BOOLEAN: | ||||
|                 if (janet_unwrap_boolean(x) != janet_unwrap_boolean(y)) return 0; | ||||
|                 result = (janet_unwrap_boolean(x) == janet_unwrap_boolean(y)); | ||||
|                 break; | ||||
|             case JANET_NUMBER: | ||||
|                 if (janet_unwrap_number(x) != janet_unwrap_number(y)) return 0; | ||||
|                 result = (janet_unwrap_number(x) == janet_unwrap_number(y)); | ||||
|                 break; | ||||
|             case JANET_STRING: | ||||
|                 if (!janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y))) return 0; | ||||
|                 result = janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y)); | ||||
|                 break; | ||||
|             case JANET_ABSTRACT: | ||||
|                 if (janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y))) return 0; | ||||
|             case JANET_TUPLE: | ||||
|                 result = janet_tuple_equal(janet_unwrap_tuple(x), janet_unwrap_tuple(y)); | ||||
|                 break; | ||||
|             case JANET_STRUCT: | ||||
|                 result = janet_struct_equal(janet_unwrap_struct(x), janet_unwrap_struct(y)); | ||||
|                 break; | ||||
|             default: | ||||
|                 if (janet_unwrap_pointer(x) != janet_unwrap_pointer(y)) return 0; | ||||
|                 /* compare pointers */ | ||||
|                 result = (janet_unwrap_pointer(x) == janet_unwrap_pointer(y)); | ||||
|                 break; | ||||
|             case JANET_TUPLE: { | ||||
|                 const Janet *t1 = janet_unwrap_tuple(x); | ||||
|                 const Janet *t2 = janet_unwrap_tuple(y); | ||||
|                 if (t1 == t2) break; | ||||
|                 if (janet_tuple_hash(t1) != janet_tuple_hash(t2)) return 0; | ||||
|                 if (janet_tuple_length(t1) != janet_tuple_length(t2)) return 0; | ||||
|                 push_traversal_node(janet_tuple_head(t1), janet_tuple_head(t2), 0); | ||||
|                 break; | ||||
|             } | ||||
|             break; | ||||
|             case JANET_STRUCT: { | ||||
|                 const JanetKV *s1 = janet_unwrap_struct(x); | ||||
|                 const JanetKV *s2 = janet_unwrap_struct(y); | ||||
|                 if (s1 == s2) break; | ||||
|                 if (janet_struct_hash(s1) != janet_struct_hash(s2)) return 0; | ||||
|                 if (janet_struct_length(s1) != janet_struct_length(s2)) return 0; | ||||
|                 push_traversal_node(janet_struct_head(s1), janet_struct_head(s2), 0); | ||||
|                 break; | ||||
|             } | ||||
|             break; | ||||
|         } | ||||
|     } while (!traversal_next(&x, &y)); | ||||
|     return 1; | ||||
|     } | ||||
|     return result; | ||||
| } | ||||
|  | ||||
| /* Computes a hash value for a function */ | ||||
| @@ -306,33 +83,15 @@ int32_t janet_hash(Janet x) { | ||||
|         case JANET_STRUCT: | ||||
|             hash = janet_struct_hash(janet_unwrap_struct(x)); | ||||
|             break; | ||||
|         case JANET_NUMBER: { | ||||
|             union { | ||||
|                 double d; | ||||
|                 uint64_t u; | ||||
|             } as; | ||||
|             as.d = janet_unwrap_number(x); | ||||
|             uint32_t lo = (uint32_t)(as.u & 0xFFFFFFFF); | ||||
|             uint32_t hi = (uint32_t)(as.u >> 32); | ||||
|             hash = (int32_t)(hi ^ (lo >> 3)); | ||||
|             break; | ||||
|         } | ||||
|         case JANET_ABSTRACT: { | ||||
|             JanetAbstract xx = janet_unwrap_abstract(x); | ||||
|             const JanetAbstractType *at = janet_abstract_type(xx); | ||||
|             if (at->hash != NULL) { | ||||
|                 hash = at->hash(xx, janet_abstract_size(xx)); | ||||
|                 break; | ||||
|             } | ||||
|         } | ||||
|         /* fallthrough */ | ||||
|         default: | ||||
|             /* TODO - test performance with different hash functions */ | ||||
|             if (sizeof(double) == sizeof(void *)) { | ||||
|                 /* Assuming 8 byte pointer */ | ||||
|                 uint64_t i = janet_u64(x); | ||||
|                 uint32_t lo = (uint32_t)(i & 0xFFFFFFFF); | ||||
|                 uint32_t hi = (uint32_t)(i >> 32); | ||||
|                 hash = (int32_t)(hi ^ (lo >> 3)); | ||||
|                 hash = (int32_t)(i & 0xFFFFFFFF); | ||||
|                 /* Get a bit more entropy by shifting the low bits out */ | ||||
|                 hash >>= 3; | ||||
|                 hash ^= (int32_t)(i >> 32); | ||||
|             } else { | ||||
|                 /* Assuming 4 byte pointer (or smaller) */ | ||||
|                 hash = (int32_t)((char *)janet_unwrap_pointer(x) - (char *)0); | ||||
| @@ -345,91 +104,54 @@ int32_t janet_hash(Janet x) { | ||||
|  | ||||
| /* Compares x to y. If they are equal returns 0. If x is less, returns -1. | ||||
|  * If y is less, returns 1. All types are comparable | ||||
|  * and should have strict ordering, excepts NaNs. */ | ||||
|  * and should have strict ordering. */ | ||||
| int janet_compare(Janet x, Janet y) { | ||||
|     janet_vm_traversal = janet_vm_traversal_base; | ||||
|     int status; | ||||
|     do { | ||||
|         JanetType tx = janet_type(x); | ||||
|         JanetType ty = janet_type(y); | ||||
|         if (tx != ty) return tx < ty ? -1 : 1; | ||||
|         switch (tx) { | ||||
|     if (janet_type(x) == janet_type(y)) { | ||||
|         switch (janet_type(x)) { | ||||
|             case JANET_NIL: | ||||
|                 break; | ||||
|             case JANET_BOOLEAN: { | ||||
|                 int diff = janet_unwrap_boolean(x) - janet_unwrap_boolean(y); | ||||
|                 if (diff) return diff; | ||||
|                 break; | ||||
|             } | ||||
|             case JANET_NUMBER: { | ||||
|                 double xx = janet_unwrap_number(x); | ||||
|                 double yy = janet_unwrap_number(y); | ||||
|                 if (xx == yy) { | ||||
|                     break; | ||||
|                 return 0; | ||||
|             case JANET_BOOLEAN: | ||||
|                 return janet_unwrap_boolean(x) - janet_unwrap_boolean(y); | ||||
|             case JANET_NUMBER: | ||||
|                 /* Check for NaNs to ensure total order */ | ||||
|                 if (janet_unwrap_number(x) != janet_unwrap_number(x)) | ||||
|                     return janet_unwrap_number(y) != janet_unwrap_number(y) | ||||
|                            ? 0 | ||||
|                            : -1; | ||||
|                 if (janet_unwrap_number(y) != janet_unwrap_number(y)) | ||||
|                     return 1; | ||||
|  | ||||
|                 if (janet_unwrap_number(x) == janet_unwrap_number(y)) { | ||||
|                     return 0; | ||||
|                 } else { | ||||
|                     return (xx < yy) ? -1 : 1; | ||||
|                     return janet_unwrap_number(x) > janet_unwrap_number(y) ? 1 : -1; | ||||
|                 } | ||||
|             } | ||||
|             case JANET_STRING: | ||||
|             case JANET_SYMBOL: | ||||
|             case JANET_KEYWORD: { | ||||
|                 int diff = janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y)); | ||||
|                 if (diff) return diff; | ||||
|                 break; | ||||
|             } | ||||
|             case JANET_ABSTRACT: { | ||||
|                 int diff = janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y)); | ||||
|                 if (diff) return diff; | ||||
|                 break; | ||||
|             } | ||||
|             default: { | ||||
|                 if (janet_unwrap_pointer(x) == janet_unwrap_pointer(y)) { | ||||
|                     break; | ||||
|             case JANET_KEYWORD: | ||||
|                 return janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y)); | ||||
|             case JANET_TUPLE: | ||||
|                 return janet_tuple_compare(janet_unwrap_tuple(x), janet_unwrap_tuple(y)); | ||||
|             case JANET_STRUCT: | ||||
|                 return janet_struct_compare(janet_unwrap_struct(x), janet_unwrap_struct(y)); | ||||
|             default: | ||||
|                 if (janet_unwrap_string(x) == janet_unwrap_string(y)) { | ||||
|                     return 0; | ||||
|                 } else { | ||||
|                     return janet_unwrap_pointer(x) > janet_unwrap_pointer(y) ? 1 : -1; | ||||
|                     return janet_unwrap_string(x) > janet_unwrap_string(y) ? 1 : -1; | ||||
|                 } | ||||
|             } | ||||
|             case JANET_TUPLE: { | ||||
|                 const Janet *lhs = janet_unwrap_tuple(x); | ||||
|                 const Janet *rhs = janet_unwrap_tuple(y); | ||||
|                 push_traversal_node(janet_tuple_head(lhs), janet_tuple_head(rhs), 1); | ||||
|                 break; | ||||
|             } | ||||
|             case JANET_STRUCT: { | ||||
|                 const JanetKV *lhs = janet_unwrap_struct(x); | ||||
|                 const JanetKV *rhs = janet_unwrap_struct(y); | ||||
|                 int32_t llen = janet_struct_capacity(lhs); | ||||
|                 int32_t rlen = janet_struct_capacity(rhs); | ||||
|                 int32_t lhash = janet_struct_hash(lhs); | ||||
|                 int32_t rhash = janet_struct_hash(rhs); | ||||
|                 if (llen < rlen) return -1; | ||||
|                 if (llen > rlen) return 1; | ||||
|                 if (lhash < rhash) return -1; | ||||
|                 if (lhash > rhash) return 1; | ||||
|                 push_traversal_node(janet_struct_head(lhs), janet_struct_head(rhs), 0); | ||||
|                 break; | ||||
|             } | ||||
|         } | ||||
|     } while (!(status = traversal_next(&x, &y))); | ||||
|     return status - 2; | ||||
| } | ||||
|  | ||||
| static int32_t getter_checkint(Janet key, int32_t max) { | ||||
|     if (!janet_checkint(key)) goto bad; | ||||
|     int32_t ret = janet_unwrap_integer(key); | ||||
|     if (ret < 0) goto bad; | ||||
|     if (ret >= max) goto bad; | ||||
|     return ret; | ||||
| bad: | ||||
|     janet_panicf("expected integer key in range [0, %d), got %v", max, key); | ||||
|     } | ||||
|     return (janet_type(x) < janet_type(y)) ? -1 : 1; | ||||
| } | ||||
|  | ||||
| /* Gets a value and returns. Can panic. */ | ||||
| Janet janet_in(Janet ds, Janet key) { | ||||
| Janet janet_get(Janet ds, Janet key) { | ||||
|     Janet value; | ||||
|     switch (janet_type(ds)) { | ||||
|         default: | ||||
|             janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds); | ||||
|             value = janet_wrap_nil(); | ||||
|             break; | ||||
|         case JANET_STRUCT: | ||||
|             value = janet_struct_get(janet_unwrap_struct(ds), key); | ||||
| @@ -439,120 +161,79 @@ Janet janet_in(Janet ds, Janet key) { | ||||
|             break; | ||||
|         case JANET_ARRAY: { | ||||
|             JanetArray *array = janet_unwrap_array(ds); | ||||
|             int32_t index = getter_checkint(key, array->count); | ||||
|             value = array->data[index]; | ||||
|             int32_t index; | ||||
|             if (!janet_checkint(key)) | ||||
|                 janet_panic("expected integer key"); | ||||
|             index = janet_unwrap_integer(key); | ||||
|             if (index < 0 || index >= array->count) { | ||||
|                 value = janet_wrap_nil(); | ||||
|             } else { | ||||
|                 value = array->data[index]; | ||||
|             } | ||||
|             break; | ||||
|         } | ||||
|         case JANET_TUPLE: { | ||||
|             const Janet *tuple = janet_unwrap_tuple(ds); | ||||
|             int32_t len = janet_tuple_length(tuple); | ||||
|             value = tuple[getter_checkint(key, len)]; | ||||
|             int32_t index; | ||||
|             if (!janet_checkint(key)) | ||||
|                 janet_panic("expected integer key"); | ||||
|             index = janet_unwrap_integer(key); | ||||
|             if (index < 0 || index >= janet_tuple_length(tuple)) { | ||||
|                 value = janet_wrap_nil(); | ||||
|             } else { | ||||
|                 value = tuple[index]; | ||||
|             } | ||||
|             break; | ||||
|         } | ||||
|         case JANET_BUFFER: { | ||||
|             JanetBuffer *buffer = janet_unwrap_buffer(ds); | ||||
|             int32_t index = getter_checkint(key, buffer->count); | ||||
|             value = janet_wrap_integer(buffer->data[index]); | ||||
|             int32_t index; | ||||
|             if (!janet_checkint(key)) | ||||
|                 janet_panic("expected integer key"); | ||||
|             index = janet_unwrap_integer(key); | ||||
|             if (index < 0 || index >= buffer->count) { | ||||
|                 value = janet_wrap_nil(); | ||||
|             } else { | ||||
|                 value = janet_wrap_integer(buffer->data[index]); | ||||
|             } | ||||
|             break; | ||||
|         } | ||||
|         case JANET_STRING: | ||||
|         case JANET_SYMBOL: | ||||
|         case JANET_KEYWORD: { | ||||
|             const uint8_t *str = janet_unwrap_string(ds); | ||||
|             int32_t index = getter_checkint(key, janet_string_length(str)); | ||||
|             value = janet_wrap_integer(str[index]); | ||||
|             int32_t index; | ||||
|             if (!janet_checkint(key)) | ||||
|                 janet_panic("expected integer key"); | ||||
|             index = janet_unwrap_integer(key); | ||||
|             if (index < 0 || index >= janet_string_length(str)) { | ||||
|                 value = janet_wrap_nil(); | ||||
|             } else { | ||||
|                 value = janet_wrap_integer(str[index]); | ||||
|             } | ||||
|             break; | ||||
|         } | ||||
|         case JANET_ABSTRACT: { | ||||
|             JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds)); | ||||
|             if (type->get) { | ||||
|                 if (!(type->get)(janet_unwrap_abstract(ds), key, &value)) | ||||
|                     janet_panicf("key %v not found in %v ", key, ds); | ||||
|                 value = (type->get)(janet_unwrap_abstract(ds), key); | ||||
|             } else { | ||||
|                 janet_panicf("no getter for %v ", ds); | ||||
|                 value = janet_wrap_nil(); | ||||
|             } | ||||
|             break; | ||||
|         } | ||||
|         case JANET_FIBER: { | ||||
|             /* Bit of a hack to allow iterating over fibers. */ | ||||
|             if (janet_equals(key, janet_wrap_integer(0))) { | ||||
|                 return janet_unwrap_fiber(ds)->last_value; | ||||
|             } else { | ||||
|                 janet_panicf("expected key 0, got %v", key); | ||||
|             } | ||||
|         } | ||||
|     } | ||||
|     return value; | ||||
| } | ||||
|  | ||||
| Janet janet_get(Janet ds, Janet key) { | ||||
|     JanetType t = janet_type(ds); | ||||
|     switch (t) { | ||||
|         default: | ||||
|             return janet_wrap_nil(); | ||||
|         case JANET_STRING: | ||||
|         case JANET_SYMBOL: | ||||
|         case JANET_KEYWORD: { | ||||
|             if (!janet_checkint(key)) return janet_wrap_nil(); | ||||
|             int32_t index = janet_unwrap_integer(key); | ||||
|             if (index < 0) return janet_wrap_nil(); | ||||
|             const uint8_t *str = janet_unwrap_string(ds); | ||||
|             if (index >= janet_string_length(str)) return janet_wrap_nil(); | ||||
|             return janet_wrap_integer(str[index]); | ||||
|         } | ||||
|         case JANET_ABSTRACT: { | ||||
|             Janet value; | ||||
|             void *abst = janet_unwrap_abstract(ds); | ||||
|             JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst); | ||||
|             if (!type->get) return janet_wrap_nil(); | ||||
|             if ((type->get)(abst, key, &value)) | ||||
|                 return value; | ||||
|             return janet_wrap_nil(); | ||||
|         } | ||||
|         case JANET_ARRAY: | ||||
|         case JANET_TUPLE: | ||||
|         case JANET_BUFFER: { | ||||
|             if (!janet_checkint(key)) return janet_wrap_nil(); | ||||
|             int32_t index = janet_unwrap_integer(key); | ||||
|             if (index < 0) return janet_wrap_nil(); | ||||
|             if (t == JANET_ARRAY) { | ||||
|                 JanetArray *a = janet_unwrap_array(ds); | ||||
|                 if (index >= a->count) return janet_wrap_nil(); | ||||
|                 return a->data[index]; | ||||
|             } else if (t == JANET_BUFFER) { | ||||
|                 JanetBuffer *b = janet_unwrap_buffer(ds); | ||||
|                 if (index >= b->count) return janet_wrap_nil(); | ||||
|                 return janet_wrap_integer(b->data[index]); | ||||
|             } else { | ||||
|                 const Janet *t = janet_unwrap_tuple(ds); | ||||
|                 if (index >= janet_tuple_length(t)) return janet_wrap_nil(); | ||||
|                 return t[index]; | ||||
|             } | ||||
|         } | ||||
|         case JANET_TABLE: { | ||||
|             return janet_table_get(janet_unwrap_table(ds), key); | ||||
|         } | ||||
|         case JANET_STRUCT: { | ||||
|             const JanetKV *st = janet_unwrap_struct(ds); | ||||
|             return janet_struct_get(st, key); | ||||
|         } | ||||
|         case JANET_FIBER: { | ||||
|             /* Bit of a hack to allow iterating over fibers. */ | ||||
|             if (janet_equals(key, janet_wrap_integer(0))) { | ||||
|                 return janet_unwrap_fiber(ds)->last_value; | ||||
|             } else { | ||||
|                 return janet_wrap_nil(); | ||||
|             } | ||||
|         } | ||||
|     } | ||||
| } | ||||
|  | ||||
| Janet janet_getindex(Janet ds, int32_t index) { | ||||
|     Janet value; | ||||
|     if (index < 0) janet_panic("expected non-negative index"); | ||||
|     switch (janet_type(ds)) { | ||||
|         default: | ||||
|             janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds); | ||||
|             value = janet_wrap_nil(); | ||||
|             break; | ||||
|         case JANET_STRING: | ||||
|         case JANET_SYMBOL: | ||||
| @@ -593,17 +274,9 @@ Janet janet_getindex(Janet ds, int32_t index) { | ||||
|         case JANET_ABSTRACT: { | ||||
|             JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds)); | ||||
|             if (type->get) { | ||||
|                 if (!(type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index), &value)) | ||||
|                     value = janet_wrap_nil(); | ||||
|                 value = (type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index)); | ||||
|             } else { | ||||
|                 janet_panicf("no getter for %v ", ds); | ||||
|             } | ||||
|             break; | ||||
|         } | ||||
|         case JANET_FIBER: { | ||||
|             if (index == 0) { | ||||
|                 value = janet_unwrap_fiber(ds)->last_value; | ||||
|             } else { | ||||
|                 value = janet_wrap_nil(); | ||||
|             } | ||||
|             break; | ||||
| @@ -616,6 +289,7 @@ int32_t janet_length(Janet x) { | ||||
|     switch (janet_type(x)) { | ||||
|         default: | ||||
|             janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x); | ||||
|             return 0; | ||||
|         case JANET_STRING: | ||||
|         case JANET_SYMBOL: | ||||
|         case JANET_KEYWORD: | ||||
| @@ -630,38 +304,6 @@ int32_t janet_length(Janet x) { | ||||
|             return janet_struct_length(janet_unwrap_struct(x)); | ||||
|         case JANET_TABLE: | ||||
|             return janet_unwrap_table(x)->count; | ||||
|         case JANET_ABSTRACT: { | ||||
|             Janet argv[1] = { x }; | ||||
|             Janet len = janet_mcall("length", 1, argv); | ||||
|             if (!janet_checkint(len)) | ||||
|                 janet_panicf("invalid integer length %v", len); | ||||
|             return janet_unwrap_integer(len); | ||||
|         } | ||||
|     } | ||||
| } | ||||
|  | ||||
| Janet janet_lengthv(Janet x) { | ||||
|     switch (janet_type(x)) { | ||||
|         default: | ||||
|             janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x); | ||||
|         case JANET_STRING: | ||||
|         case JANET_SYMBOL: | ||||
|         case JANET_KEYWORD: | ||||
|             return janet_wrap_integer(janet_string_length(janet_unwrap_string(x))); | ||||
|         case JANET_ARRAY: | ||||
|             return janet_wrap_integer(janet_unwrap_array(x)->count); | ||||
|         case JANET_BUFFER: | ||||
|             return janet_wrap_integer(janet_unwrap_buffer(x)->count); | ||||
|         case JANET_TUPLE: | ||||
|             return janet_wrap_integer(janet_tuple_length(janet_unwrap_tuple(x))); | ||||
|         case JANET_STRUCT: | ||||
|             return janet_wrap_integer(janet_struct_length(janet_unwrap_struct(x))); | ||||
|         case JANET_TABLE: | ||||
|             return janet_wrap_integer(janet_unwrap_table(x)->count); | ||||
|         case JANET_ABSTRACT: { | ||||
|             Janet argv[1] = { x }; | ||||
|             return janet_mcall("length", 1, argv); | ||||
|         } | ||||
|     } | ||||
| } | ||||
|  | ||||
| @@ -670,6 +312,7 @@ void janet_putindex(Janet ds, int32_t index, Janet value) { | ||||
|         default: | ||||
|             janet_panicf("expected %T, got %v", | ||||
|                          JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds); | ||||
|             break; | ||||
|         case JANET_ARRAY: { | ||||
|             JanetArray *array = janet_unwrap_array(ds); | ||||
|             if (index >= array->count) { | ||||
| @@ -687,7 +330,7 @@ void janet_putindex(Janet ds, int32_t index, Janet value) { | ||||
|                 janet_buffer_ensure(buffer, index + 1, 2); | ||||
|                 buffer->count = index + 1; | ||||
|             } | ||||
|             buffer->data[index] = (uint8_t)(janet_unwrap_integer(value) & 0xFF); | ||||
|             buffer->data[index] = janet_unwrap_integer(value); | ||||
|             break; | ||||
|         } | ||||
|         case JANET_TABLE: { | ||||
| @@ -712,9 +355,13 @@ void janet_put(Janet ds, Janet key, Janet value) { | ||||
|         default: | ||||
|             janet_panicf("expected %T, got %v", | ||||
|                          JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds); | ||||
|             break; | ||||
|         case JANET_ARRAY: { | ||||
|             int32_t index; | ||||
|             JanetArray *array = janet_unwrap_array(ds); | ||||
|             int32_t index = getter_checkint(key, INT32_MAX - 1); | ||||
|             if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key); | ||||
|             index = janet_unwrap_integer(key); | ||||
|             if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key); | ||||
|             if (index >= array->count) { | ||||
|                 janet_array_setcount(array, index + 1); | ||||
|             } | ||||
| @@ -722,8 +369,11 @@ void janet_put(Janet ds, Janet key, Janet value) { | ||||
|             break; | ||||
|         } | ||||
|         case JANET_BUFFER: { | ||||
|             int32_t index; | ||||
|             JanetBuffer *buffer = janet_unwrap_buffer(ds); | ||||
|             int32_t index = getter_checkint(key, INT32_MAX - 1); | ||||
|             if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key); | ||||
|             index = janet_unwrap_integer(key); | ||||
|             if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key); | ||||
|             if (!janet_checkint(value)) | ||||
|                 janet_panicf("can only put integers in buffers, got %v", value); | ||||
|             if (index >= buffer->count) { | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,7 +21,6 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include "vector.h" | ||||
| #include "util.h" | ||||
| #endif | ||||
| @@ -31,24 +30,34 @@ void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) { | ||||
|     int32_t dbl_cur = (NULL != v) ? 2 * janet_v__cap(v) : 0; | ||||
|     int32_t min_needed = janet_v_count(v) + increment; | ||||
|     int32_t m = dbl_cur > min_needed ? dbl_cur : min_needed; | ||||
|     size_t newsize = ((size_t) itemsize) * m + sizeof(int32_t) * 2; | ||||
|     int32_t *p = (int32_t *) janet_srealloc(v ? janet_v__raw(v) : 0, newsize); | ||||
|     if (!v) p[1] = 0; | ||||
|     p[0] = m; | ||||
|     return p + 2; | ||||
|     int32_t *p = (int32_t *) realloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t) * 2); | ||||
|     if (NULL != p) { | ||||
|         if (!v) p[1] = 0; | ||||
|         p[0] = m; | ||||
|         return p + 2; | ||||
|     } else { | ||||
|         { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|         return (void *)(2 * sizeof(int32_t)); | ||||
|     } | ||||
| } | ||||
|  | ||||
| /* Convert a buffer to normal allocated memory (forget capacity) */ | ||||
| void *janet_v_flattenmem(void *v, int32_t itemsize) { | ||||
|     int32_t *p; | ||||
|     int32_t sizen; | ||||
|     if (NULL == v) return NULL; | ||||
|     size_t size = (size_t) itemsize * janet_v__cnt(v); | ||||
|     p = janet_malloc(size); | ||||
|     sizen = itemsize * janet_v__cnt(v); | ||||
|     p = malloc(sizen); | ||||
|     if (NULL != p) { | ||||
|         safe_memcpy(p, v, size); | ||||
|         memcpy(p, v, sizen); | ||||
|         return p; | ||||
|     } else { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|         { | ||||
|             JANET_OUT_OF_MEMORY; | ||||
|         } | ||||
|         return NULL; | ||||
|     } | ||||
| } | ||||
|  | ||||
|   | ||||
| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -24,7 +24,6 @@ | ||||
| #define JANET_VECTOR_H_defined | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #endif | ||||
|  | ||||
| @@ -34,15 +33,16 @@ | ||||
| */ | ||||
|  | ||||
| /* This is mainly used code such as the assembler or compiler, which | ||||
|  * need vector like data structures that are only garbage collected in case | ||||
|  * of an error, and normally rely on malloc/free. */ | ||||
|  * need vector like data structures that are not garbage collected | ||||
|  * and used only from C */ | ||||
|  | ||||
| #define janet_v_free(v)         (((v) != NULL) ? (janet_sfree(janet_v__raw(v)), 0) : 0) | ||||
| #define janet_v_free(v)         (((v) != NULL) ? (free(janet_v__raw(v)), 0) : 0) | ||||
| #define janet_v_push(v, x)      (janet_v__maybegrow(v, 1), (v)[janet_v__cnt(v)++] = (x)) | ||||
| #define janet_v_pop(v)          (janet_v_count(v) ? janet_v__cnt(v)-- : 0) | ||||
| #define janet_v_count(v)        (((v) != NULL) ? janet_v__cnt(v) : 0) | ||||
| #define janet_v_last(v)         ((v)[janet_v__cnt(v) - 1]) | ||||
| #define janet_v_empty(v)        (((v) != NULL) ? (janet_v__cnt(v) = 0) : 0) | ||||
| #define janet_v_copy(v)         (janet_v_copymem((v), sizeof(*(v)))) | ||||
| #define janet_v_flatten(v)      (janet_v_flattenmem((v), sizeof(*(v)))) | ||||
|  | ||||
| #define janet_v__raw(v) ((int32_t *)(v) - 2) | ||||
| @@ -55,6 +55,7 @@ | ||||
|  | ||||
| /* Actual functions defined in vector.c */ | ||||
| void *janet_v_grow(void *v, int32_t increment, int32_t itemsize); | ||||
| void *janet_v_copymem(void *v, int32_t itemsize); | ||||
| void *janet_v_flattenmem(void *v, int32_t itemsize); | ||||
|  | ||||
| #endif | ||||
|   | ||||
							
								
								
									
										959
									
								
								src/core/vm.c
									
									
									
									
									
								
							
							
						
						
									
										959
									
								
								src/core/vm.c
									
									
									
									
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							| @@ -1,5 +1,5 @@ | ||||
| /* | ||||
| * Copyright (c) 2021 Calvin Rose | ||||
| * Copyright (c) 2019 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 | ||||
| @@ -21,11 +21,8 @@ | ||||
| */ | ||||
|  | ||||
| #ifndef JANET_AMALG | ||||
| #include "features.h" | ||||
| #include <janet.h> | ||||
| #include <math.h> | ||||
| #include "util.h" | ||||
| #include "state.h" | ||||
| #endif | ||||
|  | ||||
| /* Macro fills */ | ||||
| @@ -162,8 +159,7 @@ Janet(janet_wrap_number)(double x) { | ||||
|  | ||||
| void *janet_memalloc_empty(int32_t count) { | ||||
|     int32_t i; | ||||
|     void *mem = janet_malloc((size_t) count * sizeof(JanetKV)); | ||||
|     janet_vm_next_collection += (size_t) count * sizeof(JanetKV); | ||||
|     void *mem = malloc(count * sizeof(JanetKV)); | ||||
|     if (NULL == mem) { | ||||
|         JANET_OUT_OF_MEMORY; | ||||
|     } | ||||
| @@ -186,12 +182,6 @@ void janet_memempty(JanetKV *mem, int32_t count) { | ||||
|  | ||||
| #ifdef JANET_NANBOX_64 | ||||
|  | ||||
| Janet janet_wrap_number_safe(double d) { | ||||
|     Janet ret; | ||||
|     ret.number = isnan(d) ? NAN : d; | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| void *janet_nanbox_to_pointer(Janet x) { | ||||
|     x.i64 &= JANET_NANBOX_PAYLOADBITS; | ||||
|     return x.pointer; | ||||
| @@ -232,11 +222,6 @@ Janet janet_wrap_number(double x) { | ||||
|     return ret; | ||||
| } | ||||
|  | ||||
| Janet janet_wrap_number_safe(double d) { | ||||
|     double x = isnan(d) ? NAN : d; | ||||
|     return janet_wrap_number(x); | ||||
| } | ||||
|  | ||||
| Janet janet_nanbox32_from_tagi(uint32_t tag, int32_t integer) { | ||||
|     Janet ret; | ||||
|     ret.tagged.type = tag; | ||||
| @@ -258,10 +243,6 @@ double janet_unwrap_number(Janet x) { | ||||
|  | ||||
| #else | ||||
|  | ||||
| Janet janet_wrap_number_safe(double d) { | ||||
|     return janet_wrap_number(d); | ||||
| } | ||||
|  | ||||
| Janet janet_wrap_nil(void) { | ||||
|     Janet y; | ||||
|     y.type = JANET_NIL; | ||||
| @@ -317,4 +298,3 @@ JANET_WRAP_DEFINE(pointer, void *, JANET_POINTER, pointer) | ||||
| #undef JANET_WRAP_DEFINE | ||||
|  | ||||
| #endif | ||||
|  | ||||
|   | ||||
Some files were not shown because too many files have changed in this diff Show More
		Reference in New Issue
	
	Block a user