1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-06 10:33:03 +00:00

Compare commits

..

143 Commits

Author SHA1 Message Date
Calvin Rose
1bdde9c4f7 Fix warnings. 2020-01-28 23:46:14 -06:00
Calvin Rose
333ae7c4f8 Make amalgamtion the default when building.
This way we can support fewer build configurations. Also, remove
all undefined behavior due to use of memcpy with NULL pointers. GCC
was exploiting this to remove NULL checks in some builds.
2020-01-28 23:38:52 -06:00
Calvin Rose
f7b7c83264 Address #276 2020-01-25 12:08:43 -06:00
Calvin Rose
6f9c9879ca Add var-
We had defn-, def-, defmacro-, but no var-.
2020-01-24 22:52:28 -06:00
Calvin Rose
b8df47e063 Fix regression in take/drop. 2020-01-24 17:39:25 -06:00
Calvin Rose
9dad8bf56d Remove min-order and max-order.
Also address #275 by exposing lflags and cflags
to declare-executable
2020-01-24 17:35:21 -06:00
Calvin Rose
689f2dcbb4 Change default import prefix.
Changed from `(string path "/")` to
`(string (last (string/split "/" path)) "/)`.
2020-01-24 16:54:06 -06:00
Calvin Rose
163e2a5b22 Add string support to %j format. 2020-01-24 08:52:27 -06:00
Calvin Rose
e36334e14b Revert issue with removing buffer self print check. 2020-01-23 23:39:49 -06:00
Calvin Rose
60304c7e27 Update CHANGELOG.md 2020-01-23 19:07:09 -06:00
Calvin Rose
28d41039b8 Add mod function to core.
The `mod` function is a pair function with `%`, or te remainder
function and is distinct from it. This is taken from common lisp.
2020-01-23 18:54:30 -06:00
Calvin Rose
b8d530da36 Remove file/fileno and file/fdopen.
Also fully add call function pointer to
abstract types, including in methods, etc.
2020-01-23 09:01:33 -06:00
Calvin Rose
4fad0714e7 Add janet_gcpressure. Address #269. 2020-01-22 20:52:35 -06:00
Calvin Rose
ca17eb4a2b Address #273 2020-01-22 19:01:49 -06:00
Calvin Rose
4fe005e3c3 Add righthand operator overloading.
This is like python. Now, we just need to readd fuzzy
comparisons to have what python needs. Overloading
math functions would be neat, too.
2020-01-22 18:59:41 -06:00
Calvin Rose
2f9ed8a572 Use memmove instead of copying.
Also some comment things, and re-add old code from linenoise.
It seems to have a purpose for some keyboard layouts, so I will leave
it.
2020-01-21 23:11:00 -06:00
Calvin Rose
688e18a891 Merge pull request #268 from crocket/master
Make REPL key bindings more similar to those on GNU readline.
2020-01-21 23:09:45 -06:00
crocket
8162c64ca3 Make REPL key bindings more similar to those on GNU readline.
* I deleted Alt-H and Alt-L because Ctrl-F and Ctrl-B serve the same
roles.
* Ctrl-W, Alt-D, Alt-F, and Alt-B behave more similarly to the same
key bindings on GNU readline.
* Improved documentation of REPL keybindings on man page.
* Home and End keys now work on more terminal environments.
* Removed bindings for `Esc OH` and `Esc OF` because andrewchambers
doesn't need those bindings and the bindings don't seem to make much
sense for Home and End. `Esc O` is Single Shift Select of G3 Character
Set in xterm. https://invisible-island.net/xterm/ctlseqs/ctlseqs.html
2020-01-22 13:55:44 +09:00
Calvin Rose
e179f26d50 Add call function pointer to abstract types.
This will allow better JITs, FFIs, DSLs, etc.
2020-01-21 18:22:24 -06:00
Calvin Rose
8db68c04c4 Merge branch 'master' of github.com:janet-lang/janet 2020-01-21 17:48:54 -06:00
Calvin Rose
7c92c64730 Remove mutable operators on inttypes.
Mutations break hash table invariants, are a rather
silly performance optimization for a language like Janet.
2020-01-21 17:47:34 -06:00
Calvin Rose
01c6ffe1d5 Merge pull request #266 from andrewchambers/idempotentclose
Make file/close idempotent.
2020-01-21 10:16:06 -06:00
Andrew Chambers
46f57f5c38 Make file/close idempotent.
It is easier to use constructs like defer
with complex control flow if it is safe to close
a file twice.
2020-01-21 22:03:57 +13:00
Calvin Rose
1ec2e08f21 Add manpage docs for repl keybindings. 2020-01-20 17:29:29 -06:00
Calvin Rose
77742dec11 Add source file info on macro compiler error. 2020-01-20 16:45:57 -06:00
Calvin Rose
3cb947b37e Fix macro errors.
debug/stacktrace was being called incorrectly.
2020-01-20 16:05:08 -06:00
Calvin Rose
62cf407f0c Remove lto.
Gosh Darnit, Travis!
2020-01-20 13:53:59 -06:00
Calvin Rose
bbed72f39f Only enable lto on linux for now.
Was failing with clang, as the default clang linker doesn't
do LTO.
2020-01-20 13:37:10 -06:00
Calvin Rose
99c94a78d6 Add -flto to jpm builds as well. 2020-01-20 13:28:57 -06:00
Calvin Rose
2dd852da54 Use ATEND macros to add fields to abstract types.
This means we can add new properties to abstract types without
breaking old code. We can also make simple abstract types without
needing to add many NULL fields to the type.
2020-01-20 13:06:50 -06:00
Calvin Rose
3c87d89df3 Enable LTO by default
Most compilers support it, and it gives a good perf increase OOTB.
2020-01-20 11:38:22 -06:00
Calvin Rose
f4ad627b54 Fix regression in while loops inside each macros.
There was a specialization for `(while (not= nil _) ...)` that
was incorrect when the while loop regresses to a thunk.
2020-01-19 16:25:10 -06:00
Calvin Rose
68a5667a1a Add history first and history last shortcuts.
Alt-, and Alt-.
2020-01-19 15:45:04 -06:00
Calvin Rose
693c6d63d4 Add alt-d binding to repl. 2020-01-19 11:39:10 -06:00
Calvin Rose
f18c3323ea Clear completion list if fully complete. 2020-01-19 11:31:42 -06:00
Calvin Rose
f74e19e673 Improve alt keys and at alt-f and alt-b to repl 2020-01-19 11:16:41 -06:00
Calvin Rose
da70807292 Make autocompletion more zsh like
Also add a few ctrl sequences from readline, and
ignore unknown ctrl sequences.

Address #264

Adds Ctrl-n, Ctrl-p, and Ctrl-w
Ignores unknown ctrl sequences
No alt-* sequences yet.
2020-01-19 10:38:35 -06:00
Calvin Rose
9f8bc6bb8a Please, sir hat? 2020-01-18 21:00:06 -06:00
Calvin Rose
64b9482602 Make history not duplicate itself in getline. 2020-01-18 20:56:35 -06:00
Calvin Rose
8fbcae6029 Remove -march=native from Makefile
Instead, one can pass in CFLAGS to make
2020-01-18 20:01:12 -06:00
Calvin Rose
064475cb8d Add eachk and eachp.
These should make iterating over datastructures easier
without needing the loop macro.
2020-01-18 18:46:49 -06:00
Calvin Rose
f4077b678a Allow calling next on abstracts.
This will allow the creation of infinte
streams, low cost generators, etc.
2020-01-18 18:09:20 -06:00
Calvin Rose
51678c1aba Extend power of the each form
This changes the implementation of the `next` function which
is now used to implement each. This let's us iterate over
more types, not just tables and structs.
2020-01-18 17:55:07 -06:00
Calvin Rose
17a2fdbf1b Update for sourcehut builds.
We needed to include repo in sources array.
2020-01-18 14:42:02 -06:00
Calvin Rose
65d7c3eed1 Use stderr for getline output instead of stdout. 2020-01-18 14:34:29 -06:00
Calvin Rose
41bb8c543b Merge branch 'master' of github.com:janet-lang/janet 2020-01-18 09:46:37 -06:00
Calvin Rose
bbd7355313 Merge pull request #259 from andrewchambers/futureproofhash
Make hash api more future proof.
2020-01-18 09:45:47 -06:00
Calvin Rose
772916593b Address #262
Pressing tab only does one thing at a time.
2020-01-18 09:44:59 -06:00
Calvin Rose
9d8af7355f Improve getline. 2020-01-18 00:30:46 -06:00
Calvin Rose
521a29446f Don't rely on obscure printf features.
They may not work on all platforms.
2020-01-18 00:27:40 -06:00
Calvin Rose
a8e4c4bed0 Add special forms and sort completions.
Also fix case when no completion is needed.
2020-01-18 00:17:08 -06:00
Calvin Rose
6471b4d100 Add preliminary repl completion via tab. 2020-01-17 23:03:50 -06:00
Calvin Rose
7f9b2b34d1 Clarify import docs for dynamic bindings. 2020-01-17 18:06:00 -06:00
Calvin Rose
789c5f135a Add ctrl-a and ctrl-e to control line in repl
Emacs to start of line and to end of line key bindings.
2020-01-17 09:33:30 -06:00
Andrew Chambers
344f0b743d Make hash api more future proof. 2020-01-17 17:25:40 +13:00
Calvin Rose
d8841de180 Address #188
Delete repo folder if clone fails.
2020-01-16 22:14:23 -06:00
Calvin Rose
23c7c3bf1c Allow disabling keyed hash function (prf) in conf
In some cases, one might want to disable what is currently
SipHash for speed / better security mechansims. For example, using
red black trees for caches rather than hash tables.
2020-01-16 21:06:03 -06:00
Calvin Rose
3d117804dd Merge branch 'master' into HEAD 2020-01-16 20:08:34 -06:00
Calvin Rose
77bb0ebe3f Add limits to format to discourage huge prints.
This should make system crashing prints happen less often in repl.
Instead, display a ...
2020-01-16 18:57:01 -06:00
Calvin Rose
6d9e51e4be Fix documentation for if-with.
It was the same as when-with.
2020-01-16 18:12:05 -06:00
Calvin Rose
174ff87946 Change printing of abstracts with tostring in pp
This change makes pretty printing not hide "abstractness".
2020-01-16 18:10:17 -06:00
Andrew Chambers
ea02b2fde9 Use siphash for string hashing.
The hash key still needs to randomly initialized
for the security advantage, but this patch is a
step closer to avoiding hash based DOS.

Further work may including exposing the raw hash
function for use by abstract types who also choose to
implement hash.
2020-01-17 12:06:55 +13:00
Calvin Rose
962cd7e5f5 Add when-with and if-with
This is useful for reading from files.
2020-01-15 22:56:40 -06:00
Calvin Rose
65be9ae095 Add defer and assert to the core. 2020-01-15 22:39:14 -06:00
Calvin Rose
bc2bac8cd3 Fix memory issue in allocating decode buffer.
Since the decode table is currently a single table
per thread, we just make it a thread local to avoid
issues.
2020-01-15 19:58:14 -06:00
Calvin Rose
b567ece401 Address #252
Add repeat form (instead of exactly).
2020-01-14 19:58:03 -06:00
Calvin Rose
f001b0a40c Update Changelog
Also change how add-body in jpm works. We keep an array of thunks
instead of a single thunk.
2020-01-13 20:51:11 -06:00
Calvin Rose
04579664fd update parse.c 2020-01-12 22:43:39 -06:00
Calvin Rose
f709d7eb40 Add module/add-paths
This should make it much easier to make custom DSLs work
well with the import system. No need to mess about with import paths,
 things will just work.
2020-01-12 20:59:45 -06:00
Calvin Rose
2df8660f8b Avoid buffer overrun
On very long binding names > 256 characters, a buffer overrun would be
trigger in janet_cfuns. Not a huge issue, since this is not really code
that would ever be user facing, but we can fix this.
2020-01-12 11:31:41 -06:00
Calvin Rose
a68ee7aac6 Update Copyright 2020. 2020-01-12 10:50:37 -06:00
Calvin Rose
f0e04e734c Test for regressions in #249
Use two separate natives in compiled executable.
2020-01-12 10:45:59 -06:00
Calvin Rose
0e7cf51890 Fix MSVC warnings. 2020-01-12 10:19:51 -06:00
Calvin Rose
b54d9725d8 Fix MSVC errors. 2020-01-12 10:18:03 -06:00
Calvin Rose
2f0570aad6 Address #249
If JANET_ENTRY_NAME is defined, we are compiling into a single binary.
In this case, we don't want to define the config symbol multiple times
with same name, as this causes the linker error.
2020-01-12 10:13:06 -06:00
Calvin Rose
3d40c95e80 Add ability to Janet signal from C functions.
While C functions are not re-entrant, signaling from a C function
can be used to implement async returns. When resuming a fiber that
signalled from within a C function, the fiber is started after the
instruction that emitted the signal. The resume argument is used
as the return result from the c function.
2020-01-10 20:44:16 -06:00
Calvin Rose
ed5027db5d Address #242
Synchronize critical sections in setenv/getenv/environ.
2020-01-06 22:41:18 -06:00
Calvin Rose
c4047f3f88 Merge pull request #247 from andrewchambers/getenvdflt
Optional default value for os/getenv.
2020-01-06 17:27:33 -06:00
Andrew Chambers
ec1a06cfaf Optional default value for os/getenv. 2020-01-07 11:21:05 +13:00
Calvin Rose
17e47a798c Address #244 2020-01-05 09:26:21 -06:00
Calvin Rose
212aceedc6 Fix useless type conversion. 2020-01-02 22:12:07 -06:00
Calvin Rose
e6f897f4ef Merge branch 'master' of github.com:janet-lang/janet 2020-01-02 22:10:13 -06:00
Calvin Rose
6c7f376410 Try to remove potential overflow bugs.
Also make integer to size_t casts explicit rather than relying on
int32_t * sizeof(x) = size_t. This is kind of a personal preference for
this problem.
2020-01-02 22:08:17 -06:00
Calvin Rose
e93e237c67 Merge pull request #236 from andrewchambers/scratch_calloc
Add scratch calloc.
2020-01-02 20:29:10 -06:00
Calvin Rose
a1cd759759 Merge branch 'master' of github.com:janet-lang/janet 2020-01-02 20:28:10 -06:00
Calvin Rose
a2c45a697b Address #234 in array.c 2020-01-02 20:27:38 -06:00
Andrew Chambers
acdbf8911c Add scratch calloc. 2020-01-03 12:10:17 +13:00
Calvin Rose
9269372768 Merge pull request #235 from theosotr/fix
Fix faults in Make build
2020-01-02 15:05:04 -06:00
Thodoris Sotiropoulos
5575e7577a Fix faults in Make build 2020-01-02 22:15:55 +02:00
Calvin Rose
ef02dacdb4 Update changelog. 2019-12-31 12:17:32 -05:00
Calvin Rose
c6b639b939 Add comptime error test. 2019-12-31 12:16:19 -05:00
Calvin Rose
0b0fb18c42 Can we fix NSIS? 2019-12-31 12:10:57 -05:00
Calvin Rose
b872ee024f Add test for issue #232 2019-12-31 11:36:21 -05:00
Calvin Rose
a15d841b5b Address #232
Fix segfault on macro arity mismatch in compile.c by adding missing return statements.
2019-12-31 11:33:03 -05:00
Calvin Rose
bfb638cfc2 Try EnVar_plugin for updating path.
This should be more robust and not fail after upgrading.
2019-12-31 10:26:54 -05:00
Calvin Rose
3a47ad5d99 Remove some NSIS cruft to see if we can fix 3.05 2019-12-31 09:49:50 -05:00
Calvin Rose
e3c88295f2 Update to NSIS 3.05
Lock version in appveyor.yml
2019-12-31 09:40:36 -05:00
Calvin Rose
75bb8fbcd1 Amalg script included janet.h before test macros. 2019-12-30 22:08:12 -05:00
Calvin Rose
9cb25ad7b1 Remove some feature test macros.
_BSD_SOURCE is deprecated and not needed.
2019-12-30 21:30:13 -05:00
Calvin Rose
f361830cb2 Update feature test macro in line.c 2019-12-30 20:24:40 -05:00
Calvin Rose
9dd152dc28 Add features.h for feature test macros.
Because we use an amalgated build, feature
test macros should be set in a single file that
is included before any other headers, and is placed
at the top of the amalgamated build.
2019-12-30 19:06:15 -05:00
Calvin Rose
2ba4337e6f Remove all feature test macros from janet.h
This should help improve compatibility with other C code.
2019-12-30 15:12:17 -05:00
Calvin Rose
48fcd927ab Merge branch 'master' of github.com:janet-lang/janet 2019-12-30 14:26:38 -05:00
Calvin Rose
407d8af026 Address #233
Move _POSIX_C_SOURCE to internal header.
2019-12-30 12:31:26 -05:00
Calvin Rose
d0570b55b1 Merge pull request #231 from andrewchambers/tempfile
Add file/temp.
2019-12-29 20:00:17 -05:00
Calvin Rose
a964a95c1e Fix warnings on BSDs. 2019-12-29 19:53:35 -05:00
Andrew Chambers
c2f8441572 Add file/temp. 2019-12-30 12:00:35 +13:00
Calvin Rose
099a957e6c Update macex1 to properly handle break
Things mostly worked fine, but technically
break should be handled as a special form not a function call.
2019-12-29 16:44:53 -05:00
Calvin Rose
a2e515ab89 Merge pull request #230 from andrewchambers/file_api
Extend file api to allow creating and checking.
2019-12-29 10:22:03 -05:00
Andrew Chambers
2bebace8eb Extend file api to allow creating and checking. 2019-12-30 04:02:46 +13:00
Calvin Rose
5142722da3 Remove aliases for deprectaed functions. 2019-12-28 17:51:05 -05:00
Calvin Rose
52dd0f132a Remove emscripten build.
Prefer using custom toolchain with amalgmated build.
2019-12-28 16:11:15 -05:00
Calvin Rose
022be217a2 Remove ==, not==, and order[<,<=,>,>=].
This unifies equality and comparison checking. Before, we had
separate functions and vm opcodes for comparing general values vs.
for comparing numbers, where the numberic functions were polymorphic and
had special cases for handling NaNs. By unfiying them, abstract types
can now better integrate with other number types and behave as keys.

For now, the old functions are aliased but will eventually be removed.
2019-12-28 16:04:15 -05:00
Calvin Rose
5528bca7a9 Version bump to dev version. 2019-12-28 11:58:40 -05:00
Calvin Rose
ae474bc8d0 Merge pull request #228 from andrewchambers/pclose
Expand docs to explain pclose semantics.
2019-12-28 08:27:16 -05:00
Andrew Chambers
ddc4274314 Expand docs to explain pclose semantics. 2019-12-28 15:24:10 +13:00
Calvin Rose
da93a73dbd Version bump to 1.6.0. 2019-12-22 12:09:56 -05:00
Calvin Rose
31f8778aa3 Fix makensis invocation. 2019-12-19 13:46:59 -05:00
Calvin Rose
0ecd74d01d Echo calculated version. 2019-12-19 13:45:38 -05:00
Calvin Rose
bd20b16a32 Capture typo. 2019-12-19 13:28:17 -05:00
Calvin Rose
933f4b9111 build_win.bat: Parse out smv of janet/version. 2019-12-19 13:25:45 -05:00
Calvin Rose
3492ed6d88 Windows installer pulls version from interpreter.
This should make version updates simpler. Also
try an make installer write to ProgramFiles instead
of ProgramFiles (x86) for 64 bit build.
2019-12-19 13:18:46 -05:00
Calvin Rose
e28262f5ab Add array/fill
This function has similar semantics to buffer/fill.
2019-12-19 12:58:11 -05:00
Calvin Rose
94246f7574 Use infinite timeout to indicate non-blocking.
Makes more sense than negative numbers.
2019-12-18 16:07:06 -05:00
Calvin Rose
07b0ef1648 Throw error on bad thread creation. 2019-12-18 15:49:57 -05:00
Calvin Rose
6a39c4b91d Pass thread body explicitly in thread/new.
Doing it via thread/send make sense, but is a bit
strange. Passing the body explicitly will make more
sense to API users.
2019-12-18 15:07:46 -05:00
Calvin Rose
b9f0f14e31 Add array/new-filled
Similar function signature to buffer/new-filled.
2019-12-18 13:02:50 -05:00
Calvin Rose
4238379552 Use _setjmp/_longjmp on BSDs.
This doesn't save the signal mask so should be a bit faster.
2019-12-18 12:18:31 -05:00
Calvin Rose
8cc43ad2d1 Fix debugger example. 2019-12-17 23:06:41 -06:00
Calvin Rose
94b472df64 Update jpm with show-paths
Update CHANGELOG.md as well.
2019-12-15 22:02:33 -06:00
Calvin Rose
2b2c1ff917 Get rid of warning on BSDs. 2019-12-15 16:04:43 -06:00
Calvin Rose
c7912249b2 Typo in #ifdef. 2019-12-15 15:56:26 -06:00
Calvin Rose
b8004555ea Start cleaning up defines in janet.h 2019-12-15 15:41:58 -06:00
Calvin Rose
58ff7f0788 BSD os.c fix with arc4random. 2019-12-15 12:47:12 -06:00
Calvin Rose
f1afc5b0b4 Address #214
This adds several common patterns, which are defined in
boot.janet. This essentially gives more primitive patterns
to work with out of the box.

Fix build when JANET_REDUCED_OS is defined.
2019-12-14 20:39:14 -06:00
Calvin Rose
bc8ee207d5 Address #219.
Adds several shorthands to the C API.
2019-12-14 11:31:46 -06:00
Calvin Rose
76342540dc Add buffer/fill. Address #221 2019-12-14 10:54:29 -06:00
Calvin Rose
56784a34a1 Address #224 - Exposed file flags in janet.h
A caller can check if a file is closed with
if (flags & JANET_FILE_CLOSED) ...
2019-12-14 09:03:56 -06:00
Calvin Rose
eca42e98f6 Update CHANGELOG.md 2019-12-12 19:39:00 -06:00
Calvin Rose
c3f1b54171 Update jpm path settings.
This will make it easier to use jpm as a per-project
management tool, as well as easier to set up individual
module trees.
2019-12-12 19:35:40 -06:00
Calvin Rose
9b7d642c38 Window x86 needs isnan. 2019-12-12 19:04:13 -06:00
Calvin Rose
f24e2f8706 Update CHANGELOG.md 2019-12-12 17:51:49 -06:00
Calvin Rose
aa7f3411f5 Use JANET_SINGLE_THREADED to disable threads. 2019-12-12 17:39:22 -06:00
98 changed files with 3302 additions and 2404 deletions

View File

@@ -1,4 +1,6 @@
image: freebsd/latest
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- gmake
tasks:

View File

@@ -1,4 +1,6 @@
image: openbsd/6.5
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- gmake
tasks:

View File

@@ -2,6 +2,38 @@
All notable changes to this project will be documented in this file.
### Unreleased
- 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.
@@ -26,6 +58,8 @@ All notable changes to this project will be documented in this file.
- 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.
@@ -33,6 +67,9 @@ All notable changes to this project will be documented in this file.
- 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

View File

@@ -1,4 +1,4 @@
Copyright (c) 2019 Calvin Rose and contributors
Copyright (c) 2020 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

126
Makefile
View File

@@ -1,4 +1,4 @@
# Copyright (c) 2019 Calvin Rose
# Copyright (c) 2020 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,7 +27,7 @@ PREFIX?=/usr/local
INCLUDEDIR?=$(PREFIX)/include
BINDIR?=$(PREFIX)/bin
LIBDIR?=$(PREFIX)/lib
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\""
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || 'local')\""
CLIBS=-lm -lpthread
JANET_TARGET=build/janet
JANET_LIBRARY=build/libjanet.so
@@ -37,9 +37,9 @@ MANPATH?=$(PREFIX)/share/man/man1/
PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
DEBUGGER=gdb
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden \
CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden \
-DJANET_BUILD=$(JANET_BUILD)
LDFLAGS=-rdynamic
LDFLAGS:=$(LDFLAGS) -rdynamic
# For installation
LDCONFIG:=ldconfig "$(LIBDIR)"
@@ -67,7 +67,8 @@ all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY)
JANET_HEADERS=src/include/janet.h src/conf/janetconf.h
JANET_LOCAL_HEADERS=src/core/util.h \
JANET_LOCAL_HEADERS=src/core/features.h \
src/core/util.h \
src/core/state.h \
src/core/gc.h \
src/core/vector.h \
@@ -121,108 +122,32 @@ 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
JANET_MAINCLIENT_SOURCES=src/mainclient/line.c src/mainclient/main.c
##########################################################
##### The bootstrap interpreter that creates janet.c #####
##########################################################
JANET_WEBCLIENT_SOURCES=src/webclient/main.c
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES))
##################################################################
##### The bootstrap interpreter that compiles the core image #####
##################################################################
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES)) \
build/boot.gen.o
$(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ -c $<
build/janet_boot: $(JANET_BOOT_OBJECTS)
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ $^ $(CLIBS)
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
# Now the reason we bootstrap in the first place
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))
# 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 -Isrc/conf -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/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
build/janet.c: build/janet_boot src/boot/boot.janet
build/janet_boot . JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet' > $@
########################
##### Amalgamation #####
########################
amalg: build/shell.c build/janet.c build/janet.h build/core_image.c build/janetconf.h
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) > $@
AMALG_SHELL_SOURCE=src/mainclient/line.h src/mainclient/line.c src/mainclient/main.c
build/shell.c: $(JANET_TARGET) tools/amalg.janet $(AMALG_SHELL_SOURCE)
$(JANET_TARGET) tools/amalg.janet $(AMALG_SHELL_SOURCE) > $@
build/shell.c: src/mainclient/shell.c
cp $< $@
build/janet.h: src/include/janet.h
cp $< $@
@@ -230,6 +155,21 @@ build/janet.h: src/include/janet.h
build/janetconf.h: src/conf/janetconf.h
cp $< $@
build/janet.o: build/janet.c build/janet.h build/janetconf.h
$(CC) $(CFLAGS) -c $< -o $@ -I build
build/shell.o: build/shell.c build/janet.h build/janetconf.h
$(CC) $(CFLAGS) -c $< -o $@ -I build
$(JANET_TARGET): build/janet.o build/shell.o
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
$(JANET_LIBRARY): build/janet.o build/shell.o
$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
$(AR) rcs $@ $^
###################
##### Testing #####
###################
@@ -371,5 +311,5 @@ build/embed_test: build/embed_janet.o build/embed_main.o
test-amalg: build/embed_test
./build/embed_test
.PHONY: clean install repl debug valgrind test amalg \
.PHONY: clean install repl debug valgrind test \
valtest emscripten dist uninstall docs grammar format

View File

@@ -21,7 +21,7 @@ janet could be embedded into other programs. Try janet in your browser at
## Use Cases
Janet makes a good system scripting language, or a language to embed in other programs. Think Lua or Guile.
Janet makes a good system scripting language, or a language to embed in other programs, like Lua or Guile.
## Features
@@ -114,15 +114,6 @@ gmake repl
3. Run `build_win` to compile janet.
4. Run `build_win test` to make sure everything is working.
### Emscripten
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
@@ -155,7 +146,8 @@ ninja -C build install
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.
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.
## Installation

View File

@@ -20,17 +20,17 @@ init:
install:
- set JANET_BUILD=%appveyor_repo_commit:~0,7%
- choco install nsis -y -pre
- choco install nsis -y -pre --version 3.05
# Replace makensis.exe and files with special long string build. This should
# prevent issues when setting PATH during installation.
- 7z e "tools\nsis-3.04-strlen_8192.zip" -o"C:\Program Files (x86)\NSIS\" -y
- 7z e "tools\nsis-3.05-strlen_8192.zip" -o"C:\Program Files (x86)\NSIS\" -y
- 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 janet_outname=v1.6.0
- if "%janet_outname%"=="" set janet_outname=v1.6.1
build: off
artifacts:

View File

@@ -29,7 +29,7 @@
(defn- rule-impl
[target deps thunk &opt phony]
(put (getrules) target @[(array/slice deps) thunk phony]))
(put (getrules) target @[(array/slice deps) @[thunk] phony]))
(defmacro rule
"Add a rule to the rule graph."
@@ -53,8 +53,9 @@
(defn- add-thunk
[target more]
(def item (gettarget target))
(def [_ thunk] item)
(put item 1 (fn [] (more) (thunk))))
(def [_ thunks] item)
(array/push thunks more)
item)
(defmacro add-body
"Add recipe code to an existing rule. This makes existing rules do more but
@@ -83,26 +84,33 @@
(if (os/stat target :mode)
(break target)
(error (string "No rule for file " target " found."))))
(def [deps thunk phony] item)
(def [deps thunks phony] item)
(def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x))
(when (or phony (needs-build-some target realdeps))
(thunk))
(each thunk thunks (thunk)))
(unless phony target))
#
# Configuration
#
(def- exe-dir
"Directory containing jpm script"
(do
(def exe (dyn :current-file))
(def i (last (string/find-all sep exe)))
(slice exe 0 i)))
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
# Default based on janet binary location
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
(if-let [j (dyn :syspath)]
(string j "/../../include/janet"))))
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
(if-let [j (dyn :syspath)]
(string j "/../../bin"))))
(string exe-dir "/../include/janet")))
(def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH")
(if-let [j (dyn :syspath)]
(string j "/.."))))
(string exe-dir "/../lib")))
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
(string (dyn :syspath) "/bin")))
#
# Compilation Defaults
@@ -116,8 +124,6 @@
(def env (fiber/getenv (fiber/current)))
(def threads? (not (not (env 'thread/new))))
(print "threads " threads?)
# Default flags for natives, but not required
(def default-lflags (if is-win ["/nologo"] []))
(def default-cflags
@@ -125,7 +131,6 @@
["/nologo" "/MD"]
["-std=c99" "-Wall" "-Wextra"]))
# Link to pthreads
(def- thread-flags (if is-win [] (if threads? ["-lpthread"] [])))
@@ -582,16 +587,20 @@ int main(int argc, const char **argv) {
(rm manifest)
(print "Uninstalled."))
(defn- rimraf
"Hard delete directory tree"
[path]
(if is-win
# windows get rid of read-only files
(os/shell `rmdir /S /Q "` path `"`))
(rm path))
(defn clear-cache
"Clear the global git cache."
[]
(def cache (find-cache))
(print "clearing " cache "...")
(if is-win
# Git for windows decided that .git should be hidden and everything in it read-only.
# This means we can't delete things easily.
(os/shell (string `rmdir /S /Q "` cache `"`))
(rm cache)))
(rimraf cache))
(def- default-pkglist (or (os/getenv "JANET_PKGLIST") "https://github.com/janet-lang/pkgs.git"))
@@ -626,7 +635,9 @@ int main(int argc, const char **argv) {
(when (mkdir module-dir)
(set fresh true)
(print "cloning repository " repo " to " module-dir)
(os/execute ["git" "clone" repo module-dir] :p))
(unless (zero? (os/execute ["git" "clone" repo module-dir] :p))
(rimraf module-dir)
(error (string "could not clone git dependency " repo))))
(def olddir (os/cwd))
(try
(with-dyns [:rules @{}
@@ -741,10 +752,11 @@ int main(int argc, const char **argv) {
file is evaluated and a main function is looked for in the entry file. This function
is marshalled into bytecode which is then embedded in a final executable for distribution.\n\n
This executable can be installed as well to the --binpath given."
[&keys {:install install :name name :entry entry :headers headers}]
[&keys {:install install :name name :entry entry :headers headers
:cflags cflags :lflags lflags}]
(def name (if is-win (string name ".exe") name))
(def dest (string "build" sep name))
(create-executable @{} entry dest)
(create-executable @{:cflags cflags :lflags lflags} entry dest)
(add-dep "build" dest)
(when headers
(each h headers (add-dep dest h)))
@@ -866,6 +878,7 @@ Subcommands are:
and install the current project.
uninstall (module) : uninstall a module. If no module is given, uninstall the module
defined by the current directory.
show-paths : prints the paths that will be used to install things.
clean : remove any generated files or artifacts
test : run tests. Tests should be .janet files in the test/ directory relative to project.janet.
deps : install dependencies for the current project.
@@ -896,6 +909,14 @@ Flags are:
[]
(print help))
(defn- show-paths
[]
(print "binpath: " (dyn :binpath JANET_BINPATH))
(print "modpath: " (dyn :modpath JANET_MODPATH))
(print "libpath: " (dyn :libpath JANET_LIBPATH))
(print "headerpath: " (dyn :headerpath JANET_HEADERPATH))
(print "syspath: " (dyn :syspath)))
(defn- build
[]
(local-rule "build"))
@@ -947,6 +968,7 @@ Flags are:
"test" test
"help" help
"deps" deps
"show-paths" show-paths
"clear-cache" clear-cache
"run" local-rule
"rules" list-rules

View File

@@ -33,20 +33,6 @@ mkdir build\core
mkdir build\mainclient
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 Generate the embedded sources
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\boot\boot.gen.obj build\boot.gen.c
@if errorlevel 1 goto :BUILDFAIL
@rem Build the bootstrap interpreter
for %%f in (src\core\*.c) do (
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
@@ -58,48 +44,25 @@ for %%f in (src\boot\*.c) do (
)
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
@if errorlevel 1 goto :BUILDFAIL
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
build\janet_boot . > build\janet.c
@rem Build the sources
for %%f in (src\core\*.c) do (
%JANET_COMPILE% /Fobuild\core\%%~nf.obj %%f
@if errorlevel 1 goto :BUILDFAIL
)
%JANET_COMPILE% /Fobuild\janet.obj build\janet.c
@if errorlevel 1 goto :BUILDFAIL
%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
@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\core\*.obj build\mainclient\*.obj build\core_image.obj build\janet_win.res
%JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res
@if errorlevel 1 goto :BUILDFAIL
@rem Build static library (libjanet.a)
%JANET_LINK_STATIC% /out:build\libjanet.lib build\core\*.obj build\core_image.obj
%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
janet.exe tools\removecr.janet build\janet.c
@rem Gen shell.c
janet.exe tools\amalg.janet src\mainclient\line.h src\mainclient\line.c src\mainclient\main.c > build\shell.c
janet.exe tools\removecr.janet build\shell.c
echo === Successfully built janet.exe for Windows ===
echo === Run 'build_win test' to run tests. ==
echo === Run 'build_win clean' to delete build artifacts. ===
@@ -141,7 +104,7 @@ janet.exe tools\gendoc.janet > dist\doc.html
janet.exe tools\removecr.janet dist\doc.html
copy build\janet.c dist\janet.c
copy build\shell.c dist\shell.c
copy src\mainclient\shell.c dist\shell.c
copy janet.exe dist\janet.exe
copy LICENSE dist\LICENSE
copy README.md dist\README.md
@@ -157,7 +120,12 @@ copy auxbin\jpm dist\jpm
copy tools\jpm.bat dist\jpm.bat
@rem Create installer
"C:\Program Files (x86)\NSIS\makensis.exe" janet-installer.nsi
janet.exe -e "(->> janet/version (peg/match ''(* :d+ `.` :d+ `.` :d+)) first print)" > build\version.txt
janet.exe -e "(print (= (os/arch) :x64))" > build\64bit.txt
set /p JANET_VERSION= < build\version.txt
set /p SIXTYFOUR= < build\64bit.txt
echo "JANET_VERSION is %JANET_VERSION%"
"C:\Program Files (x86)\NSIS\makensis.exe" /DVERSION=%JANET_VERSION% /DSIXTYFOUR=%SIXTYFOUR% janet-installer.nsi
exit /b 0
@rem Run the installer. (Installs to the local user with default settings)

View File

@@ -69,14 +69,14 @@
(var last-loc [-2 -2])
(print "\n function: " (dasm 'name) " [" (in dasm 'source "") "]")
(when-let [constants (dasm 'constants)]
(printf " constants: %.4Q\n" constants))
(printf " slots: %.4Q\n\n" (frame :slots))
(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) "> " " "))
(printf "\e[33m%.20s\e[0m" (string (string/join (map string instr) " ") padding))
(prinf "\e[33m%.20s\e[0m" (string (string/join (map string instr) " ") padding))
(when sourcemap
(let [[sl sc] (sourcemap i)
loc [sl sc]]

View File

@@ -10,8 +10,7 @@
(defn make-worker
[name interval]
(-> (thread/new)
(:send worker-main)
(-> (thread/new worker-main)
(:send name)
(:send interval)))
@@ -39,8 +38,7 @@
(if (< depth 5)
(do
(defn subtree []
(-> (thread/new)
(:send worker-tree)
(-> (thread/new worker-tree)
(:send (string name "/" (choose "bob" "marley" "harry" "suki" "anna" "yu")))
(:send (inc depth))))
(let [l (subtree)
@@ -51,7 +49,7 @@
(do
(:send parent [name]))))
(-> (thread/new) (:send worker-tree) (:send "adam") (:send 0))
(-> (thread/new worker-tree) (:send "adam") (:send 0))
(def lines (thread/receive))
(map print lines)

View File

@@ -1,5 +1,9 @@
Unicode True
!echo "Program Files: ${PROGRAMFILES}"
!addplugindir "tools\"
# Version
!define VERSION "1.6.0"
!define PRODUCT_VERSION "${VERSION}.0"
VIProductVersion "${PRODUCT_VERSION}"
VIFileVersion "${PRODUCT_VERSION}"
@@ -14,13 +18,13 @@ VIFileVersion "${PRODUCT_VERSION}"
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_VALUENAME ""
!define MULTIUSER_INSTALLMODE_INSTDIR "Janet-${VERSION}"
# For now, use 32 bit folder as build is 32 bit
# !define MULTIUSER_USE_PROGRAMFILES64
!if ${SIXTYFOUR} == "true"
!define MULTIUSER_USE_PROGRAMFILES64
!endif
# Includes
!include "MultiUser.nsh"
!include "MUI2.nsh"
!include ".\tools\EnvVarUpdate.nsh"
!include "LogicLib.nsh"
# Basics
@@ -124,6 +128,15 @@ section "Janet" BfWSection
# Start Menu
createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico"
# Update path
${If} $MultiUser.InstallMode == "AllUsers"
EnVar::SetHKLM
${Else}
EnVar::SetHKCU
${EndIf}
EnVar::AddValue "PATH" "$INSTDIR\bin"
Pop $0
# Set up Environment variables
!insertmacro WriteEnv JANET_PATH "$INSTDIR\Library"
!insertmacro WriteEnv JANET_HEADERPATH "$INSTDIR\C"
@@ -132,13 +145,6 @@ section "Janet" BfWSection
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
# Update path
${If} $MultiUser.InstallMode == "AllUsers"
${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append
${Else}
${EnvVarUpdate} $0 "PATH" "A" "HKCU" "$INSTDIR\bin" ; Append
${EndIf}
# Registry information for add/remove programs
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayName" "Janet"
WriteRegStr SHCTX "${UNINST_KEY}" "InstallLocation" "$INSTDIR"
@@ -185,10 +191,12 @@ section "uninstall"
# Unset PATH
${If} $MultiUser.InstallMode == "AllUsers"
${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove
EnVar::SetHKLM
${Else}
${un.EnvVarUpdate} $0 "PATH" "R" "HKCU" "$INSTDIR\bin" ; Remove
EnVar::SetHKCU
${EndIf}
EnVar::DeleteValue "PATH" "$INSTDIR\bin"
Pop $0
# make sure windows knows about the change
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000

104
janet.1
View File

@@ -9,8 +9,8 @@ janet \- run the Janet language abstract machine
[\fB\-m\fR \fIPATH\fR]
[\fB\-c\fR \fIMODULE JIMAGE\fR]
[\fB\-\-\fR]
.IR script
.IR args ...
.BR script
.BR args ...
.SH DESCRIPTION
Janet is a functional and imperative programming language and bytecode interpreter.
It is a modern lisp, but lists are replaced by other data structures with better utility
@@ -25,6 +25,106 @@ 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\-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 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

15
jpm.1
View File

@@ -36,7 +36,7 @@ If passed to jpm install, runs tests before installing. Will run tests recursive
.TP
.BR \-\-modpath=/some/path
Set the path to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath) in that order.
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
@@ -139,6 +139,10 @@ like make. run will run a single rule or build a single file.
.BR rules
List all rules that can be run via run. This is useful for exploring rules in the project.
.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
@@ -172,7 +176,8 @@ This variable is overwritten by the --modpath=/some/path if it is provided.
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
(dyn :syspath)/../../include/janet. The --headerpath=/some/path will override this variable.
<jpm script location>/../include/janet. The --headerpath=/some/path option will override this
variable.
.RE
.B JANET_LIBPATH
@@ -180,15 +185,15 @@ default includes on your system, this value is not required. If not provided, wi
Similar to JANET_HEADERPATH, this path is where jpm will look for
libjanet.a for creating standalong executables. This does not need to be
set on a normal install.
If not provided, this will default to (dyn :syspath)/../../lib.
The --libpath=/some/path will override this variable.
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)/../../lib.
(dyn :syspath)/bin
The --binpath=/some/path will override this variable.
.RE

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2019 Calvin Rose and contributors
# Copyright (c) 2020 Calvin Rose and contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.6.0-dev')
version : '1.6.1-dev')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -62,6 +62,7 @@ conf.set('JANET_NO_PEG', not get_option('peg'))
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
conf.set('JANET_NO_TYPED_ARRAY', not get_option('typed_array'))
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
conf.set('JANET_NO_PRF', not 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'))
@@ -78,16 +79,10 @@ jconf = configure_file(output : 'janetconf.h',
# Include directories
incdir = include_directories(['src/include', '.'])
# Building generated sources
xxd = executable('xxd', 'tools/xxd.c', native : true)
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')
# 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',
@@ -149,24 +144,27 @@ boot_src = [
]
mainclient_src = [
'src/mainclient/line.c',
'src/mainclient/main.c'
'src/mainclient/shell.c'
]
# Build boot binary
janet_boot = executable('janet-boot', core_src, boot_src, boot_gen,
janet_boot = executable('janet-boot', core_src, boot_src,
include_directories : incdir,
c_args : '-DJANET_BOOTSTRAP',
dependencies : [m_dep, dl_dep, thread_dep],
native : true)
# Build core image
core_image = custom_target('core_image',
# Build janet.c
janetc = custom_target('janetc',
input : [janet_boot],
output : 'core_image.gen.c',
command : [janet_boot, '@OUTPUT@', 'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path])
output : 'janet.c',
capture : true,
command : [
janet_boot, '@CURRENT_SOURCE_DIR@',
'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path
])
libjanet = library('janet', core_src, core_image,
libjanet = library('janet', janetc,
include_directories : incdir,
dependencies : [m_dep, dl_dep, thread_dep],
install : true)
@@ -186,14 +184,14 @@ else
extra_cross_cflags = []
endif
janet_mainclient = executable('janet', core_src, core_image, mainclient_src,
janet_mainclient = executable('janet', janetc, mainclient_src,
include_directories : incdir,
dependencies : [m_dep, dl_dep, thread_dep],
c_args : extra_native_cflags,
install : true)
if meson.is_cross_build()
janet_nativeclient = executable('janet-native', core_src, core_image, mainclient_src,
janet_nativeclient = executable('janet-native', janetc, mainclient_src,
include_directories : incdir,
dependencies : [m_dep, dl_dep, thread_dep],
c_args : extra_cross_cflags,
@@ -209,25 +207,6 @@ docs = custom_target('docs',
capture : true,
command : [janet_nativeclient, '@INPUT@'])
# Amalgamated source
amalg = custom_target('amalg',
input : ['tools/amalg.janet', core_headers, core_src, core_image],
output : ['janet.c'],
capture : true,
command : [janet_nativeclient, '@INPUT@'])
amalg_shell = custom_target('amalg-shell',
input : ['tools/amalg.janet', 'src/mainclient/line.h',
'src/mainclient/line.c', 'src/mainclient/main.c'],
output : ['shell.c'],
capture : true,
command : [janet_nativeclient, '@INPUT@'])
# Amalgamated client
janet_amalgclient = executable('janet-amalg', amalg, amalg_shell,
include_directories : incdir,
dependencies : [m_dep, dl_dep, thread_dep],
build_by_default : false)
# Tests
test_files = [
'test/suite0.janet',
@@ -257,5 +236,5 @@ install_headers(['src/include/janet.h', jconf], subdir: 'janet')
janet_binscripts = [
'auxbin/jpm'
]
install_data(sources : janet_binscripts, install_dir : 'bin')
install_data(sources : ['tools/.keep'], install_dir : 'lib/janet')
install_data(sources : janet_binscripts, install_dir : get_option('bindir'))
install_data(sources : ['tools/.keep'], install_dir : join_paths(get_option('libdir'), 'janet'))

View File

@@ -10,6 +10,7 @@ option('assembler', type : 'boolean', value : true)
option('peg', type : 'boolean', value : true)
option('typed_array', type : 'boolean', value : true)
option('int_types', type : 'boolean', value : true)
option('prf', type : 'boolean', value : true)
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +23,13 @@
#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;
@@ -63,13 +70,41 @@ int main(int argc, const char **argv) {
janet_def(env, "boot/config", janet_wrap_table(opts), "Boot options");
/* Run bootstrap script to generate core image */
const char *boot_file;
const char *boot_filename;
#ifdef JANET_NO_SOURCEMAPS
boot_file = NULL;
boot_filename = NULL;
#else
boot_file = "boot.janet";
boot_filename = "boot.janet";
#endif
status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, boot_file, NULL);
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 = 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, boot_size, boot_filename, NULL);
/* Deinitialize vm */
janet_deinit();

View File

@@ -1,5 +1,5 @@
# The core janet library
# Copyright 2019 © Calvin Rose
# Copyright 2020 © Calvin Rose
###
###
@@ -58,6 +58,11 @@
[name & more]
~(def ,name :private ,;more))
(defmacro var-
"Define a private var that will not be exported."
[name & more]
~(var ,name :private ,;more))
(defn defglobal
"Dynamically create a global def."
[name value]
@@ -74,12 +79,12 @@
# Basic predicates
(defn nan? "Check if x is NaN" [x] (not= x x))
(defn even? "Check if x is even." [x] (== 0 (% x 2)))
(defn even? "Check if x is even." [x] (= 0 (% x 2)))
(defn odd? "Check if x is odd." [x] (not= 0 (% x 2)))
(defn zero? "Check if x is zero." [x] (== x 0))
(defn zero? "Check if x is zero." [x] (= x 0))
(defn pos? "Check if x is greater than 0." [x] (> x 0))
(defn neg? "Check if x is less than 0." [x] (< x 0))
(defn one? "Check if x is equal to 1." [x] (== x 1))
(defn one? "Check if x is equal to 1." [x] (= x 1))
(defn number? "Check if x is a number." [x] (= (type x) :number))
(defn fiber? "Check if x is a fiber." [x] (= (type x) :fiber))
(defn string? "Check if x is a string." [x] (= (type x) :string))
@@ -131,6 +136,11 @@
(defmacro /= "Shorthand for (set x (/ x n))." [x n] ~(set ,x (,/ ,x ,n)))
(defmacro %= "Shorthand for (set x (% x n))." [x n] ~(set ,x (,% ,x ,n)))
(defn assert
"Throw an error if x is not truthy."
[x &opt err]
(if x x (error (if err err "assert failure"))))
(defmacro default
"Define a default value for an optional argument.
Expands to (def sym (if (= nil sym) val sym))"
@@ -219,7 +229,7 @@
r (gensym)]
~(let [,f (,fiber/new (fn [] ,body) :ie)
,r (,resume ,f)]
(if (= (,fiber/status ,f) :error)
(if (,= (,fiber/status ,f) :error)
(do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
,r))))
@@ -276,20 +286,43 @@
(++ i))
~(let (,;accum) ,;body))
(defmacro defer
"Run form unconditionally after form, even if the body throws an error."
[form & body]
(with-syms [f r]
~(do
(def ,f (,fiber/new (fn [] ,;body) :ie))
(def ,r (,resume ,f))
,form
(if (= (,fiber/status ,f) :dead)
,r
(propagate ,r ,f)))))
(defmacro with
"Evaluate body with some resource, which will be automatically cleaned up
if there is an error in body. binding is bound to the expression ctor, and
dtor is a function or callable that is passed the binding. If no destructor
(dtor) is given, will call :close on the resource."
[[binding ctor dtor] & body]
(with-syms [res f]
~(let [,binding ,ctor
,f (,fiber/new (fn [] ,;body) :ie)
,res (,resume ,f)]
(,(or dtor :close) ,binding)
(if (,= (,fiber/status ,f) :error)
(,propagate ,res ,f)
,res))))
~(do
(def ,binding ,ctor)
,(apply defer [(or dtor :close) binding] body)))
(defmacro when-with
"Similar to with, but if binding is false or nil, returns
nil without evaluating the body. Otherwise, the same as with."
[[binding ctor dtor] & body]
~(if-let [,binding ,ctor]
,(apply defer [(or dtor :close) binding] body)))
(defmacro if-with
"Similar to with, but if binding is false or nil, evaluates
the falsey path. Otherwise, evaluates the truthy path. In both cases,
ctor is bound to binding."
[[binding ctor dtor] truthy &opt falsey ]
~(if-let [,binding ,ctor]
,(apply defer [(or dtor :close) binding] [truthy])
,falsey))
(defn- for-template
[binding start stop step comparison delta body]
@@ -303,17 +336,16 @@
(set ,i (,delta ,i ,step))))))
(defn- each-template
[binding in body]
(with-syms [i len]
(def ds (if (idempotent? in) in (gensym)))
[binding inx body]
(with-syms [k]
(def ds (if (idempotent? inx) inx (gensym)))
~(do
(var ,i 0)
,(unless (= ds in) ~(def ,ds ,in))
(def ,len (,length ,ds))
(while (,< ,i ,len)
(def ,binding (in ,ds ,i))
,(unless (= ds inx) ~(def ,ds ,inx))
(var ,k (,next ,ds nil))
(while (,not= nil ,k)
(def ,binding (,in ,ds ,k))
,;body
(++ ,i)))))
(set ,k (,next ,ds ,k))))))
(defn- keys-template
[binding in pair? body]
@@ -322,7 +354,7 @@
~(do
,(unless (= ds in) ~(def ,ds ,in))
(var ,k (,next ,ds nil))
(while ,k
(while (,not= nil ,k)
(def ,binding ,(if pair? ~(tuple ,k (in ,ds ,k)) k))
,;body
(set ,k (,next ,ds ,k))))))
@@ -391,10 +423,20 @@
[i start stop & body]
(for-template i start stop 1 < + body))
(defmacro eachk
"loop over each key in ds. returns nil."
[x ds & body]
(keys-template x ds false body))
(defmacro eachp
"Loop over each (key, value) pair in ds. Returns nil."
[x ds & body]
(keys-template x ds true body))
(defmacro each
"Loop over each value in ind. Returns nil."
[x ind & body]
(each-template x ind body))
"Loop over each value in ds. Returns nil."
[x ds & body]
(each-template x ds body))
(defmacro loop
"A general purpose loop macro. This macro is similar to the Common Lisp
@@ -551,16 +593,6 @@
"Returns the numeric minimum of the arguments."
[& args] (extreme < args))
(defn max-order
"Returns the maximum of the arguments according to a total
order over all values."
[& args] (extreme order> args))
(defn min-order
"Returns the minimum of the arguments according to a total
order over all values."
[& args] (extreme order< args))
(defn first
"Get the first element from an indexed data structure."
[xs]
@@ -605,11 +637,11 @@
a)
(fn sort [a &opt by]
(sort-help a 0 (- (length a) 1) (or by order<)))))
(sort-help a 0 (- (length a) 1) (or by <)))))
(defn sorted
"Returns a new sorted array without modifying the old one."
[ind by]
[ind &opt by]
(sort (array/slice ind) by))
(defn reduce
@@ -729,8 +761,10 @@
[n ind]
(def use-str (bytes? ind))
(def f (if use-str string/slice tuple/slice))
(def len (length ind))
# make sure end is in [0, len]
(def end (max 0 (min n (length ind))))
(def m (if (> n 0) n 0))
(def end (if (> m len) len m))
(f ind 0 end))
(defn take-until
@@ -754,8 +788,10 @@
[n ind]
(def use-str (bytes? ind))
(def f (if use-str string/slice tuple/slice))
(def len (length ind))
# make sure start is in [0, len]
(def start (max 0 (min n (length ind))))
(def m (if (> n 0) n 0))
(def start (if (> m len) len m))
(f ind start -1))
(defn drop-until
@@ -1427,7 +1463,7 @@
(if-let [[path line col] sm]
(string " " path " on line " line ", column " col "\n") "")
(if (or d sm) "\n" "")
(if d (doc-format d) "no documentation found.")
(if d (doc-format d) " no documentation found.")
"\n\n"))))
# else
@@ -1520,7 +1556,8 @@
'quote identity
'quasiquote expandqq
'var expanddef
'while expandall})
'while expandall
'break expandall})
(defn dotup [t]
(def h (in t 0))
@@ -1552,7 +1589,7 @@
ret)
(defn some
"Returns false if all xs are false or nil, otherwise returns the first true value."
"Returns nil if all xs are false or nil, otherwise returns the first true value."
[pred xs]
(var ret nil)
(loop [x :in xs :while (not ret)] (if-let [y (pred x)] (set ret y)))
@@ -1677,6 +1714,32 @@
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol '$ i)))
~(fn [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
###
###
### Default PEG patterns
###
###
(def default-peg-grammar
"The default grammar used for pegs. This grammar defines several common patterns
that should make it easier to write more complex patterns."
~@{:d (range "09")
:a (range "az" "AZ")
:s (set " \t\r\n\0\f")
:w (range "az" "AZ" "09")
:S (if-not :s 1)
:W (if-not :w 1)
:A (if-not :a 1)
:D (if-not :d 1)
:d+ (some :d)
:a+ (some :a)
:s+ (some :s)
:w+ (some :w)
:d* (any :d)
:a* (any :a)
:w* (any :w)
:s* (any :s)})
###
###
### Evaluation and Compilation
@@ -1718,14 +1781,15 @@
"Default handler for a compile error."
[msg macrof where]
(def ec (dyn :err-color))
(eprint
(if ec "\e[31m" "")
"compile error: "
msg
" while compiling "
where
(if ec "\e[0m" ""))
(when macrof (debug/stacktrace macrof)))
(if macrof
(debug/stacktrace macrof (string msg " while compiling " where))
(eprint
(if ec "\e[31m" "")
"compile error: "
msg
" while compiling "
where
(if ec "\e[0m" ""))))
(defn run-context
"Run a context. This evaluates expressions of janet in an environment,
@@ -1752,7 +1816,7 @@
:source where
:expander expand} opts)
(default env (fiber/getenv (fiber/current)))
(default chunks (fn [buf p] (getline "" buf)))
(default chunks (fn [buf p] (getline "" buf env)))
(default onstatus debug/stacktrace)
(default on-compile-error bad-compile)
(default on-parse-error bad-parse)
@@ -1898,27 +1962,33 @@
from searching that path template if the filter doesn't match the input
path. The filter can be a string or a predicate function, and
is often a file extension, including the period."
@[# Relative to (dyn :current-file "./."). Path must start with .
[":cur:/:all:.jimage" :image check-.]
[":cur:/:all:.janet" :source check-.]
[":cur:/:all:/init.janet" :source check-.]
[":cur:/:all::native:" :native check-.]
# As a path from (os/cwd)
[":all:.jimage" :image not-check-.]
[":all:.janet" :source not-check-.]
[":all:/init.janet" :source not-check-.]
[":all::native:" :native not-check-.]
# System paths
[":sys:/:all:.jimage" :image not-check-.]
[":sys:/:all:.janet" :source not-check-.]
[":sys:/:all:/init.janet" :source not-check-.]
[":sys:/:all::native:" :native not-check-.]])
@[])
(setdyn :syspath (boot/opts "JANET_PATH"))
(setdyn :headerpath (boot/opts "JANET_HEADERPATH"))
(defn module/add-paths
"Add paths to module/paths for a given loader such that
the generated paths behave like other module types, including
relative imports and syspath imports. ext is the file extension
to associate with this module type, including the dot. loader is the
keyword name of a loader that is module/loaders. Returns the modified module/paths."
[ext loader]
(defn- find-prefix
[pre]
(or (find-index |(string/has-prefix? pre ($ 0)) module/paths) 0))
(array/insert module/paths 0 [(string ":cur:/:all:" ext) loader check-.])
(def all-index (find-prefix ":all:"))
(array/insert module/paths all-index [(string ":all:" ext) loader not-check-.])
(def sys-index (find-prefix ":sys:"))
(array/insert module/paths sys-index [(string ":sys:/:all:" ext) loader not-check-.])
module/paths)
(module/add-paths ":native:" :native)
(module/add-paths "/init.janet" :source)
(module/add-paths ".janet" :source)
(module/add-paths ".jimage" :image)
# Version of fexists that works even with a reduced OS
(if-let [has-stat (_env 'os/stat)]
(let [stat (has-stat :value)]
@@ -2045,7 +2115,7 @@
(if-let [check (in module/cache fullpath)]
check
(do
(def loader (module/loaders mod-kind))
(def loader (if (keyword? mod-kind) (module/loaders mod-kind) mod-kind))
(unless loader (error (string "module type " mod-kind " unknown")))
(def env (loader fullpath args))
(put module/cache fullpath env)
@@ -2060,7 +2130,10 @@
:prefix prefix
:export ep} (table ;args))
(def newenv (require path ;args))
(def prefix (or (and as (string as "/")) prefix (string path "/")))
(def prefix (or
(and as (string as "/"))
prefix
(string (last (string/split "/" path)) "/")))
(loop [[k v] :pairs newenv :when (symbol? k) :when (not (v :private))]
(def newv (table/setproto @{:private (not ep)} v))
(put env (symbol prefix k) newv)))
@@ -2072,7 +2145,7 @@
use the name of the module as a prefix. One can also use :export true
to re-export the imported symbols. If :exit true is given as an argument,
any errors encountered at the top level in the module will cause (os/exit 1)
to be called."
to be called. Dynamic bindings will NOT be imported."
[path & args]
(def argm (map (fn [x]
(if (keyword? x)
@@ -2105,7 +2178,7 @@
((parser/where p) 0)
":"
(parser/state p :delimiters) "> ")
buf)))
buf env)))
(defn make-onsignal
[e level]
@@ -2120,7 +2193,7 @@
(def status (parser/state p :delimiters))
(def c ((parser/where p) 0))
(def prompt (string "debug[" level "]:" c ":" status "> "))
(getline prompt buf))
(getline prompt buf nextenv))
(print "entering debug[" level "] - (quit) to exit")
(repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv)
(print "exiting debug[" level "]")
@@ -2246,23 +2319,24 @@
(when (and (not *compile-only*) (or *should-repl* *no-file*))
(if-not *quiet*
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2020 Calvin Rose"))
(defn noprompt [_] "")
(defn getprompt [p]
(def [line] (parser/where p))
(string "janet:" line ":" (parser/state p :delimiters) "> "))
(def prompter (if *quiet* noprompt getprompt))
(defn getstdin [prompt buf]
(defn getstdin [prompt buf _]
(file/write stdout prompt)
(file/flush stdout)
(file/read stdin :line buf))
(def env (make-env))
(def getter (if *raw-stdin* getstdin getline))
(defn getchunk [buf p]
(getter (prompter p) buf))
(getter (prompter p) buf env))
(def onsig (if *quiet* (fn [x &] x) nil))
(setdyn :pretty-format (if *colorize* "%.20Q" "%.20q"))
(setdyn :err-color (if *colorize* true))
(repl getchunk onsig)))
(repl getchunk onsig env)))
###
@@ -2317,21 +2391,88 @@
reverse-lookup (invert lookup)]
(marshal env reverse-lookup)))
# Create amalgamation
(def local-headers
["src/core/features.h"
"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"])
(def core-sources
["src/core/abstract.c"
"src/core/array.c"
"src/core/asm.c"
"src/core/buffer.c"
"src/core/bytecode.c"
"src/core/capi.c"
"src/core/cfuns.c"
"src/core/compile.c"
"src/core/corelib.c"
"src/core/debug.c"
"src/core/emit.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/os.c"
"src/core/parse.c"
"src/core/peg.c"
"src/core/pp.c"
"src/core/regalloc.c"
"src/core/run.c"
"src/core/specials.c"
"src/core/string.c"
"src/core/strtod.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"
"src/core/vm.c"
"src/core/wrap.c"])
# Print janet.c to stdout
(print "/* Amalgamated build - DO NOT EDIT */")
(print "/* Generated from janet version " janet/version "-" janet/build " */")
(print "#define JANET_BUILD \"" janet/build "\"")
(print ```#define JANET_AMALG```)
(print ```#define _POSIX_C_SOURCE 200112L```)
(print ```#include "janet.h"```)
(defn do-one-flie
[fname]
(print "\n/* " fname " */\n")
(def source (slurp fname))
(print (string/replace-all "\r" "" source)))
(each h local-headers
(do-one-flie h))
(each s core-sources
(do-one-flie s))
# Create C source file that contains images a uint8_t buffer. This
# can be compiled and linked statically into the main janet library
# and example client.
(def chunks (string/bytes image))
(def image-file (file/open (boot/args 1) :wb))
(file/write image-file
"#ifndef JANET_AMALG\n"
"#include <janet.h>\n"
"#endif\n"
"static const unsigned char janet_core_image_bytes[] = {\n")
(loop [line :in (partition 10 chunks)]
(def str (string ;(interpose ", " (map (partial string/format "0x%.2X") line))))
(file/write image-file " " str ",\n"))
(file/write image-file
" 0\n};\n\n"
"const unsigned char *janet_core_image = janet_core_image_bytes;\n"
"size_t janet_core_image_size = sizeof(janet_core_image_bytes);\n")
(file/close image-file))
(print "static const unsigned char janet_core_image_bytes[] = {")
(loop [line :in (partition 16 image)]
(prin " ")
(each b line
(prinf "0x%.2X, " b))
(print))
(print " 0\n};\n")
(print "const unsigned char *janet_core_image = janet_core_image_bytes;")
(print "size_t janet_core_image_size = sizeof(janet_core_image_bytes);"))

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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
@@ -28,9 +28,9 @@
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 6
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_PATCH 1
#define JANET_VERSION_EXTRA "-dev"
#define JANET_VERSION "1.6.0-dev"
#define JANET_VERSION "1.6.1-dev"
/* #define JANET_BUILD "local" */
@@ -51,6 +51,7 @@
/* #define JANET_NO_PEG */
/* #define JANET_NO_TYPED_ARRAY */
/* #define JANET_NO_INT_TYPES */
/* #define JANET_NO_PRF */
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
/* #define JANET_RECURSION_GUARD 1024 */
/* #define JANET_MAX_PROTO_DEPTH 200 */

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "gc.h"
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "gc.h"
#include "util.h"
@@ -35,7 +36,7 @@ JanetArray *janet_array(int32_t capacity) {
Janet *data = NULL;
if (capacity > 0) {
janet_vm_next_collection += capacity * sizeof(Janet);
data = (Janet *) malloc(sizeof(Janet) * capacity);
data = (Janet *) malloc(sizeof(Janet) * (size_t) capacity);
if (NULL == data) {
JANET_OUT_OF_MEMORY;
}
@@ -51,11 +52,11 @@ 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 = malloc(sizeof(Janet) * n);
array->data = malloc(sizeof(Janet) * (size_t) n);
if (!array->data) {
JANET_OUT_OF_MEMORY;
}
memcpy(array->data, elements, sizeof(Janet) * n);
safe_memcpy(array->data, elements, sizeof(Janet) * n);
return array;
}
@@ -92,6 +93,9 @@ 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;
@@ -125,6 +129,28 @@ 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);
@@ -140,9 +166,12 @@ 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, (argc - 1) * sizeof(Janet));
if (argc > 1) memcpy(array->data + array->count, argv + 1, (size_t)(argc - 1) * sizeof(Janet));
array->count = newcount;
return argv[0];
}
@@ -202,11 +231,16 @@ 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);
memmove(array->data + at + argc - 2,
array->data + at,
restsize);
memcpy(array->data + at, argv + 2, chunksize);
if (restsize) {
memmove(array->data + at + argc - 2,
array->data + at,
restsize);
}
safe_memcpy(array->data + at, argv + 2, chunksize);
array->count += (argc - 2);
return argv[0];
}
@@ -243,6 +277,17 @@ 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"

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#endif
@@ -77,17 +78,17 @@ static const JanetInstructionDef janet_ops[] = {
{"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},
{"gten", JOP_NUMERIC_GREATER_THAN_EQUAL},
{"gte", JOP_GREATER_THAN_EQUAL},
{"gtim", JOP_GREATER_THAN_IMMEDIATE},
{"gtn", JOP_NUMERIC_GREATER_THAN},
{"in", JOP_IN},
{"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},
@@ -98,9 +99,8 @@ static const JanetInstructionDef janet_ops[] = {
{"ldu", JOP_LOAD_UPVALUE},
{"len", JOP_LENGTH},
{"lt", JOP_LESS_THAN},
{"lten", JOP_NUMERIC_LESS_THAN_EQUAL},
{"lte", JOP_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,10 +108,12 @@ 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},
{"next", JOP_NEXT},
{"noop", JOP_NOOP},
{"prop", JOP_PROPAGATE},
{"push", JOP_PUSH},
@@ -120,6 +122,7 @@ static const JanetInstructionDef janet_ops[] = {
{"pusha", JOP_PUSH_ARRAY},
{"put", JOP_PUT},
{"puti", JOP_PUT_INDEX},
{"rem", JOP_REMAINDER},
{"res", JOP_RESUME},
{"ret", JOP_RETURN},
{"retn", JOP_RETURN_NIL},
@@ -173,17 +176,25 @@ static void janet_asm_deinit(JanetAssembler *a) {
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);
longjmp(a->on_error, 1);
janet_asm_longjmp(a);
}
#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;
longjmp(a->on_error, 1);
janet_asm_longjmp(a);
}
/* Add a closure environment to the assembler. Sub funcdefs may need
@@ -501,10 +512,14 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
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);
longjmp(a.parent->on_error, 1);
janet_asm_longjmp(a.parent);
}
result.funcdef = NULL;
result.error = a.errmessage;
@@ -570,7 +585,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
x = janet_get1(s, janet_csymbolv("constants"));
if (janet_indexed_view(x, &arr, &count)) {
def->constants_length = count;
def->constants = malloc(sizeof(Janet) * count);
def->constants = malloc(sizeof(Janet) * (size_t) count);
if (NULL == def->constants) {
JANET_OUT_OF_MEMORY;
}
@@ -649,7 +664,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
}
/* Allocate bytecode array */
def->bytecode_length = blength;
def->bytecode = malloc(sizeof(uint32_t) * blength);
def->bytecode = malloc(sizeof(uint32_t) * (size_t) blength);
if (NULL == def->bytecode) {
JANET_OUT_OF_MEMORY;
}
@@ -691,7 +706,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
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 = malloc(sizeof(JanetSourceMapping) * count);
def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) count);
for (i = 0; i < count; i++) {
const Janet *tup;
Janet entry = arr[i];

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "gc.h"
#include "util.h"
@@ -31,8 +32,8 @@
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
uint8_t *data = NULL;
if (capacity > 0) {
janet_vm_next_collection += capacity;
data = malloc(sizeof(uint8_t) * capacity);
janet_gcpressure(capacity);
data = malloc(sizeof(uint8_t) * (size_t) capacity);
if (NULL == data) {
JANET_OUT_OF_MEMORY;
}
@@ -61,8 +62,8 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
if (capacity <= buffer->capacity) return;
int64_t big_capacity = ((int64_t) capacity) * growth;
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
janet_vm_next_collection += capacity - buffer->capacity;
new_data = realloc(old, capacity * sizeof(uint8_t));
janet_gcpressure(capacity - buffer->capacity);
new_data = realloc(old, (size_t) capacity * sizeof(uint8_t));
if (NULL == new_data) {
JANET_OUT_OF_MEMORY;
}
@@ -93,7 +94,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
if (new_size > buffer->capacity) {
int32_t new_capacity = new_size * 2;
uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
janet_vm_next_collection += new_capacity - buffer->capacity;
janet_gcpressure(new_capacity - buffer->capacity);
if (NULL == new_data) {
JANET_OUT_OF_MEMORY;
}
@@ -111,6 +112,7 @@ 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;
@@ -182,6 +184,19 @@ 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_u8(int32_t argc, Janet *argv) {
int32_t i;
janet_arity(argc, 1, -1);
@@ -324,11 +339,13 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
janet_panic("buffer blit out of range");
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);
if (length_src) {
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];
}
@@ -345,8 +362,8 @@ static const JanetReg buffer_cfuns[] = {
{
"buffer/new", cfun_buffer_new,
JDOC("(buffer/new capacity)\n\n"
"Creates a new, empty buffer with enough memory for capacity bytes. "
"Returns a new buffer.")
"Creates a new, empty buffer with enough backing memory for capacity bytes. "
"Returns a new buffer of length 0.")
},
{
"buffer/new-filled", cfun_buffer_new_filled,
@@ -354,6 +371,12 @@ static const JanetReg buffer_cfuns[] = {
"Creates a new buffer of length count filled with byte. By default, byte is 0. "
"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/push-byte", cfun_buffer_u8,
JDOC("(buffer/push-byte buffer x)\n\n"

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "gc.h"
#include "util.h"
@@ -40,6 +41,8 @@ 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, */
@@ -55,6 +58,8 @@ 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, */
@@ -93,11 +98,9 @@ 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_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 */
JINT_SSS, /* JOP_GREATER_THAN_EQUAL */
JINT_SSS, /* JOP_LESS_THAN_EQUAL */
JINT_SSS, /* JOP_NEXT */
};
/* Verify some bytecode */

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,31 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "state.h"
#include "fiber.h"
#endif
void janet_panicv(Janet message) {
void janet_signalv(JanetSignal sig, Janet message) {
if (janet_vm_return_reg != NULL) {
*janet_vm_return_reg = message;
longjmp(*janet_vm_jmp_buf, 1);
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
} else {
fputs((const char *)janet_formatc("janet top level panic - %v\n", message), stdout);
fputs((const char *)janet_formatc("janet top level signal - %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;
@@ -145,6 +155,13 @@ 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
@@ -168,6 +185,30 @@ 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)) {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "compile.h"
#include "emit.h"
@@ -111,6 +112,15 @@ static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
}
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_NEXT, janet_wrap_nil());
}
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_MODULO, janet_wrap_nil());
}
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_REMAINDER, janet_wrap_nil());
}
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
if (opts.flags & JANET_FOPTS_DROP) {
janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
@@ -235,41 +245,23 @@ static JanetSlot compreduce(
return t;
}
static JanetSlot do_order_gt(JanetFopts opts, JanetSlot *args) {
static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_GREATER_THAN, 0);
}
static JanetSlot do_order_lt(JanetFopts opts, JanetSlot *args) {
static JanetSlot do_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_NUMERIC_GREATER_THAN, 0);
}
static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_NUMERIC_LESS_THAN, 0);
}
static JanetSlot do_gte(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_NUMERIC_GREATER_THAN_EQUAL, 0);
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0);
}
static JanetSlot do_lte(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_NUMERIC_LESS_THAN_EQUAL, 0);
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0);
}
static JanetSlot do_eq(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_NUMERIC_EQUAL, 0);
return compreduce(opts, args, JOP_EQUALS, 0);
}
static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_NUMERIC_EQUAL, 1);
return compreduce(opts, args, JOP_EQUALS, 1);
}
/* Arranged by tag */
@@ -293,12 +285,6 @@ 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},
@@ -306,7 +292,10 @@ static const JanetFunOptimizer optimizers[] = {
{NULL, do_eq},
{NULL, do_neq},
{fixarity2, do_propagate},
{fixarity2, do_get}
{fixarity2, do_get},
{fixarity2, do_next},
{fixarity2, do_modulo},
{fixarity2, do_remainder},
};
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "compile.h"
#include "emit.h"
@@ -582,18 +583,21 @@ static int macroexpand1(
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();
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &x);
Janet tempOut;
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
janet_gcunlock(lock);
if (status != JANET_SIGNAL_OK) {
const uint8_t *es = janet_formatc("(macro) %V", x);
const uint8_t *es = janet_formatc("(macro) %V", tempOut);
c->result.macrofiber = fiberp;
janetc_error(c, es);
return 0;
} else {
*out = x;
*out = tempOut;
}
return 1;
@@ -704,20 +708,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) * def->bytecode_length;
size_t s = sizeof(int32_t) * (size_t) def->bytecode_length;
def->bytecode = malloc(s);
if (NULL == def->bytecode) {
JANET_OUT_OF_MEMORY;
}
memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
safe_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) * def->bytecode_length;
size_t s = sizeof(JanetSourceMapping) * (size_t) def->bytecode_length;
def->sourcemap = malloc(s);
if (NULL == def->sourcemap) {
JANET_OUT_OF_MEMORY;
}
memcpy(def->sourcemap, c->mapbuffer + scope->bytecode_start, s);
safe_memcpy(def->sourcemap, c->mapbuffer + scope->bytecode_start, s);
janet_v__cnt(c->mapbuffer) = scope->bytecode_start;
}
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +24,7 @@
#define JANET_COMPILE_H
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "regalloc.h"
#endif
@@ -48,20 +49,17 @@
#define JANET_FUN_RSHIFT 17
#define JANET_FUN_RSHIFTU 18
#define JANET_FUN_BNOT 19
#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
#define JANET_FUN_PROP 32
#define JANET_FUN_GET 33
#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
/* Compiler typedefs */
typedef struct JanetCompiler JanetCompiler;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include <math.h>
#include "compile.h"
@@ -345,7 +346,7 @@ 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;
memcpy(array->data, argv, argc * sizeof(Janet));
safe_memcpy(array->data, argv, argc * sizeof(Janet));
return janet_wrap_array(array);
}
@@ -401,17 +402,19 @@ static Janet janet_core_gccollect(int32_t argc, Janet *argv) {
static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
int32_t val = janet_getinteger(argv, 0);
if (val < 0)
janet_panic("expected non-negative integer");
janet_vm_gc_interval = val;
size_t s = janet_getsize(argv, 0);
/* limit interval to 48 bits */
if (s > 0xFFFFFFFFFFFFUl) {
janet_panic("interval too large");
}
janet_vm_gc_interval = s;
return janet_wrap_nil();
}
static Janet janet_core_gcinterval(int32_t argc, Janet *argv) {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_number(janet_vm_gc_interval);
return janet_wrap_number((double) janet_vm_gc_interval);
}
static Janet janet_core_type(int32_t argc, Janet *argv) {
@@ -424,20 +427,6 @@ 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]));
@@ -627,15 +616,6 @@ static const JanetReg corelib_cfuns[] = {
"\t:cfunction\n\n"
"or another symbol for an abstract type.")
},
{
"next", janet_core_next,
JDOC("(next dict &opt 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"
@@ -645,8 +625,10 @@ static const JanetReg corelib_cfuns[] = {
},
{
"getline", janet_core_getline,
JDOC("(getline &opt prompt buf)\n\n"
"Reads a line of input into a buffer, including the newline character, using a prompt. Returns the modified buffer. "
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 autocomplete. "
"Returns the modified buffer. "
"Use this function to implement a simple interface for a terminal program.")
},
{
@@ -945,6 +927,18 @@ 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
};
#endif /* ifdef JANET_BOOTSTRAP */
/*
@@ -987,6 +981,22 @@ static void janet_load_libs(JanetTable *env) {
JanetTable *janet_core_env(JanetTable *replacements) {
JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
janet_quick_asm(env, JANET_FUN_MODULO,
"mod", 2, 2, 2, 2, modulo_asm, sizeof(modulo_asm),
JDOC("(mod dividend divisor)\n\n"
"Returns the modulo of dividend / divisor."));
janet_quick_asm(env, JANET_FUN_REMAINDER,
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
JDOC("(% dividend divisor)\n\n"
"Returns the remainder of dividend / divisor."));
janet_quick_asm(env, JANET_FUN_NEXT,
"next", 2, 2, 2, 2, next_asm, sizeof(next_asm),
JDOC("(next ds &opt key)\n\n"
"Gets the next key in a datastructure. 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"
@@ -1090,46 +1100,24 @@ JanetTable *janet_core_env(JanetTable *replacements) {
"for positive shifts the return value will always be positive."));
/* Variadic comparators */
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"
"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"
"Return true if any values in xs are not equal, otherwise false."));
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_NUMERIC_GREATER_THAN,
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_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,
"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 numerically ascending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_NUMERIC_GREATER_THAN_EQUAL,
"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 numerically non-ascending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_NUMERIC_LESS_THAN_EQUAL,
"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 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."));
"Check if xs is in non-descending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS,
JDOC("(= & xs)\n\n"
"Check if all values in xs are equal. Returns a boolean."));
templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS,
JDOC("(not= & xs)\n\n"
"Check if any values in xs are not equal. Returns a boolean."));
/* Platform detection */
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "gc.h"
#include "state.h"
@@ -274,7 +275,7 @@ static Janet doframe(JanetStackFrame *frame) {
}
/* Add stack arguments */
slots = janet_array(def->slotcount);
memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
safe_memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
slots->count = def->slotcount;
janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "emit.h"
#include "vector.h"

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,17 +20,13 @@
* IN THE SOFTWARE.
*/
#ifndef JANET_LINE_H_defined
#define JANET_LINE_H_defined
/* Feature test macros */
#ifndef JANET_AMALG
#include <janet.h>
#ifndef JANET_FEATURES_H_defined
#define JANET_FEATURES_H_defined
#ifndef _POSIX_C_SOURCE
#define _POSIX_C_SOURCE 200112L
#endif
void janet_line_init();
void janet_line_deinit();
void janet_line_get(const char *p, JanetBuffer *buffer);
Janet janet_line_getter(int32_t argc, Janet *argv);
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "fiber.h"
#include "state.h"
@@ -34,7 +35,7 @@ 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;
fiber->flags = JANET_FIBER_MASK_YIELD | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
fiber->env = NULL;
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
}
@@ -46,7 +47,7 @@ static JanetFiber *fiber_alloc(int32_t capacity) {
capacity = 32;
}
fiber->capacity = capacity;
data = malloc(sizeof(Janet) * capacity);
data = malloc(sizeof(Janet) * (size_t) capacity);
if (NULL == data) {
JANET_OUT_OF_MEMORY;
}
@@ -64,7 +65,7 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
if (newstacktop >= fiber->capacity) {
janet_fiber_setcapacity(fiber, 2 * newstacktop);
}
memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
safe_memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
fiber->stacktop = newstacktop;
}
if (janet_fiber_funcframe(fiber, callee)) return NULL;
@@ -134,7 +135,7 @@ void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) {
if (newtop > fiber->capacity) {
janet_fiber_grow(fiber, newtop);
}
memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet));
safe_memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet));
fiber->stacktop = newtop;
}
@@ -210,13 +211,13 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
static void janet_env_detach(JanetFuncEnv *env) {
/* Check for closure environment */
if (env) {
size_t s = sizeof(Janet) * env->length;
size_t s = sizeof(Janet) * (size_t) env->length;
Janet *vmem = malloc(s);
janet_vm_next_collection += (uint32_t) s;
if (NULL == vmem) {
JANET_OUT_OF_MEMORY;
}
memcpy(vmem, env->as.fiber->data + env->offset, s);
safe_memcpy(vmem, env->as.fiber->data + env->offset, s);
env->offset = 0;
env->as.values = vmem;
}
@@ -368,7 +369,7 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
if (argc == 2) {
int32_t i;
JanetByteView view = janet_getbytes(argv, 1);
fiber->flags = 0;
fiber->flags = JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
for (i = 0; i < view.len; i++) {
if (view.bytes[i] >= '0' && view.bytes[i] <= '9') {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +27,34 @@
#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 0xFF0000
#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 {\

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "state.h"
#include "symcache.h"
@@ -28,26 +29,24 @@
#include "util.h"
#endif
struct JanetScratch {
JanetScratchFinalizer finalize;
long long mem[]; /* for proper alignment */
};
/* GC State */
JANET_THREAD_LOCAL void *janet_vm_blocks;
JANET_THREAD_LOCAL uint32_t janet_vm_gc_interval;
JANET_THREAD_LOCAL uint32_t janet_vm_next_collection;
JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
JANET_THREAD_LOCAL size_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 uint32_t janet_vm_root_count;
JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
JANET_THREAD_LOCAL size_t janet_vm_root_count;
JANET_THREAD_LOCAL size_t janet_vm_root_capacity;
/* Scratch Memory */
#ifdef JANET_64
#define SCRATCH_HDR_SIZE 16 /* smalloc must guarantee 16 byte alignment. */
#elif JANET_32
#define SCRATCH_HDR_SIZE 8 /* smalloc must guarantee 8 byte alignment. */
#else
#error "unknown scratch alignment"
#endif
JANET_THREAD_LOCAL void **janet_scratch_mem;
JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
JANET_THREAD_LOCAL size_t janet_scratch_cap;
JANET_THREAD_LOCAL size_t janet_scratch_len;
@@ -64,9 +63,14 @@ 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 */
/* Local state that is only temporary for gc */
static JANET_THREAD_LOCAL uint32_t depth = JANET_RECURSION_GUARD;
static JANET_THREAD_LOCAL uint32_t orig_rootcount;
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;
}
/* Mark a value */
void janet_mark(Janet x) {
@@ -347,18 +351,18 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
mem->flags = type;
/* Prepend block to heap list */
janet_vm_next_collection += (int32_t) size;
janet_vm_next_collection += size;
mem->next = janet_vm_blocks;
janet_vm_blocks = mem;
return (void *)mem;
}
static void free_one_scratch(void *mem) {
ScratchFinalizer finalize = *(ScratchFinalizer *)mem;
if (finalize)
finalize((char *)mem + SCRATCH_HDR_SIZE);
free(mem);
static void free_one_scratch(JanetScratch *s) {
if (NULL != s->finalize) {
s->finalize((char *) s->mem);
}
free(s);
}
/* Free all allocated scratch memory */
@@ -369,6 +373,11 @@ static void janet_free_all_scratch(void) {
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;
@@ -390,9 +399,9 @@ void janet_collect(void) {
* 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) {
uint32_t newcount = janet_vm_root_count + 1;
size_t newcount = janet_vm_root_count + 1;
if (newcount > janet_vm_root_capacity) {
uint32_t newcap = 2 * newcount;
size_t newcap = 2 * newcount;
janet_vm_roots = realloc(janet_vm_roots, sizeof(Janet) * newcap);
if (NULL == janet_vm_roots) {
JANET_OUT_OF_MEMORY;
@@ -472,36 +481,46 @@ void janet_gcunlock(int handle) {
/* Scratch memory API */
void *janet_smalloc(size_t size) {
void *mem = malloc(SCRATCH_HDR_SIZE + size);
if (NULL == mem) {
JanetScratch *s = malloc(sizeof(JanetScratch) + size);
if (NULL == s) {
JANET_OUT_OF_MEMORY;
}
*(ScratchFinalizer *)mem = NULL;
s->finalize = NULL;
if (janet_scratch_len == janet_scratch_cap) {
size_t newcap = 2 * janet_scratch_cap + 2;
void **newmem = (void **) realloc(janet_scratch_mem, newcap * sizeof(void *));
JanetScratch **newmem = (JanetScratch **) 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++] = mem;
return (char *)mem + SCRATCH_HDR_SIZE;
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);
mem = (char *)mem - SCRATCH_HDR_SIZE;
JanetScratch *s = janet_mem2scratch(mem);
if (janet_scratch_len) {
for (size_t i = janet_scratch_len - 1; ; i--) {
if (janet_scratch_mem[i] == mem) {
void *newmem = realloc(mem, size + SCRATCH_HDR_SIZE);
if (NULL == newmem) {
if (janet_scratch_mem[i] == s) {
JanetScratch *news = realloc(s, size + sizeof(JanetScratch));
if (NULL == news) {
JANET_OUT_OF_MEMORY;
}
janet_scratch_mem[i] = newmem;
return (char *)newmem + SCRATCH_HDR_SIZE;
janet_scratch_mem[i] = news;
return (char *)(news->mem);
}
if (i == 0) break;
}
@@ -509,19 +528,19 @@ void *janet_srealloc(void *mem, size_t size) {
janet_exit("invalid janet_srealloc");
}
void janet_sfinalizer(void *mem, ScratchFinalizer finalizer) {
mem = (char *)mem - SCRATCH_HDR_SIZE;
*(ScratchFinalizer *)mem = finalizer;
void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer) {
JanetScratch *s = janet_mem2scratch(mem);
s->finalize = finalizer;
}
void janet_sfree(void *mem) {
if (NULL == mem) return;
mem = (char *)mem - SCRATCH_HDR_SIZE;
JanetScratch *s = janet_mem2scratch(mem);
if (janet_scratch_len) {
for (size_t i = janet_scratch_len - 1; ; i--) {
if (janet_scratch_mem[i] == mem) {
if (janet_scratch_mem[i] == s) {
janet_scratch_mem[i] = janet_scratch_mem[--janet_scratch_len];
free_one_scratch(mem);
free_one_scratch(s);
return;
}
if (i == 0) break;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +24,7 @@
#define JANET_GC_H
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose & contributors
* Copyright (c) 2020 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
@@ -27,6 +27,7 @@
#include <math.h>
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#endif
@@ -39,6 +40,24 @@
static int it_s64_get(void *p, Janet key, Janet *out);
static int it_u64_get(void *p, Janet key, Janet *out);
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 void int64_marshal(void *p, JanetMarshalContext *ctx) {
janet_marshal_abstract(ctx, p);
janet_marshal_int64(ctx, *((int64_t *)p));
@@ -70,7 +89,10 @@ static const JanetAbstractType it_s64_type = {
NULL,
int64_marshal,
int64_unmarshal,
it_s64_tostring
it_s64_tostring,
janet_int64_compare,
janet_int64_hash,
JANET_ATEND_HASH
};
static const JanetAbstractType it_u64_type = {
@@ -81,7 +103,10 @@ static const JanetAbstractType it_u64_type = {
NULL,
int64_marshal,
int64_unmarshal,
it_u64_tostring
it_u64_tostring,
janet_uint64_compare,
janet_int64_hash,
JANET_ATEND_HASH
};
int64_t janet_unwrap_s64(Janet x) {
@@ -177,49 +202,50 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
for (int i = 1; i < argc; i++) \
for (int32_t i = 1; i < argc; i++) \
*box oper##= janet_unwrap_##type(argv[i]); \
return janet_wrap_abstract(box); \
} \
\
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]); \
#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(&it_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \
*box oper##= janet_unwrap_##type(argv[0]); \
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(&it_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
for (int i = 1; i < argc; i++) { \
for (int32_t 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); \
} \
\
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; \
} \
#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(&it_##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; \
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(&it_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
for (int i = 1; i < argc; i++) { \
for (int32_t i = 1; i < argc; i++) { \
T value = janet_unwrap_##type(argv[i]); \
if (value == 0) janet_panic("division by zero"); \
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
@@ -227,18 +253,18 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
} \
return janet_wrap_abstract(box); \
} \
\
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; \
} \
#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(&it_##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; \
return janet_wrap_abstract(box); \
}
} \
#define COMPMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
@@ -248,11 +274,43 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
return janet_wrap_boolean(v1 oper v2); \
}
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
janet_arity(argc, 2, -1);
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
*box = janet_unwrap_s64(argv[0]);
for (int32_t i = 1; i < argc; i++) {
int64_t value = janet_unwrap_s64(argv[i]);
if (value == 0) janet_panic("division by zero");
int64_t x = *box % value;
if (x < 0) {
x = (*box < 0) ? x - *box : x + *box;
}
*box = x;
}
return janet_wrap_abstract(box);
}
static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&it_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;
if (x < 0) {
x = (op1 < 0) ? x - op1 : x + op1;
}
*box = x;
return janet_wrap_abstract(box);
}
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, mod, %)
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
OPMETHOD(int64_t, s64, and, &)
OPMETHOD(int64_t, s64, or, |)
OPMETHOD(int64_t, s64, xor, ^)
@@ -267,9 +325,12 @@ 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, /)
DIVMETHODINVERT(uint64_t, u64, modi, %)
OPMETHOD(uint64_t, u64, and, &)
OPMETHOD(uint64_t, u64, or, |)
OPMETHOD(uint64_t, u64, xor, ^)
@@ -289,65 +350,63 @@ COMPMETHOD(uint64_t, u64, ne, !=)
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},
{"%", cfun_it_s64_mod},
{"r/", cfun_it_s64_divi},
{"mod", cfun_it_s64_mod},
{"rmod", cfun_it_s64_modi},
{"%", cfun_it_s64_rem},
{"r%", cfun_it_s64_remi},
{"<", cfun_it_s64_lt},
{">", cfun_it_s64_gt},
{"<=", cfun_it_s64_le},
{">=", cfun_it_s64_ge},
{"==", cfun_it_s64_eq},
{"=", 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},
{"+!", 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_modi},
{"%", cfun_it_u64_mod},
{"r%", cfun_it_u64_modi},
{"<", cfun_it_u64_lt},
{">", cfun_it_u64_gt},
{"<=", cfun_it_u64_le},
{">=", cfun_it_u64_ge},
{"==", cfun_it_u64_eq},
{"=", 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},
{"+!", 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}
};

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,32 +20,19 @@
* IN THE SOFTWARE.
*/
/* Compiler feature test macros for things */
#define _DEFAULT_SOURCE
#define _BSD_SOURCE
#include <stdio.h>
#include <errno.h>
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#endif
#include <stdio.h>
#include <errno.h>
#ifndef JANET_WINDOWS
#include <sys/wait.h>
#endif
#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
typedef struct IOFile IOFile;
struct IOFile {
FILE *file;
@@ -60,10 +47,7 @@ JanetAbstractType cfun_io_filetype = {
cfun_io_gc,
NULL,
io_file_get,
NULL,
NULL,
NULL,
NULL
JANET_ATEND_GET
};
/* Check arguments to fopen */
@@ -78,13 +62,13 @@ static int checkflags(const uint8_t *str) {
janet_panicf("invalid flag %c, expected w, a, or r", *str);
break;
case 'w':
flags |= IO_WRITE;
flags |= JANET_FILE_WRITE;
break;
case 'a':
flags |= IO_APPEND;
flags |= JANET_FILE_APPEND;
break;
case 'r':
flags |= IO_READ;
flags |= JANET_FILE_READ;
break;
}
for (i = 1; i < len; i++) {
@@ -93,12 +77,12 @@ static int checkflags(const uint8_t *str) {
janet_panicf("invalid flag %c, expected + or b", str[i]);
break;
case '+':
if (flags & IO_UPDATE) return -1;
flags |= IO_UPDATE;
if (flags & JANET_FILE_UPDATE) return -1;
flags |= JANET_FILE_UPDATE;
break;
case 'b':
if (flags & IO_BINARY) return -1;
flags |= IO_BINARY;
if (flags & JANET_FILE_BINARY) return -1;
flags |= JANET_FILE_BINARY;
break;
}
}
@@ -132,10 +116,10 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
!(fmode[0] == 'r' || fmode[0] == 'w')) {
janet_panicf("invalid file mode :%S, expected :r or :w", fmode);
}
flags = IO_PIPED | (fmode[0] == 'r' ? IO_READ : IO_WRITE);
flags = JANET_FILE_PIPED | (fmode[0] == 'r' ? JANET_FILE_READ : JANET_FILE_WRITE);
} else {
fmode = (const uint8_t *)"r";
flags = IO_PIPED | IO_READ;
flags = JANET_FILE_PIPED | JANET_FILE_READ;
}
#ifdef JANET_WINDOWS
#define popen _popen
@@ -148,6 +132,15 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
}
#endif
static Janet cfun_io_temp(int32_t argc, Janet *argv) {
(void)argv;
janet_fixarity(argc, 0);
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);
@@ -158,45 +151,15 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
flags = checkflags(fmode);
} else {
fmode = (const uint8_t *)"r";
flags = IO_READ;
flags = JANET_FILE_READ;
}
FILE *f = fopen((const char *)fname, (const char *)fmode);
return f ? makef(f, flags) : janet_wrap_nil();
}
static Janet cfun_io_fdopen(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
const int fd = janet_getinteger(argv, 0);
const uint8_t *fmode;
int flags;
if (argc == 2) {
fmode = janet_getkeyword(argv, 1);
flags = checkflags(fmode);
} else {
fmode = (const uint8_t *)"r";
flags = IO_READ;
}
#ifdef JANET_WINDOWS
#define fdopen _fdopen
#endif
FILE *f = fdopen(fd, (const char *)fmode);
return f ? makef(f, flags) : janet_wrap_nil();
}
static Janet cfun_io_fileno(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
if (iof->flags & IO_CLOSED)
janet_panic("file is closed");
#ifdef JANET_WINDOWS
#define fileno _fileno
#endif
return janet_wrap_integer(fileno(iof->file));
}
/* Read up to n bytes into buffer. */
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
if (!(iof->flags & (IO_READ | IO_UPDATE)))
if (!(iof->flags & (JANET_FILE_READ | JANET_FILE_UPDATE)))
janet_panic("file is not readable");
janet_buffer_extra(buffer, nBytesMax);
size_t ntoread = nBytesMax;
@@ -210,7 +173,7 @@ static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
static Janet cfun_io_fread(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
if (iof->flags & IO_CLOSED) janet_panic("file is closed");
if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed");
JanetBuffer *buffer;
if (argc == 2) {
buffer = janet_buffer(0);
@@ -250,9 +213,9 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
janet_arity(argc, 1, -1);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
if (iof->flags & IO_CLOSED)
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
janet_panic("file is not writeable");
int32_t i;
/* Verify all arguments before writing to file */
@@ -273,9 +236,9 @@ static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
if (iof->flags & IO_CLOSED)
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
janet_panic("file is not writeable");
if (fflush(iof->file))
janet_panic("could not flush file");
@@ -286,7 +249,7 @@ static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
static int cfun_io_gc(void *p, size_t len) {
(void) len;
IOFile *iof = (IOFile *)p;
if (!(iof->flags & (IO_NOT_CLOSEABLE | IO_CLOSED))) {
if (!(iof->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
return fclose(iof->file);
}
return 0;
@@ -296,22 +259,22 @@ static int cfun_io_gc(void *p, size_t len) {
static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
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))
if (iof->flags & JANET_FILE_CLOSED)
return janet_wrap_nil();
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
janet_panic("file not closable");
if (iof->flags & IO_PIPED) {
if (iof->flags & JANET_FILE_PIPED) {
#ifdef JANET_WINDOWS
#define pclose _pclose
#define WEXITSTATUS(x) x
#endif
int status = pclose(iof->file);
iof->flags |= IO_CLOSED;
iof->flags |= JANET_FILE_CLOSED;
if (status == -1) janet_panic("could not close file");
return janet_wrap_integer(WEXITSTATUS(status));
} else {
if (fclose(iof->file)) janet_panic("could not close file");
iof->flags |= IO_CLOSED;
iof->flags |= JANET_FILE_CLOSED;
return janet_wrap_nil();
}
}
@@ -320,7 +283,7 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
if (iof->flags & IO_CLOSED)
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
long int offset = 0;
int whence = SEEK_CUR;
@@ -345,7 +308,6 @@ static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
static JanetMethod io_file_methods[] = {
{"close", cfun_io_fclose},
{"fileno", cfun_io_fileno},
{"flush", cfun_io_fflush},
{"read", cfun_io_fread},
{"seek", cfun_io_fseek},
@@ -579,6 +541,12 @@ static const JanetReg io_cfuns[] = {
JDOC("(eprinf fmt & xs)\n\n"
"Like eprintf but with no trailing newline.")
},
{
"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.")
},
{
"file/open", cfun_io_fopen,
JDOC("(file/open path &opt mode)\n\n"
@@ -593,32 +561,13 @@ static const JanetReg io_cfuns[] = {
"\tb - open the file in binary mode (rather than text mode)\n"
"\t+ - append to the file instead of overwriting it")
},
{
"file/fdopen", cfun_io_fdopen,
JDOC("(file/fdopen fd &opt mode)\n\n"
"Create a file from an fd. fd is a platform specific file descriptor, 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"
"\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/fileno", cfun_io_fileno,
JDOC("(file/fileno f)\n\n"
"Return the underlying file descriptor for the file as a number."
"The meaning of this number is platform specific.")
},
{
"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.")
"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.")
},
{
"file/read", cfun_io_fread,
@@ -674,21 +623,35 @@ FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
return iof->file;
}
Janet janet_makefile(FILE *f, int flags) {
return makef(f, flags);
}
JanetAbstract janet_checkfile(Janet j) {
return janet_checkabstract(j, &cfun_io_filetype);
}
FILE *janet_unwrapfile(Janet j, int *flags) {
IOFile *iof = janet_unwrap_abstract(j);
if (NULL != flags) *flags = iof->flags;
return iof->file;
}
/* Module entry point */
void janet_lib_io(JanetTable *env) {
janet_core_cfuns(env, NULL, io_cfuns);
/* stdout */
janet_core_def(env, "stdout",
makef(stdout, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
makef(stdout, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
JDOC("The standard output file."));
/* stderr */
janet_core_def(env, "stderr",
makef(stderr, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
makef(stderr, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
JDOC("The standard error file."));
/* stdin */
janet_core_def(env, "stdin",
makef(stdin, IO_READ | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
makef(stdin, JANET_FILE_READ | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
JDOC("The standard input file."));
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "state.h"
#include "vector.h"
@@ -94,8 +95,8 @@ void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *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);
memcpy(symbuf, prefix, prelen);
memcpy(symbuf + prelen, oldsym, 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));
@@ -692,7 +693,7 @@ static const uint8_t *unmarshal_one_env(
janet_panic("invalid funcenv length");
} else {
/* Off stack variant */
env->as.values = malloc(sizeof(Janet) * length);
env->as.values = malloc(sizeof(Janet) * (size_t) length);
if (!env->as.values) {
JANET_OUT_OF_MEMORY;
}
@@ -797,7 +798,7 @@ static const uint8_t *unmarshal_one_def(
/* Unmarshal environments */
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS) {
def->environments = calloc(1, sizeof(int32_t) * environments_length);
def->environments = calloc(1, sizeof(int32_t) * (size_t) environments_length);
if (!def->environments) {
JANET_OUT_OF_MEMORY;
}
@@ -811,7 +812,7 @@ static const uint8_t *unmarshal_one_def(
/* Unmarshal sub funcdefs */
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS) {
def->defs = calloc(1, sizeof(JanetFuncDef *) * defs_length);
def->defs = calloc(1, sizeof(JanetFuncDef *) * (size_t) defs_length);
if (!def->defs) {
JANET_OUT_OF_MEMORY;
}
@@ -826,7 +827,7 @@ 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 = malloc(sizeof(JanetSourceMapping) * bytecode_length);
def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) bytecode_length);
if (!def->sourcemap) {
JANET_OUT_OF_MEMORY;
}
@@ -1016,7 +1017,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);
memcpy(dest, ctx->data, len);
safe_memcpy(dest, ctx->data, len);
ctx->data += len;
}
@@ -1138,7 +1139,7 @@ static const uint8_t *unmarshal_one(
} else { /* (lead == LB_BUFFER) */
JanetBuffer *buffer = janet_buffer(len);
buffer->count = len;
memcpy(buffer->data, data, len);
safe_memcpy(buffer->data, data, len);
*out = janet_wrap_buffer(buffer);
}
janet_v_push(st->lookup, *out);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,13 +20,14 @@
* 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);
@@ -59,7 +60,7 @@ static JanetAbstractType JanetRNG_type = {
NULL,
janet_rng_marshal,
janet_rng_unmarshal,
NULL
JANET_ATEND_UNMARSHAL
};
JanetRNG *janet_default_rng(void) {
@@ -222,13 +223,6 @@ static Janet janet_srand(int32_t argc, Janet *argv) {
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); \
@@ -280,11 +274,6 @@ 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.")

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,12 +21,14 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#endif
#ifndef JANET_REDUCED_OS
#include <stdlib.h>
#include <time.h>
#include <fcntl.h>
#include <errno.h>
@@ -50,6 +52,9 @@
#include <sys/types.h>
#include <sys/wait.h>
extern char **environ;
#ifdef JANET_THREADS
#include <pthread.h>
#endif
#endif
/* For macos */
@@ -58,6 +63,40 @@ extern char **environ;
#include <mach/mach.h>
#endif
/* Setting C99 standard makes this not available, but it should
* work/link properly if we detect a BSD */
#if defined(JANET_BSD) || defined(JANET_APPLE)
void arc4random_buf(void *buf, size_t nbytes);
#endif
/* Access to some global variables should be synchronized if not in single threaded mode, as
* setenv/getenv are not thread safe. */
#ifdef JANET_THREADS
# ifdef JANET_WINDOWS
static int env_lock_initialized = 0;
static CRITICAL_SECTION env_lock;
static void janet_lock_environ(void) {
EnterCriticalSection(&env_lock);
}
static void janet_unlock_environ(void) {
LeaveCriticalSection(&env_lock);
}
# else
static pthread_mutex_t env_lock = PTHREAD_MUTEX_INITIALIZER;
static void janet_lock_environ(void) {
pthread_mutex_lock(&env_lock);
}
static void janet_unlock_environ(void) {
pthread_mutex_unlock(&env_lock);
}
# endif
#else
static void janet_lock_environ(void) {
}
static void janet_unlock_environ(void) {
}
#endif
#endif /* JANET_REDCUED_OS */
/* Core OS functions */
@@ -74,11 +113,11 @@ static Janet os_which(int32_t argc, Janet *argv) {
return janet_ckeywordv(janet_stringify(JANET_OS_NAME));
#elif defined(JANET_WINDOWS)
return janet_ckeywordv("windows");
#elif defined(__APPLE__)
#elif defined(JANET_APPLE)
return janet_ckeywordv("macos");
#elif defined(__EMSCRIPTEN__)
return janet_ckeywordv("web");
#elif defined(__linux__)
#elif defined(JANET_LINUX)
return janet_ckeywordv("linux");
#elif defined(__FreeBSD__)
return janet_ckeywordv("freebsd");
@@ -86,6 +125,8 @@ static Janet os_which(int32_t argc, Janet *argv) {
return janet_ckeywordv("netbsd");
#elif defined(__OpenBSD__)
return janet_ckeywordv("openbsd");
#elif defined(JANET_BSD)
return janet_ckeywordv("bsd");
#else
return janet_ckeywordv("posix");
#endif
@@ -101,7 +142,7 @@ static Janet os_arch(int32_t argc, Janet *argv) {
#elif defined(__EMSCRIPTEN__)
return janet_ckeywordv("wasm");
#elif (defined(__x86_64__) || defined(_M_X64))
return janet_ckeywordv("x86-64");
return janet_ckeywordv("x64");
#elif defined(__i386) || defined(_M_IX86)
return janet_ckeywordv("x86");
#elif defined(_M_ARM64) || defined(__aarch64__)
@@ -120,13 +161,16 @@ static Janet os_arch(int32_t argc, Janet *argv) {
static Janet os_exit(int32_t argc, Janet *argv) {
janet_arity(argc, 0, 1);
int status;
if (argc == 0) {
exit(EXIT_SUCCESS);
status = EXIT_SUCCESS;
} else if (janet_checkint(argv[0])) {
exit(janet_unwrap_integer(argv[0]));
status = janet_unwrap_integer(argv[0]);
} else {
exit(EXIT_FAILURE);
status = EXIT_FAILURE;
}
janet_deinit();
exit(status);
return janet_wrap_nil();
}
@@ -135,7 +179,7 @@ static Janet os_exit(int32_t argc, Janet *argv) {
static Janet os_getenv(int32_t argc, Janet *argv) {
(void) argv;
janet_fixarity(argc, 1);
janet_arity(argc, 1, 2);
return janet_wrap_nil();
}
@@ -147,7 +191,7 @@ static char **os_execute_env(int32_t argc, const Janet *argv) {
char **envp = NULL;
if (argc > 2) {
JanetDictView dict = janet_getdictionary(argv, 2);
envp = janet_smalloc(sizeof(char *) * (dict.len + 1));
envp = janet_smalloc(sizeof(char *) * ((size_t)dict.len + 1));
int32_t j = 0;
for (int32_t i = 0; i < dict.cap; i++) {
const JanetKV *kv = dict.kvs + i;
@@ -166,7 +210,7 @@ static char **os_execute_env(int32_t argc, const Janet *argv) {
}
}
if (skip) continue;
char *envitem = janet_smalloc(klen + vlen + 2);
char *envitem = janet_smalloc((size_t) klen + (size_t) vlen + 2);
memcpy(envitem, keys, klen);
envitem[klen] = '=';
memcpy(envitem + klen + 1, vals, vlen);
@@ -322,13 +366,13 @@ static Janet os_execute(int32_t argc, Janet *argv) {
/* Check error */
if (-1 == status) {
janet_panic(strerror(errno));
janet_panicf("%p: %s", argv[0], strerror(errno));
}
return janet_wrap_integer(status);
#else
const char **child_argv = janet_smalloc(sizeof(char *) * (exargs.len + 1));
const char **child_argv = janet_smalloc(sizeof(char *) * ((size_t) exargs.len + 1));
for (int32_t i = 0; i < exargs.len; i++)
child_argv[i] = janet_getcstring(exargs.items, i);
child_argv[exargs.len] = NULL;
@@ -351,7 +395,7 @@ static Janet os_execute(int32_t argc, Janet *argv) {
/* Wait for child */
if (status) {
os_execute_cleanup(envp, child_argv);
janet_panic(strerror(status));
janet_panicf("%p: %s", argv[0], strerror(errno));
} else {
waitpid(pid, &status, 0);
}
@@ -376,6 +420,7 @@ static Janet os_environ(int32_t argc, Janet *argv) {
(void) argv;
janet_fixarity(argc, 0);
int32_t nenv = 0;
janet_lock_environ();
char **env = environ;
while (*env++)
nenv += 1;
@@ -383,7 +428,10 @@ static Janet os_environ(int32_t argc, Janet *argv) {
for (int32_t i = 0; i < nenv; i++) {
char *e = environ[i];
char *eq = strchr(e, '=');
if (!eq) janet_panic("no '=' in environ");
if (!eq) {
janet_unlock_environ();
janet_panic("no '=' in environ");
}
char *v = eq + 1;
int32_t full_len = (int32_t) strlen(e);
int32_t val_len = (int32_t) strlen(v);
@@ -393,16 +441,22 @@ static Janet os_environ(int32_t argc, Janet *argv) {
janet_stringv((const uint8_t *)v, val_len)
);
}
janet_unlock_environ();
return janet_wrap_table(t);
}
static Janet os_getenv(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
janet_arity(argc, 1, 2);
const char *cstr = janet_getcstring(argv, 0);
const char *res = getenv(cstr);
return res
? janet_cstringv(res)
: janet_wrap_nil();
janet_lock_environ();
Janet ret = res
? janet_cstringv(res)
: argc == 2
? argv[1]
: janet_wrap_nil();
janet_unlock_environ();
return ret;
}
static Janet os_setenv(int32_t argc, Janet *argv) {
@@ -415,11 +469,14 @@ static Janet os_setenv(int32_t argc, Janet *argv) {
#endif
janet_arity(argc, 1, 2);
const char *ks = janet_getcstring(argv, 0);
if (argc == 1 || janet_checktype(argv[1], JANET_NIL)) {
const char *vs = janet_optcstring(argv, argc, 1, NULL);
janet_lock_environ();
if (NULL == vs) {
UNSETENV(ks);
} else {
SETENV(ks, janet_getcstring(argv, 1));
SETENV(ks, vs);
}
janet_unlock_environ();
return janet_wrap_nil();
}
@@ -526,11 +583,9 @@ static Janet os_cryptorand(int32_t argc, Janet *argv) {
v = v >> 8;
}
}
#elif defined(__linux__) || defined(__APPLE__)
#elif defined(JANET_LINUX)
/* We should be able to call getrandom on linux, but it doesn't seem
to be uniformly supported on linux distros. Macos may support
arc4random_buf, but it needs investigation.
to be uniformly supported on linux distros.
In both cases, use this fallback path for now... */
int rc;
int randfd;
@@ -548,10 +603,11 @@ static Janet os_cryptorand(int32_t argc, Janet *argv) {
n -= nread;
}
RETRY_EINTR(rc, close(randfd));
#elif defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__)
(void) errmsg;
#elif defined(JANET_BSD) || defined(JANET_APPLE)
(void) genericerr;
arc4random_buf(buffer->data + offset, n);
#else
(void) genericerr;
janet_panic("cryptorand currently unsupported on this platform");
#endif
return janet_wrap_buffer(buffer);
@@ -915,14 +971,9 @@ static const JanetReg os_cfuns[] = {
"\t:netbsd\n"
"\t:posix - A POSIX compatible system (default)")
},
{
"os/environ", os_environ,
JDOC("(os/environ)\n\n"
"Get a copy of the os environment table.")
},
{
"os/getenv", os_getenv,
JDOC("(os/getenv variable)\n\n"
JDOC("(os/getenv variable &opt dflt)\n\n"
"Get the string value of an environment variable.")
},
{
@@ -938,6 +989,11 @@ static const JanetReg os_cfuns[] = {
"\t:unknown\n")
},
#ifndef JANET_REDUCED_OS
{
"os/environ", os_environ,
JDOC("(os/environ)\n\n"
"Get a copy of the os environment table.")
},
{
"os/dir", os_dir,
JDOC("(os/dir dir &opt array)\n\n"
@@ -1074,5 +1130,13 @@ static const JanetReg os_cfuns[] = {
/* Module entry point */
void janet_lib_os(JanetTable *env) {
#if !defined(JANET_REDUCED_OS) && defined(JANET_WINDOWS) && defined(JANET_THREADS)
/* During start up, the top-most abstract machine (thread)
* in the thread tree sets up the critical section. */
if (!env_lock_initialized) {
InitializeCriticalSection(&env_lock);
env_lock_initialized = 1;
}
#endif
janet_core_cfuns(env, NULL, os_cfuns);
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#endif
@@ -687,20 +688,19 @@ void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
if (dest->bufcap) {
dest->buf = malloc(dest->bufcap);
if (!dest->buf) goto nomem;
memcpy(dest->buf, src->buf, dest->bufcap);
}
if (dest->argcap) {
dest->args = malloc(sizeof(Janet) * dest->argcap);
if (!dest->args) goto nomem;
memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
}
if (dest->statecap) {
dest->states = malloc(sizeof(JanetParseState) * dest->statecap);
if (!dest->states) goto nomem;
memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
}
memcpy(dest->buf, src->buf, dest->bufcap);
memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
return;
nomem:
@@ -737,10 +737,7 @@ static JanetAbstractType janet_parse_parsertype = {
parsergc,
parsermark,
parserget,
NULL,
NULL,
NULL,
NULL
JANET_ATEND_GET
};
/* C Function parser */
@@ -793,6 +790,7 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
p->column--;
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++;
@@ -809,7 +807,7 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
}
p->bufcap = newcap;
}
memcpy(p->buf + p->bufcount, str, slen);
safe_memcpy(p->buf + p->bufcount, str, slen);
p->bufcount = newcount;
} else {
janet_panic("cannot insert value into parser");
@@ -892,7 +890,7 @@ static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
if (s->flags & PFLAG_CONTAINER) {
JanetArray *container_args = janet_array(s->argn);
container_args->count = s->argn;
memcpy(container_args->data, args, sizeof(args[0])*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));
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include <string.h>
#include "util.h"
@@ -347,9 +348,9 @@ tail:
if (!result) return NULL;
int32_t num_sub_captures = s->captures->count - cs.cap;
JanetArray *sub_captures = janet_array(num_sub_captures);
memcpy(sub_captures->data,
s->captures->data + cs.cap,
sizeof(Janet) * num_sub_captures);
safe_memcpy(sub_captures->data,
s->captures->data + cs.cap,
sizeof(Janet) * num_sub_captures);
sub_captures->count = num_sub_captures;
cap_load(s, cs);
pushcap(s, janet_wrap_array(sub_captures), tag);
@@ -445,6 +446,7 @@ tail:
typedef struct {
JanetTable *grammar;
JanetTable *default_grammar;
JanetTable *tags;
Janet *constants;
uint32_t *bytecode;
@@ -726,6 +728,13 @@ static void spec_opt(Builder *b, int32_t argc, const Janet *argv) {
emit_3(r, RULE_BETWEEN, 0, 1, subrule);
}
static void spec_repeat(Builder *b, int32_t argc, const Janet *argv) {
peg_fixarity(b, argc, 2);
Reserve r = reserve(b, 4);
int32_t n = peg_getnat(b, argv[0]);
uint32_t subrule = peg_compile1(b, argv[1]);
emit_3(r, RULE_BETWEEN, n, n, subrule);
}
/* Rule of the form [rule] */
static void spec_onerule(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
@@ -868,6 +877,7 @@ static const SpecialPair peg_specials[] = {
{"position", spec_position},
{"quote", spec_capture},
{"range", spec_range},
{"repeat", spec_repeat},
{"replace", spec_replace},
{"sequence", spec_sequence},
{"set", spec_set},
@@ -886,9 +896,14 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
int i = JANET_RECURSION_GUARD;
JanetTable *grammar = old_grammar;
for (; i > 0 && janet_checktype(peg, JANET_KEYWORD); --i) {
peg = janet_table_get_ex(grammar, peg, &grammar);
if (!grammar || janet_checktype(peg, JANET_NIL))
peg_panic(b, "unknown rule");
Janet nextPeg = janet_table_get_ex(grammar, peg, &grammar);
if (!grammar || janet_checktype(nextPeg, JANET_NIL)) {
nextPeg = janet_table_get(b->default_grammar, peg);
if (janet_checktype(nextPeg, JANET_NIL)) {
peg_panic(b, "unknown rule");
}
}
peg = nextPeg;
b->form = peg;
b->grammar = grammar;
}
@@ -1039,7 +1054,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
size_t bytecode_size = bytecode_len * sizeof(uint32_t);
size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet));
size_t total_size = constants_start + sizeof(Janet) * num_constants;
size_t total_size = constants_start + sizeof(Janet) * (size_t) num_constants;
/* DOS prevention? I.E. we could read bytecode and constants before
* hand so we don't allocated a ton of memory on bad, short input */
@@ -1187,15 +1202,17 @@ bad:
janet_panic("invalid peg bytecode");
}
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out);
static const JanetAbstractType peg_type = {
"core/peg",
NULL,
peg_mark,
NULL,
cfun_peg_getter,
NULL,
peg_marshal,
peg_unmarshal,
NULL
JANET_ATEND_UNMARSHAL
};
/* Convert Builder to Peg (Janet Abstract Value) */
@@ -1210,8 +1227,8 @@ static Peg *make_peg(Builder *b) {
peg->bytecode = (uint32_t *)(mem + bytecode_start);
peg->constants = (Janet *)(mem + constants_start);
peg->num_constants = janet_v_count(b->constants);
memcpy(peg->bytecode, b->bytecode, bytecode_size);
memcpy(peg->constants, b->constants, constants_size);
safe_memcpy(peg->bytecode, b->bytecode, bytecode_size);
safe_memcpy(peg->constants, b->constants, constants_size);
peg->bytecode_len = janet_v_count(b->bytecode);
return peg;
}
@@ -1220,6 +1237,7 @@ static Peg *make_peg(Builder *b) {
static Peg *compile_peg(Janet x) {
Builder builder;
builder.grammar = janet_table(0);
builder.default_grammar = janet_get_core_table("default-peg-grammar");
builder.tags = janet_table(0);
builder.constants = NULL;
builder.bytecode = NULL;
@@ -1276,6 +1294,15 @@ static Janet cfun_peg_match(int32_t argc, Janet *argv) {
return result ? janet_wrap_array(s.captures) : janet_wrap_nil();
}
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out) {
(void) a;
if (janet_keyeq(key, "match")) {
*out = janet_wrap_cfunction(cfun_peg_match);
return 1;
}
return 0;
}
static const JanetReg peg_cfuns[] = {
{
"peg/compile", cfun_peg_compile,

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,15 +20,17 @@
* IN THE SOFTWARE.
*/
#include <string.h>
#include <ctype.h>
#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>
/* Implements a pretty printer for Janet. The pretty printer
* is simple and not that flexible, but fast. */
@@ -175,53 +177,50 @@ 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_description_b(JanetBuffer *buffer, Janet x) {
void janet_to_string_b(JanetBuffer *buffer, Janet x) {
switch (janet_type(x)) {
case JANET_NIL:
janet_buffer_push_cstring(buffer, "nil");
return;
break;
case JANET_BOOLEAN:
janet_buffer_push_cstring(buffer,
janet_unwrap_boolean(x) ? "true" : "false");
return;
break;
case JANET_NUMBER:
number_to_string_b(buffer, janet_unwrap_number(x));
return;
case JANET_KEYWORD:
janet_buffer_push_u8(buffer, ':');
/* fallthrough */
break;
case JANET_STRING:
case JANET_SYMBOL:
case JANET_KEYWORD:
janet_buffer_push_bytes(buffer,
janet_unwrap_string(x),
janet_string_length(janet_unwrap_string(x)));
return;
case JANET_STRING:
janet_escape_string_b(buffer, janet_unwrap_string(x));
return;
break;
case JANET_BUFFER: {
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;
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;
}
case JANET_ABSTRACT: {
void *p = janet_unwrap_abstract(x);
const JanetAbstractType *at = janet_abstract_type(p);
if (at->tostring) {
at->tostring(p, buffer);
JanetAbstract p = janet_unwrap_abstract(x);
const JanetAbstractType *t = janet_abstract_type(p);
if (t->tostring != NULL) {
t->tostring(p, buffer);
} else {
const char *n = at->name;
string_description_b(buffer, n, janet_unwrap_abstract(x));
string_description_b(buffer, t->name, p);
}
return;
}
return;
case JANET_CFUNCTION: {
Janet check = janet_table_get(janet_vm_registry, x);
if (janet_checktype(check, JANET_SYMBOL)) {
@@ -253,26 +252,58 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
}
}
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) {
switch (janet_type(x)) {
default:
janet_description_b(buffer, x);
break;
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;
}
case JANET_STRING:
case JANET_SYMBOL:
case JANET_KEYWORD:
janet_buffer_push_bytes(buffer,
janet_unwrap_string(x),
janet_string_length(janet_unwrap_string(x)));
janet_buffer_push_u8(buffer, ':');
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;
}
}
janet_to_string_b(buffer, x);
}
const uint8_t *janet_description(Janet x) {
@@ -315,6 +346,83 @@ struct pretty {
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_NUMBER:
case JANET_BOOLEAN:
case JANET_BUFFER:
case JANET_STRING:
janet_description_b(S->buffer, x);
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)) {
@@ -329,6 +437,7 @@ 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",
@@ -350,6 +459,8 @@ static const char *janet_pretty_colors[] = {
#define JANET_PRETTY_DICT_ONELINE 4
#define JANET_PRETTY_IND_ONELINE 10
#define JANET_PRETTY_DICT_LIMIT 16
#define JANET_PRETTY_ARRAY_LIMIT 16
/* Helper for pretty printing */
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
@@ -416,9 +527,22 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
if (!isarray && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_IND_ONELINE)
janet_buffer_push_u8(S->buffer, ' ');
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
for (i = 0; i < len; i++) {
if (i) print_newline(S, len < JANET_PRETTY_IND_ONELINE);
janet_pretty_one(S, arr[i], 0);
if (len > JANET_PRETTY_ARRAY_LIMIT) {
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);
}
}
}
S->indent -= 2;
@@ -436,10 +560,17 @@ 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_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 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_buffer_push_cstring(S->buffer, "{");
@@ -453,8 +584,9 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
int32_t i = 0, len = 0, cap = 0;
int first_kv_pair = 1;
const JanetKV *kvs = NULL;
int counter = 0;
janet_dictionary_view(x, &kvs, &len, &cap);
if (!istable && len >= JANET_PRETTY_DICT_ONELINE)
if (!istable && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_DICT_ONELINE)
janet_buffer_push_u8(S->buffer, ' ');
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
for (i = 0; i < cap; i++) {
@@ -467,6 +599,12 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
janet_pretty_one(S, kvs[i].key, 0);
janet_buffer_push_u8(S->buffer, ' ');
janet_pretty_one(S, kvs[i].value, 1);
counter++;
if (counter == 10) {
print_newline(S, 0);
janet_buffer_push_cstring(S->buffer, "...");
break;
}
}
}
}
@@ -503,6 +641,29 @@ 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;
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)
@@ -748,6 +909,13 @@ void janet_buffer_format(
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);
break;
}
default: {
/* also treat cases 'nLlh' */
janet_panicf("invalid conversion '%s' to 'format'",

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "regalloc.h"
#include "util.h"
@@ -66,7 +67,7 @@ void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocato
dest->count = src->count;
dest->capacity = src->capacity;
dest->max = src->max;
size = sizeof(uint32_t) * dest->capacity;
size = sizeof(uint32_t) * (size_t) dest->capacity;
dest->regtemps = 0;
if (size) {
dest->chunks = malloc(size);
@@ -86,7 +87,7 @@ static void pushchunk(JanetcRegisterAllocator *ra) {
int32_t newcount = ra->count + 1;
if (newcount > ra->capacity) {
int32_t newcapacity = newcount * 2;
ra->chunks = realloc(ra->chunks, newcapacity * sizeof(uint32_t));
ra->chunks = realloc(ra->chunks, (size_t) newcapacity * sizeof(uint32_t));
if (!ra->chunks) {
JANET_OUT_OF_MEMORY;
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "state.h"
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "compile.h"
#include "util.h"
@@ -537,6 +538,20 @@ 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
* ...
@@ -553,6 +568,9 @@ 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");
@@ -563,13 +581,26 @@ 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, argv[0]);
cond = janetc_value(subopts, condform);
/* Check for constant condition */
if (cond.flags & JANET_SLOT_CONSTANT) {
/* Loop never executes */
if (!janet_truthy(cond.constant)) {
int never_executes = is_notnil_form
? janet_checktype(cond.constant, JANET_NIL)
: !janet_truthy(cond.constant);
if (never_executes) {
janetc_popscope(c);
return janetc_cslot(janet_wrap_nil());
}
@@ -580,7 +611,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, JOP_JUMP_IF_NOT, cond, 0, 0);
: janetc_emit_si(c, ifnjmp, cond, 0, 0);
/* Compile body */
for (i = 1; i < argn; i++) {
@@ -599,10 +630,10 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
janetc_scope(&tempscope, c, JANET_SCOPE_FUNCTION, "while-iife");
/* Recompile in the function scope */
cond = janetc_value(subopts, argv[0]);
cond = janetc_value(subopts, condform);
if (!(cond.flags & JANET_SLOT_CONSTANT)) {
/* If not an infinite loop, return nil when condition false */
janetc_emit_si(c, JOP_JUMP_IF, cond, 2, 0);
janetc_emit_si(c, ifjmp, cond, 2, 0);
janetc_emit(c, JOP_RETURN_NIL);
}
for (i = 1; i < argn; i++) {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +32,8 @@
* be in it. However, thread local global variables for interpreter
* state should allow easy multi-threading. */
typedef struct JanetScratch JanetScratch;
/* Cache the core environment */
extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
@@ -59,17 +61,17 @@ extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted;
/* Garbage collection */
extern JANET_THREAD_LOCAL void *janet_vm_blocks;
extern JANET_THREAD_LOCAL uint32_t janet_vm_gc_interval;
extern JANET_THREAD_LOCAL uint32_t janet_vm_next_collection;
extern JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
extern JANET_THREAD_LOCAL size_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 uint32_t janet_vm_root_count;
extern JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
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 void **janet_scratch_mem;
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;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,18 +20,19 @@
* 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) + length + 1);
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + (size_t) length + 1);
head->length = length;
uint8_t *data = (uint8_t *)head->data;
data[length] = 0;
@@ -46,11 +47,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) + len + 1);
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + (size_t) len + 1);
head->length = len;
head->hash = janet_string_calchash(buf, len);
uint8_t *data = (uint8_t *)head->data;
memcpy(data, buf, len);
safe_memcpy(data, buf, len);
data[len] = 0;
return data;
}
@@ -186,7 +187,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) {
memcpy(p, view.bytes, view.len);
safe_memcpy(p, view.bytes, view.len);
}
return janet_wrap_string(janet_string_end(newbuf));
}
@@ -342,11 +343,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);
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);
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);
kmp_deinit(&s.kmp);
return janet_wrap_string(janet_string_end(buf));
}
@@ -444,11 +445,11 @@ static Janet cfun_string_join(int32_t argc, Janet *argv) {
const uint8_t *chunk = NULL;
int32_t chunklen = 0;
if (i) {
memcpy(out, joiner.bytes, joiner.len);
safe_memcpy(out, joiner.bytes, joiner.len);
out += joiner.len;
}
janet_bytes_view(parts.items[i], &chunk, &chunklen);
memcpy(out, chunk, chunklen);
safe_memcpy(out, chunk, chunklen);
out += chunklen;
}
return janet_wrap_string(janet_string_end(buf));

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,14 +40,15 @@
* '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] = {
@@ -86,7 +87,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 = realloc(mant->digits, newcap * sizeof(uint32_t));
uint32_t *mem = realloc(mant->digits, (size_t) newcap * sizeof(uint32_t));
if (NULL == mem) {
JANET_OUT_OF_MEMORY;
}
@@ -446,12 +447,16 @@ 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 <= 0x8000000000000000ULL) {
*out = -((int64_t) bi);
if (neg && bi <= (UINT64_MAX / 2)) {
if (bi > INT64_MAX) {
*out = INT64_MIN;
} else {
*out = -((int64_t) bi);
}
return 1;
}
if (!neg && bi <= 0x7FFFFFFFFFFFFFFFULL) {
*out = bi;
if (!neg && bi <= INT64_MAX) {
*out = (int64_t) bi;
return 1;
}
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "gc.h"
#include "util.h"
@@ -33,7 +34,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) + capacity * sizeof(JanetKV);
size_t size = sizeof(JanetStructHead) + (size_t) capacity * sizeof(JanetKV);
JanetStructHead *head = janet_gcalloc(JANET_MEMORY_STRUCT, size);
head->length = count;
head->capacity = capacity;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,9 +25,8 @@
* 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"
@@ -35,6 +34,8 @@
#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;
@@ -44,7 +45,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 = calloc(1, janet_vm_cache_capacity * sizeof(const uint8_t *));
janet_vm_cache = calloc(1, (size_t) janet_vm_cache_capacity * sizeof(const uint8_t *));
if (NULL == janet_vm_cache) {
JANET_OUT_OF_MEMORY;
}
@@ -121,7 +122,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 = calloc(1, newCapacity * sizeof(const uint8_t *));
const uint8_t **newCache = calloc(1, (size_t) newCapacity * sizeof(const uint8_t *));
if (newCache == NULL) {
JANET_OUT_OF_MEMORY;
}
@@ -178,11 +179,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) + len + 1);
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + (size_t) len + 1);
head->hash = hash;
head->length = len;
newstr = (uint8_t *)(head->data);
memcpy(newstr, str, len);
safe_memcpy(newstr, str, len);
newstr[len] = 0;
janet_symcache_put((const uint8_t *)newstr, bucket);
return newstr;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +24,7 @@
#define JANET_SYMCACHE_H_defined
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "gc.h"
#include "util.h"
@@ -31,7 +32,7 @@
static void *janet_memalloc_empty_local(int32_t count) {
int32_t i;
void *mem = janet_smalloc(count * sizeof(JanetKV));
void *mem = janet_smalloc((size_t) count * sizeof(JanetKV));
JanetKV *mmem = (JanetKV *)mem;
for (i = 0; i < count; i++) {
JanetKV *kv = mmem + i;
@@ -240,7 +241,7 @@ JanetTable *janet_table_clone(JanetTable *table) {
if (NULL == newTable->data) {
JANET_OUT_OF_MEMORY;
}
memcpy(newTable->data, table->data, table->capacity * sizeof(JanetKV));
memcpy(newTable->data, table->data, (size_t) table->capacity * sizeof(JanetKV));
return newTable;
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "gc.h"
#include "util.h"
@@ -29,6 +30,7 @@
#ifdef JANET_THREADS
#include <math.h>
#ifdef JANET_WINDOWS
#include <windows.h>
#else
@@ -49,9 +51,6 @@ struct JanetMailbox {
pthread_cond_t cond;
#endif
/* Receiving messages - (only by owner thread) */
JanetTable *decode;
/* Setup procedure - requires a parent mailbox
* to receive thunk from */
JanetMailbox *parent;
@@ -73,9 +72,18 @@ struct JanetMailbox {
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");
janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
}
return janet_vm_thread_decode;
}
static JanetMailbox *janet_mailbox_create(JanetMailbox *parent, int refCount, uint16_t capacity) {
JanetMailbox *mailbox = malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * capacity);
JanetMailbox *mailbox = malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
if (NULL == mailbox) {
JANET_OUT_OF_MEMORY;
}
@@ -183,11 +191,11 @@ static void janet_waiter_init(JanetWaiter *waiter, double sec) {
waiter->timedwait = 0;
waiter->nowait = 0;
if (sec == 0.0 || isnan(sec)) {
if (sec <= 0.0 || isnan(sec)) {
waiter->nowait = 1;
return;
}
waiter->timedwait = sec > 0.0;
waiter->timedwait = sec > 0.0 && !isinf(sec);
/* Set maximum wait time to 30 days */
if (sec > (60.0 * 60.0 * 24.0 * 30.0)) {
@@ -354,7 +362,7 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
const uint8_t *nextItem = NULL;
Janet item = janet_unmarshal(
msgbuf->data, msgbuf->count,
0, mailbox->decode, &nextItem);
0, janet_thread_get_decode(), &nextItem);
*msg_out = item;
/* Cleanup */
@@ -368,7 +376,7 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
}
}
if (wait.nowait || mailbox->refCount <= 1) {
if (wait.nowait) {
janet_mailbox_unlock(mailbox);
return 1;
}
@@ -389,10 +397,7 @@ static JanetAbstractType Thread_AT = {
thread_gc,
thread_mark,
janet_thread_getter,
NULL,
NULL,
NULL,
NULL
JANET_ATEND_GET
};
static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) {
@@ -406,15 +411,6 @@ JanetThread *janet_getthread(const Janet *argv, int32_t n) {
return (JanetThread *) janet_getabstract(argv, n, &Thread_AT);
}
static 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);
}
/* Runs in new thread */
static int thread_worker(JanetMailbox *mailbox) {
JanetFiber *fiber = NULL;
@@ -428,7 +424,6 @@ static int thread_worker(JanetMailbox *mailbox) {
/* Get dictionaries for default encode/decode */
JanetTable *encode = janet_get_core_table("make-image-dict");
mailbox->decode = janet_get_core_table("load-image-dict");
/* Create parent thread */
JanetThread *parent = janet_make_thread(mailbox->parent, encode);
@@ -438,7 +433,7 @@ static int thread_worker(JanetMailbox *mailbox) {
/* Unmarshal the function */
Janet funcv;
int status = janet_thread_receive(&funcv, -1.0);
int status = janet_thread_receive(&funcv, INFINITY);
if (status) goto error;
if (!janet_checktype(funcv, JANET_FUNCTION)) goto error;
@@ -471,7 +466,7 @@ error:
#ifdef JANET_WINDOWS
static DWORD janet_create_thread_wrapper(void *param) {
static DWORD WINAPI janet_create_thread_wrapper(LPVOID param) {
thread_worker((JanetMailbox *)param);
return 0;
}
@@ -512,6 +507,8 @@ void janet_threads_init(void) {
if (NULL == janet_vm_mailbox) {
janet_vm_mailbox = janet_mailbox_create(NULL, 1, 10);
}
janet_vm_thread_decode = NULL;
janet_vm_thread_current = NULL;
}
void janet_threads_deinit(void) {
@@ -520,6 +517,7 @@ void janet_threads_deinit(void) {
janet_mailbox_ref_with_lock(janet_vm_mailbox, -1);
janet_vm_mailbox = NULL;
janet_vm_thread_current = NULL;
janet_vm_thread_decode = NULL;
}
/*
@@ -538,8 +536,10 @@ static Janet cfun_thread_current(int32_t argc, Janet *argv) {
}
static Janet cfun_thread_new(int32_t argc, Janet *argv) {
janet_arity(argc, 0, 1);
int32_t cap = janet_optinteger(argv, argc, 0, 10);
janet_arity(argc, 1, 2);
/* 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);
}
@@ -555,6 +555,12 @@ static Janet cfun_thread_new(int32_t argc, Janet *argv) {
janet_mailbox_ref(janet_vm_mailbox, -1); /* ->parent reference */
janet_panic("could not start 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);
}
@@ -614,9 +620,9 @@ static const JanetReg threadlib_cfuns[] = {
},
{
"thread/new", cfun_thread_new,
JDOC("(thread/new &opt capacity)\n\n"
"Start a new thread. The thread will wait for a message containing the function used to start the thread, which should be passed to the thread "
"via thread/send. If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. "
JDOC("(thread/new func &opt capacity)\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. "
"Returns a handle to the new thread.")
},

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "symcache.h"
#include "gc.h"
@@ -31,7 +32,7 @@
* 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) + (length * sizeof(Janet));
size_t size = sizeof(JanetTupleHead) + ((size_t) length * sizeof(Janet));
JanetTupleHead *head = janet_gcalloc(JANET_MEMORY_TUPLE, size);
head->sm_line = -1;
head->sm_column = -1;
@@ -48,7 +49,7 @@ 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);
memcpy(t, values, sizeof(Janet) * n);
safe_memcpy(t, values, sizeof(Janet) * n);
return janet_tuple_end(t);
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose & contributors
* Copyright (c) 2020 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
@@ -21,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#endif
@@ -118,7 +119,7 @@ static const JanetAbstractType ta_buffer_type = {
NULL,
ta_buffer_marshal,
ta_buffer_unmarshal,
NULL
JANET_ATEND_UNMARSHAL
};
static int ta_mark(void *p, size_t s) {
@@ -282,7 +283,7 @@ static const JanetAbstractType ta_view_type = {
ta_setter,
ta_view_marshal,
ta_view_unmarshal,
NULL
JANET_ATEND_UNMARSHAL
};
JanetTArrayBuffer *janet_tarray_buffer(size_t size) {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,15 +20,16 @@
* IN THE SOFTWARE.
*/
#include <inttypes.h>
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#include "state.h"
#include "gc.h"
#endif
#include <inttypes.h>
/* Base 64 lookup table for digits */
const char janet_base64[65] =
"0123456789"
@@ -93,7 +94,7 @@ const char *const janet_status_names[16] = {
"alive"
};
/* Calculate hash for string */
#ifdef JANET_NO_PRF
int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
const uint8_t *end = str + len;
@@ -103,6 +104,118 @@ 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;
@@ -135,6 +248,12 @@ 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) {
@@ -262,40 +381,51 @@ void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
/* Load many cfunctions at once */
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
uint8_t *longname_buffer = NULL;
size_t prefixlen = 0;
size_t bufsize = 0;
if (NULL != regprefix) {
prefixlen = strlen(regprefix);
bufsize = prefixlen + 256;
longname_buffer = malloc(bufsize);
if (NULL == longname_buffer) {
JANET_OUT_OF_MEMORY;
}
safe_memcpy(longname_buffer, regprefix, prefixlen);
longname_buffer[prefixlen] = '/';
prefixlen++;
}
while (cfuns->name) {
Janet name = janet_csymbolv(cfuns->name);
Janet longname = name;
if (regprefix) {
int32_t reglen = 0;
Janet name;
if (NULL != regprefix) {
int32_t nmlen = 0;
while (regprefix[reglen]) reglen++;
while (cfuns->name[nmlen]) nmlen++;
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);
int32_t totallen = (int32_t) prefixlen + nmlen;
if ((size_t) totallen > bufsize) {
bufsize = (size_t)(totallen) + 128;
longname_buffer = 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);
}
Janet fun = janet_wrap_cfunction(cfuns->cfun);
janet_def(env, cfuns->name, fun, cfuns->documentation);
janet_table_put(janet_vm_registry, fun, longname);
janet_table_put(janet_vm_registry, fun, name);
cfuns++;
}
free(longname_buffer);
}
/* Abstract type introspection */
static const JanetAbstractType type_wrap = {
"core/type-info",
NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL
JANET_ATEND_NAME
};
typedef struct {
@@ -448,3 +578,12 @@ int janet_checksize(Janet x) {
return dval == (double)((size_t) dval) &&
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);
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,14 @@
#ifndef JANET_UTIL_H_defined
#define JANET_UTIL_H_defined
#include <stdio.h>
#include <errno.h>
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#endif
#include <stdio.h>
#include <errno.h>
/* Handle runtime errors */
#ifndef janet_exit
#include <stdio.h>
@@ -67,11 +68,13 @@ 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);
const void *janet_strbinsearch(
const void *tab,
size_t tabcount,

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,8 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include "util.h"
#include <janet.h>
#endif
@@ -28,6 +30,87 @@
* Define a number of functions that can be used internally on ANY Janet.
*/
Janet janet_next(Janet ds, Janet key) {
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);
}
}
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) {
int result = 0;
@@ -53,6 +136,9 @@ int janet_equals(Janet x, Janet y) {
case JANET_STRUCT:
result = janet_struct_equal(janet_unwrap_struct(x), janet_unwrap_struct(y));
break;
case JANET_ABSTRACT:
result = !janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
break;
default:
/* compare pointers */
result = (janet_unwrap_pointer(x) == janet_unwrap_pointer(y));
@@ -83,6 +169,15 @@ int32_t janet_hash(Janet x) {
case JANET_STRUCT:
hash = janet_struct_hash(janet_unwrap_struct(x));
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 *)) {
@@ -104,7 +199,7 @@ 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. */
* and should have strict ordering, excepts NaNs. */
int janet_compare(Janet x, Janet y) {
if (janet_type(x) == janet_type(y)) {
switch (janet_type(x)) {
@@ -112,20 +207,13 @@ int janet_compare(Janet x, Janet y) {
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 janet_unwrap_number(x) > janet_unwrap_number(y) ? 1 : -1;
}
case JANET_NUMBER: {
double xx = janet_unwrap_number(x);
double yy = janet_unwrap_number(y);
return xx == yy
? 0
: (xx < yy) ? -1 : 1;
}
case JANET_STRING:
case JANET_SYMBOL:
case JANET_KEYWORD:
@@ -134,6 +222,8 @@ int janet_compare(Janet x, Janet y) {
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));
case JANET_ABSTRACT:
return janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
default:
if (janet_unwrap_string(x) == janet_unwrap_string(y)) {
return 0;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include "vector.h"
#include "util.h"
#endif
@@ -40,18 +41,14 @@ void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
/* 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;
sizen = itemsize * janet_v__cnt(v);
p = malloc(sizen);
size_t size = (size_t) itemsize * janet_v__cnt(v);
p = malloc(size);
if (NULL != p) {
memcpy(p, v, sizen);
safe_memcpy(p, v, size);
return p;
} else {
{
JANET_OUT_OF_MEMORY;
}
return NULL;
JANET_OUT_OF_MEMORY;
}
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +24,7 @@
#define JANET_VECTOR_H_defined
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,6 +21,7 @@
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "state.h"
#include "fiber.h"
@@ -117,12 +118,11 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
#define vm_binop_immediate(op)\
{\
Janet op1 = stack[B];\
vm_assert_type(op1, JANET_NUMBER);\
if (!janet_checktype(op1, JANET_NUMBER)) {\
vm_commit();\
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
stack[A] = janet_mcall(#op, 2, _argv);\
vm_pcnext();\
vm_checkgc_pcnext();\
} else {\
double x1 = janet_unwrap_number(op1);\
stack[A] = janet_wrap_number(x1 op CS);\
@@ -132,10 +132,16 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
#define _vm_bitop_immediate(op, type1)\
{\
Janet op1 = stack[B];\
vm_assert_type(op1, JANET_NUMBER);\
type1 x1 = (type1) janet_unwrap_integer(op1);\
stack[A] = janet_wrap_integer(x1 op CS);\
vm_pcnext();\
if (!janet_checktype(op1, JANET_NUMBER)) {\
vm_commit();\
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
stack[A] = janet_mcall(#op, 2, _argv);\
vm_checkgc_pcnext();\
} else {\
type1 x1 = (type1) janet_unwrap_integer(op1);\
stack[A] = janet_wrap_integer(x1 op CS);\
vm_pcnext();\
}\
}
#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t);
#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t);
@@ -143,71 +149,110 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
{\
Janet op1 = stack[B];\
Janet op2 = stack[C];\
if (!janet_checktype(op1, JANET_NUMBER)) {\
vm_commit();\
Janet _argv[2] = { op1, op2 };\
stack[A] = janet_mcall(#op, 2, _argv);\
vm_pcnext();\
} else {\
vm_assert_type(op1, JANET_NUMBER);\
vm_assert_type(op2, JANET_NUMBER);\
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
double x1 = janet_unwrap_number(op1);\
double x2 = janet_unwrap_number(op2);\
stack[A] = wrap(x1 op x2);\
vm_pcnext();\
} else {\
vm_commit();\
stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
vm_checkgc_pcnext();\
}\
}
#define vm_binop(op) _vm_binop(op, janet_wrap_number)
#define vm_numcomp(op) _vm_binop(op, janet_wrap_boolean)
#define _vm_bitop(op, type1)\
{\
Janet op1 = stack[B];\
Janet op2 = stack[C];\
vm_assert_type(op1, JANET_NUMBER);\
vm_assert_type(op2, JANET_NUMBER);\
type1 x1 = (type1) janet_unwrap_integer(op1);\
int32_t x2 = janet_unwrap_integer(op2);\
stack[A] = janet_wrap_integer(x1 op x2);\
vm_pcnext();\
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
type1 x1 = (type1) janet_unwrap_integer(op1);\
int32_t x2 = janet_unwrap_integer(op2);\
stack[A] = janet_wrap_integer(x1 op x2);\
vm_pcnext();\
} else {\
vm_commit();\
stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
vm_checkgc_pcnext();\
}\
}
#define vm_bitop(op) _vm_bitop(op, int32_t)
#define vm_bitopu(op) _vm_bitop(op, uint32_t)
#define vm_compop(op) \
{\
Janet op1 = stack[B];\
Janet op2 = stack[C];\
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
double x1 = janet_unwrap_number(op1);\
double x2 = janet_unwrap_number(op2);\
stack[A] = janet_wrap_boolean(x1 op x2);\
vm_pcnext();\
} else {\
vm_commit();\
stack[A] = janet_wrap_boolean(janet_compare(op1, op2) op 0);\
vm_checkgc_pcnext();\
}\
}
/* Trace a function call */
static void vm_do_trace(JanetFunction *func) {
Janet *stack = janet_vm_fiber->data + janet_vm_fiber->stackstart;
int32_t start = janet_vm_fiber->stackstart;
int32_t end = janet_vm_fiber->stacktop;
int32_t argc = end - start;
static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
if (func->def->name) {
janet_printf("trace (%S", func->def->name);
} else {
janet_printf("trace (%p", janet_wrap_function(func));
}
for (int32_t i = 0; i < argc; i++) {
janet_printf(" %p", stack[i]);
janet_printf(" %p", argv[i]);
}
printf(")\n");
janet_printf(")\n");
}
/* Call a non function type */
/* Invoke a method once we have looked it up */
static Janet janet_method_invoke(Janet method, int32_t argc, Janet *argv) {
switch (janet_type(method)) {
case JANET_CFUNCTION:
return (janet_unwrap_cfunction(method))(argc, argv);
case JANET_FUNCTION: {
JanetFunction *fun = janet_unwrap_function(method);
return janet_call(fun, argc, argv);
}
case JANET_ABSTRACT: {
JanetAbstract abst = janet_unwrap_abstract(method);
const JanetAbstractType *at = janet_abstract_type(abst);
if (NULL != at->call) {
return at->call(abst, argc, argv);
}
}
/* fallthrough */
case JANET_STRING:
case JANET_BUFFER:
case JANET_TABLE:
case JANET_STRUCT:
case JANET_ARRAY:
case JANET_TUPLE: {
if (argc != 1) {
janet_panicf("%v called with %d arguments, possibly expected 1", method, argc);
}
return janet_in(method, argv[0]);
}
default: {
if (argc != 1) {
janet_panicf("%v called with %d arguments, possibly expected 1", method, argc);
}
return janet_in(argv[0], method);
}
}
}
/* Call a non function type from a JOP_CALL or JOP_TAILCALL instruction.
* Assumes that the arguments are on the fiber stack. */
static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
int32_t argn = fiber->stacktop - fiber->stackstart;
Janet ds, key;
if (argn != 1) janet_panicf("%v called with %d arguments, possibly expected 1", callee, argn);
if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY |
JANET_TFLAG_STRING | JANET_TFLAG_BUFFER | JANET_TFLAG_ABSTRACT)) {
ds = callee;
key = fiber->data[fiber->stackstart];
} else {
ds = fiber->data[fiber->stackstart];
key = callee;
}
int32_t argc = fiber->stacktop - fiber->stackstart;
fiber->stacktop = fiber->stackstart;
return janet_in(ds, key);
return janet_method_invoke(callee, argc, fiber->data + fiber->stacktop);
}
/* Get a callable from a keyword method name and check ensure that it is valid. */
/* Get a callable from a keyword method name and ensure that it is valid. */
static Janet resolve_method(Janet name, JanetFiber *fiber) {
int32_t argc = fiber->stacktop - fiber->stackstart;
if (argc < 1) janet_panicf("method call (%v) takes at least 1 argument, got 0", name);
@@ -217,8 +262,33 @@ static Janet resolve_method(Janet name, JanetFiber *fiber) {
return callee;
}
/* Lookup method on value x */
static Janet janet_method_lookup(Janet x, const char *name) {
Janet kname = janet_ckeywordv(name);
return janet_get(x, kname);
}
/* Call a method first on the righthand side, and then on the left hand side with a prefix */
static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lhs, Janet rhs) {
Janet lm = janet_method_lookup(lhs, lmethod);
if (janet_checktype(lm, JANET_NIL)) {
/* Invert order for rmethod */
Janet lr = janet_method_lookup(rhs, rmethod);
Janet argv[2] = { rhs, lhs };
if (janet_checktype(lr, JANET_NIL)) {
janet_panicf("could not find method :%s for %v, or :%s for %v",
lmethod, lhs,
rmethod, rhs);
}
return janet_method_invoke(lr, 2, argv);
} else {
Janet argv[2] = { lhs, rhs };
return janet_method_invoke(lm, 2, argv);
}
}
/* Interpreter main loop */
static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status) {
static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
/* opcode -> label lookup if using clang/GCC */
#ifdef JANET_USE_COMPUTED_GOTOS
@@ -235,6 +305,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
&&label_JOP_MULTIPLY,
&&label_JOP_DIVIDE_IMMEDIATE,
&&label_JOP_DIVIDE,
&&label_JOP_MODULO,
&&label_JOP_REMAINDER,
&&label_JOP_BAND,
&&label_JOP_BOR,
&&label_JOP_BXOR,
@@ -250,6 +322,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
&&label_JOP_JUMP,
&&label_JOP_JUMP_IF,
&&label_JOP_JUMP_IF_NOT,
&&label_JOP_JUMP_IF_NIL,
&&label_JOP_JUMP_IF_NOT_NIL,
&&label_JOP_GREATER_THAN,
&&label_JOP_GREATER_THAN_IMMEDIATE,
&&label_JOP_LESS_THAN,
@@ -288,13 +362,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
&&label_JOP_MAKE_TABLE,
&&label_JOP_MAKE_TUPLE,
&&label_JOP_MAKE_BRACKET_TUPLE,
&&label_JOP_NUMERIC_LESS_THAN,
&&label_JOP_NUMERIC_LESS_THAN_EQUAL,
&&label_JOP_NUMERIC_GREATER_THAN,
&&label_JOP_NUMERIC_GREATER_THAN_EQUAL,
&&label_JOP_NUMERIC_EQUAL,
&&label_unknown_op,
&&label_unknown_op,
&&label_JOP_GREATER_THAN_EQUAL,
&&label_JOP_LESS_THAN_EQUAL,
&&label_JOP_NEXT,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
@@ -487,29 +557,38 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
register JanetFunction *func;
vm_restore();
/* Only should be hit if the fiber is either waiting for a child, or
* waiting to be resumed. In those cases, use input and increment pc. We
* DO NOT use input when resuming a fiber that has been interrupted at a
* breakpoint. */
uint8_t first_opcode;
if (status != JANET_STATUS_NEW &&
((*pc & 0xFF) == JOP_SIGNAL ||
(*pc & 0xFF) == JOP_PROPAGATE ||
(*pc & 0xFF) == JOP_RESUME)) {
stack[A] = in;
pc++;
first_opcode = *pc & 0xFF;
} else if (status == JANET_STATUS_DEBUG) {
first_opcode = *pc & 0x7F;
} else {
first_opcode = *pc & 0xFF;
if (fiber->flags & JANET_FIBER_DID_LONGJUMP) {
if (janet_fiber_frame(fiber)->func == NULL) {
/* Inside a c function */
janet_fiber_popframe(fiber);
vm_restore();
}
/* Check if we were at a tail call instruction. If so, do implicit return */
if ((*pc & 0xFF) == JOP_TAILCALL) {
/* Tail call resume */
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
janet_fiber_popframe(fiber);
if (entrance_frame) {
fiber->flags &= ~JANET_FIBER_FLAG_MASK;
vm_return(JANET_SIGNAL_OK, in);
}
vm_restore();
}
}
if (!(fiber->flags & JANET_FIBER_RESUME_NO_USEVAL)) stack[A] = in;
if (!(fiber->flags & JANET_FIBER_RESUME_NO_SKIP)) pc++;
uint8_t first_opcode = *pc & ((fiber->flags & JANET_FIBER_BREAKPOINT) ? 0x7F : 0xFF);
fiber->flags &= ~JANET_FIBER_FLAG_MASK;
/* Main interpreter loop. Semantically is a switch on
* (*pc & 0xFF) inside of an infinite loop. */
VM_START();
VM_DEFAULT();
fiber->flags |= JANET_FIBER_BREAKPOINT | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
vm_return(JANET_SIGNAL_DEBUG, janet_wrap_nil());
VM_OP(JOP_NOOP)
@@ -557,27 +636,43 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
VM_OP(JOP_MULTIPLY)
vm_binop(*);
VM_OP(JOP_NUMERIC_LESS_THAN)
vm_numcomp( <);
VM_OP(JOP_NUMERIC_LESS_THAN_EQUAL)
vm_numcomp( <=);
VM_OP(JOP_NUMERIC_GREATER_THAN)
vm_numcomp( >);
VM_OP(JOP_NUMERIC_GREATER_THAN_EQUAL)
vm_numcomp( >=);
VM_OP(JOP_NUMERIC_EQUAL)
vm_numcomp( ==);
VM_OP(JOP_DIVIDE_IMMEDIATE)
vm_binop_immediate( /);
VM_OP(JOP_DIVIDE)
vm_binop( /);
VM_OP(JOP_MODULO) {
Janet op1 = stack[B];
Janet op2 = stack[C];
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
double x1 = janet_unwrap_number(op1);
double x2 = janet_unwrap_number(op2);
double intres = x2 * floor(x1 / x2);
stack[A] = janet_wrap_number(x1 - intres);
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_binop_call("mod", "rmod", op1, op2);
vm_checkgc_pcnext();
}
}
VM_OP(JOP_REMAINDER) {
Janet op1 = stack[B];
Janet op2 = stack[C];
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
double x1 = janet_unwrap_number(op1);
double x2 = janet_unwrap_number(op2);
stack[A] = janet_wrap_number(fmod(x1, x2));
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_binop_call("%", "r%", op1, op2);
vm_checkgc_pcnext();
}
}
VM_OP(JOP_BAND)
vm_bitop(&);
@@ -640,17 +735,37 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
}
vm_next();
VM_OP(JOP_JUMP_IF_NIL)
if (janet_checktype(stack[A], JANET_NIL)) {
pc += ES;
} else {
pc++;
}
vm_next();
VM_OP(JOP_JUMP_IF_NOT_NIL)
if (janet_checktype(stack[A], JANET_NIL)) {
pc++;
} else {
pc += ES;
}
vm_next();
VM_OP(JOP_LESS_THAN)
stack[A] = janet_wrap_boolean(janet_compare(stack[B], stack[C]) < 0);
vm_pcnext();
vm_compop( <);
VM_OP(JOP_LESS_THAN_EQUAL)
vm_compop( <=);
VM_OP(JOP_LESS_THAN_IMMEDIATE)
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) < CS);
vm_pcnext();
VM_OP(JOP_GREATER_THAN)
stack[A] = janet_wrap_boolean(janet_compare(stack[B], stack[C]) > 0);
vm_pcnext();
vm_compop( >);
VM_OP(JOP_GREATER_THAN_EQUAL)
vm_compop( >=);
VM_OP(JOP_GREATER_THAN_IMMEDIATE)
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) > CS);
@@ -668,6 +783,10 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
stack[A] = janet_wrap_integer(janet_compare(stack[B], stack[C]));
vm_pcnext();
VM_OP(JOP_NEXT)
stack[A] = janet_next(stack[B], stack[C]);
vm_pcnext();
VM_OP(JOP_LOAD_NIL)
stack[D] = janet_wrap_nil();
vm_pcnext();
@@ -735,7 +854,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
vm_assert(defindex < func->def->defs_length, "invalid funcdef");
fd = func->def->defs[defindex];
elen = fd->environments_length;
fn = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) + (elen * sizeof(JanetFuncEnv *)));
fn = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) + ((size_t) elen * sizeof(JanetFuncEnv *)));
fn->def = fd;
{
int32_t i;
@@ -799,7 +918,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
}
if (janet_checktype(callee, JANET_FUNCTION)) {
func = janet_unwrap_function(callee);
if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
}
janet_stack_frame(stack)->pc = pc;
if (janet_fiber_funcframe(fiber, func)) {
int32_t n = fiber->stacktop - fiber->stackstart;
@@ -836,7 +957,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
}
if (janet_checktype(callee, JANET_FUNCTION)) {
func = janet_unwrap_function(callee);
if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
}
if (janet_fiber_funcframe_tail(fiber, func)) {
janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
int32_t n = fiber->stacktop - fiber->stackstart;
@@ -873,8 +996,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
JanetFiber *child = janet_unwrap_fiber(stack[B]);
fiber->child = child;
JanetSignal sig = janet_continue(child, stack[C], &retreg);
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig)))
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
vm_return(sig, retreg);
}
fiber->child = NULL;
stack = fiber->data + fiber->frame;
stack[A] = retreg;
@@ -898,18 +1022,22 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
janet_panicf("cannot propagate from fiber with status :%s",
janet_status_names[sub_status]);
}
janet_vm_fiber->child = f;
fiber->child = f;
vm_return((int) sub_status, stack[B]);
}
VM_OP(JOP_PUT)
vm_commit();
fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
janet_put(stack[A], stack[B], stack[C]);
fiber->flags &= ~JANET_FIBER_RESUME_NO_USEVAL;
vm_checkgc_pcnext();
VM_OP(JOP_PUT_INDEX)
vm_commit();
fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
janet_putindex(stack[A], C, stack[B]);
fiber->flags &= ~JANET_FIBER_RESUME_NO_USEVAL;
vm_checkgc_pcnext();
VM_OP(JOP_IN)
@@ -1079,6 +1207,11 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
if (janet_vm_stackn >= JANET_RECURSION_GUARD)
janet_panic("C stack recursed too deeply");
/* Tracing */
if (fun->gc.flags & JANET_FUNCFLAG_TRACE) {
vm_do_trace(fun, argc, argv);
}
/* Push frame */
janet_fiber_pushn(janet_vm_fiber, argv, argc);
if (janet_fiber_funcframe(janet_vm_fiber, fun)) {
@@ -1091,9 +1224,8 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
int handle = janet_gclock();
/* Run vm */
JanetSignal signal = run_vm(janet_vm_fiber,
janet_wrap_nil(),
JANET_STATUS_ALIVE);
janet_vm_fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
JanetSignal signal = run_vm(janet_vm_fiber, janet_wrap_nil());
/* Teardown */
janet_vm_stackn = oldn;
@@ -1153,10 +1285,16 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
/* Run loop */
JanetSignal signal;
if (setjmp(buf)) {
signal = JANET_SIGNAL_ERROR;
int jmpsig;
#if defined(JANET_BSD) || defined(JANET_APPLE)
jmpsig = _setjmp(buf);
#else
jmpsig = setjmp(buf);
#endif
if (jmpsig) {
signal = (JanetSignal) jmpsig;
} else {
signal = run_vm(fiber, in, old_status);
signal = run_vm(fiber, in);
}
/* Tear down fiber */
@@ -1197,30 +1335,12 @@ Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
/* At least 1 argument */
if (argc < 1) janet_panicf("method :%s expected at least 1 argument");
/* Find method */
Janet method;
if (janet_checktype(argv[0], JANET_ABSTRACT)) {
void *abst = janet_unwrap_abstract(argv[0]);
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst);
if (!type->get || !(type->get)(abst, janet_ckeywordv(name), &method))
janet_panicf("abstract value %v does not implement :%s", argv[0], name);
} else if (janet_checktype(argv[0], JANET_TABLE)) {
JanetTable *table = janet_unwrap_table(argv[0]);
method = janet_table_get(table, janet_ckeywordv(name));
} else if (janet_checktype(argv[0], JANET_STRUCT)) {
const JanetKV *st = janet_unwrap_struct(argv[0]);
method = janet_struct_get(st, janet_ckeywordv(name));
} else {
Janet method = janet_method_lookup(argv[0], name);
if (janet_checktype(method, JANET_NIL)) {
janet_panicf("could not find method :%s for %v", name, argv[0]);
}
/* Invoke method */
if (janet_checktype(method, JANET_CFUNCTION)) {
return (janet_unwrap_cfunction(method))(argc, argv);
} else if (janet_checktype(method, JANET_FUNCTION)) {
JanetFunction *fun = janet_unwrap_function(method);
return janet_call(fun, argc, argv);
} else {
janet_panicf("method %s has unexpected value %v", name, method);
}
return janet_method_invoke(method, argc, argv);
}
/* Setup VM */

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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,9 @@
*/
#ifndef JANET_AMALG
#include <math.h>
#include "features.h"
#include <janet.h>
#include <math.h>
#include "util.h"
#include "state.h"
#endif
@@ -161,8 +162,8 @@ Janet(janet_wrap_number)(double x) {
void *janet_memalloc_empty(int32_t count) {
int32_t i;
void *mem = malloc(count * sizeof(JanetKV));
janet_vm_next_collection += count * sizeof(JanetKV);
void *mem = malloc((size_t) count * sizeof(JanetKV));
janet_vm_next_collection += (size_t) count * sizeof(JanetKV);
if (NULL == mem) {
JANET_OUT_OF_MEMORY;
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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
@@ -45,6 +45,22 @@ extern "C" {
* detection for unsupported platforms
*/
/* Check for any flavor of BSD (except apple) */
#if defined(__FreeBSD__) || defined(__DragonFly__) || \
defined(__NetBSD__) || defined(__OpenBSD__)
#define JANET_BSD 1
#endif
/* Check for Mac */
#ifdef __APPLE__
#define JANET_APPLE 1
#endif
/* Check for Linux */
#ifdef __linux__
#define JANET_LINUX 1
#endif
/* Check Unix */
#if defined(_AIX) \
|| defined(__APPLE__) /* Darwin */ \
@@ -58,11 +74,7 @@ extern "C" {
|| defined(__QNXNTO__) \
|| defined(sun) || defined(__sun) /* Solaris */ \
|| defined(unix) || defined(__unix) || defined(__unix__)
#define JANET_UNIX 1
/* Enable certain posix features */
#ifndef _POSIX_C_SOURCE
#define _POSIX_C_SOURCE 200112L
#endif
#define JANET_POSIX 1
#elif defined(__EMSCRIPTEN__)
#define JANET_WEB 1
#elif defined(WIN32) || defined(_WIN32)
@@ -71,7 +83,7 @@ extern "C" {
/* Check 64-bit vs 32-bit */
#if ((defined(__x86_64__) || defined(_M_X64)) \
&& (defined(JANET_UNIX) || defined(JANET_WINDOWS))) \
&& (defined(JANET_POSIX) || defined(JANET_WINDOWS))) \
|| (defined(_WIN64)) /* Windows 64 bit */ \
|| (defined(__ia64__) && defined(__LP64__)) /* Itanium in LP64 mode */ \
|| defined(__alpha__) /* DEC Alpha */ \
@@ -112,8 +124,10 @@ extern "C" {
#define JANET_THREAD_LOCAL
#elif defined(__GNUC__)
#define JANET_THREAD_LOCAL __thread
#define JANET_THREADS
#elif defined(_MSC_BUILD)
#define JANET_THREAD_LOCAL __declspec(thread)
#define JANET_THREADS
#else
#define JANET_THREAD_LOCAL
#endif
@@ -143,11 +157,6 @@ extern "C" {
#define JANET_INT_TYPES
#endif
/* Enable or disable threads */
#ifndef JANET_NO_THREADS
#define JANET_THREADS
#endif
/* How to export symbols */
#ifndef JANET_API
#ifdef JANET_WINDOWS
@@ -245,6 +254,11 @@ typedef struct {
#include <stddef.h>
#include <stdio.h>
#ifdef JANET_BSD
int _setjmp(jmp_buf);
JANET_NO_RETURN void _longjmp(jmp_buf, int);
#endif
/* Names of all of the types */
JANET_API extern const char *const janet_type_names[16];
JANET_API extern const char *const janet_signal_names[14];
@@ -666,6 +680,7 @@ struct Janet {
JANET_API int janet_checkint(Janet x);
JANET_API int janet_checkint64(Janet x);
JANET_API int janet_checksize(Janet x);
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
#define janet_checkintrange(x) ((x) == (int32_t)(x))
#define janet_checkint64range(x) ((x) == (int64_t)(x))
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
@@ -681,28 +696,6 @@ struct JanetGCObject {
JanetGCObject *next;
};
/* 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 0xFF0000
#define JANET_FIBER_STATUS_OFFSET 16
/* A lightweight green thread in janet. Does not correspond to
* operating system threads. */
struct JanetFiber {
@@ -912,8 +905,29 @@ struct JanetAbstractType {
void (*marshal)(void *p, JanetMarshalContext *ctx);
void *(*unmarshal)(JanetMarshalContext *ctx);
void (*tostring)(void *p, JanetBuffer *buffer);
int (*compare)(void *lhs, void *rhs);
int32_t (*hash)(void *p, size_t len);
Janet(*next)(void *p, Janet key);
Janet(*call)(void *p, int32_t argc, Janet *argv);
};
/* Some macros to let us add extra types to JanetAbstract types without
* needing to changing native modules that declare them as static const
* structures. If more fields are added, these macros are modified to include
* default values (usually NULL). This silences missing field warnings. */
#define JANET_ATEND_NAME NULL,JANET_ATEND_GC
#define JANET_ATEND_GC NULL,JANET_ATEND_GCMARK
#define JANET_ATEND_GCMARK NULL,JANET_ATEND_GET
#define JANET_ATEND_GET NULL,JANET_ATEND_PUT
#define JANET_ATEND_PUT NULL,JANET_ATEND_MARSHAL
#define JANET_ATEND_MARSHAL NULL,JANET_ATEND_UNMARSHAL
#define JANET_ATEND_UNMARSHAL NULL,JANET_ATEND_TOSTRING
#define JANET_ATEND_TOSTRING NULL,JANET_ATEND_COMPARE
#define JANET_ATEND_COMPARE NULL,JANET_ATEND_HASH
#define JANET_ATEND_HASH NULL,JANET_ATEND_NEXT
#define JANET_ATEND_NEXT NULL,JANET_ATEND_CALL
#define JANET_ATEND_CALL
struct JanetReg {
const char *name;
JanetCFunction cfun;
@@ -1010,6 +1024,8 @@ enum JanetOpCode {
JOP_MULTIPLY,
JOP_DIVIDE_IMMEDIATE,
JOP_DIVIDE,
JOP_MODULO,
JOP_REMAINDER,
JOP_BAND,
JOP_BOR,
JOP_BXOR,
@@ -1025,6 +1041,8 @@ enum JanetOpCode {
JOP_JUMP,
JOP_JUMP_IF,
JOP_JUMP_IF_NOT,
JOP_JUMP_IF_NIL,
JOP_JUMP_IF_NOT_NIL,
JOP_GREATER_THAN,
JOP_GREATER_THAN_IMMEDIATE,
JOP_LESS_THAN,
@@ -1063,11 +1081,9 @@ enum JanetOpCode {
JOP_MAKE_TABLE,
JOP_MAKE_TUPLE,
JOP_MAKE_BRACKET_TUPLE,
JOP_NUMERIC_LESS_THAN,
JOP_NUMERIC_LESS_THAN_EQUAL,
JOP_NUMERIC_GREATER_THAN,
JOP_NUMERIC_GREATER_THAN_EQUAL,
JOP_NUMERIC_EQUAL,
JOP_GREATER_THAN_EQUAL,
JOP_LESS_THAN_EQUAL,
JOP_NEXT,
JOP_INSTRUCTION_COUNT
};
@@ -1298,6 +1314,7 @@ JANET_API int janet_gcunroot(Janet root);
JANET_API int janet_gcunrootall(Janet root);
JANET_API int janet_gclock(void);
JANET_API void janet_gcunlock(int handle);
JANET_API void janet_gcpressure(size_t s);
/* Functions */
JANET_API JanetFuncDef *janet_funcdef_alloc(void);
@@ -1310,12 +1327,17 @@ JANET_API int janet_verify(JanetFuncDef *def);
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x);
/* Misc */
#ifndef JANET_NO_PRF
#define JANET_HASH_KEY_SIZE 16
JANET_API void janet_init_hash_key(uint8_t key[JANET_HASH_KEY_SIZE]);
#endif
JANET_API int janet_equals(Janet x, Janet y);
JANET_API int32_t janet_hash(Janet x);
JANET_API int janet_compare(Janet x, Janet y);
JANET_API int janet_cstrcmp(JanetString str, const char *other);
JANET_API Janet janet_in(Janet ds, Janet key);
JANET_API Janet janet_get(Janet ds, Janet key);
JANET_API Janet janet_next(Janet ds, Janet key);
JANET_API Janet janet_getindex(Janet ds, int32_t index);
JANET_API int32_t janet_length(Janet x);
JANET_API Janet janet_lengthv(Janet x);
@@ -1323,6 +1345,9 @@ JANET_API void janet_put(Janet ds, Janet key, Janet value);
JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
#define janet_flag_at(F, I) ((F) & ((1ULL) << (I)))
JANET_API Janet janet_wrap_number_safe(double x);
JANET_API int janet_keyeq(Janet x, const char *cstring);
JANET_API int janet_streq(Janet x, const char *cstring);
JANET_API int janet_symeq(Janet x, const char *cstring);
/* VM functions */
JANET_API int janet_init(void);
@@ -1335,10 +1360,12 @@ JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
/* Scratch Memory API */
typedef void (*ScratchFinalizer)(void *);
typedef void (*JanetScratchFinalizer)(void *);
JANET_API void *janet_smalloc(size_t size);
JANET_API void *janet_srealloc(void *mem, size_t size);
JANET_API void janet_sfinalizer(void *mem, ScratchFinalizer finalizer);
JANET_API void *janet_scalloc(size_t nmemb, size_t size);
JANET_API void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer);
JANET_API void janet_sfree(void *mem);
/* C Library helpers */
@@ -1361,15 +1388,16 @@ JANET_API Janet janet_resolve_core(const char *name);
/* Allow setting entry name for static libraries */
#ifndef JANET_ENTRY_NAME
#define JANET_ENTRY_NAME _janet_init
#endif
#define JANET_MODULE_ENTRY \
JANET_API JanetBuildConfig _janet_mod_config(void) { \
return janet_config_current(); \
} \
JANET_API void JANET_ENTRY_NAME
JANET_API void _janet_init
#else
#define JANET_MODULE_ENTRY JANET_API void JANET_ENTRY_NAME
#endif
JANET_NO_RETURN JANET_API void janet_signalv(JanetSignal signal, Janet message);
JANET_NO_RETURN JANET_API void janet_panicv(Janet message);
JANET_NO_RETURN JANET_API void janet_panic(const char *message);
JANET_NO_RETURN JANET_API void janet_panics(JanetString message);
@@ -1440,8 +1468,21 @@ JANET_API JanetArray *janet_optarray(const Janet *argv, int32_t argc, int32_t n,
JANET_API Janet janet_dyn(const char *name);
JANET_API void janet_setdyn(const char *name, Janet value);
#define JANET_FILE_WRITE 1
#define JANET_FILE_READ 2
#define JANET_FILE_APPEND 4
#define JANET_FILE_UPDATE 8
#define JANET_FILE_NOT_CLOSEABLE 16
#define JANET_FILE_CLOSED 32
#define JANET_FILE_BINARY 64
#define JANET_FILE_SERIALIZABLE 128
#define JANET_FILE_PIPED 256
JANET_API Janet janet_makefile(FILE *f, int flags);
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
JANET_API FILE *janet_dynfile(const char *name, FILE *def);
JANET_API JanetAbstract janet_checkfile(Janet j);
JANET_API FILE *janet_unwrapfile(Janet j, int *flags);
/* Marshal API */
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);

View File

@@ -1,502 +0,0 @@
/*
* 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
* 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 "line.h"
#endif
/* Common */
Janet janet_line_getter(int32_t argc, Janet *argv) {
janet_arity(argc, 0, 2);
const char *str = (argc >= 1) ? (const char *) janet_getstring(argv, 0) : "";
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
janet_line_get(str, buf);
return janet_wrap_buffer(buf);
}
static void simpleline(JanetBuffer *buffer) {
FILE *in = janet_dynfile("in", stdin);
buffer->count = 0;
int c;
for (;;) {
c = fgetc(in);
if (feof(in) || c < 0) {
break;
}
janet_buffer_push_u8(buffer, (uint8_t) c);
if (c == '\n') break;
}
}
/* Windows */
#ifdef JANET_WINDOWS
void janet_line_init() {
;
}
void janet_line_deinit() {
;
}
void janet_line_get(const char *p, JanetBuffer *buffer) {
FILE *out = janet_dynfile("out", stdout);
fputs(p, out);
fflush(out);
simpleline(buffer);
}
/* Posix */
#else
/*
https://github.com/antirez/linenoise/blob/master/linenoise.c
*/
#include <termios.h>
#include <unistd.h>
#include <stdlib.h>
#include <stdio.h>
#include <errno.h>
#include <stdlib.h>
#include <ctype.h>
#include <sys/stat.h>
#include <sys/types.h>
#include <sys/ioctl.h>
#include <unistd.h>
#include <string.h>
#include <signal.h>
/* static state */
#define JANET_LINE_MAX 1024
#define JANET_HISTORY_MAX 100
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
static JANET_THREAD_LOCAL int gbl_plen = 2;
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
static JANET_THREAD_LOCAL int gbl_len = 0;
static JANET_THREAD_LOCAL int gbl_pos = 0;
static JANET_THREAD_LOCAL int gbl_cols = 80;
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
static JANET_THREAD_LOCAL int gbl_history_count = 0;
static JANET_THREAD_LOCAL int gbl_historyi = 0;
static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
static JANET_THREAD_LOCAL struct termios gbl_termios_start;
/* Unsupported terminal list from linenoise */
static const char *badterms[] = {
"cons25",
"dumb",
"emacs",
NULL
};
static char *sdup(const char *s) {
size_t len = strlen(s) + 1;
char *mem = malloc(len);
if (!mem) {
return NULL;
}
return memcpy(mem, s, len);
}
/* Ansi terminal raw mode */
static int rawmode() {
struct termios t;
if (!isatty(STDIN_FILENO)) goto fatal;
if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
t = gbl_termios_start;
t.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
t.c_cflag |= (CS8);
t.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
t.c_cc[VMIN] = 1;
t.c_cc[VTIME] = 0;
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &t) < 0) goto fatal;
gbl_israwmode = 1;
return 0;
fatal:
errno = ENOTTY;
return -1;
}
/* Disable raw mode */
static void norawmode() {
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &gbl_termios_start) != -1)
gbl_israwmode = 0;
}
static int curpos() {
char buf[32];
int cols, rows;
unsigned int i = 0;
if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
while (i < sizeof(buf) - 1) {
if (read(STDIN_FILENO, buf + i, 1) != 1) break;
if (buf[i] == 'R') break;
i++;
}
buf[i] = '\0';
if (buf[0] != 27 || buf[1] != '[') return -1;
if (sscanf(buf + 2, "%d;%d", &rows, &cols) != 2) return -1;
return cols;
}
static int getcols() {
struct winsize ws;
if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_col == 0) {
int start, cols;
start = curpos();
if (start == -1) goto failed;
if (write(STDOUT_FILENO, "\x1b[999C", 6) != 6) goto failed;
cols = curpos();
if (cols == -1) goto failed;
if (cols > start) {
char seq[32];
snprintf(seq, 32, "\x1b[%dD", cols - start);
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {
exit(1);
}
}
return cols;
} else {
return ws.ws_col;
}
failed:
return 80;
}
static void clear() {
if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {
exit(1);
}
}
static void refresh() {
char seq[64];
JanetBuffer b;
/* Keep cursor position on screen */
char *_buf = gbl_buf;
int _len = gbl_len;
int _pos = gbl_pos;
while ((gbl_plen + _pos) >= gbl_cols) {
_buf++;
_len--;
_pos--;
}
while ((gbl_plen + _len) > gbl_cols) {
_len--;
}
janet_buffer_init(&b, 0);
/* Cursor to left edge, gbl_prompt and buffer */
janet_buffer_push_u8(&b, '\r');
janet_buffer_push_cstring(&b, gbl_prompt);
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
/* Erase to right */
janet_buffer_push_cstring(&b, "\x1b[0K");
/* Move cursor to original position. */
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
janet_buffer_push_cstring(&b, seq);
if (write(STDOUT_FILENO, b.data, b.count) == -1) {
exit(1);
}
janet_buffer_deinit(&b);
}
static int insert(char c) {
if (gbl_len < JANET_LINE_MAX - 1) {
if (gbl_len == gbl_pos) {
gbl_buf[gbl_pos++] = c;
gbl_buf[++gbl_len] = '\0';
if (gbl_plen + gbl_len < gbl_cols) {
/* Avoid a full update of the line in the
* trivial case. */
if (write(STDOUT_FILENO, &c, 1) == -1) return -1;
} else {
refresh();
}
} else {
memmove(gbl_buf + gbl_pos + 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
gbl_buf[gbl_pos++] = c;
gbl_buf[++gbl_len] = '\0';
refresh();
}
}
return 0;
}
static void historymove(int delta) {
if (gbl_history_count > 1) {
free(gbl_history[gbl_historyi]);
gbl_history[gbl_historyi] = sdup(gbl_buf);
gbl_historyi += delta;
if (gbl_historyi < 0) {
gbl_historyi = 0;
return;
} else if (gbl_historyi >= gbl_history_count) {
gbl_historyi = gbl_history_count - 1;
return;
}
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
gbl_pos = gbl_len = strlen(gbl_buf);
gbl_buf[gbl_len] = '\0';
refresh();
}
}
static void addhistory() {
int i, len;
char *newline = sdup(gbl_buf);
if (!newline) return;
len = gbl_history_count;
if (len < JANET_HISTORY_MAX) {
gbl_history[gbl_history_count++] = newline;
len++;
} else {
free(gbl_history[JANET_HISTORY_MAX - 1]);
}
for (i = len - 1; i > 0; i--) {
gbl_history[i] = gbl_history[i - 1];
}
gbl_history[0] = newline;
}
static void replacehistory() {
char *newline = sdup(gbl_buf);
if (!newline) return;
free(gbl_history[0]);
gbl_history[0] = newline;
}
static void kleft() {
if (gbl_pos > 0) {
gbl_pos--;
refresh();
}
}
static void kright() {
if (gbl_pos != gbl_len) {
gbl_pos++;
refresh();
}
}
static void kbackspace() {
if (gbl_pos > 0) {
memmove(gbl_buf + gbl_pos - 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
gbl_pos--;
gbl_buf[--gbl_len] = '\0';
refresh();
}
}
static void kdelete() {
if (gbl_pos != gbl_len) {
memmove(gbl_buf + gbl_pos, gbl_buf + gbl_pos + 1, gbl_len - gbl_pos);
gbl_buf[--gbl_len] = '\0';
refresh();
}
}
static int line() {
gbl_cols = getcols();
gbl_plen = 0;
gbl_len = 0;
gbl_pos = 0;
while (gbl_prompt[gbl_plen]) gbl_plen++;
gbl_buf[0] = '\0';
addhistory();
if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
for (;;) {
char c;
int nread;
char seq[3];
nread = read(STDIN_FILENO, &c, 1);
if (nread <= 0) return -1;
switch (c) {
default:
if (insert(c)) return -1;
break;
case 9: /* tab */
if (insert(' ')) return -1;
if (insert(' ')) return -1;
break;
case 13: /* enter */
return 0;
case 3: /* ctrl-c */
errno = EAGAIN;
gbl_sigint_flag = 1;
return -1;
case 127: /* backspace */
case 8: /* ctrl-h */
kbackspace();
break;
case 4: /* ctrl-d, eof */
return -1;
case 2: /* ctrl-b */
kleft();
break;
case 6: /* ctrl-f */
kright();
break;
case 21:
gbl_buf[0] = '\0';
gbl_pos = gbl_len = 0;
refresh();
break;
case 26: /* ctrl-z */
norawmode();
kill(getpid(), SIGSTOP);
rawmode();
refresh();
break;
case 12:
clear();
refresh();
break;
case 27: /* escape sequence */
/* Read the next two bytes representing the escape sequence.
* Use two calls to handle slow terminals returning the two
* chars at different times. */
if (read(STDIN_FILENO, seq, 1) == -1) break;
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
if (seq[0] == '[') {
if (seq[1] >= '0' && seq[1] <= '9') {
/* Extended escape, read additional byte. */
if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
if (seq[2] == '~') {
switch (seq[1]) {
case '3': /* delete */
kdelete();
break;
default:
break;
}
}
} else {
switch (seq[1]) {
default:
break;
case 'A':
historymove(1);
break;
case 'B':
historymove(-1);
break;
case 'C': /* Right */
kright();
break;
case 'D': /* Left */
kleft();
break;
case 'H':
gbl_pos = 0;
refresh();
break;
case 'F':
gbl_pos = gbl_len;
refresh();
break;
}
}
} else if (seq[0] == 'O') {
switch (seq[1]) {
default:
break;
case 'H':
gbl_pos = 0;
refresh();
break;
case 'F':
gbl_pos = gbl_len;
refresh();
break;
}
}
break;
}
}
return 0;
}
void janet_line_init() {
;
}
void janet_line_deinit() {
int i;
norawmode();
for (i = 0; i < gbl_history_count; i++)
free(gbl_history[i]);
gbl_historyi = 0;
}
static int checktermsupport() {
const char *t = getenv("TERM");
int i;
if (!t) return 1;
for (i = 0; badterms[i]; i++)
if (!strcmp(t, badterms[i])) return 0;
return 1;
}
void janet_line_get(const char *p, JanetBuffer *buffer) {
gbl_prompt = p;
buffer->count = 0;
gbl_historyi = 0;
FILE *out = janet_dynfile("out", stdout);
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
simpleline(buffer);
return;
}
if (rawmode()) {
simpleline(buffer);
return;
}
if (line()) {
norawmode();
if (gbl_sigint_flag) {
raise(SIGINT);
} else {
fputc('\n', out);
}
return;
}
fflush(stdin);
norawmode();
fputc('\n', out);
janet_buffer_ensure(buffer, gbl_len + 1, 2);
memcpy(buffer->data, gbl_buf, gbl_len);
buffer->data[gbl_len] = '\n';
buffer->count = gbl_len + 1;
replacehistory();
}
#endif

View File

@@ -1,86 +0,0 @@
/*
* 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
* 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 "line.h"
#endif
#ifdef _WIN32
#include <windows.h>
#include <shlwapi.h>
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
#endif
#endif
int main(int argc, char **argv) {
int i, status;
JanetArray *args;
JanetTable *env;
#ifdef _WIN32
/* Enable color console on windows 10 console and utf8 output. */
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
DWORD dwMode = 0;
GetConsoleMode(hOut, &dwMode);
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
SetConsoleMode(hOut, dwMode);
SetConsoleOutputCP(65001);
#endif
/* Set up VM */
janet_init();
/* Replace original getline with new line getter */
JanetTable *replacements = janet_table(0);
janet_table_put(replacements, janet_csymbolv("getline"), janet_wrap_cfunction(janet_line_getter));
janet_line_init();
/* Get core env */
env = janet_core_env(replacements);
/* Create args tuple */
args = janet_array(argc);
for (i = 1; i < argc; i++)
janet_array_push(args, janet_cstringv(argv[i]));
/* Save current executable path to (dyn :executable) */
janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
/* Run startup script */
Janet mainfun, out;
janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
Janet mainargs[1] = { janet_wrap_array(args) };
JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
fiber->env = env;
status = janet_continue(fiber, janet_wrap_nil(), &out);
if (status != JANET_SIGNAL_OK) {
janet_stacktrace(fiber, out);
}
/* Deinitialize vm */
janet_deinit();
janet_line_deinit();
return status;
}

881
src/mainclient/shell.c Normal file
View File

@@ -0,0 +1,881 @@
/*
* Copyright (c) 2020 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.
*/
#if !defined(_POSIX_C_SOURCE)
#define _POSIX_C_SOURCE 200112L
#endif
#include <janet.h>
#ifdef _WIN32
#include <windows.h>
#include <shlwapi.h>
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
#endif
#endif
void janet_line_init();
void janet_line_deinit();
void janet_line_get(const char *p, JanetBuffer *buffer);
Janet janet_line_getter(int32_t argc, Janet *argv);
/*
* Line Editing
*/
static JANET_THREAD_LOCAL JanetTable *gbl_complete_env;
/* Common */
Janet janet_line_getter(int32_t argc, Janet *argv) {
janet_arity(argc, 0, 3);
const char *str = (argc >= 1) ? (const char *) janet_getstring(argv, 0) : "";
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
gbl_complete_env = (argc >= 3) ? janet_gettable(argv, 2) : NULL;
janet_line_get(str, buf);
gbl_complete_env = NULL;
return janet_wrap_buffer(buf);
}
static void simpleline(JanetBuffer *buffer) {
FILE *in = janet_dynfile("in", stdin);
buffer->count = 0;
int c;
for (;;) {
c = fgetc(in);
if (feof(in) || c < 0) {
break;
}
janet_buffer_push_u8(buffer, (uint8_t) c);
if (c == '\n') break;
}
}
/* Windows */
#ifdef JANET_WINDOWS
void janet_line_init() {
;
}
void janet_line_deinit() {
;
}
void janet_line_get(const char *p, JanetBuffer *buffer) {
FILE *out = janet_dynfile("err", stderr);
fputs(p, out);
fflush(out);
simpleline(buffer);
}
/* Posix */
#else
/*
https://github.com/antirez/linenoise/blob/master/linenoise.c
*/
#include <termios.h>
#include <unistd.h>
#include <stdlib.h>
#include <stdio.h>
#include <errno.h>
#include <stdlib.h>
#include <ctype.h>
#include <sys/stat.h>
#include <sys/types.h>
#include <sys/ioctl.h>
#include <unistd.h>
#include <string.h>
#include <signal.h>
/* static state */
#define JANET_LINE_MAX 1024
#define JANET_MATCH_MAX 256
#define JANET_HISTORY_MAX 100
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
static JANET_THREAD_LOCAL int gbl_plen = 2;
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
static JANET_THREAD_LOCAL int gbl_len = 0;
static JANET_THREAD_LOCAL int gbl_pos = 0;
static JANET_THREAD_LOCAL int gbl_cols = 80;
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
static JANET_THREAD_LOCAL int gbl_history_count = 0;
static JANET_THREAD_LOCAL int gbl_historyi = 0;
static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
static JANET_THREAD_LOCAL struct termios gbl_termios_start;
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
static JANET_THREAD_LOCAL int gbl_match_count = 0;
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
/* Unsupported terminal list from linenoise */
static const char *badterms[] = {
"cons25",
"dumb",
"emacs",
NULL
};
static char *sdup(const char *s) {
size_t len = strlen(s) + 1;
char *mem = malloc(len);
if (!mem) {
return NULL;
}
return memcpy(mem, s, len);
}
/* Ansi terminal raw mode */
static int rawmode(void) {
struct termios t;
if (!isatty(STDIN_FILENO)) goto fatal;
if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
t = gbl_termios_start;
t.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
t.c_cflag |= (CS8);
t.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
t.c_cc[VMIN] = 1;
t.c_cc[VTIME] = 0;
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &t) < 0) goto fatal;
gbl_israwmode = 1;
return 0;
fatal:
errno = ENOTTY;
return -1;
}
/* Disable raw mode */
static void norawmode(void) {
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &gbl_termios_start) != -1)
gbl_israwmode = 0;
}
static int curpos(void) {
char buf[32];
int cols, rows;
unsigned int i = 0;
if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
while (i < sizeof(buf) - 1) {
if (read(STDIN_FILENO, buf + i, 1) != 1) break;
if (buf[i] == 'R') break;
i++;
}
buf[i] = '\0';
if (buf[0] != 27 || buf[1] != '[') return -1;
if (sscanf(buf + 2, "%d;%d", &rows, &cols) != 2) return -1;
return cols;
}
static int getcols(void) {
struct winsize ws;
if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_col == 0) {
int start, cols;
start = curpos();
if (start == -1) goto failed;
if (write(STDOUT_FILENO, "\x1b[999C", 6) != 6) goto failed;
cols = curpos();
if (cols == -1) goto failed;
if (cols > start) {
char seq[32];
snprintf(seq, 32, "\x1b[%dD", cols - start);
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {
exit(1);
}
}
return cols;
} else {
return ws.ws_col;
}
failed:
return 80;
}
static void clear(void) {
if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {
exit(1);
}
}
static void refresh(void) {
char seq[64];
JanetBuffer b;
/* Keep cursor position on screen */
char *_buf = gbl_buf;
int _len = gbl_len;
int _pos = gbl_pos;
while ((gbl_plen + _pos) >= gbl_cols) {
_buf++;
_len--;
_pos--;
}
while ((gbl_plen + _len) > gbl_cols) {
_len--;
}
janet_buffer_init(&b, 0);
/* Cursor to left edge, gbl_prompt and buffer */
janet_buffer_push_u8(&b, '\r');
janet_buffer_push_cstring(&b, gbl_prompt);
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
/* Erase to right */
janet_buffer_push_cstring(&b, "\x1b[0K");
/* Move cursor to original position. */
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
janet_buffer_push_cstring(&b, seq);
if (write(STDOUT_FILENO, b.data, b.count) == -1) {
exit(1);
}
janet_buffer_deinit(&b);
}
static void clearlines(void) {
for (int i = 0; i < gbl_lines_below; i++) {
fprintf(stderr, "\x1b[1B\x1b[999D\x1b[K");
}
if (gbl_lines_below) {
fprintf(stderr, "\x1b[%dA\x1b[999D", gbl_lines_below);
fflush(stderr);
gbl_lines_below = 0;
}
}
static int insert(char c, int draw) {
if (gbl_len < JANET_LINE_MAX - 1) {
if (gbl_len == gbl_pos) {
gbl_buf[gbl_pos++] = c;
gbl_buf[++gbl_len] = '\0';
if (draw) {
if (gbl_plen + gbl_len < gbl_cols) {
/* Avoid a full update of the line in the
* trivial case. */
if (write(STDOUT_FILENO, &c, 1) == -1) return -1;
} else {
refresh();
}
}
} else {
memmove(gbl_buf + gbl_pos + 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
gbl_buf[gbl_pos++] = c;
gbl_buf[++gbl_len] = '\0';
if (draw) refresh();
}
}
return 0;
}
static void historymove(int delta) {
if (gbl_history_count > 1) {
free(gbl_history[gbl_historyi]);
gbl_history[gbl_historyi] = sdup(gbl_buf);
gbl_historyi += delta;
if (gbl_historyi < 0) {
gbl_historyi = 0;
} else if (gbl_historyi >= gbl_history_count) {
gbl_historyi = gbl_history_count - 1;
}
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
gbl_pos = gbl_len = strlen(gbl_buf);
gbl_buf[gbl_len] = '\0';
refresh();
}
}
static void addhistory(void) {
int i, len;
char *newline = sdup(gbl_buf);
if (!newline) return;
len = gbl_history_count;
if (len < JANET_HISTORY_MAX) {
gbl_history[gbl_history_count++] = newline;
len++;
} else {
free(gbl_history[JANET_HISTORY_MAX - 1]);
}
for (i = len - 1; i > 0; i--) {
gbl_history[i] = gbl_history[i - 1];
}
gbl_history[0] = newline;
}
static void replacehistory(void) {
/* History count is always > 0 here */
if (gbl_len == 0 || (gbl_history_count > 1 && !strcmp(gbl_buf, gbl_history[1]))) {
/* Delete history */
free(gbl_history[0]);
for (int i = 1; i < gbl_history_count; i++) {
gbl_history[i - 1] = gbl_history[i];
}
gbl_history_count--;
} else {
char *newline = sdup(gbl_buf);
if (!newline) return;
free(gbl_history[0]);
gbl_history[0] = newline;
}
}
static void kleft(void) {
if (gbl_pos > 0) {
gbl_pos--;
refresh();
}
}
static void kleftw(void) {
while (gbl_pos > 0 && isspace(gbl_buf[gbl_pos - 1])) {
gbl_pos--;
}
while (gbl_pos > 0 && !isspace(gbl_buf[gbl_pos - 1])) {
gbl_pos--;
}
refresh();
}
static void kright(void) {
if (gbl_pos != gbl_len) {
gbl_pos++;
refresh();
}
}
static void krightw(void) {
while (gbl_pos != gbl_len && !isspace(gbl_buf[gbl_pos])) {
gbl_pos++;
}
while (gbl_pos != gbl_len && isspace(gbl_buf[gbl_pos])) {
gbl_pos++;
}
refresh();
}
static void kbackspace(int draw) {
if (gbl_pos > 0) {
memmove(gbl_buf + gbl_pos - 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
gbl_pos--;
gbl_buf[--gbl_len] = '\0';
if (draw) refresh();
}
}
static void kdelete(int draw) {
if (gbl_pos != gbl_len) {
memmove(gbl_buf + gbl_pos, gbl_buf + gbl_pos + 1, gbl_len - gbl_pos);
gbl_buf[--gbl_len] = '\0';
if (draw) refresh();
}
}
static void kbackspacew(void) {
while (gbl_pos && isspace(gbl_buf[gbl_pos - 1])) {
kbackspace(0);
}
while (gbl_pos && !isspace(gbl_buf[gbl_pos - 1])) {
kbackspace(0);
}
refresh();
}
static void kdeletew(void) {
while (gbl_pos < gbl_len && isspace(gbl_buf[gbl_pos])) {
kdelete(0);
}
while (gbl_pos < gbl_len && !isspace(gbl_buf[gbl_pos])) {
kdelete(0);
}
refresh();
}
/* See tools/symchargen.c */
static int is_symbol_char_gen(uint8_t c) {
if (c & 0x80) return 1;
if (c >= 'a' && c <= 'z') return 1;
if (c >= 'A' && c <= 'Z') return 1;
if (c >= '0' && c <= '9') return 1;
return (c == '!' ||
c == '$' ||
c == '%' ||
c == '&' ||
c == '*' ||
c == '+' ||
c == '-' ||
c == '.' ||
c == '/' ||
c == ':' ||
c == '<' ||
c == '?' ||
c == '=' ||
c == '>' ||
c == '@' ||
c == '^' ||
c == '_');
}
static JanetByteView get_symprefix(void) {
/* Calculate current partial symbol. Maybe we could actually hook up the Janet
* parser here...*/
int i;
JanetByteView ret;
ret.len = 0;
for (i = gbl_pos - 1; i >= 0; i--) {
uint8_t c = (uint8_t) gbl_buf[i];
if (!is_symbol_char_gen(c)) break;
ret.len++;
}
/* Will be const for duration of match checking */
ret.bytes = (const uint8_t *)(gbl_buf + i + 1);
return ret;
}
static int compare_bytes(JanetByteView a, JanetByteView b) {
int32_t minlen = a.len < b.len ? a.len : b.len;
int result = strncmp((const char *) a.bytes, (const char *) b.bytes, minlen);
if (result) return result;
return a.len < b.len ? -1 : a.len > b.len ? 1 : 0;
}
static void check_match(JanetByteView src, const uint8_t *testsym, int32_t testlen) {
JanetByteView test;
test.bytes = testsym;
test.len = testlen;
if (src.len > test.len || strncmp((const char *) src.bytes, (const char *) test.bytes, src.len)) return;
JanetByteView mm = test;
for (int i = 0; i < gbl_match_count; i++) {
if (compare_bytes(mm, gbl_matches[i]) < 0) {
JanetByteView temp = mm;
mm = gbl_matches[i];
gbl_matches[i] = temp;
}
}
if (gbl_match_count == JANET_MATCH_MAX) return;
gbl_matches[gbl_match_count++] = mm;
}
static void check_cmatch(JanetByteView src, const char *cstr) {
check_match(src, (const uint8_t *) cstr, (int32_t) strlen(cstr));
}
static JanetByteView longest_common_prefix(void) {
JanetByteView bv;
if (gbl_match_count == 0) {
bv.len = 0;
bv.bytes = NULL;
} else {
bv = gbl_matches[0];
for (int i = 0; i < gbl_match_count; i++) {
JanetByteView other = gbl_matches[i];
int32_t minlen = other.len < bv.len ? other.len : bv.len;
for (bv.len = 0; bv.len < minlen; bv.len++) {
if (bv.bytes[bv.len] != other.bytes[bv.len]) {
break;
}
}
}
}
return bv;
}
static void check_specials(JanetByteView src) {
check_cmatch(src, "break");
check_cmatch(src, "def");
check_cmatch(src, "do");
check_cmatch(src, "fn");
check_cmatch(src, "if");
check_cmatch(src, "quasiquote");
check_cmatch(src, "quote");
check_cmatch(src, "set");
check_cmatch(src, "splice");
check_cmatch(src, "unquote");
check_cmatch(src, "var");
check_cmatch(src, "while");
}
static void kshowcomp(void) {
JanetTable *env = gbl_complete_env;
if (env == NULL) {
insert(' ', 0);
insert(' ', 0);
return;
}
/* Advance while on symbol char */
while (is_symbol_char_gen(gbl_buf[gbl_pos]))
gbl_pos++;
JanetByteView prefix = get_symprefix();
if (prefix.len == 0) return;
/* Find all matches */
gbl_match_count = 0;
while (NULL != env) {
JanetKV *kvend = env->data + env->capacity;
for (JanetKV *kv = env->data; kv < kvend; kv++) {
if (!janet_checktype(kv->key, JANET_SYMBOL)) continue;
const uint8_t *sym = janet_unwrap_symbol(kv->key);
check_match(prefix, sym, janet_string_length(sym));
}
env = env->proto;
}
check_specials(prefix);
JanetByteView lcp = longest_common_prefix();
for (int i = prefix.len; i < lcp.len; i++) {
insert(lcp.bytes[i], 0);
}
if (!gbl_lines_below && prefix.len != lcp.len) return;
int32_t maxlen = 0;
for (int i = 0; i < gbl_match_count; i++)
if (gbl_matches[i].len > maxlen)
maxlen = gbl_matches[i].len;
int num_cols = getcols();
clearlines();
if (gbl_match_count >= 2) {
/* Second pass, print */
int col_width = maxlen + 4;
int cols = num_cols / col_width;
if (cols == 0) cols = 1;
int current_col = 0;
for (int i = 0; i < gbl_match_count; i++) {
if (current_col == 0) {
putc('\n', stderr);
gbl_lines_below++;
}
JanetByteView s = gbl_matches[i];
fprintf(stderr, "%s", (const char *) s.bytes);
for (int j = s.len; j < col_width; j++) {
putc(' ', stderr);
}
current_col = (current_col + 1) % cols;
}
/* Go up to original line (zsh-like autocompletion) */
fprintf(stderr, "\x1B[%dA", gbl_lines_below);
fflush(stderr);
}
}
static int line() {
gbl_cols = getcols();
gbl_plen = 0;
gbl_len = 0;
gbl_pos = 0;
while (gbl_prompt[gbl_plen]) gbl_plen++;
gbl_buf[0] = '\0';
addhistory();
if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
for (;;) {
char c;
char seq[3];
if (read(STDIN_FILENO, &c, 1) <= 0) return -1;
switch (c) {
default:
if (c < 0x20) break;
if (insert(c, 1)) return -1;
break;
case 1: /* ctrl-a */
gbl_pos = 0;
refresh();
break;
case 2: /* ctrl-b */
kleft();
break;
case 3: /* ctrl-c */
errno = EAGAIN;
gbl_sigint_flag = 1;
clearlines();
return -1;
case 4: /* ctrl-d, eof */
clearlines();
return -1;
case 5: /* ctrl-e */
gbl_pos = gbl_len;
refresh();
break;
case 6: /* ctrl-f */
kright();
break;
case 127: /* backspace */
case 8: /* ctrl-h */
kbackspace(1);
break;
case 9: /* tab */
kshowcomp();
refresh();
break;
case 11: /* ctrl-k */
gbl_buf[gbl_pos] = '\0';
gbl_len = gbl_pos;
refresh();
break;
case 12: /* ctrl-l */
clear();
refresh();
break;
case 13: /* enter */
clearlines();
return 0;
case 14: /* ctrl-n */
historymove(-1);
break;
case 16: /* ctrl-p */
historymove(1);
break;
case 21: { /* ctrl-u */
memmove(gbl_buf, gbl_buf + gbl_pos, gbl_len - gbl_pos);
gbl_len -= gbl_pos;
gbl_buf[gbl_len] = '\0';
gbl_pos = 0;
refresh();
break;
}
case 23: /* ctrl-w */
kbackspacew();
break;
case 26: /* ctrl-z */
norawmode();
kill(getpid(), SIGSTOP);
rawmode();
refresh();
break;
case 27: /* escape sequence */
/* Read the next two bytes representing the escape sequence.
* Use two calls to handle slow terminals returning the two
* chars at different times. */
if (read(STDIN_FILENO, seq, 1) == -1) break;
/* Esc[ = Control Sequence Introducer (CSI) */
if (seq[0] == '[') {
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
if (seq[1] >= '0' && seq[1] <= '9') {
/* Extended escape, read additional byte. */
if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
if (seq[2] == '~') {
switch (seq[1]) {
case '1': /* Home */
gbl_pos = 0;
refresh();
break;
case '3': /* delete */
kdelete(1);
break;
case '4': /* End */
gbl_pos = gbl_len;
refresh();
break;
default:
break;
}
}
} else if (seq[0] == 'O') {
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
switch (seq[1]) {
default:
break;
case 'H': /* Home (some keyboards) */
gbl_pos = 0;
refresh();
break;
case 'F': /* End (some keyboards) */
gbl_pos = gbl_len;
refresh();
break;
}
} else {
switch (seq[1]) {
/* Single escape sequences */
default:
break;
case 'A': /* Up */
historymove(1);
break;
case 'B': /* Down */
historymove(-1);
break;
case 'C': /* Right */
kright();
break;
case 'D': /* Left */
kleft();
break;
case 'H': /* Home */
gbl_pos = 0;
refresh();
break;
case 'F': /* End */
gbl_pos = gbl_len;
refresh();
break;
}
}
} else {
/* Check alt-(shift) bindings */
switch (seq[0]) {
default:
break;
case 'd': /* Alt-d */
kdeletew();
break;
case 'b': /* Alt-b */
kleftw();
break;
case 'f': /* Alt-f */
krightw();
break;
case ',': /* Alt-, */
historymove(JANET_HISTORY_MAX);
break;
case '.': /* Alt-. */
historymove(-JANET_HISTORY_MAX);
break;
}
}
break;
}
}
return 0;
}
void janet_line_init() {
;
}
void janet_line_deinit() {
int i;
norawmode();
for (i = 0; i < gbl_history_count; i++)
free(gbl_history[i]);
gbl_historyi = 0;
}
static int checktermsupport() {
const char *t = getenv("TERM");
int i;
if (!t) return 1;
for (i = 0; badterms[i]; i++)
if (!strcmp(t, badterms[i])) return 0;
return 1;
}
void janet_line_get(const char *p, JanetBuffer *buffer) {
gbl_prompt = p;
buffer->count = 0;
gbl_historyi = 0;
FILE *out = janet_dynfile("err", stderr);
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
simpleline(buffer);
return;
}
if (rawmode()) {
simpleline(buffer);
return;
}
if (line()) {
norawmode();
if (gbl_sigint_flag) {
raise(SIGINT);
} else {
fputc('\n', out);
}
return;
}
fflush(stdin);
norawmode();
fputc('\n', out);
janet_buffer_ensure(buffer, gbl_len + 1, 2);
memcpy(buffer->data, gbl_buf, gbl_len);
buffer->data[gbl_len] = '\n';
buffer->count = gbl_len + 1;
replacehistory();
}
#endif
/*
* Entry
*/
int main(int argc, char **argv) {
int i, status;
JanetArray *args;
JanetTable *env;
#ifdef _WIN32
/* Enable color console on windows 10 console and utf8 output. */
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
DWORD dwMode = 0;
GetConsoleMode(hOut, &dwMode);
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
SetConsoleMode(hOut, dwMode);
SetConsoleOutputCP(65001);
#endif
/* Set up VM */
janet_init();
/* Replace original getline with new line getter */
JanetTable *replacements = janet_table(0);
janet_table_put(replacements, janet_csymbolv("getline"), janet_wrap_cfunction(janet_line_getter));
janet_line_init();
/* Get core env */
env = janet_core_env(replacements);
/* Create args tuple */
args = janet_array(argc);
for (i = 1; i < argc; i++)
janet_array_push(args, janet_cstringv(argv[i]));
/* Save current executable path to (dyn :executable) */
janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
/* Run startup script */
Janet mainfun, out;
janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
Janet mainargs[1] = { janet_wrap_array(args) };
JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
fiber->env = env;
status = janet_continue(fiber, janet_wrap_nil(), &out);
if (status != JANET_SIGNAL_OK) {
janet_stacktrace(fiber, out);
}
/* Deinitialize vm */
janet_deinit();
janet_line_deinit();
return status;
}

View File

@@ -1,126 +0,0 @@
/*
* 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
* 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.
*/
#include <janet.h>
#include <emscripten.h>
extern const unsigned char *janet_gen_webinit;
extern int32_t janet_gen_webinit_size;
static JanetFiber *repl_fiber = NULL;
static JanetBuffer *line_buffer = NULL;
static const uint8_t *line_prompt = NULL;
/* Yield to JS event loop from janet. Takes a repl prompt
* and a buffer to fill with input data. */
static Janet repl_yield(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
line_prompt = janet_getstring(argv, 0);
line_buffer = janet_getbuffer(argv, 1);
return janet_wrap_nil();
}
/* Re-enter the loop */
static int enter_loop(void) {
Janet ret;
JanetSignal status = janet_continue(repl_fiber, janet_wrap_nil(), &ret);
if (status == JANET_SIGNAL_ERROR) {
janet_stacktrace(repl_fiber, ret);
janet_deinit();
repl_fiber = NULL;
return 1;
}
return 0;
}
/* Allow JS interoperation from within janet */
static Janet cfun_js(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetByteView bytes = janet_getbytes(argv, 0);
emscripten_run_script((const char *)bytes.bytes);
return janet_wrap_nil();
}
/* Initialize the repl */
EMSCRIPTEN_KEEPALIVE
void repl_init(void) {
int status;
JanetTable *env;
/* Set up VM */
janet_init();
janet_register("repl-yield", repl_yield);
janet_register("js", cfun_js);
env = janet_core_env(NULL);
janet_def(env, "repl-yield", janet_wrap_cfunction(repl_yield), NULL);
janet_def(env, "js", janet_wrap_cfunction(cfun_js), NULL);
/* Run startup script */
Janet ret;
status = janet_dobytes(env, janet_gen_webinit, janet_gen_webinit_size, "webinit.janet", &ret);
if (status == JANET_SIGNAL_ERROR) {
printf("start up error.\n");
janet_deinit();
repl_fiber = NULL;
return;
}
janet_gcroot(ret);
repl_fiber = janet_unwrap_fiber(ret);
/* Start repl */
if (enter_loop()) return;
}
/* Deinitialize the repl */
EMSCRIPTEN_KEEPALIVE
void repl_deinit(void) {
if (!repl_fiber) {
return;
}
repl_fiber = NULL;
line_buffer = NULL;
janet_deinit();
}
/* Get the prompt to show in the repl */
EMSCRIPTEN_KEEPALIVE
const char *repl_prompt(void) {
return line_prompt ? ((const char *)line_prompt) : "";
}
/* Restart the repl calling from JS. Pass in the input for the next line. */
EMSCRIPTEN_KEEPALIVE
void repl_input(char *input) {
/* Create the repl if we haven't yet */
if (!repl_fiber) {
printf("initialize the repl first");
}
/* Now fill the pending line_buffer and resume the repl loop */
if (line_buffer) {
janet_buffer_push_cstring(line_buffer, input);
line_buffer = NULL;
enter_loop();
}
}

View File

@@ -1,12 +0,0 @@
# Copyright 2017-2019 (C) Calvin Rose
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
(fiber/new (fn webrepl []
(setdyn :pretty-format "%.20P")
(repl (fn get-line [buf p]
(def [offset] (parser/where p))
(def prompt (string "janet:" offset ":" (parser/state p :delimiters) "> "))
(repl-yield prompt buf)
(yield)
buf))))

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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

View File

@@ -4,22 +4,25 @@
(var num-tests-run 0)
(var suite-num 0)
(var numchecks 0)
(var start-time 0)
(defn assert [x e]
(++ num-tests-run)
(when x (++ num-tests-passed))
(if x
(do
(when (= numchecks 25)
(set numchecks 0)
(print))
(++ numchecks)
(file/write stdout "\e[32m✔\e[0m"))
(do
(file/write stdout "\n\e[31m✘\e[0m ")
(set numchecks 0)
(print e)))
x)
(defn assert
"Override's the default assert with some nice error handling."
[x e]
(++ num-tests-run)
(when x (++ num-tests-passed))
(if x
(do
(when (= numchecks 25)
(set numchecks 0)
(print))
(++ numchecks)
(file/write stdout "\e[32m✔\e[0m"))
(do
(file/write stdout "\n\e[31m✘\e[0m ")
(set numchecks 0)
(print e)))
x)
(defmacro assert-error
[msg & forms]
@@ -32,10 +35,12 @@
~(assert (not= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
(defn start-suite [x]
(set suite-num x)
(print "\nRunning test suite " x " tests...\n "))
(set suite-num x)
(set start-time (os/clock))
(print "\nRunning test suite " x " tests...\n "))
(defn end-suite []
(print "\n\nTest suite " suite-num " finished.")
(print num-tests-passed " of " num-tests-run " tests passed.\n")
(if (not= num-tests-passed num-tests-run) (os/exit 1)))
(def delta (- (os/clock) start-time))
(printf "\n\nTest suite %d finished in %.3f seconds" suite-num delta)
(print num-tests-passed " of " num-tests-run " tests passed.\n")
(if (not= num-tests-passed num-tests-run) (os/exit 1)))

View File

@@ -5,6 +5,10 @@
:name "testmod"
:source @["testmod.c"])
(declare-native
:name "testmod2"
:source @["testmod2.c"])
(declare-executable
:name "testexec"
:entry "testexec.janet")

View File

@@ -1,5 +1,6 @@
(use build/testmod)
(use build/testmod2)
(defn main [&]
(print "Hello from executable!")
(print (get5)))
(print (+ (get5) (get6))))

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose and contributors
* Copyright (c) 2020 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

40
test/install/testmod2.c Normal file
View File

@@ -0,0 +1,40 @@
/*
* Copyright (c) 2020 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.
*/
/* A very simple native module */
#include <janet.h>
static Janet cfun_get_six(int32_t argc, Janet *argv) {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_number(6.0);
}
static const JanetReg array_cfuns[] = {
{"get6", cfun_get_six, NULL},
{NULL, NULL, NULL}
};
JANET_MODULE_ENTRY(JanetTable *env) {
janet_cfuns(env, NULL, array_cfuns);
}

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2019 Calvin Rose
# Copyright (c) 2020 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
@@ -37,18 +37,18 @@
(assert (= 7 (% 20 13)) "modulo 1")
(assert (= -7 (% -20 13)) "modulo 2")
(assert (order< 1.0 nil false true
(fiber/new (fn [] 1))
"hi"
(quote hello)
:hello
(array 1 2 3)
(tuple 1 2 3)
(table "a" "b" "c" "d")
(struct 1 2 3 4)
(buffer "hi")
(fn [x] (+ x x))
print) "type ordering")
(assert (< 1.0 nil false true
(fiber/new (fn [] 1))
"hi"
(quote hello)
:hello
(array 1 2 3)
(tuple 1 2 3)
(table "a" "b" "c" "d")
(struct 1 2 3 4)
(buffer "hi")
(fn [x] (+ x x))
print) "type ordering")
(assert (= (string (buffer "123" "456")) (string @"123456")) "buffer literal")
(assert (= (get {} 1) nil) "get nil from empty struct")

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2019 Calvin Rose
# Copyright (c) 2020 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
@@ -232,11 +232,11 @@
(assert (= 4 ((get closures 4))) "closure in loop 4")
# More numerical tests
(assert (== 1 1.0) "numerical equal 1")
(assert (== 0 0.0) "numerical equal 2")
(assert (== 0 -0.0) "numerical equal 3")
(assert (== 2_147_483_647 2_147_483_647.0) "numerical equal 4")
(assert (== -2_147_483_648 -2_147_483_648.0) "numerical equal 5")
(assert (= 1 1.0) "numerical equal 1")
(assert (= 0 0.0) "numerical equal 2")
(assert (= 0 -0.0) "numerical equal 3")
(assert (= 2_147_483_647 2_147_483_647.0) "numerical equal 4")
(assert (= -2_147_483_648 -2_147_483_648.0) "numerical equal 5")
# Array tests

View File

@@ -1,4 +1,4 @@
#' Copyright (c) 2019 Calvin Rose
#' Copyright (c) 2020 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

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2019 Calvin Rose
# Copyright (c) 2020 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
@@ -203,12 +203,12 @@
(defn check-match
[pat text should-match]
(def result (peg/match pat text))
(assert (= (not should-match) (not result)) text))
(assert (= (not should-match) (not result)) (string "check-match " text)))
(defn check-deep
[pat text what]
(def result (peg/match pat text))
(assert (deep= result what) text))
(assert (deep= result what) (string "check-deep " text)))
# Just numbers

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2019 Calvin Rose
# Copyright (c) 2020 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

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2019 Calvin Rose & contributors
# Copyright (c) 2020 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

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2019 Calvin Rose & contributors
# Copyright (c) 2020 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
@@ -62,8 +62,8 @@
# just to big
(def d (u64 "123456789123456789123456789"))))
(assert (:== (:/ (u64 "0xffff_ffff_ffff_ffff") 8 2) "0xfffffffffffffff") "bigint operations")
(assert (let [a (u64 0xff)] (:== (:+ a a a a) (:* a 2 2))) "bigint operations")
(assert (= (:/ (u64 "0xffff_ffff_ffff_ffff") 8 2) (u64 "0xfffffffffffffff")) "bigint operations 1")
(assert (let [a (u64 0xff)] (= (:+ a a a a) (:* a 2 2))) "bigint operations 2")
(assert (= (string (i64 -123)) "-123") "i64 prints reasonably")
(assert (= (string (u64 123)) "123") "u64 prints reasonably")
@@ -72,9 +72,6 @@
"trap INT64_MIN / -1"
(:/ (int/s64 "-0x8000_0000_0000_0000") -1))
# in place operators
(assert (let [a (u64 1e10)] (:+! a 1000000 "1000000" "0xffff") (:== a 10002065535)) "in place operators")
# int64 typed arrays
(assert (let [t (tarray/new :int64 10)
b (i64 1000)]
@@ -84,10 +81,10 @@
(set (t 3) (t 0))
(set (t 4) (u64 1000))
(and
(:== (t 0) (t 1))
(:== (t 1) (t 2))
(:== (t 2) (t 3))
(:== (t 3) (t 4))
(= (t 0) (t 1))
(= (t 1) (t 2))
(= (t 2) (t 3))
(= (t 3) (t 4))
))
"int64 typed arrays")
@@ -167,6 +164,11 @@
(defn test-expand [path temp]
(string (module/expand-path path temp)))
# Right hand operators
(assert (= (int/s64 (sum (range 10))) (sum (map int/s64 (range 10)))) "right hand operators 1")
(assert (= (int/s64 (product (range 1 10))) (product (map int/s64 (range 1 10)))) "right hand operators 2")
(assert (= (int/s64 15) (bor 10 (int/s64 5)) (bor (int/s64 10) 5)) "right hand operators 3")
(assert (= (test-expand "abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 1")
(assert (= (test-expand "./abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 2")
(assert (= (test-expand "abc/def.txt" ":cur:/:name:") "some-dir/def.txt") "module/expand-path 3")

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2019 Calvin Rose & contributors
# Copyright (c) 2020 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
@@ -277,4 +277,26 @@
(assert (= (constantly) (constantly)) "comptime 1")
(assert-error "arity issue in macro" (eval '(each [])))
(assert-error "comptime issue" (eval '(comptime (error "oops"))))
(with [f (file/temp)]
(file/write f "foo\n")
(file/flush f)
(file/seek f :set 0)
(assert (= (string (file/read f :all)) "foo\n") "temp files work"))
(var counter 0)
(when-with [x nil |$]
(++ counter))
(when-with [x 10 |$]
(+= counter 10))
(assert (= 10 counter) "when-with 1")
(if-with [x nil |$] (++ counter) (+= counter 10))
(if-with [x true |$] (+= counter 20) (+= counter 30))
(assert (= 40 counter) "if-with 1")
(end-suite)

BIN
tools/EnVar.dll Normal file

Binary file not shown.

View File

@@ -1,327 +0,0 @@
/**
* EnvVarUpdate.nsh
* : Environmental Variables: append, prepend, and remove entries
*
* WARNING: If you use StrFunc.nsh header then include it before this file
* with all required definitions. This is to avoid conflicts
*
* Usage:
* ${EnvVarUpdate} "ResultVar" "EnvVarName" "Action" "RegLoc" "PathString"
*
* Credits:
* Version 1.0
* * Cal Turney (turnec2)
* * Amir Szekely (KiCHiK) and e-circ for developing the forerunners of this
* function: AddToPath, un.RemoveFromPath, AddToEnvVar, un.RemoveFromEnvVar,
* WriteEnvStr, and un.DeleteEnvStr
* * Diego Pedroso (deguix) for StrTok
* * Kevin English (kenglish_hi) for StrContains
* * Hendri Adriaens (Smile2Me), Diego Pedroso (deguix), and Dan Fuhry
* (dandaman32) for StrReplace
*
* Version 1.1 (compatibility with StrFunc.nsh)
* * techtonik
*
* http://nsis.sourceforge.net/Environmental_Variables:_append%2C_prepend%2C_and_remove_entries
*
*/
!ifndef ENVVARUPDATE_FUNCTION
!define ENVVARUPDATE_FUNCTION
!verbose push
!verbose 3
!include "LogicLib.nsh"
!include "WinMessages.NSH"
!include "StrFunc.nsh"
; ---- Fix for conflict if StrFunc.nsh is already includes in main file -----------------------
!macro _IncludeStrFunction StrFuncName
!ifndef ${StrFuncName}_INCLUDED
${${StrFuncName}}
!endif
!ifndef Un${StrFuncName}_INCLUDED
${Un${StrFuncName}}
!endif
!define un.${StrFuncName} "${Un${StrFuncName}}"
!macroend
!insertmacro _IncludeStrFunction StrTok
!insertmacro _IncludeStrFunction StrStr
!insertmacro _IncludeStrFunction StrRep
; ---------------------------------- Macro Definitions ----------------------------------------
!macro _EnvVarUpdateConstructor ResultVar EnvVarName Action Regloc PathString
Push "${EnvVarName}"
Push "${Action}"
Push "${RegLoc}"
Push "${PathString}"
Call EnvVarUpdate
Pop "${ResultVar}"
!macroend
!define EnvVarUpdate '!insertmacro "_EnvVarUpdateConstructor"'
!macro _unEnvVarUpdateConstructor ResultVar EnvVarName Action Regloc PathString
Push "${EnvVarName}"
Push "${Action}"
Push "${RegLoc}"
Push "${PathString}"
Call un.EnvVarUpdate
Pop "${ResultVar}"
!macroend
!define un.EnvVarUpdate '!insertmacro "_unEnvVarUpdateConstructor"'
; ---------------------------------- Macro Definitions end-------------------------------------
;----------------------------------- EnvVarUpdate start----------------------------------------
!define hklm_all_users 'HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment"'
!define hkcu_current_user 'HKCU "Environment"'
!macro EnvVarUpdate UN
Function ${UN}EnvVarUpdate
Push $0
Exch 4
Exch $1
Exch 3
Exch $2
Exch 2
Exch $3
Exch
Exch $4
Push $5
Push $6
Push $7
Push $8
Push $9
Push $R0
/* After this point:
-------------------------
$0 = ResultVar (returned)
$1 = EnvVarName (input)
$2 = Action (input)
$3 = RegLoc (input)
$4 = PathString (input)
$5 = Orig EnvVar (read from registry)
$6 = Len of $0 (temp)
$7 = tempstr1 (temp)
$8 = Entry counter (temp)
$9 = tempstr2 (temp)
$R0 = tempChar (temp) */
; Step 1: Read contents of EnvVarName from RegLoc
;
; Check for empty EnvVarName
${If} $1 == ""
SetErrors
DetailPrint "ERROR: EnvVarName is blank"
Goto EnvVarUpdate_Restore_Vars
${EndIf}
; Check for valid Action
${If} $2 != "A"
${AndIf} $2 != "P"
${AndIf} $2 != "R"
SetErrors
DetailPrint "ERROR: Invalid Action - must be A, P, or R"
Goto EnvVarUpdate_Restore_Vars
${EndIf}
${If} $3 == HKLM
ReadRegStr $5 ${hklm_all_users} $1 ; Get EnvVarName from all users into $5
${ElseIf} $3 == HKCU
ReadRegStr $5 ${hkcu_current_user} $1 ; Read EnvVarName from current user into $5
${Else}
SetErrors
DetailPrint 'ERROR: Action is [$3] but must be "HKLM" or HKCU"'
Goto EnvVarUpdate_Restore_Vars
${EndIf}
; Check for empty PathString
${If} $4 == ""
SetErrors
DetailPrint "ERROR: PathString is blank"
Goto EnvVarUpdate_Restore_Vars
${EndIf}
; Make sure we've got some work to do
${If} $5 == ""
${AndIf} $2 == "R"
SetErrors
DetailPrint "$1 is empty - Nothing to remove"
Goto EnvVarUpdate_Restore_Vars
${EndIf}
; Step 2: Scrub EnvVar
;
StrCpy $0 $5 ; Copy the contents to $0
; Remove spaces around semicolons (NOTE: spaces before the 1st entry or
; after the last one are not removed here but instead in Step 3)
${If} $0 != "" ; If EnvVar is not empty ...
${Do}
${${UN}StrStr} $7 $0 " ;"
${If} $7 == ""
${ExitDo}
${EndIf}
${${UN}StrRep} $0 $0 " ;" ";" ; Remove '<space>;'
${Loop}
${Do}
${${UN}StrStr} $7 $0 "; "
${If} $7 == ""
${ExitDo}
${EndIf}
${${UN}StrRep} $0 $0 "; " ";" ; Remove ';<space>'
${Loop}
${Do}
${${UN}StrStr} $7 $0 ";;"
${If} $7 == ""
${ExitDo}
${EndIf}
${${UN}StrRep} $0 $0 ";;" ";"
${Loop}
; Remove a leading or trailing semicolon from EnvVar
StrCpy $7 $0 1 0
${If} $7 == ";"
StrCpy $0 $0 "" 1 ; Change ';<EnvVar>' to '<EnvVar>'
${EndIf}
StrLen $6 $0
IntOp $6 $6 - 1
StrCpy $7 $0 1 $6
${If} $7 == ";"
StrCpy $0 $0 $6 ; Change ';<EnvVar>' to '<EnvVar>'
${EndIf}
; DetailPrint "Scrubbed $1: [$0]" ; Uncomment to debug
${EndIf}
/* Step 3. Remove all instances of the target path/string (even if "A" or "P")
$6 = bool flag (1 = found and removed PathString)
$7 = a string (e.g. path) delimited by semicolon(s)
$8 = entry counter starting at 0
$9 = copy of $0
$R0 = tempChar */
${If} $5 != "" ; If EnvVar is not empty ...
StrCpy $9 $0
StrCpy $0 ""
StrCpy $8 0
StrCpy $6 0
${Do}
${${UN}StrTok} $7 $9 ";" $8 "0" ; $7 = next entry, $8 = entry counter
${If} $7 == "" ; If we've run out of entries,
${ExitDo} ; were done
${EndIf} ;
; Remove leading and trailing spaces from this entry (critical step for Action=Remove)
${Do}
StrCpy $R0 $7 1
${If} $R0 != " "
${ExitDo}
${EndIf}
StrCpy $7 $7 "" 1 ; Remove leading space
${Loop}
${Do}
StrCpy $R0 $7 1 -1
${If} $R0 != " "
${ExitDo}
${EndIf}
StrCpy $7 $7 -1 ; Remove trailing space
${Loop}
${If} $7 == $4 ; If string matches, remove it by not appending it
StrCpy $6 1 ; Set 'found' flag
${ElseIf} $7 != $4 ; If string does NOT match
${AndIf} $0 == "" ; and the 1st string being added to $0,
StrCpy $0 $7 ; copy it to $0 without a prepended semicolon
${ElseIf} $7 != $4 ; If string does NOT match
${AndIf} $0 != "" ; and this is NOT the 1st string to be added to $0,
StrCpy $0 $0;$7 ; append path to $0 with a prepended semicolon
${EndIf} ;
IntOp $8 $8 + 1 ; Bump counter
${Loop} ; Check for duplicates until we run out of paths
${EndIf}
; Step 4: Perform the requested Action
;
${If} $2 != "R" ; If Append or Prepend
${If} $6 == 1 ; And if we found the target
DetailPrint "Target is already present in $1. It will be removed and"
${EndIf}
${If} $0 == "" ; If EnvVar is (now) empty
StrCpy $0 $4 ; just copy PathString to EnvVar
${If} $6 == 0 ; If found flag is either 0
${OrIf} $6 == "" ; or blank (if EnvVarName is empty)
DetailPrint "$1 was empty and has been updated with the target"
${EndIf}
${ElseIf} $2 == "A" ; If Append (and EnvVar is not empty),
StrCpy $0 $0;$4 ; append PathString
${If} $6 == 1
DetailPrint "appended to $1"
${Else}
DetailPrint "Target was appended to $1"
${EndIf}
${Else} ; If Prepend (and EnvVar is not empty),
StrCpy $0 $4;$0 ; prepend PathString
${If} $6 == 1
DetailPrint "prepended to $1"
${Else}
DetailPrint "Target was prepended to $1"
${EndIf}
${EndIf}
${Else} ; If Action = Remove
${If} $6 == 1 ; and we found the target
DetailPrint "Target was found and removed from $1"
${Else}
DetailPrint "Target was NOT found in $1 (nothing to remove)"
${EndIf}
${If} $0 == ""
DetailPrint "$1 is now empty"
${EndIf}
${EndIf}
; Step 5: Update the registry at RegLoc with the updated EnvVar and announce the change
;
ClearErrors
${If} $3 == HKLM
WriteRegExpandStr ${hklm_all_users} $1 $0 ; Write it in all users section
${ElseIf} $3 == HKCU
WriteRegExpandStr ${hkcu_current_user} $1 $0 ; Write it to current user section
${EndIf}
IfErrors 0 +4
MessageBox MB_OK|MB_ICONEXCLAMATION "Could not write updated $1 to $3"
DetailPrint "Could not write updated $1 to $3"
Goto EnvVarUpdate_Restore_Vars
; "Export" our change
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
EnvVarUpdate_Restore_Vars:
;
; Restore the user's variables and return ResultVar
Pop $R0
Pop $9
Pop $8
Pop $7
Pop $6
Pop $5
Pop $4
Pop $3
Pop $2
Pop $1
Push $0 ; Push my $0 (ResultVar)
Exch
Pop $0 ; Restore his $0
FunctionEnd
!macroend ; EnvVarUpdate UN
!insertmacro EnvVarUpdate ""
!insertmacro EnvVarUpdate "un."
;----------------------------------- EnvVarUpdate end----------------------------------------
!verbose pop
!endif

View File

@@ -5,6 +5,7 @@
(print "/* Generated from janet version " janet/version "-" janet/build " */")
(print "#define JANET_BUILD \"" janet/build "\"")
(print ```#define JANET_AMALG```)
(print ```#define _POSIX_C_SOURCE 200112L```)
(print ```#include "janet.h"```)
# Body

Binary file not shown.

Binary file not shown.

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2019 Calvin Rose
* Copyright (c) 2020 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

View File

@@ -1,104 +0,0 @@
/*
* 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
* 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.
*/
/* Simple clone of the xxd tool used at build time. Used to
* create headers out of source files. Only used for core libraries
* like the bootstrapping code and the stl. */
#include <stdlib.h>
#include <stdio.h>
#include <stdint.h>
#define BUFSIZE 1024
#define PERLINE 10
int main(int argc, const char **argv) {
static const char hex[] = "0123456789ABCDEF";
char buf[BUFSIZE];
size_t bytesRead = 0;
int32_t totalRead = 0;
int lineIndex = 0;
int line = 0;
if (argc != 4) {
fprintf(stderr, "Usage: %s infile outfile symbol\n", argv[0]);
return 1;
}
/* Open the files */
FILE *in = fopen(argv[1], "rb");
FILE *out = fopen(argv[2], "wb");
/* Check if files open successfully */
if (in == NULL) {
fprintf(stderr, "Could not open input file %s\n", argv[1]);
return 1;
} else if (out == NULL) {
fprintf(stderr, "Could not open output file %s\n", argv[2]);
return 1;
}
/* Write the header */
fprintf(out, "/* Auto generated - DO NOT EDIT */\n\n#include <stdint.h>\n\n");
fprintf(out, "static const unsigned char bytes_%s[] = {", argv[3]);
/* Read in chunks from buffer */
while ((bytesRead = fread(buf, 1, sizeof(buf), in)) > 0) {
size_t i;
totalRead += bytesRead;
for (i = 0; i < bytesRead; ++i) {
int byte = ((uint8_t *)buf) [i];
/* Write the byte */
if (lineIndex++ == 0) {
if (line++)
fputc(',', out);
fputs("\n ", out);
} else {
fputs(", ", out);
}
fputs("0x", out);
fputc(hex[byte >> 4], out);
fputc(hex[byte & 0xF], out);
/* Make line index wrap */
if (lineIndex >= PERLINE)
lineIndex = 0;
}
}
/* Write the tail */
fputs("\n};\n\n", out);
fprintf(out, "const unsigned char *%s = bytes_%s;\n\n", argv[3], argv[3]);
/* Write chunk size */
fprintf(out, "int32_t %s_size = %d;\n", argv[3], totalRead);
/* Close the file handles */
fclose(in);
fclose(out);
return 0;
}