1
0
mirror of https://github.com/janet-lang/janet synced 2026-04-06 06:51:26 +00:00

Compare commits

...

266 Commits

Author SHA1 Message Date
Calvin Rose
1579509a47 Add refreshenv. 2020-04-25 09:52:36 -05:00
Calvin Rose
d3da9e7a0d Try and address issues with appveyor hanging. 2020-04-25 09:43:46 -05:00
Calvin Rose
61edf22a45 Remove Unicode True
This seems like it might trigger mS defender based on an old bug.
Don't think we really need it, so I will remove it just in case.
2020-04-25 09:26:56 -05:00
Calvin Rose
84974d6c56 Make repl printing work from current environment.
Although this "unprotects" output in the repl, people
in a repl usually want control, not protection.
2020-04-24 22:29:02 -05:00
Calvin Rose
da438a93e0 Restore lexicographic comparison of tuples. 2020-04-24 16:51:04 -05:00
Calvin Rose
a87015598c Make janet_equals and janet_compare non recursive
This makes these operatios use constant stack space rather
than linear stackspace given the size of the inputs. This is important
to prevent certain parser input from causing a stack overflow - in
general, we try to avoid unbounded recursion.
2020-04-24 16:18:31 -05:00
Calvin Rose
c335bf5dc5 Update doc doc. 2020-04-23 12:15:12 -05:00
Calvin Rose
c6a782c0ce Add information on lockfiles to the man page. 2020-04-23 12:10:22 -05:00
Calvin Rose
d148e14aa2 Merge pull request #357 from andrewchambers/lockfilejdn
Lockfiles are jdn, not code.
2020-04-23 13:03:51 -04:00
Andrew Chambers
748a5d41c1 Lockfiles are jdn, not code. 2020-04-23 21:53:36 +12:00
Calvin Rose
c876e63010 Fix overflow in exponent estimation in strtod.c.
Found by OSS-Fuzz.
2020-04-21 18:32:59 -05:00
Calvin Rose
23b811243f Update CHANGELOG.md 2020-04-21 18:24:46 -05:00
Calvin Rose
99d9c57154 Add the --offline flag to jpm.
This will let jpm install things only from the cache, and not
try and sync the latest from git.
2020-04-21 12:41:08 -05:00
Calvin Rose
13559baecc Merge pull request #354 from andrewchambers/safeclean
Do not recurse into symlinks when cleaning.
2020-04-21 13:21:42 -04:00
Calvin Rose
481647ed5d Merge pull request #355 from sogaiu/fiber-new-err-msg
Add flags to fiber/new error message
2020-04-21 13:21:11 -04:00
sogaiu
5c162ce588 Add flags to fiber/new error message 2020-04-21 13:47:56 +01:00
Andrew Chambers
e1b6175efd Do not recurse into symlinks when cleaning. 2020-04-21 15:11:51 +12:00
Calvin Rose
ea46f096c2 Remove placeholder config variables. 2020-04-20 20:10:24 -05:00
Calvin Rose
da88dd8cfa Streamline tree printing code. 2020-04-20 19:50:32 -05:00
Calvin Rose
9b5c6112e5 The -q option no longer disables repl output. 2020-04-20 19:28:30 -05:00
Calvin Rose
ea1341a129 Show post-deps rules in rule tree. 2020-04-20 19:19:53 -05:00
Calvin Rose
343cb779d2 Remove extra os/mkdir. 2020-04-20 19:06:53 -05:00
Calvin Rose
b0af01a762 Remove ./build as default rule.
Instead, all compilation rules do the equivalent of
mkdir -p to make sure that we can build the output file.
2020-04-20 19:02:09 -05:00
Calvin Rose
d8617514f8 Add jpm rule-tree.
Useful for debugging jpm project.janet files.
This tree printing logic can also be reused for
showing dependency information in the future.
2020-04-20 18:32:25 -05:00
Calvin Rose
63812c9f80 Merge pull request #350 from DavidKorczynski/master
Updated the libfuzzer to target marshalling.
2020-04-19 18:56:51 -04:00
David Korczynski
676a0afe4c Fixed up very wrong fuzzer to go more for the parser. 2020-04-19 20:36:38 +01:00
Calvin Rose
12d21dcb85 Update CHANGELOG.md 2020-04-19 10:57:50 -05:00
Calvin Rose
5054eb4276 Add JANET_MARSH_UNSAFE flag.
This allows unmarshal to optional marshal raw
pointers and cfunctions and send them across threads.
This flag is only exposed in the C API as it is very easy
to misuse and cause segfaults.
2020-04-19 10:56:39 -05:00
Calvin Rose
122c77dbf6 Merge pull request #353 from andrewchambers/require
Fix outdated require docstring.
2020-04-19 10:44:37 -04:00
Calvin Rose
3c66cab4e7 Remove extra binding in require. 2020-04-19 09:44:02 -05:00
Calvin Rose
738fd479b3 Merge branch 'master' of github.com:janet-lang/janet 2020-04-19 09:41:49 -05:00
Calvin Rose
5c612095a1 Address #352, #351, Use :source argument in dofile
Also re-add circular dependency detection.
2020-04-19 09:38:18 -05:00
Andrew Chambers
2a7008a82c Fix outdated require docstring. 2020-04-19 23:02:35 +12:00
David Korczynski
82e052f2ec Updated the libfuzzer to target marshalling. 2020-04-18 22:04:26 +01:00
Calvin Rose
16fe0a301c Merge pull request #349 from sogaiu/tweak-unknown-signal-handling
Tweak unknown signal handling
2020-04-18 06:22:29 -05:00
sogaiu
aebb8010d4 Tweak unknown signal handling 2020-04-18 08:26:16 +01:00
Calvin Rose
e202d30835 Use make format. 2020-04-17 13:39:23 -05:00
Calvin Rose
fbe903b277 Add janet_cfuns_prefix to janet.h
Makes adding functions to the current environment easier.
2020-04-17 13:37:52 -05:00
Calvin Rose
8a89e50c13 :octal-permissions -> :int-permissions (#347) 2020-04-16 19:05:00 -05:00
Calvin Rose
6cb0e0dcea Merge branch 'master' of github.com:janet-lang/janet 2020-04-16 19:02:58 -05:00
Calvin Rose
a147ea3e80 Use JANET_PRETTY_DICT_LIMIT. 2020-04-16 19:01:49 -05:00
Calvin Rose
557988e530 Merge pull request #344 from DavidKorczynski/master
Added a fuzzer and integration with OSS-Fuzz.
2020-04-16 18:50:07 -05:00
Calvin Rose
67fb2c212f Address #348
Remove extreneous data from lockfile.
2020-04-16 18:44:21 -05:00
Calvin Rose
3765b08cca Merge branch 'master' of github.com:janet-lang/janet 2020-04-16 12:11:59 -05:00
Calvin Rose
3eb84fcb13 Fix some typos, make jpm repl work without a project.janet. 2020-04-16 12:11:17 -05:00
Calvin Rose
bea76e8e08 Merge pull request #345 from sogaiu/checks-after-allocs
Check some *alloc return values
2020-04-15 19:45:39 -05:00
Calvin Rose
f5433dcaa4 Fix core getline that doesn't use replacement. 2020-04-15 19:45:17 -05:00
Calvin Rose
ef3b953a42 Fix docstrings. 2020-04-14 21:32:50 -05:00
Calvin Rose
605a205008 Range errors for slice-likes include negatives.
Makes for less confusing errors when calling something
like `(slice [] 0 -10)`.
2020-04-14 21:27:48 -05:00
Calvin Rose
058f63b440 Add sh-rule and sh-phony to jpm dialect.
Provides useful shorthand for writing rules that invoke
shell commands.
2020-04-14 20:43:53 -05:00
Calvin Rose
71882475d6 janet_formatb -> janet_formatbv, new janet_formatb
The old function was not very useable. In the likely
case that there is no external code using this
(not well documented/janet_formatc is more convenient), we
can change this.
2020-04-14 07:38:41 -05:00
sogaiu
a3d29a15df Check some *alloc return values 2020-04-14 10:22:45 +01:00
Calvin Rose
a09112404d Add better error message on unexpected eos.
Show innermost open delimiter
2020-04-13 23:18:27 -05:00
Calvin Rose
93fc11ea21 Add edefer.
Also improve error messages from vm internal errors.
(Show bad value, not its type).
2020-04-13 20:24:11 -05:00
davkor
4faa129b8e Added a first fuzzer. 2020-04-13 17:33:58 +01:00
Calvin Rose
6c4ed0409d Add emscripten check to features.h. 2020-04-12 14:13:55 -05:00
Calvin Rose
ea2811f14f Merge branch 'master' of github.com:janet-lang/janet 2020-04-11 13:42:34 -05:00
Calvin Rose
8bc2987a71 (struct ...) with duped keys will use last value. 2020-04-11 13:42:25 -05:00
Calvin Rose
1d13095d19 Merge pull request #340 from pepe/get-vs-in-last
Fix last for empty collection, add tests
2020-04-10 19:03:21 -05:00
Calvin Rose
5ed76f197a Differentiate error from resume and error from resumed fiber. 2020-04-10 18:29:10 -05:00
Calvin Rose
e1f4cadf41 Add debugger to the core repl.
Debugger functions are prefixed by periods.
2020-04-10 17:20:23 -05:00
Calvin Rose
3b0e6357ad Make Ctrl-G in repl show docstring for symbol.
Can be used to browse docs without poluting your repl session.
2020-04-10 11:36:23 -05:00
Calvin Rose
02f17bd4e4 Add sort-by and sorted-by. 2020-04-09 20:43:51 -05:00
Josef Pospíšil
b63a0796fd Fix last for empty collection, add tests 2020-04-09 14:35:57 +02:00
Calvin Rose
e6d4e729fb Keep reference alive so unmarshalled object not collected. 2020-04-06 17:24:52 -05:00
Calvin Rose
b75a22b753 Make JANET_FRAME_SIZE consistent across architectures.
This means unmarshalling fibers should work across arches.
2020-04-06 12:41:56 -05:00
Calvin Rose
72beeeeaaa Move funcenv verification to runtime.
Lazy verification makes it easier to not leave funcenvs
in an invalid state, as well as be more precise with the validation.
We needed to verify the FuncEnvs actually pointed to a stack frame if
they were of the "on-stack" variant. There was some minor checking
before, but it was not enough to prevent func envs from pointing to
memory that was off of the fiber stack, overlapping stack frames, etc.
2020-04-06 10:58:47 -05:00
Calvin Rose
c3c42ef56f Fix case for #336.
Also consider ascii 127 (delete) non-printable for string escapes.
2020-04-06 00:11:22 -05:00
Calvin Rose
a3c55681b2 Address #336 case 6 2020-04-05 21:39:39 -05:00
Calvin Rose
cc70388846 Merge pull request #338 from andrewchambers/unmarshalfuzz2
Make unmarshal fuzzer exercise more code paths.
2020-04-05 20:36:30 -05:00
Calvin Rose
fcc610f539 Address #336 case 4
Set funcenv fields to NULL before any possible panics.
2020-04-05 19:18:59 -05:00
Calvin Rose
5bbd507858 Address #336 case 3
Fix error condition for bad abstract types - don't return NULL, panic.
2020-04-05 17:38:14 -05:00
Andrew Chambers
45156c0c47 Make unmarshal fuzzer exercise more code paths. 2020-04-06 09:59:00 +12:00
Calvin Rose
553e38ffd6 Merge pull request #337 from andrewchambers/fuzzunmarshal
Setup some simple fuzz helpers for unmarshal.
2020-04-05 08:17:42 -05:00
Calvin Rose
c4ca0490ee Prevent unmarsal DOS in arrays,buffers,tables,and structs. 2020-04-05 08:16:40 -05:00
Calvin Rose
b145d47863 Address cases 1 and 2 of #336.
Mainly related to not checking ints < 0.
2020-04-05 08:01:18 -05:00
Calvin Rose
095827a261 Update CHANGELOG.md 2020-04-05 07:12:00 -05:00
Calvin Rose
87ecdb8112 Change \UXXXXXXXX -> \UXXXXXX and check codepoint max.
No need to add two extra leading zeros, as the max unicode
codepoint is 0x10FFFF.
2020-04-05 07:09:53 -05:00
Andrew Chambers
98b2fa4d64 Setup some simple fuzz helpers for unmarshal. 2020-04-05 23:05:18 +12:00
Calvin Rose
810ef7401c Update changelog and bump version to dev version. 2020-04-04 21:50:27 -05:00
Calvin Rose
ae70a03383 Address #306 - Add unicode escapes.
Unicode escapes have the same syntax as go - \uXXXX or \UXXXXXXXX.
2020-04-04 21:46:08 -05:00
Calvin Rose
081d132538 Address #321
Also improve docs for dofile and related functions.
2020-04-04 21:17:15 -05:00
Calvin Rose
bb5c478704 Switch to two digit sonames.
Janet's versioning scheme is not 'true' semantic versioning.
Minor versions can have and often do have breaking changes.
Although such breakages are mostly avoided, only limited effort is
made to prevent this, and no system is in place to verify this.
Thus, stricter version pinning is needed.
2020-04-04 18:30:18 -05:00
Calvin Rose
ff6601f29e Add version and soversion to meson libjanet. 2020-04-04 18:04:22 -05:00
Calvin Rose
320c6c6f05 Increase NSIS installer verbosity. 2020-04-04 13:58:27 -05:00
Calvin Rose
6b89da4bb2 Use -Wl,-install_name,... on macos. 2020-04-04 13:44:21 -05:00
Calvin Rose
5b82b9e101 Address compiler warning on macos. 2020-04-04 13:34:16 -05:00
Calvin Rose
1d0e862129 Update Makefile for pkg-config issues and soname. 2020-04-04 13:09:59 -05:00
Calvin Rose
f089b2001f Add several math functions to the math module. 2020-04-04 12:52:34 -05:00
Calvin Rose
9f8420bf50 Add jpm repl subcommand and post-deps macro for jpm.
This will allow more flexibility in writing jpm project files.
2020-04-03 19:33:54 -05:00
Calvin Rose
8275da63fb Address #331 - Add :octal-permissions 2020-04-03 18:29:45 -05:00
Calvin Rose
72696600d8 Add :deps opiton to declare-executable.
This allows the addition of custom dependencies.
2020-04-03 17:53:41 -05:00
Calvin Rose
1aeb317863 Revise, revise, revise, and proofread. 2020-04-03 17:04:05 -05:00
Calvin Rose
b49b510732 Update os/link docstring. 2020-04-03 16:58:45 -05:00
Calvin Rose
a0d61e45d5 Change os/perm-str to os/perm-string. 2020-04-03 15:23:29 -05:00
Calvin Rose
95f1ef7561 Add umask support for windows, and allow parsing mode strings. 2020-04-03 15:14:11 -05:00
Calvin Rose
edb2fab64c Merge branch 'master' of github.com:janet-lang/janet 2020-04-03 15:04:39 -05:00
Calvin Rose
464fb73d83 Add os/perm-int and os/perm-str.
This helps address #331. While we could also
make os/stat return an integer, we don't do that yet
for api breakage reasons.

This also lets us use this logic on other functions
that take permission strings.
2020-04-03 15:02:12 -05:00
Calvin Rose
6a4e63a17d Merge pull request #333 from andrewchambers/umask
Add os/umask.
2020-04-03 14:48:52 -05:00
Calvin Rose
168f94d29a Merge pull request #330 from DEADB17/patch-1
Correct typo and match wording for consistency
2020-04-03 14:46:15 -05:00
Andrew Chambers
3c2b1baff2 Add os/umask. 2020-04-02 23:33:50 +13:00
Calvin Rose
f2815d7068 Actually run the installer in build_win.bat. 2020-04-01 09:26:20 -05:00
Calvin Rose
f48d9465f5 Fix appveyor.yml 2020-04-01 09:23:19 -05:00
Calvin Rose
6b1d5c6d7b Work on improving deployment for windows. 2020-04-01 09:22:27 -05:00
Calvin Rose
789ef3608b Make format. 2020-04-01 08:54:01 -05:00
DEADB17
57b08a57a0 Corret typo and match wording for consistency 2020-03-31 23:32:17 -04:00
Calvin Rose
5b6b9f1597 Prepare for 1.8.1 release. 2020-03-31 09:49:09 -05:00
Calvin Rose
47f246ba66 Merge pull request #329 from pepe/master
Fix typo flie
2020-03-31 09:17:39 -05:00
Josef Pospíšil
b6b70d54ef Fix typo flie 2020-03-31 15:31:27 +02:00
Calvin Rose
417d9a14cc s/yaml/yml/g in README.md 2020-03-31 08:03:38 -05:00
Calvin Rose
244566ccd4 Remove manual feature definitions in boot.
Instead, reuse features as defined in features.h
2020-03-31 07:52:20 -05:00
Calvin Rose
ca4a35c90a Update CHANGELOG.md 2020-03-30 16:59:51 -05:00
Calvin Rose
e4ea8bc867 Fix features for bsd.
Don't define XOPEN_SOURCE unless we actually need it.
2020-03-30 15:38:03 -05:00
q66
5d840b944b Fix wrong check on big endian systems
We can't randomly type pun random-sized types on big endian
systems.
2020-03-30 13:38:49 -05:00
q66
1e28876494 Fix typo in big endian unmarshalling code
This was subtly breaking everything.
2020-03-30 13:38:49 -05:00
q66
a40b2767c5 Fix endian check for little endian PowerPC and maybe others
This fixes various subtle breakage on ppc64le at very least.
2020-03-30 13:38:49 -05:00
Calvin Rose
279b536646 Prepare for 1.8.0 release. 2020-03-29 14:18:28 -05:00
Calvin Rose
ff163a5ae4 Use modulo instead of remainder for even?/odd?.
Works better for negative and fractional numbers.
2020-03-28 10:23:28 -05:00
Calvin Rose
65379741f7 Address edge case of reduce2 when ind is empty.
Same for accumulate 2.
2020-03-27 12:45:40 -05:00
Calvin Rose
3eb0927a2b Add accumulate(2) and reduce2
These functions are variations on reduce and can be quite useful.
Improve error message for jpm as well.
2020-03-26 21:35:11 -05:00
Calvin Rose
a3a45511e5 Remove lockfile.janet 2020-03-26 00:40:03 -05:00
Calvin Rose
a20ea702e2 Add infinite loop detection and complex deps.
We needed to handle dependencies that had both a url
and a tag component.
2020-03-26 00:34:34 -05:00
Calvin Rose
d2d0300c7e Remove use of cd in make-lockfile. 2020-03-26 00:12:18 -05:00
Calvin Rose
6e8aac984f Update CHANGELOG.md 2020-03-25 21:06:45 -05:00
Calvin Rose
6721c70b9e Fix typo in jpm. 2020-03-25 21:01:54 -05:00
Calvin Rose
b8c1c1c144 Get lockfile info from manifest, not cache.
Make manifest files track more information.
Use jdn to store manifest files, as well as repo url and
sha.
2020-03-25 20:58:53 -05:00
Calvin Rose
e380c01dd1 Add lockfiles to jpm.
Add make-lockfile and load-lockfile commands.
2020-03-25 19:44:30 -05:00
Calvin Rose
655633ef34 Tweak docstring. 2020-03-25 18:00:15 -05:00
Calvin Rose
3d1de237f6 Several changes to the os module.
- Add os/symlink
- Add os/realpath
2020-03-24 19:47:21 -05:00
Calvin Rose
6a63b13d69 Fix os/link docstring - Address #323 2020-03-21 16:18:58 -05:00
Calvin Rose
3aca5502dc Allow :dst to be nil to set tm_isdst to be -1. 2020-03-18 22:23:27 -05:00
Calvin Rose
665f4bf248 Remove windows MSVC warnings about _stat. 2020-03-18 21:37:55 -05:00
Calvin Rose
b76ff3bdfc Fix omission of daylight savings time in mktime
Since with daylight savings times, certain times
are ambiguous (the hours before and after the switch), mktime
needs to allow reading a dst flag.
2020-03-18 21:23:35 -05:00
Calvin Rose
00450cd9db try and remove warnings on windows, format os.c. 2020-03-18 21:15:50 -05:00
Calvin Rose
c344a543b0 Merge pull request #318 from leahneukirchen/mktime
os/date fixes and os/mktime
2020-03-18 20:59:08 -05:00
Calvin Rose
554202f6e8 Merge branch 'master' of github.com:janet-lang/janet 2020-03-18 18:37:11 -05:00
Calvin Rose
7590cfc610 Update meson build file to try and fix LGTM. 2020-03-18 18:36:41 -05:00
Calvin Rose
eee8338064 Merge pull request #319 from leahneukirchen/lstat
os/lstat and os/readlink
2020-03-18 17:58:32 -05:00
Calvin Rose
3b5183a74e Fixes #316: os/execute should return non-zero on signals
Behave more like shells, and catch segfaults.
2020-03-18 17:49:20 -05:00
Leah Neukirchen
3ee43c3abb add os/mktime, an inverse to os/date. 2020-03-18 23:45:02 +01:00
Leah Neukirchen
efdb13f0c7 os/date: allow negative timestamps.
Why not?  Even on 32-bit time_t systems this lasts until late 1901.
2020-03-18 23:45:02 +01:00
Leah Neukirchen
f013c6e48d os/date: check the second argument truthy, not the third. 2020-03-18 23:45:02 +01:00
Leah Neukirchen
6e67899401 Add os/readlink. 2020-03-18 20:05:48 +01:00
Leah Neukirchen
381dd1ce98 Add os/lstat. 2020-03-18 20:05:48 +01:00
Calvin Rose
b0d8369534 Increase reference accuracy of on-stack close envs.
Using a bitset to indicate which stack values are upvalues, we
can more accurately track when a reference to a stack value
persists after the stack frame exits.
2020-03-18 09:30:10 -05:00
Calvin Rose
4a7b18d841 Merge pull request #317 from andrewchambers/closureenvs
Add test cases for closure edge cases.
2020-03-17 22:05:35 -05:00
Andrew Chambers
7c4ffe9b9a Add test cases for closure edge cases. 2020-03-18 15:40:41 +13:00
Calvin Rose
de4f8f9aaf Marshal alive fibers in func envs as detached.
This will help with marshaling fibers.
2020-03-17 20:53:11 -05:00
Calvin Rose
6554cc4a8d Merge branch 'master' of github.com:janet-lang/janet 2020-03-17 18:58:33 -05:00
Calvin Rose
fac47e8ecb When marshalling a closure, try to detach funcenvs
If possible, this will reduce the need to marshal fibers
in many cases. Also add this logic to the GC so holding a closure
that originally came from a fiber that crashed does not cause that fiber
to hang around forever.
2020-03-17 18:55:32 -05:00
Calvin Rose
7443305039 Merge pull request #315 from andrewchambers/u64
Properly export u64_type
2020-03-16 17:15:20 -05:00
Andrew Chambers
635ae3a523 Properly export u64_type 2020-03-17 11:02:57 +13:00
Calvin Rose
4a05b4556e Fix MSVC build warning. 2020-03-14 12:02:31 -05:00
Calvin Rose
c074615550 Revert to 9 char permission strings on windows. 2020-03-14 12:00:11 -05:00
Calvin Rose
bac2b74b3d Add os/chmod. 2020-03-14 11:57:04 -05:00
Calvin Rose
a3aaa6634d Use separate registry table for abstract types.
This avoids overloading the registry table, which is intended
for names of c functions.
2020-03-14 10:25:39 -05:00
Calvin Rose
6a3a983f43 Expose abstract type definitions in janet.h
This makes certain operations easier, and allows
more access to built in APIs.
2020-03-14 10:12:47 -05:00
Calvin Rose
7996edfef9 Update README.md - Fixes #308 2020-03-13 20:00:32 -05:00
Calvin Rose
0600b32908 Fix docstring for os/cd - Fixes #307 2020-03-13 15:01:48 -05:00
Calvin Rose
77343e02e9 Fixes #304
Add chr macro.
2020-03-10 22:46:50 -05:00
Calvin Rose
a3d4ecddba Address #301
Incorrect bounds checking and offset calculation in buffer/blit.
2020-03-08 20:44:03 -05:00
Calvin Rose
3d3d314fb7 Remove warning about math.h on aarch64 ubuntu gcc. 2020-03-07 14:05:28 -06:00
Calvin Rose
3f3b756b61 Merge pull request #298 from leahneukirchen/m-del
Make alt-backspace behave like ctrl-w.
2020-03-07 10:14:14 -06:00
Calvin Rose
d3b9b8d452 For #293, correct wildcards in dictinoaries. 2020-03-07 10:13:10 -06:00
Calvin Rose
390c042027 Update README.md 2020-03-07 09:49:25 -06:00
Calvin Rose
c864828735 Address #293 - wildcard to match macro.
The _ symbol will match any value without creating a binding.
2020-03-07 09:40:02 -06:00
Calvin Rose
e0c9910d85 Add :range-to and :down-to to loop.
Fully inclusive ranges are generally useful and
do not complicate implementation much.
2020-03-07 09:34:11 -06:00
Calvin Rose
e62f12426b Update ci build files. 2020-03-06 18:11:29 -06:00
Calvin Rose
d3af50e4cc Rename: s/yaml/yml/g 2020-03-06 17:42:35 -06:00
Calvin Rose
cbdb700edf No need for doubly hidden files. 2020-03-06 17:35:03 -06:00
Calvin Rose
6010b95fca Remove spaces from build manifests for sourcehut. 2020-03-06 17:30:36 -06:00
Calvin Rose
e351dde651 Update CHANGELOG.md and docs for loop and pp. 2020-03-06 17:12:06 -06:00
Calvin Rose
714bd61d56 Address #300
Check for empty capture stack in replace rule.
2020-03-06 10:05:20 -06:00
Calvin Rose
f9e9c70b6c Update CHANGELOG.md 2020-03-06 08:40:51 -06:00
Calvin Rose
6123c41f13 Harden semantics for and and or macros.
There was perviously a bit of fuzziness on returning false/nil
from these macros that has been removed.
2020-03-06 08:37:59 -06:00
Leah Neukirchen
1aaa5618de Make alt-backspace behave like ctrl-w.
Another common binding in readline and its clones.
2020-03-06 10:55:45 +01:00
Calvin Rose
fbe8998ca8 Merge branch 'master' of github.com:janet-lang/janet 2020-03-05 09:35:04 -06:00
Calvin Rose
47e8f669f5 Fix match behavior for lone nil. 2020-03-05 09:35:00 -06:00
Calvin Rose
d804ee3c07 Merge pull request #296 from leahneukirchen/ctrl-d
Make ctrl-d behave like delete, but exit on an empty line.
2020-03-04 20:42:05 -06:00
Calvin Rose
06a78d90d9 Merge pull request #295 from leahneukirchen/meson-pkgconfig
Create janet.pc also from Meson.
2020-03-04 20:39:24 -06:00
Leah Neukirchen
bc2ebce086 Make ctrl-d behave like delete, but exit on an empty line.
This is the default readline behavior.
2020-03-04 14:56:04 +01:00
Leah Neukirchen
a07de921d0 Create janet.pc also from Meson. 2020-03-04 14:35:57 +01:00
Calvin Rose
6bc67b70a6 Address #294
Correct invalid format string, which masked a panic
with another, less useful panic.
2020-03-03 22:26:26 -06:00
Calvin Rose
f06addfe06 For #240, address case when LDCONFIG is empty 2020-03-03 18:13:25 -06:00
Calvin Rose
7c2c50ee16 For #240 - don't run ldconfig for DESTDIR installs. 2020-03-03 18:03:44 -06:00
Calvin Rose
8580d3c27e Address #240 - Support DESTDIR in Makefile. 2020-03-03 17:45:59 -06:00
Calvin Rose
951e10f272 Address #292
Faulty Makefile fallback.
2020-03-03 08:21:14 -06:00
Calvin Rose
2349ea9405 Update docs for buffer/push-word
Should be little endian, not big endian.
2020-03-01 12:05:24 -06:00
Calvin Rose
b17bf259f7 Fix typo: destory -> destroy 2020-02-28 09:04:28 -06:00
Calvin Rose
6b093bdcca Address #288 and partially #287
The %q formatter for janet_formatc now expects a Janet, not a JanetString or
JanetSymbol or JanetKeyword.

Also fix some reference counting issues with threads when destroying
threads, which should fix #287's
SIGSEGV. Still fails to send messages sometimes, though.
2020-02-27 17:58:17 -06:00
Calvin Rose
10ec319c32 Add better debug info to amalgamated source. 2020-02-27 00:16:54 -06:00
Calvin Rose
8cb63cebbe Remove 'make test-amalg' from CI. 2020-02-25 20:31:38 -06:00
Calvin Rose
7d26de6697 Update changelog. 2020-02-25 20:08:22 -06:00
Calvin Rose
8262290bff Improve C string format (janet_formatc, janet_panicf)
The supported formatters here now match up more with
the string/format, buffer/format, printf, eprintf, etc.
2020-02-25 20:05:45 -06:00
Calvin Rose
2779037f13 Clean up Makefile. 2020-02-25 20:02:03 -06:00
Calvin Rose
734c85d7ef Properly handle recursion with labels.
Use an empty buffer, which has pointer equality semantics, for
tag from a label.
2020-02-23 17:35:01 -06:00
Calvin Rose
05bd5767de Add label macro.
A lexically scoped version of prompt is often useful.
2020-02-23 17:15:04 -06:00
Calvin Rose
59d288c429 Add prompt and return.
User friendly delimited continuations. While this was doable with
signals before, this does not require C and will play nicely with
existing error handling, defers, and with statements.
2020-02-23 16:46:54 -06:00
Calvin Rose
8c41c0b6a7 Address MSVC warning. 2020-02-23 15:27:57 -06:00
Calvin Rose
f5f3858da1 Update CHANGELOG.md 2020-02-23 14:55:21 -06:00
Calvin Rose
738490e674 Allow function that takes 1 argument to fiber/new.
This allows reuse of closures when creating many fibers.
2020-02-23 14:47:29 -06:00
Calvin Rose
6a13703e32 Add signal and fiber/can-resume?.
These additions, along with the change that user signals 0-4 cannot
be resumed, allow delimited continuation semantics, while repsecting
existing forms like `defer`, `with`, `with-vars`, etc.
2020-02-23 13:31:27 -06:00
Calvin Rose
20d5d560f3 Add bf to main test suite. 2020-02-22 19:18:08 -06:00
Calvin Rose
aaabca6fc7 Make flychecker handle more kinds of defs.
This should help when redefining certain forms. Will also
not do functional arity checking against nil forms, as that
is the default value when a def doesn't evaluate.
2020-02-21 21:20:40 -06:00
Calvin Rose
4b440618d6 Correct docs for type form. 2020-02-21 20:22:43 -06:00
Calvin Rose
a360cb7922 Update marshal to take 3 arguments. 2020-02-15 10:04:44 -06:00
Calvin Rose
b9a2bb8104 Fix documentation for defer. 2020-02-12 09:34:23 -06:00
Calvin Rose
031a9894b0 Update inlining options for next and resume. 2020-02-08 13:03:03 -06:00
Calvin Rose
fcc09d7ea9 Clarify docs for some and all. 2020-02-05 21:06:39 -06:00
Calvin Rose
d8d482e433 Merge branch 'master' of github.com:janet-lang/janet 2020-02-03 18:18:29 -06:00
Calvin Rose
3fdc053d6c Add flush and eflush (#278)
These functions interact with Janet's dynamically scoped
IO functions in a manner that is more useful the file/flush.
We can still redirect to a buffer without changing our code.
2020-02-03 18:14:32 -06:00
Calvin Rose
8be3ce18aa Merge pull request #280 from pepe/fix-next-arity
Fix next function arity
2020-02-03 18:00:36 -06:00
Josef Pospíšil
00107c092c Fix next function arity 2020-02-03 15:36:42 +01:00
Calvin Rose
64e1961193 Update version strings to 1.7.1-dev. 2020-02-02 09:38:44 -06:00
Calvin Rose
f7ee8bd30d Update to version 1.7.0. 2020-02-01 23:35:17 -06:00
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
Andrew Chambers
344f0b743d Make hash api more future proof. 2020-01-17 17:25:40 +13:00
73 changed files with 4529 additions and 1878 deletions

View File

@@ -1,11 +0,0 @@
image: freebsd/latest
packages:
- gmake
tasks:
- build: |
cd janet
gmake
gmake test
sudo gmake install
gmake test-install
gmake test-amalg

View File

@@ -1,11 +0,0 @@
image: openbsd/6.5
packages:
- gmake
tasks:
- build: |
cd janet
gmake
gmake test
doas gmake install
gmake test-install
gmake test-amalg

12
.builds/freebsd.yml Normal file
View File

@@ -0,0 +1,12 @@
image: freebsd/12.x
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- gmake
tasks:
- build: |
cd janet
gmake
gmake test
sudo gmake install
gmake test-install

12
.builds/openbsd.yml Normal file
View File

@@ -0,0 +1,12 @@
image: openbsd/latest
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- gmake
tasks:
- build: |
cd janet
gmake
gmake test
doas gmake install
gmake test-install

3
.gitignore vendored
View File

@@ -13,6 +13,9 @@ janet
janet-*.tar.gz
dist
# jpm lockfile
lockfile.janet
# Kakoune (fzf via fd)
.fdignore

View File

@@ -4,7 +4,6 @@ script:
- make test
- sudo make install
- make test-install
- make test-amalg
- make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
compiler:
- clang

View File

@@ -1,7 +1,61 @@
# Changelog
All notable changes to this project will be documented in this file.
### Unreleased
## Unreleased - ???
- Add `jpm rule-tree` subcommand.
- Add `--offline` flag to jpm to force use of the cache.
- Allow sending pointers and C functions across threads via `thread/send`.
- Fix bug in `getline`.
- Add `sh-rule` and `sh-phony` to jpm's dialect of Janet.
- Change C api's `janet_formatb` -> `janet_formatbv`, and add new function `janet_formatb` to C api.
- Add `edefer` macro to core.
- A struct/table literal/constructor with duplicate keys will use the last value given.
Previously, this was inconsistent between tables and structs, literals and constructor functions.
- Add debugger to core. The debugger functions are only available
in a debug repl, and are prefixed by a `.`.
- Add `sort-by` and `sorted-by` to core.
- Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXX`.
- Add `math/erf`
- Add `math/erfc`
- Add `math/log1p`
- Add `math/next`
- Add os/umask
- Add os/perm-int
- Add os/perm-string
- Add :octal-permissions option for os/stat.
- Add `jpm repl` subcommand, as well as `post-deps` macro in project.janet files.
- Various bug fixes.
## 1.8.1 - 2020-03-31
- Fix bugs for big endian systems
- Fix 1.8.0 regression on BSDs
## 1.8.0 - 2020-03-29
- Add `reduce2`, `accumulate`, and `accumulate2`.
- Add lockfiles to `jpm` via `jpm make-lockfile` and `jpm load-lockfile`.
- Add `os/realpath` (Not supported on windows).
- Add `os/chmod`.
- Add `chr` macro.
- Allow `_` in the `match` macro to match anything without creating a binding
or doing unification. Also change behavior of matching nil.
- Add `:range-to` and `:down-to` verbs in the `loop` macro.
- Fix `and` and `or` macros returning nil instead of false in some cases.
- Allow matching successfully against nil values in the `match` macro.
- Improve `janet_formatc` and `janet_panicf` formatters to be more like `string/format`.
This makes it easier to make nice error messages from C.
- Add `signal`
- Add `fiber/can-resume?`
- Allow fiber functions to accept arguments that are passed in via `resume`.
- Make flychecking slightly less strict but more useful
- Correct arity for `next`
- Correct arity for `marshal`
- Add `flush` and `eflush`
- Add `prompt` and `return` on top of signal for user friendly delimited continuations.
- Fix bug in buffer/blit when using the offset-src argument.
- Fix segfault with malformed pegs.
## 1.7.0 - 2020-02-01
- Remove `file/fileno` and `file/fdopen`.
- Remove `==`, `not==`, `order<`, `order>`, `order<=`, and `order>=`. Instead, use the normal
comparison and equality functions.
- Let abstract types define a hash function and comparison/equality semantics. This lets
@@ -9,20 +63,29 @@ All notable changes to this project will be documented in this file.
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
## 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`.

170
Makefile
View File

@@ -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 || 'local')\""
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || echo local)\""
CLIBS=-lm -lpthread
JANET_TARGET=build/janet
JANET_LIBRARY=build/libjanet.so
@@ -36,10 +36,10 @@ JANET_PATH?=$(LIBDIR)/janet
MANPATH?=$(PREFIX)/share/man/man1/
PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
DEBUGGER=gdb
SONAME_SETTER=-Wl,-soname,
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden -march=native \
-DJANET_BUILD=$(JANET_BUILD)
LDFLAGS=-rdynamic
CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden
LDFLAGS:=$(LDFLAGS) -rdynamic
# For installation
LDCONFIG:=ldconfig "$(LIBDIR)"
@@ -48,13 +48,14 @@ LDCONFIG:=ldconfig "$(LIBDIR)"
UNAME:=$(shell uname -s)
ifeq ($(UNAME), Darwin)
CLIBS:=$(CLIBS) -ldl
LDCONFIG:=
SONAME_SETTER:=-Wl,-install_name,
LDCONFIG:=true
else ifeq ($(UNAME), Linux)
CLIBS:=$(CLIBS) -lrt -ldl
endif
# For other unix likes, add flags here!
ifeq ($(UNAME), Haiku)
LDCONFIG:=
LDCONFIG:=true
LDFLAGS=-Wl,--export-dynamic
endif
@@ -124,83 +125,33 @@ JANET_BOOT_SOURCES=src/boot/array_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
JANET_MAINCLIENT_HEADERS=src/mainclient/line.h
##########################################################
##### The bootstrap interpreter that creates janet.c #####
##########################################################
JANET_WEBCLIENT_SOURCES=src/webclient/main.c
##################################################################
##### 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=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES))
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) $(CFLAGS)
$(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ -c $<
$(CC) $(BOOT_CFLAGS) -o $@ -c $<
build/janet_boot: $(JANET_BOOT_OBJECTS)
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ $^ $(CLIBS)
$(CC) $(BOOT_CFLAGS) -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))
$(JANET_MAINCLIENT_OBJECTS): $(JANET_MAINCLIENT_HEADERS)
# 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 $@ $^
#############################
##### 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
SONAME=libjanet.so.1.9
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 $< $@
@@ -208,6 +159,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) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
$(AR) rcs $@ $^
###################
##### Testing #####
###################
@@ -266,9 +232,7 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
##### Installation #####
########################
SONAME=libjanet.so.1
.PHONY: build/janet.pc
.INTERMEDIATE: build/janet.pc
build/janet.pc: $(JANET_TARGET)
echo 'prefix=$(PREFIX)' > $@
echo 'exec_prefix=$${prefix}' >> $@
@@ -280,37 +244,37 @@ build/janet.pc: $(JANET_TARGET)
echo "Description: Library for the Janet programming language." >> $@
$(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
echo 'Cflags: -I$${includedir}' >> $@
echo 'Libs: -L$${libdir} -ljanet $(LDFLAGS)' >> $@
echo 'Libs: -L$${libdir} -ljanet' >> $@
echo 'Libs.private: $(CLIBS)' >> $@
install: $(JANET_TARGET) build/janet.pc
mkdir -p '$(BINDIR)'
cp $(JANET_TARGET) '$(BINDIR)/janet'
mkdir -p '$(INCLUDEDIR)/janet'
cp -rf $(JANET_HEADERS) '$(INCLUDEDIR)/janet'
mkdir -p '$(JANET_PATH)'
mkdir -p '$(LIBDIR)'
cp $(JANET_LIBRARY) '$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
cp $(JANET_STATIC_LIBRARY) '$(LIBDIR)/libjanet.a'
ln -sf $(SONAME) '$(LIBDIR)/libjanet.so'
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME)
cp -rf auxbin/* '$(BINDIR)'
mkdir -p '$(MANPATH)'
cp janet.1 '$(MANPATH)'
cp jpm.1 '$(MANPATH)'
mkdir -p '$(PKG_CONFIG_PATH)'
cp build/janet.pc '$(PKG_CONFIG_PATH)/janet.pc'
-$(LDCONFIG)
mkdir -p '$(DESTDIR)$(BINDIR)'
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
cp -rf $(JANET_HEADERS) '$(DESTDIR)$(INCLUDEDIR)/janet'
mkdir -p '$(DESTDIR)$(JANET_PATH)'
mkdir -p '$(DESTDIR)$(LIBDIR)'
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
cp -rf auxbin/* '$(DESTDIR)$(BINDIR)'
mkdir -p '$(DESTDIR)$(MANPATH)'
cp janet.1 '$(DESTDIR)$(MANPATH)'
cp jpm.1 '$(DESTDIR)$(MANPATH)'
mkdir -p '$(DESTDIR)$(PKG_CONFIG_PATH)'
cp build/janet.pc '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
uninstall:
-rm '$(BINDIR)/janet'
-rm '$(BINDIR)/jpm'
-rm -rf '$(INCLUDEDIR)/janet'
-rm -rf '$(LIBDIR)'/libjanet.*
-rm '$(PKG_CONFIG_PATH)/janet.pc'
-rm '$(MANPATH)/janet.1'
-rm '$(MANPATH)/jpm.1'
# -rm -rf '$(JANET_PATH)'/* - err on the side of correctness here
-rm '$(DESTDIR)$(BINDIR)/janet'
-rm '$(DESTDIR)$(BINDIR)/jpm'
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'
-rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.*
-rm '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
-rm '$(DESTDIR)$(MANPATH)/janet.1'
-rm '$(DESTDIR)$(MANPATH)/jpm.1'
# -rm -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here
#################
##### Other #####
@@ -339,15 +303,5 @@ test-install:
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/path.git
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git
build/embed_janet.o: build/janet.c $(JANET_HEADERS)
$(CC) $(CFLAGS) -c $< -o $@
build/embed_main.o: test/amalg/main.c $(JANET_HEADERS)
$(CC) $(CFLAGS) -c $< -o $@
build/embed_test: build/embed_janet.o build/embed_main.o
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
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

@@ -2,26 +2,28 @@
&nbsp;
[![Appveyor Status](https://ci.appveyor.com/api/projects/status/bjraxrxexmt3sxyv/branch/master?svg=true)](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
[![Build Status](https://travis-ci.org/janet-lang/janet.svg?branch=master)](https://travis-ci.org/janet-lang/janet)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml.svg)](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/.openbsd.yaml.svg)](https://builds.sr.ht/~bakpakin/janet/.openbsd.yaml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/freebsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/openbsd.yml?)
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
modern lisp, but lists are replaced
by other data structures with better utility and performance (arrays, tables, structs, tuples).
by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples).
The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
There is a repl for trying out the language, as well as the ability
to run script files. This client program is separate from the core runtime, so
janet could be embedded into other programs. Try janet in your browser at
Janet can be embedded into other programs. Try Janet in your browser at
[https://janet-lang.org](https://janet-lang.org).
<br>
## Use Cases
Janet makes a good system scripting language, or a language to embed in other programs, like Lua or Guile.
Janet makes a good system scripting language, or a language to embed in other programs.
It's like Lua and Guile in that regard. It has more built-in functionality and a richer core language than
Lua, but smaller than GNU Guile or Python.
## Features
@@ -43,7 +45,7 @@ Janet makes a good system scripting language, or a language to embed in other pr
* Imperative programming as well as functional
* REPL
* Parsing Expression Grammars built in to the core library
* 300+ functions and macros in the core library
* 400+ functions and macros in the core library
* Embedding Janet in other programs
* Interactive environment with detailed stack traces
@@ -61,7 +63,9 @@ documentation for symbols in the core library. For example,
Shows documentation for the doc macro.
To get a list of all bindings in the default
environment, use the `(all-bindings)` function.
environment, use the `(all-bindings)` function. You
can also use the `(doc)` macro with no arguments if you are in the repl
to show bound symbols.
## Source
@@ -122,7 +126,7 @@ is maybe more convenient and flexible for integrating into existing pipelines.
Meson also provides much better IDE integration than Make or batch files, as well as support
for cross compilation.
For the impatient, building with Meson is as simple as follows. The options provided to
For the impatient, building with Meson is as follows. The options provided to
`meson setup` below emulate Janet's Makefile.
```sh
@@ -152,7 +156,7 @@ Emacs, and Atom will have syntax packages for the Janet language, though.
## Installation
See [the Introduction](https://janet-lang.org/introduction.html) for more details. If you just want
to try out the language, you don't need to install anything. You can also simply move the `janet` executable wherever you want on your system and run it.
to try out the language, you don't need to install anything. You can also move the `janet` executable wherever you want on your system and run it.
## Usage
@@ -163,35 +167,38 @@ If you are looking to explore, you can print a list of all available macros, fun
by entering the command `(all-bindings)` into the repl.
```
$ ./janet
Janet 0.0.0 alpha Copyright (C) 2017-2018 Calvin Rose
$ janet
Janet 1.7.1-dev-951e10f Copyright (C) 2017-2020 Calvin Rose
janet:1:> (+ 1 2 3)
6
janet:2:> (print "Hello, World!")
Hello, World!
nil
janet:3:> (os/exit)
$ ./janet -h
usage: ./janet [options] scripts...
$ janet -h
usage: build/janet [options] script args...
Options are:
-h Show this help
-v Print the version string
-s Use raw stdin instead of getline like functionality
-e Execute a string of janet
-r Enter the repl after running all scripts
-p Keep on executing if there is a top level error (persistent)
-- Stop handling option
$
-h : Show this help
-v : Print the version string
-s : Use raw stdin instead of getline like functionality
-e code : Execute a string of janet
-r : Enter the repl after running all scripts
-p : Keep on executing if there is a top level error (persistent)
-q : Hide prompt, logo, and repl output (quiet)
-k : Compile scripts but do not execute (flycheck)
-m syspath : Set system path for loading global modules
-c source output : Compile janet source code into an image
-n : Disable ANSI color output in the repl
-l path : Execute code in a file before running the main script
-- : Stop handling options
```
If installed, you can also run `man janet` to get usage information.
If installed, you can also run `man janet` and `man jpm` to get usage information.
## Embedding
The C API for Janet is not yet documented but coming soon.
Janet can be embedded in a host program very easily. There is a make target
`make amalg` which creates the file `build/janet.c`, which is a single C file
Janet can be embedded in a host program very easily. The normal build
will create a file `build/janet.c`, which is a single C file
that contains all the source to Janet. This file, along with
`src/include/janet.h` and `src/include/janetconf.h` can dragged into any C
project and compiled into the project. Janet should be compiled with `-std=c99`
@@ -200,6 +207,8 @@ the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
there is no need for dynamic modules, add the define
`-DJANET_NO_DYNAMIC_MODULES` to the compiler options.
See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the website for more information.
## Examples
See the examples directory for some example janet code.

View File

@@ -14,24 +14,23 @@ environment:
matrix:
fast_finish: true
# skip unsupported combinations
init:
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
install:
- set JANET_BUILD=%appveyor_repo_commit:~0,7%
before_build:
- 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.05-strlen_8192.zip" -o"C:\Program Files (x86)\NSIS\" -y
build_script:
- set JANET_BUILD=%appveyor_repo_commit:~0,7%
- build_win all
test_script:
- 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.1
build: off
- if "%janet_outname%"=="" set /P janet_outname=<build\version.txt
artifacts:
- name: janet.c
@@ -49,8 +48,7 @@ artifacts:
- name: "janet-$(janet_outname)-windows-%platform%"
path: dist
type: Zip
- path: "janet-$(janet_outname)-windows-installer.exe"
name: "janet-$(janet_outname)-windows-%platform%-installer.exe"
- path: "janet-$(janet_outname)-windows-%platform%-installer.exe"
type: File
deploy:

View File

@@ -34,7 +34,7 @@
(defmacro rule
"Add a rule to the rule graph."
[target deps & body]
~(,rule-impl ,target ,deps (fn [] nil ,;body)))
~(,rule-impl ,target ,deps (fn [] ,;body)))
(defmacro phony
"Add a phony rule to the rule graph. A phony rule will run every time
@@ -43,6 +43,16 @@
[target deps & body]
~(,rule-impl ,target ,deps (fn [] nil ,;body) true))
(defmacro sh-rule
"Add a rule that invokes a shell command, and fails if the command returns non-zero."
[target deps & body]
~(,rule-impl ,target ,deps (fn [] (,assert (,zero? (,os/shell (,string ,;body)))))))
(defmacro sh-phony
"Add a phony rule that invokes a shell command, and fails if the command returns non-zero."
[target deps & body]
~(,rule-impl ,target ,deps (fn [] (,assert (,zero? (,os/shell (,string ,;body))))) true))
(defn add-dep
"Add a dependency to an existing rule. Useful for extending phony
rules or extending the dependency graph of existing rules."
@@ -131,7 +141,6 @@
["/nologo" "/MD"]
["-std=c99" "-Wall" "-Wextra"]))
# Link to pthreads
(def- thread-flags (if is-win [] (if threads? ["-lpthread"] [])))
@@ -158,7 +167,7 @@
ret)
(defn check-cc
"Ensure we have a c compiler"
"Ensure we have a c compiler."
[]
(if is-win
(do
@@ -168,6 +177,14 @@
microsoft.com"))
(do)))
(defn create-dirs
"Create all directories needed for a file (mkdir -p)."
[dest]
(def segs (string/split "/" dest))
(for i 1 (length segs)
(def path (string/join (slice segs 0 i) "/"))
(unless (empty? path) (os/mkdir path))))
#
# Importing a file
#
@@ -178,24 +195,46 @@
[into x]
(when x
(proto-flatten into (table/getproto x))
(loop [k :keys x]
(put into k (x k))))
(merge-into into x))
into)
(defn import-rules
"Import another file that defines more rules. This ruleset
is merged into the current ruleset."
[path]
(defn make-jpm-env
"Build an environment table with jpm functions preloaded."
[&opt no-deps]
(def env (make-env))
(unless (os/stat path :mode)
(error (string "cannot open " path)))
(put env :jpm-no-deps no-deps)
(loop [k :keys _env :when (symbol? k)]
(unless ((_env k) :private) (put env k (_env k))))
env)
(defn require-jpm
"Require a jpm file project file. This is different from a normal require
in that code is loaded in the jpm environment."
[path &opt no-deps]
(unless (os/stat path :mode)
(error (string "cannot open " path)))
(def env (make-jpm-env no-deps))
(def currenv (proto-flatten @{} (fiber/getenv (fiber/current))))
(loop [k :keys currenv :when (keyword? k)]
(put env k (currenv k)))
(dofile path :env env :exit true)
(when-let [rules (env :rules)] (merge-into (getrules) rules)))
env)
(defn import-rules
"Import another file that defines more rules. This ruleset
is merged into the current ruleset."
[path &opt no-deps]
(def env (require-jpm path no-deps))
(when-let [rules (env :rules)] (merge-into (getrules) rules))
env)
(defmacro post-deps
"Run code at the top level if jpm dependencies are installed. Build
code that imports dependencies should be wrapped with this macro, as project.janet
needs to be able to run successfully even without dependencies installed."
[& body]
(unless (dyn :jpm-no-deps)
~',(reduce |(eval $1) nil body)))
#
# OS and shell helpers
@@ -227,15 +266,12 @@
(defn rm
"Remove a directory and all sub directories."
[path]
(try
(if (= (os/stat path :mode) :directory)
(do
(each subpath (os/dir path)
(rm (string path sep subpath)))
(os/rmdir path))
(os/rm path))
([err f] (unless (string/has-prefix? "No such file or directory" err)
(propagate err f)))))
(if (= (os/lstat path :mode) :directory)
(do
(each subpath (os/dir path)
(rm (string path sep subpath)))
(os/rmdir path))
(os/rm path)))
(defn copy
"Copy a file or directory recursively from one location to another."
@@ -252,11 +288,7 @@
If we can't create it, give a friendly error. Return true if created, false if
existing. Throw an error if we can't create it."
[dir]
(if (os/mkdir dir)
true
(if (os/stat dir :mode)
false
(error (string "Could not create " dir " - this could be a permission issue.")))))
(os/mkdir dir))
#
# C Compilation
@@ -317,6 +349,7 @@
(rule dest [src ;headers]
(check-cc)
(print "compiling " dest "...")
(create-dirs dest)
(if is-win
(shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)
(shell cc "-c" src ;defines ;cflags "-o" dest))))
@@ -349,6 +382,7 @@
(rule target objects
(check-cc)
(print "linking " target "...")
(create-dirs target)
(if is-win
(shell linker ;lflags (string "/OUT:" target) ;objects (win-import-library))
(shell linker ;cflags `-o` target ;objects ;lflags))))
@@ -360,12 +394,14 @@
(rule target objects
(check-cc)
(print "creating static library " target "...")
(create-dirs target)
(if is-win
(shell ar "/nologo" (string "/out:" target) ;objects)
(shell ar "rcs" target ;objects))))
(defn- create-buffer-c-impl
[bytes dest name]
(create-dirs dest)
(def out (file/open dest :w))
(def chunks (seq [b :in bytes] (string b)))
(file/write out
@@ -382,6 +418,7 @@
[source dest name]
(rule dest [source]
(print "generating " dest "...")
(create-dirs dest)
(with [f (file/open source :r)]
(create-buffer-c-impl (:read f :all) dest name))))
@@ -408,6 +445,7 @@
(rule dest [source]
(check-cc)
(print "generating executable c source...")
(create-dirs dest)
# Load entry environment and get main function.
(def entry-env (dofile source))
(def main ((entry-env 'main) :value))
@@ -555,6 +593,15 @@ int main(int argc, const char **argv) {
# Public utilities
#
(defn parse
"Read a string of Janet source and parse out the first expression."
[src]
(let [p (parser/new)]
(:consume p src)
(if (= :error (:status p))
(error (string "Could not parse: " (parser/error p))))
(:produce p)))
(defn find-manifest-dir
"Get the path to the directory containing manifests for installed
packages."
@@ -564,7 +611,7 @@ int main(int argc, const char **argv) {
(defn find-manifest
"Get the full path of a manifest file given a package name."
[name]
(string (find-manifest-dir) sep name ".txt"))
(string (find-manifest-dir) sep name ".jdn"))
(defn find-cache
"Return the path to the global cache."
@@ -576,17 +623,14 @@ int main(int argc, const char **argv) {
"Uninstall bundle named name"
[name]
(def manifest (find-manifest name))
(def f (file/open manifest :r))
(unless f (print manifest " does not exist") (break))
(loop [line :iterate (:read f :line)]
(def path ((string/split "\n" line) 0))
(def path ((string/split "\r" path) 0))
(print "removing " path)
(rm path))
(:close f)
(print "removing " manifest)
(rm manifest)
(print "Uninstalled."))
(when-with [f (file/open manifest)]
(def man (parse (:read f :all)))
(each path (get man :paths [])
(print "removing " path)
(rm path))
(print "removing " manifest)
(rm manifest)
(print "Uninstalled.")))
(defn- rimraf
"Hard delete directory tree"
@@ -608,7 +652,7 @@ int main(int argc, const char **argv) {
(defn install-git
"Install a bundle from git. If the bundle is already installed, the bundle
is reinistalled (but not rebuilt if artifacts are cached)."
[repotab &opt recurse]
[repotab &opt recurse no-deps]
(def repo (if (string? repotab) repotab (repotab :repo)))
(def tag (unless (string? repotab) (repotab :tag)))
# prevent infinite recursion (very unlikely, but consider
@@ -633,12 +677,16 @@ int main(int argc, const char **argv) {
(def id (filepath-replace repo))
(def module-dir (string cache sep id))
(var fresh false)
(when (mkdir module-dir)
(set fresh true)
(print "cloning repository " repo " to " module-dir)
(unless (zero? (os/execute ["git" "clone" repo module-dir] :p))
(rimraf module-dir)
(error (string "could not clone git dependency " repo))))
(if (dyn :offline)
(if (not= :directory (os/stat module-dir :mode))
(error (string "did not find cached repo for dependency " repo))
(set fresh true))
(when (mkdir module-dir)
(set fresh true)
(print "cloning repository " repo " to " module-dir)
(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 @{}
@@ -651,9 +699,10 @@ int main(int argc, const char **argv) {
(os/execute ["git" "pull" "origin" "master"] :p))
(when tag
(os/execute ["git" "reset" "--hard" tag] :p))
(os/execute ["git" "submodule" "update" "--init" "--recursive"] :p)
(unless (dyn :offline)
(os/execute ["git" "submodule" "update" "--init" "--recursive"] :p))
(import-rules "./project.janet")
(do-rule "install-deps")
(unless no-deps (do-rule "install-deps"))
(do-rule "build")
(do-rule "install"))
([err] (print "Error building git repository dependency: " err)))
@@ -670,6 +719,49 @@ int main(int argc, const char **argv) {
(mkdir destdir)
(copy src destdir)))
(defn- pslurp
"Like slurp, but with file/popen instead file/open. Also trims output"
[cmd]
(string/trim (with [f (file/popen cmd)] (:read f :all))))
(defn- make-lockfile
[&opt filename]
(default filename "lockfile.jdn")
(def cwd (os/cwd))
(def packages @[])
# Read installed modules from manifests
(def mdir (find-manifest-dir))
(each man (os/dir mdir)
(def package (parse (slurp (string mdir sep man))))
(if (and (dictionary? package) (package :repo) (package :sha))
(array/push packages package)
(print "Cannot add local or malformed package " mdir sep man " to lockfile, skipping...")))
# Put in correct order, such that a package is preceded by all of its dependencies
(def ordered-packages @[])
(def resolved @{})
(while (< (length ordered-packages) (length packages))
(var made-progress false)
(each p packages
(def {:repo r :sha s :dependencies d} p)
(def dep-urls (map |(if (string? $) $ ($ :repo)) d))
(unless (resolved r)
(when (all resolved dep-urls)
(array/push ordered-packages {:repo r :sha s})
(set made-progress true)
(put resolved r true))))
(unless made-progress
(error (string/format "could not resolve package order for: %j"
(filter (complement resolved) (map |($ :repo) packages))))))
# Write to file
(with [f (file/open filename :w)] (with-dyns [:out f] (printf "%j" ordered-packages))))
(defn- load-lockfile
[&opt filename]
(default filename "lockfile.jdn")
(def lockarray (parse (slurp filename)))
(each {:repo url :sha sha} lockarray
(install-git {:repo url :tag sha} nil true)))
#
# Declaring Artifacts - used in project.janet, targets specifically
# tailored for janet.
@@ -753,13 +845,16 @@ 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 :deps deps}]
(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)))
(when deps
(each d deps (add-dep dest d)))
(when install
(install-rule dest (dyn :binpath JANET_BINPATH))))
@@ -780,6 +875,19 @@ int main(int argc, const char **argv) {
(add-body "install"
(spit newname bat))))
(defn- print-rule-tree
"Show dependencies for a given rule recursively in a nice tree."
[root depth prefix prefix-part]
(print prefix root)
(when-let [[root-deps] ((getrules) root)]
(when (pos? depth)
(def l (-> root-deps length dec))
(eachp [i d] (sorted root-deps)
(print-rule-tree
d (dec depth)
(string prefix-part (if (= i l) " └─" " ├─"))
(string prefix-part (if (= i l) " " " │ ")))))))
(defn declare-archive
"Build a janet archive. This is a file that bundles together many janet
scripts into a janet image. This file can the be moved to any machine with
@@ -789,6 +897,7 @@ int main(int argc, const char **argv) {
(def name (opts :name))
(def iname (string "build" sep name ".jimage"))
(rule iname (or (opts :deps) [])
(create-dirs iname)
(spit iname (make-image (require entry))))
(def path (dyn :modpath JANET_MODPATH))
(add-dep "build" iname)
@@ -808,13 +917,20 @@ int main(int argc, const char **argv) {
(setdyn :manifest-dir manifests)
(setdyn :installed-files installed-files)
(rule "./build" [] (mkdir "build"))
(phony "build" ["./build"])
(phony "build" [])
(phony "manifest" []
(print "generating " manifest "...")
(mkdir manifests)
(spit manifest (string (string/join installed-files "\n") "\n")))
(def sha (pslurp "git rev-parse HEAD"))
(def url (pslurp "git remote get-url origin"))
(def man
{:sha (if-not (empty? sha) sha)
:repo (if-not (empty? url) url)
:dependencies (array/slice (get meta :dependencies []))
:paths installed-files})
(spit manifest (string/format "%j\n" man)))
(phony "install" ["uninstall" "build" "manifest"]
(when (dyn :test)
(do-rule "test"))
@@ -858,8 +974,8 @@ int main(int argc, const char **argv) {
'(* "--" '(some (if-not "=" 1)) (+ (* "=" '(any 1)) -1))))
(defn- local-rule
[rule]
(import-rules "./project.janet")
[rule &opt no-deps]
(import-rules "./project.janet" no-deps)
(do-rule rule))
(defn- help
@@ -886,8 +1002,20 @@ Subcommands are:
run rule : run a rule. Can also run custom rules added via (phony "task" [deps...] ...)
or (rule "ouput.file" [deps...] ...).
rules : list rules available with run.
rule-tree (root rule) (depth) : Print a nice tree to see what rules depend on other rules.
Optinally provide a root rule to start printing from, and a
max depth to print. Without these options, all rules will print
their full dependency tree.
update-pkgs : Update the current package listing from the remote git repository selected.
quickbin entry executable : Create an executable from a janet script with a main function.
make-lockfile (lockfile) : Create a lockfile based on repositories in the cache. The
lockfile will record the exact versions of dependencies used to ensure a reproducible
build. Lockfiles are best used with applications, not libraries. The default lockfile
name is lockfile.jdn.
load-lockfile (lockfile) : Install modules from a lockfile in a reproducible way. The
default lockfile name is lockfile.jdn.
repl : Run a repl in the context of the current project.janet file. This lets you run rules and
otherwise debug the current project.janet file.
Keys are:
--modpath : The directory to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath)
@@ -901,15 +1029,17 @@ Keys are:
--pkglist : URL of git repository for package listing. Defaults to $JANET_PKGLIST or https://github.com/janet-lang/pkgs.git
Flags are:
--nocolor : Disable color in the jpm repl.
--verbose : Print shell commands as they are executed.
--test : If passed to jpm install, runs tests before installing. Will run tests recursively on dependencies.
--offline : Prevents jpm from going to network to get dependencies - all dependencies should be in the cache or this command will fail.
`))
(defn- show-help
(defn show-help
[]
(print help))
(defn- show-paths
(defn show-paths
[]
(print "binpath: " (dyn :binpath JANET_BINPATH))
(print "modpath: " (dyn :modpath JANET_MODPATH))
@@ -917,21 +1047,21 @@ Flags are:
(print "headerpath: " (dyn :headerpath JANET_HEADERPATH))
(print "syspath: " (dyn :syspath)))
(defn- build
(defn build
[]
(local-rule "build"))
(defn- clean
(defn clean
[]
(local-rule "clean"))
(defn- install
(defn install
[&opt repo]
(if repo
(install-git repo)
(local-rule "install")))
(defn- test
(defn test
[]
(local-rule "test"))
@@ -941,25 +1071,55 @@ Flags are:
(uninstall what)
(local-rule "uninstall")))
(defn- deps
(defn deps
[]
(local-rule "install-deps"))
(local-rule "install-deps" true))
(defn- list-rules
[]
(defn show-rule-tree
[&opt root depth]
(import-rules "./project.janet")
(def max-depth (if depth (scan-number depth) math/inf))
(if root
(print-rule-tree root max-depth "" "")
(let [ks (sort (seq [k :keys (dyn :rules)] k))]
(each k ks (print-rule-tree k max-depth "" "")))))
(defn list-rules
[&opt ctx]
(import-rules "./project.janet" true)
(def ks (sort (seq [k :keys (dyn :rules)] k)))
(each k ks (print k)))
(defn- update-pkgs
(defn update-pkgs
[]
(install-git (dyn :pkglist default-pkglist)))
(defn- quickbin
(defn quickbin
[input output]
(create-executable @{} input output)
(do-rule output))
(defn jpm-repl
[]
(def env
(try
(require-jpm "./project.janet")
([err f]
(if (= "cannot open ./project.janet" err)
(put (make-jpm-env) :project {})
(propagate err f)))))
(setdyn :pretty-format (if-not (dyn :nocolor) "%.20Q" "%.20q"))
(setdyn :err-color (if-not (dyn :nocolor) true))
(def p (env :project))
(def name (p :name))
(if name (print "Project: " name))
(if-let [r (p :repo)] (print "Repository: " r))
(if-let [a (p :author)] (print "Author: " a))
(defn getchunk [buf p]
(def [line] (parser/where p))
(getline (string "jpm[" (or name "repl") "]:" line ":" (parser/state p :delimiters) "> ") buf env))
(repl getchunk nil env))
(def- subcommands
{"build" build
"clean" clean
@@ -968,12 +1128,16 @@ Flags are:
"test" test
"help" help
"deps" deps
"repl" jpm-repl
"rule-tree" show-rule-tree
"show-paths" show-paths
"clear-cache" clear-cache
"run" local-rule
"rules" list-rules
"update-pkgs" update-pkgs
"uninstall" uninstall-cmd
"make-lockfile" make-lockfile
"load-lockfile" load-lockfile
"quickbin" quickbin})
(def- args (tuple/slice (dyn :args) 1))

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\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 %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
@@ -168,7 +131,7 @@ exit /b 0
@rem Run the installer. (Installs to the local user with default settings)
:INSTALL
@echo Running Installer...
FOR %%a in (janet-*-windows-installer.exe) DO (
FOR %%a in (janet-*-windows-*-installer.exe) DO (
%%a /S /CurrentUser
)
exit /b 0

View File

@@ -1,20 +1,18 @@
###
### A useful debugger library for Janet. Should be used
### inside a debug repl.
### inside a debug repl. This has been moved into the core.
###
(defn .fiber
"Get the current fiber being debugged."
[]
(if-let [entry (dyn '_fiber)]
(entry :value)
(dyn :fiber)))
(dyn :fiber))
(defn .stack
"Print the current fiber stack"
[]
(print)
(debug/stacktrace (.fiber) "")
(with-dyns [:err-color false] (debug/stacktrace (.fiber) ""))
(print))
(defn .frame

View File

@@ -1,3 +1,6 @@
# This file is invoked by build_win.bat
# Relevant configuration variables are set there.
Unicode True
!echo "Program Files: ${PROGRAMFILES}"
@@ -20,6 +23,9 @@ VIFileVersion "${PRODUCT_VERSION}"
!if ${SIXTYFOUR} == "true"
!define MULTIUSER_USE_PROGRAMFILES64
!define PLATNAME "x64"
!else
!define PLATNAME "x86"
!endif
# Includes
@@ -36,12 +42,12 @@ Name "Janet"
!define DOLLAR "$"
!ifdef CHECK_${DOLLAR}%APPVEYOR_REPO_TAG_NAME%
# We are not in the appveyor environment, use version name
!define OUTNAME_PART v${VERSION}
!define OUTNAME_PART ${VERSION}
!else
# We are in appveyor, use git tag name for installer
!define OUTNAME_PART ${OUTNAME}
!endif
OutFile "janet-${OUTNAME_PART}-windows-installer.exe"
OutFile "janet-${OUTNAME_PART}-windows-${PLATNAME}-installer.exe"
# Some Configuration
!define APPNAME "Janet"

114
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,110 @@ 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 Ctrl\-G
Show documentation for the current symbol under 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
@@ -48,6 +152,12 @@ Read raw input from stdin and forgo prompt history and other readline-like featu
Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier
arguments are executed before later ones.
.TP
.BR \-d
Enable debug mode. On all terminating signals as well the debug signal, this will
cause the debugger to come up in the REPL. Same as calling (setdyn :debug true) in a
default repl.
.TP
.BR \-n
Disable ANSI colors in the repl. Has no effect if no repl is run.

33
jpm.1
View File

@@ -24,6 +24,10 @@ More interesting are the local commands. For more information on jpm usage, see
.SH FLAGS
.TP
.BR \-\-nocolor
Disable color in the jpm repl.
.TP
.BR \-\-verbose
Print detailed messages of what jpm is doing, including compilation commands and other shell commands.
@@ -32,6 +36,12 @@ Print detailed messages of what jpm is doing, including compilation commands and
.BR \-\-test
If passed to jpm install, runs tests before installing. Will run tests recursively on dependencies.
.TP
.BR \-\-offline
Prevents jpm from going to network to get dependencies - all dependencies should be in the cache or this command will fail.
Use this flag with the deps and update-pkgs subcommands. This is not a surefire way to prevent a build script from accessing
the network, for example, a build script that invokes curl will still have network access.
.SH OPTIONS
.TP
@@ -139,6 +149,12 @@ 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 rule-tree\ [\fBroot\fR] [\fdepth\fR]
Show rule dependency tree in a pretty format. Optionally provide a rule to use as the tree
root, as well as a max depth to print. By default, prints the full tree for all rules. This
can be quite long, so it is recommended to give a root rule.
.TP
.BR show-paths
Show all of the paths used when installing and building artifacts.
@@ -154,6 +170,23 @@ The main function is the entry point of the program and will receive command lin
as function arguments. The entry file can import other modules, including native C modules, and
jpm will attempt to include the dependencies into the generated executable.
.TP
.BR repl
Load the current project.janet file and start a repl in it's environment. This lets a user better
debug the project file, as well as run rules manually.
.TP
.BR make-lockfile\ [\fBfilename\fR]
Create a lockfile. A lockfile is a record that describes what dependencies were installed at the
time of the lockfile's creation, including exact versions. A lockfile can then be later used
to set up that environment on a different machine via load-lockfile. By default, the lockfile
is created at lockfile.jdn, although any path can be used.
.TP
.BR load-lockfile\ [\fBfilename\fR]
Install dependencies from a lockfile previously created with make-lockfile. By default, will look
for a lockfile at lockfile.jdn, although any path can be used.
.SH ENVIRONMENT
.B JANET_PATH

View File

@@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.6.1-dev')
version : '1.9.0-dev')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -79,13 +79,6 @@ 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 = [
@@ -151,26 +144,31 @@ 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, meson.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],
version: meson.project_version(),
soversion: version_parts[0] + '.' + version_parts[1],
install : true)
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
@@ -188,14 +186,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,
@@ -211,25 +209,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',
@@ -239,7 +218,8 @@ test_files = [
'test/suite4.janet',
'test/suite5.janet',
'test/suite6.janet',
'test/suite7.janet'
'test/suite7.janet',
'test/suite8.janet'
]
foreach t : test_files
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
@@ -252,6 +232,11 @@ run_target('repl', command : [janet_nativeclient])
janet_dep = declare_dependency(include_directories : incdir,
link_with : libjanet)
# pkgconfig
pkg = import('pkgconfig')
pkg.generate(libjanet,
description: 'Library for the Janet programming language.')
# Installation
install_man('janet.1')
install_man('jpm.1')

View File

@@ -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,42 @@ 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, (int32_t) boot_size, boot_filename, NULL);
free(boot_buffer);
/* Deinitialize vm */
janet_deinit();

File diff suppressed because it is too large Load Diff

View File

@@ -50,5 +50,20 @@ int system_test() {
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
Janet *t1 = janet_tuple_begin(3);
t1[0] = janet_wrap_nil();
t1[1] = janet_wrap_integer(4);
t1[2] = janet_cstringv("hi");
Janet tuple1 = janet_wrap_tuple(janet_tuple_end(t1));
Janet *t2 = janet_tuple_begin(3);
t2[0] = janet_wrap_nil();
t2[1] = janet_wrap_integer(4);
t2[2] = janet_cstringv("hi");
Janet tuple2 = janet_wrap_tuple(janet_tuple_end(t2));
assert(janet_equals(tuple1, tuple2));
return 0;
}

View File

@@ -27,10 +27,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 6
#define JANET_VERSION_PATCH 1
#define JANET_VERSION_EXTRA "-dev"
#define JANET_VERSION "1.6.1-dev"
#define JANET_VERSION_MINOR 9
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.9.0-dev"
/* #define JANET_BUILD "local" */

View File

@@ -56,7 +56,7 @@ JanetArray *janet_array_n(const Janet *elements, int32_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;
}
@@ -235,10 +235,12 @@ static Janet cfun_array_insert(int32_t argc, Janet *argv) {
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];
}

View File

@@ -87,6 +87,8 @@ static const JanetInstructionDef janet_ops[] = {
{"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},
@@ -106,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},
@@ -118,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},
@@ -702,6 +707,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
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) * (size_t) count);
if (NULL == def->sourcemap) {
JANET_OUT_OF_MEMORY;
}
for (i = 0; i < count; i++) {
const Janet *tup;
Janet entry = arr[i];
@@ -725,6 +733,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
/* Set environments */
def->environments =
realloc(def->environments, def->environments_length * sizeof(int32_t));
if (NULL == def->environments) {
JANET_OUT_OF_MEMORY;
}
/* Verify the func def */
if (janet_verify(def)) {

View File

@@ -32,7 +32,7 @@
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
uint8_t *data = NULL;
if (capacity > 0) {
janet_vm_next_collection += capacity;
janet_gcpressure(capacity);
data = malloc(sizeof(uint8_t) * (size_t) capacity);
if (NULL == data) {
JANET_OUT_OF_MEMORY;
@@ -62,7 +62,7 @@ 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;
janet_gcpressure(capacity - buffer->capacity);
new_data = realloc(old, (size_t) capacity * sizeof(uint8_t));
if (NULL == new_data) {
JANET_OUT_OF_MEMORY;
@@ -94,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;
}
@@ -112,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;
@@ -333,16 +334,20 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
} else {
length_src = src.len - offset_src;
}
int64_t last = ((int64_t) offset_dest - offset_src) + length_src;
int64_t last = (int64_t) offset_dest + length_src;
if (last > INT32_MAX)
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);
int32_t last32 = (int32_t) last;
janet_buffer_ensure(dest, last32, 2);
if (last32 > dest->count) dest->count = last32;
if (length_src) {
if (same_buf) {
/* janet_buffer_ensure may have invalidated src */
src.bytes = dest->data;
memmove(dest->data + offset_dest, src.bytes + offset_src, length_src);
} else {
memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src);
}
}
return argv[0];
}
@@ -384,7 +389,7 @@ static const JanetReg buffer_cfuns[] = {
"buffer/push-word", cfun_buffer_word,
JDOC("(buffer/push-word buffer x)\n\n"
"Append a machine word to a buffer. The 4 bytes of the integer are appended "
"in twos complement, big endian order, unsigned. Returns the modified buffer. Will "
"in twos complement, little endian order, unsigned. Returns the modified buffer. Will "
"throw an error if the buffer overflows.")
},
{
@@ -435,7 +440,7 @@ static const JanetReg buffer_cfuns[] = {
},
{
"buffer/blit", cfun_buffer_blit,
JDOC("(buffer/blit dest src & opt dest-start src-start src-end)\n\n"
JDOC("(buffer/blit dest src &opt dest-start src-start src-end)\n\n"
"Insert the contents of src into dest. Can optionally take indices that "
"indicate which part of src to copy into which part of dest. Indices can be "
"negative to index from the end of src or dest. Returns dest.")

View File

@@ -41,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, */
@@ -56,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, */
@@ -95,7 +99,8 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
JINT_S, /* JOP_MAKE_TUPLE */
JINT_S, /* JOP_MAKE_BRACKET_TUPLE */
JINT_SSS, /* JOP_GREATER_THAN_EQUAL */
JINT_SSS /* JOP_LESS_THAN_EQUAL */
JINT_SSS, /* JOP_LESS_THAN_EQUAL */
JINT_SSS, /* JOP_NEXT */
};
/* Verify some bytecode */
@@ -207,6 +212,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
def->environments = NULL;
def->constants = NULL;
def->bytecode = NULL;
def->closure_bitset = NULL;
def->flags = 0;
def->slotcount = 0;
def->arity = 0;

View File

@@ -54,7 +54,7 @@ void janet_panicf(const char *format, ...) {
while (format[len]) len++;
janet_buffer_init(&buffer, len);
va_start(args, format);
janet_formatb(&buffer, format, args);
janet_formatbv(&buffer, format, args);
va_end(args);
ret = janet_string(buffer.data, buffer.count);
janet_buffer_deinit(&buffer);
@@ -235,18 +235,20 @@ size_t janet_getsize(const Janet *argv, int32_t n) {
int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which) {
int32_t raw = janet_getinteger(argv, n);
if (raw < 0) raw += length + 1;
if (raw < 0 || raw > length)
janet_panicf("%s index %d out of range [0,%d]", which, raw, length);
return raw;
int32_t not_raw = raw;
if (not_raw < 0) not_raw += length + 1;
if (not_raw < 0 || not_raw > length)
janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length);
return not_raw;
}
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
int32_t raw = janet_getinteger(argv, n);
if (raw < 0) raw += length;
if (raw < 0 || raw > length)
janet_panicf("%s index %d out of range [0,%d)", which, raw, length);
return raw;
int32_t not_raw = raw;
if (not_raw < 0) not_raw += length;
if (not_raw < 0 || not_raw > length)
janet_panicf("%s index %d out of range [%d,%d)", which, raw, -length, length);
return not_raw;
}
JanetView janet_getindexed(const Janet *argv, int32_t n) {

View File

@@ -28,6 +28,11 @@
#include "vector.h"
#endif
static int arity1or2(JanetFopts opts, JanetSlot *args) {
(void) opts;
int32_t arity = janet_v_count(args);
return arity == 1 || arity == 2;
}
static int fixarity1(JanetFopts opts, JanetSlot *args) {
(void) opts;
return janet_v_count(args) == 1;
@@ -63,6 +68,28 @@ static JanetSlot genericSSI(JanetFopts opts, int op, JanetSlot s, int32_t imm) {
return target;
}
/* Emit an insruction that implements a form by itself. */
static JanetSlot opfunction(
JanetFopts opts,
JanetSlot *args,
int op,
Janet defaultArg2) {
JanetCompiler *c = opts.compiler;
int32_t len;
len = janet_v_count(args);
JanetSlot t;
if (len == 1) {
t = janetc_gettarget(opts);
janetc_emit_sss(c, op, t, args[0], janetc_cslot(defaultArg2), 1);
return t;
} else {
/* len == 2 */
t = janetc_gettarget(opts);
janetc_emit_sss(c, op, t, args[0], args[1], 1);
}
return t;
}
/* Emit a series of instructions instead of a function call to a math op */
static JanetSlot opreduce(
JanetFopts opts,
@@ -112,6 +139,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 opfunction(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);
@@ -134,7 +170,7 @@ static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
}
}
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_RESUME, janet_wrap_nil());
return opfunction(opts, args, JOP_RESUME, janet_wrap_nil());
}
static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
/* Push phase */
@@ -261,7 +297,7 @@ static const JanetFunOptimizer optimizers[] = {
{fixarity1, do_error},
{minarity2, do_apply},
{maxarity1, do_yield},
{fixarity2, do_resume},
{arity1or2, do_resume},
{fixarity2, do_in},
{fixarity3, do_put},
{fixarity1, do_length},
@@ -283,7 +319,10 @@ static const JanetFunOptimizer optimizers[] = {
{NULL, do_eq},
{NULL, do_neq},
{fixarity2, do_propagate},
{fixarity2, do_get}
{fixarity2, do_get},
{arity1or2, do_next},
{fixarity2, do_modulo},
{fixarity2, do_remainder},
};
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {

View File

@@ -102,6 +102,7 @@ void janetc_scope(JanetScope *s, JanetCompiler *c, int flags, const char *name)
scope.bytecode_start = janet_v_count(c->buffer);
scope.flags = flags;
scope.parent = c->scope;
janetc_regalloc_init(&scope.ua);
/* Inherit slots */
if ((!(flags & JANET_SCOPE_FUNCTION)) && c->scope) {
janetc_regalloc_clone(&scope.ra, &(c->scope->ra));
@@ -149,6 +150,7 @@ void janetc_popscope(JanetCompiler *c) {
janet_v_free(oldscope->envs);
janet_v_free(oldscope->defs);
janetc_regalloc_deinit(&oldscope->ra);
janetc_regalloc_deinit(&oldscope->ua);
/* Update pointer */
if (newscope)
newscope->child = NULL;
@@ -202,7 +204,7 @@ JanetSlot janetc_resolve(
switch (btype) {
default:
case JANET_BINDING_NONE:
janetc_error(c, janet_formatc("unknown symbol %q", sym));
janetc_error(c, janet_formatc("unknown symbol %q", janet_wrap_symbol(sym)));
return janetc_cslot(janet_wrap_nil());
case JANET_BINDING_DEF:
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
@@ -236,6 +238,11 @@ found:
scope = scope->parent;
janet_assert(scope, "invalid scopes");
scope->flags |= JANET_SCOPE_ENV;
/* In the function scope, allocate the slot as an upvalue */
janetc_regalloc_touch(&scope->ua, ret.index);
/* Iterate through child scopes and make sure environment is propagated */
scope = scope->child;
/* Propagate env up to current scope */
@@ -455,6 +462,7 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
break;
case JANET_CFUNCTION:
case JANET_ABSTRACT:
case JANET_NIL:
break;
case JANET_KEYWORD:
if (min_arity == 0) {
@@ -713,7 +721,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
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) * (size_t) def->bytecode_length;
@@ -721,7 +729,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
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;
}
}
@@ -736,6 +744,21 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV;
}
/* Copy upvalue bitset */
if (scope->ua.count) {
/* Number of u32s we need to create a bitmask for all slots */
int32_t numchunks = (def->slotcount + 31) >> 5;
uint32_t *chunks = malloc(sizeof(uint32_t) * numchunks);
if (NULL == chunks) {
JANET_OUT_OF_MEMORY;
}
memcpy(chunks, scope->ua.chunks, sizeof(uint32_t) * numchunks);
/* Register allocator preallocates some registers [240-255, high 16 bits of chunk index 7], we can ignore those. */
if (scope->ua.count > 7) chunks[7] &= 0xFFFFU;
def->closure_bitset = chunks;
def->flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
}
/* Pop the scope */
janetc_popscope(c);

View File

@@ -57,6 +57,9 @@
#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;
@@ -124,7 +127,10 @@ struct JanetScope {
/* Regsiter allocator */
JanetcRegisterAllocator ra;
/* Referenced closure environents. The values at each index correspond
/* Upvalue allocator */
JanetcRegisterAllocator ua;
/* Referenced closure environments. The values at each index correspond
* to which index to get the environment from in the parent. The environment
* that corresponds to the direct parent's stack will always have value 0. */
int32_t *envs;

View File

@@ -346,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);
}
@@ -427,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]));
@@ -449,7 +435,7 @@ static Janet janet_core_hash(int32_t argc, Janet *argv) {
static Janet janet_core_getline(int32_t argc, Janet *argv) {
FILE *in = janet_dynfile("in", stdin);
FILE *out = janet_dynfile("out", stdout);
janet_arity(argc, 0, 2);
janet_arity(argc, 0, 3);
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
if (argc >= 1) {
const char *prompt = (const char *) janet_getstring(argv, 0);
@@ -503,6 +489,31 @@ ret_false:
return janet_wrap_false();
}
static Janet janet_core_signal(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
int sig;
if (janet_checkint(argv[0])) {
int32_t s = janet_unwrap_integer(argv[0]);
if (s < 0 || s > 9) {
janet_panicf("expected user signal between 0 and 9, got %d", s);
}
sig = JANET_SIGNAL_USER0 + s;
} else {
JanetKeyword kw = janet_getkeyword(argv, 0);
if (!janet_cstrcmp(kw, "yield")) {
sig = JANET_SIGNAL_YIELD;
} else if (!janet_cstrcmp(kw, "error")) {
sig = JANET_SIGNAL_ERROR;
} else if (!janet_cstrcmp(kw, "debug")) {
sig = JANET_SIGNAL_DEBUG;
} else {
janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
}
}
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
janet_signalv(sig, payload);
}
static const JanetReg corelib_cfuns[] = {
{
"native", janet_core_native,
@@ -613,11 +624,10 @@ static const JanetReg corelib_cfuns[] = {
{
"type", janet_core_type,
JDOC("(type x)\n\n"
"Returns the type of x as a keyword symbol. x is one of\n"
"Returns the type of x as a keyword. x is one of\n"
"\t:nil\n"
"\t:boolean\n"
"\t:integer\n"
"\t:real\n"
"\t:number\n"
"\t:array\n"
"\t:tuple\n"
"\t:table\n"
@@ -628,16 +638,7 @@ static const JanetReg corelib_cfuns[] = {
"\t:keyword\n"
"\t:function\n"
"\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. ")
"or another keyword for an abstract type.")
},
{
"hash", janet_core_hash,
@@ -648,8 +649,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 auto-complete. "
"Returns the modified buffer. "
"Use this function to implement a simple interface for a terminal program.")
},
{
@@ -682,7 +685,7 @@ static const JanetReg corelib_cfuns[] = {
"\t:all:\tthe value of path verbatim\n"
"\t:cur:\tthe current file, or (dyn :current-file)\n"
"\t:dir:\tthe directory containing the current file\n"
"\t:name:\tthe filename component of path, with extenion if given\n"
"\t:name:\tthe filename component of path, with extension if given\n"
"\t:native:\tthe extension used to load natives, .so or .dll\n"
"\t:sys:\tthe system path, or (syn :syspath)")
},
@@ -699,7 +702,12 @@ static const JanetReg corelib_cfuns[] = {
{
"slice", janet_core_slice,
JDOC("(slice x &opt start end)\n\n"
"Extract a sub-range of an indexed data strutrue or byte sequence.")
"Extract a sub-range of an indexed data structure or byte sequence.")
},
{
"signal", janet_core_signal,
JDOC("(signal what x)\n\n"
"Raise a signal with payload x. ")
},
{NULL, NULL, NULL}
};
@@ -948,6 +956,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 */
/*
@@ -990,6 +1010,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, 1, 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"
@@ -1095,22 +1131,22 @@ JanetTable *janet_core_env(JanetTable *replacements) {
/* Variadic comparators */
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."));
"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."));
"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."));
"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."));
"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 numerically equal (4.0 == 4). Returns a boolean."));
"Check if all values in xs are equal. Returns a boolean."));
templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS,
JDOC("(not= & xs)\n\n"
"Check if any values in xs are not numerically equal (3.0 not== 4). Returns a boolean."));
"Check if any values in xs are not equal. Returns a boolean."));
/* Platform detection */
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),

View File

@@ -275,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

@@ -29,4 +29,9 @@
#define _POSIX_C_SOURCE 200112L
#endif
/* Needed for realpath on linux */
#if !defined(_XOPEN_SOURCE) && (defined(__linux__) || defined(__EMSCRIPTEN__))
#define _XOPEN_SOURCE 500
#endif
#endif

View File

@@ -65,7 +65,14 @@ 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));
if (argv) {
memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
} else {
/* If argv not given, fill with nil */
for (int32_t i = 0; i < argc; i++) {
fiber->data[fiber->stacktop + i] = janet_wrap_nil();
}
}
fiber->stacktop = newstacktop;
}
if (janet_fiber_funcframe(fiber, callee)) return NULL;
@@ -135,7 +142,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;
}
@@ -211,18 +218,79 @@ 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) * (size_t) env->length;
janet_env_valid(env);
int32_t len = env->length;
size_t s = sizeof(Janet) * (size_t) len;
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);
Janet *values = env->as.fiber->data + env->offset;
safe_memcpy(vmem, values, s);
uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset;
if (bitset) {
/* Clear unneeded references in closure environment */
for (int32_t i = 0; i < len; i += 32) {
uint32_t mask = ~(bitset[i >> 5]);
int32_t maxj = i + 32 > len ? len : i + 32;
for (int32_t j = i; j < maxj; j++) {
if (mask & 1) vmem[j] = janet_wrap_nil();
mask >>= 1;
}
}
}
env->offset = 0;
env->as.values = vmem;
}
}
/* Validate potentially untrusted func env (unmarshalled envs are difficult to verify) */
int janet_env_valid(JanetFuncEnv *env) {
if (env->offset < 0) {
int32_t real_offset = -(env->offset);
JanetFiber *fiber = env->as.fiber;
int32_t i = fiber->frame;
while (i > 0) {
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
if (real_offset == i &&
frame->env == env &&
frame->func &&
frame->func->def->slotcount == env->length) {
env->offset = real_offset;
return 1;
}
i = frame->prevframe;
}
/* Invalid, set to empty off-stack variant. */
env->offset = 0;
env->length = 0;
env->as.values = NULL;
return 0;
} else {
return 1;
}
}
/* Detach a fiber from the env if the target fiber has stopped mutating */
void janet_env_maybe_detach(JanetFuncEnv *env) {
/* Check for detachable closure envs */
janet_env_valid(env);
if (env->offset > 0) {
JanetFiberStatus s = janet_fiber_status(env->as.fiber);
int isFinished = s == JANET_STATUS_DEAD ||
s == JANET_STATUS_ERROR ||
s == JANET_STATUS_USER0 ||
s == JANET_STATUS_USER1 ||
s == JANET_STATUS_USER2 ||
s == JANET_STATUS_USER3 ||
s == JANET_STATUS_USER4;
if (isFinished) {
janet_env_detach(env);
}
}
}
/* Create a tail frame for a function */
int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
int32_t i;
@@ -362,10 +430,10 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
JanetFunction *func = janet_getfunction(argv, 0);
JanetFiber *fiber;
if (func->def->min_arity != 0) {
janet_panic("expected nullary function in fiber constructor");
if (func->def->min_arity > 1) {
janet_panicf("fiber function must accept 0 or 1 arguments");
}
fiber = janet_fiber(func, 64, 0, NULL);
fiber = janet_fiber(func, 64, func->def->min_arity, NULL);
if (argc == 2) {
int32_t i;
JanetByteView view = janet_getbytes(argv, 1);
@@ -377,7 +445,7 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
} else {
switch (view.bytes[i]) {
default:
janet_panicf("invalid flag %c, expected a, d, e, u, or y", view.bytes[i]);
janet_panicf("invalid flag %c, expected a, t, d, e, u, y, i, or p", view.bytes[i]);
break;
case 'a':
fiber->flags |=
@@ -386,6 +454,15 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
JANET_FIBER_MASK_USER |
JANET_FIBER_MASK_YIELD;
break;
case 't':
fiber->flags |=
JANET_FIBER_MASK_ERROR |
JANET_FIBER_MASK_USER0 |
JANET_FIBER_MASK_USER1 |
JANET_FIBER_MASK_USER2 |
JANET_FIBER_MASK_USER3 |
JANET_FIBER_MASK_USER4;
break;
case 'd':
fiber->flags |= JANET_FIBER_MASK_DEBUG;
break;
@@ -448,6 +525,20 @@ static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
JanetFiberStatus s = janet_fiber_status(fiber);
int isFinished = s == JANET_STATUS_DEAD ||
s == JANET_STATUS_ERROR ||
s == JANET_STATUS_USER0 ||
s == JANET_STATUS_USER1 ||
s == JANET_STATUS_USER2 ||
s == JANET_STATUS_USER3 ||
s == JANET_STATUS_USER4;
return janet_wrap_boolean(!isFinished);
}
static const JanetReg fiber_cfuns[] = {
{
"fiber/new", cfun_fiber_new,
@@ -463,6 +554,7 @@ static const JanetReg fiber_cfuns[] = {
"\ta - block all signals\n"
"\td - block debug signals\n"
"\te - block error signals\n"
"\tt - block termination signals: error + user[0-4]\n"
"\tu - block user signals\n"
"\ty - block yield signals\n"
"\t0-9 - block a specific user signal\n\n"
@@ -513,6 +605,11 @@ static const JanetReg fiber_cfuns[] = {
"Sets the environment table for a fiber. Set to nil to remove the current "
"environment.")
},
{
"fiber/can-resume?", cfun_fiber_can_resume,
JDOC("(fiber/can-resume? fiber)\n\n"
"Check if a fiber is finished and cannot be resumed.")
},
{NULL, NULL, NULL}
};

View File

@@ -73,5 +73,7 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func);
int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func);
void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun);
void janet_fiber_popframe(JanetFiber *fiber);
void janet_env_maybe_detach(JanetFuncEnv *env);
int janet_env_valid(JanetFuncEnv *env);
#endif

View File

@@ -27,8 +27,14 @@
#include "symcache.h"
#include "gc.h"
#include "util.h"
#include "fiber.h"
#endif
struct JanetScratch {
JanetScratchFinalizer finalize;
long long mem[]; /* for proper alignment */
};
/* GC State */
JANET_THREAD_LOCAL void *janet_vm_blocks;
JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
@@ -41,14 +47,7 @@ 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;
@@ -69,6 +68,11 @@ static void janet_mark_abstract(void *adata);
static JANET_THREAD_LOCAL uint32_t depth = JANET_RECURSION_GUARD;
static JANET_THREAD_LOCAL size_t orig_rootcount;
/* Hint to the GC that we may need to collect */
void janet_gcpressure(size_t s) {
janet_vm_next_collection += s;
}
/* Mark a value */
void janet_mark(Janet x) {
if (depth) {
@@ -186,7 +190,10 @@ static void janet_mark_funcenv(JanetFuncEnv *env) {
if (janet_gc_reachable(env))
return;
janet_gc_mark(env);
if (env->offset) {
/* If closure env references a dead fiber, we can just copy out the stack frame we need so
* we don't need to keep around the whole dead fiber. */
janet_env_maybe_detach(env);
if (env->offset > 0) {
/* On stack */
janet_mark_fiber(env->as.fiber);
} else {
@@ -302,6 +309,7 @@ static void janet_deinit_block(JanetGCObject *mem) {
free(def->constants);
free(def->bytecode);
free(def->sourcemap);
free(def->closure_bitset);
}
break;
}
@@ -355,11 +363,11 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
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 */
@@ -370,6 +378,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;
@@ -473,26 +486,26 @@ 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_t) -1 / size) {
if (nmemb && size > SIZE_MAX / nmemb) {
JANET_OUT_OF_MEMORY;
}
size_t n = nmemb * size;
@@ -503,16 +516,16 @@ void *janet_scalloc(size_t nmemb, size_t size) {
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;
}
@@ -520,19 +533,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

@@ -81,7 +81,7 @@ static void it_u64_tostring(void *p, JanetBuffer *buffer) {
janet_buffer_push_cstring(buffer, str);
}
static const JanetAbstractType it_s64_type = {
const JanetAbstractType janet_s64_type = {
"core/s64",
NULL,
NULL,
@@ -91,10 +91,11 @@ static const JanetAbstractType it_s64_type = {
int64_unmarshal,
it_s64_tostring,
janet_int64_compare,
janet_int64_hash
janet_int64_hash,
JANET_ATEND_HASH
};
static const JanetAbstractType it_u64_type = {
const JanetAbstractType janet_u64_type = {
"core/u64",
NULL,
NULL,
@@ -104,7 +105,8 @@ static const JanetAbstractType it_u64_type = {
int64_unmarshal,
it_u64_tostring,
janet_uint64_compare,
janet_int64_hash
janet_int64_hash,
JANET_ATEND_HASH
};
int64_t janet_unwrap_s64(Janet x) {
@@ -126,8 +128,8 @@ int64_t janet_unwrap_s64(Janet x) {
}
case JANET_ABSTRACT: {
void *abst = janet_unwrap_abstract(x);
if (janet_abstract_type(abst) == &it_s64_type ||
(janet_abstract_type(abst) == &it_u64_type))
if (janet_abstract_type(abst) == &janet_s64_type ||
(janet_abstract_type(abst) == &janet_u64_type))
return *(int64_t *)abst;
break;
}
@@ -155,8 +157,8 @@ uint64_t janet_unwrap_u64(Janet x) {
}
case JANET_ABSTRACT: {
void *abst = janet_unwrap_abstract(x);
if (janet_abstract_type(abst) == &it_s64_type ||
(janet_abstract_type(abst) == &it_u64_type))
if (janet_abstract_type(abst) == &janet_s64_type ||
(janet_abstract_type(abst) == &janet_u64_type))
return *(uint64_t *)abst;
break;
}
@@ -168,19 +170,19 @@ uint64_t janet_unwrap_u64(Janet x) {
JanetIntType janet_is_int(Janet x) {
if (!janet_checktype(x, JANET_ABSTRACT)) return JANET_INT_NONE;
const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x));
return (at == &it_s64_type) ? JANET_INT_S64 :
((at == &it_u64_type) ? JANET_INT_U64 :
return (at == &janet_s64_type) ? JANET_INT_S64 :
((at == &janet_u64_type) ? JANET_INT_U64 :
JANET_INT_NONE);
}
Janet janet_wrap_s64(int64_t x) {
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
*box = (int64_t)x;
return janet_wrap_abstract(box);
}
Janet janet_wrap_u64(uint64_t x) {
uint64_t *box = janet_abstract(&it_u64_type, sizeof(uint64_t));
uint64_t *box = janet_abstract(&janet_u64_type, sizeof(uint64_t));
*box = (uint64_t)x;
return janet_wrap_abstract(box);
}
@@ -198,51 +200,52 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
#define OPMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
T *box = janet_abstract(&janet_##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(&janet_##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)); \
T *box = janet_abstract(&janet_##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(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \
T value = janet_unwrap_##type(argv[0]); \
if (value == 0) janet_panic("division by zero"); \
*box oper##= value; \
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)); \
T *box = janet_abstract(&janet_##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"); \
@@ -250,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(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \
T value = janet_unwrap_##type(argv[0]); \
if (value == 0) janet_panic("division by zero"); \
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
*box oper##= value; \
return janet_wrap_abstract(box); \
}
} \
#define COMPMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
@@ -271,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(&janet_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(&janet_s64_type, sizeof(int64_t));
int64_t op1 = janet_unwrap_s64(argv[0]);
int64_t op2 = janet_unwrap_s64(argv[1]);
int64_t x = op1 % op2;
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, ^)
@@ -290,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, ^)
@@ -312,10 +350,17 @@ 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},
@@ -323,31 +368,30 @@ static JanetMethod it_s64_methods[] = {
{"=", 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},
@@ -355,22 +399,14 @@ static JanetMethod it_u64_methods[] = {
{"=", 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}
};
@@ -405,8 +441,8 @@ static const JanetReg it_cfuns[] = {
/* Module entry point */
void janet_lib_inttypes(JanetTable *env) {
janet_core_cfuns(env, NULL, it_cfuns);
janet_register_abstract_type(&it_s64_type);
janet_register_abstract_type(&it_u64_type);
janet_register_abstract_type(&janet_s64_type);
janet_register_abstract_type(&janet_u64_type);
}
#endif

View File

@@ -33,26 +33,15 @@
#include <sys/wait.h>
#endif
typedef struct IOFile IOFile;
struct IOFile {
FILE *file;
int flags;
};
static int cfun_io_gc(void *p, size_t len);
static int io_file_get(void *p, Janet key, Janet *out);
JanetAbstractType cfun_io_filetype = {
const JanetAbstractType janet_file_type = {
"core/file",
cfun_io_gc,
NULL,
io_file_get,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL
JANET_ATEND_GET
};
/* Check arguments to fopen */
@@ -95,7 +84,7 @@ static int checkflags(const uint8_t *str) {
}
static Janet makef(FILE *f, int flags) {
IOFile *iof = (IOFile *) janet_abstract(&cfun_io_filetype, sizeof(IOFile));
JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile));
iof->file = f;
iof->flags = flags;
return janet_wrap_abstract(iof);
@@ -162,38 +151,8 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
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 = JANET_FILE_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 & JANET_FILE_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) {
static void read_chunk(JanetFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
if (!(iof->flags & (JANET_FILE_READ | JANET_FILE_UPDATE)))
janet_panic("file is not readable");
janet_buffer_extra(buffer, nBytesMax);
@@ -207,7 +166,7 @@ static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
/* Read a certain number of bytes into memory */
static Janet cfun_io_fread(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed");
JanetBuffer *buffer;
if (argc == 2) {
@@ -247,7 +206,7 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
/* Write bytes to a file */
static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
janet_arity(argc, 1, -1);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
@@ -270,7 +229,7 @@ static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
/* Flush the bytes in the file */
static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
@@ -283,7 +242,7 @@ static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
/* Cleanup a file */
static int cfun_io_gc(void *p, size_t len) {
(void) len;
IOFile *iof = (IOFile *)p;
JanetFile *iof = (JanetFile *)p;
if (!(iof->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
return fclose(iof->file);
}
@@ -293,9 +252,9 @@ static int cfun_io_gc(void *p, size_t len) {
/* Close a file */
static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
return janet_wrap_nil();
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
janet_panic("file not closable");
if (iof->flags & JANET_FILE_PIPED) {
@@ -317,7 +276,7 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
/* Seek a file */
static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
long int offset = 0;
@@ -343,7 +302,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},
@@ -362,8 +320,8 @@ FILE *janet_dynfile(const char *name, FILE *def) {
Janet x = janet_dyn(name);
if (!janet_checktype(x, JANET_ABSTRACT)) return def;
void *abstract = janet_unwrap_abstract(x);
if (janet_abstract_type(abstract) != &cfun_io_filetype) return def;
IOFile *iofile = abstract;
if (janet_abstract_type(abstract) != &janet_file_type) return def;
JanetFile *iofile = abstract;
return iofile->file;
}
@@ -390,9 +348,9 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
break;
case JANET_ABSTRACT: {
void *abstract = janet_unwrap_abstract(x);
if (janet_abstract_type(abstract) != &cfun_io_filetype)
if (janet_abstract_type(abstract) != &janet_file_type)
return janet_wrap_nil();
IOFile *iofile = abstract;
JanetFile *iofile = abstract;
f = iofile->file;
break;
}
@@ -457,9 +415,9 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
break;
case JANET_ABSTRACT: {
void *abstract = janet_unwrap_abstract(x);
if (janet_abstract_type(abstract) != &cfun_io_filetype)
if (janet_abstract_type(abstract) != &janet_file_type)
return janet_wrap_nil();
IOFile *iofile = abstract;
JanetFile *iofile = abstract;
f = iofile->file;
break;
}
@@ -496,6 +454,38 @@ static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
}
static void janet_flusher(const char *name, FILE *dflt_file) {
Janet x = janet_dyn(name);
switch (janet_type(x)) {
default:
break;
case JANET_NIL:
fflush(dflt_file);
break;
case JANET_ABSTRACT: {
void *abstract = janet_unwrap_abstract(x);
if (janet_abstract_type(abstract) != &janet_file_type) break;
JanetFile *iofile = abstract;
fflush(iofile->file);
break;
}
}
}
static Janet cfun_io_flush(int32_t argc, Janet *argv) {
janet_fixarity(argc, 0);
(void) argv;
janet_flusher("out", stdout);
return janet_wrap_nil();
}
static Janet cfun_io_eflush(int32_t argc, Janet *argv) {
janet_fixarity(argc, 0);
(void) argv;
janet_flusher("err", stderr);
return janet_wrap_nil();
}
void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) {
va_list args;
va_start(args, format);
@@ -512,12 +502,12 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
int32_t len = 0;
while (format[len]) len++;
janet_buffer_init(&buffer, len);
janet_formatb(&buffer, format, args);
janet_formatbv(&buffer, format, args);
if (xtype == JANET_ABSTRACT) {
void *abstract = janet_unwrap_abstract(x);
if (janet_abstract_type(abstract) != &cfun_io_filetype)
if (janet_abstract_type(abstract) != &janet_file_type)
break;
IOFile *iofile = abstract;
JanetFile *iofile = abstract;
f = iofile->file;
}
fwrite(buffer.data, buffer.count, 1, f);
@@ -525,7 +515,7 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
break;
}
case JANET_BUFFER:
janet_formatb(janet_unwrap_buffer(x), format, args);
janet_formatbv(janet_unwrap_buffer(x), format, args);
break;
}
va_end(args);
@@ -577,6 +567,16 @@ static const JanetReg io_cfuns[] = {
JDOC("(eprinf fmt & xs)\n\n"
"Like eprintf but with no trailing newline.")
},
{
"flush", cfun_io_flush,
JDOC("(flush)\n\n"
"Flush (dyn :out stdout) if it is a file, otherwise do nothing.")
},
{
"eflush", cfun_io_eflush,
JDOC("(eflush)\n\n"
"Flush (dyn :err stderr) if it is a file, otherwise do nothing.")
},
{
"file/temp", cfun_io_temp,
JDOC("(file/temp)\n\n"
@@ -597,26 +597,6 @@ 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"
@@ -674,7 +654,7 @@ static const JanetReg io_cfuns[] = {
/* C API */
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
IOFile *iof = janet_getabstract(argv, n, &cfun_io_filetype);
JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
if (NULL != flags) *flags = iof->flags;
return iof->file;
}
@@ -684,11 +664,11 @@ Janet janet_makefile(FILE *f, int flags) {
}
JanetAbstract janet_checkfile(Janet j) {
return janet_checkabstract(j, &cfun_io_filetype);
return janet_checkabstract(j, &janet_file_type);
}
FILE *janet_unwrapfile(Janet j, int *flags) {
IOFile *iof = janet_unwrap_abstract(j);
JanetFile *iof = janet_unwrap_abstract(j);
if (NULL != flags) *flags = iof->flags;
return iof->file;
}

View File

@@ -42,26 +42,28 @@ typedef struct {
/* Lead bytes in marshaling protocol */
enum {
LB_REAL = 200,
LB_NIL,
LB_FALSE,
LB_TRUE,
LB_FIBER,
LB_INTEGER,
LB_STRING,
LB_SYMBOL,
LB_KEYWORD,
LB_ARRAY,
LB_TUPLE,
LB_TABLE,
LB_TABLE_PROTO,
LB_STRUCT,
LB_BUFFER,
LB_FUNCTION,
LB_REGISTRY,
LB_ABSTRACT,
LB_REFERENCE,
LB_FUNCENV_REF,
LB_FUNCDEF_REF
LB_NIL, /* 201 */
LB_FALSE, /* 202 */
LB_TRUE, /* 203 */
LB_FIBER, /* 204 */
LB_INTEGER, /* 205 */
LB_STRING, /* 206 */
LB_SYMBOL, /* 207 */
LB_KEYWORD, /* 208 */
LB_ARRAY, /* 209 */
LB_TUPLE, /* 210 */
LB_TABLE, /* 211 */
LB_TABLE_PROTO, /* 212 */
LB_STRUCT, /* 213 */
LB_BUFFER, /* 214 */
LB_FUNCTION, /* 215 */
LB_REGISTRY, /* 216 */
LB_ABSTRACT, /* 217 */
LB_REFERENCE, /* 218 */
LB_FUNCENV_REF, /* 219 */
LB_FUNCDEF_REF, /* 220 */
LB_UNSAFE_CFUNCTION, /* 221 */
LB_UNSAFE_POINTER /* 222 */
} LeadBytes;
/* Helper to look inside an entry in an environment */
@@ -95,8 +97,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));
@@ -183,16 +185,32 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
return;
}
}
janet_env_valid(env);
janet_v_push(st->seen_envs, env);
pushint(st, env->offset);
pushint(st, env->length);
if (env->offset) {
/* On stack variant */
marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
if (env->offset > 0 && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
pushint(st, 0);
pushint(st, env->length);
Janet *values = env->as.fiber->data + env->offset;
uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset;
for (int32_t i = 0; i < env->length; i++) {
if (1 & (bitset[i >> 5] >> (i & 0x1F))) {
marshal_one(st, values[i], flags + 1);
} else {
pushbyte(st, LB_NIL);
}
}
} else {
/* Off stack variant */
for (int32_t i = 0; i < env->length; i++)
marshal_one(st, env->as.values[i], flags + 1);
janet_env_maybe_detach(env);
pushint(st, env->offset);
pushint(st, env->length);
if (env->offset > 0) {
/* On stack variant */
marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
} else {
/* Off stack variant */
for (int32_t i = 0; i < env->length; i++)
marshal_one(st, env->as.values[i], flags + 1);
}
}
}
@@ -205,6 +223,16 @@ static void janet_func_addflags(JanetFuncDef *def) {
if (def->sourcemap) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
}
/* Marshal a sequence of u32s */
static void janet_marshal_u32s(MarshalState *st, const uint32_t *u32s, int32_t n) {
for (int32_t i = 0; i < n; i++) {
pushbyte(st, u32s[i] & 0xFF);
pushbyte(st, (u32s[i] >> 8) & 0xFF);
pushbyte(st, (u32s[i] >> 16) & 0xFF);
pushbyte(st, (u32s[i] >> 24) & 0xFF);
}
}
/* Marshal a function def */
static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
MARSH_STACKCHECK;
@@ -239,12 +267,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
marshal_one(st, def->constants[i], flags);
/* marshal the bytecode */
for (int32_t i = 0; i < def->bytecode_length; i++) {
pushbyte(st, def->bytecode[i] & 0xFF);
pushbyte(st, (def->bytecode[i] >> 8) & 0xFF);
pushbyte(st, (def->bytecode[i] >> 16) & 0xFF);
pushbyte(st, (def->bytecode[i] >> 24) & 0xFF);
}
janet_marshal_u32s(st, def->bytecode, def->bytecode_length);
/* marshal the environments if needed */
for (int32_t i = 0; i < def->environments_length; i++)
@@ -264,6 +287,11 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
current = map.line;
}
}
/* Marshal closure bitset, if needed */
if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
janet_marshal_u32s(st, def->closure_bitset, ((def->slotcount + 31) >> 5));
}
}
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
@@ -537,9 +565,25 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
marshal_one_fiber(st, janet_unwrap_fiber(x), flags + 1);
return;
}
case JANET_CFUNCTION: {
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
MARK_SEEN();
pushbyte(st, LB_UNSAFE_CFUNCTION);
JanetCFunction cfn = janet_unwrap_cfunction(x);
pushbytes(st, (uint8_t *) &cfn, sizeof(JanetCFunction));
return;
}
case JANET_POINTER: {
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
MARK_SEEN();
pushbyte(st, LB_UNSAFE_POINTER);
void *ptr = janet_unwrap_pointer(x);
pushbytes(st, (uint8_t *) &ptr, sizeof(void *));
return;
}
no_registry:
default: {
janet_panicf("no registry value and cannot marshal %p", x);
return;
}
}
#undef MARK_SEEN
@@ -609,6 +653,15 @@ static int32_t readint(UnmarshalState *st, const uint8_t **atdata) {
return ret;
}
/* Helper to read a natural number (int >= 0). */
static int32_t readnat(UnmarshalState *st, const uint8_t **atdata) {
int32_t ret = readint(st, atdata);
if (ret < 0) {
janet_panicf("expected integer >= 0, got %d", ret);
}
return ret;
}
/* Helper to read a size_t (up to 8 bytes unsigned). */
static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
uint64_t ret;
@@ -677,36 +730,51 @@ static const uint8_t *unmarshal_one_env(
JanetFuncEnv *env = janet_gcalloc(JANET_MEMORY_FUNCENV, sizeof(JanetFuncEnv));
env->length = 0;
env->offset = 0;
env->as.values = NULL;
janet_v_push(st->lookup_envs, env);
int32_t offset = readint(st, &data);
int32_t length = readint(st, &data);
if (offset) {
int32_t offset = readnat(st, &data);
int32_t length = readnat(st, &data);
if (offset > 0) {
Janet fiberv;
/* On stack variant */
data = unmarshal_one(st, data, &fiberv, flags);
janet_asserttype(fiberv, JANET_FIBER);
env->as.fiber = janet_unwrap_fiber(fiberv);
/* Unmarshalling fiber may set values */
if (env->offset != 0 && env->offset != offset)
janet_panic("invalid funcenv offset");
if (env->length != 0 && env->length != length)
janet_panic("invalid funcenv length");
/* Negative offset indicates untrusted input */
env->offset = -offset;
} else {
/* Off stack variant */
if (length == 0) {
janet_panic("invalid funcenv length");
}
env->as.values = malloc(sizeof(Janet) * (size_t) length);
if (!env->as.values) {
JANET_OUT_OF_MEMORY;
}
env->offset = 0;
for (int32_t i = 0; i < length; i++)
data = unmarshal_one(st, data, env->as.values + i, flags);
}
env->offset = offset;
env->length = length;
*out = env;
}
return data;
}
/* Unmarshal a series of u32s */
static const uint8_t *janet_unmarshal_u32s(UnmarshalState *st, const uint8_t *data, uint32_t *into, int32_t n) {
for (int32_t i = 0; i < n; i++) {
MARSH_EOS(st, data + 3);
into[i] =
(uint32_t)(data[0]) |
((uint32_t)(data[1]) << 8) |
((uint32_t)(data[2]) << 16) |
((uint32_t)(data[3]) << 24);
data += 4;
}
return data;
}
/* Unmarshal a funcdef */
static const uint8_t *unmarshal_one_def(
UnmarshalState *st,
@@ -730,6 +798,12 @@ static const uint8_t *unmarshal_one_def(
def->bytecode_length = 0;
def->name = NULL;
def->source = NULL;
def->closure_bitset = NULL;
def->defs = NULL;
def->environments = NULL;
def->constants = NULL;
def->bytecode = NULL;
def->sourcemap = NULL;
janet_v_push(st->lookup_defs, def);
/* Set default lengths to zero */
@@ -740,18 +814,18 @@ static const uint8_t *unmarshal_one_def(
/* Read flags and other fixed values */
def->flags = readint(st, &data);
def->slotcount = readint(st, &data);
def->arity = readint(st, &data);
def->min_arity = readint(st, &data);
def->max_arity = readint(st, &data);
def->slotcount = readnat(st, &data);
def->arity = readnat(st, &data);
def->min_arity = readnat(st, &data);
def->max_arity = readnat(st, &data);
/* Read some lengths */
constants_length = readint(st, &data);
bytecode_length = readint(st, &data);
constants_length = readnat(st, &data);
bytecode_length = readnat(st, &data);
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
environments_length = readint(st, &data);
environments_length = readnat(st, &data);
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
defs_length = readint(st, &data);
defs_length = readnat(st, &data);
/* Check name and source (optional) */
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
@@ -785,15 +859,7 @@ static const uint8_t *unmarshal_one_def(
if (!def->bytecode) {
JANET_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < bytecode_length; i++) {
MARSH_EOS(st, data + 3);
def->bytecode[i] =
(uint32_t)(data[0]) |
((uint32_t)(data[1]) << 8) |
((uint32_t)(data[2]) << 16) |
((uint32_t)(data[3]) << 24);
data += 4;
}
data = janet_unmarshal_u32s(st, data, def->bytecode, bytecode_length);
def->bytecode_length = bytecode_length;
/* Unmarshal environments */
@@ -834,12 +900,21 @@ static const uint8_t *unmarshal_one_def(
for (int32_t i = 0; i < bytecode_length; i++) {
current += readint(st, &data);
def->sourcemap[i].line = current;
def->sourcemap[i].column = readint(st, &data);
def->sourcemap[i].column = readnat(st, &data);
}
} else {
def->sourcemap = NULL;
}
/* Unmarshal closure bitset if needed */
if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
def->closure_bitset = malloc(sizeof(uint32_t) * def->slotcount);
if (NULL == def->closure_bitset) {
JANET_OUT_OF_MEMORY;
}
data = janet_unmarshal_u32s(st, data, def->closure_bitset, (def->slotcount + 31) >> 5);
}
/* Validate */
if (janet_verify(def))
janet_panic("funcdef has invalid bytecode");
@@ -857,7 +932,7 @@ static const uint8_t *unmarshal_one_fiber(
JanetFiber **out,
int flags) {
/* Initialize a new fiber */
/* Initialize a new fiber with gc friendly defaults */
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
fiber->flags = 0;
fiber->frame = 0;
@@ -872,42 +947,41 @@ static const uint8_t *unmarshal_one_fiber(
/* Push fiber to seen stack */
janet_v_push(st->lookup, janet_wrap_fiber(fiber));
/* Set frame later so fiber can be GCed at anytime if unmarshalling fails */
int32_t frame = 0;
int32_t stack = 0;
int32_t stacktop = 0;
/* Read ints */
fiber->flags = readint(st, &data);
frame = readint(st, &data);
fiber->stackstart = readint(st, &data);
fiber->stacktop = readint(st, &data);
fiber->maxstack = readint(st, &data);
int32_t fiber_flags = readint(st, &data);
int32_t frame = readnat(st, &data);
int32_t fiber_stackstart = readnat(st, &data);
int32_t fiber_stacktop = readnat(st, &data);
int32_t fiber_maxstack = readnat(st, &data);
JanetTable *fiber_env = NULL;
/* Check for bad flags and ints */
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber->stackstart ||
fiber->stackstart > fiber->stacktop ||
fiber->stacktop > fiber->maxstack) {
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber_stackstart ||
fiber_stackstart > fiber_stacktop ||
fiber_stacktop > fiber_maxstack) {
janet_panic("fiber has incorrect stack setup");
}
/* Allocate stack memory */
fiber->capacity = fiber->stacktop + 10;
fiber->capacity = fiber_stacktop + 10;
fiber->data = malloc(sizeof(Janet) * fiber->capacity);
if (!fiber->data) {
JANET_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < fiber->capacity; i++) {
fiber->data[i] = janet_wrap_nil();
}
/* get frames */
stack = frame;
stacktop = fiber->stackstart - JANET_FRAME_SIZE;
int32_t stack = frame;
int32_t stacktop = fiber_stackstart - JANET_FRAME_SIZE;
while (stack > 0) {
JanetFunction *func = NULL;
JanetFuncDef *def = NULL;
JanetFuncEnv *env = NULL;
int32_t frameflags = readint(st, &data);
int32_t prevframe = readint(st, &data);
int32_t pcdiff = readint(st, &data);
int32_t prevframe = readnat(st, &data);
int32_t pcdiff = readnat(st, &data);
/* Get frame items */
Janet *framestack = fiber->data + stack;
@@ -923,15 +997,7 @@ static const uint8_t *unmarshal_one_fiber(
/* Check env */
if (frameflags & JANET_STACKFRAME_HASENV) {
frameflags &= ~JANET_STACKFRAME_HASENV;
int32_t offset = stack;
int32_t length = stacktop - stack;
data = unmarshal_one_env(st, data, &env, flags + 1);
if (env->offset != 0 && env->offset != offset)
janet_panic("funcenv offset does not match fiber frame");
if (env->length != 0 && env->length != length)
janet_panic("funcenv length does not match fiber frame");
env->offset = offset;
env->length = length;
}
/* Error checking */
@@ -939,11 +1005,11 @@ static const uint8_t *unmarshal_one_fiber(
if (expected_framesize != stacktop - stack) {
janet_panic("fiber stackframe size mismatch");
}
if (pcdiff < 0 || pcdiff >= def->bytecode_length) {
if (pcdiff >= def->bytecode_length) {
janet_panic("fiber stackframe has invalid pc");
}
if ((int32_t)(prevframe + JANET_FRAME_SIZE) > stack) {
janet_panic("fibre stackframe does not align with previous frame");
janet_panic("fiber stackframe does not align with previous frame");
}
/* Get stack items */
@@ -966,25 +1032,32 @@ static const uint8_t *unmarshal_one_fiber(
}
/* Check for fiber env */
if (fiber->flags & JANET_FIBER_FLAG_HASENV) {
if (fiber_flags & JANET_FIBER_FLAG_HASENV) {
Janet envv;
fiber->flags &= ~JANET_FIBER_FLAG_HASENV;
fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
data = unmarshal_one(st, data, &envv, flags + 1);
janet_asserttype(envv, JANET_TABLE);
fiber->env = janet_unwrap_table(envv);
fiber_env = janet_unwrap_table(envv);
}
/* Check for child fiber */
if (fiber->flags & JANET_FIBER_FLAG_HASCHILD) {
if (fiber_flags & JANET_FIBER_FLAG_HASCHILD) {
Janet fiberv;
fiber->flags &= ~JANET_FIBER_FLAG_HASCHILD;
fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
data = unmarshal_one(st, data, &fiberv, flags + 1);
janet_asserttype(fiberv, JANET_FIBER);
fiber->child = janet_unwrap_fiber(fiberv);
}
/* Return data */
/* We have valid fiber, finally construct remaining fields. */
fiber->frame = frame;
fiber->flags = fiber_flags;
fiber->stackstart = fiber_stackstart;
fiber->stacktop = fiber_stacktop;
fiber->maxstack = fiber_maxstack;
fiber->env = fiber_env;
/* Return data */
*out = fiber;
return data;
}
@@ -1017,7 +1090,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;
}
@@ -1043,7 +1116,7 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
Janet key;
data = unmarshal_one(st, data, &key, flags + 1);
const JanetAbstractType *at = janet_get_abstract_type(key);
if (at == NULL) return NULL;
if (at == NULL) goto oops;
if (at->unmarshal) {
JanetMarshalContext context = {NULL, st, flags, data, at};
*out = janet_wrap_abstract(at->unmarshal(&context));
@@ -1052,7 +1125,8 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
}
return context.data;
}
return NULL;
oops:
janet_panic("invalid abstract type");
}
static const uint8_t *unmarshal_one(
@@ -1064,7 +1138,7 @@ static const uint8_t *unmarshal_one(
MARSH_STACKCHECK;
MARSH_EOS(st, data);
lead = data[0];
if (lead < 200) {
if (lead < LB_REAL) {
*out = janet_wrap_integer(readint(st, &data));
return data;
}
@@ -1100,7 +1174,7 @@ static const uint8_t *unmarshal_one(
u.bytes[0] = data[8];
u.bytes[1] = data[7];
u.bytes[2] = data[6];
u.bytes[5] = data[5];
u.bytes[3] = data[5];
u.bytes[4] = data[4];
u.bytes[5] = data[3];
u.bytes[6] = data[2];
@@ -1118,7 +1192,7 @@ static const uint8_t *unmarshal_one(
case LB_KEYWORD:
case LB_REGISTRY: {
data++;
int32_t len = readint(st, &data);
int32_t len = readnat(st, &data);
MARSH_EOS(st, data - 1 + len);
if (lead == LB_STRING) {
const uint8_t *str = janet_string(data, len);
@@ -1139,7 +1213,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);
@@ -1178,7 +1252,11 @@ static const uint8_t *unmarshal_one(
/* Things that open with integers */
{
data++;
int32_t len = readint(st, &data);
int32_t len = readnat(st, &data);
/* DOS check */
if (lead != LB_REFERENCE) {
MARSH_EOS(st, data - 1 + len);
}
if (lead == LB_ARRAY) {
/* Array */
JanetArray *array = janet_array(len);
@@ -1210,7 +1288,7 @@ static const uint8_t *unmarshal_one(
*out = janet_wrap_struct(janet_struct_end(struct_));
janet_v_push(st->lookup, *out);
} else if (lead == LB_REFERENCE) {
if (len < 0 || len >= janet_v_count(st->lookup))
if (len >= janet_v_count(st->lookup))
janet_panicf("invalid reference %d", len);
*out = st->lookup[len];
} else {
@@ -1233,6 +1311,42 @@ static const uint8_t *unmarshal_one(
}
return data;
}
case LB_UNSAFE_POINTER: {
MARSH_EOS(st, data + sizeof(void *));
data++;
if (!(flags & JANET_MARSHAL_UNSAFE)) {
janet_panicf("unsafe flag not given, "
"will not unmarshal raw pointer at index %d",
(int)(data - st->start));
}
union {
void *ptr;
uint8_t bytes[sizeof(void *)];
} u;
memcpy(u.bytes, data, sizeof(void *));
data += sizeof(void *);
*out = janet_wrap_pointer(u.ptr);
janet_v_push(st->lookup, *out);
return data;
}
case LB_UNSAFE_CFUNCTION: {
MARSH_EOS(st, data + sizeof(JanetCFunction));
data++;
if (!(flags & JANET_MARSHAL_UNSAFE)) {
janet_panicf("unsafe flag not given, "
"will not unmarshal function pointer at index %d",
(int)(data - st->start));
}
union {
JanetCFunction ptr;
uint8_t bytes[sizeof(JanetCFunction)];
} u;
memcpy(u.bytes, data, sizeof(JanetCFunction));
data += sizeof(JanetCFunction);
*out = janet_wrap_cfunction(u.ptr);
janet_v_push(st->lookup, *out);
return data;
}
default: {
janet_panicf("unknown byte %x at index %d",
*data,
@@ -1274,7 +1388,7 @@ static Janet cfun_env_lookup(int32_t argc, Janet *argv) {
}
static Janet cfun_marshal(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
janet_arity(argc, 1, 3);
JanetBuffer *buffer;
JanetTable *rreg = NULL;
if (argc > 1) {

View File

@@ -52,7 +52,7 @@ static void *janet_rng_unmarshal(JanetMarshalContext *ctx) {
return rng;
}
static JanetAbstractType JanetRNG_type = {
const JanetAbstractType janet_rng_type = {
"core/rng",
NULL,
NULL,
@@ -60,9 +60,7 @@ static JanetAbstractType JanetRNG_type = {
NULL,
janet_rng_marshal,
janet_rng_unmarshal,
NULL,
NULL,
NULL
JANET_ATEND_UNMARSHAL
};
JanetRNG *janet_default_rng(void) {
@@ -117,7 +115,7 @@ double janet_rng_double(JanetRNG *rng) {
static Janet cfun_rng_make(int32_t argc, Janet *argv) {
janet_arity(argc, 0, 1);
JanetRNG *rng = janet_abstract(&JanetRNG_type, sizeof(JanetRNG));
JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG));
if (argc == 1) {
if (janet_checkint(argv[0])) {
uint32_t seed = (uint32_t)(janet_getinteger(argv, 0));
@@ -134,13 +132,13 @@ static Janet cfun_rng_make(int32_t argc, Janet *argv) {
static Janet cfun_rng_uniform(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
return janet_wrap_number(janet_rng_double(rng));
}
static Janet cfun_rng_int(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
if (argc == 1) {
uint32_t word = janet_rng_u32(rng) >> 1;
return janet_wrap_integer(word);
@@ -168,7 +166,7 @@ static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) {
static Janet cfun_rng_buffer(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
int32_t n = janet_getnat(argv, 1);
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, n);
@@ -225,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); \
@@ -264,6 +255,10 @@ JANET_DEFINE_MATHOP(fabs, fabs)
JANET_DEFINE_MATHOP(floor, floor)
JANET_DEFINE_MATHOP(trunc, trunc)
JANET_DEFINE_MATHOP(round, round)
JANET_DEFINE_MATHOP(gamma, lgamma)
JANET_DEFINE_MATHOP(log1p, log1p)
JANET_DEFINE_MATHOP(erf, erf)
JANET_DEFINE_MATHOP(erfc, erfc)
#define JANET_DEFINE_MATH2OP(name, fop)\
static Janet janet_##name(int32_t argc, Janet *argv) {\
@@ -276,6 +271,7 @@ static Janet janet_##name(int32_t argc, Janet *argv) {\
JANET_DEFINE_MATH2OP(atan2, atan2)
JANET_DEFINE_MATH2OP(pow, pow)
JANET_DEFINE_MATH2OP(hypot, hypot)
JANET_DEFINE_MATH2OP(nextafter, nextafter)
static Janet janet_not(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
@@ -283,11 +279,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.")
@@ -452,6 +443,26 @@ static const JanetReg math_cfuns[] = {
JDOC("(math/exp2 x)\n\n"
"Returns 2 to the power of x.")
},
{
"math/log1p", janet_log1p,
JDOC("(math/log1p x)\n\n"
"Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
},
{
"math/gamma", janet_gamma,
JDOC("(math/gamma x)\n\n"
"Returns gamma(x).")
},
{
"math/erfc", janet_erfc,
JDOC("(math/erfc x)\n\n"
"Returns the complementary error function of x.")
},
{
"math/erf", janet_erf,
JDOC("(math/erf x)\n\n"
"Returns the error function of x.")
},
{
"math/expm1", janet_expm1,
JDOC("(math/expm1 x)\n\n"
@@ -467,13 +478,18 @@ static const JanetReg math_cfuns[] = {
JDOC("(math/round x)\n\n"
"Returns the integer nearest to x.")
},
{
"math/next", janet_nextafter,
JDOC("(math/next y)\n\n"
"Returns the next representable floating point value after x in the direction of y.")
},
{NULL, NULL, NULL}
};
/* Module entry point */
void janet_lib_math(JanetTable *env) {
janet_core_cfuns(env, NULL, math_cfuns);
janet_register_abstract_type(&JanetRNG_type);
janet_register_abstract_type(&janet_rng_type);
#ifdef JANET_BOOTSTRAP
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
JDOC("The value pi."));

View File

@@ -32,6 +32,7 @@
#include <time.h>
#include <fcntl.h>
#include <errno.h>
#include <limits.h>
#include <stdio.h>
#include <string.h>
#include <sys/stat.h>
@@ -69,6 +70,13 @@ extern char **environ;
void arc4random_buf(void *buf, size_t nbytes);
#endif
/* Not POSIX, but all Unixes but Solaris have this function. */
#if defined(JANET_POSIX) && !defined(__sun)
time_t timegm(struct tm *tm);
#elif defined(JANET_WINDOWS)
#define timegm _mkgmtime
#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
@@ -401,7 +409,16 @@ static Janet os_execute(int32_t argc, Janet *argv) {
}
os_execute_cleanup(envp, child_argv);
return janet_wrap_integer(WEXITSTATUS(status));
/* Use POSIX shell semantics for interpreting signals */
int ret;
if (WIFEXITED(status)) {
ret = WEXITSTATUS(status);
} else if (WIFSTOPPED(status)) {
ret = WSTOPSIG(status) + 128;
} else {
ret = WTERMSIG(status) + 128;
}
return janet_wrap_integer(ret);
#endif
}
@@ -621,13 +638,11 @@ static Janet os_date(int32_t argc, Janet *argv) {
struct tm *t_info = NULL;
if (argc) {
int64_t integer = janet_getinteger64(argv, 0);
if (integer < 0)
janet_panicf("expected non-negative 64 bit signed integer, got %v", argv[0]);
t = (time_t) integer;
} else {
time(&t);
}
if (argc >= 2 && janet_truthy(argv[2])) {
if (argc >= 2 && janet_truthy(argv[1])) {
/* local time */
#ifdef JANET_WINDOWS
localtime_s(&t_infos, &t);
@@ -658,6 +673,101 @@ static Janet os_date(int32_t argc, Janet *argv) {
return janet_wrap_struct(janet_struct_end(st));
}
static int entry_getdst(Janet env_entry) {
Janet v;
if (janet_checktype(env_entry, JANET_TABLE)) {
JanetTable *entry = janet_unwrap_table(env_entry);
v = janet_table_get(entry, janet_ckeywordv("dst"));
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
const JanetKV *entry = janet_unwrap_struct(env_entry);
v = janet_struct_get(entry, janet_ckeywordv("dst"));
} else {
v = janet_wrap_nil();
}
if (janet_checktype(v, JANET_NIL)) {
return -1;
} else {
return janet_truthy(v);
}
}
#ifdef JANET_WINDOWS
typedef int32_t timeint_t;
#else
typedef int64_t timeint_t;
#endif
static timeint_t entry_getint(Janet env_entry, char *field) {
Janet i;
if (janet_checktype(env_entry, JANET_TABLE)) {
JanetTable *entry = janet_unwrap_table(env_entry);
i = janet_table_get(entry, janet_ckeywordv(field));
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
const JanetKV *entry = janet_unwrap_struct(env_entry);
i = janet_struct_get(entry, janet_ckeywordv(field));
} else {
return 0;
}
if (janet_checktype(i, JANET_NIL)) {
return 0;
}
#ifdef JANET_WINDOWS
if (!janet_checkint(i)) {
janet_panicf("bad slot #%s, expected 32 bit signed integer, got %v",
field, i);
}
#else
if (!janet_checkint64(i)) {
janet_panicf("bad slot #%s, expected 64 bit signed integer, got %v",
field, i);
}
#endif
return (timeint_t)janet_unwrap_number(i);
}
static Janet os_mktime(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
time_t t;
struct tm t_info;
/* Use memset instead of = {0} to silence paranoid warning in macos */
memset(&t_info, 0, sizeof(t_info));
if (!janet_checktype(argv[0], JANET_TABLE) &&
!janet_checktype(argv[0], JANET_STRUCT))
janet_panic_type(argv[0], 0, JANET_TFLAG_DICTIONARY);
t_info.tm_sec = entry_getint(argv[0], "seconds");
t_info.tm_min = entry_getint(argv[0], "minutes");
t_info.tm_hour = entry_getint(argv[0], "hours");
t_info.tm_mday = entry_getint(argv[0], "month-day") + 1;
t_info.tm_mon = entry_getint(argv[0], "month");
t_info.tm_year = entry_getint(argv[0], "year") - 1900;
t_info.tm_isdst = entry_getdst(argv[0]);
if (argc >= 2 && janet_truthy(argv[1])) {
/* local time */
t = mktime(&t_info);
} else {
/* utc time */
#ifdef __sun
janet_panic("os/mktime UTC not supported on Solaris");
return janet_wrap_nil();
#else
t = timegm(&t_info);
#endif
}
if (t == (time_t) -1) {
janet_panicf("%s", strerror(errno));
}
return janet_wrap_number((double)t);
}
static Janet os_link(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
#ifdef JANET_WINDOWS
@@ -668,9 +778,25 @@ static Janet os_link(int32_t argc, Janet *argv) {
#else
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
int res = ((argc == 3 && janet_getboolean(argv, 2)) ? symlink : link)(oldpath, newpath);
int res = ((argc == 3 && janet_truthy(argv[2])) ? symlink : link)(oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
return janet_wrap_integer(res);
return janet_wrap_nil();
#endif
}
static Janet os_symlink(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
#ifdef JANET_WINDOWS
(void) argc;
(void) argv;
janet_panic("os/symlink not supported on Windows");
return janet_wrap_nil();
#else
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
int res = symlink(oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
return janet_wrap_nil();
#endif
}
@@ -682,7 +808,9 @@ static Janet os_mkdir(int32_t argc, Janet *argv) {
#else
int res = mkdir(path, S_IRUSR | S_IWUSR | S_IXUSR | S_IRGRP | S_IWGRP | S_IXGRP | S_IROTH | S_IXOTH);
#endif
return janet_wrap_boolean(res != -1);
if (res == 0) return janet_wrap_true();
if (errno == EEXIST) return janet_wrap_false();
janet_panicf("%s: %s", strerror(errno), path);
}
static Janet os_rmdir(int32_t argc, Janet *argv) {
@@ -737,13 +865,42 @@ static Janet os_remove(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet os_readlink(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
#ifdef JANET_WINDOWS
static const uint8_t *janet_decode_permissions(unsigned short m) {
uint8_t flags[9] = {0};
flags[0] = flags[3] = flags[6] = (m & S_IREAD) ? 'r' : '-';
flags[1] = flags[4] = flags[7] = (m & S_IWRITE) ? 'w' : '-';
flags[2] = flags[5] = flags[8] = (m & S_IEXEC) ? 'x' : '-';
return janet_string(flags, sizeof(flags));
(void) argc;
(void) argv;
janet_panic("os/readlink not supported on Windows");
return janet_wrap_nil();
#else
static char buffer[PATH_MAX];
const char *path = janet_getcstring(argv, 0);
ssize_t len = readlink(path, buffer, sizeof buffer);
if (len < 0 || (size_t)len >= sizeof buffer)
janet_panicf("%s: %s", strerror(errno), path);
return janet_stringv((const uint8_t *)buffer, len);
#endif
}
#ifdef JANET_WINDOWS
typedef struct _stat jstat_t;
typedef unsigned short jmode_t;
static int32_t janet_perm_to_unix(unsigned short m) {
int32_t ret = 0;
if (m & S_IEXEC) ret |= 0111;
if (m & S_IWRITE) ret |= 0222;
if (m & S_IREAD) ret |= 0444;
return ret;
}
static unsigned short janet_perm_from_unix(int32_t x) {
unsigned short m = 0;
if (x & 111) m |= S_IEXEC;
if (x & 222) m |= S_IWRITE;
if (x & 444) m |= S_IREAD;
return m;
}
static const uint8_t *janet_decode_mode(unsigned short m) {
@@ -753,19 +910,22 @@ static const uint8_t *janet_decode_mode(unsigned short m) {
else if (m & _S_IFCHR) str = "character";
return janet_ckeyword(str);
}
static int32_t janet_decode_permissions(jmode_t mode) {
return (int32_t)(mode & (S_IEXEC | S_IWRITE | S_IREAD));
}
#else
static const uint8_t *janet_decode_permissions(mode_t m) {
uint8_t flags[9] = {0};
flags[0] = (m & S_IRUSR) ? 'r' : '-';
flags[1] = (m & S_IWUSR) ? 'w' : '-';
flags[2] = (m & S_IXUSR) ? 'x' : '-';
flags[3] = (m & S_IRGRP) ? 'r' : '-';
flags[4] = (m & S_IWGRP) ? 'w' : '-';
flags[5] = (m & S_IXGRP) ? 'x' : '-';
flags[6] = (m & S_IROTH) ? 'r' : '-';
flags[7] = (m & S_IWOTH) ? 'w' : '-';
flags[8] = (m & S_IXOTH) ? 'x' : '-';
return janet_string(flags, sizeof(flags));
typedef struct stat jstat_t;
typedef mode_t jmode_t;
static int32_t janet_perm_to_unix(mode_t m) {
return (int32_t) m;
}
static mode_t janet_perm_from_unix(int32_t x) {
return (mode_t) x;
}
static const uint8_t *janet_decode_mode(mode_t m) {
@@ -779,75 +939,131 @@ static const uint8_t *janet_decode_mode(mode_t m) {
else if (S_ISCHR(m)) str = "character";
return janet_ckeyword(str);
}
static int32_t janet_decode_permissions(jmode_t mode) {
return (int32_t)(mode & 0777);
}
#endif
/* Can we do this? */
#ifdef JANET_WINDOWS
#define stat _stat
#endif
static int32_t os_parse_permstring(const uint8_t *perm) {
int32_t m = 0;
if (perm[0] == 'r') m |= 0400;
if (perm[1] == 'w') m |= 0200;
if (perm[2] == 'x') m |= 0100;
if (perm[3] == 'r') m |= 0040;
if (perm[4] == 'w') m |= 0020;
if (perm[5] == 'x') m |= 0010;
if (perm[6] == 'r') m |= 0004;
if (perm[7] == 'w') m |= 0002;
if (perm[8] == 'x') m |= 0001;
return m;
}
static Janet os_make_permstring(int32_t permissions) {
uint8_t bytes[9] = {0};
bytes[0] = (permissions & 0400) ? 'r' : '-';
bytes[1] = (permissions & 0200) ? 'w' : '-';
bytes[2] = (permissions & 0100) ? 'x' : '-';
bytes[3] = (permissions & 0040) ? 'r' : '-';
bytes[4] = (permissions & 0020) ? 'w' : '-';
bytes[5] = (permissions & 0010) ? 'x' : '-';
bytes[6] = (permissions & 0004) ? 'r' : '-';
bytes[7] = (permissions & 0002) ? 'w' : '-';
bytes[8] = (permissions & 0001) ? 'x' : '-';
return janet_stringv(bytes, sizeof(bytes));
}
static int32_t os_get_unix_mode(const Janet *argv, int32_t n) {
int32_t unix_mode;
if (janet_checkint(argv[n])) {
/* Integer mode */
int32_t x = janet_unwrap_integer(argv[n]);
if (x < 0 || x > 0777) {
janet_panicf("bad slot #%d, expected integer in range [0, 8r777], got %v", n, argv[n]);
}
unix_mode = x;
} else {
/* Bytes mode */
JanetByteView bytes = janet_getbytes(argv, n);
if (bytes.len != 9) {
janet_panicf("bad slot #%d: expected byte sequence of length 9, got %v", n, argv[n]);
}
unix_mode = os_parse_permstring(bytes.bytes);
}
return unix_mode;
}
static jmode_t os_getmode(const Janet *argv, int32_t n) {
return janet_perm_from_unix(os_get_unix_mode(argv, n));
}
/* Getters */
static Janet os_stat_dev(struct stat *st) {
static Janet os_stat_dev(jstat_t *st) {
return janet_wrap_number(st->st_dev);
}
static Janet os_stat_inode(struct stat *st) {
static Janet os_stat_inode(jstat_t *st) {
return janet_wrap_number(st->st_ino);
}
static Janet os_stat_mode(struct stat *st) {
static Janet os_stat_mode(jstat_t *st) {
return janet_wrap_keyword(janet_decode_mode(st->st_mode));
}
static Janet os_stat_permissions(struct stat *st) {
return janet_wrap_string(janet_decode_permissions(st->st_mode));
static Janet os_stat_int_permissions(jstat_t *st) {
return janet_wrap_integer(janet_perm_to_unix(janet_decode_permissions(st->st_mode)));
}
static Janet os_stat_uid(struct stat *st) {
static Janet os_stat_permissions(jstat_t *st) {
return os_make_permstring(janet_perm_to_unix(janet_decode_permissions(st->st_mode)));
}
static Janet os_stat_uid(jstat_t *st) {
return janet_wrap_number(st->st_uid);
}
static Janet os_stat_gid(struct stat *st) {
static Janet os_stat_gid(jstat_t *st) {
return janet_wrap_number(st->st_gid);
}
static Janet os_stat_nlink(struct stat *st) {
static Janet os_stat_nlink(jstat_t *st) {
return janet_wrap_number(st->st_nlink);
}
static Janet os_stat_rdev(struct stat *st) {
static Janet os_stat_rdev(jstat_t *st) {
return janet_wrap_number(st->st_rdev);
}
static Janet os_stat_size(struct stat *st) {
static Janet os_stat_size(jstat_t *st) {
return janet_wrap_number(st->st_size);
}
static Janet os_stat_accessed(struct stat *st) {
static Janet os_stat_accessed(jstat_t *st) {
return janet_wrap_number((double) st->st_atime);
}
static Janet os_stat_modified(struct stat *st) {
static Janet os_stat_modified(jstat_t *st) {
return janet_wrap_number((double) st->st_mtime);
}
static Janet os_stat_changed(struct stat *st) {
static Janet os_stat_changed(jstat_t *st) {
return janet_wrap_number((double) st->st_ctime);
}
#ifdef JANET_WINDOWS
static Janet os_stat_blocks(struct stat *st) {
static Janet os_stat_blocks(jstat_t *st) {
return janet_wrap_number(0);
}
static Janet os_stat_blocksize(struct stat *st) {
static Janet os_stat_blocksize(jstat_t *st) {
return janet_wrap_number(0);
}
#else
static Janet os_stat_blocks(struct stat *st) {
static Janet os_stat_blocks(jstat_t *st) {
return janet_wrap_number(st->st_blocks);
}
static Janet os_stat_blocksize(struct stat *st) {
static Janet os_stat_blocksize(jstat_t *st) {
return janet_wrap_number(st->st_blksize);
}
#endif
struct OsStatGetter {
const char *name;
Janet(*fn)(struct stat *st);
Janet(*fn)(jstat_t *st);
};
static const struct OsStatGetter os_stat_getters[] = {
{"dev", os_stat_dev},
{"inode", os_stat_inode},
{"mode", os_stat_mode},
{"int-permissions", os_stat_int_permissions},
{"permissions", os_stat_permissions},
{"uid", os_stat_uid},
{"gid", os_stat_gid},
@@ -862,7 +1078,7 @@ static const struct OsStatGetter os_stat_getters[] = {
{NULL, NULL}
};
static Janet os_stat(int32_t argc, Janet *argv) {
static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
const char *path = janet_getcstring(argv, 0);
JanetTable *tab = NULL;
@@ -880,8 +1096,18 @@ static Janet os_stat(int32_t argc, Janet *argv) {
}
/* Build result */
struct stat st;
int res = stat(path, &st);
jstat_t st;
#ifdef JANET_WINDOWS
(void) do_lstat;
int res = _stat(path, &st);
#else
int res;
if (do_lstat) {
res = lstat(path, &st);
} else {
res = stat(path, &st);
}
#endif
if (-1 == res) {
return janet_wrap_nil();
}
@@ -903,6 +1129,37 @@ static Janet os_stat(int32_t argc, Janet *argv) {
}
}
static Janet os_stat(int32_t argc, Janet *argv) {
return os_stat_or_lstat(0, argc, argv);
}
static Janet os_lstat(int32_t argc, Janet *argv) {
return os_stat_or_lstat(1, argc, argv);
}
static Janet os_chmod(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
const char *path = janet_getcstring(argv, 0);
#ifdef JANET_WINDOWS
int res = _chmod(path, os_getmode(argv, 1));
#else
int res = chmod(path, os_getmode(argv, 1));
#endif
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
return janet_wrap_nil();
}
static Janet os_umask(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
int mask = (int) os_getmode(argv, 0);
#ifdef JANET_WINDOWS
int res = _umask(mask);
#else
int res = umask(mask);
#endif
return janet_wrap_integer(janet_perm_to_unix(res));
}
static Janet os_dir(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
const char *dir = janet_getcstring(argv, 0);
@@ -949,6 +1206,31 @@ static Janet os_rename(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet os_realpath(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
#ifdef JANET_WINDOWS
(void) argv;
janet_panic("os/realpath not supported on Windows");
#else
const char *src = janet_getcstring(argv, 0);
char *dest = realpath(src, NULL);
if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
Janet ret = janet_cstringv(dest);
free(dest);
return ret;
#endif
}
static Janet os_permission_string(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
return os_make_permstring(os_get_unix_mode(argv, 0));
}
static Janet os_permission_int(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
return janet_wrap_integer(os_get_unix_mode(argv, 0));
}
#endif /* JANET_REDUCED_OS */
static const JanetReg os_cfuns[] = {
@@ -1007,7 +1289,8 @@ static const JanetReg os_cfuns[] = {
" only that information from stat. If the file or directory does not exist, returns nil. The keys are\n\n"
"\t:dev - the device that the file is on\n"
"\t:mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n"
"\t:permissions - A unix permission string like \"rwx--x--x\"\n"
"\t:int-permissions - A Unix permission integer like 8r744\n"
"\t:permissions - A Unix permission string like \"rwxr--r--\"\n"
"\t:uid - File uid\n"
"\t:gid - File gid\n"
"\t:nlink - number of links to file\n"
@@ -1019,6 +1302,19 @@ static const JanetReg os_cfuns[] = {
"\t:changed - timestamp when file last chnaged (permissions changed)\n"
"\t:modified - timestamp when file last modified (content changed)\n")
},
{
"os/lstat", os_lstat,
JDOC("(os/lstat path &opt tab|key)\n\n"
"Like os/stat, but don't follow symlinks.\n")
},
{
"os/chmod", os_chmod,
JDOC("(os/chmod path mode)\n\n"
"Change file permissions, where mode is a permission string as returned by "
"os/perm-string, or an integer as returned by os/perm-int. "
"When mode is an integer, it is interpreted as a Unix permission value, best specified in octal, like "
"8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil.")
},
{
"os/touch", os_touch,
JDOC("(os/touch path &opt actime modtime)\n\n"
@@ -1028,13 +1324,19 @@ static const JanetReg os_cfuns[] = {
{
"os/cd", os_cd,
JDOC("(os/cd path)\n\n"
"Change current directory to path. Returns true on success, false on failure.")
"Change current directory to path. Returns nil on success, errors on failure.")
},
{
"os/umask", os_umask,
JDOC("(os/umask mask)\n\n"
"Set a new umask, returns the old umask.")
},
{
"os/mkdir", os_mkdir,
JDOC("(os/mkdir path)\n\n"
"Create a new directory. The path will be relative to the current directory if relative, otherwise "
"it will be an absolute path.")
"it will be an absolute path. Returns true if the directory was created, false if the directory already exists, and "
"errors otherwise.")
},
{
"os/rmdir", os_rmdir,
@@ -1049,8 +1351,20 @@ static const JanetReg os_cfuns[] = {
{
"os/link", os_link,
JDOC("(os/link oldpath newpath &opt symlink)\n\n"
"Create a symlink from oldpath to newpath. The 3 optional paramater "
"enables a hard link over a soft link. Does not work on Windows.")
"Create a link at newpath that points to oldpath and returns nil. "
"Iff symlink is truthy, creates a symlink. "
"Iff symlink is falsey or not provided, "
"creates a hard link. Does not work on Windows.")
},
{
"os/symlink", os_symlink,
JDOC("(os/symlink oldpath newpath)\n\n"
"Create a symlink from oldpath to newpath, returning nil. Same as (os/link oldpath newpath true).")
},
{
"os/readlink", os_readlink,
JDOC("(os/readlink path)\n\n"
"Read the contents of a symbolic link. Does not work on Windows.\n")
},
{
"os/execute", os_execute,
@@ -1080,6 +1394,16 @@ static const JanetReg os_cfuns[] = {
"Get the current time expressed as the number of seconds since "
"January 1, 1970, the Unix epoch. Returns a real number.")
},
{
"os/mktime", os_mktime,
JDOC("(os/mktime date-struct &opt local)\n\n"
"Get the broken down date-struct time expressed as the number "
" of seconds since January 1, 1970, the Unix epoch. "
"Returns a real number. "
"Date is given in UTC unless local is truthy, in which case the "
"date is computed for the local timezone.\n\n"
"Inverse function to os/date.")
},
{
"os/clock", os_clock,
JDOC("(os/clock)\n\n"
@@ -1100,14 +1424,14 @@ static const JanetReg os_cfuns[] = {
{
"os/cryptorand", os_cryptorand,
JDOC("(os/cryptorand n &opt buf)\n\n"
"Get or append n bytes of good quality random data provided by the os. Returns a new buffer or buf.")
"Get or append n bytes of good quality random data provided by the OS. Returns a new buffer or buf.")
},
{
"os/date", os_date,
JDOC("(os/date &opt time local)\n\n"
"Returns the given time as a date struct, or the current time if no time is given. "
"Returns a struct with following key values. Note that all numbers are 0-indexed. "
"Date is given in UTC unless local is truthy, in which case the date is formated for "
"Date is given in UTC unless local is truthy, in which case the date is formatted for "
"the local timezone.\n\n"
"\t:seconds - number of seconds [0-61]\n"
"\t:minutes - number of minutes [0-59]\n"
@@ -1124,6 +1448,25 @@ static const JanetReg os_cfuns[] = {
JDOC("(os/rename oldname newname)\n\n"
"Rename a file on disk to a new path. Returns nil.")
},
{
"os/realpath", os_realpath,
JDOC("(os/realpath path)\n\n"
"Get the absolute path for a given path, following ../, ./, and symlinks. "
"Returns an absolute path as a string. Will raise an error on Windows.")
},
{
"os/perm-string", os_permission_string,
JDOC("(os/perm-string int)\n\n"
"Convert a Unix octal permission value from a permission integer as returned by os/stat "
"to a human readable string, that follows the formatting "
"of unix tools like ls. Returns the string as a 9 character string of r, w, x and - characters. Does not "
"include the file/directory/symlink character as rendered by `ls`.")
},
{
"os/perm-int", os_permission_int,
JDOC("(os/perm-int bytes)\n\n"
"Parse a 9 character permission string and return an integer that can be used by chmod.")
},
#endif
{NULL, NULL, NULL}
};

View File

@@ -26,6 +26,9 @@
#include "util.h"
#endif
#define JANET_PARSER_DEAD 0x1
#define JANET_PARSER_GENERATED_ERROR 0x2
/* Check if a character is whitespace */
static int is_whitespace(uint8_t c) {
return c == ' '
@@ -201,6 +204,8 @@ static int checkescape(uint8_t c) {
default:
return -1;
case 'x':
case 'u':
case 'U':
return 1;
case 'n':
return '\n';
@@ -228,6 +233,24 @@ static int checkescape(uint8_t c) {
/* Forward declare */
static int stringchar(JanetParser *p, JanetParseState *state, uint8_t c);
static void write_codepoint(JanetParser *p, int32_t codepoint) {
if (codepoint <= 0x7F) {
push_buf(p, (uint8_t) codepoint);
} else if (codepoint <= 0x7FF) {
push_buf(p, (uint8_t)((codepoint >> 6) & 0x1F) | 0xC0);
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
} else if (codepoint <= 0xFFFF) {
push_buf(p, (uint8_t)((codepoint >> 12) & 0x0F) | 0xE0);
push_buf(p, (uint8_t)((codepoint >> 6) & 0x3F) | 0x80);
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
} else {
push_buf(p, (uint8_t)((codepoint >> 18) & 0x07) | 0xF0);
push_buf(p, (uint8_t)((codepoint >> 12) & 0x3F) | 0x80);
push_buf(p, (uint8_t)((codepoint >> 6) & 0x3F) | 0x80);
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
}
}
static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) {
int digit = to_hex(c);
if (digit < 0) {
@@ -237,7 +260,27 @@ static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) {
state->argn = (state->argn << 4) + digit;
state->counter--;
if (!state->counter) {
push_buf(p, (state->argn & 0xFF));
push_buf(p, (uint8_t)(state->argn & 0xFF));
state->argn = 0;
state->consumer = stringchar;
}
return 1;
}
static int escapeu(JanetParser *p, JanetParseState *state, uint8_t c) {
int digit = to_hex(c);
if (digit < 0) {
p->error = "invalid hex digit in unicode escape";
return 1;
}
state->argn = (state->argn << 4) + digit;
state->counter--;
if (!state->counter) {
if (state->argn > 0x10FFFF) {
p->error = "invalid unicode codepoint";
return 1;
}
write_codepoint(p, state->argn);
state->argn = 0;
state->consumer = stringchar;
}
@@ -254,6 +297,10 @@ static int escape1(JanetParser *p, JanetParseState *state, uint8_t c) {
state->counter = 2;
state->argn = 0;
state->consumer = escapeh;
} else if (c == 'u' || c == 'U') {
state->counter = c == 'u' ? 4 : 6;
state->argn = 0;
state->consumer = escapeu;
} else {
push_buf(p, (uint8_t) e);
state->consumer = stringchar;
@@ -393,21 +440,23 @@ static Janet close_array(JanetParser *p, JanetParseState *state) {
static Janet close_struct(JanetParser *p, JanetParseState *state) {
JanetKV *st = janet_struct_begin(state->argn >> 1);
for (int32_t i = state->argn; i > 0; i -= 2) {
Janet value = p->args[--p->argcount];
Janet key = p->args[--p->argcount];
for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) {
Janet key = p->args[i];
Janet value = p->args[i + 1];
janet_struct_put(st, key, value);
}
p->argcount -= state->argn;
return janet_wrap_struct(janet_struct_end(st));
}
static Janet close_table(JanetParser *p, JanetParseState *state) {
JanetTable *table = janet_table(state->argn >> 1);
for (int32_t i = state->argn; i > 0; i -= 2) {
Janet value = p->args[--p->argcount];
Janet key = p->args[--p->argcount];
for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) {
Janet key = p->args[i];
Janet value = p->args[i + 1];
janet_table_put(table, key, value);
}
p->argcount -= state->argn;
return janet_wrap_table(table);
}
@@ -591,11 +640,30 @@ void janet_parser_eof(JanetParser *parser) {
size_t oldline = parser->line;
janet_parser_consume(parser, '\n');
if (parser->statecount > 1) {
parser->error = "unexpected end of source";
JanetParseState *s = parser->states + (parser->statecount - 1);
JanetBuffer *buffer = janet_buffer(40);
janet_buffer_push_cstring(buffer, "unexpected end of source, ");
if (s->flags & PFLAG_PARENS) {
janet_buffer_push_u8(buffer, '(');
} else if (s->flags & PFLAG_SQRBRACKETS) {
janet_buffer_push_u8(buffer, '[');
} else if (s->flags & PFLAG_CURLYBRACKETS) {
janet_buffer_push_u8(buffer, '{');
} else if (s->flags & PFLAG_STRING) {
janet_buffer_push_u8(buffer, '"');
} else if (s->flags & PFLAG_LONGSTRING) {
int32_t i;
for (i = 0; i < s->argn; i++) {
janet_buffer_push_u8(buffer, '`');
}
}
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
parser->error = (const char *) janet_string(buffer->data, buffer->count);
parser->flag |= JANET_PARSER_GENERATED_ERROR;
}
parser->line = oldline;
parser->column = oldcolumn;
parser->flag = 1;
parser->flag |= JANET_PARSER_DEAD;
}
enum JanetParserStatus janet_parser_status(JanetParser *parser) {
@@ -617,6 +685,7 @@ const char *janet_parser_error(JanetParser *parser) {
if (status == JANET_PARSE_ERROR) {
const char *e = parser->error;
parser->error = NULL;
parser->flag &= ~JANET_PARSER_GENERATED_ERROR;
janet_parser_flush(parser);
return e;
}
@@ -688,20 +757,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:
@@ -721,6 +789,9 @@ static int parsermark(void *p, size_t size) {
for (i = 0; i < parser->argcount; i++) {
janet_mark(parser->args[i]);
}
if (parser->flag & JANET_PARSER_GENERATED_ERROR) {
janet_mark(janet_wrap_string(parser->error));
}
return 0;
}
@@ -733,31 +804,26 @@ static int parsergc(void *p, size_t size) {
static int parserget(void *p, Janet key, Janet *out);
static JanetAbstractType janet_parse_parsertype = {
const JanetAbstractType janet_parser_type = {
"core/parser",
parsergc,
parsermark,
parserget,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL
JANET_ATEND_GET
};
/* C Function parser */
static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
(void) argv;
janet_fixarity(argc, 0);
JanetParser *p = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
JanetParser *p = janet_abstract(&janet_parser_type, sizeof(JanetParser));
janet_parser_init(p);
return janet_wrap_abstract(p);
}
static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
JanetByteView view = janet_getbytes(argv, 1);
if (argc == 3) {
int32_t offset = janet_getinteger(argv, 2);
@@ -782,14 +848,14 @@ static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
static Janet cfun_parse_eof(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
janet_parser_eof(p);
return argv[0];
}
static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
JanetParseState *s = p->states + p->statecount - 1;
if (s->consumer == tokenchar) {
janet_parser_consume(p, ' ');
@@ -813,7 +879,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");
@@ -823,13 +889,13 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
static Janet cfun_parse_has_more(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
return janet_wrap_boolean(janet_parser_has_more(p));
}
static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
int32_t i = janet_getinteger(argv, 1);
janet_parser_consume(p, 0xFF & i);
return argv[0];
@@ -837,7 +903,7 @@ static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
static Janet cfun_parse_status(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
const char *stat = NULL;
switch (janet_parser_status(p)) {
case JANET_PARSE_PENDING:
@@ -858,28 +924,32 @@ static Janet cfun_parse_status(int32_t argc, Janet *argv) {
static Janet cfun_parse_error(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
const char *err = janet_parser_error(p);
if (err) return janet_cstringv(err);
if (err) {
return (p->flag & JANET_PARSER_GENERATED_ERROR)
? janet_wrap_string(err)
: janet_cstringv(err);
}
return janet_wrap_nil();
}
static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
return janet_parser_produce(p);
}
static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
janet_parser_flush(p);
return argv[0];
}
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
Janet *tup = janet_tuple_begin(2);
tup[0] = janet_wrap_integer(p->line);
tup[1] = janet_wrap_integer(p->column);
@@ -896,7 +966,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));
}
@@ -959,31 +1029,30 @@ struct ParserStateGetter {
};
static Janet parser_state_delimiters(const JanetParser *_p) {
JanetParser *clone = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
janet_parser_clone(_p, clone);
JanetParser *p = (JanetParser *)_p;
size_t i;
const uint8_t *str;
size_t oldcount;
oldcount = clone->bufcount;
for (i = 0; i < clone->statecount; i++) {
JanetParseState *s = clone->states + i;
oldcount = p->bufcount;
for (i = 0; i < p->statecount; i++) {
JanetParseState *s = p->states + i;
if (s->flags & PFLAG_PARENS) {
push_buf(clone, '(');
push_buf(p, '(');
} else if (s->flags & PFLAG_SQRBRACKETS) {
push_buf(clone, '[');
push_buf(p, '[');
} else if (s->flags & PFLAG_CURLYBRACKETS) {
push_buf(clone, '{');
push_buf(p, '{');
} else if (s->flags & PFLAG_STRING) {
push_buf(clone, '"');
push_buf(p, '"');
} else if (s->flags & PFLAG_LONGSTRING) {
int32_t i;
for (i = 0; i < s->argn; i++) {
push_buf(clone, '`');
push_buf(p, '`');
}
}
}
str = janet_string(clone->buf + oldcount, (int32_t)(clone->bufcount - oldcount));
clone->bufcount = oldcount;
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
p->bufcount = oldcount;
return janet_wrap_string(str);
}
@@ -1010,7 +1079,7 @@ static const struct ParserStateGetter parser_state_getters[] = {
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
const uint8_t *key = NULL;
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
if (argc == 2) {
key = janet_getkeyword(argv, 1);
}
@@ -1037,8 +1106,8 @@ static Janet cfun_parse_state(int32_t argc, Janet *argv) {
static Janet cfun_parse_clone(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *src = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *dest = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
JanetParser *src = janet_getabstract(argv, 0, &janet_parser_type);
JanetParser *dest = janet_abstract(&janet_parser_type, sizeof(JanetParser));
janet_parser_clone(src, dest);
return janet_wrap_abstract(dest);
}

View File

@@ -35,34 +35,6 @@
* Runtime
*/
/* opcodes for peg vm */
typedef enum {
RULE_LITERAL, /* [len, bytes...] */
RULE_NCHAR, /* [n] */
RULE_NOTNCHAR, /* [n] */
RULE_RANGE, /* [lo | hi << 16 (1 word)] */
RULE_SET, /* [bitmap (8 words)] */
RULE_LOOK, /* [offset, rule] */
RULE_CHOICE, /* [len, rules...] */
RULE_SEQUENCE, /* [len, rules...] */
RULE_IF, /* [rule_a, rule_b (b if a)] */
RULE_IFNOT, /* [rule_a, rule_b (b if not a)] */
RULE_NOT, /* [rule] */
RULE_BETWEEN, /* [lo, hi, rule] */
RULE_GETTAG, /* [searchtag, tag] */
RULE_CAPTURE, /* [rule, tag] */
RULE_POSITION, /* [tag] */
RULE_ARGUMENT, /* [argument-index, tag] */
RULE_CONSTANT, /* [constant, tag] */
RULE_ACCUMULATE, /* [rule, tag] */
RULE_GROUP, /* [rule, tag] */
RULE_REPLACE, /* [rule, constant, tag] */
RULE_MATCHTIME, /* [rule, constant, tag] */
RULE_ERROR, /* [rule] */
RULE_DROP, /* [rule] */
RULE_BACKMATCH, /* [tag] */
} Opcode;
/* Hold captured patterns and match state */
typedef struct {
const uint8_t *text_start;
@@ -348,9 +320,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);
@@ -369,19 +341,23 @@ tail:
s->mode = oldmode;
if (!result) return NULL;
Janet cap;
Janet cap = janet_wrap_nil();
Janet constant = s->constants[rule[2]];
switch (janet_type(constant)) {
default:
cap = constant;
break;
case JANET_STRUCT:
cap = janet_struct_get(janet_unwrap_struct(constant),
s->captures->data[s->captures->count - 1]);
if (s->captures->count) {
cap = janet_struct_get(janet_unwrap_struct(constant),
s->captures->data[s->captures->count - 1]);
}
break;
case JANET_TABLE:
cap = janet_table_get(janet_unwrap_table(constant),
s->captures->data[s->captures->count - 1]);
if (s->captures->count) {
cap = janet_table_get(janet_unwrap_table(constant),
s->captures->data[s->captures->count - 1]);
}
break;
case JANET_CFUNCTION:
cap = janet_unwrap_cfunction(constant)(s->captures->count - cs.cap,
@@ -476,7 +452,7 @@ JANET_NO_RETURN static void peg_panic(Builder *b, const char *msg) {
static void peg_fixarity(Builder *b, int32_t argc, int32_t arity) {
if (argc != arity) {
peg_panicf(b, "expected %d argument%s, got %d%",
peg_panicf(b, "expected %d argument%s, got %d",
arity,
arity == 1 ? "" : "s",
argc);
@@ -1012,16 +988,9 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
* Post-Compilation
*/
typedef struct {
uint32_t *bytecode;
Janet *constants;
size_t bytecode_len;
uint32_t num_constants;
} Peg;
static int peg_mark(void *p, size_t size) {
(void) size;
Peg *peg = (Peg *)p;
JanetPeg *peg = (JanetPeg *)p;
if (NULL != peg->constants)
for (uint32_t i = 0; i < peg->num_constants; i++)
janet_mark(peg->constants[i]);
@@ -1029,7 +998,7 @@ static int peg_mark(void *p, size_t size) {
}
static void peg_marshal(void *p, JanetMarshalContext *ctx) {
Peg *peg = (Peg *)p;
JanetPeg *peg = (JanetPeg *)p;
janet_marshal_size(ctx, peg->bytecode_len);
janet_marshal_int(ctx, (int32_t)peg->num_constants);
janet_marshal_abstract(ctx, p);
@@ -1051,7 +1020,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
uint32_t num_constants = (uint32_t) janet_unmarshal_int(ctx);
/* Calculate offsets. Should match those in make_peg */
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
size_t bytecode_start = size_padded(sizeof(JanetPeg), 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) * (size_t) num_constants;
@@ -1061,7 +1030,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
/* Allocate PEG */
char *mem = janet_unmarshal_abstract(ctx, total_size);
Peg *peg = (Peg *)mem;
JanetPeg *peg = (JanetPeg *)mem;
uint32_t *bytecode = (uint32_t *)(mem + bytecode_start);
Janet *constants = (Janet *)(mem + constants_start);
peg->bytecode = NULL;
@@ -1204,7 +1173,7 @@ bad:
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out);
static const JanetAbstractType peg_type = {
const JanetAbstractType janet_peg_type = {
"core/peg",
NULL,
peg_mark,
@@ -1212,31 +1181,29 @@ static const JanetAbstractType peg_type = {
NULL,
peg_marshal,
peg_unmarshal,
NULL,
NULL,
NULL
JANET_ATEND_UNMARSHAL
};
/* Convert Builder to Peg (Janet Abstract Value) */
static Peg *make_peg(Builder *b) {
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
/* Convert Builder to JanetPeg (Janet Abstract Value) */
static JanetPeg *make_peg(Builder *b) {
size_t bytecode_start = size_padded(sizeof(JanetPeg), sizeof(uint32_t));
size_t bytecode_size = janet_v_count(b->bytecode) * sizeof(uint32_t);
size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet));
size_t constants_size = janet_v_count(b->constants) * sizeof(Janet);
size_t total_size = constants_start + constants_size;
char *mem = janet_abstract(&peg_type, total_size);
Peg *peg = (Peg *)mem;
char *mem = janet_abstract(&janet_peg_type, total_size);
JanetPeg *peg = (JanetPeg *)mem;
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;
}
/* Compiler entry point */
static Peg *compile_peg(Janet x) {
static JanetPeg *compile_peg(Janet x) {
Builder builder;
builder.grammar = janet_table(0);
builder.default_grammar = janet_get_core_table("default-peg-grammar");
@@ -1247,7 +1214,7 @@ static Peg *compile_peg(Janet x) {
builder.form = x;
builder.depth = JANET_RECURSION_GUARD;
peg_compile1(&builder, x);
Peg *peg = make_peg(&builder);
JanetPeg *peg = make_peg(&builder);
builder_cleanup(&builder);
return peg;
}
@@ -1258,15 +1225,15 @@ static Peg *compile_peg(Janet x) {
static Janet cfun_peg_compile(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
Peg *peg = compile_peg(argv[0]);
JanetPeg *peg = compile_peg(argv[0]);
return janet_wrap_abstract(peg);
}
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
janet_arity(argc, 2, -1);
Peg *peg;
JanetPeg *peg;
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &peg_type) {
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
peg = janet_unwrap_abstract(argv[0]);
} else {
peg = compile_peg(argv[0]);
@@ -1325,7 +1292,7 @@ static const JanetReg peg_cfuns[] = {
/* Load the peg module */
void janet_lib_peg(JanetTable *env) {
janet_core_cfuns(env, NULL, peg_cfuns);
janet_register_abstract_type(&peg_type);
janet_register_abstract_type(&janet_peg_type);
}
#endif /* ifdef JANET_PEG */

View File

@@ -156,7 +156,7 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
break;
default:
if (c < 32 || c > 127) {
if (c < 32 || c > 126) {
uint8_t buf[4];
buf[0] = '\\';
buf[1] = 'x';
@@ -177,6 +177,10 @@ 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);
}
@@ -248,6 +252,26 @@ 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)) {
@@ -261,10 +285,6 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
return;
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;
}
@@ -326,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)) {
@@ -362,8 +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
#define JANET_PRETTY_DICT_LIMIT 30
#define JANET_PRETTY_ARRAY_LIMIT 160
/* Helper for pretty printing */
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
@@ -494,6 +591,11 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
for (i = 0; i < cap; i++) {
if (!janet_checktype(kvs[i].key, JANET_NIL)) {
if (counter == JANET_PRETTY_DICT_LIMIT) {
print_newline(S, 0);
janet_buffer_push_cstring(S->buffer, "...");
break;
}
if (first_kv_pair) {
first_kv_pair = 0;
} else {
@@ -503,11 +605,6 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
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;
}
}
}
}
@@ -544,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)
@@ -568,96 +688,6 @@ static void pushtypes(JanetBuffer *buffer, int types) {
}
}
void janet_formatb(JanetBuffer *bufp, const char *format, va_list args) {
for (const char *c = format; *c; c++) {
switch (*c) {
default:
janet_buffer_push_u8(bufp, *c);
break;
case '%': {
if (c[1] == '\0')
break;
switch (*++c) {
default:
janet_buffer_push_u8(bufp, *c);
break;
case 'f':
number_to_string_b(bufp, va_arg(args, double));
break;
case 'd':
integer_to_string_b(bufp, va_arg(args, long));
break;
case 'S': {
const uint8_t *str = va_arg(args, const uint8_t *);
janet_buffer_push_bytes(bufp, str, janet_string_length(str));
break;
}
case 's':
janet_buffer_push_cstring(bufp, va_arg(args, const char *));
break;
case 'c':
janet_buffer_push_u8(bufp, (uint8_t) va_arg(args, long));
break;
case 'q': {
const uint8_t *str = va_arg(args, const uint8_t *);
janet_escape_string_b(bufp, str);
break;
}
case 't': {
janet_buffer_push_cstring(bufp, typestr(va_arg(args, Janet)));
break;
}
case 'T': {
int types = va_arg(args, long);
pushtypes(bufp, types);
break;
}
case 'V': {
janet_to_string_b(bufp, va_arg(args, Janet));
break;
}
case 'v': {
janet_description_b(bufp, va_arg(args, Janet));
break;
}
case 'p': {
janet_pretty(bufp, 4, 0, va_arg(args, Janet));
break;
}
case 'P': {
janet_pretty(bufp, 4, JANET_PRETTY_COLOR, va_arg(args, Janet));
break;
}
}
}
}
}
}
/* Helper function for formatting strings. Useful for generating error messages and the like.
* Similar to printf, but specialized for operating with janet. */
const uint8_t *janet_formatc(const char *format, ...) {
va_list args;
const uint8_t *ret;
JanetBuffer buffer;
int32_t len = 0;
/* Calculate length, init buffer and args */
while (format[len]) len++;
janet_buffer_init(&buffer, len);
va_start(args, format);
/* Run format */
janet_formatb(&buffer, format, args);
/* Iterate length */
va_end(args);
ret = janet_string(buffer.data, buffer.count);
janet_buffer_deinit(&buffer);
return ret;
}
/*
* code adapted from lua/lstrlib.c http://lua.org
*/
@@ -698,6 +728,149 @@ static const char *scanformat(
return p;
}
void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
const char *format_end = format + strlen(format);
const char *c = format;
int32_t startlen = b->count;
while (c < format_end) {
if (*c != '%') {
janet_buffer_push_u8(b, (uint8_t) *c++);
} else if (*++c == '%') {
janet_buffer_push_u8(b, (uint8_t) *c++);
} else {
char form[MAX_FORMAT], item[MAX_ITEM];
char width[3], precision[3];
int nb = 0; /* number of bytes in added item */
c = scanformat(c, form, width, precision);
switch (*c++) {
case 'c': {
int n = va_arg(args, long);
nb = snprintf(item, MAX_ITEM, form, n);
break;
}
case 'd':
case 'i':
case 'o':
case 'u':
case 'x':
case 'X': {
int32_t n = va_arg(args, long);
nb = snprintf(item, MAX_ITEM, form, n);
break;
}
case 'a':
case 'A':
case 'e':
case 'E':
case 'f':
case 'g':
case 'G': {
double d = va_arg(args, double);
nb = snprintf(item, MAX_ITEM, form, d);
break;
}
case 's':
case 'S': {
const char *str = va_arg(args, const char *);
int32_t len = c[-1] == 's'
? (int32_t) strlen(str)
: janet_string_length((JanetString) str);
if (form[2] == '\0')
janet_buffer_push_bytes(b, (const uint8_t *) str, len);
else {
if (len != (int32_t) strlen((const char *) str))
janet_panic("string contains zeros");
if (!strchr(form, '.') && len >= 100) {
janet_panic("no precision and string is too long to be formatted");
} else {
nb = snprintf(item, MAX_ITEM, form, str);
}
}
break;
}
case 'V':
janet_to_string_b(b, va_arg(args, Janet));
break;
case 'v':
janet_description_b(b, va_arg(args, Janet));
break;
case 't':
janet_buffer_push_cstring(b, typestr(va_arg(args, Janet)));
break;
case 'T': {
int types = va_arg(args, long);
pushtypes(b, types);
break;
}
case 'Q':
case 'q':
case 'P':
case 'p': { /* janet pretty , precision = depth */
int depth = atoi(precision);
if (depth < 1) depth = 4;
char d = c[-1];
int has_color = (d == 'P') || (d == 'Q');
int has_oneline = (d == 'Q') || (d == 'q');
int flags = 0;
flags |= has_color ? JANET_PRETTY_COLOR : 0;
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
janet_pretty_(b, depth, flags, va_arg(args, Janet), startlen);
break;
}
case 'j': {
int depth = atoi(precision);
if (depth < 1)
depth = JANET_RECURSION_GUARD;
janet_jdn_(b, depth, va_arg(args, Janet), startlen);
break;
}
default: {
/* also treat cases 'nLlh' */
janet_panicf("invalid conversion '%s' to 'format'",
form);
}
}
if (nb >= MAX_ITEM)
janet_panicf("format buffer overflow", form);
if (nb > 0)
janet_buffer_push_bytes(b, (uint8_t *) item, nb);
}
}
}
/* Helper function for formatting strings. Useful for generating error messages and the like.
* Similar to printf, but specialized for operating with janet. */
const uint8_t *janet_formatc(const char *format, ...) {
va_list args;
const uint8_t *ret;
JanetBuffer buffer;
int32_t len = 0;
/* Calculate length, init buffer and args */
while (format[len]) len++;
janet_buffer_init(&buffer, len);
va_start(args, format);
/* Run format */
janet_formatbv(&buffer, format, args);
/* Iterate length */
va_end(args);
ret = janet_string(buffer.data, buffer.count);
janet_buffer_deinit(&buffer);
return ret;
}
JanetBuffer *janet_formatb(JanetBuffer *buffer, const char *format, ...) {
va_list args;
va_start(args, format);
janet_formatbv(buffer, format, args);
va_end(args);
return buffer;
}
/* Shared implementation between string/format and
* buffer/format */
void janet_buffer_format(
@@ -789,6 +962,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

@@ -538,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
* ...
@@ -554,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");
@@ -564,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());
}
@@ -581,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++) {
@@ -600,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

@@ -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;
@@ -51,6 +53,10 @@ extern JANET_THREAD_LOCAL Janet *janet_vm_return_reg;
* along with otherwise bare c function pointers. */
extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
/* Registry for abstract abstract types that can be marshalled.
* We need this to look up the constructors when unmarshalling. */
extern JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
/* Immutable value cache */
extern JANET_THREAD_LOCAL const uint8_t **janet_vm_cache;
extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity;
@@ -69,10 +75,21 @@ 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;
/* Recursionless traversal of data structures */
typedef struct {
JanetGCObject *self;
JanetGCObject *other;
int32_t index;
int32_t index2;
} JanetTraversalNode;
extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal;
extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top;
extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base;
/* Setup / teardown */
#ifdef JANET_THREADS
void janet_threads_init(void);

View File

@@ -51,7 +51,7 @@ const uint8_t *janet_string(const uint8_t *buf, int32_t len) {
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;
}
@@ -187,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));
}
@@ -343,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));
}
@@ -445,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

@@ -208,9 +208,9 @@ static double convert(
/* Approximate exponent in base 2 of mant and exponent. This should get us a good estimate of the final size of the
* number, within * 2^32 or so. */
int32_t mant_exp2_approx = mant->n * 32 + 16;
int32_t exp_exp2_approx = (int32_t)(floor(log2(base) * exponent));
int32_t exp2_approx = mant_exp2_approx + exp_exp2_approx;
int64_t mant_exp2_approx = mant->n * 32 + 16;
int64_t exp_exp2_approx = (int64_t)(floor(log2(base) * exponent));
int64_t exp2_approx = mant_exp2_approx + exp_exp2_approx;
/* Short circuit zero, huge, and small numbers. We use the exponent range of valid IEEE754 doubles (-1022, 1023)
* with a healthy buffer to allow for inaccuracies in the approximation and denormailzed numbers. */
@@ -447,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

@@ -123,7 +123,8 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
dist = otherdist;
hash = otherhash;
} else if (status == 0) {
/* A key was added to the struct more than once */
/* A key was added to the struct more than once - replace old value */
kv->value = value;
return;
}
}
@@ -166,51 +167,3 @@ JanetTable *janet_struct_to_table(const JanetKV *st) {
}
return table;
}
/* Check if two structs are equal */
int janet_struct_equal(const JanetKV *lhs, const JanetKV *rhs) {
int32_t index;
int32_t llen = janet_struct_capacity(lhs);
int32_t rlen = janet_struct_capacity(rhs);
int32_t lhash = janet_struct_hash(lhs);
int32_t rhash = janet_struct_hash(rhs);
if (llen != rlen)
return 0;
if (lhash != rhash)
return 0;
for (index = 0; index < llen; index++) {
const JanetKV *l = lhs + index;
const JanetKV *r = rhs + index;
if (!janet_equals(l->key, r->key))
return 0;
if (!janet_equals(l->value, r->value))
return 0;
}
return 1;
}
/* Compare structs */
int janet_struct_compare(const JanetKV *lhs, const JanetKV *rhs) {
int32_t i;
int32_t lhash = janet_struct_hash(lhs);
int32_t rhash = janet_struct_hash(rhs);
int32_t llen = janet_struct_capacity(lhs);
int32_t rlen = janet_struct_capacity(rhs);
if (llen < rlen)
return -1;
if (llen > rlen)
return 1;
if (lhash < rhash)
return -1;
if (lhash > rhash)
return 1;
for (i = 0; i < llen; ++i) {
const JanetKV *l = lhs + i;
const JanetKV *r = rhs + i;
int comp = janet_compare(l->key, r->key);
if (comp != 0) return comp;
comp = janet_compare(l->value, r->value);
if (comp != 0) return comp;
}
return 0;
}

View File

@@ -183,7 +183,7 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
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

@@ -51,10 +51,6 @@ struct JanetMailbox {
pthread_cond_t cond;
#endif
/* Setup procedure - requires a parent mailbox
* to receive thunk from */
JanetMailbox *parent;
/* Memory management - reference counting */
int refCount;
int closed;
@@ -70,6 +66,11 @@ struct JanetMailbox {
JanetBuffer messages[];
};
typedef struct {
JanetMailbox *original;
JanetMailbox *newbox;
} JanetMailboxPair;
static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL;
static JANET_THREAD_LOCAL JanetThread *janet_vm_thread_current = NULL;
static JANET_THREAD_LOCAL JanetTable *janet_vm_thread_decode = NULL;
@@ -82,7 +83,7 @@ static JanetTable *janet_thread_get_decode(void) {
return janet_vm_thread_decode;
}
static JanetMailbox *janet_mailbox_create(JanetMailbox *parent, int refCount, uint16_t capacity) {
static JanetMailbox *janet_mailbox_create(int refCount, uint16_t capacity) {
JanetMailbox *mailbox = malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
if (NULL == mailbox) {
JANET_OUT_OF_MEMORY;
@@ -96,7 +97,6 @@ static JanetMailbox *janet_mailbox_create(JanetMailbox *parent, int refCount, ui
#endif
mailbox->refCount = refCount;
mailbox->closed = 0;
mailbox->parent = parent;
mailbox->messageCount = 0;
mailbox->messageCapacity = capacity;
mailbox->messageFirst = 0;
@@ -175,6 +175,23 @@ static int thread_mark(void *p, size_t size) {
return 0;
}
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) {
JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair));
if (NULL == pair) {
JANET_OUT_OF_MEMORY;
}
pair->original = original;
janet_mailbox_ref(original, 1);
pair->newbox = janet_mailbox_create(1, 16);
return pair;
}
static void destroy_mailbox_pair(JanetMailboxPair *pair) {
janet_mailbox_ref(pair->original, -1);
janet_mailbox_ref(pair->newbox, -1);
free(pair);
}
/* Abstract waiting for timeout across windows/posix */
typedef struct {
int timedwait;
@@ -312,7 +329,7 @@ int janet_thread_send(JanetThread *thread, Janet msg, double timeout) {
msgbuf->count = 0;
/* Start panic zone */
janet_marshal(msgbuf, msg, thread->encode, 0);
janet_marshal(msgbuf, msg, thread->encode, JANET_MARSHAL_UNSAFE);
/* End panic zone */
mailbox->messageNext = (mailbox->messageNext + 1) % mailbox->messageCapacity;
@@ -362,7 +379,7 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
const uint8_t *nextItem = NULL;
Janet item = janet_unmarshal(
msgbuf->data, msgbuf->count,
0, janet_thread_get_decode(), &nextItem);
JANET_MARSHAL_UNSAFE, janet_thread_get_decode(), &nextItem);
*msg_out = item;
/* Cleanup */
@@ -392,37 +409,34 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
static int janet_thread_getter(void *p, Janet key, Janet *out);
static JanetAbstractType Thread_AT = {
const JanetAbstractType janet_thread_type = {
"core/thread",
thread_gc,
thread_mark,
janet_thread_getter,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL
JANET_ATEND_GET
};
static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) {
JanetThread *thread = janet_abstract(&Thread_AT, sizeof(JanetThread));
JanetThread *thread = janet_abstract(&janet_thread_type, sizeof(JanetThread));
janet_mailbox_ref(mailbox, 1);
thread->mailbox = mailbox;
thread->encode = encode;
return thread;
}
JanetThread *janet_getthread(const Janet *argv, int32_t n) {
return (JanetThread *) janet_getabstract(argv, n, &Thread_AT);
return (JanetThread *) janet_getabstract(argv, n, &janet_thread_type);
}
/* Runs in new thread */
static int thread_worker(JanetMailbox *mailbox) {
static int thread_worker(JanetMailboxPair *pair) {
JanetFiber *fiber = NULL;
Janet out;
/* Use the mailbox we were given */
janet_vm_mailbox = mailbox;
janet_vm_mailbox = pair->newbox;
janet_mailbox_ref(pair->newbox, 1);
/* Init VM */
janet_init();
@@ -431,9 +445,7 @@ static int thread_worker(JanetMailbox *mailbox) {
JanetTable *encode = janet_get_core_table("make-image-dict");
/* Create parent thread */
JanetThread *parent = janet_make_thread(mailbox->parent, encode);
janet_mailbox_ref(mailbox->parent, -1);
mailbox->parent = NULL; /* only used to create the thread */
JanetThread *parent = janet_make_thread(pair->original, encode);
Janet parentv = janet_wrap_abstract(parent);
/* Unmarshal the function */
@@ -454,16 +466,18 @@ static int thread_worker(JanetMailbox *mailbox) {
fiber = janet_fiber(func, 64, 1, argv);
JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out);
if (sig != JANET_SIGNAL_OK) {
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(mailbox, encode)));
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode)));
janet_stacktrace(fiber, out);
}
/* Normal exit */
destroy_mailbox_pair(pair);
janet_deinit();
return 0;
/* Fail to set something up */
error:
destroy_mailbox_pair(pair);
janet_eprintf("\nthread failed to start\n");
janet_deinit();
return 1;
@@ -472,12 +486,12 @@ error:
#ifdef JANET_WINDOWS
static DWORD WINAPI janet_create_thread_wrapper(LPVOID param) {
thread_worker((JanetMailbox *)param);
thread_worker((JanetMailboxPair *)param);
return 0;
}
static int janet_thread_start_child(JanetThread *thread) {
HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, thread->mailbox, 0, NULL);
static int janet_thread_start_child(JanetMailboxPair *pair) {
HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, pair, 0, NULL);
int ret = NULL == handle;
/* Does not kill thread, simply detatches */
if (!ret) CloseHandle(handle);
@@ -487,13 +501,13 @@ static int janet_thread_start_child(JanetThread *thread) {
#else
static void *janet_pthread_wrapper(void *param) {
thread_worker((JanetMailbox *)param);
thread_worker((JanetMailboxPair *)param);
return NULL;
}
static int janet_thread_start_child(JanetThread *thread) {
static int janet_thread_start_child(JanetMailboxPair *pair) {
pthread_t handle;
int error = pthread_create(&handle, NULL, janet_pthread_wrapper, thread->mailbox);
int error = pthread_create(&handle, NULL, janet_pthread_wrapper, pair);
if (error) {
return 1;
} else {
@@ -510,7 +524,7 @@ static int janet_thread_start_child(JanetThread *thread) {
void janet_threads_init(void) {
if (NULL == janet_vm_mailbox) {
janet_vm_mailbox = janet_mailbox_create(NULL, 1, 10);
janet_vm_mailbox = janet_mailbox_create(1, 10);
}
janet_vm_thread_decode = NULL;
janet_vm_thread_current = NULL;
@@ -534,7 +548,6 @@ static Janet cfun_thread_current(int32_t argc, Janet *argv) {
janet_fixarity(argc, 0);
if (NULL == janet_vm_thread_current) {
janet_vm_thread_current = janet_make_thread(janet_vm_mailbox, janet_get_core_table("make-image-dict"));
janet_mailbox_ref(janet_vm_mailbox, 1);
janet_gcroot(janet_wrap_abstract(janet_vm_thread_current));
}
return janet_wrap_abstract(janet_vm_thread_current);
@@ -549,15 +562,11 @@ static Janet cfun_thread_new(int32_t argc, Janet *argv) {
janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap);
}
JanetTable *encode = janet_get_core_table("make-image-dict");
JanetMailbox *mailbox = janet_mailbox_create(janet_vm_mailbox, 2, (uint16_t) cap);
/* one for created thread, one for ->parent reference in new mailbox */
janet_mailbox_ref(janet_vm_mailbox, 2);
JanetThread *thread = janet_make_thread(mailbox, encode);
if (janet_thread_start_child(thread)) {
janet_mailbox_ref(mailbox, -1); /* mailbox reference */
janet_mailbox_ref(janet_vm_mailbox, -1); /* ->parent reference */
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox);
JanetThread *thread = janet_make_thread(pair->newbox, encode);
if (janet_thread_start_child(pair)) {
destroy_mailbox_pair(pair);
janet_panic("could not start thread");
}
@@ -655,7 +664,7 @@ static const JanetReg threadlib_cfuns[] = {
/* Module entry point */
void janet_lib_thread(JanetTable *env) {
janet_core_cfuns(env, NULL, threadlib_cfuns);
janet_register_abstract_type(&Thread_AT);
janet_register_abstract_type(&janet_thread_type);
}
#endif

View File

@@ -49,49 +49,10 @@ 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);
}
/* Check if two tuples are equal */
int janet_tuple_equal(const Janet *lhs, const Janet *rhs) {
int32_t index;
int32_t llen = janet_tuple_length(lhs);
int32_t rlen = janet_tuple_length(rhs);
int32_t lhash = janet_tuple_hash(lhs);
int32_t rhash = janet_tuple_hash(rhs);
if (lhash == 0)
lhash = janet_tuple_hash(lhs) = janet_array_calchash(lhs, llen);
if (rhash == 0)
rhash = janet_tuple_hash(rhs) = janet_array_calchash(rhs, rlen);
if (lhash != rhash)
return 0;
if (llen != rlen)
return 0;
for (index = 0; index < llen; index++) {
if (!janet_equals(lhs[index], rhs[index]))
return 0;
}
return 1;
}
/* Compare tuples */
int janet_tuple_compare(const Janet *lhs, const Janet *rhs) {
int32_t i;
int32_t llen = janet_tuple_length(lhs);
int32_t rlen = janet_tuple_length(rhs);
int32_t count = llen < rlen ? llen : rlen;
for (i = 0; i < count; ++i) {
int comp = janet_compare(lhs[i], rhs[i]);
if (comp != 0) return comp;
}
if (llen < rlen)
return -1;
else if (llen > rlen)
return 1;
return 0;
}
/* C Functions */
static Janet cfun_tuple_brackets(int32_t argc, Janet *argv) {

View File

@@ -111,7 +111,7 @@ static void *ta_buffer_unmarshal(JanetMarshalContext *ctx) {
return buf;
}
static const JanetAbstractType ta_buffer_type = {
const JanetAbstractType janet_ta_buffer_type = {
"ta/buffer",
ta_buffer_gc,
NULL,
@@ -119,9 +119,7 @@ static const JanetAbstractType ta_buffer_type = {
NULL,
ta_buffer_marshal,
ta_buffer_unmarshal,
NULL,
NULL,
NULL
JANET_ATEND_UNMARSHAL
};
static int ta_mark(void *p, size_t s) {
@@ -156,7 +154,7 @@ static void *ta_view_unmarshal(JanetMarshalContext *ctx) {
offset = janet_unmarshal_size(ctx);
buffer = janet_unmarshal_janet(ctx);
if (!janet_checktype(buffer, JANET_ABSTRACT) ||
(janet_abstract_type(janet_unwrap_abstract(buffer)) != &ta_buffer_type)) {
(janet_abstract_type(janet_unwrap_abstract(buffer)) != &janet_ta_buffer_type)) {
janet_panicf("expected typed array buffer");
}
view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer);
@@ -277,7 +275,7 @@ static void ta_setter(void *p, Janet key, Janet value) {
}
}
static const JanetAbstractType ta_view_type = {
const JanetAbstractType janet_ta_view_type = {
"ta/view",
NULL,
ta_mark,
@@ -285,13 +283,11 @@ static const JanetAbstractType ta_view_type = {
ta_setter,
ta_view_marshal,
ta_view_unmarshal,
NULL,
NULL,
NULL
JANET_ATEND_UNMARSHAL
};
JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
JanetTArrayBuffer *buf = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
JanetTArrayBuffer *buf = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
ta_buffer_init(buf, size);
return buf;
}
@@ -303,13 +299,13 @@ JanetTArrayView *janet_tarray_view(
size_t offset,
JanetTArrayBuffer *buffer) {
JanetTArrayView *view = janet_abstract(&ta_view_type, sizeof(JanetTArrayView));
JanetTArrayView *view = janet_abstract(&janet_ta_view_type, sizeof(JanetTArrayView));
if ((stride < 1) || (size < 1)) janet_panic("stride and size should be > 0");
size_t buf_size = offset + ta_type_sizes[type] * ((size - 1) * stride + 1);
if (NULL == buffer) {
buffer = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
ta_buffer_init(buffer, buf_size);
}
@@ -329,15 +325,15 @@ JanetTArrayView *janet_tarray_view(
}
JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) {
return janet_getabstract(argv, n, &ta_buffer_type);
return janet_getabstract(argv, n, &janet_ta_buffer_type);
}
JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) {
return janet_getabstract(argv, n, &ta_view_type);
return janet_getabstract(argv, n, &janet_ta_view_type);
}
JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) {
JanetTArrayView *view = janet_getabstract(argv, n, &ta_view_type);
JanetTArrayView *view = janet_getabstract(argv, n, &janet_ta_view_type);
if (view->type != type) {
janet_panicf("bad slot #%d, expected typed array of type %s, got %v",
n, ta_type_names[type], argv[n]);
@@ -363,7 +359,7 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
4, argv[4]);
}
void *p = janet_unwrap_abstract(argv[4]);
if (janet_abstract_type(p) == &ta_view_type) {
if (janet_abstract_type(p) == &janet_ta_view_type) {
JanetTArrayView *view = (JanetTArrayView *)p;
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
stride *= view->stride;
@@ -379,7 +375,7 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
static JanetTArrayView *ta_is_view(Janet x) {
if (!janet_checktype(x, JANET_ABSTRACT)) return NULL;
void *abst = janet_unwrap_abstract(x);
if (janet_abstract_type(abst) != &ta_view_type) return NULL;
if (janet_abstract_type(abst) != &janet_ta_view_type) return NULL;
return (JanetTArrayView *)abst;
}
@@ -400,7 +396,7 @@ static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
if ((view = ta_is_view(argv[0]))) {
return janet_wrap_number((double) view->size);
}
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &ta_buffer_type);
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &janet_ta_buffer_type);
return janet_wrap_number((double) buf->size);
}
@@ -437,7 +433,7 @@ static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 3);
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
JanetRange range;
int32_t length = (int32_t)src->size;
if (argc == 1) {
@@ -465,9 +461,9 @@ static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
janet_arity(argc, 4, 5);
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
size_t index_src = janet_getsize(argv, 1);
JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
size_t index_dst = janet_getsize(argv, 3);
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
size_t src_atom_size = ta_type_sizes[src->type];
@@ -492,9 +488,9 @@ static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
janet_arity(argc, 4, 5);
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
size_t index_src = janet_getsize(argv, 1);
JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
size_t index_dst = janet_getsize(argv, 3);
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
size_t src_atom_size = ta_type_sizes[src->type];
@@ -578,8 +574,8 @@ static JanetMethod tarray_view_methods[] = {
/* Module entry point */
void janet_lib_typed_array(JanetTable *env) {
janet_core_cfuns(env, NULL, ta_cfuns);
janet_register_abstract_type(&ta_buffer_type);
janet_register_abstract_type(&ta_view_type);
janet_register_abstract_type(&janet_ta_buffer_type);
janet_register_abstract_type(&janet_ta_view_type);
}
#endif

View File

@@ -200,9 +200,9 @@ static uint32_t halfsiphash(const uint8_t *in, const size_t inlen, const uint8_t
}
/* end of siphash */
static uint8_t hash_key[16] = {0};
static uint8_t hash_key[JANET_HASH_KEY_SIZE] = {0};
void janet_init_hash_key(uint8_t new_key[16]) {
void janet_init_hash_key(uint8_t new_key[JANET_HASH_KEY_SIZE]) {
memcpy(hash_key, new_key, sizeof(hash_key));
}
@@ -248,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) {
@@ -374,7 +380,7 @@ 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) {
static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns, int defprefix) {
uint8_t *longname_buffer = NULL;
size_t prefixlen = 0;
size_t bufsize = 0;
@@ -385,7 +391,7 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
if (NULL == longname_buffer) {
JANET_OUT_OF_MEMORY;
}
memcpy(longname_buffer, regprefix, prefixlen);
safe_memcpy(longname_buffer, regprefix, prefixlen);
longname_buffer[prefixlen] = '/';
prefixlen++;
}
@@ -402,61 +408,52 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
JANET_OUT_OF_MEMORY;
}
}
memcpy(longname_buffer + prefixlen, cfuns->name, nmlen);
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);
if (defprefix) {
JanetTable *subt = janet_table(2);
janet_table_put(subt, janet_ckeywordv("value"), fun);
if (cfuns->documentation)
janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(cfuns->documentation));
janet_table_put(env, name, janet_wrap_table(subt));
} else {
janet_def(env, cfuns->name, fun, cfuns->documentation);
}
janet_table_put(janet_vm_registry, fun, name);
cfuns++;
}
free(longname_buffer);
}
void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
_janet_cfuns_prefix(env, regprefix, cfuns, 1);
}
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
_janet_cfuns_prefix(env, regprefix, cfuns, 0);
}
/* Abstract type introspection */
static const JanetAbstractType type_wrap = {
"core/type-info",
NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL
};
typedef struct {
const JanetAbstractType *at;
} JanetAbstractTypeWrap;
void janet_register_abstract_type(const JanetAbstractType *at) {
JanetAbstractTypeWrap *abstract = (JanetAbstractTypeWrap *)
janet_abstract(&type_wrap, sizeof(JanetAbstractTypeWrap));
abstract->at = at;
Janet sym = janet_csymbolv(at->name);
if (!(janet_checktype(janet_table_get(janet_vm_registry, sym), JANET_NIL))) {
if (!(janet_checktype(janet_table_get(janet_vm_abstract_registry, sym), JANET_NIL))) {
janet_panicf("cannot register abstract type %s, "
"a type with the same name exists", at->name);
}
janet_table_put(janet_vm_registry, sym, janet_wrap_abstract(abstract));
janet_table_put(janet_vm_abstract_registry, sym, janet_wrap_pointer((void *) at));
}
const JanetAbstractType *janet_get_abstract_type(Janet key) {
Janet twrap = janet_table_get(janet_vm_registry, key);
if (janet_checktype(twrap, JANET_NIL)) {
Janet wrapped = janet_table_get(janet_vm_abstract_registry, key);
if (janet_checktype(wrapped, JANET_NIL)) {
return NULL;
}
if (!janet_checktype(twrap, JANET_ABSTRACT) ||
(janet_abstract_type(janet_unwrap_abstract(twrap)) != &type_wrap)) {
janet_panic("expected abstract type");
}
JanetAbstractTypeWrap *w = (JanetAbstractTypeWrap *)janet_unwrap_abstract(twrap);
return w->at;
return (JanetAbstractType *)(janet_unwrap_pointer(wrapped));
}
#ifndef JANET_BOOTSTRAP

View File

@@ -68,6 +68,7 @@ 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);

View File

@@ -22,13 +22,163 @@
#ifndef JANET_AMALG
#include "features.h"
#include "util.h"
#include "state.h"
#include "gc.h"
#include <janet.h>
#endif
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal = NULL;
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top = NULL;
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base = NULL;
static void push_traversal_node(void *lhs, void *rhs, int32_t index2) {
JanetTraversalNode node;
node.self = (JanetGCObject *) lhs;
node.other = (JanetGCObject *) rhs;
node.index = 0;
node.index2 = index2;
if (janet_vm_traversal + 1 >= janet_vm_traversal_top) {
size_t oldsize = janet_vm_traversal - janet_vm_traversal_base;
size_t newsize = 2 * oldsize + 1;
if (newsize < 128) {
newsize = 128;
}
JanetTraversalNode *tn = realloc(janet_vm_traversal_base, newsize * sizeof(JanetTraversalNode));
if (tn == NULL) {
JANET_OUT_OF_MEMORY;
}
janet_vm_traversal_base = tn;
janet_vm_traversal_top = janet_vm_traversal_base + newsize;
janet_vm_traversal = janet_vm_traversal_base + oldsize;
}
*(++janet_vm_traversal) = node;
}
/*
* Used for travsersing structs and tuples without recursion
* Returns:
* 0 - next node found
* 1 - early stop - lhs < rhs
* 2 - no next node found
* 3 - early stop - lhs > rhs
*/
static int traversal_next(Janet *x, Janet *y) {
JanetTraversalNode *t = janet_vm_traversal;
while (t && t > janet_vm_traversal_base) {
JanetGCObject *self = t->self;
JanetTupleHead *tself = (JanetTupleHead *)self;
JanetStructHead *sself = (JanetStructHead *)self;
JanetGCObject *other = t->other;
JanetTupleHead *tother = (JanetTupleHead *)other;
JanetStructHead *sother = (JanetStructHead *)other;
if ((self->flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_TUPLE) {
/* Node is a tuple at index t->index */
if (t->index < tself->length && t->index < tother->length) {
int32_t index = t->index++;
*x = tself->data[index];
*y = tother->data[index];
janet_vm_traversal = t;
return 0;
}
if (t->index2 && tself->length != tother->length) {
return tself->length > tother->length ? 3 : 1;
}
} else {
/* Node is a struct at index t->index: if t->index2 is true, we should return the values. */
if (t->index2) {
t->index2 = 0;
int32_t index = t->index++;
*x = sself->data[index].value;
*y = sother->data[index].value;
janet_vm_traversal = t;
return 0;
}
for (int32_t i = t->index; i < sself->capacity; i++) {
t->index2 = 1;
*x = sself->data[t->index].key;
*y = sother->data[t->index].key;
janet_vm_traversal = t;
return 0;
}
}
t--;
}
janet_vm_traversal = t;
return 2;
}
/*
* Define a number of functions that can be used internally on ANY Janet.
*/
Janet janet_next(Janet ds, Janet key) {
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;
@@ -43,41 +193,51 @@ static int janet_compare_abstract(JanetAbstract xx, JanetAbstract yy) {
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;
if (janet_type(x) != janet_type(y)) {
result = 0;
} else {
janet_vm_traversal = janet_vm_traversal_base;
do {
if (janet_type(x) != janet_type(y)) return 0;
switch (janet_type(x)) {
case JANET_NIL:
result = 1;
break;
case JANET_BOOLEAN:
result = (janet_unwrap_boolean(x) == janet_unwrap_boolean(y));
if (janet_unwrap_boolean(x) != janet_unwrap_boolean(y)) return 0;
break;
case JANET_NUMBER:
result = (janet_unwrap_number(x) == janet_unwrap_number(y));
if (janet_unwrap_number(x) != janet_unwrap_number(y)) return 0;
break;
case JANET_STRING:
result = janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y));
break;
case JANET_TUPLE:
result = janet_tuple_equal(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
break;
case JANET_STRUCT:
result = janet_struct_equal(janet_unwrap_struct(x), janet_unwrap_struct(y));
if (!janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y))) return 0;
break;
case JANET_ABSTRACT:
result = !janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
if (janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y))) return 0;
break;
default:
/* compare pointers */
result = (janet_unwrap_pointer(x) == janet_unwrap_pointer(y));
if (janet_unwrap_pointer(x) != janet_unwrap_pointer(y)) return 0;
break;
case JANET_TUPLE: {
const Janet *t1 = janet_unwrap_tuple(x);
const Janet *t2 = janet_unwrap_tuple(y);
if (t1 == t2) break;
if (janet_tuple_hash(t1) != janet_tuple_hash(t2)) return 0;
if (janet_tuple_length(t1) != janet_tuple_length(t2)) return 0;
push_traversal_node(janet_tuple_head(t1), janet_tuple_head(t2), 0);
break;
}
break;
case JANET_STRUCT: {
const JanetKV *s1 = janet_unwrap_struct(x);
const JanetKV *s2 = janet_unwrap_struct(y);
if (s1 == s2) break;
if (janet_struct_hash(s1) != janet_struct_hash(s2)) return 0;
if (janet_struct_length(s1) != janet_struct_length(s2)) return 0;
push_traversal_node(janet_struct_head(s1), janet_struct_head(s2), 0);
break;
}
break;
}
}
return result;
} while (!traversal_next(&x, &y));
return 1;
}
/* Computes a hash value for a function */
@@ -133,38 +293,71 @@ int32_t janet_hash(Janet x) {
* If y is less, returns 1. All types are comparable
* 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)) {
janet_vm_traversal = janet_vm_traversal_base;
int status;
do {
JanetType tx = janet_type(x);
JanetType ty = janet_type(y);
if (tx != ty) return tx < ty ? -1 : 1;
switch (tx) {
case JANET_NIL:
return 0;
case JANET_BOOLEAN:
return janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
break;
case JANET_BOOLEAN: {
int diff = janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
if (diff) return diff;
break;
}
case JANET_NUMBER: {
double xx = janet_unwrap_number(x);
double yy = janet_unwrap_number(y);
return xx == yy
? 0
: (xx < yy) ? -1 : 1;
if (xx == yy) {
break;
} else {
return (xx < yy) ? -1 : 1;
}
}
case JANET_STRING:
case JANET_SYMBOL:
case JANET_KEYWORD:
return janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y));
case JANET_TUPLE:
return janet_tuple_compare(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
case JANET_STRUCT:
return janet_struct_compare(janet_unwrap_struct(x), janet_unwrap_struct(y));
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;
case JANET_KEYWORD: {
int diff = janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y));
if (diff) return diff;
break;
}
case JANET_ABSTRACT: {
int diff = janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
if (diff) return diff;
break;
}
default: {
if (janet_unwrap_pointer(x) == janet_unwrap_pointer(y)) {
break;
} else {
return janet_unwrap_string(x) > janet_unwrap_string(y) ? 1 : -1;
return janet_unwrap_pointer(x) > janet_unwrap_pointer(y) ? 1 : -1;
}
}
case JANET_TUPLE: {
const Janet *lhs = janet_unwrap_tuple(x);
const Janet *rhs = janet_unwrap_tuple(y);
push_traversal_node(janet_tuple_head(lhs), janet_tuple_head(rhs), 1);
break;
}
case JANET_STRUCT: {
const JanetKV *lhs = janet_unwrap_struct(x);
const JanetKV *rhs = janet_unwrap_struct(y);
int32_t llen = janet_struct_capacity(lhs);
int32_t rlen = janet_struct_capacity(rhs);
int32_t lhash = janet_struct_hash(lhs);
int32_t rhash = janet_struct_hash(rhs);
if (llen < rlen) return -1;
if (llen > rlen) return 1;
if (lhash < rhash) return -1;
if (lhash > rhash) return 1;
push_traversal_node(janet_struct_head(lhs), janet_struct_head(rhs), 0);
break;
}
}
}
return (janet_type(x) < janet_type(y)) ? -1 : 1;
} while (!(status = traversal_next(&x, &y)));
return status - 2;
}
static int32_t getter_checkint(Janet key, int32_t max) {

View File

@@ -45,7 +45,7 @@ void *janet_v_flattenmem(void *v, int32_t itemsize) {
size_t size = (size_t) itemsize * janet_v__cnt(v);
p = malloc(size);
if (NULL != p) {
memcpy(p, v, size);
safe_memcpy(p, v, size);
return p;
} else {
JANET_OUT_OF_MEMORY;

View File

@@ -30,9 +30,12 @@
#include "util.h"
#endif
#include <math.h>
/* VM state */
JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
JANET_THREAD_LOCAL int janet_vm_stackn = 0;
JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber = NULL;
JANET_THREAD_LOCAL Janet *janet_vm_return_reg = NULL;
@@ -86,8 +89,8 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
func = janet_stack_frame(stack)->func; \
} while (0)
#define vm_return(sig, val) do { \
vm_commit(); \
janet_vm_return_reg[0] = (val); \
vm_commit(); \
return (sig); \
} while (0)
@@ -104,13 +107,13 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
#define vm_assert_type(X, T) do { \
if (!(janet_checktype((X), (T)))) { \
vm_commit(); \
janet_panicf("expected %T, got %t", (1 << (T)), (X)); \
janet_panicf("expected %T, got %v", (1 << (T)), (X)); \
} \
} while (0)
#define vm_assert_types(X, TS) do { \
if (!(janet_checktypes((X), (TS)))) { \
vm_commit(); \
janet_panicf("expected %T, got %t", (TS), (X)); \
janet_panicf("expected %T, got %v", (TS), (X)); \
} \
} while (0)
@@ -118,12 +121,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);\
@@ -133,10 +135,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);
@@ -144,17 +152,15 @@ 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(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)
@@ -162,12 +168,16 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
{\
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)
@@ -175,53 +185,77 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
{\
Janet op1 = stack[B];\
Janet op2 = stack[C];\
if (!janet_checktype(op1, JANET_NUMBER) || !janet_checktype(op2, JANET_NUMBER)) {\
vm_commit();\
stack[A] = janet_wrap_boolean(janet_compare(op1, op2) op 0);\
vm_pcnext();\
} else {\
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);
@@ -231,6 +265,35 @@ 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);
}
}
/* Forward declaration */
static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out);
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out);
/* Interpreter main loop */
static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
@@ -249,6 +312,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
&&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,
@@ -264,6 +329,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
&&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,
@@ -304,11 +371,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
&&label_JOP_MAKE_BRACKET_TUPLE,
&&label_JOP_GREATER_THAN_EQUAL,
&&label_JOP_LESS_THAN_EQUAL,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_JOP_NEXT,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
@@ -586,6 +649,37 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
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(&);
@@ -648,6 +742,22 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
}
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)
vm_compop( <);
@@ -680,6 +790,10 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
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();
@@ -714,7 +828,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_assert(func->def->environments_length > eindex, "invalid upvalue environment");
env = func->envs[eindex];
vm_assert(env->length > vindex, "invalid upvalue index");
if (env->offset) {
vm_assert(janet_env_valid(env), "invalid upvalue environment");
if (env->offset > 0) {
/* On stack */
stack[A] = env->as.fiber->data[env->offset + vindex];
} else {
@@ -731,7 +846,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_assert(func->def->environments_length > eindex, "invalid upvalue environment");
env = func->envs[eindex];
vm_assert(env->length > vindex, "invalid upvalue index");
if (env->offset) {
vm_assert(janet_env_valid(env), "invalid upvalue environment");
if (env->offset > 0) {
env->as.fiber->data[env->offset + vindex] = stack[A];
} else {
env->as.values[vindex] = stack[A];
@@ -794,7 +910,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (janet_indexed_view(stack[D], &vals, &len)) {
janet_fiber_pushn(fiber, vals, len);
} else {
janet_panicf("expected %T, got %t", JANET_TFLAG_INDEXED, stack[D]);
janet_panicf("expected %T, got %v", JANET_TFLAG_INDEXED, stack[D]);
}
}
stack = fiber->data + fiber->frame;
@@ -811,7 +927,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
}
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;
@@ -848,7 +966,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
}
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;
@@ -883,8 +1003,12 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
Janet retreg;
vm_assert_type(stack[B], JANET_FIBER);
JanetFiber *child = janet_unwrap_fiber(stack[B]);
if (janet_check_can_resume(child, &retreg)) {
vm_commit();
janet_panicv(retreg);
}
fiber->child = child;
JanetSignal sig = janet_continue(child, stack[C], &retreg);
JanetSignal sig = janet_continue_no_check(child, stack[C], &retreg);
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
vm_return(sig, retreg);
}
@@ -1096,6 +1220,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)) {
@@ -1120,10 +1249,7 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
return *janet_vm_return_reg;
}
/* Enter the main vm loop */
JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
jmp_buf buf;
static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
/* Check conditions */
JanetFiberStatus old_status = janet_fiber_status(fiber);
if (janet_vm_stackn >= JANET_RECURSION_GUARD) {
@@ -1133,12 +1259,20 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
}
if (old_status == JANET_STATUS_ALIVE ||
old_status == JANET_STATUS_DEAD ||
(old_status >= JANET_STATUS_USER0 && old_status <= JANET_STATUS_USER4) ||
old_status == JANET_STATUS_ERROR) {
const uint8_t *str = janet_formatc("cannot resume fiber with status :%s",
janet_status_names[old_status]);
*out = janet_wrap_string(str);
return JANET_SIGNAL_ERROR;
}
return JANET_SIGNAL_OK;
}
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) {
jmp_buf buf;
JanetFiberStatus old_status = janet_fiber_status(fiber);
/* Continue child fiber if it exists */
if (fiber->child) {
@@ -1153,6 +1287,19 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
fiber->child = NULL;
}
/* Handle new fibers being resumed with a non-nil value */
if (old_status == JANET_STATUS_NEW && !janet_checktype(in, JANET_NIL)) {
Janet *stack = fiber->data + fiber->frame;
JanetFunction *func = janet_stack_frame(stack)->func;
if (func) {
if (func->def->arity > 0) {
stack[0] = in;
} else if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
stack[0] = janet_wrap_tuple(janet_tuple_n(&in, 1));
}
}
}
/* Save global state */
int32_t oldn = janet_vm_stackn++;
int handle = janet_vm_gc_suspend;
@@ -1195,6 +1342,14 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
return signal;
}
/* Enter the main vm loop */
JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
/* Check conditions */
JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
if (tmp_signal) return tmp_signal;
return janet_continue_no_check(fiber, in, out);
}
JanetSignal janet_pcall(
JanetFunction *fun,
int32_t argc,
@@ -1219,30 +1374,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 */
@@ -1266,7 +1403,13 @@ int janet_init(void) {
janet_scratch_cap = 0;
/* Initialize registry */
janet_vm_registry = janet_table(0);
janet_vm_abstract_registry = janet_table(0);
janet_gcroot(janet_wrap_table(janet_vm_registry));
janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
/* Traversal */
janet_vm_traversal = NULL;
janet_vm_traversal_base = NULL;
janet_vm_traversal_top = NULL;
/* Core env */
janet_vm_core_env = NULL;
/* Seed RNG */
@@ -1287,7 +1430,9 @@ void janet_deinit(void) {
janet_vm_root_count = 0;
janet_vm_root_capacity = 0;
janet_vm_registry = NULL;
janet_vm_abstract_registry = NULL;
janet_vm_core_env = NULL;
free(janet_vm_traversal_base);
#ifdef JANET_THREADS
janet_threads_deinit();
#endif

View File

@@ -97,7 +97,14 @@ extern "C" {
#endif
/* Check big endian */
#if defined(__MIPSEB__) /* MIPS 32-bit */ \
#if defined(__LITTLE_ENDIAN__) || \
(defined(__BYTE_ORDER__) && (__BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__))
/* If we know the target is LE, always use that - e.g. ppc64 little endian
* defines the __LITTLE_ENDIAN__ macro in the ABI spec, so we can rely
* on that and if that's not defined, fall back to big endian assumption
*/
#define JANET_LITTLE_ENDIAN 1
#elif defined(__MIPSEB__) /* MIPS 32-bit */ \
|| defined(__ppc__) || defined(__PPC__) /* CPU(PPC) - PowerPC 32-bit */ \
|| defined(__powerpc__) || defined(__powerpc) || defined(__POWERPC__) \
|| defined(_M_PPC) || defined(__PPC) \
@@ -656,7 +663,7 @@ struct Janet {
#define janet_type(x) ((x).type)
#define janet_checktype(x, t) ((x).type == (t))
#define janet_truthy(x) \
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.integer & 0x1)))
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.u64 & 0x1)))
#define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
#define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
@@ -681,8 +688,8 @@ 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_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
#define janet_checkint64range(x) ((x) >= INT64_MIN && (x) <= INT64_MAX && (x) == (int64_t)(x))
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
@@ -726,8 +733,9 @@ struct JanetStackFrame {
int32_t flags;
};
/* Number of Janets a frame takes up in the stack */
#define JANET_FRAME_SIZE ((sizeof(JanetStackFrame) + sizeof(Janet) - 1) / sizeof(Janet))
/* Number of Janets a frame takes up in the stack
* Should be constant across architectures */
#define JANET_FRAME_SIZE 4
/* A dynamic array type. */
struct JanetArray {
@@ -805,6 +813,7 @@ struct JanetAbstractHead {
#define JANET_FUNCDEF_FLAG_HASENVS 0x400000
#define JANET_FUNCDEF_FLAG_HASSOURCEMAP 0x800000
#define JANET_FUNCDEF_FLAG_STRUCTARG 0x1000000
#define JANET_FUNCDEF_FLAG_HASCLOBITSET 0x2000000
#define JANET_FUNCDEF_FLAG_TAG 0xFFFF
/* Source mapping structure for a bytecode instruction */
@@ -820,6 +829,7 @@ struct JanetFuncDef {
Janet *constants;
JanetFuncDef **defs;
uint32_t *bytecode;
uint32_t *closure_bitset; /* Bit set indicating which slots can be referenced by closures. */
/* Various debug information */
JanetSourceMapping *sourcemap;
@@ -887,8 +897,9 @@ struct JanetParser {
int flag;
};
/* A context for marshaling and unmarshaling abstract types */
typedef struct {
void *m_state; /* void* to not expose MarshalState ?*/
void *m_state;
void *u_state;
int flags;
const uint8_t *data;
@@ -907,8 +918,27 @@ struct JanetAbstractType {
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;
@@ -946,6 +976,12 @@ struct JanetRNG {
uint32_t counter;
};
typedef struct JanetFile JanetFile;
struct JanetFile {
FILE *file;
int flags;
};
/* Thread types */
#ifdef JANET_THREADS
typedef struct JanetThread JanetThread;
@@ -1005,6 +1041,8 @@ enum JanetOpCode {
JOP_MULTIPLY,
JOP_DIVIDE_IMMEDIATE,
JOP_DIVIDE,
JOP_MODULO,
JOP_REMAINDER,
JOP_BAND,
JOP_BOR,
JOP_BXOR,
@@ -1020,6 +1058,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,
@@ -1060,6 +1100,7 @@ enum JanetOpCode {
JOP_MAKE_BRACKET_TUPLE,
JOP_GREATER_THAN_EQUAL,
JOP_LESS_THAN_EQUAL,
JOP_NEXT,
JOP_INSTRUCTION_COUNT
};
@@ -1071,6 +1112,7 @@ extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
/***** START SECTION MAIN *****/
/* Parsing */
extern JANET_API const JanetAbstractType janet_parser_type;
JANET_API void janet_parser_init(JanetParser *parser);
JANET_API void janet_parser_deinit(JanetParser *parser);
JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c);
@@ -1132,6 +1174,7 @@ JANET_API void janet_debug_find(
JanetString source, int32_t line, int32_t column);
/* RNG */
extern JANET_API const JanetAbstractType janet_rng_type;
JANET_API JanetRNG *janet_default_rng(void);
JANET_API void janet_rng_seed(JanetRNG *rng, uint32_t seed);
JANET_API void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len);
@@ -1166,6 +1209,7 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
#define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
#define janet_tuple_from_head(gcobject) ((const Janet *)((char *)gcobject + offsetof(JanetTupleHead, data)))
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
#define janet_tuple_sm_line(t) (janet_tuple_head(t)->sm_line)
@@ -1174,8 +1218,6 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
JANET_API Janet *janet_tuple_begin(int32_t length);
JANET_API JanetTuple janet_tuple_end(Janet *tuple);
JANET_API JanetTuple janet_tuple_n(const Janet *values, int32_t n);
JANET_API int janet_tuple_equal(JanetTuple lhs, JanetTuple rhs);
JANET_API int janet_tuple_compare(JanetTuple lhs, JanetTuple rhs);
/* String/Symbol functions */
#define janet_string_head(s) ((JanetStringHead *)((char *)s - offsetof(JanetStringHead, data)))
@@ -1195,7 +1237,8 @@ JANET_API void janet_description_b(JanetBuffer *buffer, Janet x);
#define janet_cstringv(cstr) janet_wrap_string(janet_cstring(cstr))
#define janet_stringv(str, len) janet_wrap_string(janet_string((str), (len)))
JANET_API JanetString janet_formatc(const char *format, ...);
JANET_API void janet_formatb(JanetBuffer *bufp, const char *format, va_list args);
JANET_API JanetBuffer *janet_formatb(JanetBuffer *bufp, const char *format, ...);
JANET_API void janet_formatbv(JanetBuffer *bufp, const char *format, va_list args);
/* Symbol functions */
JANET_API JanetSymbol janet_symbol(const uint8_t *str, int32_t len);
@@ -1212,6 +1255,7 @@ JANET_API JanetSymbol janet_symbol_gen(void);
/* Structs */
#define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
#define janet_struct_from_head(t) ((const JanetKV *)((char *)gcobject + offsetof(JanetStructHead, data)))
#define janet_struct_length(t) (janet_struct_head(t)->length)
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
@@ -1220,8 +1264,6 @@ JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
JANET_API JanetStruct janet_struct_end(JanetKV *st);
JANET_API Janet janet_struct_get(JanetStruct st, Janet key);
JANET_API JanetTable *janet_struct_to_table(JanetStruct st);
JANET_API int janet_struct_equal(JanetStruct lhs, JanetStruct rhs);
JANET_API int janet_struct_compare(JanetStruct lhs, JanetStruct rhs);
JANET_API const JanetKV *janet_struct_find(JanetStruct st, Janet key);
/* Table functions */
@@ -1254,6 +1296,7 @@ JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap,
/* Abstract */
#define janet_abstract_head(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
#define janet_abstract_from_head(gcobject) ((JanetAbstract)((char *)gcobject + offsetof(JanetAbstractHead, data)))
#define janet_abstract_type(u) (janet_abstract_head(u)->type)
#define janet_abstract_size(u) (janet_abstract_head(u)->size)
JANET_API void *janet_abstract_begin(const JanetAbstractType *type, size_t size);
@@ -1266,6 +1309,8 @@ typedef JanetBuildConfig(*JanetModconf)(void);
JANET_API JanetModule janet_native(const char *name, JanetString *error);
/* Marshaling */
#define JANET_MARSHAL_UNSAFE 0x20000
JANET_API void janet_marshal(
JanetBuffer *buf,
Janet x,
@@ -1290,6 +1335,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);
@@ -1303,7 +1349,8 @@ JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, J
/* Misc */
#ifndef JANET_NO_PRF
JANET_API void janet_init_hash_key(uint8_t key[16]);
#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);
@@ -1311,6 +1358,7 @@ 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);
@@ -1333,11 +1381,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_scalloc(size_t nmemb, size_t size);
JANET_API void janet_sfinalizer(void *mem, ScratchFinalizer finalizer);
JANET_API void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer);
JANET_API void janet_sfree(void *mem);
/* C Library helpers */
@@ -1440,6 +1489,8 @@ 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);
extern JANET_API const JanetAbstractType janet_file_type;
#define JANET_FILE_WRITE 1
#define JANET_FILE_READ 2
#define JANET_FILE_APPEND 4
@@ -1477,8 +1528,52 @@ JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key);
#ifdef JANET_PEG
extern JANET_API const JanetAbstractType janet_peg_type;
/* opcodes for peg vm */
typedef enum {
RULE_LITERAL, /* [len, bytes...] */
RULE_NCHAR, /* [n] */
RULE_NOTNCHAR, /* [n] */
RULE_RANGE, /* [lo | hi << 16 (1 word)] */
RULE_SET, /* [bitmap (8 words)] */
RULE_LOOK, /* [offset, rule] */
RULE_CHOICE, /* [len, rules...] */
RULE_SEQUENCE, /* [len, rules...] */
RULE_IF, /* [rule_a, rule_b (b if a)] */
RULE_IFNOT, /* [rule_a, rule_b (b if not a)] */
RULE_NOT, /* [rule] */
RULE_BETWEEN, /* [lo, hi, rule] */
RULE_GETTAG, /* [searchtag, tag] */
RULE_CAPTURE, /* [rule, tag] */
RULE_POSITION, /* [tag] */
RULE_ARGUMENT, /* [argument-index, tag] */
RULE_CONSTANT, /* [constant, tag] */
RULE_ACCUMULATE, /* [rule, tag] */
RULE_GROUP, /* [rule, tag] */
RULE_REPLACE, /* [rule, constant, tag] */
RULE_MATCHTIME, /* [rule, constant, tag] */
RULE_ERROR, /* [rule] */
RULE_DROP, /* [rule] */
RULE_BACKMATCH, /* [tag] */
} JanetPegOpcode;
typedef struct {
uint32_t *bytecode;
Janet *constants;
size_t bytecode_len;
uint32_t num_constants;
} JanetPeg;
#endif
#ifdef JANET_TYPED_ARRAY
extern JANET_API const JanetAbstractType janet_ta_view_type;
extern JANET_API const JanetAbstractType janet_ta_buffer_type;
typedef enum {
JANET_TARRAY_TYPE_U8,
JANET_TARRAY_TYPE_S8,
@@ -1529,6 +1624,9 @@ JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n);
#ifdef JANET_INT_TYPES
extern JANET_API const JanetAbstractType janet_s64_type;
extern JANET_API const JanetAbstractType janet_u64_type;
typedef enum {
JANET_INT_NONE,
JANET_INT_S64,
@@ -1545,6 +1643,15 @@ JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
#endif
#ifdef JANET_THREADS
extern JANET_API const JanetAbstractType janet_thread_type;
JANET_API int janet_thread_receive(Janet *msg_out, double timeout);
JANET_API int janet_thread_send(JanetThread *thread, Janet msg, double timeout);
#endif
/***** END SECTION MAIN *****/
#ifdef __cplusplus

View File

@@ -1,40 +0,0 @@
/*
* 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.
*/
#ifndef JANET_LINE_H_defined
#define JANET_LINE_H_defined
#if !defined(_POSIX_C_SOURCE)
#define _POSIX_C_SOURCE 200112L
#endif
#ifndef JANET_AMALG
#include <janet.h>
#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,90 +0,0 @@
/*
* 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
#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;
}

View File

@@ -24,9 +24,25 @@
#define _POSIX_C_SOURCE 200112L
#endif
#ifndef JANET_AMALG
#include "line.h"
#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;
@@ -67,7 +83,7 @@ void janet_line_deinit() {
}
void janet_line_get(const char *p, JanetBuffer *buffer) {
FILE *out = janet_dynfile("out", stdout);
FILE *out = janet_dynfile("err", stderr);
fputs(p, out);
fflush(out);
simpleline(buffer);
@@ -80,8 +96,6 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
https://github.com/antirez/linenoise/blob/master/linenoise.c
*/
#include <janet.h>
#include <termios.h>
#include <unistd.h>
#include <stdlib.h>
@@ -114,6 +128,7 @@ 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[] = {
@@ -236,6 +251,17 @@ static void refresh(void) {
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) {
@@ -268,10 +294,8 @@ static void historymove(int delta) {
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);
@@ -299,10 +323,20 @@ static void addhistory(void) {
}
static void replacehistory(void) {
char *newline = sdup(gbl_buf);
if (!newline) return;
free(gbl_history[0]);
gbl_history[0] = newline;
/* 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) {
@@ -312,6 +346,16 @@ static void kleft(void) {
}
}
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++;
@@ -319,23 +363,54 @@ static void kright(void) {
}
}
static void kbackspace(void) {
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';
refresh();
if (draw) refresh();
}
}
static void kdelete(void) {
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';
refresh();
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;
@@ -440,19 +515,110 @@ static void check_specials(JanetByteView src) {
check_cmatch(src, "while");
}
/* TODO - check against special forms and print in alphabetical order */
static void kshowcomp(void) {
JanetTable *env = gbl_complete_env;
if (env == NULL) {
insert(' ', 0);
insert(' ', 0);
return;
static void resolve_format(JanetTable *entry) {
int is_macro = janet_truthy(janet_table_get(entry, janet_ckeywordv("macro")));
Janet refv = janet_table_get(entry, janet_ckeywordv("ref"));
int is_ref = janet_checktype(refv, JANET_ARRAY);
Janet value = janet_wrap_nil();
if (is_ref) {
JanetArray *a = janet_unwrap_array(refv);
if (a->count) value = a->data[0];
} else {
value = janet_table_get(entry, janet_ckeywordv("value"));
}
if (is_macro) {
fprintf(stderr, " macro\n");
gbl_lines_below++;
} else if (is_ref) {
janet_eprintf(" var (%t)\n", value);
gbl_lines_below++;
} else {
janet_eprintf(" %t\n", value);
gbl_lines_below++;
}
Janet sm = janet_table_get(entry, janet_ckeywordv("source-map"));
Janet path = janet_get(sm, janet_wrap_integer(0));
Janet line = janet_get(sm, janet_wrap_integer(1));
Janet col = janet_get(sm, janet_wrap_integer(2));
if (janet_checktype(path, JANET_STRING) && janet_truthy(line) && janet_truthy(col)) {
janet_eprintf(" %S on line %v, column %v\n", janet_unwrap_string(path), line, col);
gbl_lines_below++;
}
}
JanetByteView prefix = get_symprefix();
if (prefix.len == 0) return;
static void doc_format(JanetString doc, int32_t width) {
int32_t maxcol = width - 8;
uint8_t wordbuf[256] = {0};
int32_t wordp = 0;
int32_t current = 0;
if (maxcol > 200) maxcol = 200;
fprintf(stderr, " ");
for (int32_t i = 0; i < janet_string_length(doc); i++) {
uint8_t b = doc[i];
switch (b) {
default: {
if (maxcol <= current + wordp + 1) {
if (!current) {
fwrite(wordbuf, wordp, 1, stderr);
wordp = 0;
}
fprintf(stderr, "\n ");
gbl_lines_below++;
current = 0;
}
wordbuf[wordp++] = b;
break;
}
case '\t': {
if (maxcol <= current + wordp + 2) {
if (!current) {
fwrite(wordbuf, wordp, 1, stderr);
wordp = 0;
}
fprintf(stderr, "\n ");
gbl_lines_below++;
current = 0;
}
wordbuf[wordp++] = ' ';
wordbuf[wordp++] = ' ';
break;
}
case '\n':
case ' ': {
if (wordp) {
int32_t oldcur = current;
int spacer = maxcol > current + wordp + 1;
if (spacer) current++;
else current = 0;
current += wordp;
if (oldcur) fprintf(stderr, spacer ? " " : "\n ");
if (oldcur && !spacer) gbl_lines_below++;
fwrite(wordbuf, wordp, 1, stderr);
wordp = 0;
}
if (b == '\n') {
fprintf(stderr, "\n ");
gbl_lines_below++;
current = 0;
}
}
}
}
if (wordp) {
int32_t oldcur = current;
int spacer = maxcol > current + wordp + 1;
if (spacer) current++;
else current = 0;
current += wordp + 1;
if (oldcur) fprintf(stderr, spacer ? " " : "\n ");
if (oldcur && !spacer) gbl_lines_below++;
fwrite(wordbuf, wordp, 1, stderr);
wordp = 0;
}
}
/* Find all matches */
static void find_matches(JanetByteView prefix) {
JanetTable *env = gbl_complete_env;
gbl_match_count = 0;
while (NULL != env) {
JanetKV *kvend = env->data + env->capacity;
@@ -463,6 +629,49 @@ static void kshowcomp(void) {
}
env = env->proto;
}
}
static void kshowdoc(void) {
if (!gbl_complete_env) return;
while (is_symbol_char_gen(gbl_buf[gbl_pos])) gbl_pos++;
JanetByteView prefix = get_symprefix();
Janet symbol = janet_symbolv(prefix.bytes, prefix.len);
Janet entry = janet_table_get(gbl_complete_env, symbol);
if (!janet_checktype(entry, JANET_TABLE)) return;
Janet doc = janet_table_get(janet_unwrap_table(entry), janet_ckeywordv("doc"));
if (!janet_checktype(doc, JANET_STRING)) return;
JanetString docs = janet_unwrap_string(doc);
int num_cols = getcols();
clearlines();
fprintf(stderr, "\n\n\n");
gbl_lines_below += 3;
resolve_format(janet_unwrap_table(entry));
fprintf(stderr, "\n");
gbl_lines_below += 1;
doc_format(docs, num_cols);
fprintf(stderr, "\n\n");
gbl_lines_below += 2;
/* Go up to original line (zsh-like autocompletion) */
fprintf(stderr, "\x1B[%dA", gbl_lines_below);
fflush(stderr);
}
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_matches(prefix);
check_specials(prefix);
@@ -471,29 +680,39 @@ static void kshowcomp(void) {
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) {
norawmode();
/* 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) printf("\n");
printf("%-*s", col_width, (const char *) gbl_matches[i].bytes);
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;
}
printf("\n");
rawmode();
/* Go up to original line (zsh-like autocompletion) */
fprintf(stderr, "\x1B[%dA", gbl_lines_below);
fflush(stderr);
}
}
@@ -510,32 +729,15 @@ static int line() {
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;
if (read(STDIN_FILENO, &c, 1) <= 0) return -1;
switch (c) {
default:
if (c < 0x20) break;
if (insert(c, 1)) return -1;
break;
case 9: /* tab */
kshowcomp();
refresh();
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 1: /* ctrl-a */
gbl_pos = 0;
refresh();
@@ -543,6 +745,18 @@ static int line() {
case 2: /* ctrl-b */
kleft();
break;
case 3: /* ctrl-c */
errno = EAGAIN;
gbl_sigint_flag = 1;
clearlines();
return -1;
case 4: /* ctrl-d, eof */
if (gbl_len == 0) { /* quit on empty line */
clearlines();
return -1;
}
kdelete(1);
break;
case 5: /* ctrl-e */
gbl_pos = gbl_len;
refresh();
@@ -550,48 +764,104 @@ static int line() {
case 6: /* ctrl-f */
kright();
break;
case 21:
gbl_buf[0] = '\0';
gbl_pos = gbl_len = 0;
case 7: /* ctrl-g */
kshowdoc();
refresh();
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 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;
/* 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();
kdelete(1);
break;
case '4': /* End */
gbl_pos = gbl_len;
refresh();
break;
default:
break;
}
}
} else {
} else if (seq[0] == 'O') {
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
switch (seq[1]) {
default:
break;
case 'A':
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':
case 'B': /* Down */
historymove(-1);
break;
case 'C': /* Right */
@@ -600,27 +870,38 @@ static int line() {
case 'D': /* Left */
kleft();
break;
case 'H':
case 'H': /* Home */
gbl_pos = 0;
refresh();
break;
case 'F':
case 'F': /* End */
gbl_pos = gbl_len;
refresh();
break;
}
}
} else if (seq[0] == 'O') {
switch (seq[1]) {
} else {
/* Check alt-(shift) bindings */
switch (seq[0]) {
default:
break;
case 'H':
gbl_pos = 0;
refresh();
case 'd': /* Alt-d */
kdeletew();
break;
case 'F':
gbl_pos = gbl_len;
refresh();
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;
case 127: /* Alt-backspace */
kbackspacew();
break;
}
}
@@ -655,7 +936,7 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
gbl_prompt = p;
buffer->count = 0;
gbl_historyi = 0;
FILE *out = janet_dynfile("out", stdout);
FILE *out = janet_dynfile("err", stderr);
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
simpleline(buffer);
return;
@@ -684,3 +965,59 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
}
#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

@@ -0,0 +1,45 @@
#include <stdint.h>
#include <string.h>
#include <janet.h>
int LLVMFuzzerTestOneInput(const uint8_t *data, size_t size) {
/* init Janet */
janet_init();
/* fuzz the parser */
JanetParser parser;
janet_parser_init(&parser);
for (int i = 0, done = 0; i < size; i++) {
switch (janet_parser_status(&parser)) {
case JANET_PARSE_DEAD:
case JANET_PARSE_ERROR:
done = 1;
break;
case JANET_PARSE_PENDING:
if (i == size) {
janet_parser_eof(&parser);
} else {
janet_parser_consume(&parser, data[i]);
}
break;
case JANET_PARSE_ROOT:
if (i >= size) {
janet_parser_eof(&parser);
} else {
janet_parser_consume(&parser, data[i]);
}
break;
}
if (done == 1)
break;
}
janet_parser_deinit(&parser);
/* cleanup Janet */
janet_deinit();
return 0;
}

View File

@@ -8,7 +8,8 @@
(defn assert
"Override's the default assert with some nice error handling."
[x e]
[x &opt e]
(default e "assert error")
(++ num-tests-run)
(when x (++ num-tests-passed))
(if x

View File

@@ -206,6 +206,10 @@
(def 🐮 :cow)
(assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)")
(assert (not= 🦊 "🦊") "utf8 strings are not symbols and vice versa")
(assert (= "\U01F637" "😷") "unicode escape 1")
(assert (= "\u2623" "\U002623" "") "unicode escape 2")
(assert (= "\u24c2" "\U0024c2" "") "unicode escape 3")
(assert (= "\u0061" "a") "unicode escape 4")
# Symbols with @ character
@@ -250,6 +254,11 @@
(assert (apply <= (merge @[1 3 5] @[2 4 6 6 6 9])) "merge sort merge 3")
(assert (apply <= (merge '(1 3 5) @[2 4 6 6 6 9])) "merge sort merge 4")
(assert (deep= @[1 2 3 4 5] (sort @[5 3 4 1 2])) "sort 1")
(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sort-by |($ :a) @[{:a 4} {:a 7} {:a 1}])) "sort 2")
(assert (deep= @[1 2 3 4 5] (sorted [5 3 4 1 2])) "sort 3")
(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sorted-by |($ :a) [{:a 4} {:a 7} {:a 1}])) "sort 4")
# Gensym tests
(assert (not= (gensym) (gensym)) "two gensyms not equal")
@@ -319,5 +328,11 @@
(assert (= true ;(map truthy? [0 "" true @{} {} [] '()])) "truthy values")
(assert (= false ;(map truthy? [nil false])) "non-truthy values")
# Struct and Table duplicate elements
(assert (= {:a 3 :b 2} {:a 1 :b 2 :a 3}) "struct literal duplicate keys")
(assert (= {:a 3 :b 2} (struct :a 1 :b 2 :a 3)) "struct constructor duplicate keys")
(assert (deep= @{:a 3 :b 2} @{:a 1 :b 2 :a 3}) "table literal duplicate keys")
(assert (deep= @{:a 3 :b 2} (table :a 1 :b 2 :a 3)) "table constructor duplicate keys")
(end-suite)

View File

@@ -212,13 +212,17 @@
(assert (= 7 (case :a :b 5 :c 6 :u 10 7)) "case with default")
# Testing the loop and for macros
# Testing the loop and seq macros
(def xs (apply tuple (seq [x :range [0 10] :when (even? x)] (tuple (/ x 2) x))))
(assert (= xs '((0 0) (1 2) (2 4) (3 6) (4 8))) "seq macro 1")
(def xs (apply tuple (seq [x :down [8 -2] :when (even? x)] (tuple (/ x 2) x))))
(assert (= xs '((4 8) (3 6) (2 4) (1 2) (0 0))) "seq macro 2")
# :range-to and :down-to
(assert (deep= (seq [x :range-to [0 10]] x) (seq [x :range [0 11]] x)) "loop :range-to")
(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x)) "loop :down-to")
# Some testing for not=
(assert (not= 1 1 0) "not= 1")
(assert (not= 0 1 1) "not= 2")
@@ -255,4 +259,26 @@
(assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
(assert (array= (array/slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array/slice 2")
# Even and odd
(assert (odd? 9) "odd? 1")
(assert (odd? -9) "odd? 2")
(assert (not (odd? 10)) "odd? 3")
(assert (not (odd? 0)) "odd? 4")
(assert (not (odd? -10)) "odd? 5")
(assert (not (odd? 1.1)) "odd? 6")
(assert (not (odd? -0.1)) "odd? 7")
(assert (not (odd? -1.1)) "odd? 8")
(assert (not (odd? -1.6)) "odd? 9")
(assert (even? 10) "even? 1")
(assert (even? -10) "even? 2")
(assert (even? 0) "even? 3")
(assert (not (even? 9)) "even? 4")
(assert (not (even? -9)) "even? 5")
(assert (not (even? 0.1)) "even? 6")
(assert (not (even? -0.1)) "even? 7")
(assert (not (even? -10.1)) "even? 8")
(assert (not (even? -10.6)) "even? 9")
(end-suite)

View File

@@ -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)]
@@ -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

@@ -226,6 +226,23 @@
:week-day 3}
(os/date 1388608200)) "os/date")
# OS mktime test
(assert (= 1388608200 (os/mktime {:year-day 0
:minutes 30
:month 0
:dst false
:seconds 0
:year 2014
:month-day 0
:hours 20
:week-day 3})) "os/mktime")
(def now (os/time))
(assert (= (os/mktime (os/date now)) now) "UTC os/mktime")
(assert (= (os/mktime (os/date now true) true) now) "local os/mktime")
(assert (= (os/mktime {:year 1970}) 0) "os/mktime default values")
# Appending buffer to self
(with-dyns [:out @""]

255
test/suite8.janet Normal file
View File

@@ -0,0 +1,255 @@
# 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
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite 8)
###
### Compiling brainfuck to Janet.
###
(def- bf-peg
"Peg for compiling brainfuck into a Janet source ast."
(peg/compile
~{:+ (/ '(some "+") ,(fn [x] ~(+= (DATA POS) ,(length x))))
:- (/ '(some "-") ,(fn [x] ~(-= (DATA POS) ,(length x))))
:> (/ '(some ">") ,(fn [x] ~(+= POS ,(length x))))
:< (/ '(some "<") ,(fn [x] ~(-= POS ,(length x))))
:. (* "." (constant (prinf "%c" (get DATA POS))))
:loop (/ (* "[" :main "]") ,(fn [& captures]
~(while (not= (get DATA POS) 0)
,;captures)))
:main (any (+ :s :loop :+ :- :> :< :.)) }))
(defn bf
"Run brainfuck."
[text]
(eval
~(let [DATA (array/new-filled 100 0)]
(var POS 50)
,;(peg/match bf-peg text))))
(defn test-bf
"Test some bf for expected output."
[input output]
(def b @"")
(with-dyns [:out b]
(bf input))
(assert (= (string output) (string b))
(string "bf input '"
input
"' failed, expected "
(describe output)
", got "
(describe (string b))
".")))
(test-bf "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++." "Hello World!\n")
(test-bf ">++++++++[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]>-----.>->
+++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+."
"Hello World!\n")
(test-bf "+[+[<<<+>>>>]+<-<-<<<+<++]<<.<++.<++..+++.<<++.<---.>>.>.+++.------.>-.>>--."
"Hello, World!")
# Prompts and Labels
(assert (= 10 (label a (for i 0 10 (if (= i 5) (return a 10))))) "label 1")
(defn recur
[lab x y]
(when (= x y) (return lab :done))
(def res (label newlab (recur (or lab newlab) (+ x 1) y)))
(if lab :oops res))
(assert (= :done (recur nil 0 10)) "label 2")
(assert (= 10 (prompt :a (for i 0 10 (if (= i 5) (return :a 10))))) "prompt 1")
(defn- inner-loop
[i]
(if (= i 5)
(return :a 10)))
(assert (= 10 (prompt :a (for i 0 10 (inner-loop i)))) "prompt 2")
(defn- inner-loop2
[i]
(try
(if (= i 5)
(error 10))
([err] (return :a err))))
(assert (= 10 (prompt :a (for i 0 10 (inner-loop2 i)))) "prompt 3")
# Match checks
(assert (= :hi (match nil nil :hi)) "match 1")
(assert (= :hi (match {:a :hi} {:a a} a)) "match 2")
(assert (= nil (match {:a :hi} {:a a :b b} a)) "match 3")
(assert (= nil (match [1 2] [a b c] a)) "match 4")
(assert (= 2 (match [1 2] [a b] b)) "match 5")
# And/or checks
(assert (= false (and false false)) "and 1")
(assert (= false (or false false)) "or 1")
# #300 Regression test
# Just don't segfault
(assert (peg/match '{:main (replace "S" {"S" :spade})} "S7") "regression #300")
# Test cases for #293
(assert (= :yes (match [1 2 3] [_ a _] :yes :no)) "match wildcard 1")
(assert (= :no (match [1 2 3] [__ a __] :yes :no)) "match wildcard 2")
(assert (= :yes (match [1 2 [1 2 3]] [_ a [_ _ _]] :yes :no)) "match wildcard 3")
(assert (= :yes (match [1 2 3] (_ (even? 2)) :yes :no)) "match wildcard 4")
(assert (= :yes (match {:a 1} {:a _} :yes :no)) "match wildcard 5")
(assert (= false (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} false :no)) "match wildcard 6")
(assert (= nil (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} nil :no)) "match wildcard 7")
# Regression #301
(def b (buffer/new-filled 128 0x78))
(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1")
(def a @"abcdefghijklm")
(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2")
(assert (deep= @"bcde" (buffer/blit @"" a -1 1 5)) "buffer/blit 3")
(assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4")
(assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5")
# chr
(assert (= (chr "a") 97) "chr 1")
# Detaching closure over non resumable fiber.
(do
(defn f1
[a]
(defn f1 [] (++ (a 0)))
(defn f2 [] (++ (a 0)))
(error [f1 f2]))
(def [_ [f1 f2]] (protect (f1 @[0])))
# At time of writing, mark phase can detach closure envs.
(gccollect)
(assert (= 1 (f1)) "detach-non-resumable-closure 1")
(assert (= 2 (f2)) "detach-non-resumable-closure 2"))
# Marshal closure over non resumable fiber.
(do
(defn f1
[a]
(defn f1 [] (++ (a 0)))
(defn f2 [] (++ (a 0)))
(error [f1 f2]))
(def [_ tup] (protect (f1 @[0])))
(def [f1 f2] (unmarshal (marshal tup make-image-dict) load-image-dict))
(assert (= 1 (f1)) "marshal-non-resumable-closure 1")
(assert (= 2 (f2)) "marshal-non-resumable-closure 2"))
# Marshal closure over currently alive fiber.
(do
(defn f1
[a]
(defn f1 [] (++ (a 0)))
(defn f2 [] (++ (a 0)))
(marshal [f1 f2] make-image-dict))
(def [f1 f2] (unmarshal (f1 @[0]) load-image-dict))
(assert (= 1 (f1)) "marshal-live-closure 1")
(assert (= 2 (f2)) "marshal-live-closure 2"))
(do
(var a 1)
(defn b [x] (+ a x))
(def c (unmarshal (marshal b)))
(assert (= 2 (c 1)) "marshal-on-stack-closure 1"))
# Reduce2
(assert (= (reduce + 0 (range 1 10)) (reduce2 + (range 10))) "reduce2 1")
(assert (= (reduce * 1 (range 2 10)) (reduce2 * (range 1 10))) "reduce2 2")
(assert (= nil (reduce2 * [])) "reduce2 3")
# Accumulate
(assert (deep= (accumulate + 0 (range 5)) @[0 1 3 6 10]) "accumulate 1")
(assert (deep= (accumulate2 + (range 5)) @[0 1 3 6 10]) "accumulate2 1")
(assert (deep= @[] (accumulate2 + [])) "accumulate2 2")
(assert (deep= @[] (accumulate 0 + [])) "accumulate 2")
# Perm strings
(assert (= (os/perm-int "rwxrwxrwx") 8r777) "perm 1")
(assert (= (os/perm-int "rwxr-xr-x") 8r755) "perm 2")
(assert (= (os/perm-int "rw-r--r--") 8r644) "perm 3")
(assert (= (band (os/perm-int "rwxrwxrwx") 8r077) 8r077) "perm 4")
(assert (= (band (os/perm-int "rwxr-xr-x") 8r077) 8r055) "perm 5")
(assert (= (band (os/perm-int "rw-r--r--") 8r077) 8r044) "perm 6")
(assert (= (os/perm-string 8r777) "rwxrwxrwx") "perm 7")
(assert (= (os/perm-string 8r755) "rwxr-xr-x") "perm 8")
(assert (= (os/perm-string 8r644) "rw-r--r--") "perm 9")
# Issue #336 cases - don't segfault
(assert-error "unmarshal errors 1" (unmarshal @"\xd6\xb9\xb9"))
(assert-error "unmarshal errors 2" (unmarshal @"\xd7bc"))
(assert-error "unmarshal errors 3" (unmarshal "\xd3\x01\xd9\x01\x62\xcf\x03\x78\x79\x7a" load-image-dict))
(assert-error "unmarshal errors 4"
(unmarshal
@"\xD7\xCD\0e/p\x98\0\0\x03\x01\x01\x01\x02\0\0\x04\0\xCEe/p../tools
\0\0\0/afl\0\0\x01\0erate\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE
\xA8\xDE\xDE\xDE\xDE\xDE\xDE\0\0\0\xDE\xDE_unmarshal_testcase3.ja
neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
\0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict))
# No segfault, valgrind clean.
(def x @"\xCC\xCD.nd\x80\0\r\x1C\xCDg!\0\x07\xCC\xCD\r\x1Ce\x10\0\r;\xCDb\x04\xFF9\xFF\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04uu\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04}\x04\x04\x04\x04\x04\x04\x04\x04#\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x01\0\0\x03\x04\x04\x04\xE2\x03\x04\x04\x04\x04\x04\x04\x04\x04\x04\x14\x1A\x04\x04\x04\x04\x04\x18\x04\x04!\x04\xE2\x03\x04\x04\x04\x04\x04\x04$\x04\x04\x04\x04\x04\x04\x04\x04\x04\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04A\0\0\0\x03\0\0!\xBF\xFF")
(unmarshal x load-image-dict)
(gccollect)
(marshal x make-image-dict)
(def b @"\xCC\xCD\0\x03\0\x08\x04\rm\xCD\x7F\xFF\xFF\xFF\x02\0\x02\xD7\xCD\0\x98\0\0\x05\x01\x01\x01\x01\x08\xCE\x01f\xCE../tools/afl/generate_unmarshal_testcases.janet\xCE\x012,\x01\0\0&\x03\0\06\x02\x03\x03)\x03\x01\0*\x04\0\00\x03\x04\0>\x03\0\0\x03\x03\0\0*\x05\0\x11\0\x11\0\x05\0\x05\0\x05\0\x05\0\x05\xC9\xDA\x04\xC9\xC9\xC9")
(unmarshal b load-image-dict)
(gccollect)
(def v (unmarshal
@"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000"
load-image-dict))
(gccollect)
# in vs get regression
(assert (nil? (first @"")) "in vs get 1")
(assert (nil? (last @"")) "in vs get 1")
# For undefined behavior sanitizer
0xf&1fffFFFF
# Tuple comparison
(assert (< [1 2 3] [2 2 3]) "tuple comparison 1")
(assert (< [1 2 3] [2 2]) "tuple comparison 2")
(assert (< [1 2 3] [2 2 3 4]) "tuple comparison 3")
(assert (< [1 2 3] [1 2 3 4]) "tuple comparison 4")
(assert (< [1 2 3] [1 2 3 -1]) "tuple comparison 5")
(assert (> [1 2 3] [1 2]) "tuple comparison 6")
(end-suite)

View File

@@ -3,12 +3,26 @@
To use these, you need to install afl (of course), and xterm. A tiling window manager helps manage
many concurrent fuzzer instances.
Note, afl sometimes requires system configuration, if you find AFL quitting prematurely, try manually
launching it and addressing any error messages.
## Fuzz the parser
```
$ sh ./tools/afl/prepare_to_fuzz.sh
export NFUZZ=1
$ export NFUZZ=1
$ sh ./tools/afl/fuzz.sh parser
Ctrl+C when done to close all fuzzer terminals.
$ sh ./tools/afl/aggregate_cases.sh parser
$ ls ./fuzz_out/parser_aggregated/
```
```
## Fuzz the unmarshaller
```
$ janet ./tools/afl/generate_unmarshal_testcases.janet
$ sh ./tools/afl/prepare_to_fuzz.sh
$ export NFUZZ=1
$ sh ./tools/afl/fuzz.sh unmarshal
Ctrl+C when done to close all fuzzer terminals.
$ sh ./tools/afl/aggregate_cases.sh unmarshal
$ ls ./fuzz_out/unmarshal_aggregated/
```

View File

@@ -0,0 +1,49 @@
(os/mkdir "./tools/afl/unmarshal_testcases/")
(defn spit-case [n v]
(spit
(string "./tools/afl/unmarshal_testcases/" (string n))
(marshal v make-image-dict)))
(def cases [
nil
"abc"
:def
'hij
123
(int/s64 123)
"7"
[1 2 3]
@[1 2 3]
{:a 123}
@{:b 'xyz}
(peg/compile
'{:a (* "a" :b "a")
:b (* "b" (+ :a 0) "b")
:main (* "(" :b ")")})
(fn f [a] (fn [] {:ab a}))
(fn f [a] (print "hello world!"))
(do
(defn f [a] (yield) @[1 "2"])
(def fb (fiber/new f))
(resume fb)
fb)
])
(eachk i cases
(spit-case i (in cases i)))

View File

@@ -0,0 +1,6 @@
# Unmarshal garbage.
(def v (unmarshal (slurp ((dyn :args) 1)) load-image-dict))
# Trigger leaks or use after free.
(gccollect)
# Attempt to use generated value.
(marshal v make-image-dict)

View File

@@ -308,7 +308,7 @@
<array>
<dict>
<key>match</key>
<string>(\\[nevr0zft"\\']|\\x[0-9a-fA-F][0-9a-fA-f])</string>
<string>(\\[nevr0zft"\\']|\\x[0-9a-fA-F]{2}|\\u[0-9a-fA-F]{4}|\\U[0-9a-fA-F]{6})</string>
<key>name</key>
<string>constant.character.escape.janet</string>
</dict>

View File

@@ -1,104 +0,0 @@
/*
* 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.
*/
/* 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;
}