mirror of
https://github.com/janet-lang/janet
synced 2025-11-23 18:54:50 +00:00
Compare commits
409 Commits
clean-stri
...
v1.0.0
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
d66f8333c1 | ||
|
|
1588359ebc | ||
|
|
a861399ecb | ||
|
|
a7f3d3436f | ||
|
|
75f1bb6a7c | ||
|
|
0384b83c31 | ||
|
|
c68361a03f | ||
|
|
0bda455cad | ||
|
|
bb7bef7188 | ||
|
|
b8032ec61d | ||
|
|
8d1e6ddffc | ||
|
|
f7f2f5e84f | ||
|
|
bedd9ccaa1 | ||
|
|
a29e717fd7 | ||
|
|
522545287e | ||
|
|
4b4fe80404 | ||
|
|
cf05ff610f | ||
|
|
300124961f | ||
|
|
7eb78c8028 | ||
|
|
1a7691dade | ||
|
|
3b51501847 | ||
|
|
fc46030e7d | ||
|
|
ff3bb66272 | ||
|
|
1ceaceada4 | ||
|
|
19a0444f41 | ||
|
|
0102a72538 | ||
|
|
9943bdd907 | ||
|
|
264c5bc02b | ||
|
|
9ba8728176 | ||
|
|
8839731951 | ||
|
|
e88a9af2f6 | ||
|
|
a5e50a0f65 | ||
|
|
7c35acca75 | ||
|
|
4bb57550c8 | ||
|
|
446ab037b0 | ||
|
|
4adfb9f2d3 | ||
|
|
9c89d1c658 | ||
|
|
3598f056bb | ||
|
|
779fcf2d54 | ||
|
|
3bbc121c6a | ||
|
|
82edc19137 | ||
|
|
5689ef1af1 | ||
|
|
b4e25e5597 | ||
|
|
647139cdf9 | ||
|
|
6225f8d334 | ||
|
|
95eb54045f | ||
|
|
43520ac67d | ||
|
|
802a2d6b71 | ||
|
|
d9a4ef05ac | ||
|
|
f00a2770ef | ||
|
|
b83fe146fa | ||
|
|
6249f03367 | ||
|
|
bfc00b67bd | ||
|
|
2b7428ed2b | ||
|
|
64a80c57e3 | ||
|
|
efb2ab06cb | ||
|
|
b082c8123e | ||
|
|
cc1ff9125a | ||
|
|
5734e02034 | ||
|
|
6e8beff0a0 | ||
|
|
c21eaa5474 | ||
|
|
13667292c6 | ||
|
|
22eb8372dd | ||
|
|
1b7a9def25 | ||
|
|
d7954e6fe3 | ||
|
|
c20c9cd5d7 | ||
|
|
46531d9a60 | ||
|
|
d9a366fbed | ||
|
|
64bf52372a | ||
|
|
0a9715a94c | ||
|
|
c82aac1365 | ||
|
|
e697cc3811 | ||
|
|
c150f2f2c1 | ||
|
|
0a54e1ed62 | ||
|
|
b9daf41327 | ||
|
|
2d2bc436e6 | ||
|
|
3d76d988c3 | ||
|
|
bea6dbbf3d | ||
|
|
e1bd24c2ab | ||
|
|
1f30ea66e9 | ||
|
|
c43aaf8986 | ||
|
|
2acc81d1c5 | ||
|
|
26513a7a16 | ||
|
|
d005ac6888 | ||
|
|
7fdb098a20 | ||
|
|
a4a200e037 | ||
|
|
15d95d8803 | ||
|
|
46950a8cb3 | ||
|
|
4867cab569 | ||
|
|
c8cf7c2445 | ||
|
|
1b63215aad | ||
|
|
bcbe42ab23 | ||
|
|
c8c6419013 | ||
|
|
e8516c29e0 | ||
|
|
12247bd958 | ||
|
|
9d30d5f6e3 | ||
|
|
ba0956488d | ||
|
|
31f502b508 | ||
|
|
efaaead378 | ||
|
|
4d47d92a4a | ||
|
|
b39ad97a87 | ||
|
|
af23040d9c | ||
|
|
fd2d706e33 | ||
|
|
178d175bcf | ||
|
|
7a7f586094 | ||
|
|
5124587c96 | ||
|
|
6c897b1a37 | ||
|
|
c6ac53f4be | ||
|
|
2d7812a06c | ||
|
|
db55277b58 | ||
|
|
75818217a6 | ||
|
|
486b80fa7b | ||
|
|
873054d055 | ||
|
|
f12f896020 | ||
|
|
09ab391d13 | ||
|
|
7569930b0c | ||
|
|
e7189438dd | ||
|
|
3c304ddc35 | ||
|
|
1696de233c | ||
|
|
ce9cd4fcef | ||
|
|
698e89aba4 | ||
|
|
4c8dd4b96c | ||
|
|
11998b3913 | ||
|
|
840610facf | ||
|
|
0280deccae | ||
|
|
4d5a95784a | ||
|
|
b43d93cf55 | ||
|
|
3f137ed0b1 | ||
|
|
5deb13d73e | ||
|
|
82a1c8635e | ||
|
|
010e2e4652 | ||
|
|
ddedae6831 | ||
|
|
6c63c4f129 | ||
|
|
802686e3df | ||
|
|
3be79e8735 | ||
|
|
a303704a7d | ||
|
|
b5e6c0b8fc | ||
|
|
98c46fcfb1 | ||
|
|
409da697dd | ||
|
|
91c3685705 | ||
|
|
411fc77ecf | ||
|
|
0378ba78cc | ||
|
|
55d8e8b56b | ||
|
|
97ad4c4f89 | ||
|
|
8de999c8f7 | ||
|
|
f444bd25ef | ||
|
|
43c0db4b0e | ||
|
|
8f168c600d | ||
|
|
ec43afb426 | ||
|
|
880049c0ee | ||
|
|
2b7ac16784 | ||
|
|
56d903d75b | ||
|
|
7054e878fb | ||
|
|
dde5351d11 | ||
|
|
7d49e3e6f1 | ||
|
|
30cb01e2f0 | ||
|
|
018e836ef5 | ||
|
|
7b25125431 | ||
|
|
0aa2f68793 | ||
|
|
516e031f67 | ||
|
|
3331f2fa02 | ||
|
|
dd1a199ebd | ||
|
|
f35b5765d6 | ||
|
|
8359044408 | ||
|
|
9f3dde3cc7 | ||
|
|
ad0f7d9b0d | ||
|
|
f647ac5631 | ||
|
|
e4c5eb4c76 | ||
|
|
dc9fc9c3f5 | ||
|
|
3b6a51df24 | ||
|
|
f2313b9959 | ||
|
|
805b3bbb88 | ||
|
|
232ea22dc5 | ||
|
|
3388acd2db | ||
|
|
52ab9fb475 | ||
|
|
c7dc3611bc | ||
|
|
7a313f6038 | ||
|
|
bbcfaf1289 | ||
|
|
bfb0cb331e | ||
|
|
1759252071 | ||
|
|
fff60b053b | ||
|
|
65ac17986a | ||
|
|
ff720f1320 | ||
|
|
5a28d8d1fa | ||
|
|
ea25766374 | ||
|
|
88b8418253 | ||
|
|
4fa1b28cad | ||
|
|
c70d59edee | ||
|
|
5694998382 | ||
|
|
1cfc7b3b0d | ||
|
|
03e3ecb0a1 | ||
|
|
f8935b0692 | ||
|
|
702b50b7a1 | ||
|
|
e7baa2ae3d | ||
|
|
bfb354b469 | ||
|
|
3c0f12ea4d | ||
|
|
25a93ac4a6 | ||
|
|
0bad523913 | ||
|
|
5b36199aea | ||
|
|
a474a640be | ||
|
|
f10028d41a | ||
|
|
eb4684a64d | ||
|
|
73b81e0253 | ||
|
|
027f106a56 | ||
|
|
20e94adb61 | ||
|
|
9100794cea | ||
|
|
4ddf90e301 | ||
|
|
d1eca1cf52 | ||
|
|
7918add47d | ||
|
|
513d551df6 | ||
|
|
ddaa5e34e6 | ||
|
|
208eb7520a | ||
|
|
2d7df6b78e | ||
|
|
7527142549 | ||
|
|
4e6193b67e | ||
|
|
4ded5e10a2 | ||
|
|
1596511175 | ||
|
|
d514eab627 | ||
|
|
5287007cd6 | ||
|
|
e5a56174e2 | ||
|
|
6c68c7a35f | ||
|
|
675c1030fd | ||
|
|
ed65d04b81 | ||
|
|
fa1c5c85b5 | ||
|
|
59c69e6896 | ||
|
|
ee35786c8f | ||
|
|
ec6e2cfd62 | ||
|
|
7d48e7fd1f | ||
|
|
0063e3a69d | ||
|
|
cd6c009c03 | ||
|
|
b15cf193a0 | ||
|
|
429dc70374 | ||
|
|
e50e77e5f9 | ||
|
|
2fdd6aa0f7 | ||
|
|
cc55364b21 | ||
|
|
71526d1d9b | ||
|
|
e239980da7 | ||
|
|
1709bce77e | ||
|
|
d6ba2de888 | ||
|
|
61c0a4bc87 | ||
|
|
8af28d3fa5 | ||
|
|
970923d0e5 | ||
|
|
5d7dc0a57c | ||
|
|
c5090606a4 | ||
|
|
bf2d9ae634 | ||
|
|
871a58e1db | ||
|
|
53c7f2eedd | ||
|
|
bfd3845218 | ||
|
|
22d75d017f | ||
|
|
37e6ea0a23 | ||
|
|
10769f6f2e | ||
|
|
082639319e | ||
|
|
f20ad34c76 | ||
|
|
c045eadefa | ||
|
|
e2337b2ec4 | ||
|
|
90c5d12613 | ||
|
|
6016662807 | ||
|
|
2c9195b507 | ||
|
|
b47c48b59a | ||
|
|
98758b68ab | ||
|
|
7f1b5d4d70 | ||
|
|
25aa7a26c5 | ||
|
|
cb2caecbb3 | ||
|
|
1e299632e4 | ||
|
|
94a2084723 | ||
|
|
22e24fb47b | ||
|
|
93f0d5f626 | ||
|
|
bad040665f | ||
|
|
a07d76b264 | ||
|
|
1db6d0e0bc | ||
|
|
34849ea7b3 | ||
|
|
5a9f7c3a85 | ||
|
|
15c6300608 | ||
|
|
c6a4485623 | ||
|
|
090c6ac975 | ||
|
|
319575c864 | ||
|
|
42a0af3b1b | ||
|
|
9bc899ccf2 | ||
|
|
d29e3a1199 | ||
|
|
41bb6a9833 | ||
|
|
95e54c66b6 | ||
|
|
31e2415bbb | ||
|
|
2a5234b390 | ||
|
|
ad5b0a371e | ||
|
|
ba4dd9b5bb | ||
|
|
d42bdf2443 | ||
|
|
a246877c1e | ||
|
|
98e68a5cb4 | ||
|
|
e12aace02c | ||
|
|
51a9c7104d | ||
|
|
75dc08ff21 | ||
|
|
6fa60820a3 | ||
|
|
609a9621af | ||
|
|
8ba1121161 | ||
|
|
9a080197e7 | ||
|
|
e65375277a | ||
|
|
4a111b38b1 | ||
|
|
a363dce943 | ||
|
|
687a3c91f5 | ||
|
|
951aa0d8cd | ||
|
|
a61b59be87 | ||
|
|
91f3c17a5b | ||
|
|
0382dc976b | ||
|
|
69dcab2b55 | ||
|
|
c4f6f1d256 | ||
|
|
b57e530553 | ||
|
|
021b71ad62 | ||
|
|
0ee2ff1b05 | ||
|
|
adaa014d7c | ||
|
|
dc9dc98e80 | ||
|
|
4a2d4f52b5 | ||
|
|
8d37e544ab | ||
|
|
b07adce2b9 | ||
|
|
624be87c97 | ||
|
|
1b9591b5e3 | ||
|
|
a4cc23971f | ||
|
|
9ed1c35d30 | ||
|
|
6158ec0ce5 | ||
|
|
009bed158b | ||
|
|
402dc2a767 | ||
|
|
b5eb888af6 | ||
|
|
172261b89f | ||
|
|
8cc2c964c1 | ||
|
|
efbb704247 | ||
|
|
7fef5be3af | ||
|
|
1753f8bc18 | ||
|
|
235019ec39 | ||
|
|
7d17159ae4 | ||
|
|
56d7d4ef39 | ||
|
|
77c379faa8 | ||
|
|
3014a59c3e | ||
|
|
d70049dbb1 | ||
|
|
4713219317 | ||
|
|
36f92db61e | ||
|
|
59393fc73b | ||
|
|
3eb44f1f79 | ||
|
|
fb5119bf43 | ||
|
|
febfefa4b2 | ||
|
|
632b920e97 | ||
|
|
c81bf42f6b | ||
|
|
4147c0ce1f | ||
|
|
602e30a421 | ||
|
|
92a5567b4a | ||
|
|
9495be328c | ||
|
|
0eae75a5c2 | ||
|
|
8e0d7f2539 | ||
|
|
9c1c7fb384 | ||
|
|
af48912f11 | ||
|
|
327d2ed849 | ||
|
|
db64a682be | ||
|
|
4d3c655058 | ||
|
|
2becebce92 | ||
|
|
0cc6c6ff33 | ||
|
|
115bc6140b | ||
|
|
b14fcb068b | ||
|
|
2ea28f29b0 | ||
|
|
7cb1c7cef2 | ||
|
|
9d60e8b343 | ||
|
|
340a6c4d8d | ||
|
|
e5a4c6fc2b | ||
|
|
db9ac6dba5 | ||
|
|
d570aae817 | ||
|
|
59e4b15fad | ||
|
|
b3401381fa | ||
|
|
beed839d12 | ||
|
|
f4908ebc41 | ||
|
|
1147482e62 | ||
|
|
4d07176f1c | ||
|
|
8c67bf82f6 | ||
|
|
0823eb7327 | ||
|
|
8cff3dd2c3 | ||
|
|
df550efb6b | ||
|
|
00a47dc0cb | ||
|
|
811b1825cb | ||
|
|
2ca252bc0e | ||
|
|
6054858359 | ||
|
|
1d50fd9485 | ||
|
|
a982f351d7 | ||
|
|
27a274b686 | ||
|
|
cb002e7b84 | ||
|
|
c022a1cf1a | ||
|
|
9d4effc02e | ||
|
|
7c19ed8a48 | ||
|
|
ef5f80ad38 | ||
|
|
dbcbb4466d | ||
|
|
7927078b49 | ||
|
|
b61c9eb991 | ||
|
|
ed72dcf82d | ||
|
|
9480ad24cc | ||
|
|
a9574b692f | ||
|
|
8d9a88e759 | ||
|
|
732de8f88d | ||
|
|
6af5800d21 | ||
|
|
540b326c54 | ||
|
|
660a2b41ae | ||
|
|
d2d502b9ae | ||
|
|
3aae524964 | ||
|
|
07912f5ab2 | ||
|
|
ffc14f6019 | ||
|
|
1e70c97ef0 | ||
|
|
54227ebff1 | ||
|
|
33087fe9de | ||
|
|
6d5ff43de7 | ||
|
|
c715912ea3 | ||
|
|
3b6ff3c09a | ||
|
|
efab484fff | ||
|
|
4ba7fbb8bb | ||
|
|
53cc7ebd29 | ||
|
|
c6f032340a |
@@ -1,11 +1,11 @@
|
|||||||
image: freebsd/latest
|
image: freebsd/latest
|
||||||
packages:
|
packages:
|
||||||
- gmake
|
- gmake
|
||||||
- gcc
|
|
||||||
sources:
|
|
||||||
- https://github.com/janet-lang/janet.git
|
|
||||||
tasks:
|
tasks:
|
||||||
- build: |
|
- build: |
|
||||||
cd janet
|
cd janet
|
||||||
gmake CC=gcc
|
gmake
|
||||||
gmake test CC=gcc
|
gmake test
|
||||||
|
sudo gmake install
|
||||||
|
gmake test-install
|
||||||
|
gmake test-amalg
|
||||||
|
|||||||
11
.builds/.openbsd.yaml
Normal file
11
.builds/.openbsd.yaml
Normal file
@@ -0,0 +1,11 @@
|
|||||||
|
image: openbsd/6.5
|
||||||
|
packages:
|
||||||
|
- gmake
|
||||||
|
tasks:
|
||||||
|
- build: |
|
||||||
|
cd janet
|
||||||
|
gmake
|
||||||
|
gmake test
|
||||||
|
doas gmake install
|
||||||
|
gmake test-install
|
||||||
|
gmake test-amalg
|
||||||
8
.gitignore
vendored
8
.gitignore
vendored
@@ -4,6 +4,7 @@ dst
|
|||||||
janet
|
janet
|
||||||
!*/**/janet
|
!*/**/janet
|
||||||
/build
|
/build
|
||||||
|
/builddir
|
||||||
/Build
|
/Build
|
||||||
/Release
|
/Release
|
||||||
/Debug
|
/Debug
|
||||||
@@ -12,6 +13,13 @@ janet
|
|||||||
janet-*.tar.gz
|
janet-*.tar.gz
|
||||||
dist
|
dist
|
||||||
|
|
||||||
|
# VSCode
|
||||||
|
.vscode
|
||||||
|
|
||||||
|
# Eclipse
|
||||||
|
.project
|
||||||
|
.cproject
|
||||||
|
|
||||||
# Local directory for testing
|
# Local directory for testing
|
||||||
local
|
local
|
||||||
|
|
||||||
|
|||||||
@@ -2,6 +2,9 @@ language: c
|
|||||||
script:
|
script:
|
||||||
- make
|
- make
|
||||||
- make test
|
- make test
|
||||||
|
- sudo make install
|
||||||
|
- make test-install
|
||||||
|
- make test-amalg
|
||||||
- make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
- make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||||
compiler:
|
compiler:
|
||||||
- clang
|
- clang
|
||||||
|
|||||||
97
CHANGELOG.md
97
CHANGELOG.md
@@ -1,7 +1,100 @@
|
|||||||
# Changelog
|
# Changelog
|
||||||
All notable changes to this project will be documented in this file.
|
All notable changes to this project will be documented in this file.
|
||||||
|
|
||||||
## 0.4.0 - ??
|
## 1.0.0 - 2019-07-01
|
||||||
|
- Add `with` macro for resource handling.
|
||||||
|
- Add `propagate` function so we can "rethrow" signals after they are
|
||||||
|
intercepted. This makes signals even more flexible.
|
||||||
|
- Add `JANET_NO_DOCSTRINGS` and `JANET_NO_SOURCEMAPS` defines in janetconf.h
|
||||||
|
for shrinking binary size.
|
||||||
|
This seems to save about 50kB in most builds, so it's not usually worth it.
|
||||||
|
- Update module system to allow relative imports. The `:cur:` pattern
|
||||||
|
in `module/expand-path` will expand to the directory part of the current file, or
|
||||||
|
whatever the value of `(dyn :current-file)` is. The `:dir:` pattern gets
|
||||||
|
the directory part of the input path name.
|
||||||
|
- Remove `:native:` pattern in `module/paths`.
|
||||||
|
- Add `module/expand-path`
|
||||||
|
- Remove `module/*syspath*` and `module/*headerpath*` in favor of dynamic
|
||||||
|
bindings `:syspath` and `:headerpath`.
|
||||||
|
- Compiled PEGs can now be marshaled and unmarshaled.
|
||||||
|
- Change signature to `parser/state`
|
||||||
|
- Add `:until` verb to loop.
|
||||||
|
- Add `:p` flag to `fiber/new`.
|
||||||
|
- Add `file/{fdopen,fileno}` functions.
|
||||||
|
- Add `parser/clone` function.
|
||||||
|
- Add optional argument to `parser/where` to set parser byte index.
|
||||||
|
- Add optional `env` argument to `all-bindings` and `all-dynamics`.
|
||||||
|
- Add scratch memory C API functions for auto-released memory on next gc.
|
||||||
|
Scratch memory differs from normal GCed memory as it can also be freed normally
|
||||||
|
for better performance.
|
||||||
|
- Add API compatibility checking for modules. This will let native modules not load
|
||||||
|
when the host program is not of a compatible version or configuration.
|
||||||
|
- Change signature of `os/execute` to be much more flexible.
|
||||||
|
|
||||||
|
## 0.6.0 - 2019-05-29
|
||||||
|
- `file/close` returns exit code when closing file opened with `file/popen`.
|
||||||
|
- Add `os/rename`
|
||||||
|
- Update windows installer to include tools like `jpm`.
|
||||||
|
- Add `jpm` tool for building and managing projects.
|
||||||
|
- Change interface to `cook` tool.
|
||||||
|
- Add optional filters to `module/paths` to further refine import methods.
|
||||||
|
- Add keyword arguments via `&keys` in parameter list.
|
||||||
|
- Add `-k` flag for flychecking source.
|
||||||
|
- Change signature to `compile` function.
|
||||||
|
- Add `module/loaders` for custom loading functions.
|
||||||
|
- Add external unification to `match` macro.
|
||||||
|
- Add static library to main build.
|
||||||
|
- Add `janet/*headerpath*` and change location of installed headers.
|
||||||
|
- Let `partition` take strings.
|
||||||
|
- Haiku OS support
|
||||||
|
- Add `string/trim`, `string/trimr`, and `string/triml`.
|
||||||
|
- Add `dofile` function.
|
||||||
|
- Numbers require at least 1 significant digit.
|
||||||
|
- `file/read` will return nil on end of file.
|
||||||
|
- Fix various bugs.
|
||||||
|
|
||||||
|
## 0.5.0 - 2019-05-09
|
||||||
|
- Fix some bugs with buffers.
|
||||||
|
- Add `trace` and `untrace` to the core library.
|
||||||
|
- Add `string/has-prefix?` and `string/has-suffix?` to string module.
|
||||||
|
- Add simple debugger to repl that activates on errors or debug signal
|
||||||
|
- Remove `*env*` and `*doc-width*`.
|
||||||
|
- Add `fiber/getenv`, `fiber/setenv`, and `dyn`, and `setdyn`.
|
||||||
|
- Add support for dynamic bindings (via the `dyn` and `setdyn` functions).
|
||||||
|
- Change signatures of some functions like `eval` which no longer takes
|
||||||
|
an optional environment.
|
||||||
|
- Add printf function
|
||||||
|
- Make `pp` configurable with dynamic binding `:pretty-format`.
|
||||||
|
- Remove the `meta` function.
|
||||||
|
- Add `with-dyns` for blocks with dynamic bindings assigned.
|
||||||
|
- Allow leading and trailing newlines in backtick-delimited string (long strings).
|
||||||
|
These newlines will not be included in the actual string value.
|
||||||
|
|
||||||
|
## 0.4.1 - 2019-04-14
|
||||||
|
- Squash some bugs
|
||||||
|
- Peg patterns can now make captures in any position in a grammar.
|
||||||
|
- Add color to repl output
|
||||||
|
- Add array/remove function
|
||||||
|
- Add meson build support
|
||||||
|
- Add int module for int types
|
||||||
|
- Add meson build option
|
||||||
|
- Add (break) special form and improve loop macro
|
||||||
|
- Allow abstract types to specify custom tostring method
|
||||||
|
- Extend C API for marshalling abstract types and other values
|
||||||
|
- Add functions to `os` module.
|
||||||
|
|
||||||
|
## 0.4.0 - 2019-03-08
|
||||||
|
- Fix a number of smaller bugs
|
||||||
|
- Added :export option to import and require
|
||||||
|
- Added typed arrays
|
||||||
|
- Remove `callable?`.
|
||||||
|
- Remove `tuple/append` and `tuple/prepend`, which may have seemed like `O(1)`
|
||||||
|
operations. Instead, use the `splice` special to extend tuples.
|
||||||
|
- Add `-m` flag to main client to allow specifying where to load
|
||||||
|
system modules from.
|
||||||
|
- Add `-c` flag to main client to allow compiling Janet modules to images.
|
||||||
|
- Add `string/format` and `buffer/format`.
|
||||||
|
- Remove `string/pretty` and `string/number`.
|
||||||
- `make-image` function creates pre compiled images for janet. These images
|
- `make-image` function creates pre compiled images for janet. These images
|
||||||
link to the core library. They can be loaded via require or manually via
|
link to the core library. They can be loaded via require or manually via
|
||||||
`load-image`.
|
`load-image`.
|
||||||
@@ -20,7 +113,7 @@ All notable changes to this project will be documented in this file.
|
|||||||
- Disallow NaNs as table or struct keys
|
- Disallow NaNs as table or struct keys
|
||||||
- Update module resolution paths and format
|
- Update module resolution paths and format
|
||||||
|
|
||||||
## 0.3.0 - 2019-26-01
|
## 0.3.0 - 2019-01-26
|
||||||
- Add amalgamated build to janet for easier embedding.
|
- Add amalgamated build to janet for easier embedding.
|
||||||
- Add os/date function
|
- Add os/date function
|
||||||
- Add slurp and spit to core library.
|
- Add slurp and spit to core library.
|
||||||
|
|||||||
@@ -29,7 +29,12 @@ may require changes before being merged.
|
|||||||
run tests with `make test`. If you want to add a new test suite, simply add a file to
|
run tests with `make test`. If you want to add a new test suite, simply add a file to
|
||||||
the test folder and make sure it is run when`make test` is invoked.
|
the test folder and make sure it is run when`make test` is invoked.
|
||||||
* Be consistent with the style. For C this means follow the indentation and style in
|
* Be consistent with the style. For C this means follow the indentation and style in
|
||||||
other files (files have MIT license at top, 4 spaces indentation, no trailing whitespace, cuddled brackets, etc.)
|
other files (files have MIT license at top, 4 spaces indentation, no trailing
|
||||||
|
whitespace, cuddled brackets, etc.) Use `make format` to
|
||||||
|
automatically format your C code with
|
||||||
|
[astyle](http://astyle.sourceforge.net/astyle.html). You will probably need
|
||||||
|
to install this, but it can be installed with most package managers.
|
||||||
|
|
||||||
For janet code, the use lisp indentation with 2 spaces. One can use janet.vim to
|
For janet code, the use lisp indentation with 2 spaces. One can use janet.vim to
|
||||||
do this indentation, or approximate as close as possible.
|
do this indentation, or approximate as close as possible.
|
||||||
|
|
||||||
@@ -39,7 +44,6 @@ For changes to the VM and Core code, you will probably need to know C. Janet is
|
|||||||
a subset of C99 that works with Microsoft Visual C++. This means most of C99 but with the following
|
a subset of C99 that works with Microsoft Visual C++. This means most of C99 but with the following
|
||||||
omissions.
|
omissions.
|
||||||
|
|
||||||
* No Variable Length Arrays (yes these may work in newer MSVC compilers)
|
|
||||||
* No `restrict`
|
* No `restrict`
|
||||||
* Certain functions in the standard library are not always available
|
* Certain functions in the standard library are not always available
|
||||||
|
|
||||||
@@ -51,6 +55,11 @@ Code should compile warning free and run valgrind clean. I find that these two c
|
|||||||
of the easiest ways to protect against a large number of bugs in an unsafe language like C. To check for
|
of the easiest ways to protect against a large number of bugs in an unsafe language like C. To check for
|
||||||
valgrind errors, run `make valtest` and check the output for undefined or flagged behavior.
|
valgrind errors, run `make valtest` and check the output for undefined or flagged behavior.
|
||||||
|
|
||||||
|
### Formatting
|
||||||
|
|
||||||
|
Use [astyle](http://astyle.sourceforge.net/astyle.html) via `make format` to
|
||||||
|
ensure a consistent code style for C.
|
||||||
|
|
||||||
## Janet style
|
## Janet style
|
||||||
|
|
||||||
All janet code in the project should be formatted similar to the code in core.janet.
|
All janet code in the project should be formatted similar to the code in core.janet.
|
||||||
|
|||||||
218
Makefile
218
Makefile
@@ -24,54 +24,110 @@
|
|||||||
|
|
||||||
PREFIX?=/usr/local
|
PREFIX?=/usr/local
|
||||||
|
|
||||||
INCLUDEDIR=$(PREFIX)/include/janet
|
INCLUDEDIR=$(PREFIX)/include
|
||||||
LIBDIR=$(PREFIX)/lib
|
|
||||||
BINDIR=$(PREFIX)/bin
|
BINDIR=$(PREFIX)/bin
|
||||||
|
LIBDIR=$(PREFIX)/lib
|
||||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\""
|
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\""
|
||||||
|
|
||||||
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden \
|
|
||||||
-DJANET_BUILD=$(JANET_BUILD)
|
|
||||||
CLIBS=-lm
|
CLIBS=-lm
|
||||||
JANET_TARGET=build/janet
|
JANET_TARGET=build/janet
|
||||||
JANET_LIBRARY=build/libjanet.so
|
JANET_LIBRARY=build/libjanet.so
|
||||||
JANET_PATH?=/usr/local/lib/janet
|
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||||
|
JANET_PATH?=$(PREFIX)/lib/janet
|
||||||
|
MANPATH?=$(PREFIX)/share/man/man1/
|
||||||
|
PKG_CONFIG_PATH?=$(PREFIX)/lib/pkgconfig
|
||||||
DEBUGGER=gdb
|
DEBUGGER=gdb
|
||||||
|
|
||||||
|
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fpic -O2 -fvisibility=hidden \
|
||||||
|
-DJANET_BUILD=$(JANET_BUILD)
|
||||||
|
LDFLAGS=-rdynamic
|
||||||
|
|
||||||
|
# Check OS
|
||||||
UNAME:=$(shell uname -s)
|
UNAME:=$(shell uname -s)
|
||||||
LDCONFIG:=ldconfig
|
|
||||||
ifeq ($(UNAME), Darwin)
|
ifeq ($(UNAME), Darwin)
|
||||||
# Add other macos/clang flags
|
|
||||||
LDCONFIG:=
|
|
||||||
CLIBS:=$(CLIBS) -ldl
|
CLIBS:=$(CLIBS) -ldl
|
||||||
else ifeq ($(UNAME), OpenBSD)
|
else ifeq ($(UNAME), Linux)
|
||||||
# pass ...
|
|
||||||
else
|
|
||||||
CFLAGS:=$(CFLAGS) -rdynamic
|
|
||||||
CLIBS:=$(CLIBS) -lrt -ldl
|
CLIBS:=$(CLIBS) -lrt -ldl
|
||||||
endif
|
endif
|
||||||
|
# For other unix likes, add flags here!
|
||||||
|
ifeq ($(UNAME),Haiku)
|
||||||
|
LDFLAGS=-Wl,--export-dynamic
|
||||||
|
endif
|
||||||
|
|
||||||
$(shell mkdir -p build/core build/mainclient build/webclient build/boot)
|
$(shell mkdir -p build/core build/mainclient build/webclient build/boot)
|
||||||
|
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY)
|
||||||
|
|
||||||
# Source headers
|
######################
|
||||||
JANET_HEADERS=$(sort $(wildcard src/include/janet/*.h))
|
##### Name Files #####
|
||||||
JANET_LOCAL_HEADERS=$(sort $(wildcard src/*/*.h))
|
######################
|
||||||
|
|
||||||
# Source files
|
JANET_HEADERS=src/include/janet.h src/conf/janetconf.h
|
||||||
JANET_CORE_SOURCES=$(sort $(wildcard src/core/*.c))
|
|
||||||
JANET_MAINCLIENT_SOURCES=$(sort $(wildcard src/mainclient/*.c))
|
|
||||||
JANET_WEBCLIENT_SOURCES=$(sort $(wildcard src/webclient/*.c))
|
|
||||||
|
|
||||||
all: $(JANET_TARGET) $(JANET_LIBRARY)
|
JANET_LOCAL_HEADERS=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
|
||||||
|
|
||||||
|
JANET_CORE_SOURCES=src/core/abstract.c \
|
||||||
|
src/core/array.c \
|
||||||
|
src/core/asm.c \
|
||||||
|
src/core/buffer.c \
|
||||||
|
src/core/bytecode.c \
|
||||||
|
src/core/capi.c \
|
||||||
|
src/core/cfuns.c \
|
||||||
|
src/core/compile.c \
|
||||||
|
src/core/corelib.c \
|
||||||
|
src/core/debug.c \
|
||||||
|
src/core/emit.c \
|
||||||
|
src/core/fiber.c \
|
||||||
|
src/core/gc.c \
|
||||||
|
src/core/inttypes.c \
|
||||||
|
src/core/io.c \
|
||||||
|
src/core/marsh.c \
|
||||||
|
src/core/math.c \
|
||||||
|
src/core/os.c \
|
||||||
|
src/core/parse.c \
|
||||||
|
src/core/peg.c \
|
||||||
|
src/core/pp.c \
|
||||||
|
src/core/regalloc.c \
|
||||||
|
src/core/run.c \
|
||||||
|
src/core/specials.c \
|
||||||
|
src/core/string.c \
|
||||||
|
src/core/strtod.c \
|
||||||
|
src/core/struct.c \
|
||||||
|
src/core/symcache.c \
|
||||||
|
src/core/table.c \
|
||||||
|
src/core/tuple.c \
|
||||||
|
src/core/typedarray.c \
|
||||||
|
src/core/util.c \
|
||||||
|
src/core/value.c \
|
||||||
|
src/core/vector.c \
|
||||||
|
src/core/vm.c \
|
||||||
|
src/core/wrap.c
|
||||||
|
|
||||||
|
JANET_BOOT_SOURCES=src/boot/array_test.c \
|
||||||
|
src/boot/boot.c \
|
||||||
|
src/boot/buffer_test.c \
|
||||||
|
src/boot/number_test.c \
|
||||||
|
src/boot/system_test.c \
|
||||||
|
src/boot/table_test.c
|
||||||
|
|
||||||
|
JANET_MAINCLIENT_SOURCES=src/mainclient/line.c src/mainclient/main.c
|
||||||
|
|
||||||
|
JANET_WEBCLIENT_SOURCES=src/webclient/main.c
|
||||||
|
|
||||||
##################################################################
|
##################################################################
|
||||||
##### The bootstrap interpreter that compiles the core image #####
|
##### The bootstrap interpreter that compiles the core image #####
|
||||||
##################################################################
|
##################################################################
|
||||||
|
|
||||||
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) src/boot/boot.c) \
|
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES)) \
|
||||||
build/core.gen.o \
|
|
||||||
build/boot.gen.o
|
build/boot.gen.o
|
||||||
|
|
||||||
build/%.boot.o: src/%.c
|
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||||
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ -c $<
|
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ -c $<
|
||||||
|
|
||||||
build/janet_boot: $(JANET_BOOT_OBJECTS)
|
build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||||
@@ -79,7 +135,7 @@ build/janet_boot: $(JANET_BOOT_OBJECTS)
|
|||||||
|
|
||||||
# Now the reason we bootstrap in the first place
|
# Now the reason we bootstrap in the first place
|
||||||
build/core_image.c: build/janet_boot
|
build/core_image.c: build/janet_boot
|
||||||
build/janet_boot
|
build/janet_boot $@ JANET_PATH $(JANET_PATH) JANET_HEADERPATH $(INCLUDEDIR)/janet
|
||||||
|
|
||||||
##########################################################
|
##########################################################
|
||||||
##### The main interpreter program and shared object #####
|
##### The main interpreter program and shared object #####
|
||||||
@@ -96,17 +152,20 @@ build/%.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
|||||||
$(CC) $(CFLAGS) -o $@ -c $<
|
$(CC) $(CFLAGS) -o $@ -c $<
|
||||||
|
|
||||||
$(JANET_TARGET): $(JANET_CORE_OBJECTS) $(JANET_MAINCLIENT_OBJECTS)
|
$(JANET_TARGET): $(JANET_CORE_OBJECTS) $(JANET_MAINCLIENT_OBJECTS)
|
||||||
$(CC) $(CFLAGS) -o $@ $^ $(CLIBS)
|
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||||
|
|
||||||
$(JANET_LIBRARY): $(JANET_CORE_OBJECTS)
|
$(JANET_LIBRARY): $(JANET_CORE_OBJECTS)
|
||||||
$(CC) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
|
$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
|
||||||
|
|
||||||
|
$(JANET_STATIC_LIBRARY): $(JANET_CORE_OBJECTS)
|
||||||
|
$(AR) rcs $@ $^
|
||||||
|
|
||||||
######################
|
######################
|
||||||
##### Emscripten #####
|
##### Emscripten #####
|
||||||
######################
|
######################
|
||||||
|
|
||||||
EMCC=emcc
|
EMCC=emcc
|
||||||
EMCFLAGS=-std=c99 -Wall -Wextra -Isrc/include -O2 \
|
EMCFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -O2 \
|
||||||
-s EXTRA_EXPORTED_RUNTIME_METHODS='["cwrap"]' \
|
-s EXTRA_EXPORTED_RUNTIME_METHODS='["cwrap"]' \
|
||||||
-s ALLOW_MEMORY_GROWTH=1 \
|
-s ALLOW_MEMORY_GROWTH=1 \
|
||||||
-s AGGRESSIVE_VARIABLE_ELIMINATION=1 \
|
-s AGGRESSIVE_VARIABLE_ELIMINATION=1 \
|
||||||
@@ -140,8 +199,6 @@ emscripten: $(JANET_EMTARGET)
|
|||||||
build/xxd: tools/xxd.c
|
build/xxd: tools/xxd.c
|
||||||
$(CC) $< -o $@
|
$(CC) $< -o $@
|
||||||
|
|
||||||
build/core.gen.c: src/core/core.janet build/xxd
|
|
||||||
build/xxd $< $@ janet_gen_core
|
|
||||||
build/init.gen.c: src/mainclient/init.janet build/xxd
|
build/init.gen.c: src/mainclient/init.janet build/xxd
|
||||||
build/xxd $< $@ janet_gen_init
|
build/xxd $< $@ janet_gen_init
|
||||||
build/webinit.gen.c: src/webclient/webinit.janet build/xxd
|
build/webinit.gen.c: src/webclient/webinit.janet build/xxd
|
||||||
@@ -155,10 +212,11 @@ build/boot.gen.c: src/boot/boot.janet build/xxd
|
|||||||
|
|
||||||
amalg: build/janet.c build/janet.h build/core_image.c
|
amalg: build/janet.c build/janet.h build/core_image.c
|
||||||
|
|
||||||
build/janet.c: $(JANET_LOCAL_HEADERS) $(JANET_CORE_SOURCES) tools/amalg.janet $(JANET_TARGET)
|
AMALG_SOURCE=$(JANET_LOCAL_HEADERS) $(JANET_CORE_SOURCES) build/core_image.c
|
||||||
$(JANET_TARGET) tools/amalg.janet > $@
|
build/janet.c: $(AMALG_SOURCE) tools/amalg.janet $(JANET_TARGET)
|
||||||
|
$(JANET_TARGET) tools/amalg.janet $(AMALG_SOURCE) > $@
|
||||||
|
|
||||||
build/janet.h: src/include/janet/janet.h
|
build/janet.h: src/include/janet.h
|
||||||
cp $< $@
|
cp $< $@
|
||||||
|
|
||||||
###################
|
###################
|
||||||
@@ -179,13 +237,13 @@ valgrind: $(JANET_TARGET)
|
|||||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET)
|
$(VALGRIND_COMMAND) ./$(JANET_TARGET)
|
||||||
|
|
||||||
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||||
for f in test/*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
||||||
|
|
||||||
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||||
for f in test/*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||||
|
|
||||||
callgrind: $(JANET_TARGET)
|
callgrind: $(JANET_TARGET)
|
||||||
for f in test/*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
||||||
|
|
||||||
########################
|
########################
|
||||||
##### Distribution #####
|
##### Distribution #####
|
||||||
@@ -193,8 +251,9 @@ callgrind: $(JANET_TARGET)
|
|||||||
|
|
||||||
dist: build/janet-dist.tar.gz
|
dist: build/janet-dist.tar.gz
|
||||||
|
|
||||||
build/janet-%.tar.gz: $(JANET_TARGET) src/include/janet/janet.h \
|
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||||
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) \
|
src/include/janet.h src/conf/janetconf.h \
|
||||||
|
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||||
build/doc.html README.md build/janet.c
|
build/doc.html README.md build/janet.c
|
||||||
tar -czvf $@ $^
|
tar -czvf $@ $^
|
||||||
|
|
||||||
@@ -207,10 +266,61 @@ docs: build/doc.html
|
|||||||
build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||||
$(JANET_TARGET) tools/gendoc.janet > build/doc.html
|
$(JANET_TARGET) tools/gendoc.janet > build/doc.html
|
||||||
|
|
||||||
|
########################
|
||||||
|
##### Installation #####
|
||||||
|
########################
|
||||||
|
|
||||||
|
SONAME=libjanet.so.1
|
||||||
|
|
||||||
|
.PHONY: $(PKG_CONFIG_PATH)/janet.pc
|
||||||
|
$(PKG_CONFIG_PATH)/janet.pc: $(JANET_TARGET)
|
||||||
|
mkdir -p $(PKG_CONFIG_PATH)
|
||||||
|
echo 'prefix=$(PREFIX)' > $@
|
||||||
|
echo 'exec_prefix=$${prefix}' >> $@
|
||||||
|
echo 'includedir=$(INCLUDEDIR)/janet' >> $@
|
||||||
|
echo 'libdir=$(LIBDIR)' >> $@
|
||||||
|
echo "" >> $@
|
||||||
|
echo "Name: janet" >> $@
|
||||||
|
echo "Url: https://janet-lang.org" >> $@
|
||||||
|
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.private: $(CLIBS)' >> $@
|
||||||
|
|
||||||
|
install: $(JANET_TARGET) $(PKG_CONFIG_PATH)/janet.pc
|
||||||
|
mkdir -p $(BINDIR)
|
||||||
|
cp $(JANET_TARGET) $(BINDIR)/janet
|
||||||
|
mkdir -p $(INCLUDEDIR)/janet
|
||||||
|
cp -rf $(JANET_HEADERS) $(INCLUDEDIR)/janet
|
||||||
|
mkdir -p $(JANET_PATH)
|
||||||
|
mkdir -p $(LIBDIR)
|
||||||
|
cp $(JANET_LIBRARY) $(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')
|
||||||
|
cp $(JANET_STATIC_LIBRARY) $(LIBDIR)/libjanet.a
|
||||||
|
ln -sf $(SONAME) $(LIBDIR)/libjanet.so
|
||||||
|
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME)
|
||||||
|
cp -rf auxlib/* $(JANET_PATH)
|
||||||
|
cp -rf auxbin/* $(BINDIR)
|
||||||
|
mkdir -p $(MANPATH)
|
||||||
|
cp janet.1 $(MANPATH)
|
||||||
|
-ldconfig $(LIBDIR)
|
||||||
|
|
||||||
|
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 -rf $(JANET_PATH)/* - err on the side of correctness here
|
||||||
|
|
||||||
#################
|
#################
|
||||||
##### Other #####
|
##### Other #####
|
||||||
#################
|
#################
|
||||||
|
|
||||||
|
format:
|
||||||
|
tools/format.sh
|
||||||
|
|
||||||
grammar: build/janet.tmLanguage
|
grammar: build/janet.tmLanguage
|
||||||
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||||
$(JANET_TARGET) $< > $@
|
$(JANET_TARGET) $< > $@
|
||||||
@@ -218,26 +328,18 @@ build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
|||||||
clean:
|
clean:
|
||||||
-rm -rf build vgcore.* callgrind.*
|
-rm -rf build vgcore.* callgrind.*
|
||||||
|
|
||||||
install: $(JANET_TARGET)
|
test-install:
|
||||||
mkdir -p $(BINDIR)
|
cd test/install && rm -rf build && jpm build && jpm test
|
||||||
cp $(JANET_TARGET) $(BINDIR)/janet
|
|
||||||
mkdir -p $(INCLUDEDIR)
|
|
||||||
cp $(JANET_HEADERS) $(INCLUDEDIR)
|
|
||||||
mkdir -p $(LIBDIR)
|
|
||||||
cp $(JANET_LIBRARY) $(LIBDIR)/libjanet.so
|
|
||||||
mkdir -p $(JANET_PATH)
|
|
||||||
cp tools/cook.janet $(JANET_PATH)
|
|
||||||
cp tools/highlight.janet $(JANET_PATH)
|
|
||||||
cp janet.1 /usr/local/share/man/man1/
|
|
||||||
mandb
|
|
||||||
$(LDCONFIG)
|
|
||||||
|
|
||||||
uninstall:
|
build/embed_janet.o: build/janet.c $(JANET_HEADERS)
|
||||||
-rm $(BINDIR)/../$(JANET_TARGET)
|
$(CC) $(CFLAGS) -c $< -o $@
|
||||||
-rm $(LIBDIR)/../$(JANET_LIBRARY)
|
build/embed_main.o: test/amalg/main.c $(JANET_HEADERS)
|
||||||
-rm -rf $(INCLUDEDIR)
|
$(CC) $(CFLAGS) -c $< -o $@
|
||||||
$(LDCONFIG)
|
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 amalg \
|
||||||
valtest emscripten dist uninstall docs grammar \
|
valtest emscripten dist uninstall docs grammar format
|
||||||
$(TEST_PROGRAM_PHONIES) $(TEST_PROGRAM_VALPHONIES)
|
|
||||||
|
|||||||
184
README.md
184
README.md
@@ -1,30 +1,24 @@
|
|||||||
[](https://gitter.im/janet-language/community)
|
[](https://gitter.im/janet-language/community)
|
||||||
|
|
||||||
|
[](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
|
||||||
[](https://travis-ci.org/janet-lang/janet)
|
[](https://travis-ci.org/janet-lang/janet)
|
||||||
[](https://ci.appveyor.com/project/janet-lang/janet)
|
|
||||||
[](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml?)
|
[](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml?)
|
||||||
|
[](https://builds.sr.ht/~bakpakin/janet/.openbsd.yaml?)
|
||||||
|
<noscript><a href="https://liberapay.com/Janet-Language/donate"><img alt="Donate using Liberapay" src="https://liberapay.com/assets/widgets/donate.svg"></a></noscript>
|
||||||
|
|
||||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
<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
|
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
|
||||||
modern lisp, but lists are replaced
|
modern lisp, but lists are replaced
|
||||||
by other data structures with better utility and performance (arrays, tables, structs, tuples).
|
by other data structures with better utility and performance (arrays, tables, structs, tuples).
|
||||||
The language also bridging bridging to native code written in C, meta-programming with macros, and bytecode assembly.
|
The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
|
||||||
|
|
||||||
There is a repl for trying out the language, as well as the ability
|
There is a repl for trying out the language, as well as the ability
|
||||||
to run script files. This client program is separate from the core runtime, so
|
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 could be embedded into other programs. Try janet in your browser at
|
||||||
[https://janet-lang.org](https://janet-lang.org).
|
[https://janet-lang.org](https://janet-lang.org).
|
||||||
|
|
||||||
#
|
<br>
|
||||||
|
|
||||||
Implemented in mostly standard C99, janet runs on Windows, Linux and macOS.
|
|
||||||
The few features that are not standard C (dynamic library loading, compiler specific optimizations),
|
|
||||||
are fairly straight forward. Janet can be easily ported to new platforms.
|
|
||||||
|
|
||||||
For syntax highlighting, there is some preliminary vim syntax highlighting in [janet.vim](https://github.com/janet-lang/janet.vim).
|
|
||||||
Generic lisp syntax highlighting should, however, provide good results. One can also generate a janet.tmLanguage
|
|
||||||
file for other programs with `make grammar`.
|
|
||||||
|
|
||||||
## Use Cases
|
## Use Cases
|
||||||
|
|
||||||
@@ -56,17 +50,12 @@ Janet makes a good system scripting language, or a language to embed in other pr
|
|||||||
|
|
||||||
## Documentation
|
## Documentation
|
||||||
|
|
||||||
Documentation can be found in the doc directory of
|
* For a quick tutorial, see [the introduction](https://janet-lang.org/docs/index.html) for more details.
|
||||||
the repository. There is an introduction
|
* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html)
|
||||||
section contains a good overview of the language.
|
|
||||||
|
|
||||||
API documentation for all bindings can also be generated
|
Documentation is also available locally in the repl.
|
||||||
with `make docs`, which will create `build/doc.html`, which
|
Use the `(doc symbol-name)` macro to get API
|
||||||
can be viewed with any web browser. This
|
documentation for symbols in the core library. For example,
|
||||||
includes all forms in the core library except special forms.
|
|
||||||
|
|
||||||
For individual bindings from within the REPL, use the `(doc symbol-name)` macro to get API
|
|
||||||
documentation for the core library. For example,
|
|
||||||
```
|
```
|
||||||
(doc doc)
|
(doc doc)
|
||||||
```
|
```
|
||||||
@@ -75,12 +64,78 @@ Shows documentation for the doc macro.
|
|||||||
To get a list of all bindings in the default
|
To get a list of all bindings in the default
|
||||||
environment, use the `(all-symbols)` function.
|
environment, use the `(all-symbols)` function.
|
||||||
|
|
||||||
|
## Source
|
||||||
|
|
||||||
|
You can get the source on [GitHub](https://github.com/janet-lang/janet) or
|
||||||
|
[SourceHut](https://git.sr.ht/~bakpakin/janet). While the GitHub repo is the official repo,
|
||||||
|
the SourceHut mirror is actively maintained.
|
||||||
|
|
||||||
|
## Building
|
||||||
|
|
||||||
|
### macos and Unix-like
|
||||||
|
|
||||||
|
The Makefile is non-portable and requires GNU-flavored make.
|
||||||
|
|
||||||
|
```
|
||||||
|
cd somewhere/my/projects/janet
|
||||||
|
make
|
||||||
|
make test
|
||||||
|
make repl
|
||||||
|
```
|
||||||
|
|
||||||
|
### 32-bit Haiku
|
||||||
|
|
||||||
|
32-bit Haiku build instructions are the same as the unix-like build instructions,
|
||||||
|
but you need to specify an alternative compiler, such as `gcc-x86`.
|
||||||
|
|
||||||
|
```
|
||||||
|
cd somewhere/my/projects/janet
|
||||||
|
make CC=gcc-x86
|
||||||
|
make test
|
||||||
|
make repl
|
||||||
|
```
|
||||||
|
|
||||||
|
### FreeBSD
|
||||||
|
|
||||||
|
FreeBSD build instructions are the same as the unix-like build instuctions,
|
||||||
|
but you need `gmake` to compile. Alternatively, install directly from
|
||||||
|
packages, using `pkg install lang/janet`.
|
||||||
|
|
||||||
|
```
|
||||||
|
cd somewhere/my/projects/janet
|
||||||
|
gmake
|
||||||
|
gmake test
|
||||||
|
gmake repl
|
||||||
|
```
|
||||||
|
|
||||||
|
### Windows
|
||||||
|
|
||||||
|
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#)
|
||||||
|
2. Run a Visual Studio Command Prompt (cl.exe and link.exe need to be on the PATH) and cd to the directory with janet.
|
||||||
|
3. Run `build_win` to compile janet.
|
||||||
|
4. Run `build_win test` to make sure everything is working.
|
||||||
|
|
||||||
|
### Emscripten
|
||||||
|
|
||||||
|
To build janet for the web via [Emscripten](https://kripken.github.io/emscripten-site/), make sure you
|
||||||
|
have `emcc` installed and on your path. On a linux or macOS system, use `make emscripten` to build
|
||||||
|
`janet.js` and `janet.wasm` - both are needed to run janet in a browser or in node.
|
||||||
|
The JavaScript build is what runs the repl on the main website,
|
||||||
|
but really serves mainly as a proof of concept. Janet will run slower in a browser.
|
||||||
|
Building with emscripten on windows is currently unsupported.
|
||||||
|
|
||||||
|
### Meson
|
||||||
|
|
||||||
|
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross platform build
|
||||||
|
system. Although Meson has a python dependency, Meson is a very complete build system that
|
||||||
|
is maybe more convenient and flexible for integrating into existing pipelines.
|
||||||
|
Meson also provides much better IDE integration than Make or batch files, as well as support
|
||||||
|
for cross compilation.
|
||||||
|
|
||||||
## Installation
|
## Installation
|
||||||
|
|
||||||
Install a stable version of janet from the [releases page](https://github.com/janet-lang/janet/releases).
|
See [the Introduction](https://janet-lang.org/introduction.html) for more details. If you just want
|
||||||
Janet is prebuilt for a few systems, but if you want to develop janet, run janet on a non-x86 system, or
|
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.
|
||||||
get the latest, you must build janet from source. Janet is in alpha and may change
|
|
||||||
in backwards incompatible ways.
|
|
||||||
|
|
||||||
## Usage
|
## Usage
|
||||||
|
|
||||||
@@ -98,7 +153,7 @@ janet:1:> (+ 1 2 3)
|
|||||||
janet:2:> (print "Hello, World!")
|
janet:2:> (print "Hello, World!")
|
||||||
Hello, World!
|
Hello, World!
|
||||||
nil
|
nil
|
||||||
janet:3:> (os.exit)
|
janet:3:> (os/exit)
|
||||||
$ ./janet -h
|
$ ./janet -h
|
||||||
usage: ./janet [options] scripts...
|
usage: ./janet [options] scripts...
|
||||||
Options are:
|
Options are:
|
||||||
@@ -112,68 +167,22 @@ Options are:
|
|||||||
$
|
$
|
||||||
```
|
```
|
||||||
|
|
||||||
|
If installed, you can also run `man janet` to get usage information.
|
||||||
|
|
||||||
## Embedding
|
## Embedding
|
||||||
|
|
||||||
The C API for Janet is not yet documented but coming soon.
|
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`
|
Janet can be embedded in a host program very easily. There is a make target
|
||||||
which creates the file `build/janet.c`, which is a single C file that contains all the source
|
`make amalg` which creates the file `build/janet.c`, which is a single C file
|
||||||
to Janet. This file, along with `src/include/janet/janet.h` can dragged into any C project
|
that contains all the source to Janet. This file, along with
|
||||||
and compiled into the project. Janet should be compiled with `-std=c99` on most compilers, and
|
`src/include/janet.h` and `src/include/janetconf.h` can dragged into any C
|
||||||
will need to be linked to the math library, `-lm`, and the dynamic linker, `-ldl`, if one wants
|
project and compiled into the project. Janet should be compiled with `-std=c99`
|
||||||
to be able to load dynamic modules. If there is no need for dynamic modules, add the define
|
on most compilers, and will need to be linked to the math library, `-lm`, and
|
||||||
|
the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
|
||||||
|
there is no need for dynamic modules, add the define
|
||||||
`-DJANET_NO_DYNAMIC_MODULES` to the compiler options.
|
`-DJANET_NO_DYNAMIC_MODULES` to the compiler options.
|
||||||
|
|
||||||
## Compiling and Running
|
|
||||||
|
|
||||||
Janet only uses Make and batch files to compile on Posix and windows
|
|
||||||
respectively. To configure janet, edit the header file src/include/janet/janet.h
|
|
||||||
before compilation.
|
|
||||||
|
|
||||||
### macos and Unix-like
|
|
||||||
|
|
||||||
On most platforms, use Make to build janet. The resulting binary will be in `build/janet`.
|
|
||||||
|
|
||||||
```sh
|
|
||||||
cd somewhere/my/projects/janet
|
|
||||||
make
|
|
||||||
make test
|
|
||||||
```
|
|
||||||
|
|
||||||
After building, run `make install` to install the janet binary and libs.
|
|
||||||
Will install in `/usr/local` by default, see the Makefile to customize.
|
|
||||||
|
|
||||||
It's also recommended to set the `JANET_PATH` variable in your profile.
|
|
||||||
This is where janet will look for imported libraries after the current directory.
|
|
||||||
|
|
||||||
### FreeBSD
|
|
||||||
|
|
||||||
FreeBSD build instructions are the same as the unix-like build instuctions,
|
|
||||||
but you need `gmake` and `gcc` to compile.
|
|
||||||
|
|
||||||
```
|
|
||||||
cd somewhere/my/projects/janet
|
|
||||||
gmake CC=gcc
|
|
||||||
gmake test CC=gcc
|
|
||||||
```
|
|
||||||
|
|
||||||
### Windows
|
|
||||||
|
|
||||||
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#)
|
|
||||||
or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#)
|
|
||||||
2. Run a Visual Studio Command Prompt (cl.exe and link.exe need to be on the PATH) and cd to the directory with janet.
|
|
||||||
3. Run `build_win` to compile janet.
|
|
||||||
4. Run `build_win test` to make sure everything is working.
|
|
||||||
|
|
||||||
### Emscripten
|
|
||||||
|
|
||||||
To build janet for the web via [Emscripten](https://kripken.github.io/emscripten-site/), make sure you
|
|
||||||
have `emcc` installed and on your path. On a linux or macOS system, use `make emscripten` to build
|
|
||||||
`janet.js` and `janet.wasm` - both are needed to run janet in a browser or in node.
|
|
||||||
The JavaScript build is what runs the repl on the main website,
|
|
||||||
but really serves mainly as a proof of concept. Janet will run slower in a browser.
|
|
||||||
Building with emscripten on windows is currently unsupported.
|
|
||||||
|
|
||||||
## Examples
|
## Examples
|
||||||
|
|
||||||
See the examples directory for some example janet code.
|
See the examples directory for some example janet code.
|
||||||
@@ -183,9 +192,18 @@ See the examples directory for some example janet code.
|
|||||||
Feel free to ask questions and join discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
|
Feel free to ask questions and join discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
|
||||||
Alternatively, check out [the #janet channel on Freenode](https://webchat.freenode.net/)
|
Alternatively, check out [the #janet channel on Freenode](https://webchat.freenode.net/)
|
||||||
|
|
||||||
|
## FAQ
|
||||||
|
|
||||||
|
### Why is my terminal is spitting out junk when I run the repl?
|
||||||
|
|
||||||
|
Make sure your terminal supports ANSI escape codes. Most modern terminals will
|
||||||
|
support these, but some older terminals, windows consoles, or embedded terminals
|
||||||
|
will not. If your terminal does not support ANSI escape codes, run the repl with
|
||||||
|
the `-n` flag, which disables color output. You can also try the `-s` if further issues
|
||||||
|
ensue.
|
||||||
|
|
||||||
## Why Janet
|
## Why Janet
|
||||||
|
|
||||||
Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).
|
Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).
|
||||||
|
|
||||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-the-good-place.gif" alt="Janet logo" width="115px" align="left">
|
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-the-good-place.gif" alt="Janet logo" width="115px" align="left">
|
||||||
|
|
||||||
|
|||||||
@@ -21,9 +21,8 @@ install:
|
|||||||
- build_win
|
- build_win
|
||||||
- build_win test
|
- build_win test
|
||||||
- choco install nsis -y -pre
|
- choco install nsis -y -pre
|
||||||
- call "C:\Program Files (x86)\NSIS\makensis.exe" janet-installer.nsi
|
|
||||||
- build_win dist
|
- build_win dist
|
||||||
- copy janet-install.exe dist\install.exe
|
- call "C:\Program Files (x86)\NSIS\makensis.exe" janet-installer.nsi
|
||||||
|
|
||||||
build: off
|
build: off
|
||||||
|
|
||||||
@@ -33,9 +32,9 @@ only_commits:
|
|||||||
- src/
|
- src/
|
||||||
|
|
||||||
artifacts:
|
artifacts:
|
||||||
- path: dist
|
- path: janet-installer.exe
|
||||||
name: janet-windows
|
name: janet-windows-installer.exe
|
||||||
type: Zip
|
type: File
|
||||||
|
|
||||||
deploy:
|
deploy:
|
||||||
description: 'The Janet Programming Language.'
|
description: 'The Janet Programming Language.'
|
||||||
|
|||||||
BIN
assets/icon.ico
Normal file
BIN
assets/icon.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 100 KiB |
11
assets/icon_svg.svg
Normal file
11
assets/icon_svg.svg
Normal file
@@ -0,0 +1,11 @@
|
|||||||
|
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 20010904//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">
|
||||||
|
<svg version="1.0" xmlns="http://www.w3.org/2000/svg" width="64px" height="64px" viewBox="0 0 640 640" preserveAspectRatio="xMidYMid meet">
|
||||||
|
<g id="layer101" fill="#d45500" stroke="none">
|
||||||
|
<path d="M145 531 c-46 -31 -58 -75 -30 -118 21 -32 30 -22 44 47 7 30 19 62 27 71 26 29 1 29 -41 0z"/>
|
||||||
|
<path d="M341 534 c-23 -29 -26 -50 -11 -88 10 -28 64 -60 86 -52 12 5 12 2 0 -22 -24 -47 -51 -64 -116 -71 -51 -6 -65 -12 -85 -37 -14 -16 -24 -32 -25 -36 0 -12 -35 -9 -48 4 -7 7 -12 24 -12 38 0 41 -11 43 -47 8 -47 -46 -46 -90 5 -138 20 -19 49 -51 63 -70 l27 -35 88 0 c49 0 106 4 127 8 46 10 106 62 143 125 25 42 28 58 30 142 0 52 4 103 9 113 11 27 -14 75 -49 93 -41 21 -115 44 -143 44 -12 0 -31 -12 -42 -26z m89 -119 c0 -3 -2 -5 -5 -5 -3 0 -5 2 -5 5 0 3 2 5 5 5 3 0 5 -2 5 -5z"/>
|
||||||
|
</g>
|
||||||
|
<g id="layer102" fill="#deaa87" stroke="none">
|
||||||
|
<path d="M186 549 c-33 -31 -38 -43 -56 -137 -26 -135 -26 -163 3 -190 33 -31 49 -28 85 17 28 35 36 39 87 43 46 4 61 10 90 38 18 18 39 46 46 62 10 25 9 32 -5 46 -17 16 -19 16 -29 1 -8 -14 -15 -15 -34 -6 -27 12 -40 65 -24 96 10 17 8 23 -12 36 -13 8 -44 18 -69 21 -42 6 -49 4 -82 -27z"/>
|
||||||
|
</g>
|
||||||
|
|
||||||
|
</svg>
|
||||||
|
After Width: | Height: | Size: 1.2 KiB |
43
auxbin/jpm
Executable file
43
auxbin/jpm
Executable file
@@ -0,0 +1,43 @@
|
|||||||
|
#!/usr/bin/env janet
|
||||||
|
|
||||||
|
# CLI tool for building janet projects. Wraps cook.
|
||||||
|
|
||||||
|
(import cook)
|
||||||
|
|
||||||
|
(def- argpeg
|
||||||
|
(peg/compile
|
||||||
|
'(* "--" '(some (if-not "=" 1)) "=" '(any 1))))
|
||||||
|
|
||||||
|
(defn- help
|
||||||
|
[]
|
||||||
|
(print "usage: jpm [targets]... --key=value ...")
|
||||||
|
(print "Available targets are:")
|
||||||
|
(each k (sort (keys (dyn :rules @{})))
|
||||||
|
(print " " k))
|
||||||
|
(print `
|
||||||
|
|
||||||
|
Keys are:
|
||||||
|
--modpath : The directory to install modules to. Defaults to $JANET_MODPATH or (dyn :syspath)
|
||||||
|
--headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH or (dyn :headerpath)
|
||||||
|
--binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH.
|
||||||
|
--optimize : Optimization level for natives. Defaults to $OPTIMIZE or 2.
|
||||||
|
--compiler : C compiler to use for natives. Defaults to $COMPILER or cc.
|
||||||
|
--linker : C linker to use for linking natives. Defaults to $LINKER or cc.
|
||||||
|
--cflags : Extra compiler flags for native modules. Defaults to $CFLAGS if set.
|
||||||
|
--lflags : Extra linker flags for native modules. Defaults to $LFLAGS if set.
|
||||||
|
`))
|
||||||
|
|
||||||
|
(def args (tuple/slice process/args 2))
|
||||||
|
(def todo @[])
|
||||||
|
(each arg args
|
||||||
|
(if (string/has-prefix? "--" arg)
|
||||||
|
(if-let [m (peg/match argpeg arg)]
|
||||||
|
(let [[key value] m]
|
||||||
|
(setdyn (keyword key) value))
|
||||||
|
(print "invalid argument " arg))
|
||||||
|
(array/push todo arg)))
|
||||||
|
|
||||||
|
(cook/import-rules "./project.janet")
|
||||||
|
|
||||||
|
(if (empty? todo) (help))
|
||||||
|
(each rule todo (cook/do-rule rule))
|
||||||
397
auxlib/cook.janet
Normal file
397
auxlib/cook.janet
Normal file
@@ -0,0 +1,397 @@
|
|||||||
|
### cook.janet
|
||||||
|
###
|
||||||
|
### Library to help build janet natives and other
|
||||||
|
### build artifacts.
|
||||||
|
###
|
||||||
|
### Copyright 2019 © Calvin Rose
|
||||||
|
|
||||||
|
#
|
||||||
|
# Basic Path Settings
|
||||||
|
#
|
||||||
|
|
||||||
|
# Windows is the OS outlier
|
||||||
|
(def- is-win (= (os/which) :windows))
|
||||||
|
(def- is-mac (= (os/which) :macos))
|
||||||
|
(def- sep (if is-win "\\" "/"))
|
||||||
|
(def- objext (if is-win ".obj" ".o"))
|
||||||
|
(def- modext (if is-win ".dll" ".so"))
|
||||||
|
|
||||||
|
#
|
||||||
|
# Rule Engine
|
||||||
|
#
|
||||||
|
|
||||||
|
(defn- getrules []
|
||||||
|
(def rules (dyn :rules))
|
||||||
|
(if rules rules (setdyn :rules @{})))
|
||||||
|
|
||||||
|
(defn- gettarget [target]
|
||||||
|
(def item ((getrules) target))
|
||||||
|
(unless item (error (string "No rule for target " target)))
|
||||||
|
item)
|
||||||
|
|
||||||
|
(defn- rule-impl
|
||||||
|
[target deps thunk &opt phony]
|
||||||
|
(put (getrules) target @[(array/slice deps) thunk phony]))
|
||||||
|
|
||||||
|
(defmacro rule
|
||||||
|
"Add a rule to the rule graph."
|
||||||
|
[target deps & body]
|
||||||
|
~(,rule-impl ,target ,deps (fn [] nil ,;body)))
|
||||||
|
|
||||||
|
(defmacro phony
|
||||||
|
"Add a phony rule to the rule graph. A phony rule will run every time
|
||||||
|
(it is always considered out of date). Phony rules are good for defining
|
||||||
|
user facing tasks."
|
||||||
|
[target deps & body]
|
||||||
|
~(,rule-impl ,target ,deps (fn [] nil ,;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."
|
||||||
|
[target dep]
|
||||||
|
(def [deps] (gettarget target))
|
||||||
|
(array/push deps dep))
|
||||||
|
|
||||||
|
(defn- add-thunk
|
||||||
|
[target more]
|
||||||
|
(def item (gettarget target))
|
||||||
|
(def [_ thunk] item)
|
||||||
|
(put item 1 (fn [] (more) (thunk))))
|
||||||
|
|
||||||
|
(defmacro add-body
|
||||||
|
"Add recipe code to an existing rule. This makes existing rules do more but
|
||||||
|
does not modify the dependency graph."
|
||||||
|
[target & body]
|
||||||
|
~(,add-thunk ,target (fn [] ,;body)))
|
||||||
|
|
||||||
|
(defn- needs-build
|
||||||
|
[dest src]
|
||||||
|
(let [mod-dest (os/stat dest :modified)
|
||||||
|
mod-src (os/stat src :modified)]
|
||||||
|
(< mod-dest mod-src)))
|
||||||
|
|
||||||
|
(defn- needs-build-some
|
||||||
|
[dest sources]
|
||||||
|
(def f (file/open dest))
|
||||||
|
(if (not f) (break true))
|
||||||
|
(file/close f)
|
||||||
|
(some (partial needs-build dest) sources))
|
||||||
|
|
||||||
|
(defn do-rule
|
||||||
|
"Evaluate a given rule."
|
||||||
|
[target]
|
||||||
|
(def item ((getrules) target))
|
||||||
|
(unless item
|
||||||
|
(if (os/stat target :mode)
|
||||||
|
(break target)
|
||||||
|
(error (string "No rule for file " target " found."))))
|
||||||
|
(def [deps thunk phony] item)
|
||||||
|
(def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x))
|
||||||
|
(when (or phony (needs-build-some target realdeps))
|
||||||
|
(thunk))
|
||||||
|
(unless phony target))
|
||||||
|
|
||||||
|
(def- _env (fiber/getenv (fiber/current)))
|
||||||
|
|
||||||
|
(defn import-rules
|
||||||
|
"Import another file that defines more cook rules. This ruleset
|
||||||
|
is merged into the current ruleset."
|
||||||
|
[path]
|
||||||
|
(def env (make-env))
|
||||||
|
(unless (os/stat path :mode)
|
||||||
|
(error (string "cannot open " path)))
|
||||||
|
(loop [k :keys _env :when (symbol? k)]
|
||||||
|
(unless ((_env k) :private) (put env k (_env k))))
|
||||||
|
(def currenv (fiber/getenv (fiber/current)))
|
||||||
|
(loop [k :keys currenv :when (keyword? k)]
|
||||||
|
(put env k (currenv k)))
|
||||||
|
(dofile path :env env)
|
||||||
|
(when-let [rules (env :rules)] (merge-into (getrules) rules)))
|
||||||
|
|
||||||
|
#
|
||||||
|
# Configuration
|
||||||
|
#
|
||||||
|
|
||||||
|
# Installation settings
|
||||||
|
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
|
||||||
|
(def JANET_HEADERPATH (os/getenv "JANET_HEADERPATH"))
|
||||||
|
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH") (unless is-win "/usr/local/bin")))
|
||||||
|
|
||||||
|
# Compilation settings
|
||||||
|
(def- OPTIMIZE (or (os/getenv "OPTIMIZE") 2))
|
||||||
|
(def- COMPILER (or (os/getenv "COMPILER") (if is-win "cl" "cc")))
|
||||||
|
(def- LINKER (or (os/getenv "LINKER") (if is-win "link" COMPILER)))
|
||||||
|
(def- LFLAGS
|
||||||
|
(if-let [lflags (os/getenv "LFLAGS")]
|
||||||
|
(string/split " " lflags)
|
||||||
|
(if is-win ["/nologo" "/DLL"]
|
||||||
|
(if is-mac
|
||||||
|
["-shared" "-undefined" "dynamic_lookup"]
|
||||||
|
["-shared"]))))
|
||||||
|
(def- CFLAGS
|
||||||
|
(if-let [cflags (os/getenv "CFLAGS")]
|
||||||
|
(string/split " " cflags)
|
||||||
|
(if is-win
|
||||||
|
["/nologo"]
|
||||||
|
["-std=c99" "-Wall" "-Wextra" "-fpic"])))
|
||||||
|
|
||||||
|
# Some defaults
|
||||||
|
(def default-cflags CFLAGS)
|
||||||
|
(def default-lflags LFLAGS)
|
||||||
|
(def default-cc COMPILER)
|
||||||
|
(def default-ld LINKER)
|
||||||
|
|
||||||
|
(defn- opt
|
||||||
|
"Get an option, allowing overrides via dynamic bindings AND some
|
||||||
|
default value dflt if no dynamic binding is set."
|
||||||
|
[opts key dflt]
|
||||||
|
(def ret (or (opts key) (dyn key dflt)))
|
||||||
|
(if (= nil ret)
|
||||||
|
(error (string "option :" key " not set")))
|
||||||
|
ret)
|
||||||
|
|
||||||
|
#
|
||||||
|
# OS and shell helpers
|
||||||
|
#
|
||||||
|
|
||||||
|
(defn shell
|
||||||
|
"Do a shell command"
|
||||||
|
[& args]
|
||||||
|
(def res (os/execute args :p))
|
||||||
|
(unless (zero? res)
|
||||||
|
(error (string "command exited with status " res))))
|
||||||
|
|
||||||
|
(defn rm
|
||||||
|
"Remove a directory and all sub directories."
|
||||||
|
[path]
|
||||||
|
(if (= (os/stat 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."
|
||||||
|
[src dest]
|
||||||
|
(print "copying " src " to " dest "...")
|
||||||
|
(if is-win
|
||||||
|
(shell "xcopy" src dest "/y" "/e")
|
||||||
|
(shell "cp" "-rf" src dest)))
|
||||||
|
|
||||||
|
#
|
||||||
|
# C Compilation
|
||||||
|
#
|
||||||
|
|
||||||
|
(defn- embed-name
|
||||||
|
"Rename a janet symbol for embedding."
|
||||||
|
[path]
|
||||||
|
(->> path
|
||||||
|
(string/replace-all sep "___")
|
||||||
|
(string/replace-all ".janet" "")))
|
||||||
|
|
||||||
|
(defn- embed-c-name
|
||||||
|
"Rename a janet file for embedding."
|
||||||
|
[path]
|
||||||
|
(->> path
|
||||||
|
(string/replace-all sep "___")
|
||||||
|
(string/replace-all ".janet" ".janet.c")
|
||||||
|
(string "build" sep)))
|
||||||
|
|
||||||
|
(defn- embed-o-name
|
||||||
|
"Get object file for c file."
|
||||||
|
[path]
|
||||||
|
(->> path
|
||||||
|
(string/replace-all sep "___")
|
||||||
|
(string/replace-all ".janet" (string ".janet" objext))
|
||||||
|
(string "build" sep)))
|
||||||
|
|
||||||
|
(defn- object-name
|
||||||
|
"Rename a source file so it can be built in a flat source tree."
|
||||||
|
[path]
|
||||||
|
(->> path
|
||||||
|
(string/replace-all sep "___")
|
||||||
|
(string/replace-all ".c" (if is-win ".obj" ".o"))
|
||||||
|
(string "build" sep)))
|
||||||
|
|
||||||
|
(defn- lib-name
|
||||||
|
"Generate name for dynamic library."
|
||||||
|
[name]
|
||||||
|
(string "build" sep name modext))
|
||||||
|
|
||||||
|
(defn- make-define
|
||||||
|
"Generate strings for adding custom defines to the compiler."
|
||||||
|
[define value]
|
||||||
|
(def pre (if is-win "/D" "-D"))
|
||||||
|
(if value
|
||||||
|
(string pre define "=" value)
|
||||||
|
(string pre define)))
|
||||||
|
|
||||||
|
(defn- make-defines
|
||||||
|
"Generate many defines. Takes a dictionary of defines. If a value is
|
||||||
|
true, generates -DNAME (/DNAME on windows), otherwise -DNAME=value."
|
||||||
|
[defines]
|
||||||
|
(seq [[d v] :pairs defines] (make-define d (if (not= v true) v))))
|
||||||
|
|
||||||
|
(defn- getcflags
|
||||||
|
"Generate the c flags from the input options."
|
||||||
|
[opts]
|
||||||
|
@[;(opt opts :cflags CFLAGS)
|
||||||
|
(string (if is-win "/I" "-I") (opt opts :headerpath JANET_HEADERPATH))
|
||||||
|
(string (if is-win "/O" "-O") (opt opts :optimize OPTIMIZE))])
|
||||||
|
|
||||||
|
(defn- compile-c
|
||||||
|
"Compile a C file into an object file."
|
||||||
|
[opts src dest]
|
||||||
|
(def cc (opt opts :compiler COMPILER))
|
||||||
|
(def cflags (getcflags opts))
|
||||||
|
(def defines (interpose " " (make-defines (opt opts :defines {}))))
|
||||||
|
(def headers (or (opts :headers) []))
|
||||||
|
(rule dest [src ;headers]
|
||||||
|
(print "compiling " dest "...")
|
||||||
|
(if is-win
|
||||||
|
(shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)
|
||||||
|
(shell cc "-c" src ;defines ;cflags "-o" dest))))
|
||||||
|
|
||||||
|
(defn- link-c
|
||||||
|
"Link a number of object files together."
|
||||||
|
[opts target & objects]
|
||||||
|
(def ld (opt opts :linker LINKER))
|
||||||
|
(def cflags (getcflags opts))
|
||||||
|
(def lflags (opt opts :lflags LFLAGS))
|
||||||
|
(rule target objects
|
||||||
|
(print "linking " target "...")
|
||||||
|
(if is-win
|
||||||
|
(shell ld ;lflags (string "/OUT:" target) ;objects (string (opt opts :headerpath JANET_HEADERPATH) `\\janet.lib`))
|
||||||
|
(shell ld ;cflags `-o` target ;objects ;lflags))))
|
||||||
|
|
||||||
|
(defn- create-buffer-c
|
||||||
|
"Inline raw byte file as a c file."
|
||||||
|
[source dest name]
|
||||||
|
(rule dest [source]
|
||||||
|
(print "generating " dest "...")
|
||||||
|
(def f (file/open source :r))
|
||||||
|
(if (not f) (error (string "file " f " not found")))
|
||||||
|
(def out (file/open dest :w))
|
||||||
|
(def chunks (seq [b :in (file/read f :all)] (string b)))
|
||||||
|
(file/write out
|
||||||
|
"#include <janet.h>\n"
|
||||||
|
"static const unsigned char bytes[] = {"
|
||||||
|
;(interpose ", " chunks)
|
||||||
|
"};\n\n"
|
||||||
|
"const unsigned char *" name "_embed = bytes;\n"
|
||||||
|
"size_t " name "_embed_size = sizeof(bytes);\n")
|
||||||
|
(file/close out)
|
||||||
|
(file/close f)))
|
||||||
|
|
||||||
|
#
|
||||||
|
# Declaring Artifacts - used in project.janet, targets specifically
|
||||||
|
# tailored for janet.
|
||||||
|
#
|
||||||
|
|
||||||
|
(defn- install-rule
|
||||||
|
"Add install and uninstall rule for moving file from src into destdir."
|
||||||
|
[src destdir]
|
||||||
|
(def parts (string/split sep src))
|
||||||
|
(def name (last parts))
|
||||||
|
(add-body "install"
|
||||||
|
(try (os/mkdir destdir) ([err] nil))
|
||||||
|
(copy src destdir))
|
||||||
|
(add-body "uninstall"
|
||||||
|
(def path (string destdir sep name))
|
||||||
|
(print "removing " path)
|
||||||
|
(try (rm path) ([err]
|
||||||
|
(unless (= err "No such file or directory")
|
||||||
|
(error err))))))
|
||||||
|
|
||||||
|
(defn declare-native
|
||||||
|
"Declare a native binary. This is a shared library that can be loaded
|
||||||
|
dynamically by a janet runtime."
|
||||||
|
[&keys opts]
|
||||||
|
(def sources (opts :source))
|
||||||
|
(def name (opts :name))
|
||||||
|
(def lname (lib-name name))
|
||||||
|
(loop [src :in sources]
|
||||||
|
(compile-c opts src (object-name src)))
|
||||||
|
(def objects (map object-name sources))
|
||||||
|
(when-let [embedded (opts :embedded)]
|
||||||
|
(loop [src :in embedded]
|
||||||
|
(def c-src (embed-c-name src))
|
||||||
|
(def o-src (embed-o-name src))
|
||||||
|
(array/push objects o-src)
|
||||||
|
(create-buffer-c src c-src (embed-name src))
|
||||||
|
(compile-c opts c-src o-src)))
|
||||||
|
(link-c opts lname ;objects)
|
||||||
|
(add-dep "build" lname)
|
||||||
|
(def path (opt opts :modpath JANET_MODPATH))
|
||||||
|
(install-rule lname path))
|
||||||
|
|
||||||
|
(defn declare-source
|
||||||
|
"Create a Janet modules. This does not actually build the module(s),
|
||||||
|
but registers it for packaging and installation."
|
||||||
|
[&keys opts]
|
||||||
|
(def sources (opts :source))
|
||||||
|
(def path (opt opts :modpath JANET_MODPATH))
|
||||||
|
(each s sources
|
||||||
|
(install-rule s path)))
|
||||||
|
|
||||||
|
(defn declare-bin
|
||||||
|
"Declare a generic file to be installed as an executable."
|
||||||
|
[&keys opts]
|
||||||
|
(def main (opts :main))
|
||||||
|
(def binpath (opt opts :binpath JANET_BINPATH))
|
||||||
|
(install-rule main binpath))
|
||||||
|
|
||||||
|
(defn declare-binscript
|
||||||
|
"Declare a janet file to be installed as an executable script. Creates
|
||||||
|
a shim on windows."
|
||||||
|
[&keys opts]
|
||||||
|
(def main (opts :main))
|
||||||
|
(def binpath (opt opts :binpath JANET_BINPATH))
|
||||||
|
(install-rule main binpath)
|
||||||
|
# Create a dud batch file when on windows.
|
||||||
|
(when is-win
|
||||||
|
(def name (last (string/split sep main)))
|
||||||
|
(def bat (string "@echo off\r\njanet %~dp0\\" name "%*"))
|
||||||
|
(def newname (string binpath sep name ".bat"))
|
||||||
|
(add-body "install"
|
||||||
|
(spit newname bat))
|
||||||
|
(add-body "uninstall"
|
||||||
|
(os/rm newname))))
|
||||||
|
|
||||||
|
(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
|
||||||
|
a janet vm and the required dependencies and run there."
|
||||||
|
[&keys opts]
|
||||||
|
(def entry (opts :entry))
|
||||||
|
(def name (opts :name))
|
||||||
|
(def iname (string "build" sep name ".jimage"))
|
||||||
|
(rule iname (or (opts :deps) [])
|
||||||
|
(spit iname (make-image (require entry))))
|
||||||
|
(def path (opt opts :modpath JANET_MODPATH))
|
||||||
|
(install-rule iname path))
|
||||||
|
|
||||||
|
(defn declare-project
|
||||||
|
"Define your project metadata. This should
|
||||||
|
be the first declaration in a project.janet file.
|
||||||
|
Also sets up basic phony targets like clean, build, test, etc."
|
||||||
|
[&keys meta]
|
||||||
|
(setdyn :project meta)
|
||||||
|
(try (os/mkdir "build") ([err] nil))
|
||||||
|
(phony "build" [])
|
||||||
|
(phony "install" ["build"] (print "Installed."))
|
||||||
|
(phony "uninstall" [] (print "Uninstalled."))
|
||||||
|
(phony "clean" [] (rm "build") (print "Deleted build directory."))
|
||||||
|
(phony "test" ["build"]
|
||||||
|
(defn dodir
|
||||||
|
[dir]
|
||||||
|
(each sub (os/dir dir)
|
||||||
|
(def ndir (string dir sep sub))
|
||||||
|
(case (os/stat ndir :mode)
|
||||||
|
:file (when (string/has-suffix? ".janet" ndir)
|
||||||
|
(print "running " ndir " ...")
|
||||||
|
(dofile ndir :exit true))
|
||||||
|
:directory (dodir ndir))))
|
||||||
|
(dodir "test")
|
||||||
|
(print "All tests passed.")))
|
||||||
149
auxlib/path.janet
Normal file
149
auxlib/path.janet
Normal file
@@ -0,0 +1,149 @@
|
|||||||
|
### path.janet
|
||||||
|
###
|
||||||
|
### A library for path manipulation.
|
||||||
|
###
|
||||||
|
### Copyright 2019 © Calvin Rose
|
||||||
|
|
||||||
|
#
|
||||||
|
# Common
|
||||||
|
#
|
||||||
|
|
||||||
|
(def- ext-peg
|
||||||
|
(peg/compile ~{:back (> -1 (+ (* ($) (set "\\/.")) :back))
|
||||||
|
:main :back}))
|
||||||
|
|
||||||
|
(defn ext
|
||||||
|
"Get the file extension for a path."
|
||||||
|
[path]
|
||||||
|
(if-let [m (peg/match ext-peg path (length path))]
|
||||||
|
(let [i (m 0)]
|
||||||
|
(if (= (path i) 46)
|
||||||
|
(string/slice path (m 0) -1)))))
|
||||||
|
|
||||||
|
(defn- redef
|
||||||
|
"Redef a value, keeping all metadata."
|
||||||
|
[from to]
|
||||||
|
(setdyn (symbol to) (dyn (symbol from))))
|
||||||
|
|
||||||
|
#
|
||||||
|
# Generating Macros
|
||||||
|
#
|
||||||
|
|
||||||
|
(defmacro- decl-sep [pre sep] ~(def ,(symbol pre "/sep") ,sep))
|
||||||
|
(defmacro- decl-delim [pre d] ~(def ,(symbol pre "/delim") ,d))
|
||||||
|
|
||||||
|
(defmacro- decl-last-sep
|
||||||
|
[pre sep]
|
||||||
|
~(def- ,(symbol pre "/last-sep-peg")
|
||||||
|
(peg/compile ~{:back (> -1 (+ (* ,sep ($)) :back))
|
||||||
|
:main :back})))
|
||||||
|
|
||||||
|
(defmacro- decl-basename
|
||||||
|
[pre]
|
||||||
|
~(defn ,(symbol pre "/basename")
|
||||||
|
"Gets the base file name of a path."
|
||||||
|
[path]
|
||||||
|
(if-let [m (peg/match
|
||||||
|
,(symbol pre "/last-sep-peg")
|
||||||
|
path
|
||||||
|
(length path))]
|
||||||
|
(let [[p] m]
|
||||||
|
(string/slice path p -1))
|
||||||
|
path)))
|
||||||
|
|
||||||
|
(defmacro- decl-parts
|
||||||
|
[pre sep]
|
||||||
|
~(defn ,(symbol pre "/parts")
|
||||||
|
"Split a path into its parts."
|
||||||
|
[path]
|
||||||
|
(string/split ,sep path)))
|
||||||
|
|
||||||
|
(defmacro- decl-normalize
|
||||||
|
[pre sep lead]
|
||||||
|
~(defn ,(symbol pre "/normalize")
|
||||||
|
"Normalize a path. This removes . and .. in the
|
||||||
|
path, as well as empty path elements."
|
||||||
|
[path]
|
||||||
|
(def els (string/split ,sep path))
|
||||||
|
(def newparts @[])
|
||||||
|
(if (,(symbol pre "/abspath?") path) (array/push newparts ,lead))
|
||||||
|
(each part els
|
||||||
|
(case part
|
||||||
|
"" nil
|
||||||
|
"." nil
|
||||||
|
".." (array/pop newparts)
|
||||||
|
(array/push newparts part)))
|
||||||
|
(string/join newparts ,sep)))
|
||||||
|
|
||||||
|
(defmacro- decl-join
|
||||||
|
[pre sep]
|
||||||
|
~(defn ,(symbol pre "/join")
|
||||||
|
"Join path elements together."
|
||||||
|
[& els]
|
||||||
|
(,(symbol pre "/normalize") (string/join els ,sep))))
|
||||||
|
|
||||||
|
(defmacro- decl-abspath
|
||||||
|
[pre]
|
||||||
|
~(defn ,(symbol pre "/abspath")
|
||||||
|
"Coerce a path to be absolute."
|
||||||
|
[path]
|
||||||
|
(if (,(symbol pre "/abspath?") path)
|
||||||
|
path
|
||||||
|
(,(symbol pre "/join") (os/cwd) path))))
|
||||||
|
|
||||||
|
#
|
||||||
|
# Posix
|
||||||
|
#
|
||||||
|
|
||||||
|
(defn posix/abspath?
|
||||||
|
"Check if a path is absolute."
|
||||||
|
[path]
|
||||||
|
(string/has-prefix? "/" path))
|
||||||
|
|
||||||
|
(redef "ext" "posix/ext")
|
||||||
|
(decl-sep "posix" "/")
|
||||||
|
(decl-delim "posix" ":")
|
||||||
|
(decl-last-sep "posix" "/")
|
||||||
|
(decl-basename "posix")
|
||||||
|
(decl-parts "posix" "/")
|
||||||
|
(decl-normalize "posix" "/" "")
|
||||||
|
(decl-join "posix" "/")
|
||||||
|
(decl-abspath "posix")
|
||||||
|
|
||||||
|
#
|
||||||
|
# Windows
|
||||||
|
#
|
||||||
|
|
||||||
|
(def- abs-peg (peg/compile '(* (range "AZ") ":\\")))
|
||||||
|
(defn win32/abspath?
|
||||||
|
"Check if a path is absolute."
|
||||||
|
[path]
|
||||||
|
(peg/match abs-peg path))
|
||||||
|
|
||||||
|
(redef "ext" "win32/ext")
|
||||||
|
(decl-sep "win32" "\\")
|
||||||
|
(decl-delim "win32" ";")
|
||||||
|
(decl-last-sep "win32" "\\")
|
||||||
|
(decl-basename "win32")
|
||||||
|
(decl-parts "win32" "\\")
|
||||||
|
(decl-normalize "win32" "\\" "C:")
|
||||||
|
(decl-join "win32" "\\")
|
||||||
|
(decl-abspath "win32")
|
||||||
|
|
||||||
|
#
|
||||||
|
# Specialize for current OS
|
||||||
|
#
|
||||||
|
|
||||||
|
(def- syms
|
||||||
|
["ext"
|
||||||
|
"sep"
|
||||||
|
"delim"
|
||||||
|
"basename"
|
||||||
|
"abspath?"
|
||||||
|
"abspath"
|
||||||
|
"parts"
|
||||||
|
"normalize"
|
||||||
|
"join"])
|
||||||
|
(let [pre (if (= :windows (os/which)) "win32" "posix")]
|
||||||
|
(each sym syms
|
||||||
|
(redef (string pre "/" sym) sym)))
|
||||||
@@ -16,7 +16,7 @@
|
|||||||
|
|
||||||
@rem Set compile and link options here
|
@rem Set compile and link options here
|
||||||
@setlocal
|
@setlocal
|
||||||
@set JANET_COMPILE=cl /nologo /Isrc\include /c /O2 /W3 /LD /D_CRT_SECURE_NO_WARNINGS
|
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /LD /D_CRT_SECURE_NO_WARNINGS
|
||||||
@set JANET_LINK=link /nologo
|
@set JANET_LINK=link /nologo
|
||||||
|
|
||||||
mkdir build
|
mkdir build
|
||||||
@@ -31,16 +31,12 @@ mkdir build\boot
|
|||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
@rem Generate the embedded sources
|
@rem Generate the embedded sources
|
||||||
@build\xxd.exe src\core\core.janet build\core.gen.c janet_gen_core
|
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
|
||||||
@build\xxd.exe src\mainclient\init.janet build\init.gen.c janet_gen_init
|
@build\xxd.exe src\mainclient\init.janet build\init.gen.c janet_gen_init
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
@build\xxd.exe src\boot\boot.janet build\boot.gen.c janet_gen_boot
|
@build\xxd.exe src\boot\boot.janet build\boot.gen.c janet_gen_boot
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
@rem Build the generated sources
|
@rem Build the generated sources
|
||||||
@%JANET_COMPILE% /Fobuild\boot\core.gen.obj build\core.gen.c
|
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
|
||||||
@%JANET_COMPILE% /Fobuild\mainclient\init.gen.obj build\init.gen.c
|
@%JANET_COMPILE% /Fobuild\mainclient\init.gen.obj build\init.gen.c
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
@%JANET_COMPILE% /Fobuild\boot\boot.gen.obj build\boot.gen.c
|
@%JANET_COMPILE% /Fobuild\boot\boot.gen.obj build\boot.gen.c
|
||||||
@@ -57,7 +53,7 @@ for %%f in (src\boot\*.c) do (
|
|||||||
)
|
)
|
||||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
build\janet_boot
|
build\janet_boot build\core_image.c
|
||||||
|
|
||||||
@rem Build the core image
|
@rem Build the core image
|
||||||
@%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c
|
@%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c
|
||||||
@@ -69,6 +65,9 @@ for %%f in (src\core\*.c) do (
|
|||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@rem Build the resources
|
||||||
|
rc /nologo /fobuild\janet_win.res janet_win.rc
|
||||||
|
|
||||||
@rem Build the main client
|
@rem Build the main client
|
||||||
for %%f in (src\mainclient\*.c) do (
|
for %%f in (src\mainclient\*.c) do (
|
||||||
@%JANET_COMPILE% /Fobuild\mainclient\%%~nf.obj %%f
|
@%JANET_COMPILE% /Fobuild\mainclient\%%~nf.obj %%f
|
||||||
@@ -76,9 +75,17 @@ for %%f in (src\mainclient\*.c) do (
|
|||||||
)
|
)
|
||||||
|
|
||||||
@rem Link everything to main client
|
@rem Link everything to main client
|
||||||
%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj build\core_image.obj
|
%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj build\core_image.obj build\janet_win.res
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
|
@rem Gen amlag
|
||||||
|
setlocal enabledelayedexpansion
|
||||||
|
set "amalg_files="
|
||||||
|
for %%f in (src\core\*.c) do (
|
||||||
|
set "amalg_files=!amalg_files! %%f"
|
||||||
|
)
|
||||||
|
janet.exe tools\amalg.janet src\core\util.h src\core\state.h src\core\gc.h src\core\vector.h src\core\fiber.h src\core\regalloc.h src\core\compile.h src\core\emit.h src\core\symcache.h %amalg_files% build\core_image.c > build\janet.c
|
||||||
|
|
||||||
echo === Successfully built janet.exe for Windows ===
|
echo === Successfully built janet.exe for Windows ===
|
||||||
echo === Run 'build_win test' to run tests. ==
|
echo === Run 'build_win test' to run tests. ==
|
||||||
echo === Run 'build_win clean' to delete build artifacts. ===
|
echo === Run 'build_win clean' to delete build artifacts. ===
|
||||||
@@ -116,15 +123,21 @@ exit /b 0
|
|||||||
:DIST
|
:DIST
|
||||||
mkdir dist
|
mkdir dist
|
||||||
janet.exe tools\gendoc.janet > dist\doc.html
|
janet.exe tools\gendoc.janet > dist\doc.html
|
||||||
janet.exe tools\amalg.janet > dist\janet.c
|
|
||||||
|
copy build\janet.c dist\janet.c
|
||||||
copy janet.exe dist\janet.exe
|
copy janet.exe dist\janet.exe
|
||||||
copy LICENSE dist\LICENSE
|
copy LICENSE dist\LICENSE
|
||||||
copy README.md dist\README.md
|
copy README.md dist\README.md
|
||||||
|
|
||||||
copy janet.lib dist\janet.lib
|
copy janet.lib dist\janet.lib
|
||||||
copy janet.exp dist\janet.exp
|
copy janet.exp dist\janet.exp
|
||||||
copy src\include\janet\janet.h dist\janet.h
|
copy src\include\janet.h dist\janet.h
|
||||||
copy tools\cook.janet dist\cook.janet
|
copy src\conf\janetconf.h dist\janetconf.h
|
||||||
copy tools\highlight.janet dist\highlight.janet
|
|
||||||
|
copy auxlib\cook.janet dist\cook.janet
|
||||||
|
|
||||||
|
copy auxbin\jpm dist\jpm
|
||||||
|
copy tools\jpm.bat dist\jpm.bat
|
||||||
exit /b 0
|
exit /b 0
|
||||||
|
|
||||||
:TESTFAIL
|
:TESTFAIL
|
||||||
|
|||||||
@@ -14,5 +14,5 @@
|
|||||||
(map keys (keys solutions)))
|
(map keys (keys solutions)))
|
||||||
|
|
||||||
(def arr @[2 4 1 3 8 7 -3 -1 12 -5 -8])
|
(def arr @[2 4 1 3 8 7 -3 -1 12 -5 -8])
|
||||||
(print "3sum of " (string/pretty arr) ":")
|
(printf "3sum of %P: " arr)
|
||||||
(print (string/pretty (sum3 arr)))
|
(printf "%P\n" (sum3 arr))
|
||||||
|
|||||||
@@ -4,11 +4,11 @@
|
|||||||
(seq [x :range [-1 2]
|
(seq [x :range [-1 2]
|
||||||
y :range [-1 2]
|
y :range [-1 2]
|
||||||
:when (not (and (zero? x) (zero? y)))]
|
:when (not (and (zero? x) (zero? y)))]
|
||||||
(tuple x y)))
|
[x y]))
|
||||||
|
|
||||||
(defn- neighbors
|
(defn- neighbors
|
||||||
[[x y]]
|
[[x y]]
|
||||||
(map (fn [[x1 y1]] (tuple (+ x x1) (+ y y1))) window))
|
(map (fn [[x1 y1]] [(+ x x1) (+ y y1)]) window))
|
||||||
|
|
||||||
(defn tick
|
(defn tick
|
||||||
"Get the next state in the Game Of Life."
|
"Get the next state in the Game Of Life."
|
||||||
@@ -28,7 +28,7 @@
|
|||||||
(loop [x :range [x1 (+ 1 x2)]
|
(loop [x :range [x1 (+ 1 x2)]
|
||||||
:after (print)
|
:after (print)
|
||||||
y :range [y1 (+ 1 y2)]]
|
y :range [y1 (+ 1 y2)]]
|
||||||
(file/write stdout (if (get cellset (tuple x y)) "X " ". ")))
|
(file/write stdout (if (get cellset [x y]) "X " ". ")))
|
||||||
(print))
|
(print))
|
||||||
|
|
||||||
#
|
#
|
||||||
|
|||||||
@@ -2,10 +2,8 @@
|
|||||||
# of the triangle to the leaves of the triangle.
|
# of the triangle to the leaves of the triangle.
|
||||||
|
|
||||||
(defn myfold [xs ys]
|
(defn myfold [xs ys]
|
||||||
(let [xs1 (tuple/prepend xs 0)
|
(let [m1 (map + [;xs 0] ys)
|
||||||
xs2 (tuple/append xs 0)
|
m2 (map + [0 ;xs] ys)]
|
||||||
m1 (map + xs1 ys)
|
|
||||||
m2 (map + xs2 ys)]
|
|
||||||
(map max m1 m2)))
|
(map max m1 m2)))
|
||||||
|
|
||||||
(defn maxpath [t]
|
(defn maxpath [t]
|
||||||
|
|||||||
1
examples/numarray/.gitignore
vendored
Normal file
1
examples/numarray/.gitignore
vendored
Normal file
@@ -0,0 +1 @@
|
|||||||
|
/build
|
||||||
@@ -4,7 +4,7 @@
|
|||||||
:name "numarray"
|
:name "numarray"
|
||||||
:source @["numarray.c"])
|
:source @["numarray.c"])
|
||||||
|
|
||||||
(import build/numarray :prefix "")
|
(import build/numarray :as numarray)
|
||||||
|
|
||||||
(def a (numarray/new 30))
|
(def a (numarray/new 30))
|
||||||
(print (get a 20))
|
(print (get a 20))
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
#include <stdlib.h>
|
#include <stdlib.h>
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
|
|
||||||
typedef struct {
|
typedef struct {
|
||||||
double *data;
|
double *data;
|
||||||
@@ -99,11 +99,13 @@ Janet num_array_get(void *p, Janet key) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static const JanetReg cfuns[] = {
|
||||||
{"numarray/new", num_array_new,
|
{
|
||||||
|
"new", num_array_new,
|
||||||
"(numarray/new size)\n\n"
|
"(numarray/new size)\n\n"
|
||||||
"Create new numarray"
|
"Create new numarray"
|
||||||
},
|
},
|
||||||
{"numarray/scale", num_array_scale,
|
{
|
||||||
|
"scale", num_array_scale,
|
||||||
"(numarray/scale numarray factor)\n\n"
|
"(numarray/scale numarray factor)\n\n"
|
||||||
"scale numarray by factor"
|
"scale numarray by factor"
|
||||||
},
|
},
|
||||||
|
|||||||
@@ -13,4 +13,4 @@
|
|||||||
(if isprime? (array/push list i)))
|
(if isprime? (array/push list i)))
|
||||||
list)
|
list)
|
||||||
|
|
||||||
(print (string/pretty (primes 100)))
|
(pp (primes 100))
|
||||||
|
|||||||
83
examples/tarray.janet
Normal file
83
examples/tarray.janet
Normal file
@@ -0,0 +1,83 @@
|
|||||||
|
# naive matrix implementation for testing typed array
|
||||||
|
|
||||||
|
(defmacro printf [& xs] ['print ['string/format (splice xs)]])
|
||||||
|
|
||||||
|
(defn matrix [nrow ncol] {:nrow nrow :ncol ncol :array (tarray/new :float64 (* nrow ncol))})
|
||||||
|
|
||||||
|
(defn matrix/row [mat i]
|
||||||
|
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||||
|
(tarray/new :float64 ncol 1 (* i ncol) array))
|
||||||
|
|
||||||
|
(defn matrix/column [mat j]
|
||||||
|
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||||
|
(tarray/new :float64 nrow ncol j array))
|
||||||
|
|
||||||
|
(defn matrix/set [mat i j value]
|
||||||
|
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||||
|
(set (array (+ (* i ncol) j)) value))
|
||||||
|
|
||||||
|
(defn matrix/get [mat i j value]
|
||||||
|
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||||
|
(array (+ (* i ncol) j)))
|
||||||
|
|
||||||
|
|
||||||
|
# other variants to test rows and cols views
|
||||||
|
|
||||||
|
(defn matrix/set* [mat i j value]
|
||||||
|
(set ((matrix/row mat i) j) value))
|
||||||
|
|
||||||
|
(defn matrix/set** [mat i j value]
|
||||||
|
(set ((matrix/column mat j) i) value))
|
||||||
|
|
||||||
|
|
||||||
|
(defn matrix/get* [mat i j value]
|
||||||
|
((matrix/row mat i) j))
|
||||||
|
|
||||||
|
(defn matrix/get** [mat i j value]
|
||||||
|
((matrix/column j) i))
|
||||||
|
|
||||||
|
|
||||||
|
(defn tarray/print [array]
|
||||||
|
(def size (tarray/length array))
|
||||||
|
(def buf @"")
|
||||||
|
(buffer/format buf "[%2i]" size)
|
||||||
|
(for i 0 size
|
||||||
|
(buffer/format buf " %+6.3f " (array i)))
|
||||||
|
(print buf))
|
||||||
|
|
||||||
|
(defn matrix/print [mat]
|
||||||
|
(def {:nrow nrow :ncol ncol :array tarray} mat)
|
||||||
|
(printf "matrix %iX%i %p" nrow ncol tarray)
|
||||||
|
(for i 0 nrow
|
||||||
|
(tarray/print (matrix/row mat i))))
|
||||||
|
|
||||||
|
|
||||||
|
(def nr 5)
|
||||||
|
(def nc 4)
|
||||||
|
(def A (matrix nr nc))
|
||||||
|
|
||||||
|
(loop (i :range (0 nr) j :range (0 nc))
|
||||||
|
(matrix/set A i j i))
|
||||||
|
(matrix/print A)
|
||||||
|
|
||||||
|
(loop (i :range (0 nr) j :range (0 nc))
|
||||||
|
(matrix/set* A i j i))
|
||||||
|
(matrix/print A)
|
||||||
|
|
||||||
|
(loop (i :range (0 nr) j :range (0 nc))
|
||||||
|
(matrix/set** A i j i))
|
||||||
|
(matrix/print A)
|
||||||
|
|
||||||
|
|
||||||
|
(printf "properties:\n%p" (tarray/properties (A :array)))
|
||||||
|
(for i 0 nr
|
||||||
|
(printf "row properties:[%i]\n%p" i (tarray/properties (matrix/row A i))))
|
||||||
|
(for i 0 nc
|
||||||
|
(printf "col properties:[%i]\n%p" i (tarray/properties (matrix/column A i))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
29
examples/urlloader.janet
Normal file
29
examples/urlloader.janet
Normal file
@@ -0,0 +1,29 @@
|
|||||||
|
# An example of using Janet's extensible module system
|
||||||
|
# to import files from URL. To try this, run `janet -l examples/urlloader.janet`
|
||||||
|
# from the repl, and then:
|
||||||
|
#
|
||||||
|
# (import https://raw.githubusercontent.com/janet-lang/janet/master/examples/colors.janet :as c)
|
||||||
|
#
|
||||||
|
# This will import a file using curl. You can then try
|
||||||
|
#
|
||||||
|
# (print (c/color :green "Hello!"))
|
||||||
|
#
|
||||||
|
# This is a bit of a toy example (it just shells out to curl), but it is very
|
||||||
|
# powerful and will work well in many cases.
|
||||||
|
|
||||||
|
(defn- load-url
|
||||||
|
[url args]
|
||||||
|
(def f (file/popen (string "curl " url)))
|
||||||
|
(def res (dofile f :source url ;args))
|
||||||
|
(try (file/close f) ([err] nil))
|
||||||
|
res)
|
||||||
|
|
||||||
|
(defn- check-http-url
|
||||||
|
[path]
|
||||||
|
(if (or (string/has-prefix? "http://" path)
|
||||||
|
(string/has-prefix? "https://" path))
|
||||||
|
path))
|
||||||
|
|
||||||
|
# Add the module loader and path tuple to right places
|
||||||
|
(array/push module/paths [check-http-url :janet-http])
|
||||||
|
(put module/loaders :janet-http load-url)
|
||||||
@@ -1,55 +1,182 @@
|
|||||||
|
# Version
|
||||||
|
!define VERSION "1.0.0"
|
||||||
|
!define PRODUCT_VERSION "${VERSION}.0"
|
||||||
|
VIProductVersion "${PRODUCT_VERSION}"
|
||||||
|
VIFileVersion "${PRODUCT_VERSION}"
|
||||||
|
|
||||||
|
# Use the modern UI
|
||||||
!define MULTIUSER_EXECUTIONLEVEL Highest
|
!define MULTIUSER_EXECUTIONLEVEL Highest
|
||||||
!define MULTIUSER_MUI
|
!define MULTIUSER_MUI
|
||||||
!define MULTIUSER_INSTALLMODE_COMMANDLINE
|
!define MULTIUSER_INSTALLMODE_COMMANDLINE
|
||||||
!define MULTIUSER_INSTALLMODE_INSTDIR "janet"
|
!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_KEY "Software\Janet\${VERSION}"
|
||||||
|
!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_VALUENAME ""
|
||||||
|
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_KEY "Software\Janet\${VERSION}"
|
||||||
|
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_VALUENAME ""
|
||||||
|
!define MULTIUSER_INSTALLMODE_INSTDIR "Janet-${VERSION}"
|
||||||
|
|
||||||
|
# Includes
|
||||||
!include "MultiUser.nsh"
|
!include "MultiUser.nsh"
|
||||||
!include "MUI2.nsh"
|
!include "MUI2.nsh"
|
||||||
|
!include ".\tools\EnvVarUpdate.nsh"
|
||||||
|
!include "LogicLib.nsh"
|
||||||
|
|
||||||
|
# Basics
|
||||||
Name "Janet"
|
Name "Janet"
|
||||||
OutFile "janet-install.exe"
|
OutFile "janet-v${VERSION}-windows-installer.exe"
|
||||||
|
|
||||||
|
# Some Configuration
|
||||||
|
!define APPNAME "Janet"
|
||||||
|
!define DESCRIPTION "The Janet Programming Language"
|
||||||
|
!define HELPURL "http://janet-lang.org"
|
||||||
|
BrandingText "The Janet Programming Language"
|
||||||
|
|
||||||
|
# Macros for setting registry values
|
||||||
|
!define UNINST_KEY "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet-${VERSION}"
|
||||||
|
!macro WriteEnv key value
|
||||||
|
${If} $MultiUser.InstallMode == "AllUsers"
|
||||||
|
WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "${key}" "${value}"
|
||||||
|
${Else}
|
||||||
|
WriteRegExpandStr HKCU "Environment" "${key}" "${value}"
|
||||||
|
${EndIf}
|
||||||
|
!macroend
|
||||||
|
!macro DelEnv key
|
||||||
|
${If} $MultiUser.InstallMode == "AllUsers"
|
||||||
|
DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "${key}"
|
||||||
|
${Else}
|
||||||
|
DeleteRegValue HKCU "Environment" "${key}"
|
||||||
|
${EndIf}
|
||||||
|
!macroend
|
||||||
|
|
||||||
|
# MUI Configuration
|
||||||
|
!define MUI_ICON "assets\icon.ico"
|
||||||
|
!define MUI_UNICON "assets\icon.ico"
|
||||||
|
!define MUI_HEADERIMAGE
|
||||||
|
!define MUI_HEADERIMAGE_BITMAP "assets\janet-w200.png"
|
||||||
|
!define MUI_HEADERIMAGE_RIGHT
|
||||||
!define MUI_ABORTWARNING
|
!define MUI_ABORTWARNING
|
||||||
|
|
||||||
|
# Show a welcome page first
|
||||||
!insertmacro MUI_PAGE_WELCOME
|
!insertmacro MUI_PAGE_WELCOME
|
||||||
!insertmacro MUI_PAGE_LICENSE "LICENSE"
|
!insertmacro MUI_PAGE_LICENSE "LICENSE"
|
||||||
!insertmacro MUI_PAGE_COMPONENTS
|
|
||||||
|
# Pick Install Directory
|
||||||
!insertmacro MULTIUSER_PAGE_INSTALLMODE
|
!insertmacro MULTIUSER_PAGE_INSTALLMODE
|
||||||
!insertmacro MUI_PAGE_DIRECTORY
|
!insertmacro MUI_PAGE_DIRECTORY
|
||||||
|
|
||||||
!insertmacro MUI_PAGE_INSTFILES
|
!insertmacro MUI_PAGE_INSTFILES
|
||||||
|
|
||||||
|
# Done
|
||||||
!insertmacro MUI_PAGE_FINISH
|
!insertmacro MUI_PAGE_FINISH
|
||||||
|
|
||||||
!insertmacro MUI_UNPAGE_CONFIRM
|
# Need to set a language.
|
||||||
!insertmacro MUI_UNPAGE_INSTFILES
|
|
||||||
|
|
||||||
!insertmacro MUI_LANGUAGE "English"
|
!insertmacro MUI_LANGUAGE "English"
|
||||||
|
|
||||||
Section "Janet" BfWSection
|
function .onInit
|
||||||
SetOutPath $INSTDIR
|
!insertmacro MULTIUSER_INIT
|
||||||
File "janet.exe"
|
functionEnd
|
||||||
WriteUninstaller "$INSTDIR\janet-uninstall.exe"
|
|
||||||
|
section "Janet" BfWSection
|
||||||
|
createDirectory "$INSTDIR\Library"
|
||||||
|
createDirectory "$INSTDIR\C"
|
||||||
|
createDirectory "$INSTDIR\bin"
|
||||||
|
createDirectory "$INSTDIR\docs"
|
||||||
|
setOutPath "$INSTDIR"
|
||||||
|
|
||||||
|
# Bin files
|
||||||
|
file /oname=bin\janet.exe dist\janet.exe
|
||||||
|
file /oname=logo.ico assets\icon.ico
|
||||||
|
file /oname=bin\jpm.janet auxbin\jpm
|
||||||
|
file /oname=bin\jpm.bat tools\jpm.bat
|
||||||
|
|
||||||
|
# Modules
|
||||||
|
file /oname=Library\cook.janet auxlib\cook.janet
|
||||||
|
file /oname=Library\path.janet auxlib\path.janet
|
||||||
|
|
||||||
|
# C headers
|
||||||
|
file /oname=C\janet.h dist\janet.h
|
||||||
|
file /oname=C\janetconf.h dist\janetconf.h
|
||||||
|
file /oname=C\janet.lib dist\janet.lib
|
||||||
|
file /oname=C\janet.exp dist\janet.exp
|
||||||
|
file /oname=C\janet.c dist\janet.c
|
||||||
|
|
||||||
|
# Documentation
|
||||||
|
file /oname=docs\docs.html dist\doc.html
|
||||||
|
|
||||||
|
# Other
|
||||||
|
file README.md
|
||||||
|
file LICENSE
|
||||||
|
|
||||||
|
# Uninstaller - See function un.onInit and section "uninstall" for configuration
|
||||||
|
writeUninstaller "$INSTDIR\uninstall.exe"
|
||||||
|
|
||||||
# Start Menu
|
# Start Menu
|
||||||
CreateShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\janet.exe" "" ""
|
createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico"
|
||||||
SectionEnd
|
|
||||||
|
|
||||||
Function .onInit
|
# Set up Environment variables
|
||||||
!insertmacro MULTIUSER_INIT
|
!insertmacro WriteEnv JANET_PATH "$INSTDIR\Library"
|
||||||
!insertmacro MUI_LANGDLL_DISPLAY
|
!insertmacro WriteEnv JANET_HEADERPATH "$INSTDIR\C"
|
||||||
FunctionEnd
|
!insertmacro WriteEnv JANET_BINPATH "$INSTDIR\bin"
|
||||||
|
|
||||||
!insertmacro MUI_FUNCTION_DESCRIPTION_BEGIN
|
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||||
!insertmacro MUI_DESCRIPTION_TEXT ${BfWSection} "The Janet programming language."
|
|
||||||
!insertmacro MUI_FUNCTION_DESCRIPTION_END
|
|
||||||
|
|
||||||
Section "Uninstall"
|
# Update path
|
||||||
Delete "$INSTDIR\janet.exe"
|
${EnvVarUpdate} $0 "PATH" "A" "HKCU" "$INSTDIR\bin" ; Append
|
||||||
Delete "$INSTDIR\janet-uninstall.exe"
|
${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append
|
||||||
RMDir "$INSTDIR"
|
|
||||||
SectionEnd
|
|
||||||
|
|
||||||
Function un.onInit
|
# Registry information for add/remove programs
|
||||||
|
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayName" "Janet"
|
||||||
|
WriteRegStr SHCTX "${UNINST_KEY}" "InstallLocation" "$INSTDIR"
|
||||||
|
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayIcon" "$INSTDIR\logo.ico"
|
||||||
|
WriteRegStr SHCTX "${UNINST_KEY}" "Publisher" "Janet-Lang.org"
|
||||||
|
WriteRegStr SHCTX "${UNINST_KEY}" "HelpLink" "${HELPURL}"
|
||||||
|
WriteRegStr SHCTX "${UNINST_KEY}" "URLUpdateInfo" "${HELPURL}"
|
||||||
|
WriteRegStr SHCTX "${UNINST_KEY}" "URLInfoAbout" "${HELPURL}"
|
||||||
|
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayVersion" "0.6.0"
|
||||||
|
WriteRegDWORD SHCTX "${UNINST_KEY}" "VersionMajor" 0
|
||||||
|
WriteRegDWORD SHCTX "${UNINST_KEY}" "VersionMinor" 6
|
||||||
|
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoModify" 1
|
||||||
|
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoRepair" 1
|
||||||
|
WriteRegDWORD SHCTX "${UNINST_KEY}" "EstimatedSize" 1000
|
||||||
|
# Add uninstall
|
||||||
|
WriteRegStr SHCTX "${UNINST_KEY}" "UninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode"
|
||||||
|
WriteRegStr SHCTX "${UNINST_KEY}" "QuietUninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode /S"
|
||||||
|
|
||||||
|
sectionEnd
|
||||||
|
|
||||||
|
# Uninstaller
|
||||||
|
|
||||||
|
function un.onInit
|
||||||
!insertmacro MULTIUSER_UNINIT
|
!insertmacro MULTIUSER_UNINIT
|
||||||
!insertmacro MUI_UNGETLANGUAGE
|
functionEnd
|
||||||
FunctionEnd
|
|
||||||
|
section "uninstall"
|
||||||
|
|
||||||
|
# Remove Start Menu launcher
|
||||||
|
delete "$SMPROGRAMS\Janet.lnk"
|
||||||
|
|
||||||
|
# Remove files
|
||||||
|
delete "$INSTDIR\logo.ico"
|
||||||
|
delete "$INSTDIR\README.md"
|
||||||
|
delete "$INSTDIR\LICENSE"
|
||||||
|
rmdir /r "$INSTDIR\Library"
|
||||||
|
rmdir /r "$INSTDIR\bin"
|
||||||
|
rmdir /r "$INSTDIR\C"
|
||||||
|
rmdir /r "$INSTDIR\docs"
|
||||||
|
|
||||||
|
# Remove env vars
|
||||||
|
!insertmacro DelEnv JANET_PATH
|
||||||
|
!insertmacro DelEnv JANET_HEADERPATH
|
||||||
|
!insertmacro DelEnv JANET_BINPATH
|
||||||
|
|
||||||
|
# Unset PATH
|
||||||
|
${un.EnvVarUpdate} $0 "PATH" "R" "HKCU" "$INSTDIR\bin" ; Remove
|
||||||
|
${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove
|
||||||
|
|
||||||
|
# make sure windows knows about the change
|
||||||
|
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||||
|
|
||||||
|
# Always delete uninstaller as the last action
|
||||||
|
delete "$INSTDIR\uninstall.exe"
|
||||||
|
|
||||||
|
# Remove uninstaller information from the registry
|
||||||
|
DeleteRegKey SHCTX "${UNINST_KEY}"
|
||||||
|
sectionEnd
|
||||||
|
|||||||
48
janet.1
48
janet.1
@@ -3,8 +3,11 @@
|
|||||||
janet \- run the Janet language abstract machine
|
janet \- run the Janet language abstract machine
|
||||||
.SH SYNOPSIS
|
.SH SYNOPSIS
|
||||||
.B janet
|
.B janet
|
||||||
[\fB\-hvsrp\fR]
|
[\fB\-hvsrpnqk\fR]
|
||||||
[\fB\-e\fR \fIJANET SOURCE\fR]
|
[\fB\-e\fR \fISOURCE\fR]
|
||||||
|
[\fB\-l\fR \fIMODULE\fR]
|
||||||
|
[\fB\-m\fR \fIPATH\fR]
|
||||||
|
[\fB\-c\fR \fIMODULE JIMAGE\fR]
|
||||||
[\fB\-\-\fR]
|
[\fB\-\-\fR]
|
||||||
.IR script
|
.IR script
|
||||||
.IR args ...
|
.IR args ...
|
||||||
@@ -16,7 +19,7 @@ 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.
|
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
|
This client program is separate from the core runtime, so Janet could be embedded
|
||||||
into other programs. Try Janet in your browser at https://Janet-lang.org.
|
into other programs. Try Janet in your browser at https://janet-lang.org.
|
||||||
|
|
||||||
Implemented in mostly standard C99, Janet runs on Windows, Linux and macOS.
|
Implemented in mostly standard C99, Janet runs on Windows, Linux and macOS.
|
||||||
The few features that are not standard C99 (dynamic library loading, compiler
|
The few features that are not standard C99 (dynamic library loading, compiler
|
||||||
@@ -41,8 +44,13 @@ Shows the version text and exits immediately.
|
|||||||
Read raw input from stdin and forgo prompt history and other readline-like features.
|
Read raw input from stdin and forgo prompt history and other readline-like features.
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-q
|
.BR \-e\ code
|
||||||
Quiet output. Don't print a repl prompt or expression results to stdout.
|
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 \-n
|
||||||
|
Disable ANSI colors in the repl. Has no effect if no repl is run.
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-r
|
.BR \-r
|
||||||
@@ -56,19 +64,35 @@ it will immediately exit after printing the error message. In persistent mode, J
|
|||||||
after an error. Persistent mode can be good for debugging and testing.
|
after an error. Persistent mode can be good for debugging and testing.
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-e
|
.BR \-q
|
||||||
Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier
|
Quiet output. Don't print a repl prompt or expression results to stdout.
|
||||||
arguments are executed before later ones.
|
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-l
|
.BR \-k
|
||||||
|
Don't execute a script, only compile it to check for errors. Useful for linting scripts.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-m\ syspath
|
||||||
|
Set the dynamic binding :syspath to the string syspath so that Janet will load system modules
|
||||||
|
from a directory different than the default. The default is set when Janet is built, and defaults to
|
||||||
|
/usr/local/lib/janet on Linux/Posix, and C:/Janet/Library on Windows. This option supersedes JANET_PATH.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-c\ source\ output
|
||||||
|
Precompiles Janet source code into an image, a binary dump that can be efficiently loaded later.
|
||||||
|
Source should be a path to the Janet module to compile, and output should be the file path of
|
||||||
|
resulting image. Output should usually end with the .jimage extension.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-l\ path
|
||||||
Load a Janet file before running a script or repl. Multiple files can be loaded
|
Load a Janet file before running a script or repl. Multiple files can be loaded
|
||||||
in this manner, and exports from each file will be made available to the script
|
in this manner, and exports from each file will be made available to the script
|
||||||
or repl.
|
or repl.
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-\-
|
.BR \-\-
|
||||||
Stop parsing command line arguments. All arguments after this one will be considered file names.
|
Stop parsing command line arguments. All arguments after this one will be considered file names
|
||||||
|
and then arguments to the script.
|
||||||
|
|
||||||
.SH ENVIRONMENT
|
.SH ENVIRONMENT
|
||||||
|
|
||||||
@@ -76,9 +100,7 @@ Stop parsing command line arguments. All arguments after this one will be consid
|
|||||||
.RS
|
.RS
|
||||||
The location to look for Janet libraries. This is the only environment variable Janet needs to
|
The location to look for Janet libraries. This is the only environment variable Janet needs to
|
||||||
find native and source code modules. If no JANET_PATH is set, Janet will look in
|
find native and source code modules. If no JANET_PATH is set, Janet will look in
|
||||||
/usr/local/lib/Janet for modules.
|
the default location set at compile time.
|
||||||
To make Janet search multiple locations, modify the module.paths
|
|
||||||
array in Janet.
|
|
||||||
.RE
|
.RE
|
||||||
|
|
||||||
.SH AUTHOR
|
.SH AUTHOR
|
||||||
|
|||||||
1
janet_win.rc
Normal file
1
janet_win.rc
Normal file
@@ -0,0 +1 @@
|
|||||||
|
IDI_MYICON ICON "assets\icon.ico"
|
||||||
233
meson.build
Normal file
233
meson.build
Normal file
@@ -0,0 +1,233 @@
|
|||||||
|
# Copyright (c) 2019 Calvin Rose and contributors
|
||||||
|
#
|
||||||
|
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
# of this software and associated documentation files (the "Software"), to
|
||||||
|
# deal in 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.
|
||||||
|
|
||||||
|
project('janet', 'c',
|
||||||
|
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||||
|
version : '1.0.0')
|
||||||
|
|
||||||
|
# Global settings
|
||||||
|
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||||
|
header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet')
|
||||||
|
|
||||||
|
# Link math library on all systems
|
||||||
|
cc = meson.get_compiler('c')
|
||||||
|
m_dep = cc.find_library('m', required : false)
|
||||||
|
dl_dep = cc.find_library('dl', required : false)
|
||||||
|
|
||||||
|
# Link options
|
||||||
|
if build_machine.system() != 'windows'
|
||||||
|
add_project_link_arguments('-rdynamic', language : 'c')
|
||||||
|
endif
|
||||||
|
|
||||||
|
# Generate custom janetconf.h
|
||||||
|
conf = configuration_data()
|
||||||
|
version_parts = meson.project_version().split('.')
|
||||||
|
last_parts = version_parts[2].split('-')
|
||||||
|
if last_parts.length() > 1
|
||||||
|
conf.set_quoted('JANET_VERSION_EXTRA', '-' + last_parts[1])
|
||||||
|
else
|
||||||
|
conf.set_quoted('JANET_VERSION_EXTRA', '')
|
||||||
|
endif
|
||||||
|
conf.set('JANET_VERSION_MAJOR', version_parts[0].to_int())
|
||||||
|
conf.set('JANET_VERSION_MINOR', version_parts[1].to_int())
|
||||||
|
conf.set('JANET_VERSION_PATCH', last_parts[0].to_int())
|
||||||
|
conf.set_quoted('JANET_VERSION', meson.project_version())
|
||||||
|
# Use options
|
||||||
|
conf.set_quoted('JANET_BUILD', get_option('git_hash'))
|
||||||
|
conf.set('JANET_NO_NANBOX', not get_option('nanbox'))
|
||||||
|
conf.set('JANET_SINGLE_THREADED', not get_option('single_threaded'))
|
||||||
|
conf.set('JANET_NO_DYNAMIC_MODULES', not get_option('dynamic_modules'))
|
||||||
|
conf.set('JANET_NO_DOCSTRINGS', not get_option('docstrings'))
|
||||||
|
conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
|
||||||
|
conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
|
||||||
|
conf.set('JANET_NO_PEG', not get_option('peg'))
|
||||||
|
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
|
||||||
|
conf.set('JANET_NO_TYPED_ARRAY', not get_option('typed_array'))
|
||||||
|
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
|
||||||
|
conf.set('JANET_RECURSION_GUARD', get_option('recursion_guard'))
|
||||||
|
conf.set('JANET_MAX_PROTO_DEPTH', get_option('max_proto_depth'))
|
||||||
|
conf.set('JANET_MAX_MACRO_EXPAND', get_option('max_macro_expand'))
|
||||||
|
conf.set('JANET_STACK_MAX', get_option('stack_max'))
|
||||||
|
jconf = configure_file(output : 'janetconf.h',
|
||||||
|
configuration : conf)
|
||||||
|
|
||||||
|
# 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')
|
||||||
|
init_gen = gen.process('src/mainclient/init.janet', extra_args: 'janet_gen_init')
|
||||||
|
|
||||||
|
# Order is important here, as some headers
|
||||||
|
# depend on other headers for the amalg target
|
||||||
|
core_headers = [
|
||||||
|
'src/core/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'
|
||||||
|
]
|
||||||
|
|
||||||
|
core_src = [
|
||||||
|
'src/core/abstract.c',
|
||||||
|
'src/core/array.c',
|
||||||
|
'src/core/asm.c',
|
||||||
|
'src/core/buffer.c',
|
||||||
|
'src/core/bytecode.c',
|
||||||
|
'src/core/capi.c',
|
||||||
|
'src/core/cfuns.c',
|
||||||
|
'src/core/compile.c',
|
||||||
|
'src/core/corelib.c',
|
||||||
|
'src/core/debug.c',
|
||||||
|
'src/core/emit.c',
|
||||||
|
'src/core/fiber.c',
|
||||||
|
'src/core/gc.c',
|
||||||
|
'src/core/inttypes.c',
|
||||||
|
'src/core/io.c',
|
||||||
|
'src/core/marsh.c',
|
||||||
|
'src/core/math.c',
|
||||||
|
'src/core/os.c',
|
||||||
|
'src/core/parse.c',
|
||||||
|
'src/core/peg.c',
|
||||||
|
'src/core/pp.c',
|
||||||
|
'src/core/regalloc.c',
|
||||||
|
'src/core/run.c',
|
||||||
|
'src/core/specials.c',
|
||||||
|
'src/core/string.c',
|
||||||
|
'src/core/strtod.c',
|
||||||
|
'src/core/struct.c',
|
||||||
|
'src/core/symcache.c',
|
||||||
|
'src/core/table.c',
|
||||||
|
'src/core/tuple.c',
|
||||||
|
'src/core/typedarray.c',
|
||||||
|
'src/core/util.c',
|
||||||
|
'src/core/value.c',
|
||||||
|
'src/core/vector.c',
|
||||||
|
'src/core/vm.c',
|
||||||
|
'src/core/wrap.c'
|
||||||
|
]
|
||||||
|
|
||||||
|
boot_src = [
|
||||||
|
'src/boot/array_test.c',
|
||||||
|
'src/boot/boot.c',
|
||||||
|
'src/boot/buffer_test.c',
|
||||||
|
'src/boot/number_test.c',
|
||||||
|
'src/boot/system_test.c',
|
||||||
|
'src/boot/table_test.c',
|
||||||
|
]
|
||||||
|
|
||||||
|
mainclient_src = [
|
||||||
|
'src/mainclient/line.c',
|
||||||
|
'src/mainclient/main.c'
|
||||||
|
]
|
||||||
|
|
||||||
|
# Build boot binary
|
||||||
|
janet_boot = executable('janet-boot', core_src, boot_src, boot_gen,
|
||||||
|
include_directories : incdir,
|
||||||
|
c_args : '-DJANET_BOOTSTRAP',
|
||||||
|
dependencies : [m_dep, dl_dep],
|
||||||
|
native : true)
|
||||||
|
|
||||||
|
# Build core image
|
||||||
|
core_image = custom_target('core_image',
|
||||||
|
input : [janet_boot],
|
||||||
|
output : 'core_image.gen.c',
|
||||||
|
command : [janet_boot, '@OUTPUT@', 'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path])
|
||||||
|
|
||||||
|
libjanet = library('janet', core_src, core_image,
|
||||||
|
include_directories : incdir,
|
||||||
|
dependencies : [m_dep, dl_dep],
|
||||||
|
install : true)
|
||||||
|
|
||||||
|
janet_mainclient = executable('janet', core_src, core_image, init_gen, mainclient_src,
|
||||||
|
include_directories : incdir,
|
||||||
|
dependencies : [m_dep, dl_dep],
|
||||||
|
install : true)
|
||||||
|
|
||||||
|
if meson.is_cross_build()
|
||||||
|
janet_nativeclient = executable('janet-native', core_src, core_image, init_gen, mainclient_src,
|
||||||
|
include_directories : incdir,
|
||||||
|
dependencies : [m_dep, dl_dep],
|
||||||
|
native : true)
|
||||||
|
else
|
||||||
|
janet_nativeclient = janet_mainclient
|
||||||
|
endif
|
||||||
|
|
||||||
|
# Documentation
|
||||||
|
docs = custom_target('docs',
|
||||||
|
input : ['tools/gendoc.janet'],
|
||||||
|
output : ['doc.html'],
|
||||||
|
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@'])
|
||||||
|
|
||||||
|
# Amalgamated client
|
||||||
|
janet_amalgclient = executable('janet-amalg', amalg, init_gen, mainclient_src,
|
||||||
|
include_directories : incdir,
|
||||||
|
dependencies : [m_dep, dl_dep],
|
||||||
|
build_by_default : false)
|
||||||
|
|
||||||
|
# Tests
|
||||||
|
test_files = [
|
||||||
|
'test/suite0.janet',
|
||||||
|
'test/suite1.janet',
|
||||||
|
'test/suite2.janet',
|
||||||
|
'test/suite3.janet',
|
||||||
|
'test/suite4.janet',
|
||||||
|
'test/suite5.janet',
|
||||||
|
'test/suite6.janet'
|
||||||
|
]
|
||||||
|
foreach t : test_files
|
||||||
|
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
|
||||||
|
endforeach
|
||||||
|
|
||||||
|
# Repl
|
||||||
|
run_target('repl', command : [janet_nativeclient])
|
||||||
|
|
||||||
|
# For use as meson subproject (wrap)
|
||||||
|
janet_dep = declare_dependency(include_directories : incdir,
|
||||||
|
link_with : libjanet)
|
||||||
|
|
||||||
|
# Installation
|
||||||
|
install_man('janet.1')
|
||||||
|
install_headers(['src/include/janet.h', jconf], subdir: 'janet')
|
||||||
|
janet_libs = [
|
||||||
|
'auxlib/cook.janet',
|
||||||
|
'auxlib/path.janet'
|
||||||
|
]
|
||||||
|
janet_binscripts = [
|
||||||
|
'auxbin/jpm'
|
||||||
|
]
|
||||||
|
install_data(sources : janet_libs, install_dir : janet_path)
|
||||||
|
install_data(sources : janet_binscripts, install_dir : 'bin')
|
||||||
17
meson_options.txt
Normal file
17
meson_options.txt
Normal file
@@ -0,0 +1,17 @@
|
|||||||
|
option('git_hash', type : 'string', value : 'meson')
|
||||||
|
|
||||||
|
option('single_threaded', type : 'boolean', value : false)
|
||||||
|
option('nanbox', type : 'boolean', value : true)
|
||||||
|
option('dynamic_modules', type : 'boolean', value : true)
|
||||||
|
option('docstrings', type : 'boolean', value : true)
|
||||||
|
option('sourcemaps', type : 'boolean', value : true)
|
||||||
|
option('reduced_os', type : 'boolean', value : false)
|
||||||
|
option('assembler', type : 'boolean', value : true)
|
||||||
|
option('peg', type : 'boolean', value : true)
|
||||||
|
option('typed_array', type : 'boolean', value : true)
|
||||||
|
option('int_types', type : 'boolean', value : true)
|
||||||
|
|
||||||
|
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
|
||||||
|
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)
|
||||||
|
option('max_macro_expand', type : 'integer', min : 1, max : 8000, value : 200)
|
||||||
|
option('stack_max', type : 'integer', min : 8096, max : 1000000000, value : 16384)
|
||||||
@@ -20,16 +20,16 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
|
|
||||||
int main() {
|
#include "tests.h"
|
||||||
|
|
||||||
|
int array_test() {
|
||||||
|
|
||||||
int i;
|
int i;
|
||||||
JanetArray *array1, *array2;
|
JanetArray *array1, *array2;
|
||||||
|
|
||||||
janet_init();
|
|
||||||
|
|
||||||
array1 = janet_array(10);
|
array1 = janet_array(10);
|
||||||
array2 = janet_array(0);
|
array2 = janet_array(0);
|
||||||
|
|
||||||
@@ -62,7 +62,5 @@ int main() {
|
|||||||
|
|
||||||
assert(array1->count == 5);
|
assert(array1->count == 5);
|
||||||
|
|
||||||
janet_deinit();
|
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@@ -20,21 +20,56 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
|
#include "tests.h"
|
||||||
|
|
||||||
extern const unsigned char *janet_gen_boot;
|
extern const unsigned char *janet_gen_boot;
|
||||||
extern int32_t janet_gen_boot_size;
|
extern int32_t janet_gen_boot_size;
|
||||||
|
|
||||||
int main() {
|
int main(int argc, const char **argv) {
|
||||||
|
|
||||||
|
/* Init janet */
|
||||||
|
janet_init();
|
||||||
|
|
||||||
|
/* Run tests */
|
||||||
|
array_test();
|
||||||
|
buffer_test();
|
||||||
|
number_test();
|
||||||
|
system_test();
|
||||||
|
table_test();
|
||||||
|
|
||||||
|
/* C tests passed */
|
||||||
|
|
||||||
|
/* Set up VM */
|
||||||
int status;
|
int status;
|
||||||
JanetTable *env;
|
JanetTable *env;
|
||||||
|
|
||||||
/* Set up VM */
|
env = janet_core_env(NULL);
|
||||||
janet_init();
|
|
||||||
env = janet_core_env();
|
/* Create args tuple */
|
||||||
|
JanetArray *args = janet_array(argc);
|
||||||
|
for (int i = 0; i < argc; i++)
|
||||||
|
janet_array_push(args, janet_cstringv(argv[i]));
|
||||||
|
janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments.");
|
||||||
|
|
||||||
|
/* Add in options from janetconf.h so boot.janet can configure the image as needed. */
|
||||||
|
JanetTable *opts = janet_table(0);
|
||||||
|
#ifdef JANET_NO_DOCSTRINGS
|
||||||
|
janet_table_put(opts, janet_ckeywordv("no-docstrings"), janet_wrap_true());
|
||||||
|
#endif
|
||||||
|
#ifdef JANET_NO_SOURCEMAPS
|
||||||
|
janet_table_put(opts, janet_ckeywordv("no-sourcemaps"), janet_wrap_true());
|
||||||
|
#endif
|
||||||
|
janet_def(env, "process/config", janet_wrap_table(opts), "Boot options");
|
||||||
|
|
||||||
/* Run bootstrap script to generate core image */
|
/* Run bootstrap script to generate core image */
|
||||||
status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, "boot.janet", NULL);
|
const char *boot_file;
|
||||||
|
#ifdef JANET_NO_SOURCEMAPS
|
||||||
|
boot_file = NULL;
|
||||||
|
#else
|
||||||
|
boot_file = "boot.janet";
|
||||||
|
#endif
|
||||||
|
status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, boot_file, NULL);
|
||||||
|
|
||||||
/* Deinitialize vm */
|
/* Deinitialize vm */
|
||||||
janet_deinit();
|
janet_deinit();
|
||||||
|
|||||||
1917
src/boot/boot.janet
1917
src/boot/boot.janet
File diff suppressed because it is too large
Load Diff
@@ -20,16 +20,16 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
|
|
||||||
int main() {
|
#include "tests.h"
|
||||||
|
|
||||||
|
int buffer_test() {
|
||||||
|
|
||||||
int i;
|
int i;
|
||||||
JanetBuffer *buffer1, *buffer2;
|
JanetBuffer *buffer1, *buffer2;
|
||||||
|
|
||||||
janet_init();
|
|
||||||
|
|
||||||
buffer1 = janet_buffer(100);
|
buffer1 = janet_buffer(100);
|
||||||
buffer2 = janet_buffer(0);
|
buffer2 = janet_buffer(0);
|
||||||
|
|
||||||
@@ -58,7 +58,5 @@ int main() {
|
|||||||
assert(buffer1->data[i] == buffer2->data[i]);
|
assert(buffer1->data[i] == buffer2->data[i]);
|
||||||
}
|
}
|
||||||
|
|
||||||
janet_deinit();
|
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@@ -20,11 +20,13 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
|
|
||||||
|
#include "tests.h"
|
||||||
|
|
||||||
/* Check a subset of numbers against system implementation.
|
/* Check a subset of numbers against system implementation.
|
||||||
* Note that this depends on the system implementation being correct,
|
* Note that this depends on the system implementation being correct,
|
||||||
* which may not be the case for old or non compliant systems. Also,
|
* which may not be the case for old or non compliant systems. Also,
|
||||||
@@ -36,14 +38,12 @@ static void test_valid_str(const char *str) {
|
|||||||
double cnum, jnum;
|
double cnum, jnum;
|
||||||
jnum = 0.0;
|
jnum = 0.0;
|
||||||
cnum = atof(str);
|
cnum = atof(str);
|
||||||
err = janet_scan_number((const uint8_t *) str, strlen(str), &jnum);
|
err = janet_scan_number((const uint8_t *) str, (int32_t) strlen(str), &jnum);
|
||||||
assert(!err);
|
assert(!err);
|
||||||
assert(cnum == jnum);
|
assert(cnum == jnum);
|
||||||
}
|
}
|
||||||
|
|
||||||
int main() {
|
int number_test() {
|
||||||
|
|
||||||
janet_init();
|
|
||||||
|
|
||||||
test_valid_str("1.0");
|
test_valid_str("1.0");
|
||||||
test_valid_str("1");
|
test_valid_str("1");
|
||||||
@@ -63,7 +63,5 @@ int main() {
|
|||||||
test_valid_str("0000000011111111111111111111111111");
|
test_valid_str("0000000011111111111111111111111111");
|
||||||
test_valid_str(".112312333333323123123123123123123");
|
test_valid_str(".112312333333323123123123123123123");
|
||||||
|
|
||||||
janet_deinit();
|
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@@ -20,11 +20,13 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
|
|
||||||
int main() {
|
#include "tests.h"
|
||||||
|
|
||||||
|
int system_test() {
|
||||||
|
|
||||||
#ifdef JANET_32
|
#ifdef JANET_32
|
||||||
assert(sizeof(void *) == 4);
|
assert(sizeof(void *) == 4);
|
||||||
@@ -32,8 +34,6 @@ int main() {
|
|||||||
assert(sizeof(void *) == 8);
|
assert(sizeof(void *) == 8);
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
janet_init();
|
|
||||||
|
|
||||||
/* Reflexive testing and nanbox testing */
|
/* Reflexive testing and nanbox testing */
|
||||||
assert(janet_equals(janet_wrap_nil(), janet_wrap_nil()));
|
assert(janet_equals(janet_wrap_nil(), janet_wrap_nil()));
|
||||||
assert(janet_equals(janet_wrap_false(), janet_wrap_false()));
|
assert(janet_equals(janet_wrap_false(), janet_wrap_false()));
|
||||||
@@ -45,10 +45,10 @@ int main() {
|
|||||||
assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
|
assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
|
||||||
assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
|
assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
|
||||||
|
|
||||||
|
assert(NULL != &janet_wrap_nil);
|
||||||
|
|
||||||
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
|
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
|
||||||
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
|
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
|
||||||
|
|
||||||
janet_deinit();
|
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@@ -20,15 +20,15 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
|
|
||||||
int main() {
|
#include "tests.h"
|
||||||
|
|
||||||
|
int table_test() {
|
||||||
|
|
||||||
JanetTable *t1, *t2;
|
JanetTable *t1, *t2;
|
||||||
|
|
||||||
janet_init();
|
|
||||||
|
|
||||||
t1 = janet_table(10);
|
t1 = janet_table(10);
|
||||||
t2 = janet_table(0);
|
t2 = janet_table(0);
|
||||||
|
|
||||||
@@ -61,7 +61,5 @@ int main() {
|
|||||||
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
|
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
|
||||||
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
|
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
|
||||||
|
|
||||||
janet_deinit();
|
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
11
src/boot/tests.h
Normal file
11
src/boot/tests.h
Normal file
@@ -0,0 +1,11 @@
|
|||||||
|
#ifndef TESTS_H_DNMBUYYL
|
||||||
|
#define TESTS_H_DNMBUYYL
|
||||||
|
|
||||||
|
/* Tests */
|
||||||
|
extern int array_test();
|
||||||
|
extern int buffer_test();
|
||||||
|
extern int number_test();
|
||||||
|
extern int system_test();
|
||||||
|
extern int table_test();
|
||||||
|
|
||||||
|
#endif /* end of include guard: TESTS_H_DNMBUYYL */
|
||||||
60
src/conf/janetconf.h
Normal file
60
src/conf/janetconf.h
Normal file
@@ -0,0 +1,60 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 Calvin Rose
|
||||||
|
*
|
||||||
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
* of this software and associated documentation files (the "Software"), to
|
||||||
|
* deal in the Software without restriction, including without limitation the
|
||||||
|
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||||
|
* sell copies of the Software, and to permit persons to whom the Software is
|
||||||
|
* furnished to do so, subject to the following conditions:
|
||||||
|
*
|
||||||
|
* The above copyright notice and this permission notice shall be included in
|
||||||
|
* all copies or substantial portions of the Software.
|
||||||
|
*
|
||||||
|
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||||
|
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
|
* IN THE SOFTWARE.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/* This is an example janetconf.h file. This will be usually generated
|
||||||
|
* by the build system. */
|
||||||
|
|
||||||
|
#ifndef JANETCONF_H
|
||||||
|
#define JANETCONF_H
|
||||||
|
|
||||||
|
#define JANET_VERSION_MAJOR 1
|
||||||
|
#define JANET_VERSION_MINOR 0
|
||||||
|
#define JANET_VERSION_PATCH 0
|
||||||
|
#define JANET_VERSION_EXTRA ""
|
||||||
|
#define JANET_VERSION "1.0.0"
|
||||||
|
|
||||||
|
/* #define JANET_BUILD "local" */
|
||||||
|
|
||||||
|
/* These settings all affect linking, so use cautiously. */
|
||||||
|
/* #define JANET_SINGLE_THREADED */
|
||||||
|
/* #define JANET_NO_DYNAMIC_MODULES */
|
||||||
|
/* #define JANET_NO_NANBOX */
|
||||||
|
/* #define JANET_API __attribute__((visibility ("default"))) */
|
||||||
|
|
||||||
|
/* These settings should be specified before amalgamation is
|
||||||
|
* built. */
|
||||||
|
/* #define JANET_NO_DOCSTRINGS */
|
||||||
|
/* #define JANET_NO_SOURCEMAPS */
|
||||||
|
/* #define JANET_REDUCED_OS */
|
||||||
|
|
||||||
|
/* Other settings */
|
||||||
|
/* #define JANET_NO_ASSEMBLER */
|
||||||
|
/* #define JANET_NO_PEG */
|
||||||
|
/* #define JANET_NO_TYPED_ARRAY */
|
||||||
|
/* #define JANET_NO_INT_TYPES */
|
||||||
|
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
|
||||||
|
/* #define JANET_RECURSION_GUARD 1024 */
|
||||||
|
/* #define JANET_MAX_PROTO_DEPTH 200 */
|
||||||
|
/* #define JANET_MAX_MACRO_EXPAND 200 */
|
||||||
|
/* #define JANET_STACK_MAX 16384 */
|
||||||
|
|
||||||
|
#endif /* end of include guard: JANETCONF_H */
|
||||||
@@ -21,16 +21,24 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Create new userdata */
|
/* Create new userdata */
|
||||||
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
|
void *janet_abstract_begin(const JanetAbstractType *atype, size_t size) {
|
||||||
char *data = janet_gcalloc(JANET_MEMORY_ABSTRACT, sizeof(JanetAbstractHeader) + size);
|
JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_NONE,
|
||||||
JanetAbstractHeader *header = (JanetAbstractHeader *)data;
|
sizeof(JanetAbstractHead) + size);
|
||||||
void *a = data + sizeof(JanetAbstractHeader);
|
|
||||||
header->size = size;
|
header->size = size;
|
||||||
header->type = atype;
|
header->type = atype;
|
||||||
return a;
|
return (void *) & (header->data);
|
||||||
|
}
|
||||||
|
|
||||||
|
void *janet_abstract_end(void *x) {
|
||||||
|
janet_gc_settype((void *)(janet_abstract_head(x)), JANET_MEMORY_ABSTRACT);
|
||||||
|
return x;
|
||||||
|
}
|
||||||
|
|
||||||
|
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
|
||||||
|
return janet_abstract_end(janet_abstract_begin(atype, size));
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -21,15 +21,16 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
|
|
||||||
/* Initializes an array */
|
/* Creates a new array */
|
||||||
JanetArray *janet_array_init(JanetArray *array, int32_t capacity) {
|
JanetArray *janet_array(int32_t capacity) {
|
||||||
|
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||||
Janet *data = NULL;
|
Janet *data = NULL;
|
||||||
if (capacity > 0) {
|
if (capacity > 0) {
|
||||||
data = (Janet *) malloc(sizeof(Janet) * capacity);
|
data = (Janet *) malloc(sizeof(Janet) * capacity);
|
||||||
@@ -43,16 +44,6 @@ JanetArray *janet_array_init(JanetArray *array, int32_t capacity) {
|
|||||||
return array;
|
return array;
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_array_deinit(JanetArray *array) {
|
|
||||||
free(array->data);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Creates a new array */
|
|
||||||
JanetArray *janet_array(int32_t capacity) {
|
|
||||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
|
||||||
return janet_array_init(array, capacity);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Creates a new array from n elements. */
|
/* Creates a new array from n elements. */
|
||||||
JanetArray *janet_array_n(const Janet *elements, int32_t n) {
|
JanetArray *janet_array_n(const Janet *elements, int32_t n) {
|
||||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||||
@@ -165,6 +156,7 @@ static Janet cfun_array_slice(int32_t argc, Janet *argv) {
|
|||||||
JanetRange range = janet_getslice(argc, argv);
|
JanetRange range = janet_getslice(argc, argv);
|
||||||
JanetView view = janet_getindexed(argv, 0);
|
JanetView view = janet_getindexed(argv, 0);
|
||||||
JanetArray *array = janet_array(range.end - range.start);
|
JanetArray *array = janet_array(range.end - range.start);
|
||||||
|
if (array->data)
|
||||||
memcpy(array->data, view.items + range.start, sizeof(Janet) * (range.end - range.start));
|
memcpy(array->data, view.items + range.start, sizeof(Janet) * (range.end - range.start));
|
||||||
array->count = range.end - range.start;
|
array->count = range.end - range.start;
|
||||||
return janet_wrap_array(array);
|
return janet_wrap_array(array);
|
||||||
@@ -180,10 +172,9 @@ static Janet cfun_array_concat(int32_t argc, Janet *argv) {
|
|||||||
janet_array_push(array, argv[i]);
|
janet_array_push(array, argv[i]);
|
||||||
break;
|
break;
|
||||||
case JANET_ARRAY:
|
case JANET_ARRAY:
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE: {
|
||||||
{
|
int32_t j, len = 0;
|
||||||
int32_t j, len;
|
const Janet *vals = NULL;
|
||||||
const Janet *vals;
|
|
||||||
janet_indexed_view(argv[i], &vals, &len);
|
janet_indexed_view(argv[i], &vals, &len);
|
||||||
for (j = 0; j < len; j++)
|
for (j = 0; j < len; j++)
|
||||||
janet_array_push(array, vals[j]);
|
janet_array_push(array, vals[j]);
|
||||||
@@ -212,56 +203,97 @@ static Janet cfun_array_insert(int32_t argc, Janet *argv) {
|
|||||||
restsize);
|
restsize);
|
||||||
memcpy(array->data + at, argv + 2, chunksize);
|
memcpy(array->data + at, argv + 2, chunksize);
|
||||||
array->count += (argc - 2);
|
array->count += (argc - 2);
|
||||||
return janet_wrap_array(array);
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_array_remove(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 2, 3);
|
||||||
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
|
int32_t at = janet_getinteger(argv, 1);
|
||||||
|
int32_t n = 1;
|
||||||
|
if (at < 0) {
|
||||||
|
at = array->count + at + 1;
|
||||||
|
}
|
||||||
|
if (at < 0 || at > array->count)
|
||||||
|
janet_panicf("removal index %d out of range [0,%d]", at, array->count);
|
||||||
|
if (argc == 3) {
|
||||||
|
n = janet_getinteger(argv, 2);
|
||||||
|
if (n < 0)
|
||||||
|
janet_panicf("expected non-negative integer for argument n, got %v", argv[2]);
|
||||||
|
}
|
||||||
|
if (at + n > array->count) {
|
||||||
|
n = array->count - at;
|
||||||
|
}
|
||||||
|
memmove(array->data + at,
|
||||||
|
array->data + at + n,
|
||||||
|
(array->count - at - n) * sizeof(Janet));
|
||||||
|
array->count -= n;
|
||||||
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg array_cfuns[] = {
|
static const JanetReg array_cfuns[] = {
|
||||||
{"array/new", cfun_array_new,
|
{
|
||||||
|
"array/new", cfun_array_new,
|
||||||
JDOC("(array/new capacity)\n\n"
|
JDOC("(array/new capacity)\n\n"
|
||||||
"Creates a new empty array with a pre-allocated capacity. The same as "
|
"Creates a new empty array with a pre-allocated capacity. The same as "
|
||||||
"(array) but can be more efficient if the maximum size of an array is known.")
|
"(array) but can be more efficient if the maximum size of an array is known.")
|
||||||
},
|
},
|
||||||
{"array/pop", cfun_array_pop,
|
{
|
||||||
|
"array/pop", cfun_array_pop,
|
||||||
JDOC("(array/pop arr)\n\n"
|
JDOC("(array/pop arr)\n\n"
|
||||||
"Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
|
"Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
|
||||||
"the input array.")
|
"the input array.")
|
||||||
},
|
},
|
||||||
{"array/peek", cfun_array_peek,
|
{
|
||||||
|
"array/peek", cfun_array_peek,
|
||||||
JDOC("(array/peek arr)\n\n"
|
JDOC("(array/peek arr)\n\n"
|
||||||
"Returns the last element of the array. Does not modify the array.")
|
"Returns the last element of the array. Does not modify the array.")
|
||||||
},
|
},
|
||||||
{"array/push", cfun_array_push,
|
{
|
||||||
|
"array/push", cfun_array_push,
|
||||||
JDOC("(array/push arr x)\n\n"
|
JDOC("(array/push arr x)\n\n"
|
||||||
"Insert an element in the end of an array. Modifies the input array and returns it.")
|
"Insert an element in the end of an array. Modifies the input array and returns it.")
|
||||||
},
|
},
|
||||||
{"array/ensure", cfun_array_ensure,
|
{
|
||||||
|
"array/ensure", cfun_array_ensure,
|
||||||
JDOC("(array/ensure arr capacity)\n\n"
|
JDOC("(array/ensure arr capacity)\n\n"
|
||||||
"Ensures that the memory backing the array has enough memory for capacity "
|
"Ensures that the memory backing the array is large enough for capacity "
|
||||||
"items. Capacity must be an integer. If the backing capacity is already enough, "
|
"items. Capacity must be an integer. If the backing capacity is already enough, "
|
||||||
"then this function does nothing. Otherwise, the backing memory will be reallocated "
|
"then this function does nothing. Otherwise, the backing memory will be reallocated "
|
||||||
"so that there is enough space.")
|
"so that there is enough space.")
|
||||||
},
|
},
|
||||||
{"array/slice", cfun_array_slice,
|
{
|
||||||
JDOC("(array/slice arrtup [, start=0 [, end=(length arrtup)]])\n\n"
|
"array/slice", cfun_array_slice,
|
||||||
|
JDOC("(array/slice arrtup &opt start end)\n\n"
|
||||||
"Takes a slice of array or tuple from start to end. The range is half open, "
|
"Takes a slice of array or tuple from start to end. The range is half open, "
|
||||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||||
"end of the array. By default, start is 0 and end is the length of the array. "
|
"end of the array. By default, start is 0 and end is the length of the array. "
|
||||||
"Returns a new array.")
|
"Returns a new array.")
|
||||||
},
|
},
|
||||||
{"array/concat", cfun_array_concat,
|
{
|
||||||
|
"array/concat", cfun_array_concat,
|
||||||
JDOC("(array/concat arr & parts)\n\n"
|
JDOC("(array/concat arr & parts)\n\n"
|
||||||
"Concatenates a variadic number of arrays (and tuples) into the first argument "
|
"Concatenates a variadic number of arrays (and tuples) into the first argument "
|
||||||
"which must an array. If any of the parts are arrays or tuples, their elements will "
|
"which must an array. If any of the parts are arrays or tuples, their elements will "
|
||||||
"be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
|
"be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
|
||||||
"Return the modified array arr.")
|
"Return the modified array arr.")
|
||||||
},
|
},
|
||||||
{"array/insert", cfun_array_insert,
|
{
|
||||||
|
"array/insert", cfun_array_insert,
|
||||||
JDOC("(array/insert arr at & xs)\n\n"
|
JDOC("(array/insert arr at & xs)\n\n"
|
||||||
"Insert all of xs into array arr at index at. at should be an integer "
|
"Insert all of xs into array arr at index at. at should be an integer "
|
||||||
"0 and the length of the array. A negative value for at will index from "
|
"0 and the length of the array. A negative value for at will index from "
|
||||||
"the end of the array, such that inserting at -1 appends to the array. "
|
"the end of the array, such that inserting at -1 appends to the array. "
|
||||||
"Returns the array.")
|
"Returns the array.")
|
||||||
},
|
},
|
||||||
|
{
|
||||||
|
"array/remove", cfun_array_remove,
|
||||||
|
JDOC("(array/remove arr at &opt n)\n\n"
|
||||||
|
"Remove up to n elements starting at index at in array arr. at can index from "
|
||||||
|
"the end of the array with a negative index, and n must be a non-negative integer. "
|
||||||
|
"By default, n is 1. "
|
||||||
|
"Returns the array.")
|
||||||
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|||||||
@@ -21,7 +21,7 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
@@ -101,6 +101,7 @@ static const JanetInstructionDef janet_ops[] = {
|
|||||||
{"ltim", JOP_LESS_THAN_IMMEDIATE},
|
{"ltim", JOP_LESS_THAN_IMMEDIATE},
|
||||||
{"ltn", JOP_NUMERIC_LESS_THAN},
|
{"ltn", JOP_NUMERIC_LESS_THAN},
|
||||||
{"mkarr", JOP_MAKE_ARRAY},
|
{"mkarr", JOP_MAKE_ARRAY},
|
||||||
|
{"mkbtp", JOP_MAKE_BRACKET_TUPLE},
|
||||||
{"mkbuf", JOP_MAKE_BUFFER},
|
{"mkbuf", JOP_MAKE_BUFFER},
|
||||||
{"mkstr", JOP_MAKE_STRING},
|
{"mkstr", JOP_MAKE_STRING},
|
||||||
{"mkstu", JOP_MAKE_STRUCT},
|
{"mkstu", JOP_MAKE_STRUCT},
|
||||||
@@ -111,6 +112,7 @@ static const JanetInstructionDef janet_ops[] = {
|
|||||||
{"mul", JOP_MULTIPLY},
|
{"mul", JOP_MULTIPLY},
|
||||||
{"mulim", JOP_MULTIPLY_IMMEDIATE},
|
{"mulim", JOP_MULTIPLY_IMMEDIATE},
|
||||||
{"noop", JOP_NOOP},
|
{"noop", JOP_NOOP},
|
||||||
|
{"prop", JOP_PROPAGATE},
|
||||||
{"push", JOP_PUSH},
|
{"push", JOP_PUSH},
|
||||||
{"push2", JOP_PUSH_2},
|
{"push2", JOP_PUSH_2},
|
||||||
{"push3", JOP_PUSH_3},
|
{"push3", JOP_PUSH_3},
|
||||||
@@ -147,19 +149,18 @@ static const TypeAlias type_aliases[] = {
|
|||||||
{"callable", JANET_TFLAG_CALLABLE},
|
{"callable", JANET_TFLAG_CALLABLE},
|
||||||
{"cfunction", JANET_TFLAG_CFUNCTION},
|
{"cfunction", JANET_TFLAG_CFUNCTION},
|
||||||
{"dictionary", JANET_TFLAG_DICTIONARY},
|
{"dictionary", JANET_TFLAG_DICTIONARY},
|
||||||
{"false", JANET_TFLAG_FALSE},
|
|
||||||
{"fiber", JANET_TFLAG_FIBER},
|
{"fiber", JANET_TFLAG_FIBER},
|
||||||
{"function", JANET_TFLAG_FUNCTION},
|
{"function", JANET_TFLAG_FUNCTION},
|
||||||
{"indexed", JANET_TFLAG_INDEXED},
|
{"indexed", JANET_TFLAG_INDEXED},
|
||||||
|
{"keyword", JANET_TFLAG_KEYWORD},
|
||||||
{"nil", JANET_TFLAG_NIL},
|
{"nil", JANET_TFLAG_NIL},
|
||||||
{"number", JANET_TFLAG_NUMBER},
|
{"number", JANET_TFLAG_NUMBER},
|
||||||
|
{"pointer", JANET_TFLAG_POINTER},
|
||||||
{"string", JANET_TFLAG_STRING},
|
{"string", JANET_TFLAG_STRING},
|
||||||
{"struct", JANET_TFLAG_STRUCT},
|
{"struct", JANET_TFLAG_STRUCT},
|
||||||
{"symbol", JANET_TFLAG_SYMBOL},
|
{"symbol", JANET_TFLAG_SYMBOL},
|
||||||
{"keyword", JANET_TFLAG_KEYWORD},
|
{"table", JANET_TFLAG_TABLE},
|
||||||
{"table", JANET_TFLAG_BOOLEAN},
|
{"tuple", JANET_TFLAG_TUPLE}
|
||||||
{"true", JANET_TFLAG_TRUE},
|
|
||||||
{"tuple", JANET_TFLAG_BOOLEAN}
|
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Deinitialize an Assembler. Does not deinitialize the parents. */
|
/* Deinitialize an Assembler. Does not deinitialize the parents. */
|
||||||
@@ -253,8 +254,7 @@ static int32_t doarg_1(
|
|||||||
default:
|
default:
|
||||||
goto error;
|
goto error;
|
||||||
break;
|
break;
|
||||||
case JANET_NUMBER:
|
case JANET_NUMBER: {
|
||||||
{
|
|
||||||
double y = janet_unwrap_number(x);
|
double y = janet_unwrap_number(x);
|
||||||
if (janet_checkintrange(y)) {
|
if (janet_checkintrange(y)) {
|
||||||
ret = (int32_t) y;
|
ret = (int32_t) y;
|
||||||
@@ -263,8 +263,7 @@ static int32_t doarg_1(
|
|||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE: {
|
||||||
{
|
|
||||||
const Janet *t = janet_unwrap_tuple(x);
|
const Janet *t = janet_unwrap_tuple(x);
|
||||||
if (argtype == JANET_OAT_TYPE) {
|
if (argtype == JANET_OAT_TYPE) {
|
||||||
int32_t i = 0;
|
int32_t i = 0;
|
||||||
@@ -277,8 +276,7 @@ static int32_t doarg_1(
|
|||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_KEYWORD:
|
case JANET_KEYWORD: {
|
||||||
{
|
|
||||||
if (NULL != c && argtype == JANET_OAT_LABEL) {
|
if (NULL != c && argtype == JANET_OAT_LABEL) {
|
||||||
Janet result = janet_table_get(c, x);
|
Janet result = janet_table_get(c, x);
|
||||||
if (janet_checktype(result, JANET_NUMBER)) {
|
if (janet_checktype(result, JANET_NUMBER)) {
|
||||||
@@ -302,8 +300,7 @@ static int32_t doarg_1(
|
|||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL: {
|
||||||
{
|
|
||||||
if (NULL != c) {
|
if (NULL != c) {
|
||||||
Janet result = janet_table_get(c, x);
|
Janet result = janet_table_get(c, x);
|
||||||
if (janet_checktype(result, JANET_NUMBER)) {
|
if (janet_checktype(result, JANET_NUMBER)) {
|
||||||
@@ -364,44 +361,38 @@ static uint32_t read_instruction(
|
|||||||
uint32_t instr = idef->opcode;
|
uint32_t instr = idef->opcode;
|
||||||
enum JanetInstructionType type = janet_instructions[idef->opcode];
|
enum JanetInstructionType type = janet_instructions[idef->opcode];
|
||||||
switch (type) {
|
switch (type) {
|
||||||
case JINT_0:
|
case JINT_0: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 1)
|
if (janet_tuple_length(argt) != 1)
|
||||||
janet_asm_error(a, "expected 0 arguments: (op)");
|
janet_asm_error(a, "expected 0 arguments: (op)");
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_S:
|
case JINT_S: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 2)
|
if (janet_tuple_length(argt) != 2)
|
||||||
janet_asm_error(a, "expected 1 argument: (op, slot)");
|
janet_asm_error(a, "expected 1 argument: (op, slot)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 2, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 2, 0, argt[1]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_L:
|
case JINT_L: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 2)
|
if (janet_tuple_length(argt) != 2)
|
||||||
janet_asm_error(a, "expected 1 argument: (op, label)");
|
janet_asm_error(a, "expected 1 argument: (op, label)");
|
||||||
instr |= doarg(a, JANET_OAT_LABEL, 1, 3, 1, argt[1]);
|
instr |= doarg(a, JANET_OAT_LABEL, 1, 3, 1, argt[1]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SS:
|
case JINT_SS: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, slot)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, slot)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 2, 2, 0, argt[2]);
|
instr |= doarg(a, JANET_OAT_SLOT, 2, 2, 0, argt[2]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SL:
|
case JINT_SL: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, label)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, label)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
instr |= doarg(a, JANET_OAT_LABEL, 2, 2, 1, argt[2]);
|
instr |= doarg(a, JANET_OAT_LABEL, 2, 2, 1, argt[2]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_ST:
|
case JINT_ST: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, type)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, type)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
@@ -409,24 +400,21 @@ static uint32_t read_instruction(
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SI:
|
case JINT_SI:
|
||||||
case JINT_SU:
|
case JINT_SU: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, integer)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, integer)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
instr |= doarg(a, JANET_OAT_INTEGER, 2, 2, type == JINT_SI, argt[2]);
|
instr |= doarg(a, JANET_OAT_INTEGER, 2, 2, type == JINT_SI, argt[2]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SD:
|
case JINT_SD: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, funcdef)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, funcdef)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
instr |= doarg(a, JANET_OAT_FUNCDEF, 2, 2, 0, argt[2]);
|
instr |= doarg(a, JANET_OAT_FUNCDEF, 2, 2, 0, argt[2]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SSS:
|
case JINT_SSS: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 4)
|
if (janet_tuple_length(argt) != 4)
|
||||||
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, slot)");
|
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, slot)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
@@ -435,8 +423,7 @@ static uint32_t read_instruction(
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SSI:
|
case JINT_SSI:
|
||||||
case JINT_SSU:
|
case JINT_SSU: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 4)
|
if (janet_tuple_length(argt) != 4)
|
||||||
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, integer)");
|
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, integer)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
@@ -444,8 +431,7 @@ static uint32_t read_instruction(
|
|||||||
instr |= doarg(a, JANET_OAT_INTEGER, 3, 1, type == JINT_SSI, argt[3]);
|
instr |= doarg(a, JANET_OAT_INTEGER, 3, 1, type == JINT_SSI, argt[3]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SES:
|
case JINT_SES: {
|
||||||
{
|
|
||||||
JanetAssembler *b = a;
|
JanetAssembler *b = a;
|
||||||
uint32_t env;
|
uint32_t env;
|
||||||
if (janet_tuple_length(argt) != 4)
|
if (janet_tuple_length(argt) != 4)
|
||||||
@@ -461,8 +447,7 @@ static uint32_t read_instruction(
|
|||||||
instr |= doarg(b, JANET_OAT_SLOT, 3, 1, 0, argt[3]);
|
instr |= doarg(b, JANET_OAT_SLOT, 3, 1, 0, argt[3]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SC:
|
case JINT_SC: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, constant)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, constant)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
@@ -541,15 +526,20 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
/* Set function arity */
|
/* Set function arity */
|
||||||
x = janet_get1(s, janet_csymbolv("arity"));
|
x = janet_get1(s, janet_csymbolv("arity"));
|
||||||
def->arity = janet_checkint(x) ? janet_unwrap_integer(x) : 0;
|
def->arity = janet_checkint(x) ? janet_unwrap_integer(x) : 0;
|
||||||
|
janet_asm_assert(&a, def->arity >= 0, "arity must be non-negative");
|
||||||
|
|
||||||
|
x = janet_get1(s, janet_csymbolv("max-arity"));
|
||||||
|
def->max_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
|
||||||
|
janet_asm_assert(&a, def->max_arity >= def->arity, "max-arity must be greater than or equal to arity");
|
||||||
|
|
||||||
|
x = janet_get1(s, janet_csymbolv("min-arity"));
|
||||||
|
def->min_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
|
||||||
|
janet_asm_assert(&a, def->min_arity <= def->arity, "min-arity must be less than or equal to arity");
|
||||||
|
|
||||||
/* Check vararg */
|
/* Check vararg */
|
||||||
x = janet_get1(s, janet_csymbolv("vararg"));
|
x = janet_get1(s, janet_csymbolv("vararg"));
|
||||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||||
|
|
||||||
/* Check strict arity */
|
|
||||||
x = janet_get1(s, janet_csymbolv("fix-arity"));
|
|
||||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
|
|
||||||
|
|
||||||
/* Check source */
|
/* Check source */
|
||||||
x = janet_get1(s, janet_csymbolv("source"));
|
x = janet_get1(s, janet_csymbolv("source"));
|
||||||
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
||||||
@@ -658,7 +648,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
}
|
}
|
||||||
/* Allocate bytecode array */
|
/* Allocate bytecode array */
|
||||||
def->bytecode_length = blength;
|
def->bytecode_length = blength;
|
||||||
def->bytecode = malloc(sizeof(int32_t) * blength);
|
def->bytecode = malloc(sizeof(uint32_t) * blength);
|
||||||
if (NULL == def->bytecode) {
|
if (NULL == def->bytecode) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
@@ -838,6 +828,8 @@ Janet janet_disasm(JanetFuncDef *def) {
|
|||||||
JanetArray *constants;
|
JanetArray *constants;
|
||||||
JanetTable *ret = janet_table(10);
|
JanetTable *ret = janet_table(10);
|
||||||
janet_table_put(ret, janet_csymbolv("arity"), janet_wrap_integer(def->arity));
|
janet_table_put(ret, janet_csymbolv("arity"), janet_wrap_integer(def->arity));
|
||||||
|
janet_table_put(ret, janet_csymbolv("min-arity"), janet_wrap_integer(def->min_arity));
|
||||||
|
janet_table_put(ret, janet_csymbolv("max-arity"), janet_wrap_integer(def->max_arity));
|
||||||
janet_table_put(ret, janet_csymbolv("bytecode"), janet_wrap_array(bcode));
|
janet_table_put(ret, janet_csymbolv("bytecode"), janet_wrap_array(bcode));
|
||||||
if (NULL != def->source) {
|
if (NULL != def->source) {
|
||||||
janet_table_put(ret, janet_csymbolv("source"), janet_wrap_string(def->source));
|
janet_table_put(ret, janet_csymbolv("source"), janet_wrap_string(def->source));
|
||||||
@@ -845,9 +837,6 @@ Janet janet_disasm(JanetFuncDef *def) {
|
|||||||
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||||
janet_table_put(ret, janet_csymbolv("vararg"), janet_wrap_true());
|
janet_table_put(ret, janet_csymbolv("vararg"), janet_wrap_true());
|
||||||
}
|
}
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
|
||||||
janet_table_put(ret, janet_csymbolv("fix-arity"), janet_wrap_true());
|
|
||||||
}
|
|
||||||
if (NULL != def->name) {
|
if (NULL != def->name) {
|
||||||
janet_table_put(ret, janet_csymbolv("name"), janet_wrap_string(def->name));
|
janet_table_put(ret, janet_csymbolv("name"), janet_wrap_string(def->name));
|
||||||
}
|
}
|
||||||
@@ -934,13 +923,15 @@ static Janet cfun_disasm(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg asm_cfuns[] = {
|
static const JanetReg asm_cfuns[] = {
|
||||||
{"asm", cfun_asm,
|
{
|
||||||
|
"asm", cfun_asm,
|
||||||
JDOC("(asm assembly)\n\n"
|
JDOC("(asm assembly)\n\n"
|
||||||
"Returns a new function that is the compiled result of the assembly.\n"
|
"Returns a new function that is the compiled result of the assembly.\n"
|
||||||
"The syntax for the assembly can be found on the janet wiki. Will throw an\n"
|
"The syntax for the assembly can be found on the janet wiki. Will throw an\n"
|
||||||
"error on invalid assembly.")
|
"error on invalid assembly.")
|
||||||
},
|
},
|
||||||
{"disasm", cfun_disasm,
|
{
|
||||||
|
"disasm", cfun_disasm,
|
||||||
JDOC("(disasm func)\n\n"
|
JDOC("(disasm func)\n\n"
|
||||||
"Returns assembly that could be used be compile the given function.\n"
|
"Returns assembly that could be used be compile the given function.\n"
|
||||||
"func must be a function, not a c function. Will throw on error on a badly\n"
|
"func must be a function, not a c function. Will throw on error on a badly\n"
|
||||||
|
|||||||
@@ -21,7 +21,7 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
@@ -172,6 +172,7 @@ static Janet cfun_buffer_new_filled(int32_t argc, Janet *argv) {
|
|||||||
byte = janet_getinteger(argv, 1) & 0xFF;
|
byte = janet_getinteger(argv, 1) & 0xFF;
|
||||||
}
|
}
|
||||||
JanetBuffer *buffer = janet_buffer(count);
|
JanetBuffer *buffer = janet_buffer(count);
|
||||||
|
if (buffer->data)
|
||||||
memset(buffer->data, byte, count);
|
memset(buffer->data, byte, count);
|
||||||
buffer->count = count;
|
buffer->count = count;
|
||||||
return janet_wrap_buffer(buffer);
|
return janet_wrap_buffer(buffer);
|
||||||
@@ -207,6 +208,10 @@ static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
|
|||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
for (i = 1; i < argc; i++) {
|
for (i = 1; i < argc; i++) {
|
||||||
JanetByteView view = janet_getbytes(argv, i);
|
JanetByteView view = janet_getbytes(argv, i);
|
||||||
|
if (view.bytes == buffer->data) {
|
||||||
|
janet_buffer_ensure(buffer, buffer->count + view.len, 2);
|
||||||
|
view.bytes = buffer->data;
|
||||||
|
}
|
||||||
janet_buffer_push_bytes(buffer, view.bytes, view.len);
|
janet_buffer_push_bytes(buffer, view.bytes, view.len);
|
||||||
}
|
}
|
||||||
return argv[0];
|
return argv[0];
|
||||||
@@ -236,6 +241,7 @@ static Janet cfun_buffer_slice(int32_t argc, Janet *argv) {
|
|||||||
JanetRange range = janet_getslice(argc, argv);
|
JanetRange range = janet_getslice(argc, argv);
|
||||||
JanetByteView view = janet_getbytes(argv, 0);
|
JanetByteView view = janet_getbytes(argv, 0);
|
||||||
JanetBuffer *buffer = janet_buffer(range.end - range.start);
|
JanetBuffer *buffer = janet_buffer(range.end - range.start);
|
||||||
|
if (buffer->data)
|
||||||
memcpy(buffer->data, view.bytes + range.start, range.end - range.start);
|
memcpy(buffer->data, view.bytes + range.start, range.end - range.start);
|
||||||
buffer->count = range.end - range.start;
|
buffer->count = range.end - range.start;
|
||||||
return janet_wrap_buffer(buffer);
|
return janet_wrap_buffer(buffer);
|
||||||
@@ -294,6 +300,7 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
|
|||||||
janet_arity(argc, 2, 5);
|
janet_arity(argc, 2, 5);
|
||||||
JanetBuffer *dest = janet_getbuffer(argv, 0);
|
JanetBuffer *dest = janet_getbuffer(argv, 0);
|
||||||
JanetByteView src = janet_getbytes(argv, 1);
|
JanetByteView src = janet_getbytes(argv, 1);
|
||||||
|
int same_buf = src.bytes == dest->data;
|
||||||
int32_t offset_dest = 0;
|
int32_t offset_dest = 0;
|
||||||
int32_t offset_src = 0;
|
int32_t offset_src = 0;
|
||||||
if (argc > 2)
|
if (argc > 2)
|
||||||
@@ -313,7 +320,12 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
|
|||||||
janet_panic("buffer blit out of range");
|
janet_panic("buffer blit out of range");
|
||||||
janet_buffer_ensure(dest, (int32_t) last, 2);
|
janet_buffer_ensure(dest, (int32_t) last, 2);
|
||||||
if (last > dest->count) dest->count = (int32_t) last;
|
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);
|
memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||||
|
}
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -326,72 +338,86 @@ static Janet cfun_buffer_format(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg buffer_cfuns[] = {
|
static const JanetReg buffer_cfuns[] = {
|
||||||
{"buffer/new", cfun_buffer_new,
|
{
|
||||||
|
"buffer/new", cfun_buffer_new,
|
||||||
JDOC("(buffer/new capacity)\n\n"
|
JDOC("(buffer/new capacity)\n\n"
|
||||||
"Creates a new, empty buffer with enough memory for capacity bytes. "
|
"Creates a new, empty buffer with enough memory for capacity bytes. "
|
||||||
"Returns a new buffer.")
|
"Returns a new buffer.")
|
||||||
},
|
},
|
||||||
{"buffer/new-filled", cfun_buffer_new_filled,
|
{
|
||||||
JDOC("(buffer/new-filled count [, byte=0])\n\n"
|
"buffer/new-filled", cfun_buffer_new_filled,
|
||||||
"Creates a new buffer of length count filled with byte. "
|
JDOC("(buffer/new-filled count &opt byte)\n\n"
|
||||||
|
"Creates a new buffer of length count filled with byte. By default, byte is 0. "
|
||||||
"Returns the new buffer.")
|
"Returns the new buffer.")
|
||||||
},
|
},
|
||||||
{"buffer/push-byte", cfun_buffer_u8,
|
{
|
||||||
|
"buffer/push-byte", cfun_buffer_u8,
|
||||||
JDOC("(buffer/push-byte buffer x)\n\n"
|
JDOC("(buffer/push-byte buffer x)\n\n"
|
||||||
"Append a byte to a buffer. Will expand the buffer as necessary. "
|
"Append a byte to a buffer. Will expand the buffer as necessary. "
|
||||||
"Returns the modified buffer. Will throw an error if the buffer overflows.")
|
"Returns the modified buffer. Will throw an error if the buffer overflows.")
|
||||||
},
|
},
|
||||||
{"buffer/push-word", cfun_buffer_word,
|
{
|
||||||
|
"buffer/push-word", cfun_buffer_word,
|
||||||
JDOC("(buffer/push-word buffer x)\n\n"
|
JDOC("(buffer/push-word buffer x)\n\n"
|
||||||
"Append a machine word to a buffer. The 4 bytes of the integer are appended "
|
"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, big endian order, unsigned. Returns the modified buffer. Will "
|
||||||
"throw an error if the buffer overflows.")
|
"throw an error if the buffer overflows.")
|
||||||
},
|
},
|
||||||
{"buffer/push-string", cfun_buffer_chars,
|
{
|
||||||
|
"buffer/push-string", cfun_buffer_chars,
|
||||||
JDOC("(buffer/push-string buffer str)\n\n"
|
JDOC("(buffer/push-string buffer str)\n\n"
|
||||||
"Push a string onto the end of a buffer. Non string values will be converted "
|
"Push a string onto the end of a buffer. Non string values will be converted "
|
||||||
"to strings before being pushed. Returns the modified buffer. "
|
"to strings before being pushed. Returns the modified buffer. "
|
||||||
"Will throw an error if the buffer overflows.")
|
"Will throw an error if the buffer overflows.")
|
||||||
},
|
},
|
||||||
{"buffer/popn", cfun_buffer_popn,
|
{
|
||||||
|
"buffer/popn", cfun_buffer_popn,
|
||||||
JDOC("(buffer/popn buffer n)\n\n"
|
JDOC("(buffer/popn buffer n)\n\n"
|
||||||
"Removes the last n bytes from the buffer. Returns the modified buffer.")
|
"Removes the last n bytes from the buffer. Returns the modified buffer.")
|
||||||
},
|
},
|
||||||
{"buffer/clear", cfun_buffer_clear,
|
{
|
||||||
|
"buffer/clear", cfun_buffer_clear,
|
||||||
JDOC("(buffer/clear buffer)\n\n"
|
JDOC("(buffer/clear buffer)\n\n"
|
||||||
"Sets the size of a buffer to 0 and empties it. The buffer retains "
|
"Sets the size of a buffer to 0 and empties it. The buffer retains "
|
||||||
"its memory so it can be efficiently refilled. Returns the modified buffer.")
|
"its memory so it can be efficiently refilled. Returns the modified buffer.")
|
||||||
},
|
},
|
||||||
{"buffer/slice", cfun_buffer_slice,
|
{
|
||||||
JDOC("(buffer/slice bytes [, start=0 [, end=(length bytes)]])\n\n"
|
"buffer/slice", cfun_buffer_slice,
|
||||||
|
JDOC("(buffer/slice bytes &opt start end)\n\n"
|
||||||
"Takes a slice of a byte sequence from start to end. The range is half open, "
|
"Takes a slice of a byte sequence from start to end. The range is half open, "
|
||||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||||
"end of the array. By default, start is 0 and end is the length of the buffer. "
|
"end of the array. By default, start is 0 and end is the length of the buffer. "
|
||||||
"Returns a new buffer.")
|
"Returns a new buffer.")
|
||||||
},
|
},
|
||||||
{"buffer/bit-set", cfun_buffer_bitset,
|
{
|
||||||
|
"buffer/bit-set", cfun_buffer_bitset,
|
||||||
JDOC("(buffer/bit-set buffer index)\n\n"
|
JDOC("(buffer/bit-set buffer index)\n\n"
|
||||||
"Sets the bit at the given bit-index. Returns the buffer.")
|
"Sets the bit at the given bit-index. Returns the buffer.")
|
||||||
},
|
},
|
||||||
{"buffer/bit-clear", cfun_buffer_bitclear,
|
{
|
||||||
|
"buffer/bit-clear", cfun_buffer_bitclear,
|
||||||
JDOC("(buffer/bit-clear buffer index)\n\n"
|
JDOC("(buffer/bit-clear buffer index)\n\n"
|
||||||
"Clears the bit at the given bit-index. Returns the buffer.")
|
"Clears the bit at the given bit-index. Returns the buffer.")
|
||||||
},
|
},
|
||||||
{"buffer/bit", cfun_buffer_bitget,
|
{
|
||||||
|
"buffer/bit", cfun_buffer_bitget,
|
||||||
JDOC("(buffer/bit buffer index)\n\n"
|
JDOC("(buffer/bit buffer index)\n\n"
|
||||||
"Gets the bit at the given bit-index. Returns true if the bit is set, false if not.")
|
"Gets the bit at the given bit-index. Returns true if the bit is set, false if not.")
|
||||||
},
|
},
|
||||||
{"buffer/bit-toggle", cfun_buffer_bittoggle,
|
{
|
||||||
|
"buffer/bit-toggle", cfun_buffer_bittoggle,
|
||||||
JDOC("(buffer/bit-toggle buffer index)\n\n"
|
JDOC("(buffer/bit-toggle buffer index)\n\n"
|
||||||
"Toggles the bit at the given bit index in buffer. Returns the buffer.")
|
"Toggles the bit at the given bit index in buffer. Returns the buffer.")
|
||||||
},
|
},
|
||||||
{"buffer/blit", cfun_buffer_blit,
|
{
|
||||||
JDOC("(buffer/blit dest src [, dest-start=0 [, src-start=0 [, src-end=-1]]])\n\n"
|
"buffer/blit", cfun_buffer_blit,
|
||||||
|
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 "
|
"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 "
|
"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.")
|
"negative to index from the end of src or dest. Returns dest.")
|
||||||
},
|
},
|
||||||
{"buffer/format", cfun_buffer_format,
|
{
|
||||||
|
"buffer/format", cfun_buffer_format,
|
||||||
JDOC("(buffer/format buffer format & args)\n\n"
|
JDOC("(buffer/format buffer format & args)\n\n"
|
||||||
"Snprintf like functionality for printing values into a buffer. Returns "
|
"Snprintf like functionality for printing values into a buffer. Returns "
|
||||||
" the modified buffer.")
|
" the modified buffer.")
|
||||||
|
|||||||
@@ -21,8 +21,9 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Look up table for instructions */
|
/* Look up table for instructions */
|
||||||
@@ -78,6 +79,7 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
|||||||
JINT_S, /* JOP_TAILCALL, */
|
JINT_S, /* JOP_TAILCALL, */
|
||||||
JINT_SSS, /* JOP_RESUME, */
|
JINT_SSS, /* JOP_RESUME, */
|
||||||
JINT_SSU, /* JOP_SIGNAL, */
|
JINT_SSU, /* JOP_SIGNAL, */
|
||||||
|
JINT_SSS, /* JOP_PROPAGATE */
|
||||||
JINT_SSS, /* JOP_GET, */
|
JINT_SSS, /* JOP_GET, */
|
||||||
JINT_SSS, /* JOP_PUT, */
|
JINT_SSS, /* JOP_PUT, */
|
||||||
JINT_SSU, /* JOP_GET_INDEX, */
|
JINT_SSU, /* JOP_GET_INDEX, */
|
||||||
@@ -85,10 +87,11 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
|||||||
JINT_SS, /* JOP_LENGTH */
|
JINT_SS, /* JOP_LENGTH */
|
||||||
JINT_S, /* JOP_MAKE_ARRAY */
|
JINT_S, /* JOP_MAKE_ARRAY */
|
||||||
JINT_S, /* JOP_MAKE_BUFFER */
|
JINT_S, /* JOP_MAKE_BUFFER */
|
||||||
JINT_S, /* JOP_MAKE_TUPLE */
|
JINT_S, /* JOP_MAKE_STRING */
|
||||||
JINT_S, /* JOP_MAKE_STRUCT */
|
JINT_S, /* JOP_MAKE_STRUCT */
|
||||||
JINT_S, /* JOP_MAKE_TABLE */
|
JINT_S, /* JOP_MAKE_TABLE */
|
||||||
JINT_S, /* JOP_MAKE_STRING */
|
JINT_S, /* JOP_MAKE_TUPLE */
|
||||||
|
JINT_S, /* JOP_MAKE_BRACKET_TUPLE */
|
||||||
JINT_SSS, /* JOP_NUMERIC_LESS_THAN */
|
JINT_SSS, /* JOP_NUMERIC_LESS_THAN */
|
||||||
JINT_SSS, /* JOP_NUMERIC_LESS_THAN_EQUAL */
|
JINT_SSS, /* JOP_NUMERIC_LESS_THAN_EQUAL */
|
||||||
JINT_SSS, /* JOP_NUMERIC_GREATER_THAN */
|
JINT_SSS, /* JOP_NUMERIC_GREATER_THAN */
|
||||||
@@ -118,65 +121,55 @@ int32_t janet_verify(JanetFuncDef *def) {
|
|||||||
switch (type) {
|
switch (type) {
|
||||||
case JINT_0:
|
case JINT_0:
|
||||||
continue;
|
continue;
|
||||||
case JINT_S:
|
case JINT_S: {
|
||||||
{
|
|
||||||
if ((int32_t)(instr >> 8) >= sc) return 4;
|
if ((int32_t)(instr >> 8) >= sc) return 4;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SI:
|
case JINT_SI:
|
||||||
case JINT_SU:
|
case JINT_SU:
|
||||||
case JINT_ST:
|
case JINT_ST: {
|
||||||
{
|
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_L:
|
case JINT_L: {
|
||||||
{
|
|
||||||
int32_t jumpdest = i + (((int32_t)instr) >> 8);
|
int32_t jumpdest = i + (((int32_t)instr) >> 8);
|
||||||
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
|
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SS:
|
case JINT_SS: {
|
||||||
{
|
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
|
||||||
(int32_t)(instr >> 16) >= sc) return 4;
|
(int32_t)(instr >> 16) >= sc) return 4;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SSI:
|
case JINT_SSI:
|
||||||
case JINT_SSU:
|
case JINT_SSU: {
|
||||||
{
|
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
|
||||||
(int32_t)((instr >> 16) & 0xFF) >= sc) return 4;
|
(int32_t)((instr >> 16) & 0xFF) >= sc) return 4;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SL:
|
case JINT_SL: {
|
||||||
{
|
|
||||||
int32_t jumpdest = i + (((int32_t)instr) >> 16);
|
int32_t jumpdest = i + (((int32_t)instr) >> 16);
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
||||||
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
|
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SSS:
|
case JINT_SSS: {
|
||||||
{
|
|
||||||
if (((int32_t)(instr >> 8) & 0xFF) >= sc ||
|
if (((int32_t)(instr >> 8) & 0xFF) >= sc ||
|
||||||
((int32_t)(instr >> 16) & 0xFF) >= sc ||
|
((int32_t)(instr >> 16) & 0xFF) >= sc ||
|
||||||
((int32_t)(instr >> 24) & 0xFF) >= sc) return 4;
|
((int32_t)(instr >> 24) & 0xFF) >= sc) return 4;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SD:
|
case JINT_SD: {
|
||||||
{
|
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
||||||
if ((int32_t)(instr >> 16) >= def->defs_length) return 6;
|
if ((int32_t)(instr >> 16) >= def->defs_length) return 6;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SC:
|
case JINT_SC: {
|
||||||
{
|
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
||||||
if ((int32_t)(instr >> 16) >= def->constants_length) return 7;
|
if ((int32_t)(instr >> 16) >= def->constants_length) return 7;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SES:
|
case JINT_SES: {
|
||||||
{
|
|
||||||
/* How can we check the last slot index? We need info parent funcdefs. Resort
|
/* How can we check the last slot index? We need info parent funcdefs. Resort
|
||||||
* to runtime checks for now. Maybe invalid upvalue references could be defaulted
|
* to runtime checks for now. Maybe invalid upvalue references could be defaulted
|
||||||
* to nil? (don't commit to this in the long term, though) */
|
* to nil? (don't commit to this in the long term, though) */
|
||||||
@@ -218,6 +211,8 @@ JanetFuncDef *janet_funcdef_alloc() {
|
|||||||
def->flags = 0;
|
def->flags = 0;
|
||||||
def->slotcount = 0;
|
def->slotcount = 0;
|
||||||
def->arity = 0;
|
def->arity = 0;
|
||||||
|
def->min_arity = 0;
|
||||||
|
def->max_arity = INT32_MAX;
|
||||||
def->source = NULL;
|
def->source = NULL;
|
||||||
def->sourcemap = NULL;
|
def->sourcemap = NULL;
|
||||||
def->name = NULL;
|
def->name = NULL;
|
||||||
|
|||||||
110
src/core/capi.c
110
src/core/capi.c
@@ -21,7 +21,7 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "fiber.h"
|
#include "fiber.h"
|
||||||
#endif
|
#endif
|
||||||
@@ -36,6 +36,34 @@ void janet_panicv(Janet message) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void janet_panicf(const char *format, ...) {
|
||||||
|
va_list args;
|
||||||
|
const uint8_t *ret;
|
||||||
|
JanetBuffer buffer;
|
||||||
|
int32_t len = 0;
|
||||||
|
while (format[len]) len++;
|
||||||
|
janet_buffer_init(&buffer, len);
|
||||||
|
va_start(args, format);
|
||||||
|
janet_formatb(&buffer, format, args);
|
||||||
|
va_end(args);
|
||||||
|
ret = janet_string(buffer.data, buffer.count);
|
||||||
|
janet_buffer_deinit(&buffer);
|
||||||
|
janet_panics(ret);
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_printf(const char *format, ...) {
|
||||||
|
va_list args;
|
||||||
|
JanetBuffer buffer;
|
||||||
|
int32_t len = 0;
|
||||||
|
while (format[len]) len++;
|
||||||
|
janet_buffer_init(&buffer, len);
|
||||||
|
va_start(args, format);
|
||||||
|
janet_formatb(&buffer, format, args);
|
||||||
|
va_end(args);
|
||||||
|
fwrite(buffer.data, buffer.count, 1, janet_dynfile("out", stdout));
|
||||||
|
janet_buffer_deinit(&buffer);
|
||||||
|
}
|
||||||
|
|
||||||
void janet_panic(const char *message) {
|
void janet_panic(const char *message) {
|
||||||
janet_panicv(janet_cstringv(message));
|
janet_panicv(janet_cstringv(message));
|
||||||
}
|
}
|
||||||
@@ -95,15 +123,16 @@ DEFINE_GETTER(buffer, BUFFER, JanetBuffer *)
|
|||||||
DEFINE_GETTER(fiber, FIBER, JanetFiber *)
|
DEFINE_GETTER(fiber, FIBER, JanetFiber *)
|
||||||
DEFINE_GETTER(function, FUNCTION, JanetFunction *)
|
DEFINE_GETTER(function, FUNCTION, JanetFunction *)
|
||||||
DEFINE_GETTER(cfunction, CFUNCTION, JanetCFunction)
|
DEFINE_GETTER(cfunction, CFUNCTION, JanetCFunction)
|
||||||
|
DEFINE_GETTER(boolean, BOOLEAN, int)
|
||||||
|
DEFINE_GETTER(pointer, POINTER, void *)
|
||||||
|
|
||||||
int janet_getboolean(const Janet *argv, int32_t n) {
|
const char *janet_getcstring(const Janet *argv, int32_t n) {
|
||||||
Janet x = argv[n];
|
const uint8_t *jstr = janet_getstring(argv, n);
|
||||||
if (janet_checktype(x, JANET_TRUE)) {
|
const char *cstr = (const char *)jstr;
|
||||||
return 1;
|
if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
|
||||||
} else if (!janet_checktype(x, JANET_FALSE)) {
|
janet_panicf("string %v contains embedded 0s");
|
||||||
janet_panicf("bad slot #%d, expected boolean, got %v", n, x);
|
|
||||||
}
|
}
|
||||||
return 0;
|
return cstr;
|
||||||
}
|
}
|
||||||
|
|
||||||
int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
||||||
@@ -122,6 +151,14 @@ int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
|||||||
return (int64_t) janet_unwrap_number(x);
|
return (int64_t) janet_unwrap_number(x);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
size_t janet_getsize(const Janet *argv, int32_t n) {
|
||||||
|
Janet x = argv[n];
|
||||||
|
if (!janet_checksize(x)) {
|
||||||
|
janet_panicf("bad slot #%d, expected size, got %v", n, x);
|
||||||
|
}
|
||||||
|
return (size_t) janet_unwrap_number(x);
|
||||||
|
}
|
||||||
|
|
||||||
int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
||||||
int32_t raw = janet_getinteger(argv, n);
|
int32_t raw = janet_getinteger(argv, n);
|
||||||
if (raw < 0) raw += length + 1;
|
if (raw < 0) raw += length + 1;
|
||||||
@@ -195,3 +232,60 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
|
|||||||
}
|
}
|
||||||
return range;
|
return range;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Janet janet_dyn(const char *name) {
|
||||||
|
if (!janet_vm_fiber) return janet_wrap_nil();
|
||||||
|
if (janet_vm_fiber->env) {
|
||||||
|
return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
|
||||||
|
} else {
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_setdyn(const char *name, Janet value) {
|
||||||
|
if (!janet_vm_fiber) return;
|
||||||
|
if (!janet_vm_fiber->env) {
|
||||||
|
janet_vm_fiber->env = janet_table(1);
|
||||||
|
}
|
||||||
|
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
|
||||||
|
}
|
||||||
|
|
||||||
|
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {
|
||||||
|
uint64_t ret = 0;
|
||||||
|
const uint8_t *keyw = janet_getkeyword(argv, n);
|
||||||
|
int32_t klen = janet_string_length(keyw);
|
||||||
|
int32_t flen = (int32_t) strlen(flags);
|
||||||
|
if (flen > 64) {
|
||||||
|
flen = 64;
|
||||||
|
}
|
||||||
|
for (int32_t j = 0; j < klen; j++) {
|
||||||
|
for (int32_t i = 0; i < flen; i++) {
|
||||||
|
if (((uint8_t) flags[i]) == keyw[j]) {
|
||||||
|
ret |= 1ULL << i;
|
||||||
|
goto found;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_panicf("unexpected flag %c, expected one of \"%s\"", (char) keyw[j], flags);
|
||||||
|
found:
|
||||||
|
;
|
||||||
|
}
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Some definitions for function-like macros */
|
||||||
|
|
||||||
|
JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {
|
||||||
|
return janet_struct_head(st);
|
||||||
|
}
|
||||||
|
|
||||||
|
JANET_API JanetAbstractHead *(janet_abstract_head)(const void *abstract) {
|
||||||
|
return janet_abstract_head(abstract);
|
||||||
|
}
|
||||||
|
|
||||||
|
JANET_API JanetStringHead *(janet_string_head)(const uint8_t *s) {
|
||||||
|
return janet_string_head(s);
|
||||||
|
}
|
||||||
|
|
||||||
|
JANET_API JanetTupleHead *(janet_tuple_head)(const Janet *tuple) {
|
||||||
|
return janet_tuple_head(tuple);
|
||||||
|
}
|
||||||
|
|||||||
@@ -21,7 +21,7 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "compile.h"
|
#include "compile.h"
|
||||||
#include "emit.h"
|
#include "emit.h"
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
@@ -35,6 +35,10 @@ static int fixarity1(JanetFopts opts, JanetSlot *args) {
|
|||||||
(void) opts;
|
(void) opts;
|
||||||
return janet_v_count(args) == 1;
|
return janet_v_count(args) == 1;
|
||||||
}
|
}
|
||||||
|
static int maxarity1(JanetFopts opts, JanetSlot *args) {
|
||||||
|
(void) opts;
|
||||||
|
return janet_v_count(args) <= 1;
|
||||||
|
}
|
||||||
static int minarity2(JanetFopts opts, JanetSlot *args) {
|
static int minarity2(JanetFopts opts, JanetSlot *args) {
|
||||||
(void) opts;
|
(void) opts;
|
||||||
return janet_v_count(args) >= 2;
|
return janet_v_count(args) >= 2;
|
||||||
@@ -88,6 +92,9 @@ static JanetSlot opreduce(
|
|||||||
|
|
||||||
/* Function optimizers */
|
/* Function optimizers */
|
||||||
|
|
||||||
|
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
|
||||||
|
return opreduce(opts, args, JOP_PROPAGATE, janet_wrap_nil());
|
||||||
|
}
|
||||||
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
|
||||||
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
|
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
@@ -115,8 +122,12 @@ static JanetSlot do_length(JanetFopts opts, JanetSlot *args) {
|
|||||||
return genericSS(opts, JOP_LENGTH, args[0]);
|
return genericSS(opts, JOP_LENGTH, args[0]);
|
||||||
}
|
}
|
||||||
static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
|
||||||
|
if (janet_v_count(args) == 0) {
|
||||||
|
return genericSSI(opts, JOP_SIGNAL, janetc_cslot(janet_wrap_nil()), 3);
|
||||||
|
} else {
|
||||||
return genericSSI(opts, JOP_SIGNAL, args[0], 3);
|
return genericSSI(opts, JOP_SIGNAL, args[0], 3);
|
||||||
}
|
}
|
||||||
|
}
|
||||||
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_RESUME, janet_wrap_nil());
|
return opreduce(opts, args, JOP_RESUME, janet_wrap_nil());
|
||||||
}
|
}
|
||||||
@@ -262,7 +273,7 @@ static const JanetFunOptimizer optimizers[] = {
|
|||||||
{fixarity0, do_debug},
|
{fixarity0, do_debug},
|
||||||
{fixarity1, do_error},
|
{fixarity1, do_error},
|
||||||
{minarity2, do_apply},
|
{minarity2, do_apply},
|
||||||
{fixarity1, do_yield},
|
{maxarity1, do_yield},
|
||||||
{fixarity2, do_resume},
|
{fixarity2, do_resume},
|
||||||
{fixarity2, do_get},
|
{fixarity2, do_get},
|
||||||
{fixarity3, do_put},
|
{fixarity3, do_put},
|
||||||
@@ -289,7 +300,8 @@ static const JanetFunOptimizer optimizers[] = {
|
|||||||
{NULL, do_gte},
|
{NULL, do_gte},
|
||||||
{NULL, do_lte},
|
{NULL, do_lte},
|
||||||
{NULL, do_eq},
|
{NULL, do_eq},
|
||||||
{NULL, do_neq}
|
{NULL, do_neq},
|
||||||
|
{fixarity2, do_propagate}
|
||||||
};
|
};
|
||||||
|
|
||||||
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
||||||
|
|||||||
@@ -21,11 +21,12 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "compile.h"
|
#include "compile.h"
|
||||||
#include "emit.h"
|
#include "emit.h"
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#include "state.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
JanetFopts janetc_fopts_default(JanetCompiler *c) {
|
JanetFopts janetc_fopts_default(JanetCompiler *c) {
|
||||||
@@ -97,7 +98,6 @@ void janetc_scope(JanetScope *s, JanetCompiler *c, int flags, const char *name)
|
|||||||
scope.syms = NULL;
|
scope.syms = NULL;
|
||||||
scope.envs = NULL;
|
scope.envs = NULL;
|
||||||
scope.defs = NULL;
|
scope.defs = NULL;
|
||||||
scope.selfconst = -1;
|
|
||||||
scope.bytecode_start = janet_v_count(c->buffer);
|
scope.bytecode_start = janet_v_count(c->buffer);
|
||||||
scope.flags = flags;
|
scope.flags = flags;
|
||||||
scope.parent = c->scope;
|
scope.parent = c->scope;
|
||||||
@@ -206,8 +206,7 @@ JanetSlot janetc_resolve(
|
|||||||
case JANET_BINDING_DEF:
|
case JANET_BINDING_DEF:
|
||||||
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
|
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
|
||||||
return janetc_cslot(check);
|
return janetc_cslot(check);
|
||||||
case JANET_BINDING_VAR:
|
case JANET_BINDING_VAR: {
|
||||||
{
|
|
||||||
JanetSlot ret = janetc_cslot(check);
|
JanetSlot ret = janetc_cslot(check);
|
||||||
/* TODO save type info */
|
/* TODO save type info */
|
||||||
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
|
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
|
||||||
@@ -311,9 +310,9 @@ JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
|
|||||||
JanetSlot *ret = NULL;
|
JanetSlot *ret = NULL;
|
||||||
JanetFopts subopts = janetc_fopts_default(c);
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
const JanetKV *kvs = NULL;
|
const JanetKV *kvs = NULL;
|
||||||
int32_t cap, i, len;
|
int32_t cap = 0, len = 0;
|
||||||
janet_dictionary_view(ds, &kvs, &len, &cap);
|
janet_dictionary_view(ds, &kvs, &len, &cap);
|
||||||
for (i = 0; i < cap; i++) {
|
for (int32_t i = 0; i < cap; i++) {
|
||||||
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
|
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
|
||||||
janet_v_push(ret, janetc_value(subopts, kvs[i].key));
|
janet_v_push(ret, janetc_value(subopts, kvs[i].key));
|
||||||
janet_v_push(ret, janetc_value(subopts, kvs[i].value));
|
janet_v_push(ret, janetc_value(subopts, kvs[i].value));
|
||||||
@@ -479,6 +478,9 @@ static int macroexpand1(
|
|||||||
c->current_mapping.start = janet_tuple_sm_start(form);
|
c->current_mapping.start = janet_tuple_sm_start(form);
|
||||||
c->current_mapping.end = janet_tuple_sm_end(form);
|
c->current_mapping.end = janet_tuple_sm_end(form);
|
||||||
}
|
}
|
||||||
|
/* Bracketed tuples are not specials or macros! */
|
||||||
|
if (janet_tuple_flag(form) & JANET_TUPLE_FLAG_BRACKETCTOR)
|
||||||
|
return 0;
|
||||||
if (!janet_checktype(form[0], JANET_SYMBOL))
|
if (!janet_checktype(form[0], JANET_SYMBOL))
|
||||||
return 0;
|
return 0;
|
||||||
const uint8_t *name = janet_unwrap_symbol(form[0]);
|
const uint8_t *name = janet_unwrap_symbol(form[0]);
|
||||||
@@ -494,7 +496,7 @@ static int macroexpand1(
|
|||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
/* Evaluate macro */
|
/* Evaluate macro */
|
||||||
JanetFiber *fiberp;
|
JanetFiber *fiberp = NULL;
|
||||||
JanetFunction *macro = janet_unwrap_function(macroval);
|
JanetFunction *macro = janet_unwrap_function(macroval);
|
||||||
int lock = janet_gclock();
|
int lock = janet_gclock();
|
||||||
JanetSignal status = janet_pcall(
|
JanetSignal status = janet_pcall(
|
||||||
@@ -548,8 +550,7 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
|||||||
ret = spec->compile(opts, janet_tuple_length(tup) - 1, tup + 1);
|
ret = spec->compile(opts, janet_tuple_length(tup) - 1, tup + 1);
|
||||||
} else {
|
} else {
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE: {
|
||||||
{
|
|
||||||
JanetFopts subopts = janetc_fopts_default(c);
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
const Janet *tup = janet_unwrap_tuple(x);
|
const Janet *tup = janet_unwrap_tuple(x);
|
||||||
/* Empty tuple is tuple literal */
|
/* Empty tuple is tuple literal */
|
||||||
@@ -628,7 +629,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
|||||||
}
|
}
|
||||||
memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
|
memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
|
||||||
janet_v__cnt(c->buffer) = scope->bytecode_start;
|
janet_v__cnt(c->buffer) = scope->bytecode_start;
|
||||||
if (NULL != c->mapbuffer) {
|
if (NULL != c->mapbuffer && c->source) {
|
||||||
size_t s = sizeof(JanetSourceMapping) * def->bytecode_length;
|
size_t s = sizeof(JanetSourceMapping) * def->bytecode_length;
|
||||||
def->sourcemap = malloc(s);
|
def->sourcemap = malloc(s);
|
||||||
if (NULL == def->sourcemap) {
|
if (NULL == def->sourcemap) {
|
||||||
@@ -643,6 +644,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
|||||||
def->source = c->source;
|
def->source = c->source;
|
||||||
|
|
||||||
def->arity = 0;
|
def->arity = 0;
|
||||||
|
def->min_arity = 0;
|
||||||
def->flags = 0;
|
def->flags = 0;
|
||||||
if (scope->flags & JANET_SCOPE_ENV) {
|
if (scope->flags & JANET_SCOPE_ENV) {
|
||||||
def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV;
|
def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV;
|
||||||
@@ -715,8 +717,12 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
|
|||||||
|
|
||||||
/* C Function for compiling */
|
/* C Function for compiling */
|
||||||
static Janet cfun(int32_t argc, Janet *argv) {
|
static Janet cfun(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 2, 3);
|
janet_arity(argc, 1, 3);
|
||||||
JanetTable *env = janet_gettable(argv, 1);
|
JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm_fiber->env;
|
||||||
|
if (NULL == env) {
|
||||||
|
env = janet_table(0);
|
||||||
|
janet_vm_fiber->env = env;
|
||||||
|
}
|
||||||
const uint8_t *source = NULL;
|
const uint8_t *source = NULL;
|
||||||
if (argc == 3) {
|
if (argc == 3) {
|
||||||
source = janet_getstring(argv, 2);
|
source = janet_getstring(argv, 2);
|
||||||
@@ -737,8 +743,9 @@ static Janet cfun(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg compile_cfuns[] = {
|
static const JanetReg compile_cfuns[] = {
|
||||||
{"compile", cfun,
|
{
|
||||||
JDOC("(compile ast env [, source])\n\n"
|
"compile", cfun,
|
||||||
|
JDOC("(compile ast &opt env source)\n\n"
|
||||||
"Compiles an Abstract Syntax Tree (ast) into a janet function. "
|
"Compiles an Abstract Syntax Tree (ast) into a janet function. "
|
||||||
"Pair the compile function with parsing functionality to implement "
|
"Pair the compile function with parsing functionality to implement "
|
||||||
"eval. Returns a janet function and does not modify ast. Throws an "
|
"eval. Returns a janet function and does not modify ast. Throws an "
|
||||||
|
|||||||
@@ -24,7 +24,7 @@
|
|||||||
#define JANET_COMPILE_H
|
#define JANET_COMPILE_H
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "regalloc.h"
|
#include "regalloc.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
@@ -60,6 +60,7 @@
|
|||||||
#define JANET_FUN_LTE 29
|
#define JANET_FUN_LTE 29
|
||||||
#define JANET_FUN_EQ 30
|
#define JANET_FUN_EQ 30
|
||||||
#define JANET_FUN_NEQ 31
|
#define JANET_FUN_NEQ 31
|
||||||
|
#define JANET_FUN_PROP 32
|
||||||
|
|
||||||
/* Compiler typedefs */
|
/* Compiler typedefs */
|
||||||
typedef struct JanetCompiler JanetCompiler;
|
typedef struct JanetCompiler JanetCompiler;
|
||||||
@@ -96,6 +97,7 @@ struct JanetSlot {
|
|||||||
#define JANET_SCOPE_TOP 4
|
#define JANET_SCOPE_TOP 4
|
||||||
#define JANET_SCOPE_UNUSED 8
|
#define JANET_SCOPE_UNUSED 8
|
||||||
#define JANET_SCOPE_CLOSURE 16
|
#define JANET_SCOPE_CLOSURE 16
|
||||||
|
#define JANET_SCOPE_WHILE 32
|
||||||
|
|
||||||
/* A symbol and slot pair */
|
/* A symbol and slot pair */
|
||||||
typedef struct SymPair {
|
typedef struct SymPair {
|
||||||
@@ -131,9 +133,6 @@ struct JanetScope {
|
|||||||
* that corresponds to the direct parent's stack will always have value 0. */
|
* that corresponds to the direct parent's stack will always have value 0. */
|
||||||
int32_t *envs;
|
int32_t *envs;
|
||||||
|
|
||||||
/* Where to add reference to self in constants */
|
|
||||||
int32_t selfconst;
|
|
||||||
|
|
||||||
int32_t bytecode_start;
|
int32_t bytecode_start;
|
||||||
int flags;
|
int flags;
|
||||||
};
|
};
|
||||||
|
|||||||
1749
src/core/core.janet
1749
src/core/core.janet
File diff suppressed because it is too large
Load Diff
@@ -21,17 +21,14 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "compile.h"
|
#include "compile.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Generated bytes */
|
/* Generated bytes */
|
||||||
#ifdef JANET_BOOTSTRAP
|
#ifndef JANET_BOOTSTRAP
|
||||||
extern const unsigned char *janet_gen_core;
|
|
||||||
extern int32_t janet_gen_core_size;
|
|
||||||
#else
|
|
||||||
extern const unsigned char *janet_core_image;
|
extern const unsigned char *janet_core_image;
|
||||||
extern size_t janet_core_image_size;
|
extern size_t janet_core_image_size;
|
||||||
#endif
|
#endif
|
||||||
@@ -41,7 +38,7 @@ extern size_t janet_core_image_size;
|
|||||||
#if defined(JANET_NO_DYNAMIC_MODULES)
|
#if defined(JANET_NO_DYNAMIC_MODULES)
|
||||||
typedef int Clib;
|
typedef int Clib;
|
||||||
#define load_clib(name) ((void) name, 0)
|
#define load_clib(name) ((void) name, 0)
|
||||||
#define symbol_clib(lib, sym) ((void) lib, (void) sym, 0)
|
#define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
|
||||||
#define error_clib() "dynamic libraries not supported"
|
#define error_clib() "dynamic libraries not supported"
|
||||||
#elif defined(JANET_WINDOWS)
|
#elif defined(JANET_WINDOWS)
|
||||||
#include <windows.h>
|
#include <windows.h>
|
||||||
@@ -60,18 +57,199 @@ typedef void *Clib;
|
|||||||
JanetModule janet_native(const char *name, const uint8_t **error) {
|
JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||||
Clib lib = load_clib(name);
|
Clib lib = load_clib(name);
|
||||||
JanetModule init;
|
JanetModule init;
|
||||||
|
JanetModconf getter;
|
||||||
if (!lib) {
|
if (!lib) {
|
||||||
*error = janet_cstring(error_clib());
|
*error = janet_cstring(error_clib());
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
init = (JanetModule) symbol_clib(lib, "_janet_init");
|
init = (JanetModule) symbol_clib(lib, "_janet_init");
|
||||||
if (!init) {
|
if (!init) {
|
||||||
*error = janet_cstring("could not find _janet_init symbol");
|
*error = janet_cstring("could not find the _janet_init symbol");
|
||||||
|
return NULL;
|
||||||
|
}
|
||||||
|
getter = (JanetModconf) symbol_clib(lib, "_janet_mod_config");
|
||||||
|
if (!getter) {
|
||||||
|
*error = janet_cstring("could not find the _janet_mod_config symbol");
|
||||||
|
return NULL;
|
||||||
|
}
|
||||||
|
JanetBuildConfig modconf = getter();
|
||||||
|
JanetBuildConfig host = janet_config_current();
|
||||||
|
if (host.major != modconf.major ||
|
||||||
|
host.minor < modconf.minor ||
|
||||||
|
host.bits != modconf.bits) {
|
||||||
|
char errbuf[128];
|
||||||
|
sprintf(errbuf, "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
|
||||||
|
host.major,
|
||||||
|
host.minor,
|
||||||
|
host.patch,
|
||||||
|
host.bits,
|
||||||
|
modconf.major,
|
||||||
|
modconf.minor,
|
||||||
|
modconf.patch,
|
||||||
|
modconf.bits);
|
||||||
|
*error = janet_cstring(errbuf);
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
return init;
|
return init;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static const char *janet_dyncstring(const char *name, const char *dflt) {
|
||||||
|
Janet x = janet_dyn(name);
|
||||||
|
if (janet_checktype(x, JANET_NIL)) return dflt;
|
||||||
|
if (!janet_checktype(x, JANET_STRING)) {
|
||||||
|
janet_panicf("expected string, got %v", x);
|
||||||
|
}
|
||||||
|
const uint8_t *jstr = janet_unwrap_string(x);
|
||||||
|
const char *cstr = (const char *)jstr;
|
||||||
|
if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
|
||||||
|
janet_panicf("string %v contains embedded 0s");
|
||||||
|
}
|
||||||
|
return cstr;
|
||||||
|
}
|
||||||
|
|
||||||
|
static int is_path_sep(char c) {
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
if (c == '\\') return 1;
|
||||||
|
#endif
|
||||||
|
return c == '/';
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Used for module system. */
|
||||||
|
static Janet janet_core_expand_path(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 2);
|
||||||
|
const char *input = janet_getcstring(argv, 0);
|
||||||
|
const char *template = janet_getcstring(argv, 1);
|
||||||
|
const char *curfile = janet_dyncstring("current-file", "");
|
||||||
|
const char *syspath = janet_dyncstring("syspath", "");
|
||||||
|
JanetBuffer *out = janet_buffer(0);
|
||||||
|
size_t tlen = strlen(template);
|
||||||
|
|
||||||
|
/* Calculate name */
|
||||||
|
const char *name = input + strlen(input);
|
||||||
|
while (name > input) {
|
||||||
|
if (is_path_sep(*(name - 1))) break;
|
||||||
|
name--;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Calculate dirpath from current file */
|
||||||
|
const char *curname = curfile + strlen(curfile);
|
||||||
|
while (curname > curfile) {
|
||||||
|
if (is_path_sep(*curname)) break;
|
||||||
|
curname--;
|
||||||
|
}
|
||||||
|
const char *curdir;
|
||||||
|
int32_t curlen;
|
||||||
|
if (curname == curfile) {
|
||||||
|
/* Current file has one or zero path segments, so
|
||||||
|
* we are in the . directory. */
|
||||||
|
curdir = ".";
|
||||||
|
curlen = 1;
|
||||||
|
} else {
|
||||||
|
/* Current file has 2 or more segments, so we
|
||||||
|
* can cut off the last segment. */
|
||||||
|
curdir = curfile;
|
||||||
|
curlen = (int32_t)(curname - curfile);
|
||||||
|
}
|
||||||
|
|
||||||
|
for (size_t i = 0; i < tlen; i++) {
|
||||||
|
if (template[i] == ':') {
|
||||||
|
if (strncmp(template + i, ":all:", 5) == 0) {
|
||||||
|
janet_buffer_push_cstring(out, input);
|
||||||
|
i += 4;
|
||||||
|
} else if (strncmp(template + i, ":cur:", 5) == 0) {
|
||||||
|
janet_buffer_push_bytes(out, (const uint8_t *)curdir, curlen);
|
||||||
|
i += 4;
|
||||||
|
} else if (strncmp(template + i, ":dir:", 5) == 0) {
|
||||||
|
janet_buffer_push_bytes(out, (const uint8_t *)input,
|
||||||
|
(int32_t)(name - input));
|
||||||
|
i += 4;
|
||||||
|
} else if (strncmp(template + i, ":sys:", 5) == 0) {
|
||||||
|
janet_buffer_push_cstring(out, syspath);
|
||||||
|
i += 4;
|
||||||
|
} else if (strncmp(template + i, ":name:", 6) == 0) {
|
||||||
|
janet_buffer_push_cstring(out, name);
|
||||||
|
i += 5;
|
||||||
|
} else {
|
||||||
|
janet_buffer_push_u8(out, (uint8_t) template[i]);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
janet_buffer_push_u8(out, (uint8_t) template[i]);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Normalize */
|
||||||
|
uint8_t *scan = out->data;
|
||||||
|
uint8_t *print = scan;
|
||||||
|
uint8_t *scanend = scan + out->count;
|
||||||
|
int normal_section_count = 0;
|
||||||
|
int dot_count = 0;
|
||||||
|
while (scan < scanend) {
|
||||||
|
if (*scan == '.') {
|
||||||
|
if (dot_count >= 0) {
|
||||||
|
dot_count++;
|
||||||
|
} else {
|
||||||
|
*print++ = '.';
|
||||||
|
}
|
||||||
|
} else if (is_path_sep(*scan)) {
|
||||||
|
if (dot_count == 1) {
|
||||||
|
;
|
||||||
|
} else if (dot_count == 2) {
|
||||||
|
if (normal_section_count > 0) {
|
||||||
|
/* unprint last separator */
|
||||||
|
print--;
|
||||||
|
/* unprint last section */
|
||||||
|
while (print > out->data && !is_path_sep(*(print - 1)))
|
||||||
|
print--;
|
||||||
|
normal_section_count--;
|
||||||
|
} else {
|
||||||
|
*print++ = '.';
|
||||||
|
*print++ = '.';
|
||||||
|
*print++ = '/';
|
||||||
|
}
|
||||||
|
} else if (scan == out->data || dot_count != 0) {
|
||||||
|
while (dot_count > 0) {
|
||||||
|
--dot_count;
|
||||||
|
*print++ = '.';
|
||||||
|
}
|
||||||
|
if (scan > out->data) {
|
||||||
|
normal_section_count++;
|
||||||
|
}
|
||||||
|
*print++ = '/';
|
||||||
|
}
|
||||||
|
dot_count = 0;
|
||||||
|
} else {
|
||||||
|
dot_count = -1;
|
||||||
|
*print++ = *scan;
|
||||||
|
}
|
||||||
|
scan++;
|
||||||
|
}
|
||||||
|
out->count = (int32_t)(print - out->data);
|
||||||
|
return janet_wrap_buffer(out);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet janet_core_dyn(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 2);
|
||||||
|
Janet value;
|
||||||
|
if (janet_vm_fiber->env) {
|
||||||
|
value = janet_table_get(janet_vm_fiber->env, argv[0]);
|
||||||
|
} else {
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
}
|
||||||
|
if (argc == 2 && janet_checktype(value, JANET_NIL)) {
|
||||||
|
return argv[1];
|
||||||
|
}
|
||||||
|
return value;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet janet_core_setdyn(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 2);
|
||||||
|
if (!janet_vm_fiber->env) {
|
||||||
|
janet_vm_fiber->env = janet_table(2);
|
||||||
|
}
|
||||||
|
janet_table_put(janet_vm_fiber->env, argv[0], argv[1]);
|
||||||
|
return argv[1];
|
||||||
|
}
|
||||||
|
|
||||||
static Janet janet_core_native(int32_t argc, Janet *argv) {
|
static Janet janet_core_native(int32_t argc, Janet *argv) {
|
||||||
JanetModule init;
|
JanetModule init;
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
@@ -91,19 +269,6 @@ static Janet janet_core_native(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_table(env);
|
return janet_wrap_table(env);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet janet_core_print(int32_t argc, Janet *argv) {
|
|
||||||
for (int32_t i = 0; i < argc; ++i) {
|
|
||||||
int32_t j, len;
|
|
||||||
const uint8_t *vstr = janet_to_string(argv[i]);
|
|
||||||
len = janet_string_length(vstr);
|
|
||||||
for (j = 0; j < len; ++j) {
|
|
||||||
putc(vstr[j], stdout);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
putc('\n', stdout);
|
|
||||||
return janet_wrap_nil();
|
|
||||||
}
|
|
||||||
|
|
||||||
static Janet janet_core_describe(int32_t argc, Janet *argv) {
|
static Janet janet_core_describe(int32_t argc, Janet *argv) {
|
||||||
JanetBuffer *b = janet_buffer(0);
|
JanetBuffer *b = janet_buffer(0);
|
||||||
for (int32_t i = 0; i < argc; ++i)
|
for (int32_t i = 0; i < argc; ++i)
|
||||||
@@ -243,104 +408,154 @@ static Janet janet_core_hash(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_number(janet_hash(argv[0]));
|
return janet_wrap_number(janet_hash(argv[0]));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Janet janet_core_getline(int32_t argc, Janet *argv) {
|
||||||
|
FILE *in = janet_dynfile("in", stdin);
|
||||||
|
FILE *out = janet_dynfile("out", stdout);
|
||||||
|
janet_arity(argc, 0, 2);
|
||||||
|
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
|
||||||
|
if (argc >= 1) {
|
||||||
|
const char *prompt = (const char *) janet_getstring(argv, 0);
|
||||||
|
fprintf(out, "%s", prompt);
|
||||||
|
fflush(out);
|
||||||
|
}
|
||||||
|
{
|
||||||
|
buf->count = 0;
|
||||||
|
int c;
|
||||||
|
for (;;) {
|
||||||
|
c = fgetc(in);
|
||||||
|
if (feof(in) || c < 0) {
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
janet_buffer_push_u8(buf, (uint8_t) c);
|
||||||
|
if (c == '\n') break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return janet_wrap_buffer(buf);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet janet_core_trace(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetFunction *func = janet_getfunction(argv, 0);
|
||||||
|
func->gc.flags |= JANET_FUNCFLAG_TRACE;
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet janet_core_untrace(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetFunction *func = janet_getfunction(argv, 0);
|
||||||
|
func->gc.flags &= ~JANET_FUNCFLAG_TRACE;
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
static const JanetReg corelib_cfuns[] = {
|
static const JanetReg corelib_cfuns[] = {
|
||||||
{"native", janet_core_native,
|
{
|
||||||
JDOC("(native path [,env])\n\n"
|
"native", janet_core_native,
|
||||||
|
JDOC("(native path &opt env)\n\n"
|
||||||
"Load a native module from the given path. The path "
|
"Load a native module from the given path. The path "
|
||||||
"must be an absolute or relative path on the file system, and is "
|
"must be an absolute or relative path on the file system, and is "
|
||||||
"usually a .so file on Unix systems, and a .dll file on Windows. "
|
"usually a .so file on Unix systems, and a .dll file on Windows. "
|
||||||
"Returns an environment table that contains functions and other values "
|
"Returns an environment table that contains functions and other values "
|
||||||
"from the native module.")
|
"from the native module.")
|
||||||
},
|
},
|
||||||
{"print", janet_core_print,
|
{
|
||||||
JDOC("(print & xs)\n\n"
|
"describe", janet_core_describe,
|
||||||
"Print values to the console (standard out). Value are converted "
|
|
||||||
"to strings if they are not already. After printing all values, a "
|
|
||||||
"newline character is printed. Returns nil.")
|
|
||||||
},
|
|
||||||
{"describe", janet_core_describe,
|
|
||||||
JDOC("(describe x)\n\n"
|
JDOC("(describe x)\n\n"
|
||||||
"Returns a string that is a human readable description of a value x.")
|
"Returns a string that is a human readable description of a value x.")
|
||||||
},
|
},
|
||||||
{"string", janet_core_string,
|
{
|
||||||
|
"string", janet_core_string,
|
||||||
JDOC("(string & parts)\n\n"
|
JDOC("(string & parts)\n\n"
|
||||||
"Creates a string by concatenating values together. Values are "
|
"Creates a string by concatenating values together. Values are "
|
||||||
"converted to bytes via describe if they are not byte sequences. "
|
"converted to bytes via describe if they are not byte sequences. "
|
||||||
"Returns the new string.")
|
"Returns the new string.")
|
||||||
},
|
},
|
||||||
{"symbol", janet_core_symbol,
|
{
|
||||||
|
"symbol", janet_core_symbol,
|
||||||
JDOC("(symbol & xs)\n\n"
|
JDOC("(symbol & xs)\n\n"
|
||||||
"Creates a symbol by concatenating values together. Values are "
|
"Creates a symbol by concatenating values together. Values are "
|
||||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||||
"the new symbol.")
|
"the new symbol.")
|
||||||
},
|
},
|
||||||
{"keyword", janet_core_keyword,
|
{
|
||||||
|
"keyword", janet_core_keyword,
|
||||||
JDOC("(keyword & xs)\n\n"
|
JDOC("(keyword & xs)\n\n"
|
||||||
"Creates a keyword by concatenating values together. Values are "
|
"Creates a keyword by concatenating values together. Values are "
|
||||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||||
"the new keyword.")
|
"the new keyword.")
|
||||||
},
|
},
|
||||||
{"buffer", janet_core_buffer,
|
{
|
||||||
|
"buffer", janet_core_buffer,
|
||||||
JDOC("(buffer & xs)\n\n"
|
JDOC("(buffer & xs)\n\n"
|
||||||
"Creates a new buffer by concatenating values together. Values are "
|
"Creates a new buffer by concatenating values together. Values are "
|
||||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||||
"the new buffer.")
|
"the new buffer.")
|
||||||
},
|
},
|
||||||
{"abstract?", janet_core_is_abstract,
|
{
|
||||||
|
"abstract?", janet_core_is_abstract,
|
||||||
JDOC("(abstract? x)\n\n"
|
JDOC("(abstract? x)\n\n"
|
||||||
"Check if x is an abstract type.")
|
"Check if x is an abstract type.")
|
||||||
},
|
},
|
||||||
{"table", janet_core_table,
|
{
|
||||||
|
"table", janet_core_table,
|
||||||
JDOC("(table & kvs)\n\n"
|
JDOC("(table & kvs)\n\n"
|
||||||
"Creates a new table from a variadic number of keys and values. "
|
"Creates a new table from a variadic number of keys and values. "
|
||||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||||
"an odd number of elements, an error will be thrown. Returns the "
|
"an odd number of elements, an error will be thrown. Returns the "
|
||||||
"new table.")
|
"new table.")
|
||||||
},
|
},
|
||||||
{"array", janet_core_array,
|
{
|
||||||
|
"array", janet_core_array,
|
||||||
JDOC("(array & items)\n\n"
|
JDOC("(array & items)\n\n"
|
||||||
"Create a new array that contains items. Returns the new array.")
|
"Create a new array that contains items. Returns the new array.")
|
||||||
},
|
},
|
||||||
{"scan-number", janet_core_scannumber,
|
{
|
||||||
|
"scan-number", janet_core_scannumber,
|
||||||
JDOC("(scan-number str)\n\n"
|
JDOC("(scan-number str)\n\n"
|
||||||
"Parse a number from a byte sequence an return that number, either and integer "
|
"Parse a number from a byte sequence an return that number, either and integer "
|
||||||
"or a real. The number "
|
"or a real. The number "
|
||||||
"must be in the same format as numbers in janet source code. Will return nil "
|
"must be in the same format as numbers in janet source code. Will return nil "
|
||||||
"on an invalid number.")
|
"on an invalid number.")
|
||||||
},
|
},
|
||||||
{"tuple", janet_core_tuple,
|
{
|
||||||
|
"tuple", janet_core_tuple,
|
||||||
JDOC("(tuple & items)\n\n"
|
JDOC("(tuple & items)\n\n"
|
||||||
"Creates a new tuple that contains items. Returns the new tuple.")
|
"Creates a new tuple that contains items. Returns the new tuple.")
|
||||||
},
|
},
|
||||||
{"struct", janet_core_struct,
|
{
|
||||||
|
"struct", janet_core_struct,
|
||||||
JDOC("(struct & kvs)\n\n"
|
JDOC("(struct & kvs)\n\n"
|
||||||
"Create a new struct from a sequence of key value pairs. "
|
"Create a new struct from a sequence of key value pairs. "
|
||||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||||
"an odd number of elements, an error will be thrown. Returns the "
|
"an odd number of elements, an error will be thrown. Returns the "
|
||||||
"new struct.")
|
"new struct.")
|
||||||
},
|
},
|
||||||
{"gensym", janet_core_gensym,
|
{
|
||||||
|
"gensym", janet_core_gensym,
|
||||||
JDOC("(gensym)\n\n"
|
JDOC("(gensym)\n\n"
|
||||||
"Returns a new symbol that is unique across the runtime. This means it "
|
"Returns a new symbol that is unique across the runtime. This means it "
|
||||||
"will not collide with any already created symbols during compilation, so "
|
"will not collide with any already created symbols during compilation, so "
|
||||||
"it can be used in macros to generate automatic bindings.")
|
"it can be used in macros to generate automatic bindings.")
|
||||||
},
|
},
|
||||||
{"gccollect", janet_core_gccollect,
|
{
|
||||||
|
"gccollect", janet_core_gccollect,
|
||||||
JDOC("(gccollect)\n\n"
|
JDOC("(gccollect)\n\n"
|
||||||
"Run garbage collection. You should probably not call this manually.")
|
"Run garbage collection. You should probably not call this manually.")
|
||||||
},
|
},
|
||||||
{"gcsetinterval", janet_core_gcsetinterval,
|
{
|
||||||
|
"gcsetinterval", janet_core_gcsetinterval,
|
||||||
JDOC("(gcsetinterval interval)\n\n"
|
JDOC("(gcsetinterval interval)\n\n"
|
||||||
"Set an integer number of bytes to allocate before running garbage collection. "
|
"Set an integer number of bytes to allocate before running garbage collection. "
|
||||||
"Low valuesi for interval will be slower but use less memory. "
|
"Low valuesi for interval will be slower but use less memory. "
|
||||||
"High values will be faster but use more memory.")
|
"High values will be faster but use more memory.")
|
||||||
},
|
},
|
||||||
{"gcinterval", janet_core_gcinterval,
|
{
|
||||||
|
"gcinterval", janet_core_gcinterval,
|
||||||
JDOC("(gcinterval)\n\n"
|
JDOC("(gcinterval)\n\n"
|
||||||
"Returns the integer number of bytes to allocate before running an iteration "
|
"Returns the integer number of bytes to allocate before running an iteration "
|
||||||
"of garbage collection.")
|
"of garbage collection.")
|
||||||
},
|
},
|
||||||
{"type", janet_core_type,
|
{
|
||||||
|
"type", janet_core_type,
|
||||||
JDOC("(type x)\n\n"
|
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 symbol. x is one of\n"
|
||||||
"\t:nil\n"
|
"\t:nil\n"
|
||||||
@@ -359,20 +574,56 @@ static const JanetReg corelib_cfuns[] = {
|
|||||||
"\t:cfunction\n\n"
|
"\t:cfunction\n\n"
|
||||||
"or another symbol for an abstract type.")
|
"or another symbol for an abstract type.")
|
||||||
},
|
},
|
||||||
{"next", janet_core_next,
|
{
|
||||||
JDOC("(next dict key)\n\n"
|
"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 "
|
"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 "
|
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||||
"to be seen only once per iteration if they data structure is not mutated "
|
"to be seen only once per iteration if they data structure is not mutated "
|
||||||
"during iteration. If key is nil, next returns the first key. If next "
|
"during iteration. If key is nil, next returns the first key. If next "
|
||||||
"returns nil, there are no more keys to iterate through. ")
|
"returns nil, there are no more keys to iterate through. ")
|
||||||
},
|
},
|
||||||
{"hash", janet_core_hash,
|
{
|
||||||
|
"hash", janet_core_hash,
|
||||||
JDOC("(hash value)\n\n"
|
JDOC("(hash value)\n\n"
|
||||||
"Gets a hash value for any janet value. The hash is an integer can be used "
|
"Gets a hash value for any janet value. The hash is an integer can be used "
|
||||||
"as a cheap hash function for all janet objects. If two values are strictly equal, "
|
"as a cheap hash function for all janet objects. If two values are strictly equal, "
|
||||||
"then they will have the same hash value.")
|
"then they will have the same hash value.")
|
||||||
},
|
},
|
||||||
|
{
|
||||||
|
"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. "
|
||||||
|
"Use this function to implement a simple interface for a terminal program.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"dyn", janet_core_dyn,
|
||||||
|
JDOC("(dyn key &opt default)\n\n"
|
||||||
|
"Get a dynamic binding. Returns the default value (or nil) if no binding found.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"setdyn", janet_core_setdyn,
|
||||||
|
JDOC("(setdyn key value)\n\n"
|
||||||
|
"Set a dynamic binding. Returns value.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"trace", janet_core_trace,
|
||||||
|
JDOC("(trace func)\n\n"
|
||||||
|
"Enable tracing on a function. Returns the function.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"untrace", janet_core_untrace,
|
||||||
|
JDOC("(untrace func)\n\n"
|
||||||
|
"Disables tracing on a function. Returns the function.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"module/expand-path", janet_core_expand_path,
|
||||||
|
JDOC("(module/expand-path path template)\n\n"
|
||||||
|
"Expands a path template as found in module/paths for module/find. "
|
||||||
|
"This takes in a path (the argument to require) and a template string, template, "
|
||||||
|
"to expand the path to a path that can be "
|
||||||
|
"used for importing files.")
|
||||||
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -384,12 +635,16 @@ static void janet_quick_asm(
|
|||||||
int32_t flags,
|
int32_t flags,
|
||||||
const char *name,
|
const char *name,
|
||||||
int32_t arity,
|
int32_t arity,
|
||||||
|
int32_t min_arity,
|
||||||
|
int32_t max_arity,
|
||||||
int32_t slots,
|
int32_t slots,
|
||||||
const uint32_t *bytecode,
|
const uint32_t *bytecode,
|
||||||
size_t bytecode_size,
|
size_t bytecode_size,
|
||||||
const char *doc) {
|
const char *doc) {
|
||||||
JanetFuncDef *def = janet_funcdef_alloc();
|
JanetFuncDef *def = janet_funcdef_alloc();
|
||||||
def->arity = arity;
|
def->arity = arity;
|
||||||
|
def->min_arity = min_arity;
|
||||||
|
def->max_arity = max_arity;
|
||||||
def->flags = flags;
|
def->flags = flags;
|
||||||
def->slotcount = slots;
|
def->slotcount = slots;
|
||||||
def->bytecode = malloc(bytecode_size);
|
def->bytecode = malloc(bytecode_size);
|
||||||
@@ -465,6 +720,8 @@ static void templatize_varop(
|
|||||||
flags | JANET_FUNCDEF_FLAG_VARARG,
|
flags | JANET_FUNCDEF_FLAG_VARARG,
|
||||||
name,
|
name,
|
||||||
0,
|
0,
|
||||||
|
0,
|
||||||
|
INT32_MAX,
|
||||||
6,
|
6,
|
||||||
varop_asm,
|
varop_asm,
|
||||||
sizeof(varop_asm),
|
sizeof(varop_asm),
|
||||||
@@ -518,6 +775,8 @@ static void templatize_comparator(
|
|||||||
flags | JANET_FUNCDEF_FLAG_VARARG,
|
flags | JANET_FUNCDEF_FLAG_VARARG,
|
||||||
name,
|
name,
|
||||||
0,
|
0,
|
||||||
|
0,
|
||||||
|
INT32_MAX,
|
||||||
6,
|
6,
|
||||||
comparator_asm,
|
comparator_asm,
|
||||||
sizeof(comparator_asm),
|
sizeof(comparator_asm),
|
||||||
@@ -555,14 +814,14 @@ static void make_apply(JanetTable *env) {
|
|||||||
S(JOP_TAILCALL, 0)
|
S(JOP_TAILCALL, 0)
|
||||||
};
|
};
|
||||||
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
|
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
|
||||||
"apply", 1, 6, apply_asm, sizeof(apply_asm),
|
"apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm),
|
||||||
JDOC("(apply f & args)\n\n"
|
JDOC("(apply f & args)\n\n"
|
||||||
"Applies a function to a variable number of arguments. Each element in args "
|
"Applies a function to a variable number of arguments. Each element in args "
|
||||||
"is used as an argument to f, except the last element in args, which is expected to "
|
"is used as an argument to f, except the last element in args, which is expected to "
|
||||||
"be an array-like. Each element in this last argument is then also pushed as an argument to "
|
"be an array-like. Each element in this last argument is then also pushed as an argument to "
|
||||||
"f. For example:\n\n"
|
"f. For example:\n\n"
|
||||||
"\t(apply + 1000 (range 10))\n\n"
|
"\t(apply + 1000 (range 10))\n\n"
|
||||||
"sums the first 10 integers and 1000.)"));
|
"sums the first 10 integers and 1000."));
|
||||||
}
|
}
|
||||||
|
|
||||||
static const uint32_t error_asm[] = {
|
static const uint32_t error_asm[] = {
|
||||||
@@ -596,39 +855,56 @@ static const uint32_t bnot_asm[] = {
|
|||||||
JOP_BNOT,
|
JOP_BNOT,
|
||||||
JOP_RETURN
|
JOP_RETURN
|
||||||
};
|
};
|
||||||
|
static const uint32_t propagate_asm[] = {
|
||||||
|
JOP_PROPAGATE | (1 << 24),
|
||||||
|
JOP_RETURN
|
||||||
|
};
|
||||||
#endif /* ifndef JANET_NO_BOOTSTRAP */
|
#endif /* ifndef JANET_NO_BOOTSTRAP */
|
||||||
|
|
||||||
JanetTable *janet_core_env(void) {
|
JanetTable *janet_core_env(JanetTable *replacements) {
|
||||||
JanetTable *env = janet_table(0);
|
JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
|
||||||
janet_core_cfuns(env, NULL, corelib_cfuns);
|
janet_core_cfuns(env, NULL, corelib_cfuns);
|
||||||
|
|
||||||
#ifdef JANET_BOOTSTRAP
|
#ifdef JANET_BOOTSTRAP
|
||||||
janet_quick_asm(env, JANET_FUN_YIELD, "debug", 0, 1, debug_asm, sizeof(debug_asm),
|
janet_quick_asm(env, JANET_FUN_PROP,
|
||||||
|
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
|
||||||
|
JDOC("(propagate x fiber)\n\n"
|
||||||
|
"Propagate a signal from a fiber to the current fiber. The resulting "
|
||||||
|
"stack trace from the current fiber will include frames from fiber. If "
|
||||||
|
"fiber is in a state that can be resumed, resuming the current fiber will "
|
||||||
|
"first resume fiber."));
|
||||||
|
janet_quick_asm(env, JANET_FUN_DEBUG,
|
||||||
|
"debug", 0, 0, 0, 1, debug_asm, sizeof(debug_asm),
|
||||||
JDOC("(debug)\n\n"
|
JDOC("(debug)\n\n"
|
||||||
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
|
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
|
||||||
"the running state of the current fiber. Returns nil."));
|
"the running state of the current fiber. Returns nil."));
|
||||||
janet_quick_asm(env, JANET_FUN_ERROR, "error", 1, 1, error_asm, sizeof(error_asm),
|
janet_quick_asm(env, JANET_FUN_ERROR,
|
||||||
|
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
|
||||||
JDOC("(error e)\n\n"
|
JDOC("(error e)\n\n"
|
||||||
"Throws an error e that can be caught and handled by a parent fiber."));
|
"Throws an error e that can be caught and handled by a parent fiber."));
|
||||||
janet_quick_asm(env, JANET_FUN_YIELD, "yield", 1, 2, yield_asm, sizeof(yield_asm),
|
janet_quick_asm(env, JANET_FUN_YIELD,
|
||||||
|
"yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm),
|
||||||
JDOC("(yield x)\n\n"
|
JDOC("(yield x)\n\n"
|
||||||
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
|
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
|
||||||
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
||||||
"return the value that was passed to resume."));
|
"return the value that was passed to resume."));
|
||||||
janet_quick_asm(env, JANET_FUN_RESUME, "resume", 2, 2, resume_asm, sizeof(resume_asm),
|
janet_quick_asm(env, JANET_FUN_RESUME,
|
||||||
JDOC("(resume fiber [,x])\n\n"
|
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
|
||||||
|
JDOC("(resume fiber &opt x)\n\n"
|
||||||
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
|
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
|
||||||
"will be returned to the last yield in the case of a pending fiber, or the argument to "
|
"will be returned to the last yield in the case of a pending fiber, or the argument to "
|
||||||
"the dispatch function in the case of a new fiber. Returns either the return result of "
|
"the dispatch function in the case of a new fiber. Returns either the return result of "
|
||||||
"the fiber's dispatch function, or the value from the next yield call in fiber."));
|
"the fiber's dispatch function, or the value from the next yield call in fiber."));
|
||||||
janet_quick_asm(env, JANET_FUN_GET, "get", 2, 2, get_asm, sizeof(get_asm),
|
janet_quick_asm(env, JANET_FUN_GET,
|
||||||
|
"get", 2, 2, 2, 2, get_asm, sizeof(get_asm),
|
||||||
JDOC("(get ds key)\n\n"
|
JDOC("(get ds key)\n\n"
|
||||||
"Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, "
|
"Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, "
|
||||||
"symbols, and buffers are all associative and can be used with get. Order structures, name "
|
"symbols, and buffers are all associative and can be used with get. Order structures, name "
|
||||||
"arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can "
|
"arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can "
|
||||||
"take any value as a key except nil and return a value except nil. Byte sequences will return "
|
"take any value as a key except nil and return a value except nil. Byte sequences will return "
|
||||||
"integer representations of bytes as result of a get call."));
|
"integer representations of bytes as result of a get call."));
|
||||||
janet_quick_asm(env, JANET_FUN_PUT, "put", 3, 3, put_asm, sizeof(put_asm),
|
janet_quick_asm(env, JANET_FUN_PUT,
|
||||||
|
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
|
||||||
JDOC("(put ds key value)\n\n"
|
JDOC("(put ds key value)\n\n"
|
||||||
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
|
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
|
||||||
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
|
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
|
||||||
@@ -636,11 +912,13 @@ JanetTable *janet_core_env(void) {
|
|||||||
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
|
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
|
||||||
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
|
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
|
||||||
"a value nil into a table will remove the key from the table. Returns the data structure ds."));
|
"a value nil into a table will remove the key from the table. Returns the data structure ds."));
|
||||||
janet_quick_asm(env, JANET_FUN_LENGTH, "length", 1, 1, length_asm, sizeof(length_asm),
|
janet_quick_asm(env, JANET_FUN_LENGTH,
|
||||||
|
"length", 1, 1, 1, 1, length_asm, sizeof(length_asm),
|
||||||
JDOC("(length ds)\n\n"
|
JDOC("(length ds)\n\n"
|
||||||
"Returns the length or count of a data structure in constant time as an integer. For "
|
"Returns the length or count of a data structure in constant time as an integer. For "
|
||||||
"structs and tables, returns the number of key-value pairs in the data structure."));
|
"structs and tables, returns the number of key-value pairs in the data structure."));
|
||||||
janet_quick_asm(env, JANET_FUN_BNOT, "bnot", 1, 1, bnot_asm, sizeof(bnot_asm),
|
janet_quick_asm(env, JANET_FUN_BNOT,
|
||||||
|
"bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm),
|
||||||
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
|
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
|
||||||
make_apply(env);
|
make_apply(env);
|
||||||
|
|
||||||
@@ -731,6 +1009,9 @@ JanetTable *janet_core_env(void) {
|
|||||||
JDOC("The version number of the running janet program."));
|
JDOC("The version number of the running janet program."));
|
||||||
janet_def(env, "janet/build", janet_cstringv(JANET_BUILD),
|
janet_def(env, "janet/build", janet_cstringv(JANET_BUILD),
|
||||||
JDOC("The build identifier of the running janet program."));
|
JDOC("The build identifier of the running janet program."));
|
||||||
|
janet_def(env, "janet/config-bits", janet_wrap_integer(JANET_CURRENT_CONFIG_BITS),
|
||||||
|
JDOC("The flag set of config options from janetconf.h which is used to check "
|
||||||
|
"if native modules are compatible with the host program."));
|
||||||
|
|
||||||
/* Allow references to the environment */
|
/* Allow references to the environment */
|
||||||
janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope."));
|
janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope."));
|
||||||
@@ -753,29 +1034,27 @@ JanetTable *janet_core_env(void) {
|
|||||||
janet_lib_debug(env);
|
janet_lib_debug(env);
|
||||||
janet_lib_string(env);
|
janet_lib_string(env);
|
||||||
janet_lib_marsh(env);
|
janet_lib_marsh(env);
|
||||||
|
#ifdef JANET_PEG
|
||||||
janet_lib_peg(env);
|
janet_lib_peg(env);
|
||||||
|
#endif
|
||||||
#ifdef JANET_ASSEMBLER
|
#ifdef JANET_ASSEMBLER
|
||||||
janet_lib_asm(env);
|
janet_lib_asm(env);
|
||||||
#endif
|
#endif
|
||||||
|
#ifdef JANET_TYPED_ARRAY
|
||||||
|
janet_lib_typed_array(env);
|
||||||
|
#endif
|
||||||
|
#ifdef JANET_INT_TYPES
|
||||||
|
janet_lib_inttypes(env);
|
||||||
|
#endif
|
||||||
|
|
||||||
#ifdef JANET_BOOTSTRAP
|
#ifndef JANET_BOOTSTRAP
|
||||||
/* Run bootstrap source */
|
|
||||||
janet_dobytes(env, janet_gen_core, janet_gen_core_size, "core.janet", NULL);
|
|
||||||
#else
|
|
||||||
|
|
||||||
/* Unmarshal from core image */
|
/* Unmarshal from core image */
|
||||||
Janet marsh_out;
|
Janet marsh_out = janet_unmarshal(
|
||||||
int status = janet_unmarshal(
|
|
||||||
janet_core_image,
|
janet_core_image,
|
||||||
janet_core_image_size,
|
janet_core_image_size,
|
||||||
0,
|
0,
|
||||||
&marsh_out,
|
|
||||||
env,
|
env,
|
||||||
NULL);
|
NULL);
|
||||||
if (status) {
|
|
||||||
printf("error unmarshaling core image\n");
|
|
||||||
exit(1);
|
|
||||||
}
|
|
||||||
janet_gcroot(marsh_out);
|
janet_gcroot(marsh_out);
|
||||||
env = janet_unwrap_table(marsh_out);
|
env = janet_unwrap_table(marsh_out);
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -21,7 +21,7 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
@@ -54,7 +54,7 @@ void janet_debug_find(
|
|||||||
JanetFuncDef **def_out, int32_t *pc_out,
|
JanetFuncDef **def_out, int32_t *pc_out,
|
||||||
const uint8_t *source, int32_t offset) {
|
const uint8_t *source, int32_t offset) {
|
||||||
/* Scan the heap for right func def */
|
/* Scan the heap for right func def */
|
||||||
JanetGCMemoryHeader *current = janet_vm_blocks;
|
JanetGCObject *current = janet_vm_blocks;
|
||||||
/* Keep track of the best source mapping we have seen so far */
|
/* Keep track of the best source mapping we have seen so far */
|
||||||
int32_t besti = -1;
|
int32_t besti = -1;
|
||||||
int32_t best_range = INT32_MAX;
|
int32_t best_range = INT32_MAX;
|
||||||
@@ -95,6 +95,7 @@ void janet_debug_find(
|
|||||||
* consitency with the top level code it is defined once. */
|
* consitency with the top level code it is defined once. */
|
||||||
void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
||||||
int32_t fi;
|
int32_t fi;
|
||||||
|
FILE *out = janet_dynfile("err", stderr);
|
||||||
const char *errstr = (const char *)janet_to_string(err);
|
const char *errstr = (const char *)janet_to_string(err);
|
||||||
JanetFiber **fibers = NULL;
|
JanetFiber **fibers = NULL;
|
||||||
int wrote_error = 0;
|
int wrote_error = 0;
|
||||||
@@ -116,43 +117,43 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
|||||||
if (!wrote_error) {
|
if (!wrote_error) {
|
||||||
JanetFiberStatus status = janet_fiber_status(fiber);
|
JanetFiberStatus status = janet_fiber_status(fiber);
|
||||||
const char *prefix = status == JANET_STATUS_ERROR ? "" : "status ";
|
const char *prefix = status == JANET_STATUS_ERROR ? "" : "status ";
|
||||||
fprintf(stderr, "%s%s: %s\n",
|
fprintf(out, "%s%s: %s\n",
|
||||||
prefix,
|
prefix,
|
||||||
janet_status_names[status],
|
janet_status_names[status],
|
||||||
errstr);
|
errstr);
|
||||||
wrote_error = 1;
|
wrote_error = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
fprintf(stderr, " in");
|
fprintf(out, " in");
|
||||||
|
|
||||||
if (frame->func) {
|
if (frame->func) {
|
||||||
def = frame->func->def;
|
def = frame->func->def;
|
||||||
fprintf(stderr, " %s", def->name ? (const char *)def->name : "<anonymous>");
|
fprintf(out, " %s", def->name ? (const char *)def->name : "<anonymous>");
|
||||||
if (def->source) {
|
if (def->source) {
|
||||||
fprintf(stderr, " [%s]", (const char *)def->source);
|
fprintf(out, " [%s]", (const char *)def->source);
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
||||||
if (cfun) {
|
if (cfun) {
|
||||||
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
||||||
if (!janet_checktype(name, JANET_NIL))
|
if (!janet_checktype(name, JANET_NIL))
|
||||||
fprintf(stderr, " %s", (const char *)janet_to_string(name));
|
fprintf(out, " %s", (const char *)janet_to_string(name));
|
||||||
else
|
else
|
||||||
fprintf(stderr, " <cfunction>");
|
fprintf(out, " <cfunction>");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
||||||
fprintf(stderr, " (tailcall)");
|
fprintf(out, " (tailcall)");
|
||||||
if (frame->func && frame->pc) {
|
if (frame->func && frame->pc) {
|
||||||
int32_t off = (int32_t)(frame->pc - def->bytecode);
|
int32_t off = (int32_t)(frame->pc - def->bytecode);
|
||||||
if (def->sourcemap) {
|
if (def->sourcemap) {
|
||||||
JanetSourceMapping mapping = def->sourcemap[off];
|
JanetSourceMapping mapping = def->sourcemap[off];
|
||||||
fprintf(stderr, " at (%d:%d)", mapping.start, mapping.end);
|
fprintf(out, " at (%d:%d)", mapping.start, mapping.end);
|
||||||
} else {
|
} else {
|
||||||
fprintf(stderr, " pc=%d", off);
|
fprintf(out, " pc=%d", off);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
fprintf(stderr, "\n");
|
fprintf(out, "\n");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -192,7 +193,7 @@ static Janet cfun_debug_break(int32_t argc, Janet *argv) {
|
|||||||
|
|
||||||
static Janet cfun_debug_unbreak(int32_t argc, Janet *argv) {
|
static Janet cfun_debug_unbreak(int32_t argc, Janet *argv) {
|
||||||
JanetFuncDef *def;
|
JanetFuncDef *def;
|
||||||
int32_t offset;
|
int32_t offset = 0;
|
||||||
helper_find(argc, argv, &def, &offset);
|
helper_find(argc, argv, &def, &offset);
|
||||||
janet_debug_unbreak(def, offset);
|
janet_debug_unbreak(def, offset);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
@@ -200,7 +201,7 @@ static Janet cfun_debug_unbreak(int32_t argc, Janet *argv) {
|
|||||||
|
|
||||||
static Janet cfun_debug_fbreak(int32_t argc, Janet *argv) {
|
static Janet cfun_debug_fbreak(int32_t argc, Janet *argv) {
|
||||||
JanetFuncDef *def;
|
JanetFuncDef *def;
|
||||||
int32_t offset;
|
int32_t offset = 0;
|
||||||
helper_find_fun(argc, argv, &def, &offset);
|
helper_find_fun(argc, argv, &def, &offset);
|
||||||
janet_debug_break(def, offset);
|
janet_debug_break(def, offset);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
@@ -322,14 +323,14 @@ static const JanetReg debug_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"debug/fbreak", cfun_debug_fbreak,
|
"debug/fbreak", cfun_debug_fbreak,
|
||||||
JDOC("(debug/fbreak fun [,pc=0])\n\n"
|
JDOC("(debug/fbreak fun &opt pc)\n\n"
|
||||||
"Set a breakpoint in a given function. pc is an optional offset, which "
|
"Set a breakpoint in a given function. pc is an optional offset, which "
|
||||||
"is in bytecode instructions. fun is a function value. Will throw an error "
|
"is in bytecode instructions. fun is a function value. Will throw an error "
|
||||||
"if the offset is too large or negative.")
|
"if the offset is too large or negative.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"debug/unfbreak", cfun_debug_unfbreak,
|
"debug/unfbreak", cfun_debug_unfbreak,
|
||||||
JDOC("(debug/unfbreak fun [,pc=0])\n\n"
|
JDOC("(debug/unfbreak fun &opt pc)\n\n"
|
||||||
"Unset a breakpoint set with debug/fbreak.")
|
"Unset a breakpoint set with debug/fbreak.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
|
|||||||
@@ -21,7 +21,7 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "emit.h"
|
#include "emit.h"
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
#include "regalloc.h"
|
#include "regalloc.h"
|
||||||
@@ -78,27 +78,26 @@ static void janetc_loadconst(JanetCompiler *c, Janet k, int32_t reg) {
|
|||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
janetc_emit(c, (reg << 8) | JOP_LOAD_NIL);
|
janetc_emit(c, (reg << 8) | JOP_LOAD_NIL);
|
||||||
break;
|
break;
|
||||||
case JANET_TRUE:
|
case JANET_BOOLEAN:
|
||||||
janetc_emit(c, (reg << 8) | JOP_LOAD_TRUE);
|
janetc_emit(c, (reg << 8) |
|
||||||
|
(janet_unwrap_boolean(k) ? JOP_LOAD_TRUE : JOP_LOAD_FALSE));
|
||||||
break;
|
break;
|
||||||
case JANET_FALSE:
|
case JANET_NUMBER: {
|
||||||
janetc_emit(c, (reg << 8) | JOP_LOAD_FALSE);
|
|
||||||
break;
|
|
||||||
case JANET_NUMBER:
|
|
||||||
{
|
|
||||||
double dval = janet_unwrap_number(k);
|
double dval = janet_unwrap_number(k);
|
||||||
int32_t i = (int32_t) dval;
|
if (dval < INT16_MIN || dval > INT16_MAX)
|
||||||
if (dval != i || !(dval >= INT16_MIN && dval <= INT16_MAX))
|
|
||||||
goto do_constant;
|
goto do_constant;
|
||||||
|
int32_t i = (int32_t) dval;
|
||||||
|
if (dval != i)
|
||||||
|
goto do_constant;
|
||||||
|
uint32_t iu = (uint32_t)i;
|
||||||
janetc_emit(c,
|
janetc_emit(c,
|
||||||
(i << 16) |
|
(iu << 16) |
|
||||||
(reg << 8) |
|
(reg << 8) |
|
||||||
JOP_LOAD_INTEGER);
|
JOP_LOAD_INTEGER);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
default:
|
default:
|
||||||
do_constant:
|
do_constant: {
|
||||||
{
|
|
||||||
int32_t cindex = janetc_const(c, k);
|
int32_t cindex = janetc_const(c, k);
|
||||||
janetc_emit(c,
|
janetc_emit(c,
|
||||||
(cindex << 16) |
|
(cindex << 16) |
|
||||||
@@ -240,11 +239,11 @@ void janetc_copy(
|
|||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
/* Process: src -> near -> dest */
|
/* Process: src -> near -> dest */
|
||||||
int32_t near = janetc_allocnear(c, JANETC_REGTEMP_3);
|
int32_t nearreg = janetc_allocnear(c, JANETC_REGTEMP_3);
|
||||||
janetc_movenear(c, near, src);
|
janetc_movenear(c, nearreg, src);
|
||||||
janetc_moveback(c, dest, near);
|
janetc_moveback(c, dest, nearreg);
|
||||||
/* Cleanup */
|
/* Cleanup */
|
||||||
janetc_regalloc_freetemp(&c->scope->ra, near, JANETC_REGTEMP_3);
|
janetc_regalloc_freetemp(&c->scope->ra, nearreg, JANETC_REGTEMP_3);
|
||||||
|
|
||||||
}
|
}
|
||||||
/* Instruction templated emitters */
|
/* Instruction templated emitters */
|
||||||
@@ -252,7 +251,7 @@ void janetc_copy(
|
|||||||
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {
|
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {
|
||||||
int32_t reg = janetc_regnear(c, s, JANETC_REGTEMP_0);
|
int32_t reg = janetc_regnear(c, s, JANETC_REGTEMP_0);
|
||||||
int32_t label = janet_v_count(c->buffer);
|
int32_t label = janet_v_count(c->buffer);
|
||||||
janetc_emit(c, op | (reg << 8) | (rest << 16));
|
janetc_emit(c, op | (reg << 8) | ((uint32_t)rest << 16));
|
||||||
if (wr)
|
if (wr)
|
||||||
janetc_moveback(c, s, reg);
|
janetc_moveback(c, s, reg);
|
||||||
janetc_free_regnear(c, s, reg, JANETC_REGTEMP_0);
|
janetc_free_regnear(c, s, reg, JANETC_REGTEMP_0);
|
||||||
@@ -294,7 +293,7 @@ static int32_t emit2s(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2,
|
|||||||
int32_t reg1 = janetc_regnear(c, s1, JANETC_REGTEMP_0);
|
int32_t reg1 = janetc_regnear(c, s1, JANETC_REGTEMP_0);
|
||||||
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
|
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
|
||||||
int32_t label = janet_v_count(c->buffer);
|
int32_t label = janet_v_count(c->buffer);
|
||||||
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | (rest << 24));
|
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | ((uint32_t)rest << 24));
|
||||||
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
|
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
|
||||||
if (wr)
|
if (wr)
|
||||||
janetc_moveback(c, s1, reg1);
|
janetc_moveback(c, s1, reg1);
|
||||||
@@ -327,7 +326,7 @@ int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2
|
|||||||
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
|
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
|
||||||
int32_t reg3 = janetc_regnear(c, s3, JANETC_REGTEMP_2);
|
int32_t reg3 = janetc_regnear(c, s3, JANETC_REGTEMP_2);
|
||||||
int32_t label = janet_v_count(c->buffer);
|
int32_t label = janet_v_count(c->buffer);
|
||||||
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | (reg3 << 24));
|
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | ((uint32_t)reg3 << 24));
|
||||||
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
|
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
|
||||||
janetc_free_regnear(c, s3, reg3, JANETC_REGTEMP_2);
|
janetc_free_regnear(c, s3, reg3, JANETC_REGTEMP_2);
|
||||||
if (wr)
|
if (wr)
|
||||||
|
|||||||
116
src/core/fiber.c
116
src/core/fiber.c
@@ -21,7 +21,7 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "fiber.h"
|
#include "fiber.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
@@ -35,6 +35,7 @@ static void fiber_reset(JanetFiber *fiber) {
|
|||||||
fiber->stacktop = JANET_FRAME_SIZE;
|
fiber->stacktop = JANET_FRAME_SIZE;
|
||||||
fiber->child = NULL;
|
fiber->child = NULL;
|
||||||
fiber->flags = JANET_FIBER_MASK_YIELD;
|
fiber->flags = JANET_FIBER_MASK_YIELD;
|
||||||
|
fiber->env = NULL;
|
||||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -126,6 +127,16 @@ void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) {
|
|||||||
fiber->stacktop = newtop;
|
fiber->stacktop = newtop;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Create a struct with n values. If n is odd, the last value is ignored. */
|
||||||
|
static Janet make_struct_n(const Janet *args, int32_t n) {
|
||||||
|
int32_t i = 0;
|
||||||
|
JanetKV *st = janet_struct_begin(n & (~1));
|
||||||
|
for (; i < n; i += 2) {
|
||||||
|
janet_struct_put(st, args[i], args[i + 1]);
|
||||||
|
}
|
||||||
|
return janet_wrap_struct(janet_struct_end(st));
|
||||||
|
}
|
||||||
|
|
||||||
/* Push a stack frame to a fiber */
|
/* Push a stack frame to a fiber */
|
||||||
int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||||
JanetStackFrame *newframe;
|
JanetStackFrame *newframe;
|
||||||
@@ -138,11 +149,8 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
|||||||
int32_t next_arity = fiber->stacktop - fiber->stackstart;
|
int32_t next_arity = fiber->stacktop - fiber->stackstart;
|
||||||
|
|
||||||
/* Check strict arity before messing with state */
|
/* Check strict arity before messing with state */
|
||||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
if (next_arity < func->def->min_arity) return 1;
|
||||||
if (func->def->arity != next_arity) {
|
if (next_arity > func->def->max_arity) return 1;
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
if (fiber->capacity < nextstacktop) {
|
if (fiber->capacity < nextstacktop) {
|
||||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||||
@@ -166,10 +174,17 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
|||||||
/* Check varargs */
|
/* Check varargs */
|
||||||
if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||||
int32_t tuplehead = fiber->frame + func->def->arity;
|
int32_t tuplehead = fiber->frame + func->def->arity;
|
||||||
|
int st = func->def->flags & JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||||
if (tuplehead >= oldtop) {
|
if (tuplehead >= oldtop) {
|
||||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
fiber->data[tuplehead] = st
|
||||||
|
? make_struct_n(NULL, 0)
|
||||||
|
: janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
||||||
} else {
|
} else {
|
||||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
|
fiber->data[tuplehead] = st
|
||||||
|
? make_struct_n(
|
||||||
|
fiber->data + tuplehead,
|
||||||
|
oldtop - tuplehead)
|
||||||
|
: janet_wrap_tuple(janet_tuple_n(
|
||||||
fiber->data + tuplehead,
|
fiber->data + tuplehead,
|
||||||
oldtop - tuplehead));
|
oldtop - tuplehead));
|
||||||
}
|
}
|
||||||
@@ -204,11 +219,8 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
|||||||
int32_t stacksize;
|
int32_t stacksize;
|
||||||
|
|
||||||
/* Check strict arity before messing with state */
|
/* Check strict arity before messing with state */
|
||||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
if (next_arity < func->def->min_arity) return 1;
|
||||||
if (func->def->arity != next_arity) {
|
if (next_arity > func->def->max_arity) return 1;
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
if (fiber->capacity < nextstacktop) {
|
if (fiber->capacity < nextstacktop) {
|
||||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||||
@@ -225,12 +237,19 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
|||||||
/* Check varargs */
|
/* Check varargs */
|
||||||
if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||||
int32_t tuplehead = fiber->stackstart + func->def->arity;
|
int32_t tuplehead = fiber->stackstart + func->def->arity;
|
||||||
|
int st = func->def->flags & JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||||
if (tuplehead >= fiber->stacktop) {
|
if (tuplehead >= fiber->stacktop) {
|
||||||
if (tuplehead >= fiber->capacity) janet_fiber_setcapacity(fiber, 2 * (tuplehead + 1));
|
if (tuplehead >= fiber->capacity) janet_fiber_setcapacity(fiber, 2 * (tuplehead + 1));
|
||||||
for (i = fiber->stacktop; i < tuplehead; ++i) fiber->data[i] = janet_wrap_nil();
|
for (i = fiber->stacktop; i < tuplehead; ++i) fiber->data[i] = janet_wrap_nil();
|
||||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
fiber->data[tuplehead] = st
|
||||||
|
? make_struct_n(NULL, 0)
|
||||||
|
: janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
||||||
} else {
|
} else {
|
||||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
|
fiber->data[tuplehead] = st
|
||||||
|
? make_struct_n(
|
||||||
|
fiber->data + tuplehead,
|
||||||
|
fiber->stacktop - tuplehead)
|
||||||
|
: janet_wrap_tuple(janet_tuple_n(
|
||||||
fiber->data + tuplehead,
|
fiber->data + tuplehead,
|
||||||
fiber->stacktop - tuplehead));
|
fiber->stacktop - tuplehead));
|
||||||
}
|
}
|
||||||
@@ -297,17 +316,42 @@ void janet_fiber_popframe(JanetFiber *fiber) {
|
|||||||
fiber->frame = frame->prevframe;
|
fiber->frame = frame->prevframe;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
JanetFiberStatus janet_fiber_status(JanetFiber *f) {
|
||||||
|
return ((f)->flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET;
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetFiber *janet_current_fiber(void) {
|
||||||
|
return janet_vm_fiber;
|
||||||
|
}
|
||||||
|
|
||||||
/* CFuns */
|
/* CFuns */
|
||||||
|
|
||||||
|
static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
|
return fiber->env ?
|
||||||
|
janet_wrap_table(fiber->env) :
|
||||||
|
janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_fiber_setenv(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 2);
|
||||||
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
|
if (janet_checktype(argv[1], JANET_NIL)) {
|
||||||
|
fiber->env = NULL;
|
||||||
|
} else {
|
||||||
|
fiber->env = janet_gettable(argv, 1);
|
||||||
|
}
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
JanetFunction *func = janet_getfunction(argv, 0);
|
JanetFunction *func = janet_getfunction(argv, 0);
|
||||||
JanetFiber *fiber;
|
JanetFiber *fiber;
|
||||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
if (func->def->min_arity != 0) {
|
||||||
if (func->def->arity != 0) {
|
|
||||||
janet_panic("expected nullary function in fiber constructor");
|
janet_panic("expected nullary function in fiber constructor");
|
||||||
}
|
}
|
||||||
}
|
|
||||||
fiber = janet_fiber(func, 64, 0, NULL);
|
fiber = janet_fiber(func, 64, 0, NULL);
|
||||||
if (argc == 2) {
|
if (argc == 2) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
@@ -341,6 +385,19 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
|||||||
case 'y':
|
case 'y':
|
||||||
fiber->flags |= JANET_FIBER_MASK_YIELD;
|
fiber->flags |= JANET_FIBER_MASK_YIELD;
|
||||||
break;
|
break;
|
||||||
|
case 'i':
|
||||||
|
if (!janet_vm_fiber->env) {
|
||||||
|
janet_vm_fiber->env = janet_table(0);
|
||||||
|
}
|
||||||
|
fiber->env = janet_vm_fiber->env;
|
||||||
|
break;
|
||||||
|
case 'p':
|
||||||
|
if (!janet_vm_fiber->env) {
|
||||||
|
janet_vm_fiber->env = janet_table(0);
|
||||||
|
}
|
||||||
|
fiber->env = janet_table(0);
|
||||||
|
fiber->env->proto = janet_vm_fiber->env;
|
||||||
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -351,8 +408,7 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
|||||||
static Janet cfun_fiber_status(int32_t argc, Janet *argv) {
|
static Janet cfun_fiber_status(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
uint32_t s = (fiber->flags & JANET_FIBER_STATUS_MASK) >>
|
uint32_t s = janet_fiber_status(fiber);
|
||||||
JANET_FIBER_STATUS_OFFSET;
|
|
||||||
return janet_ckeywordv(janet_status_names[s]);
|
return janet_ckeywordv(janet_status_names[s]);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -382,7 +438,7 @@ static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
|
|||||||
static const JanetReg fiber_cfuns[] = {
|
static const JanetReg fiber_cfuns[] = {
|
||||||
{
|
{
|
||||||
"fiber/new", cfun_fiber_new,
|
"fiber/new", cfun_fiber_new,
|
||||||
JDOC("(fiber/new func [,sigmask])\n\n"
|
JDOC("(fiber/new func &opt sigmask)\n\n"
|
||||||
"Create a new fiber with function body func. Can optionally "
|
"Create a new fiber with function body func. Can optionally "
|
||||||
"take a set of signals to block from the current parent fiber "
|
"take a set of signals to block from the current parent fiber "
|
||||||
"when called. The mask is specified as a keyword where each character "
|
"when called. The mask is specified as a keyword where each character "
|
||||||
@@ -396,7 +452,11 @@ static const JanetReg fiber_cfuns[] = {
|
|||||||
"\te - block error signals\n"
|
"\te - block error signals\n"
|
||||||
"\tu - block user signals\n"
|
"\tu - block user signals\n"
|
||||||
"\ty - block yield signals\n"
|
"\ty - block yield signals\n"
|
||||||
"\t0-9 - block a specific user signal")
|
"\t0-9 - block a specific user signal\n\n"
|
||||||
|
"The sigmask argument also can take environment flags. If any mutually "
|
||||||
|
"exclusive flags are present, the last flag takes precedence.\n\n"
|
||||||
|
"\ti - inherit the environment from the current fiber\n"
|
||||||
|
"\tp - the environment table's prototype is the current environment table")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"fiber/status", cfun_fiber_status,
|
"fiber/status", cfun_fiber_status,
|
||||||
@@ -428,6 +488,18 @@ static const JanetReg fiber_cfuns[] = {
|
|||||||
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
||||||
"maximum stack size is usually 8192.")
|
"maximum stack size is usually 8192.")
|
||||||
},
|
},
|
||||||
|
{
|
||||||
|
"fiber/getenv", cfun_fiber_getenv,
|
||||||
|
JDOC("(fiber/getenv fiber)\n\n"
|
||||||
|
"Gets the environment for a fiber. Returns nil if no such table is "
|
||||||
|
"set yet.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"fiber/setenv", cfun_fiber_setenv,
|
||||||
|
JDOC("(fiber/setenv fiber table)\n\n"
|
||||||
|
"Sets the environment table for a fiber. Set to nil to remove the current "
|
||||||
|
"environment.")
|
||||||
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|||||||
@@ -24,7 +24,7 @@
|
|||||||
#define JANET_FIBER_H_defined
|
#define JANET_FIBER_H_defined
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||||
|
|||||||
199
src/core/gc.c
199
src/core/gc.c
@@ -21,10 +21,11 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "symcache.h"
|
#include "symcache.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* GC State */
|
/* GC State */
|
||||||
@@ -38,6 +39,11 @@ JANET_THREAD_LOCAL Janet *janet_vm_roots;
|
|||||||
JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
|
JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
|
||||||
JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
|
JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
|
||||||
|
|
||||||
|
/* Scratch Memory */
|
||||||
|
JANET_THREAD_LOCAL void **janet_scratch_mem;
|
||||||
|
JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||||
|
JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||||
|
|
||||||
/* Helpers for marking the various gc types */
|
/* Helpers for marking the various gc types */
|
||||||
static void janet_mark_funcenv(JanetFuncEnv *env);
|
static void janet_mark_funcenv(JanetFuncEnv *env);
|
||||||
static void janet_mark_funcdef(JanetFuncDef *def);
|
static void janet_mark_funcdef(JanetFuncDef *def);
|
||||||
@@ -60,18 +66,37 @@ void janet_mark(Janet x) {
|
|||||||
if (depth) {
|
if (depth) {
|
||||||
depth--;
|
depth--;
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
default: break;
|
default:
|
||||||
|
break;
|
||||||
case JANET_STRING:
|
case JANET_STRING:
|
||||||
case JANET_KEYWORD:
|
case JANET_KEYWORD:
|
||||||
case JANET_SYMBOL: janet_mark_string(janet_unwrap_string(x)); break;
|
case JANET_SYMBOL:
|
||||||
case JANET_FUNCTION: janet_mark_function(janet_unwrap_function(x)); break;
|
janet_mark_string(janet_unwrap_string(x));
|
||||||
case JANET_ARRAY: janet_mark_array(janet_unwrap_array(x)); break;
|
break;
|
||||||
case JANET_TABLE: janet_mark_table(janet_unwrap_table(x)); break;
|
case JANET_FUNCTION:
|
||||||
case JANET_STRUCT: janet_mark_struct(janet_unwrap_struct(x)); break;
|
janet_mark_function(janet_unwrap_function(x));
|
||||||
case JANET_TUPLE: janet_mark_tuple(janet_unwrap_tuple(x)); break;
|
break;
|
||||||
case JANET_BUFFER: janet_mark_buffer(janet_unwrap_buffer(x)); break;
|
case JANET_ARRAY:
|
||||||
case JANET_FIBER: janet_mark_fiber(janet_unwrap_fiber(x)); break;
|
janet_mark_array(janet_unwrap_array(x));
|
||||||
case JANET_ABSTRACT: janet_mark_abstract(janet_unwrap_abstract(x)); break;
|
break;
|
||||||
|
case JANET_TABLE:
|
||||||
|
janet_mark_table(janet_unwrap_table(x));
|
||||||
|
break;
|
||||||
|
case JANET_STRUCT:
|
||||||
|
janet_mark_struct(janet_unwrap_struct(x));
|
||||||
|
break;
|
||||||
|
case JANET_TUPLE:
|
||||||
|
janet_mark_tuple(janet_unwrap_tuple(x));
|
||||||
|
break;
|
||||||
|
case JANET_BUFFER:
|
||||||
|
janet_mark_buffer(janet_unwrap_buffer(x));
|
||||||
|
break;
|
||||||
|
case JANET_FIBER:
|
||||||
|
janet_mark_fiber(janet_unwrap_fiber(x));
|
||||||
|
break;
|
||||||
|
case JANET_ABSTRACT:
|
||||||
|
janet_mark_abstract(janet_unwrap_abstract(x));
|
||||||
|
break;
|
||||||
}
|
}
|
||||||
depth++;
|
depth++;
|
||||||
} else {
|
} else {
|
||||||
@@ -80,7 +105,7 @@ void janet_mark(Janet x) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_string(const uint8_t *str) {
|
static void janet_mark_string(const uint8_t *str) {
|
||||||
janet_gc_mark(janet_string_raw(str));
|
janet_gc_mark(janet_string_head(str));
|
||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_buffer(JanetBuffer *buffer) {
|
static void janet_mark_buffer(JanetBuffer *buffer) {
|
||||||
@@ -88,11 +113,11 @@ static void janet_mark_buffer(JanetBuffer *buffer) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_abstract(void *adata) {
|
static void janet_mark_abstract(void *adata) {
|
||||||
if (janet_gc_reachable(janet_abstract_header(adata)))
|
if (janet_gc_reachable(janet_abstract_head(adata)))
|
||||||
return;
|
return;
|
||||||
janet_gc_mark(janet_abstract_header(adata));
|
janet_gc_mark(janet_abstract_head(adata));
|
||||||
if (janet_abstract_header(adata)->type->gcmark) {
|
if (janet_abstract_head(adata)->type->gcmark) {
|
||||||
janet_abstract_header(adata)->type->gcmark(adata, janet_abstract_size(adata));
|
janet_abstract_head(adata)->type->gcmark(adata, janet_abstract_size(adata));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -135,16 +160,16 @@ static void janet_mark_table(JanetTable *table) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_struct(const JanetKV *st) {
|
static void janet_mark_struct(const JanetKV *st) {
|
||||||
if (janet_gc_reachable(janet_struct_raw(st)))
|
if (janet_gc_reachable(janet_struct_head(st)))
|
||||||
return;
|
return;
|
||||||
janet_gc_mark(janet_struct_raw(st));
|
janet_gc_mark(janet_struct_head(st));
|
||||||
janet_mark_kvs(st, janet_struct_capacity(st));
|
janet_mark_kvs(st, janet_struct_capacity(st));
|
||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_tuple(const Janet *tuple) {
|
static void janet_mark_tuple(const Janet *tuple) {
|
||||||
if (janet_gc_reachable(janet_tuple_raw(tuple)))
|
if (janet_gc_reachable(janet_tuple_head(tuple)))
|
||||||
return;
|
return;
|
||||||
janet_gc_mark(janet_tuple_raw(tuple));
|
janet_gc_mark(janet_tuple_head(tuple));
|
||||||
janet_mark_many(tuple, janet_tuple_length(tuple));
|
janet_mark_many(tuple, janet_tuple_length(tuple));
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -217,6 +242,9 @@ recur:
|
|||||||
i = frame->prevframe;
|
i = frame->prevframe;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if (fiber->env)
|
||||||
|
janet_mark_table(fiber->env);
|
||||||
|
|
||||||
/* Explicit tail recursion */
|
/* Explicit tail recursion */
|
||||||
if (fiber->child) {
|
if (fiber->child) {
|
||||||
fiber = fiber->child;
|
fiber = fiber->child;
|
||||||
@@ -225,21 +253,19 @@ recur:
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Deinitialize a block of memory */
|
/* Deinitialize a block of memory */
|
||||||
static void janet_deinit_block(JanetGCMemoryHeader *block) {
|
static void janet_deinit_block(JanetGCObject *mem) {
|
||||||
void *mem = ((char *)(block + 1));
|
switch (mem->flags & JANET_MEM_TYPEBITS) {
|
||||||
JanetAbstractHeader *h = (JanetAbstractHeader *)mem;
|
|
||||||
switch (block->flags & JANET_MEM_TYPEBITS) {
|
|
||||||
default:
|
default:
|
||||||
case JANET_MEMORY_FUNCTION:
|
case JANET_MEMORY_FUNCTION:
|
||||||
break; /* Do nothing for non gc types */
|
break; /* Do nothing for non gc types */
|
||||||
case JANET_MEMORY_SYMBOL:
|
case JANET_MEMORY_SYMBOL:
|
||||||
janet_symbol_deinit((const uint8_t *)mem + 2 * sizeof(int32_t));
|
janet_symbol_deinit(((JanetStringHead *) mem)->data);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_ARRAY:
|
case JANET_MEMORY_ARRAY:
|
||||||
janet_array_deinit((JanetArray*) mem);
|
free(((JanetArray *) mem)->data);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_TABLE:
|
case JANET_MEMORY_TABLE:
|
||||||
janet_table_deinit((JanetTable*) mem);
|
free(((JanetTable *) mem)->data);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_FIBER:
|
case JANET_MEMORY_FIBER:
|
||||||
free(((JanetFiber *)mem)->data);
|
free(((JanetFiber *)mem)->data);
|
||||||
@@ -247,20 +273,20 @@ static void janet_deinit_block(JanetGCMemoryHeader *block) {
|
|||||||
case JANET_MEMORY_BUFFER:
|
case JANET_MEMORY_BUFFER:
|
||||||
janet_buffer_deinit((JanetBuffer *) mem);
|
janet_buffer_deinit((JanetBuffer *) mem);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_ABSTRACT:
|
case JANET_MEMORY_ABSTRACT: {
|
||||||
if (h->type->gc) {
|
JanetAbstractHead *head = (JanetAbstractHead *)mem;
|
||||||
janet_assert(!h->type->gc((void *)(h + 1), h->size), "finalizer failed");
|
if (head->type->gc) {
|
||||||
|
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
||||||
|
}
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_FUNCENV:
|
case JANET_MEMORY_FUNCENV: {
|
||||||
{
|
|
||||||
JanetFuncEnv *env = (JanetFuncEnv *)mem;
|
JanetFuncEnv *env = (JanetFuncEnv *)mem;
|
||||||
if (0 == env->offset)
|
if (0 == env->offset)
|
||||||
free(env->as.values);
|
free(env->as.values);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_FUNCDEF:
|
case JANET_MEMORY_FUNCDEF: {
|
||||||
{
|
|
||||||
JanetFuncDef *def = (JanetFuncDef *)mem;
|
JanetFuncDef *def = (JanetFuncDef *)mem;
|
||||||
/* TODO - get this all with one alloc and one free */
|
/* TODO - get this all with one alloc and one free */
|
||||||
free(def->defs);
|
free(def->defs);
|
||||||
@@ -276,9 +302,9 @@ static void janet_deinit_block(JanetGCMemoryHeader *block) {
|
|||||||
/* Iterate over all allocated memory, and free memory that is not
|
/* Iterate over all allocated memory, and free memory that is not
|
||||||
* marked as reachable. Flip the gc color flag for next sweep. */
|
* marked as reachable. Flip the gc color flag for next sweep. */
|
||||||
void janet_sweep() {
|
void janet_sweep() {
|
||||||
JanetGCMemoryHeader *previous = NULL;
|
JanetGCObject *previous = NULL;
|
||||||
JanetGCMemoryHeader *current = janet_vm_blocks;
|
JanetGCObject *current = janet_vm_blocks;
|
||||||
JanetGCMemoryHeader *next;
|
JanetGCObject *next;
|
||||||
while (NULL != current) {
|
while (NULL != current) {
|
||||||
next = current->next;
|
next = current->next;
|
||||||
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
||||||
@@ -299,29 +325,33 @@ void janet_sweep() {
|
|||||||
|
|
||||||
/* Allocate some memory that is tracked for garbage collection */
|
/* Allocate some memory that is tracked for garbage collection */
|
||||||
void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||||
JanetGCMemoryHeader *mdata;
|
JanetGCObject *mem;
|
||||||
size_t total = size + sizeof(JanetGCMemoryHeader);
|
|
||||||
|
|
||||||
/* Make sure everything is inited */
|
/* Make sure everything is inited */
|
||||||
janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
|
janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
|
||||||
void *mem = malloc(total);
|
mem = malloc(size);
|
||||||
|
|
||||||
/* Check for bad malloc */
|
/* Check for bad malloc */
|
||||||
if (NULL == mem) {
|
if (NULL == mem) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
|
|
||||||
mdata = (JanetGCMemoryHeader *)mem;
|
|
||||||
|
|
||||||
/* Configure block */
|
/* Configure block */
|
||||||
mdata->flags = type;
|
mem->flags = type;
|
||||||
|
|
||||||
/* Prepend block to heap list */
|
/* Prepend block to heap list */
|
||||||
janet_vm_next_collection += (int32_t) size;
|
janet_vm_next_collection += (int32_t) size;
|
||||||
mdata->next = janet_vm_blocks;
|
mem->next = janet_vm_blocks;
|
||||||
janet_vm_blocks = mdata;
|
janet_vm_blocks = mem;
|
||||||
|
|
||||||
return (char *) mem + sizeof(JanetGCMemoryHeader);
|
return (void *)mem;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Free all allocated scratch memory */
|
||||||
|
static void janet_free_all_scratch(void) {
|
||||||
|
for (size_t i = 0; i < janet_scratch_len; i++)
|
||||||
|
free(janet_scratch_mem[i]);
|
||||||
|
janet_scratch_len = 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Run garbage collection */
|
/* Run garbage collection */
|
||||||
@@ -338,6 +368,7 @@ void janet_collect(void) {
|
|||||||
}
|
}
|
||||||
janet_sweep();
|
janet_sweep();
|
||||||
janet_vm_next_collection = 0;
|
janet_vm_next_collection = 0;
|
||||||
|
janet_free_all_scratch();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Add a root value to the GC. This prevents the GC from removing a value
|
/* Add a root value to the GC. This prevents the GC from removing a value
|
||||||
@@ -362,8 +393,7 @@ static int janet_gc_idequals(Janet lhs, Janet rhs) {
|
|||||||
if (janet_type(lhs) != janet_type(rhs))
|
if (janet_type(lhs) != janet_type(rhs))
|
||||||
return 0;
|
return 0;
|
||||||
switch (janet_type(lhs)) {
|
switch (janet_type(lhs)) {
|
||||||
case JANET_TRUE:
|
case JANET_BOOLEAN:
|
||||||
case JANET_FALSE:
|
|
||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
case JANET_NUMBER:
|
case JANET_NUMBER:
|
||||||
/* These values don't really matter to the gc so returning 1 all the time is fine. */
|
/* These values don't really matter to the gc so returning 1 all the time is fine. */
|
||||||
@@ -377,9 +407,8 @@ static int janet_gc_idequals(Janet lhs, Janet rhs) {
|
|||||||
* a value and all its children. */
|
* a value and all its children. */
|
||||||
int janet_gcunroot(Janet root) {
|
int janet_gcunroot(Janet root) {
|
||||||
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
||||||
Janet *v = janet_vm_roots;
|
|
||||||
/* Search from top to bottom as access is most likely LIFO */
|
/* Search from top to bottom as access is most likely LIFO */
|
||||||
for (v = janet_vm_roots; v < vtop; v++) {
|
for (Janet *v = janet_vm_roots; v < vtop; v++) {
|
||||||
if (janet_gc_idequals(root, *v)) {
|
if (janet_gc_idequals(root, *v)) {
|
||||||
*v = janet_vm_roots[--janet_vm_root_count];
|
*v = janet_vm_roots[--janet_vm_root_count];
|
||||||
return 1;
|
return 1;
|
||||||
@@ -391,10 +420,9 @@ int janet_gcunroot(Janet root) {
|
|||||||
/* Remove a root value from the GC. This sets the effective reference count to 0. */
|
/* Remove a root value from the GC. This sets the effective reference count to 0. */
|
||||||
int janet_gcunrootall(Janet root) {
|
int janet_gcunrootall(Janet root) {
|
||||||
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
||||||
Janet *v = janet_vm_roots;
|
|
||||||
int ret = 0;
|
int ret = 0;
|
||||||
/* Search from top to bottom as access is most likely LIFO */
|
/* Search from top to bottom as access is most likely LIFO */
|
||||||
for (v = janet_vm_roots; v < vtop; v++) {
|
for (Janet *v = janet_vm_roots; v < vtop; v++) {
|
||||||
if (janet_gc_idequals(root, *v)) {
|
if (janet_gc_idequals(root, *v)) {
|
||||||
*v = janet_vm_roots[--janet_vm_root_count];
|
*v = janet_vm_roots[--janet_vm_root_count];
|
||||||
vtop--;
|
vtop--;
|
||||||
@@ -406,16 +434,75 @@ int janet_gcunrootall(Janet root) {
|
|||||||
|
|
||||||
/* Free all allocated memory */
|
/* Free all allocated memory */
|
||||||
void janet_clear_memory(void) {
|
void janet_clear_memory(void) {
|
||||||
JanetGCMemoryHeader *current = janet_vm_blocks;
|
JanetGCObject *current = janet_vm_blocks;
|
||||||
while (NULL != current) {
|
while (NULL != current) {
|
||||||
janet_deinit_block(current);
|
janet_deinit_block(current);
|
||||||
JanetGCMemoryHeader *next = current->next;
|
JanetGCObject *next = current->next;
|
||||||
free(current);
|
free(current);
|
||||||
current = next;
|
current = next;
|
||||||
}
|
}
|
||||||
janet_vm_blocks = NULL;
|
janet_vm_blocks = NULL;
|
||||||
|
janet_free_all_scratch();
|
||||||
|
free(janet_scratch_mem);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Primitives for suspending GC. */
|
/* Primitives for suspending GC. */
|
||||||
int janet_gclock(void) { return janet_vm_gc_suspend++; }
|
int janet_gclock(void) {
|
||||||
void janet_gcunlock(int handle) { janet_vm_gc_suspend = handle; }
|
return janet_vm_gc_suspend++;
|
||||||
|
}
|
||||||
|
void janet_gcunlock(int handle) {
|
||||||
|
janet_vm_gc_suspend = handle;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Scratch memory API */
|
||||||
|
|
||||||
|
void *janet_smalloc(size_t size) {
|
||||||
|
void *mem = malloc(size);
|
||||||
|
if (NULL == mem) {
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
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 *));
|
||||||
|
if (NULL == newmem) {
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
janet_scratch_cap = newcap;
|
||||||
|
janet_scratch_mem = newmem;
|
||||||
|
}
|
||||||
|
janet_scratch_mem[janet_scratch_len++] = mem;
|
||||||
|
return mem;
|
||||||
|
}
|
||||||
|
|
||||||
|
void *janet_srealloc(void *mem, size_t size) {
|
||||||
|
if (NULL == mem) return janet_smalloc(size);
|
||||||
|
if (janet_scratch_len) {
|
||||||
|
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||||
|
if (janet_scratch_mem[i] == mem) {
|
||||||
|
void *newmem = realloc(mem, size);
|
||||||
|
if (NULL == newmem) {
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
janet_scratch_mem[i] = newmem;
|
||||||
|
return newmem;
|
||||||
|
}
|
||||||
|
if (i == 0) break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_exit("invalid janet_srealloc");
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_sfree(void *mem) {
|
||||||
|
if (NULL == mem) return;
|
||||||
|
if (janet_scratch_len) {
|
||||||
|
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||||
|
if (janet_scratch_mem[i] == mem) {
|
||||||
|
janet_scratch_mem[i] = janet_scratch_mem[--janet_scratch_len];
|
||||||
|
free(mem);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
if (i == 0) break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_exit("invalid janet_sfree");
|
||||||
|
}
|
||||||
|
|||||||
@@ -24,11 +24,11 @@
|
|||||||
#define JANET_GC_H
|
#define JANET_GC_H
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* The metadata header associated with an allocated block of memory */
|
/* The metadata header associated with an allocated block of memory */
|
||||||
#define janet_gc_header(mem) ((JanetGCMemoryHeader *)(mem) - 1)
|
#define janet_gc_header(mem) ((JanetGCObject *)(mem))
|
||||||
|
|
||||||
#define JANET_MEM_TYPEBITS 0xFF
|
#define JANET_MEM_TYPEBITS 0xFF
|
||||||
#define JANET_MEM_REACHABLE 0x100
|
#define JANET_MEM_REACHABLE 0x100
|
||||||
@@ -40,13 +40,6 @@
|
|||||||
#define janet_gc_mark(m) (janet_gc_header(m)->flags |= JANET_MEM_REACHABLE)
|
#define janet_gc_mark(m) (janet_gc_header(m)->flags |= JANET_MEM_REACHABLE)
|
||||||
#define janet_gc_reachable(m) (janet_gc_header(m)->flags & JANET_MEM_REACHABLE)
|
#define janet_gc_reachable(m) (janet_gc_header(m)->flags & JANET_MEM_REACHABLE)
|
||||||
|
|
||||||
/* Memory header struct. Node of a linked list of memory blocks. */
|
|
||||||
typedef struct JanetGCMemoryHeader JanetGCMemoryHeader;
|
|
||||||
struct JanetGCMemoryHeader {
|
|
||||||
JanetGCMemoryHeader *next;
|
|
||||||
uint32_t flags;
|
|
||||||
};
|
|
||||||
|
|
||||||
/* Memory types for the GC. Different from JanetType to include funcenv and funcdef. */
|
/* Memory types for the GC. Different from JanetType to include funcenv and funcdef. */
|
||||||
enum JanetMemoryType {
|
enum JanetMemoryType {
|
||||||
JANET_MEMORY_NONE,
|
JANET_MEMORY_NONE,
|
||||||
|
|||||||
386
src/core/inttypes.c
Normal file
386
src/core/inttypes.c
Normal file
@@ -0,0 +1,386 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 Calvin Rose & contributors
|
||||||
|
*
|
||||||
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
* of this software and associated documentation files (the "Software"), to
|
||||||
|
* deal in the Software without restriction, including without limitation the
|
||||||
|
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||||
|
* sell copies of the Software, and to permit persons to whom the Software is
|
||||||
|
* furnished to do so, subject to the following conditions:
|
||||||
|
*
|
||||||
|
* The above copyright notice and this permission notice shall be included in
|
||||||
|
* all copies or substantial portions of the Software.
|
||||||
|
*
|
||||||
|
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||||
|
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
|
* IN THE SOFTWARE.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#include <errno.h>
|
||||||
|
#include <stdlib.h>
|
||||||
|
#include <limits.h>
|
||||||
|
#include <inttypes.h>
|
||||||
|
#include <math.h>
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Conditional compilation */
|
||||||
|
#ifdef JANET_INT_TYPES
|
||||||
|
|
||||||
|
#define MAX_INT_IN_DBL 9007199254740992ULL /* 2^53 */
|
||||||
|
|
||||||
|
static Janet it_s64_get(void *p, Janet key);
|
||||||
|
static Janet it_u64_get(void *p, Janet key);
|
||||||
|
|
||||||
|
static void int64_marshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
janet_marshal_int64(ctx, *((int64_t *)p));
|
||||||
|
}
|
||||||
|
|
||||||
|
static void int64_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
*((int64_t *)p) = janet_unmarshal_int64(ctx);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void it_s64_tostring(void *p, JanetBuffer *buffer) {
|
||||||
|
char str[32];
|
||||||
|
sprintf(str, "<core/s64 %" PRId64 ">", *((int64_t *)p));
|
||||||
|
janet_buffer_push_cstring(buffer, str);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void it_u64_tostring(void *p, JanetBuffer *buffer) {
|
||||||
|
char str[32];
|
||||||
|
sprintf(str, "<core/u64 %" PRIu64 ">", *((uint64_t *)p));
|
||||||
|
janet_buffer_push_cstring(buffer, str);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetAbstractType it_s64_type = {
|
||||||
|
"core/s64",
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
it_s64_get,
|
||||||
|
NULL,
|
||||||
|
int64_marshal,
|
||||||
|
int64_unmarshal,
|
||||||
|
it_s64_tostring
|
||||||
|
};
|
||||||
|
|
||||||
|
static const JanetAbstractType it_u64_type = {
|
||||||
|
"core/u64",
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
it_u64_get,
|
||||||
|
NULL,
|
||||||
|
int64_marshal,
|
||||||
|
int64_unmarshal,
|
||||||
|
it_u64_tostring
|
||||||
|
};
|
||||||
|
|
||||||
|
int64_t janet_unwrap_s64(Janet x) {
|
||||||
|
switch (janet_type(x)) {
|
||||||
|
default:
|
||||||
|
break;
|
||||||
|
case JANET_NUMBER : {
|
||||||
|
double dbl = janet_unwrap_number(x);
|
||||||
|
if (fabs(dbl) <= MAX_INT_IN_DBL)
|
||||||
|
return (int64_t)dbl;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_STRING: {
|
||||||
|
int64_t value;
|
||||||
|
const uint8_t *str = janet_unwrap_string(x);
|
||||||
|
if (janet_scan_int64(str, janet_string_length(str), &value))
|
||||||
|
return value;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_ABSTRACT: {
|
||||||
|
void *abst = janet_unwrap_abstract(x);
|
||||||
|
if (janet_abstract_type(abst) == &it_s64_type ||
|
||||||
|
(janet_abstract_type(abst) == &it_u64_type))
|
||||||
|
return *(int64_t *)abst;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_panic("bad s64 initializer");
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint64_t janet_unwrap_u64(Janet x) {
|
||||||
|
switch (janet_type(x)) {
|
||||||
|
default:
|
||||||
|
break;
|
||||||
|
case JANET_NUMBER : {
|
||||||
|
double dbl = janet_unwrap_number(x);
|
||||||
|
if ((dbl >= 0) && (dbl <= MAX_INT_IN_DBL))
|
||||||
|
return (uint64_t)dbl;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_STRING: {
|
||||||
|
uint64_t value;
|
||||||
|
const uint8_t *str = janet_unwrap_string(x);
|
||||||
|
if (janet_scan_uint64(str, janet_string_length(str), &value))
|
||||||
|
return value;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_ABSTRACT: {
|
||||||
|
void *abst = janet_unwrap_abstract(x);
|
||||||
|
if (janet_abstract_type(abst) == &it_s64_type ||
|
||||||
|
(janet_abstract_type(abst) == &it_u64_type))
|
||||||
|
return *(uint64_t *)abst;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_panic("bad u64 initializer");
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetIntType janet_is_int(Janet x) {
|
||||||
|
if (!janet_checktype(x, JANET_ABSTRACT)) return JANET_INT_NONE;
|
||||||
|
const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x));
|
||||||
|
return (at == &it_s64_type) ? JANET_INT_S64 :
|
||||||
|
((at == &it_u64_type) ? JANET_INT_U64 :
|
||||||
|
JANET_INT_NONE);
|
||||||
|
}
|
||||||
|
|
||||||
|
Janet janet_wrap_s64(int64_t x) {
|
||||||
|
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
|
||||||
|
*box = (int64_t)x;
|
||||||
|
return janet_wrap_abstract(box);
|
||||||
|
}
|
||||||
|
|
||||||
|
Janet janet_wrap_u64(uint64_t x) {
|
||||||
|
uint64_t *box = janet_abstract(&it_u64_type, sizeof(uint64_t));
|
||||||
|
*box = (uint64_t)x;
|
||||||
|
return janet_wrap_abstract(box);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_it_s64_new(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
return janet_wrap_s64(janet_unwrap_s64(argv[0]));
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
|
||||||
|
}
|
||||||
|
|
||||||
|
#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)); \
|
||||||
|
*box = janet_unwrap_##type(argv[0]); \
|
||||||
|
for (int 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]); \
|
||||||
|
return janet_wrap_abstract(box); \
|
||||||
|
}
|
||||||
|
|
||||||
|
#define DIVMETHOD(T, type, name, oper) \
|
||||||
|
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||||
|
janet_arity(argc, 2, -1); \
|
||||||
|
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||||
|
*box = janet_unwrap_##type(argv[0]); \
|
||||||
|
for (int i = 1; i < argc; i++) { \
|
||||||
|
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; \
|
||||||
|
} \
|
||||||
|
return janet_wrap_abstract(box); \
|
||||||
|
}
|
||||||
|
|
||||||
|
#define DIVMETHOD_SIGNED(T, type, name, oper) \
|
||||||
|
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||||
|
janet_arity(argc, 2, -1); \
|
||||||
|
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||||
|
*box = janet_unwrap_##type(argv[0]); \
|
||||||
|
for (int i = 1; i < argc; i++) { \
|
||||||
|
T value = janet_unwrap_##type(argv[i]); \
|
||||||
|
if (value == 0) janet_panic("division by zero"); \
|
||||||
|
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||||
|
*box oper##= value; \
|
||||||
|
} \
|
||||||
|
return janet_wrap_abstract(box); \
|
||||||
|
} \
|
||||||
|
\
|
||||||
|
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
|
||||||
|
janet_arity(argc, 2, -1); \
|
||||||
|
T *box = janet_getabstract(argv,0,&it_##type##_type); \
|
||||||
|
for (int i = 1; i < argc; i++) { \
|
||||||
|
T value = janet_unwrap_##type(argv[i]); \
|
||||||
|
if (value == 0) janet_panic("division by zero"); \
|
||||||
|
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||||
|
*box oper##= value; \
|
||||||
|
} \
|
||||||
|
return janet_wrap_abstract(box); \
|
||||||
|
}
|
||||||
|
|
||||||
|
#define COMPMETHOD(T, type, name, oper) \
|
||||||
|
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||||
|
janet_fixarity(argc, 2); \
|
||||||
|
T v1 = janet_unwrap_##type(argv[0]); \
|
||||||
|
T v2 = janet_unwrap_##type(argv[1]); \
|
||||||
|
return janet_wrap_boolean(v1 oper v2); \
|
||||||
|
}
|
||||||
|
|
||||||
|
OPMETHOD(int64_t, s64, add, +)
|
||||||
|
OPMETHOD(int64_t, s64, sub, -)
|
||||||
|
OPMETHOD(int64_t, s64, mul, *)
|
||||||
|
DIVMETHOD_SIGNED(int64_t, s64, div, /)
|
||||||
|
DIVMETHOD_SIGNED(int64_t, s64, mod, %)
|
||||||
|
OPMETHOD(int64_t, s64, and, &)
|
||||||
|
OPMETHOD(int64_t, s64, or, |)
|
||||||
|
OPMETHOD(int64_t, s64, xor, ^)
|
||||||
|
OPMETHOD(int64_t, s64, lshift, <<)
|
||||||
|
OPMETHOD(int64_t, s64, rshift, >>)
|
||||||
|
COMPMETHOD(int64_t, s64, lt, <)
|
||||||
|
COMPMETHOD(int64_t, s64, gt, >)
|
||||||
|
COMPMETHOD(int64_t, s64, le, <=)
|
||||||
|
COMPMETHOD(int64_t, s64, ge, >=)
|
||||||
|
COMPMETHOD(int64_t, s64, eq, ==)
|
||||||
|
COMPMETHOD(int64_t, s64, ne, !=)
|
||||||
|
|
||||||
|
OPMETHOD(uint64_t, u64, add, +)
|
||||||
|
OPMETHOD(uint64_t, u64, sub, -)
|
||||||
|
OPMETHOD(uint64_t, u64, mul, *)
|
||||||
|
DIVMETHOD(uint64_t, u64, div, /)
|
||||||
|
DIVMETHOD(uint64_t, u64, mod, %)
|
||||||
|
OPMETHOD(uint64_t, u64, and, &)
|
||||||
|
OPMETHOD(uint64_t, u64, or, |)
|
||||||
|
OPMETHOD(uint64_t, u64, xor, ^)
|
||||||
|
OPMETHOD(uint64_t, u64, lshift, <<)
|
||||||
|
OPMETHOD(uint64_t, u64, rshift, >>)
|
||||||
|
COMPMETHOD(uint64_t, u64, lt, <)
|
||||||
|
COMPMETHOD(uint64_t, u64, gt, >)
|
||||||
|
COMPMETHOD(uint64_t, u64, le, <=)
|
||||||
|
COMPMETHOD(uint64_t, u64, ge, >=)
|
||||||
|
COMPMETHOD(uint64_t, u64, eq, ==)
|
||||||
|
COMPMETHOD(uint64_t, u64, ne, !=)
|
||||||
|
|
||||||
|
#undef OPMETHOD
|
||||||
|
#undef DIVMETHOD
|
||||||
|
#undef DIVMETHOD_SIGNED
|
||||||
|
#undef COMPMETHOD
|
||||||
|
|
||||||
|
static JanetMethod it_s64_methods[] = {
|
||||||
|
{"+", cfun_it_s64_add},
|
||||||
|
{"-", cfun_it_s64_sub},
|
||||||
|
{"*", cfun_it_s64_mul},
|
||||||
|
{"/", cfun_it_s64_div},
|
||||||
|
{"%", cfun_it_s64_mod},
|
||||||
|
{"<", cfun_it_s64_lt},
|
||||||
|
{">", cfun_it_s64_gt},
|
||||||
|
{"<=", cfun_it_s64_le},
|
||||||
|
{">=", cfun_it_s64_ge},
|
||||||
|
{"==", cfun_it_s64_eq},
|
||||||
|
{"!=", cfun_it_s64_ne},
|
||||||
|
{"&", cfun_it_s64_and},
|
||||||
|
{"|", cfun_it_s64_or},
|
||||||
|
{"^", 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},
|
||||||
|
{"-", cfun_it_u64_sub},
|
||||||
|
{"*", cfun_it_u64_mul},
|
||||||
|
{"/", cfun_it_u64_div},
|
||||||
|
{"%", cfun_it_u64_mod},
|
||||||
|
{"<", cfun_it_u64_lt},
|
||||||
|
{">", cfun_it_u64_gt},
|
||||||
|
{"<=", cfun_it_u64_le},
|
||||||
|
{">=", cfun_it_u64_ge},
|
||||||
|
{"==", cfun_it_u64_eq},
|
||||||
|
{"!=", cfun_it_u64_ne},
|
||||||
|
{"&", cfun_it_u64_and},
|
||||||
|
{"|", cfun_it_u64_or},
|
||||||
|
{"^", 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}
|
||||||
|
};
|
||||||
|
|
||||||
|
static Janet it_s64_get(void *p, Janet key) {
|
||||||
|
(void) p;
|
||||||
|
if (!janet_checktype(key, JANET_KEYWORD))
|
||||||
|
janet_panicf("expected keyword, got %v", key);
|
||||||
|
return janet_getmethod(janet_unwrap_keyword(key), it_s64_methods);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet it_u64_get(void *p, Janet key) {
|
||||||
|
(void) p;
|
||||||
|
if (!janet_checktype(key, JANET_KEYWORD))
|
||||||
|
janet_panicf("expected keyword, got %v", key);
|
||||||
|
return janet_getmethod(janet_unwrap_keyword(key), it_u64_methods);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg it_cfuns[] = {
|
||||||
|
{
|
||||||
|
"int/s64", cfun_it_s64_new,
|
||||||
|
JDOC("(int/s64 value)\n\n"
|
||||||
|
"Create a boxed signed 64 bit integer from a string value.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"int/u64", cfun_it_u64_new,
|
||||||
|
JDOC("(int/u64 value)\n\n"
|
||||||
|
"Create a boxed unsigned 64 bit integer from a string value.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
/* 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);
|
||||||
|
}
|
||||||
|
|
||||||
|
#endif
|
||||||
125
src/core/io.c
125
src/core/io.c
@@ -28,10 +28,14 @@
|
|||||||
#include <errno.h>
|
#include <errno.h>
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
#ifndef JANET_WINDOWS
|
||||||
|
#include <sys/wait.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
#define IO_WRITE 1
|
#define IO_WRITE 1
|
||||||
#define IO_READ 2
|
#define IO_READ 2
|
||||||
#define IO_APPEND 4
|
#define IO_APPEND 4
|
||||||
@@ -56,6 +60,9 @@ JanetAbstractType cfun_io_filetype = {
|
|||||||
cfun_io_gc,
|
cfun_io_gc,
|
||||||
NULL,
|
NULL,
|
||||||
io_file_get,
|
io_file_get,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
NULL
|
NULL
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -157,7 +164,37 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
|||||||
return f ? makef(f, flags) : janet_wrap_nil();
|
return f ? makef(f, flags) : janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Read up to n bytes into buffer. Return error string if error. */
|
static Janet cfun_io_fdopen(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 2);
|
||||||
|
const int fd = janet_getinteger(argv, 0);
|
||||||
|
const uint8_t *fmode;
|
||||||
|
int flags;
|
||||||
|
if (argc == 2) {
|
||||||
|
fmode = janet_getkeyword(argv, 1);
|
||||||
|
flags = checkflags(fmode);
|
||||||
|
} else {
|
||||||
|
fmode = (const uint8_t *)"r";
|
||||||
|
flags = IO_READ;
|
||||||
|
}
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
#define fdopen _fdopen
|
||||||
|
#endif
|
||||||
|
FILE *f = fdopen(fd, (const char *)fmode);
|
||||||
|
return f ? makef(f, flags) : janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_io_fileno(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||||
|
if (iof->flags & IO_CLOSED)
|
||||||
|
janet_panic("file is closed");
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
#define fileno _fileno
|
||||||
|
#endif
|
||||||
|
return janet_wrap_integer(fileno(iof->file));
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Read up to n bytes into buffer. */
|
||||||
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||||
if (!(iof->flags & (IO_READ | IO_UPDATE)))
|
if (!(iof->flags & (IO_READ | IO_UPDATE)))
|
||||||
janet_panic("file is not readable");
|
janet_panic("file is not readable");
|
||||||
@@ -180,6 +217,7 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
|||||||
} else {
|
} else {
|
||||||
buffer = janet_getbuffer(argv, 2);
|
buffer = janet_getbuffer(argv, 2);
|
||||||
}
|
}
|
||||||
|
int32_t bufstart = buffer->count;
|
||||||
if (janet_checktype(argv[1], JANET_KEYWORD)) {
|
if (janet_checktype(argv[1], JANET_KEYWORD)) {
|
||||||
const uint8_t *sym = janet_unwrap_keyword(argv[1]);
|
const uint8_t *sym = janet_unwrap_keyword(argv[1]);
|
||||||
if (!janet_cstrcmp(sym, "all")) {
|
if (!janet_cstrcmp(sym, "all")) {
|
||||||
@@ -198,9 +236,14 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
|||||||
if (fsize < 0) {
|
if (fsize < 0) {
|
||||||
janet_panicf("could not get file size of %v", argv[0]);
|
janet_panicf("could not get file size of %v", argv[0]);
|
||||||
}
|
}
|
||||||
|
if (fsize > (INT32_MAX)) {
|
||||||
|
janet_panic("file to large to read into buffer");
|
||||||
|
}
|
||||||
fseek(iof->file, 0, SEEK_SET);
|
fseek(iof->file, 0, SEEK_SET);
|
||||||
read_chunk(iof, buffer, (int32_t) fsize);
|
read_chunk(iof, buffer, (int32_t) fsize);
|
||||||
}
|
}
|
||||||
|
/* Never return nil for :all */
|
||||||
|
return janet_wrap_buffer(buffer);
|
||||||
} else if (!janet_cstrcmp(sym, "line")) {
|
} else if (!janet_cstrcmp(sym, "line")) {
|
||||||
for (;;) {
|
for (;;) {
|
||||||
int x = fgetc(iof->file);
|
int x = fgetc(iof->file);
|
||||||
@@ -215,6 +258,7 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
|||||||
if (len < 0) janet_panic("expected positive integer");
|
if (len < 0) janet_panic("expected positive integer");
|
||||||
read_chunk(iof, buffer, len);
|
read_chunk(iof, buffer, len);
|
||||||
}
|
}
|
||||||
|
if (bufstart == buffer->count) return janet_wrap_nil();
|
||||||
return janet_wrap_buffer(buffer);
|
return janet_wrap_buffer(buffer);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -275,13 +319,17 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
|||||||
if (iof->flags & IO_PIPED) {
|
if (iof->flags & IO_PIPED) {
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
#define pclose _pclose
|
#define pclose _pclose
|
||||||
|
#define WEXITSTATUS(x) x
|
||||||
#endif
|
#endif
|
||||||
if (pclose(iof->file)) janet_panic("could not close file");
|
int status = pclose(iof->file);
|
||||||
|
iof->flags |= IO_CLOSED;
|
||||||
|
if (status == -1) janet_panic("could not close file");
|
||||||
|
return janet_wrap_integer(WEXITSTATUS(status));
|
||||||
} else {
|
} else {
|
||||||
if (fclose(iof->file)) janet_panic("could not close file");
|
if (fclose(iof->file)) janet_panic("could not close file");
|
||||||
}
|
|
||||||
iof->flags |= IO_CLOSED;
|
iof->flags |= IO_CLOSED;
|
||||||
return argv[0];
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Seek a file */
|
/* Seek a file */
|
||||||
@@ -327,10 +375,40 @@ static Janet io_file_get(void *p, Janet key) {
|
|||||||
return janet_getmethod(janet_unwrap_keyword(key), io_file_methods);
|
return janet_getmethod(janet_unwrap_keyword(key), io_file_methods);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
FILE *janet_dynfile(const char *name, FILE *def) {
|
||||||
|
Janet x = janet_dyn(name);
|
||||||
|
if (!janet_checktype(x, JANET_ABSTRACT)) return def;
|
||||||
|
void *abstract = janet_unwrap_abstract(x);
|
||||||
|
if (janet_abstract_type(abstract) != &cfun_io_filetype) return def;
|
||||||
|
IOFile *iofile = abstract;
|
||||||
|
return iofile->file;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_io_print(int32_t argc, Janet *argv) {
|
||||||
|
FILE *f = janet_dynfile("out", stdout);
|
||||||
|
for (int32_t i = 0; i < argc; ++i) {
|
||||||
|
int32_t j, len;
|
||||||
|
const uint8_t *vstr = janet_to_string(argv[i]);
|
||||||
|
len = janet_string_length(vstr);
|
||||||
|
for (j = 0; j < len; ++j) {
|
||||||
|
putc(vstr[j], f);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
putc('\n', f);
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
static const JanetReg io_cfuns[] = {
|
static const JanetReg io_cfuns[] = {
|
||||||
|
{
|
||||||
|
"print", cfun_io_print,
|
||||||
|
JDOC("(print & xs)\n\n"
|
||||||
|
"Print values to the console (standard out). Value are converted "
|
||||||
|
"to strings if they are not already. After printing all values, a "
|
||||||
|
"newline character is printed. Returns nil.")
|
||||||
|
},
|
||||||
{
|
{
|
||||||
"file/open", cfun_io_fopen,
|
"file/open", cfun_io_fopen,
|
||||||
JDOC("(file/open path [,mode])\n\n"
|
JDOC("(file/open path &opt mode)\n\n"
|
||||||
"Open a file. path is an absolute or relative path, and "
|
"Open a file. path is an absolute or relative path, and "
|
||||||
"mode is a set of flags indicating the mode to open the file in. "
|
"mode is a set of flags indicating the mode to open the file in. "
|
||||||
"mode is a keyword where each character represents a flag. If the file "
|
"mode is a keyword where each character represents a flag. If the file "
|
||||||
@@ -342,6 +420,26 @@ static const JanetReg io_cfuns[] = {
|
|||||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||||
"\t+ - append to the file instead of overwriting it")
|
"\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,
|
"file/close", cfun_io_fclose,
|
||||||
JDOC("(file/close f)\n\n"
|
JDOC("(file/close f)\n\n"
|
||||||
@@ -351,7 +449,7 @@ static const JanetReg io_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"file/read", cfun_io_fread,
|
"file/read", cfun_io_fread,
|
||||||
JDOC("(file/read f what [,buf])\n\n"
|
JDOC("(file/read f what &opt buf)\n\n"
|
||||||
"Read a number of bytes from a file into a buffer. A buffer can "
|
"Read a number of bytes from a file into a buffer. A buffer can "
|
||||||
"be provided as an optional fourth argument, otherwise a new buffer "
|
"be provided as an optional fourth argument, otherwise a new buffer "
|
||||||
"is created. 'what' can either be an integer or a keyword. Returns the "
|
"is created. 'what' can either be an integer or a keyword. Returns the "
|
||||||
@@ -375,7 +473,7 @@ static const JanetReg io_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"file/seek", cfun_io_fseek,
|
"file/seek", cfun_io_fseek,
|
||||||
JDOC("(file/seek f [,whence [,n]])\n\n"
|
JDOC("(file/seek f &opt whence n)\n\n"
|
||||||
"Jump to a relative location in the file. 'whence' must be one of\n\n"
|
"Jump to a relative location in the file. 'whence' must be one of\n\n"
|
||||||
"\t:cur - jump relative to the current file location\n"
|
"\t:cur - jump relative to the current file location\n"
|
||||||
"\t:set - jump relative to the beginning of the file\n"
|
"\t:set - jump relative to the beginning of the file\n"
|
||||||
@@ -386,7 +484,7 @@ static const JanetReg io_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"file/popen", cfun_io_popen,
|
"file/popen", cfun_io_popen,
|
||||||
JDOC("(file/popen path [,mode])\n\n"
|
JDOC("(file/popen path &opt mode)\n\n"
|
||||||
"Open a file that is backed by a process. The file must be opened in either "
|
"Open a file that is backed by a process. The file must be opened in either "
|
||||||
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
|
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
|
||||||
"process can be read from the file. In :w mode, the stdin of the process "
|
"process can be read from the file. In :w mode, the stdin of the process "
|
||||||
@@ -395,6 +493,14 @@ static const JanetReg io_cfuns[] = {
|
|||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
/* C API */
|
||||||
|
|
||||||
|
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
|
||||||
|
IOFile *iof = janet_getabstract(argv, n, &cfun_io_filetype);
|
||||||
|
if (NULL != flags) *flags = iof->flags;
|
||||||
|
return iof->file;
|
||||||
|
}
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
void janet_lib_io(JanetTable *env) {
|
void janet_lib_io(JanetTable *env) {
|
||||||
janet_core_cfuns(env, NULL, io_cfuns);
|
janet_core_cfuns(env, NULL, io_cfuns);
|
||||||
@@ -411,4 +517,5 @@ void janet_lib_io(JanetTable *env) {
|
|||||||
janet_core_def(env, "stdin",
|
janet_core_def(env, "stdin",
|
||||||
makef(stdin, IO_READ | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
makef(stdin, IO_READ | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||||
JDOC("The standard input file."));
|
JDOC("The standard input file."));
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|||||||
555
src/core/marsh.c
555
src/core/marsh.c
File diff suppressed because it is too large
Load Diff
@@ -23,7 +23,7 @@
|
|||||||
#include <math.h>
|
#include <math.h>
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
|||||||
754
src/core/os.c
754
src/core/os.c
@@ -21,21 +21,35 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#include <stdlib.h>
|
#include <stdlib.h>
|
||||||
|
|
||||||
|
#ifndef JANET_REDUCED_OS
|
||||||
|
|
||||||
#include <time.h>
|
#include <time.h>
|
||||||
|
#include <fcntl.h>
|
||||||
|
#include <errno.h>
|
||||||
|
#include <stdio.h>
|
||||||
|
#include <string.h>
|
||||||
|
#include <sys/stat.h>
|
||||||
|
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
#include <Windows.h>
|
#include <windows.h>
|
||||||
#include <direct.h>
|
#include <direct.h>
|
||||||
|
#include <sys/utime.h>
|
||||||
|
#include <io.h>
|
||||||
|
#include <process.h>
|
||||||
#else
|
#else
|
||||||
|
#include <spawn.h>
|
||||||
|
#include <utime.h>
|
||||||
#include <unistd.h>
|
#include <unistd.h>
|
||||||
|
#include <dirent.h>
|
||||||
#include <sys/types.h>
|
#include <sys/types.h>
|
||||||
#include <sys/wait.h>
|
#include <sys/wait.h>
|
||||||
#include <stdio.h>
|
extern char **environ;
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* For macos */
|
/* For macos */
|
||||||
@@ -44,6 +58,12 @@
|
|||||||
#include <mach/mach.h>
|
#include <mach/mach.h>
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
#endif /* JANET_REDCUED_OS */
|
||||||
|
|
||||||
|
/* Core OS functions */
|
||||||
|
|
||||||
|
/* Full OS functions */
|
||||||
|
|
||||||
static Janet os_which(int32_t argc, Janet *argv) {
|
static Janet os_which(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
(void) argv;
|
(void) argv;
|
||||||
@@ -58,100 +78,253 @@ static Janet os_which(int32_t argc, Janet *argv) {
|
|||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
#ifdef JANET_WINDOWS
|
static Janet os_exit(int32_t argc, Janet *argv) {
|
||||||
static Janet os_execute(int32_t argc, Janet *argv) {
|
janet_arity(argc, 0, 1);
|
||||||
janet_arity(argc, 1, -1);
|
if (argc == 0) {
|
||||||
JanetBuffer *buffer = janet_buffer(10);
|
exit(EXIT_SUCCESS);
|
||||||
for (int32_t i = 0; i < argc; i++) {
|
} else if (janet_checkint(argv[0])) {
|
||||||
const uint8_t *argstring = janet_getstring(argv, i);
|
exit(janet_unwrap_integer(argv[0]));
|
||||||
janet_buffer_push_bytes(buffer, argstring, janet_string_length(argstring));
|
} else {
|
||||||
if (i != argc - 1) {
|
exit(EXIT_FAILURE);
|
||||||
janet_buffer_push_u8(buffer, ' ');
|
|
||||||
}
|
}
|
||||||
}
|
return janet_wrap_nil();
|
||||||
janet_buffer_push_u8(buffer, 0);
|
|
||||||
|
|
||||||
/* Convert to wide chars */
|
|
||||||
wchar_t *sys_str = malloc(buffer->count * sizeof(wchar_t));
|
|
||||||
if (NULL == sys_str) {
|
|
||||||
JANET_OUT_OF_MEMORY;
|
|
||||||
}
|
|
||||||
int nwritten = MultiByteToWideChar(
|
|
||||||
CP_UTF8,
|
|
||||||
MB_PRECOMPOSED,
|
|
||||||
buffer->data,
|
|
||||||
buffer->count,
|
|
||||||
sys_str,
|
|
||||||
buffer->count);
|
|
||||||
if (nwritten == 0) {
|
|
||||||
free(sys_str);
|
|
||||||
janet_panic("could not create process");
|
|
||||||
}
|
}
|
||||||
|
|
||||||
STARTUPINFO si;
|
#ifdef JANET_REDUCED_OS
|
||||||
PROCESS_INFORMATION pi;
|
/* Provide a dud os/getenv so boot.janet and init.janet work, but nothing else */
|
||||||
|
|
||||||
ZeroMemory(&si, sizeof(si));
|
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||||
si.cb = sizeof(si);
|
(void) argv;
|
||||||
ZeroMemory(&pi, sizeof(pi));
|
janet_fixarity(argc, 1);
|
||||||
|
return janet_wrap_nil();
|
||||||
// Start the child process.
|
|
||||||
if(!CreateProcess(NULL,
|
|
||||||
(LPSTR) sys_str,
|
|
||||||
NULL,
|
|
||||||
NULL,
|
|
||||||
FALSE,
|
|
||||||
0,
|
|
||||||
NULL,
|
|
||||||
NULL,
|
|
||||||
&si,
|
|
||||||
&pi)) {
|
|
||||||
free(sys_str);
|
|
||||||
janet_panic("could not create process");
|
|
||||||
}
|
}
|
||||||
free(sys_str);
|
|
||||||
|
|
||||||
// Wait until child process exits.
|
|
||||||
WaitForSingleObject(pi.hProcess, INFINITE);
|
|
||||||
|
|
||||||
// Close process and thread handles.
|
|
||||||
WORD status;
|
|
||||||
GetExitCodeProcess(pi.hProcess, (LPDWORD)&status);
|
|
||||||
CloseHandle(pi.hProcess);
|
|
||||||
CloseHandle(pi.hThread);
|
|
||||||
return janet_wrap_integer(status);
|
|
||||||
}
|
|
||||||
#else
|
#else
|
||||||
static Janet os_execute(int32_t argc, Janet *argv) {
|
/* Provide full os functionality */
|
||||||
janet_arity(argc, 1, -1);
|
|
||||||
const uint8_t **child_argv = malloc(sizeof(uint8_t *) * (argc + 1));
|
|
||||||
if (NULL == child_argv) {
|
|
||||||
JANET_OUT_OF_MEMORY;
|
|
||||||
}
|
|
||||||
for (int32_t i = 0; i < argc; i++) {
|
|
||||||
child_argv[i] = janet_getstring(argv, i);
|
|
||||||
}
|
|
||||||
child_argv[argc] = NULL;
|
|
||||||
|
|
||||||
/* Fork child process */
|
/* Get env for os_execute */
|
||||||
pid_t pid = fork();
|
static char **os_execute_env(int32_t argc, const Janet *argv) {
|
||||||
if (pid < 0) {
|
char **envp = NULL;
|
||||||
janet_panic("failed to execute");
|
if (argc > 2) {
|
||||||
} else if (pid == 0) {
|
JanetDictView dict = janet_getdictionary(argv, 2);
|
||||||
if (-1 == execve((const char *)child_argv[0], (char **)child_argv, NULL)) {
|
envp = janet_smalloc(sizeof(char *) * (dict.len + 1));
|
||||||
exit(1);
|
int32_t j = 0;
|
||||||
|
for (int32_t i = 0; i < dict.cap; i++) {
|
||||||
|
const JanetKV *kv = dict.kvs + i;
|
||||||
|
if (!janet_checktype(kv->key, JANET_STRING)) continue;
|
||||||
|
if (!janet_checktype(kv->value, JANET_STRING)) continue;
|
||||||
|
const uint8_t *keys = janet_unwrap_string(kv->key);
|
||||||
|
const uint8_t *vals = janet_unwrap_string(kv->value);
|
||||||
|
int32_t klen = janet_string_length(keys);
|
||||||
|
int32_t vlen = janet_string_length(vals);
|
||||||
|
/* Check keys has no embedded 0s or =s. */
|
||||||
|
int skip = 0;
|
||||||
|
for (int32_t k = 0; k < klen; k++) {
|
||||||
|
if (keys[k] == '\0' || keys[k] == '=') {
|
||||||
|
skip = 1;
|
||||||
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
int status;
|
if (skip) continue;
|
||||||
waitpid(pid, &status, 0);
|
char *envitem = janet_smalloc(klen + vlen + 2);
|
||||||
return janet_wrap_integer(status);
|
memcpy(envitem, keys, klen);
|
||||||
|
envitem[klen] = '=';
|
||||||
|
memcpy(envitem + klen + 1, vals, vlen);
|
||||||
|
envitem[klen + vlen + 1] = 0;
|
||||||
|
envp[j++] = envitem;
|
||||||
|
}
|
||||||
|
envp[j] = NULL;
|
||||||
|
}
|
||||||
|
return envp;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Free memory from os_execute */
|
||||||
|
static void os_execute_cleanup(char **envp, const char **child_argv) {
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
(void) child_argv;
|
||||||
|
#else
|
||||||
|
janet_sfree((void *)child_argv);
|
||||||
|
#endif
|
||||||
|
if (NULL != envp) {
|
||||||
|
char **envitem = envp;
|
||||||
|
while (*envitem != NULL) {
|
||||||
|
janet_sfree(*envitem);
|
||||||
|
envitem++;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_sfree(envp);
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
/* Windows processes created via CreateProcess get only one command line argument string, and
|
||||||
|
* must parse this themselves. Each processes is free to do this however they like, but the
|
||||||
|
* standard parsing method is CommandLineToArgvW. We need to properly escape arguments into
|
||||||
|
* a single string of this format. Returns a buffer that can be cast into a c string. */
|
||||||
|
static JanetBuffer *os_exec_escape(JanetView args) {
|
||||||
|
JanetBuffer *b = janet_buffer(0);
|
||||||
|
for (int32_t i = 0; i < args.len; i++) {
|
||||||
|
const char *arg = janet_getcstring(args.items, i);
|
||||||
|
|
||||||
|
/* Push leading space if not first */
|
||||||
|
if (i) janet_buffer_push_u8(b, ' ');
|
||||||
|
|
||||||
|
/* Find first special character */
|
||||||
|
const char *first_spec = arg;
|
||||||
|
while (*first_spec) {
|
||||||
|
switch (*first_spec) {
|
||||||
|
case ' ':
|
||||||
|
case '\t':
|
||||||
|
case '\v':
|
||||||
|
case '\n':
|
||||||
|
case '"':
|
||||||
|
goto found;
|
||||||
|
case '\0':
|
||||||
|
janet_panic("embedded 0 not allowed in command line string");
|
||||||
|
default:
|
||||||
|
first_spec++;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
found:
|
||||||
|
|
||||||
|
/* Check if needs escape */
|
||||||
|
if (*first_spec == '\0') {
|
||||||
|
/* No escape needed */
|
||||||
|
janet_buffer_push_cstring(b, arg);
|
||||||
|
} else {
|
||||||
|
/* Escape */
|
||||||
|
janet_buffer_push_u8(b, '"');
|
||||||
|
for (const char *c = arg; ; c++) {
|
||||||
|
unsigned numBackSlashes = 0;
|
||||||
|
while (*c == '\\') {
|
||||||
|
c++;
|
||||||
|
numBackSlashes++;
|
||||||
|
}
|
||||||
|
if (*c == '"') {
|
||||||
|
/* Escape all backslashes and double quote mark */
|
||||||
|
int32_t n = 2 * numBackSlashes + 1;
|
||||||
|
janet_buffer_extra(b, n + 1);
|
||||||
|
memset(b->data + b->count, '\\', n);
|
||||||
|
b->count += n;
|
||||||
|
janet_buffer_push_u8(b, '"');
|
||||||
|
} else if (*c) {
|
||||||
|
/* Don't escape backslashes. */
|
||||||
|
int32_t n = numBackSlashes;
|
||||||
|
janet_buffer_extra(b, n + 1);
|
||||||
|
memset(b->data + b->count, '\\', n);
|
||||||
|
b->count += n;
|
||||||
|
janet_buffer_push_u8(b, *c);
|
||||||
|
} else {
|
||||||
|
/* we finished Escape all backslashes */
|
||||||
|
int32_t n = 2 * numBackSlashes;
|
||||||
|
janet_buffer_extra(b, n + 1);
|
||||||
|
memset(b->data + b->count, '\\', n);
|
||||||
|
b->count += n;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_buffer_push_u8(b, '"');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_buffer_push_u8(b, 0);
|
||||||
|
return b;
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 3);
|
||||||
|
|
||||||
|
/* Get flags */
|
||||||
|
uint64_t flags = 0;
|
||||||
|
if (argc > 1) {
|
||||||
|
flags = janet_getflags(argv, 1, "ep");
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Get environment */
|
||||||
|
char **envp = os_execute_env(argc, argv);
|
||||||
|
|
||||||
|
/* Get arguments */
|
||||||
|
JanetView exargs = janet_getindexed(argv, 0);
|
||||||
|
if (exargs.len < 1) {
|
||||||
|
janet_panic("expected at least 1 command line argument");
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Result */
|
||||||
|
int status = 0;
|
||||||
|
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
|
||||||
|
JanetBuffer *buf = os_exec_escape(exargs);
|
||||||
|
if (buf->count > 1025) {
|
||||||
|
janet_panic("command line string too long");
|
||||||
|
}
|
||||||
|
const char *path = (const char *) janet_unwrap_string(exargs.items[0]);
|
||||||
|
char *cargv[2] = {(char *) buf->data, NULL};
|
||||||
|
|
||||||
|
/* Use _spawn family of functions. */
|
||||||
|
/* Windows docs say do this before any spawns. */
|
||||||
|
_flushall();
|
||||||
|
|
||||||
|
/* Use an empty env instead when envp is NULL to be consistent with other implementation. */
|
||||||
|
char *empty_env[1] = {NULL};
|
||||||
|
char **envp1 = (NULL == envp) ? empty_env : envp;
|
||||||
|
|
||||||
|
if (janet_flag_at(flags, 1) && janet_flag_at(flags, 0)) {
|
||||||
|
status = (int) _spawnvpe(_P_WAIT, path, cargv, envp1);
|
||||||
|
} else if (janet_flag_at(flags, 1)) {
|
||||||
|
status = (int) _spawnvp(_P_WAIT, path, cargv);
|
||||||
|
} else if (janet_flag_at(flags, 0)) {
|
||||||
|
status = (int) _spawnve(_P_WAIT, path, cargv, envp1);
|
||||||
|
} else {
|
||||||
|
status = (int) _spawnv(_P_WAIT, path, cargv);
|
||||||
|
}
|
||||||
|
os_execute_cleanup(envp, NULL);
|
||||||
|
|
||||||
|
/* Check error */
|
||||||
|
if (-1 == status) {
|
||||||
|
janet_panic(strerror(errno));
|
||||||
|
}
|
||||||
|
|
||||||
|
return janet_wrap_integer(status);
|
||||||
|
#else
|
||||||
|
|
||||||
|
const char **child_argv = janet_smalloc(sizeof(char *) * (exargs.len + 1));
|
||||||
|
for (int32_t i = 0; i < exargs.len; i++)
|
||||||
|
child_argv[i] = janet_getcstring(exargs.items, i);
|
||||||
|
child_argv[exargs.len] = NULL;
|
||||||
|
/* Coerce to form that works for spawn. I'm fairly confident no implementation
|
||||||
|
* of posix_spawn would modify the argv array passed in. */
|
||||||
|
char *const *cargv = (char *const *)child_argv;
|
||||||
|
|
||||||
|
/* Use posix_spawn to spawn new process */
|
||||||
|
pid_t pid;
|
||||||
|
if (janet_flag_at(flags, 1)) {
|
||||||
|
status = posix_spawnp(&pid,
|
||||||
|
child_argv[0], NULL, NULL, cargv,
|
||||||
|
janet_flag_at(flags, 0) ? envp : environ);
|
||||||
|
} else {
|
||||||
|
status = posix_spawn(&pid,
|
||||||
|
child_argv[0], NULL, NULL, cargv,
|
||||||
|
janet_flag_at(flags, 0) ? envp : environ);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Wait for child */
|
||||||
|
if (status) {
|
||||||
|
os_execute_cleanup(envp, child_argv);
|
||||||
|
janet_panic(strerror(status));
|
||||||
|
} else {
|
||||||
|
waitpid(pid, &status, 0);
|
||||||
|
}
|
||||||
|
|
||||||
|
os_execute_cleanup(envp, child_argv);
|
||||||
|
return janet_wrap_integer(WEXITSTATUS(status));
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
static Janet os_shell(int32_t argc, Janet *argv) {
|
static Janet os_shell(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 0, 1);
|
janet_arity(argc, 0, 1);
|
||||||
const char *cmd = argc
|
const char *cmd = argc
|
||||||
? (const char *)janet_getstring(argv, 0)
|
? janet_getcstring(argv, 0)
|
||||||
: NULL;
|
: NULL;
|
||||||
int stat = system(cmd);
|
int stat = system(cmd);
|
||||||
return argc
|
return argc
|
||||||
@@ -161,10 +334,9 @@ static Janet os_shell(int32_t argc, Janet *argv) {
|
|||||||
|
|
||||||
static Janet os_getenv(int32_t argc, Janet *argv) {
|
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
const uint8_t *k = janet_getstring(argv, 0);
|
const char *cstr = janet_getcstring(argv, 0);
|
||||||
const char *cstr = (const char *) k;
|
|
||||||
const char *res = getenv(cstr);
|
const char *res = getenv(cstr);
|
||||||
return (res && cstr)
|
return res
|
||||||
? janet_cstringv(res)
|
? janet_cstringv(res)
|
||||||
: janet_wrap_nil();
|
: janet_wrap_nil();
|
||||||
}
|
}
|
||||||
@@ -178,25 +350,11 @@ static Janet os_setenv(int32_t argc, Janet *argv) {
|
|||||||
#define UNSETENV(K) unsetenv(K)
|
#define UNSETENV(K) unsetenv(K)
|
||||||
#endif
|
#endif
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
const uint8_t *k = janet_getstring(argv, 0);
|
const char *ks = janet_getcstring(argv, 0);
|
||||||
const char *ks = (const char *) k;
|
|
||||||
if (argc == 1 || janet_checktype(argv[1], JANET_NIL)) {
|
if (argc == 1 || janet_checktype(argv[1], JANET_NIL)) {
|
||||||
UNSETENV(ks);
|
UNSETENV(ks);
|
||||||
} else {
|
} else {
|
||||||
const uint8_t *v = janet_getstring(argv, 1);
|
SETENV(ks, janet_getcstring(argv, 1));
|
||||||
SETENV(ks, (const char *)v);
|
|
||||||
}
|
|
||||||
return janet_wrap_nil();
|
|
||||||
}
|
|
||||||
|
|
||||||
static Janet os_exit(int32_t argc, Janet *argv) {
|
|
||||||
janet_arity(argc, 0, 1);
|
|
||||||
if (argc == 0) {
|
|
||||||
exit(EXIT_SUCCESS);
|
|
||||||
} else if (janet_checkint(argv[0])) {
|
|
||||||
exit(janet_unwrap_integer(argv[0]));
|
|
||||||
} else {
|
|
||||||
exit(EXIT_FAILURE);
|
|
||||||
}
|
}
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
@@ -299,7 +457,306 @@ static Janet os_date(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_struct(janet_struct_end(st));
|
return janet_wrap_struct(janet_struct_end(st));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Janet os_link(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 2, 3);
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
(void) argc;
|
||||||
|
(void) argv;
|
||||||
|
janet_panic("os/link 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 = ((argc == 3 && janet_getboolean(argv, 2)) ? symlink : link)(oldpath, newpath);
|
||||||
|
if (res == -1) janet_panic(strerror(errno));
|
||||||
|
return janet_wrap_integer(res);
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet os_mkdir(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
const char *path = janet_getcstring(argv, 0);
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
int res = _mkdir(path);
|
||||||
|
#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);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet os_rmdir(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
const char *path = janet_getcstring(argv, 0);
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
int res = _rmdir(path);
|
||||||
|
#else
|
||||||
|
int res = rmdir(path);
|
||||||
|
#endif
|
||||||
|
if (res == -1) janet_panic(strerror(errno));
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet os_cd(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
const char *path = janet_getcstring(argv, 0);
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
int res = _chdir(path);
|
||||||
|
#else
|
||||||
|
int res = chdir(path);
|
||||||
|
#endif
|
||||||
|
if (res == -1) janet_panic(strerror(errno));
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet os_touch(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 3);
|
||||||
|
const char *path = janet_getcstring(argv, 0);
|
||||||
|
struct utimbuf timebuf, *bufp;
|
||||||
|
if (argc >= 2) {
|
||||||
|
bufp = &timebuf;
|
||||||
|
timebuf.actime = (time_t) janet_getnumber(argv, 1);
|
||||||
|
if (argc >= 3) {
|
||||||
|
timebuf.modtime = (time_t) janet_getnumber(argv, 2);
|
||||||
|
} else {
|
||||||
|
timebuf.modtime = timebuf.actime;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
bufp = NULL;
|
||||||
|
}
|
||||||
|
int res = utime(path, bufp);
|
||||||
|
if (-1 == res) janet_panic(strerror(errno));
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet os_remove(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
const char *path = janet_getcstring(argv, 0);
|
||||||
|
int status = remove(path);
|
||||||
|
if (-1 == status) janet_panic(strerror(errno));
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
#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));
|
||||||
|
}
|
||||||
|
|
||||||
|
static const uint8_t *janet_decode_mode(unsigned short m) {
|
||||||
|
const char *str = "other";
|
||||||
|
if (m & _S_IFREG) str = "file";
|
||||||
|
else if (m & _S_IFDIR) str = "directory";
|
||||||
|
else if (m & _S_IFCHR) str = "character";
|
||||||
|
return janet_ckeyword(str);
|
||||||
|
}
|
||||||
|
#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));
|
||||||
|
}
|
||||||
|
|
||||||
|
static const uint8_t *janet_decode_mode(mode_t m) {
|
||||||
|
const char *str = "other";
|
||||||
|
if (S_ISREG(m)) str = "file";
|
||||||
|
else if (S_ISDIR(m)) str = "directory";
|
||||||
|
else if (S_ISFIFO(m)) str = "fifo";
|
||||||
|
else if (S_ISBLK(m)) str = "block";
|
||||||
|
else if (S_ISSOCK(m)) str = "socket";
|
||||||
|
else if (S_ISLNK(m)) str = "link";
|
||||||
|
else if (S_ISCHR(m)) str = "character";
|
||||||
|
return janet_ckeyword(str);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Can we do this? */
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
#define stat _stat
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Getters */
|
||||||
|
static Janet os_stat_dev(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_dev);
|
||||||
|
}
|
||||||
|
static Janet os_stat_inode(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_ino);
|
||||||
|
}
|
||||||
|
static Janet os_stat_mode(struct stat *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_uid(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_uid);
|
||||||
|
}
|
||||||
|
static Janet os_stat_gid(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_gid);
|
||||||
|
}
|
||||||
|
static Janet os_stat_nlink(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_nlink);
|
||||||
|
}
|
||||||
|
static Janet os_stat_rdev(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_rdev);
|
||||||
|
}
|
||||||
|
static Janet os_stat_size(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_size);
|
||||||
|
}
|
||||||
|
static Janet os_stat_accessed(struct stat *st) {
|
||||||
|
return janet_wrap_number((double) st->st_atime);
|
||||||
|
}
|
||||||
|
static Janet os_stat_modified(struct stat *st) {
|
||||||
|
return janet_wrap_number((double) st->st_mtime);
|
||||||
|
}
|
||||||
|
static Janet os_stat_changed(struct stat *st) {
|
||||||
|
return janet_wrap_number((double) st->st_ctime);
|
||||||
|
}
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
static Janet os_stat_blocks(struct stat *st) {
|
||||||
|
return janet_wrap_number(0);
|
||||||
|
}
|
||||||
|
static Janet os_stat_blocksize(struct stat *st) {
|
||||||
|
return janet_wrap_number(0);
|
||||||
|
}
|
||||||
|
#else
|
||||||
|
static Janet os_stat_blocks(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_blocks);
|
||||||
|
}
|
||||||
|
static Janet os_stat_blocksize(struct stat *st) {
|
||||||
|
return janet_wrap_number(st->st_blksize);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
struct OsStatGetter {
|
||||||
|
const char *name;
|
||||||
|
Janet(*fn)(struct stat *st);
|
||||||
|
};
|
||||||
|
|
||||||
|
static const struct OsStatGetter os_stat_getters[] = {
|
||||||
|
{"dev", os_stat_dev},
|
||||||
|
{"inode", os_stat_inode},
|
||||||
|
{"mode", os_stat_mode},
|
||||||
|
{"permissions", os_stat_permissions},
|
||||||
|
{"uid", os_stat_uid},
|
||||||
|
{"gid", os_stat_gid},
|
||||||
|
{"nlink", os_stat_nlink},
|
||||||
|
{"rdev", os_stat_rdev},
|
||||||
|
{"size", os_stat_size},
|
||||||
|
{"blocks", os_stat_blocks},
|
||||||
|
{"blocksize", os_stat_blocksize},
|
||||||
|
{"accessed", os_stat_accessed},
|
||||||
|
{"modified", os_stat_modified},
|
||||||
|
{"changed", os_stat_changed},
|
||||||
|
{NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
static Janet os_stat(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 2);
|
||||||
|
const char *path = janet_getcstring(argv, 0);
|
||||||
|
JanetTable *tab = NULL;
|
||||||
|
int getall = 1;
|
||||||
|
const uint8_t *key;
|
||||||
|
if (argc == 2) {
|
||||||
|
if (janet_checktype(argv[1], JANET_KEYWORD)) {
|
||||||
|
getall = 0;
|
||||||
|
key = janet_getkeyword(argv, 1);
|
||||||
|
} else {
|
||||||
|
tab = janet_gettable(argv, 1);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
tab = janet_table(0);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Build result */
|
||||||
|
struct stat st;
|
||||||
|
int res = stat(path, &st);
|
||||||
|
if (-1 == res) {
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
if (getall) {
|
||||||
|
/* Put results in table */
|
||||||
|
for (const struct OsStatGetter *sg = os_stat_getters; sg->name != NULL; sg++) {
|
||||||
|
janet_table_put(tab, janet_ckeywordv(sg->name), sg->fn(&st));
|
||||||
|
}
|
||||||
|
return janet_wrap_table(tab);
|
||||||
|
} else {
|
||||||
|
/* Get one result */
|
||||||
|
for (const struct OsStatGetter *sg = os_stat_getters; sg->name != NULL; sg++) {
|
||||||
|
if (janet_cstrcmp(key, sg->name)) continue;
|
||||||
|
return sg->fn(&st);
|
||||||
|
}
|
||||||
|
janet_panicf("unexpected keyword %v", janet_wrap_keyword(key));
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet os_dir(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 2);
|
||||||
|
const char *dir = janet_getcstring(argv, 0);
|
||||||
|
JanetArray *paths = (argc == 2) ? janet_getarray(argv, 1) : janet_array(0);
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
/* Read directory items with FindFirstFile / FindNextFile / FindClose */
|
||||||
|
struct _finddata_t afile;
|
||||||
|
char pattern[MAX_PATH + 1];
|
||||||
|
if (strlen(dir) > (sizeof(pattern) - 3))
|
||||||
|
janet_panicf("path too long: %s", dir);
|
||||||
|
sprintf(pattern, "%s/*", dir);
|
||||||
|
intptr_t res = _findfirst(pattern, &afile);
|
||||||
|
if (-1 == res) janet_panicv(janet_cstringv(strerror(errno)));
|
||||||
|
do {
|
||||||
|
if (strcmp(".", afile.name) && strcmp("..", afile.name)) {
|
||||||
|
janet_array_push(paths, janet_cstringv(afile.name));
|
||||||
|
}
|
||||||
|
} while (_findnext(res, &afile) != -1);
|
||||||
|
_findclose(res);
|
||||||
|
#else
|
||||||
|
/* Read directory items with opendir / readdir / closedir */
|
||||||
|
struct dirent *dp;
|
||||||
|
DIR *dfd = opendir(dir);
|
||||||
|
if (dfd == NULL) janet_panicf("cannot open directory %s", dir);
|
||||||
|
while ((dp = readdir(dfd)) != NULL) {
|
||||||
|
if (!strcmp(dp->d_name, ".") || !strcmp(dp->d_name, "..")) {
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
janet_array_push(paths, janet_cstringv(dp->d_name));
|
||||||
|
}
|
||||||
|
closedir(dfd);
|
||||||
|
#endif
|
||||||
|
return janet_wrap_array(paths);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet os_rename(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 2);
|
||||||
|
const char *src = janet_getcstring(argv, 0);
|
||||||
|
const char *dest = janet_getcstring(argv, 1);
|
||||||
|
int status = rename(src, dest);
|
||||||
|
if (status) {
|
||||||
|
janet_panic(strerror(errno));
|
||||||
|
}
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
#endif /* JANET_REDUCED_OS */
|
||||||
|
|
||||||
static const JanetReg os_cfuns[] = {
|
static const JanetReg os_cfuns[] = {
|
||||||
|
{
|
||||||
|
"os/exit", os_exit,
|
||||||
|
JDOC("(os/exit &opt x)\n\n"
|
||||||
|
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
||||||
|
"the exit with status equal the hash of x.")
|
||||||
|
},
|
||||||
{
|
{
|
||||||
"os/which", os_which,
|
"os/which", os_which,
|
||||||
JDOC("(os/which)\n\n"
|
JDOC("(os/which)\n\n"
|
||||||
@@ -308,28 +765,87 @@ static const JanetReg os_cfuns[] = {
|
|||||||
"\t:macos - Apple macos\n"
|
"\t:macos - Apple macos\n"
|
||||||
"\t:posix - A POSIX compatible system (default)")
|
"\t:posix - A POSIX compatible system (default)")
|
||||||
},
|
},
|
||||||
|
{
|
||||||
|
"os/getenv", os_getenv,
|
||||||
|
JDOC("(os/getenv variable)\n\n"
|
||||||
|
"Get the string value of an environment variable.")
|
||||||
|
},
|
||||||
|
#ifndef JANET_REDUCED_OS
|
||||||
|
{
|
||||||
|
"os/dir", os_dir,
|
||||||
|
JDOC("(os/dir dir &opt array)\n\n"
|
||||||
|
"Iterate over files and subdirectories in a directory. Returns an array of paths parts, "
|
||||||
|
"with only the filename or directory name and no prefix.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"os/stat", os_stat,
|
||||||
|
JDOC("(os/stat path &opt tab|key)\n\n"
|
||||||
|
"Gets information about a file or directory. Returns a table If the third argument is a keyword, returns "
|
||||||
|
" 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:uid - File uid\n"
|
||||||
|
"\t:gid - File gid\n"
|
||||||
|
"\t:nlink - number of links to file\n"
|
||||||
|
"\t:rdev - Real device of file. 0 on windows.\n"
|
||||||
|
"\t:size - size of file in bytes\n"
|
||||||
|
"\t:blocks - number of blocks in file. 0 on windows\n"
|
||||||
|
"\t:blocksize - size of blocks in file. 0 on windows\n"
|
||||||
|
"\t:accessed - timestamp when file last accessed\n"
|
||||||
|
"\t:changed - timestamp when file last chnaged (permissions changed)\n"
|
||||||
|
"\t:modified - timestamp when file last modified (content changed)\n")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"os/touch", os_touch,
|
||||||
|
JDOC("(os/touch path &opt actime modtime)\n\n"
|
||||||
|
"Update the access time and modification times for a file. By default, sets "
|
||||||
|
"times to the current time.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"os/cd", os_cd,
|
||||||
|
JDOC("(os/cd path)\n\n"
|
||||||
|
"Change current directory to path. Returns true on success, false on failure.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"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.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"os/rmdir", os_rmdir,
|
||||||
|
JDOC("(os/rmdir path)\n\n"
|
||||||
|
"Delete a directory. The directory must be empty to succeed.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"os/rm", os_remove,
|
||||||
|
JDOC("(os/rm path)\n\n"
|
||||||
|
"Delete a file. Returns nil.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"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.")
|
||||||
|
},
|
||||||
{
|
{
|
||||||
"os/execute", os_execute,
|
"os/execute", os_execute,
|
||||||
JDOC("(os/execute program & args)\n\n"
|
JDOC("(os/execute args &opts flags env)\n\n"
|
||||||
"Execute a program on the system and pass it string arguments. Returns "
|
"Execute a program on the system and pass it string arguments. Flags "
|
||||||
"the exit status of the program.")
|
"is a keyword that modifies how the program will execute.\n\n"
|
||||||
|
"\t:e - enables passing an environment to the program. Without :e, the "
|
||||||
|
"current environment is inherited.\n"
|
||||||
|
"\t:p - allows searching the current PATH for the binary to execute. "
|
||||||
|
"Without this flag, binaries must use absolute paths.\n\n"
|
||||||
|
"env is a table or struct mapping environment variables to values. "
|
||||||
|
"Returns the exit status of the program.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/shell", os_shell,
|
"os/shell", os_shell,
|
||||||
JDOC("(os/shell str)\n\n"
|
JDOC("(os/shell str)\n\n"
|
||||||
"Pass a command string str directly to the system shell.")
|
"Pass a command string str directly to the system shell.")
|
||||||
},
|
},
|
||||||
{
|
|
||||||
"os/exit", os_exit,
|
|
||||||
JDOC("(os/exit x)\n\n"
|
|
||||||
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
|
||||||
"the exit with status equal the hash of x.")
|
|
||||||
},
|
|
||||||
{
|
|
||||||
"os/getenv", os_getenv,
|
|
||||||
JDOC("(os/getenv variable)\n\n"
|
|
||||||
"Get the string value of an environment variable.")
|
|
||||||
},
|
|
||||||
{
|
{
|
||||||
"os/setenv", os_setenv,
|
"os/setenv", os_setenv,
|
||||||
JDOC("(os/setenv variable value)\n\n"
|
JDOC("(os/setenv variable value)\n\n"
|
||||||
@@ -360,12 +876,12 @@ static const JanetReg os_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/date", os_date,
|
"os/date", os_date,
|
||||||
JDOC("(os/date [,time])\n\n"
|
JDOC("(os/date &opt time)\n\n"
|
||||||
"Returns the given time as a date struct, or the current time if no time is given. "
|
"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.\n\n"
|
"Returns a struct with following key values. Note that all numbers are 0-indexed.\n\n"
|
||||||
"\t:seconds - number of seconds [0-61]\n"
|
"\t:seconds - number of seconds [0-61]\n"
|
||||||
"\t:minutes - number of minutes [0-59]\n"
|
"\t:minutes - number of minutes [0-59]\n"
|
||||||
"\t:seconds - number of hours [0-23]\n"
|
"\t:hours - number of hours [0-23]\n"
|
||||||
"\t:month-day - day of month [0-30]\n"
|
"\t:month-day - day of month [0-30]\n"
|
||||||
"\t:month - month of year [0, 11]\n"
|
"\t:month - month of year [0, 11]\n"
|
||||||
"\t:year - years since year 0 (e.g. 2019)\n"
|
"\t:year - years since year 0 (e.g. 2019)\n"
|
||||||
@@ -373,6 +889,12 @@ static const JanetReg os_cfuns[] = {
|
|||||||
"\t:year-day - day of the year [0-365]\n"
|
"\t:year-day - day of the year [0-365]\n"
|
||||||
"\t:dst - If Day Light Savings is in effect")
|
"\t:dst - If Day Light Savings is in effect")
|
||||||
},
|
},
|
||||||
|
{
|
||||||
|
"os/rename", os_rename,
|
||||||
|
JDOC("(os/rename oldname newname)\n\n"
|
||||||
|
"Rename a file on disk to a new path. Returns nil.")
|
||||||
|
},
|
||||||
|
#endif
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|||||||
368
src/core/parse.c
368
src/core/parse.c
@@ -21,7 +21,7 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
@@ -32,6 +32,7 @@ static int is_whitespace(uint8_t c) {
|
|||||||
|| c == '\n'
|
|| c == '\n'
|
||||||
|| c == '\r'
|
|| c == '\r'
|
||||||
|| c == '\0'
|
|| c == '\0'
|
||||||
|
|| c == '\v'
|
||||||
|| c == '\f';
|
|| c == '\f';
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -48,7 +49,7 @@ static const uint32_t symchars[8] = {
|
|||||||
/* Check if a character is a valid symbol character
|
/* Check if a character is a valid symbol character
|
||||||
* symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_~| */
|
* symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_~| */
|
||||||
static int is_symbol_char(uint8_t c) {
|
static int is_symbol_char(uint8_t c) {
|
||||||
return symchars[c >> 5] & (1 << (c & 0x1F));
|
return symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Validate some utf8. Useful for identifiers. Only validates
|
/* Validate some utf8. Useful for identifiers. Only validates
|
||||||
@@ -143,6 +144,8 @@ DEF_PARSER_STACK(_pushstate, JanetParseState, states, statecount, statecap)
|
|||||||
#define PFLAG_LONGSTRING 0x4000
|
#define PFLAG_LONGSTRING 0x4000
|
||||||
#define PFLAG_READERMAC 0x8000
|
#define PFLAG_READERMAC 0x8000
|
||||||
#define PFLAG_ATSYM 0x10000
|
#define PFLAG_ATSYM 0x10000
|
||||||
|
#define PFLAG_COMMENT 0x20000
|
||||||
|
#define PFLAG_TOKEN 0x40000
|
||||||
|
|
||||||
static void pushstate(JanetParser *p, Consumer consumer, int flags) {
|
static void pushstate(JanetParser *p, Consumer consumer, int flags) {
|
||||||
JanetParseState s;
|
JanetParseState s;
|
||||||
@@ -191,17 +194,30 @@ static void popstate(JanetParser *p, Janet val) {
|
|||||||
|
|
||||||
static int checkescape(uint8_t c) {
|
static int checkescape(uint8_t c) {
|
||||||
switch (c) {
|
switch (c) {
|
||||||
default: return -1;
|
default:
|
||||||
case 'x': return 1;
|
return -1;
|
||||||
case 'n': return '\n';
|
case 'x':
|
||||||
case 't': return '\t';
|
return 1;
|
||||||
case 'r': return '\r';
|
case 'n':
|
||||||
case '0': return '\0';
|
return '\n';
|
||||||
case 'z': return '\0';
|
case 't':
|
||||||
case 'f': return '\f';
|
return '\t';
|
||||||
case 'e': return 27;
|
case 'r':
|
||||||
case '"': return '"';
|
return '\r';
|
||||||
case '\\': return '\\';
|
case '0':
|
||||||
|
return '\0';
|
||||||
|
case 'z':
|
||||||
|
return '\0';
|
||||||
|
case 'f':
|
||||||
|
return '\f';
|
||||||
|
case 'v':
|
||||||
|
return '\v';
|
||||||
|
case 'e':
|
||||||
|
return 27;
|
||||||
|
case '"':
|
||||||
|
return '"';
|
||||||
|
case '\\':
|
||||||
|
return '\\';
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -243,12 +259,24 @@ static int escape1(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
|
|
||||||
static int stringend(JanetParser *p, JanetParseState *state) {
|
static int stringend(JanetParser *p, JanetParseState *state) {
|
||||||
Janet ret;
|
Janet ret;
|
||||||
|
uint8_t *bufstart = p->buf;
|
||||||
|
int32_t buflen = (int32_t) p->bufcount;
|
||||||
|
if (state->flags & PFLAG_LONGSTRING) {
|
||||||
|
/* Check for leading newline character so we can remove it */
|
||||||
|
if (bufstart[0] == '\n') {
|
||||||
|
bufstart++;
|
||||||
|
buflen--;
|
||||||
|
}
|
||||||
|
if (buflen > 0 && bufstart[buflen - 1] == '\n') {
|
||||||
|
buflen--;
|
||||||
|
}
|
||||||
|
}
|
||||||
if (state->flags & PFLAG_BUFFER) {
|
if (state->flags & PFLAG_BUFFER) {
|
||||||
JanetBuffer *b = janet_buffer((int32_t)p->bufcount);
|
JanetBuffer *b = janet_buffer(buflen);
|
||||||
janet_buffer_push_bytes(b, p->buf, (int32_t)p->bufcount);
|
janet_buffer_push_bytes(b, bufstart, buflen);
|
||||||
ret = janet_wrap_buffer(b);
|
ret = janet_wrap_buffer(b);
|
||||||
} else {
|
} else {
|
||||||
ret = janet_wrap_string(janet_string(p->buf, (int32_t)p->bufcount));
|
ret = janet_wrap_string(janet_string(bufstart, buflen));
|
||||||
}
|
}
|
||||||
p->bufcount = 0;
|
p->bufcount = 0;
|
||||||
popstate(p, ret);
|
popstate(p, ret);
|
||||||
@@ -331,13 +359,18 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
|
|
||||||
static int comment(JanetParser *p, JanetParseState *state, uint8_t c) {
|
static int comment(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||||
(void) state;
|
(void) state;
|
||||||
if (c == '\n') p->statecount--;
|
if (c == '\n') {
|
||||||
|
p->statecount--;
|
||||||
|
p->bufcount = 0;
|
||||||
|
} else {
|
||||||
|
push_buf(p, c);
|
||||||
|
}
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet close_tuple(JanetParser *p, JanetParseState *state, int32_t flag) {
|
static Janet close_tuple(JanetParser *p, JanetParseState *state, int32_t flag) {
|
||||||
Janet *ret = janet_tuple_begin(state->argn);
|
Janet *ret = janet_tuple_begin(state->argn);
|
||||||
janet_tuple_flag(ret) = flag;
|
janet_tuple_flag(ret) |= flag;
|
||||||
for (int32_t i = state->argn - 1; i >= 0; i--)
|
for (int32_t i = state->argn - 1; i >= 0; i--)
|
||||||
ret[i] = p->args[--p->argcount];
|
ret[i] = p->args[--p->argcount];
|
||||||
return janet_wrap_tuple(janet_tuple_end(ret));
|
return janet_wrap_tuple(janet_tuple_end(ret));
|
||||||
@@ -417,7 +450,7 @@ static int longstring(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
|
|
||||||
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
|
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
|
||||||
|
|
||||||
static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
static int atsign(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||||
(void) state;
|
(void) state;
|
||||||
p->statecount--;
|
p->statecount--;
|
||||||
switch (c) {
|
switch (c) {
|
||||||
@@ -439,8 +472,8 @@ static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
default:
|
default:
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
pushstate(p, tokenchar, 0);
|
pushstate(p, tokenchar, PFLAG_TOKEN);
|
||||||
push_buf(p, '@'); /* Push the leading ampersand that was dropped */
|
push_buf(p, '@'); /* Push the leading at-sign that was dropped */
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -453,7 +486,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
p->error = "unexpected character";
|
p->error = "unexpected character";
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
pushstate(p, tokenchar, 0);
|
pushstate(p, tokenchar, PFLAG_TOKEN);
|
||||||
return 0;
|
return 0;
|
||||||
case '\'':
|
case '\'':
|
||||||
case ',':
|
case ',':
|
||||||
@@ -465,18 +498,17 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
pushstate(p, stringchar, PFLAG_STRING);
|
pushstate(p, stringchar, PFLAG_STRING);
|
||||||
return 1;
|
return 1;
|
||||||
case '#':
|
case '#':
|
||||||
pushstate(p, comment, 0);
|
pushstate(p, comment, PFLAG_COMMENT);
|
||||||
return 1;
|
return 1;
|
||||||
case '@':
|
case '@':
|
||||||
pushstate(p, ampersand, 0);
|
pushstate(p, atsign, PFLAG_ATSYM);
|
||||||
return 1;
|
return 1;
|
||||||
case '`':
|
case '`':
|
||||||
pushstate(p, longstring, PFLAG_LONGSTRING);
|
pushstate(p, longstring, PFLAG_LONGSTRING);
|
||||||
return 1;
|
return 1;
|
||||||
case ')':
|
case ')':
|
||||||
case ']':
|
case ']':
|
||||||
case '}':
|
case '}': {
|
||||||
{
|
|
||||||
Janet ds;
|
Janet ds;
|
||||||
if (p->statecount == 1) {
|
if (p->statecount == 1) {
|
||||||
p->error = "unexpected delimiter";
|
p->error = "unexpected delimiter";
|
||||||
@@ -518,20 +550,37 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
int janet_parser_consume(JanetParser *parser, uint8_t c) {
|
static void janet_parser_checkdead(JanetParser *parser) {
|
||||||
|
if (parser->flag) janet_panic("parser is dead, cannot consume");
|
||||||
|
if (parser->error) janet_panic("parser has unchecked error, cannot consume");
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Public API */
|
||||||
|
|
||||||
|
void janet_parser_consume(JanetParser *parser, uint8_t c) {
|
||||||
int consumed = 0;
|
int consumed = 0;
|
||||||
if (parser->error) return 0;
|
janet_parser_checkdead(parser);
|
||||||
parser->offset++;
|
parser->offset++;
|
||||||
while (!consumed && !parser->error) {
|
while (!consumed && !parser->error) {
|
||||||
JanetParseState *state = parser->states + parser->statecount - 1;
|
JanetParseState *state = parser->states + parser->statecount - 1;
|
||||||
consumed = state->consumer(parser, state, c);
|
consumed = state->consumer(parser, state, c);
|
||||||
}
|
}
|
||||||
parser->lookback = c;
|
parser->lookback = c;
|
||||||
return 1;
|
}
|
||||||
|
|
||||||
|
void janet_parser_eof(JanetParser *parser) {
|
||||||
|
janet_parser_checkdead(parser);
|
||||||
|
janet_parser_consume(parser, '\n');
|
||||||
|
if (parser->statecount > 1) {
|
||||||
|
parser->error = "unexpected end of source";
|
||||||
|
}
|
||||||
|
parser->offset--;
|
||||||
|
parser->flag = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
enum JanetParserStatus janet_parser_status(JanetParser *parser) {
|
enum JanetParserStatus janet_parser_status(JanetParser *parser) {
|
||||||
if (parser->error) return JANET_PARSE_ERROR;
|
if (parser->error) return JANET_PARSE_ERROR;
|
||||||
|
if (parser->flag) return JANET_PARSE_DEAD;
|
||||||
if (parser->statecount > 1) return JANET_PARSE_PENDING;
|
if (parser->statecount > 1) return JANET_PARSE_PENDING;
|
||||||
return JANET_PARSE_ROOT;
|
return JANET_PARSE_ROOT;
|
||||||
}
|
}
|
||||||
@@ -581,6 +630,7 @@ void janet_parser_init(JanetParser *parser) {
|
|||||||
parser->lookback = -1;
|
parser->lookback = -1;
|
||||||
parser->offset = 0;
|
parser->offset = 0;
|
||||||
parser->pending = 0;
|
parser->pending = 0;
|
||||||
|
parser->flag = 0;
|
||||||
|
|
||||||
pushstate(parser, root, PFLAG_CONTAINER);
|
pushstate(parser, root, PFLAG_CONTAINER);
|
||||||
}
|
}
|
||||||
@@ -591,6 +641,55 @@ void janet_parser_deinit(JanetParser *parser) {
|
|||||||
free(parser->states);
|
free(parser->states);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
|
||||||
|
/* Misc fields */
|
||||||
|
dest->flag = src->flag;
|
||||||
|
dest->pending = src->pending;
|
||||||
|
dest->lookback = src->lookback;
|
||||||
|
dest->offset = src->offset;
|
||||||
|
dest->error = src->error;
|
||||||
|
|
||||||
|
/* Keep counts */
|
||||||
|
dest->argcount = src->argcount;
|
||||||
|
dest->bufcount = src->bufcount;
|
||||||
|
dest->statecount = src->statecount;
|
||||||
|
|
||||||
|
/* Capacities are equal to counts */
|
||||||
|
dest->bufcap = dest->bufcount;
|
||||||
|
dest->statecap = dest->statecount;
|
||||||
|
dest->argcap = dest->argcount;
|
||||||
|
|
||||||
|
/* Deep cloned fields */
|
||||||
|
dest->args = NULL;
|
||||||
|
dest->states = NULL;
|
||||||
|
dest->buf = NULL;
|
||||||
|
if (dest->bufcap) {
|
||||||
|
dest->buf = malloc(dest->bufcap);
|
||||||
|
if (!dest->buf) goto nomem;
|
||||||
|
}
|
||||||
|
if (dest->argcap) {
|
||||||
|
dest->args = malloc(sizeof(Janet) * dest->argcap);
|
||||||
|
if (!dest->args) goto nomem;
|
||||||
|
}
|
||||||
|
if (dest->statecap) {
|
||||||
|
dest->states = malloc(sizeof(JanetParseState) * dest->statecap);
|
||||||
|
if (!dest->states) goto nomem;
|
||||||
|
}
|
||||||
|
|
||||||
|
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:
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
|
||||||
|
int janet_parser_has_more(JanetParser *parser) {
|
||||||
|
return !!parser->pending;
|
||||||
|
}
|
||||||
|
|
||||||
/* C functions */
|
/* C functions */
|
||||||
|
|
||||||
static int parsermark(void *p, size_t size) {
|
static int parsermark(void *p, size_t size) {
|
||||||
@@ -617,6 +716,9 @@ static JanetAbstractType janet_parse_parsertype = {
|
|||||||
parsergc,
|
parsergc,
|
||||||
parsermark,
|
parsermark,
|
||||||
parserget,
|
parserget,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
NULL
|
NULL
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -654,6 +756,13 @@ static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_integer(i);
|
return janet_wrap_integer(i);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Janet cfun_parse_eof(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
|
janet_parser_eof(p);
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
@@ -671,7 +780,7 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
|||||||
const uint8_t *str = janet_to_string(argv[1]);
|
const uint8_t *str = janet_to_string(argv[1]);
|
||||||
int32_t slen = janet_string_length(str);
|
int32_t slen = janet_string_length(str);
|
||||||
size_t newcount = p->bufcount + slen;
|
size_t newcount = p->bufcount + slen;
|
||||||
if (p->bufcap > p->bufcount + slen) {
|
if (p->bufcap < newcount) {
|
||||||
size_t newcap = 2 * newcount;
|
size_t newcap = 2 * newcount;
|
||||||
p->buf = realloc(p->buf, newcap);
|
p->buf = realloc(p->buf, newcap);
|
||||||
if (p->buf == NULL) {
|
if (p->buf == NULL) {
|
||||||
@@ -715,6 +824,9 @@ static Janet cfun_parse_status(int32_t argc, Janet *argv) {
|
|||||||
case JANET_PARSE_ROOT:
|
case JANET_PARSE_ROOT:
|
||||||
stat = "root";
|
stat = "root";
|
||||||
break;
|
break;
|
||||||
|
case JANET_PARSE_DEAD:
|
||||||
|
stat = "dead";
|
||||||
|
break;
|
||||||
}
|
}
|
||||||
return janet_ckeywordv(stat);
|
return janet_ckeywordv(stat);
|
||||||
}
|
}
|
||||||
@@ -741,43 +853,179 @@ static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
|
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_arity(argc, 1, 2);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
|
if (argc > 1) {
|
||||||
|
int32_t offset = janet_getinteger(argv, 1);
|
||||||
|
p->offset = offset;
|
||||||
|
return argv[0];
|
||||||
|
} else {
|
||||||
return janet_wrap_integer(p->offset);
|
return janet_wrap_integer(p->offset);
|
||||||
}
|
}
|
||||||
|
}
|
||||||
|
|
||||||
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
|
||||||
|
uint8_t *buff, uint32_t bufcount) {
|
||||||
|
JanetTable *state = janet_table(0);
|
||||||
|
const uint8_t *buffer;
|
||||||
|
int add_buffer = 0;
|
||||||
|
const char *type = NULL;
|
||||||
|
|
||||||
|
if (s->flags & PFLAG_CONTAINER) {
|
||||||
|
JanetArray *container_args = janet_array(s->argn);
|
||||||
|
container_args->count = s->argn;
|
||||||
|
memcpy(container_args->data, args, sizeof(args[0])*s->argn);
|
||||||
|
janet_table_put(state, janet_ckeywordv("args"),
|
||||||
|
janet_wrap_array(container_args));
|
||||||
|
}
|
||||||
|
|
||||||
|
if (s->flags & PFLAG_PARENS || s->flags & PFLAG_SQRBRACKETS) {
|
||||||
|
if (s->flags & PFLAG_ATSYM) {
|
||||||
|
type = "array";
|
||||||
|
} else {
|
||||||
|
type = "tuple";
|
||||||
|
}
|
||||||
|
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||||
|
if (s->flags & PFLAG_ATSYM) {
|
||||||
|
type = "table";
|
||||||
|
} else {
|
||||||
|
type = "struct";
|
||||||
|
}
|
||||||
|
} else if (s->flags & PFLAG_STRING || s->flags & PFLAG_LONGSTRING) {
|
||||||
|
if (s->flags & PFLAG_BUFFER) {
|
||||||
|
type = "buffer";
|
||||||
|
} else {
|
||||||
|
type = "string";
|
||||||
|
}
|
||||||
|
add_buffer = 1;
|
||||||
|
} else if (s->flags & PFLAG_COMMENT) {
|
||||||
|
type = "comment";
|
||||||
|
add_buffer = 1;
|
||||||
|
} else if (s->flags & PFLAG_TOKEN) {
|
||||||
|
type = "token";
|
||||||
|
add_buffer = 1;
|
||||||
|
} else if (s->flags & PFLAG_ATSYM) {
|
||||||
|
type = "at";
|
||||||
|
} else if (s->flags & PFLAG_READERMAC) {
|
||||||
|
int c = s->flags & 0xFF;
|
||||||
|
type = (c == '\'') ? "quote" :
|
||||||
|
(c == ',') ? "unquote" :
|
||||||
|
(c == ';') ? "splice" :
|
||||||
|
(c == '~') ? "quasiquote" : "<reader>";
|
||||||
|
} else {
|
||||||
|
type = "root";
|
||||||
|
}
|
||||||
|
|
||||||
|
if (type) {
|
||||||
|
janet_table_put(state, janet_ckeywordv("type"),
|
||||||
|
janet_ckeywordv(type));
|
||||||
|
}
|
||||||
|
|
||||||
|
if (add_buffer) {
|
||||||
|
buffer = janet_string(buff, bufcount);
|
||||||
|
janet_table_put(state, janet_ckeywordv("buffer"), janet_wrap_string(buffer));
|
||||||
|
}
|
||||||
|
|
||||||
|
janet_table_put(state, janet_ckeywordv("start"),
|
||||||
|
janet_wrap_integer(s->start));
|
||||||
|
return janet_wrap_table(state);
|
||||||
|
}
|
||||||
|
|
||||||
|
struct ParserStateGetter {
|
||||||
|
const char *name;
|
||||||
|
Janet(*fn)(const JanetParser *p);
|
||||||
|
};
|
||||||
|
|
||||||
|
static Janet parser_state_delimiters(const JanetParser *_p) {
|
||||||
|
JanetParser *clone = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
||||||
|
janet_parser_clone(_p, clone);
|
||||||
size_t i;
|
size_t i;
|
||||||
const uint8_t *str;
|
const uint8_t *str;
|
||||||
size_t oldcount;
|
size_t oldcount;
|
||||||
janet_fixarity(argc, 1);
|
oldcount = clone->bufcount;
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
for (i = 0; i < clone->statecount; i++) {
|
||||||
oldcount = p->bufcount;
|
JanetParseState *s = clone->states + i;
|
||||||
for (i = 0; i < p->statecount; i++) {
|
|
||||||
JanetParseState *s = p->states + i;
|
|
||||||
if (s->flags & PFLAG_PARENS) {
|
if (s->flags & PFLAG_PARENS) {
|
||||||
push_buf(p, '(');
|
push_buf(clone, '(');
|
||||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||||
push_buf(p, '[');
|
push_buf(clone, '[');
|
||||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||||
push_buf(p, '{');
|
push_buf(clone, '{');
|
||||||
} else if (s->flags & PFLAG_STRING) {
|
} else if (s->flags & PFLAG_STRING) {
|
||||||
push_buf(p, '"');
|
push_buf(clone, '"');
|
||||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
for (i = 0; i < s->argn; i++) {
|
for (i = 0; i < s->argn; i++) {
|
||||||
push_buf(p, '`');
|
push_buf(clone, '`');
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
|
str = janet_string(clone->buf + oldcount, (int32_t)(clone->bufcount - oldcount));
|
||||||
p->bufcount = oldcount;
|
clone->bufcount = oldcount;
|
||||||
return janet_wrap_string(str);
|
return janet_wrap_string(str);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Janet parser_state_frames(const JanetParser *p) {
|
||||||
|
int32_t count = (int32_t) p->statecount;
|
||||||
|
JanetArray *states = janet_array(count);
|
||||||
|
states->count = count;
|
||||||
|
uint8_t *buf = p->buf;
|
||||||
|
Janet *args = p->args;
|
||||||
|
for (int32_t i = count - 1; i >= 0; --i) {
|
||||||
|
JanetParseState *s = p->states + i;
|
||||||
|
states->data[i] = janet_wrap_parse_state(s, args, buf, (uint32_t) p->bufcount);
|
||||||
|
args -= s->argn;
|
||||||
|
}
|
||||||
|
return janet_wrap_array(states);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const struct ParserStateGetter parser_state_getters[] = {
|
||||||
|
{"frames", parser_state_frames},
|
||||||
|
{"delimiters", parser_state_delimiters},
|
||||||
|
{NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 2);
|
||||||
|
const uint8_t *key = NULL;
|
||||||
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
|
if (argc == 2) {
|
||||||
|
key = janet_getkeyword(argv, 1);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (key) {
|
||||||
|
/* Get one result */
|
||||||
|
for (const struct ParserStateGetter *sg = parser_state_getters;
|
||||||
|
sg->name != NULL; sg++) {
|
||||||
|
if (janet_cstrcmp(key, sg->name)) continue;
|
||||||
|
return sg->fn(p);
|
||||||
|
}
|
||||||
|
janet_panicf("unexpected keyword %v", janet_wrap_keyword(key));
|
||||||
|
return janet_wrap_nil();
|
||||||
|
} else {
|
||||||
|
/* Put results in table */
|
||||||
|
JanetTable *tab = janet_table(0);
|
||||||
|
for (const struct ParserStateGetter *sg = parser_state_getters;
|
||||||
|
sg->name != NULL; sg++) {
|
||||||
|
janet_table_put(tab, janet_ckeywordv(sg->name), sg->fn(p));
|
||||||
|
}
|
||||||
|
return janet_wrap_table(tab);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_parse_clone(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetParser *src = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
|
JanetParser *dest = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
||||||
|
janet_parser_clone(src, dest);
|
||||||
|
return janet_wrap_abstract(dest);
|
||||||
|
}
|
||||||
|
|
||||||
static const JanetMethod parser_methods[] = {
|
static const JanetMethod parser_methods[] = {
|
||||||
{"byte", cfun_parse_byte},
|
{"byte", cfun_parse_byte},
|
||||||
|
{"clone", cfun_parse_clone},
|
||||||
{"consume", cfun_parse_consume},
|
{"consume", cfun_parse_consume},
|
||||||
|
{"eof", cfun_parse_eof},
|
||||||
{"error", cfun_parse_error},
|
{"error", cfun_parse_error},
|
||||||
{"flush", cfun_parse_flush},
|
{"flush", cfun_parse_flush},
|
||||||
{"has-more", cfun_parse_has_more},
|
{"has-more", cfun_parse_has_more},
|
||||||
@@ -802,6 +1050,13 @@ static const JanetReg parse_cfuns[] = {
|
|||||||
"Creates and returns a new parser object. Parsers are state machines "
|
"Creates and returns a new parser object. Parsers are state machines "
|
||||||
"that can receive bytes, and generate a stream of janet values.")
|
"that can receive bytes, and generate a stream of janet values.")
|
||||||
},
|
},
|
||||||
|
{
|
||||||
|
"parser/clone", cfun_parse_clone,
|
||||||
|
JDOC("(parser/clone p)\n\n"
|
||||||
|
"Creates a deep clone of a parser that is identical to the input parser. "
|
||||||
|
"This cloned parser can be used to continue parsing from a good checkpoint "
|
||||||
|
"if parsing later fails. Returns a new parser.")
|
||||||
|
},
|
||||||
{
|
{
|
||||||
"parser/has-more", cfun_parse_has_more,
|
"parser/has-more", cfun_parse_has_more,
|
||||||
JDOC("(parser/has-more parser)\n\n"
|
JDOC("(parser/has-more parser)\n\n"
|
||||||
@@ -816,7 +1071,7 @@ static const JanetReg parse_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/consume", cfun_parse_consume,
|
"parser/consume", cfun_parse_consume,
|
||||||
JDOC("(parser/consume parser bytes [, index])\n\n"
|
JDOC("(parser/consume parser bytes &opt index)\n\n"
|
||||||
"Input bytes into the parser and parse them. Will not throw errors "
|
"Input bytes into the parser and parse them. Will not throw errors "
|
||||||
"if there is a parse error. Starts at the byte index given by index. Returns "
|
"if there is a parse error. Starts at the byte index given by index. Returns "
|
||||||
"the number of bytes read.")
|
"the number of bytes read.")
|
||||||
@@ -852,18 +1107,27 @@ static const JanetReg parse_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/state", cfun_parse_state,
|
"parser/state", cfun_parse_state,
|
||||||
JDOC("(parser/state parser)\n\n"
|
JDOC("(parser/state parser &opt key)\n\n"
|
||||||
"Returns a string representation of the internal state of the parser. "
|
"Returns a representation of the internal state of the parser. If a key is passed, "
|
||||||
"Each byte in the string represents a nested data structure. For example, "
|
"only that information about the state is returned. Allowed keys are:\n\n"
|
||||||
|
"\t:delimiters - Each byte in the string represents a nested data structure. For example, "
|
||||||
"if the parser state is '([\"', then the parser is in the middle of parsing a "
|
"if the parser state is '([\"', then the parser is in the middle of parsing a "
|
||||||
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.")
|
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt."
|
||||||
|
"\t:frames - Each table in the array represents a 'frame' in the parser state. Frames "
|
||||||
|
"contain information about the start of the expression being parsed as well as the "
|
||||||
|
"type of that expression and some type-specific information.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/where", cfun_parse_where,
|
"parser/where", cfun_parse_where,
|
||||||
JDOC("(parser/where parser)\n\n"
|
JDOC("(parser/where parser &opt offset)\n\n"
|
||||||
"Returns the current line number and column number of the parser's location "
|
"Returns the current line number and column number of the parser's location "
|
||||||
"in the byte stream as a tuple (line, column). Lines and columns are counted from "
|
"in the byte stream as an index, counted from 0. "
|
||||||
"1, (the first byte is line 1, column 1) and a newline is considered ASCII 0x0A.")
|
"If offset is supplied, then the byte offset is updated to that new value.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/eof", cfun_parse_eof,
|
||||||
|
JDOC("(parser/eof parser)\n\n"
|
||||||
|
"Indicate that the end of file was reached to the parser. This puts the parser in the :dead state.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/insert", cfun_parse_insert,
|
"parser/insert", cfun_parse_insert,
|
||||||
|
|||||||
382
src/core/peg.c
382
src/core/peg.c
@@ -21,13 +21,15 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
#ifdef JANET_PEG
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* Runtime
|
* Runtime
|
||||||
*/
|
*/
|
||||||
@@ -73,8 +75,7 @@ typedef struct {
|
|||||||
int32_t depth;
|
int32_t depth;
|
||||||
enum {
|
enum {
|
||||||
PEG_MODE_NORMAL,
|
PEG_MODE_NORMAL,
|
||||||
PEG_MODE_ACCUMULATE,
|
PEG_MODE_ACCUMULATE
|
||||||
PEG_MODE_NOCAPTURE
|
|
||||||
} mode;
|
} mode;
|
||||||
} PegState;
|
} PegState;
|
||||||
|
|
||||||
@@ -103,10 +104,10 @@ static void cap_load(PegState *s, CapState cs) {
|
|||||||
|
|
||||||
/* Add a capture */
|
/* Add a capture */
|
||||||
static void pushcap(PegState *s, Janet capture, uint32_t tag) {
|
static void pushcap(PegState *s, Janet capture, uint32_t tag) {
|
||||||
if (s->mode == PEG_MODE_ACCUMULATE)
|
if (s->mode == PEG_MODE_ACCUMULATE) {
|
||||||
janet_to_string_b(s->scratch, capture);
|
janet_to_string_b(s->scratch, capture);
|
||||||
if (s->mode == PEG_MODE_NORMAL ||
|
}
|
||||||
(tag && s->mode == PEG_MODE_ACCUMULATE)) {
|
if (tag || s->mode == PEG_MODE_NORMAL) {
|
||||||
janet_array_push(s->captures, capture);
|
janet_array_push(s->captures, capture);
|
||||||
janet_buffer_push_u8(s->tags, tag);
|
janet_buffer_push_u8(s->tags, tag);
|
||||||
}
|
}
|
||||||
@@ -123,8 +124,7 @@ static void pushcap(PegState *s, Janet capture, uint32_t tag) {
|
|||||||
* Post-conditions: If there is a match, returns a pointer to the next text.
|
* Post-conditions: If there is a match, returns a pointer to the next text.
|
||||||
* All captures on the capture stack are valid. If there is no match,
|
* All captures on the capture stack are valid. If there is no match,
|
||||||
* returns NULL. Extra captures from successful child expressions can be
|
* returns NULL. Extra captures from successful child expressions can be
|
||||||
* left on the capture stack. If s->mode was PEG_MODE_NOCAPTURE, captures MUST
|
* left on the capture stack.
|
||||||
* not be changed, though.
|
|
||||||
*/
|
*/
|
||||||
static const uint8_t *peg_rule(
|
static const uint8_t *peg_rule(
|
||||||
PegState *s,
|
PegState *s,
|
||||||
@@ -136,27 +136,23 @@ tail:
|
|||||||
janet_panic("unexpected opcode");
|
janet_panic("unexpected opcode");
|
||||||
return NULL;
|
return NULL;
|
||||||
|
|
||||||
case RULE_LITERAL:
|
case RULE_LITERAL: {
|
||||||
{
|
|
||||||
uint32_t len = rule[1];
|
uint32_t len = rule[1];
|
||||||
if (text + len > s->text_end) return NULL;
|
if (text + len > s->text_end) return NULL;
|
||||||
return memcmp(text, rule + 2, len) ? NULL : text + len;
|
return memcmp(text, rule + 2, len) ? NULL : text + len;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_NCHAR:
|
case RULE_NCHAR: {
|
||||||
{
|
|
||||||
uint32_t n = rule[1];
|
uint32_t n = rule[1];
|
||||||
return (text + n > s->text_end) ? NULL : text + n;
|
return (text + n > s->text_end) ? NULL : text + n;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_NOTNCHAR:
|
case RULE_NOTNCHAR: {
|
||||||
{
|
|
||||||
uint32_t n = rule[1];
|
uint32_t n = rule[1];
|
||||||
return (text + n > s->text_end) ? text : NULL;
|
return (text + n > s->text_end) ? text : NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_RANGE:
|
case RULE_RANGE: {
|
||||||
{
|
|
||||||
uint8_t lo = rule[1] & 0xFF;
|
uint8_t lo = rule[1] & 0xFF;
|
||||||
uint8_t hi = (rule[1] >> 16) & 0xFF;
|
uint8_t hi = (rule[1] >> 16) & 0xFF;
|
||||||
return (text < s->text_end &&
|
return (text < s->text_end &&
|
||||||
@@ -166,8 +162,7 @@ tail:
|
|||||||
: NULL;
|
: NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_SET:
|
case RULE_SET: {
|
||||||
{
|
|
||||||
uint32_t word = rule[1 + (text[0] >> 5)];
|
uint32_t word = rule[1 + (text[0] >> 5)];
|
||||||
uint32_t mask = (uint32_t)1 << (text[0] & 0x1F);
|
uint32_t mask = (uint32_t)1 << (text[0] & 0x1F);
|
||||||
return (text < s->text_end && (word & mask))
|
return (text < s->text_end && (word & mask))
|
||||||
@@ -175,21 +170,16 @@ tail:
|
|||||||
: NULL;
|
: NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_LOOK:
|
case RULE_LOOK: {
|
||||||
{
|
|
||||||
text += ((int32_t *)rule)[1];
|
text += ((int32_t *)rule)[1];
|
||||||
if (text < s->text_start || text > s->text_end) return NULL;
|
if (text < s->text_start || text > s->text_end) return NULL;
|
||||||
int oldmode = s->mode;
|
|
||||||
s->mode = PEG_MODE_NOCAPTURE;
|
|
||||||
down1(s);
|
down1(s);
|
||||||
const uint8_t *result = peg_rule(s, s->bytecode + rule[2], text);
|
const uint8_t *result = peg_rule(s, s->bytecode + rule[2], text);
|
||||||
up1(s);
|
up1(s);
|
||||||
s->mode = oldmode;
|
|
||||||
return result ? text : NULL;
|
return result ? text : NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_CHOICE:
|
case RULE_CHOICE: {
|
||||||
{
|
|
||||||
uint32_t len = rule[1];
|
uint32_t len = rule[1];
|
||||||
const uint32_t *args = rule + 2;
|
const uint32_t *args = rule + 2;
|
||||||
if (len == 0) return NULL;
|
if (len == 0) return NULL;
|
||||||
@@ -208,8 +198,7 @@ tail:
|
|||||||
goto tail;
|
goto tail;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_SEQUENCE:
|
case RULE_SEQUENCE: {
|
||||||
{
|
|
||||||
uint32_t len = rule[1];
|
uint32_t len = rule[1];
|
||||||
const uint32_t *args = rule + 2;
|
const uint32_t *args = rule + 2;
|
||||||
if (len == 0) return text;
|
if (len == 0) return text;
|
||||||
@@ -223,35 +212,26 @@ tail:
|
|||||||
}
|
}
|
||||||
|
|
||||||
case RULE_IF:
|
case RULE_IF:
|
||||||
case RULE_IFNOT:
|
case RULE_IFNOT: {
|
||||||
{
|
|
||||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||||
const uint32_t *rule_b = s->bytecode + rule[2];
|
const uint32_t *rule_b = s->bytecode + rule[2];
|
||||||
int oldmode = s->mode;
|
|
||||||
s->mode = PEG_MODE_NOCAPTURE;
|
|
||||||
down1(s);
|
down1(s);
|
||||||
const uint8_t *result = peg_rule(s, rule_a, text);
|
const uint8_t *result = peg_rule(s, rule_a, text);
|
||||||
up1(s);
|
up1(s);
|
||||||
s->mode = oldmode;
|
|
||||||
if (rule[0] == RULE_IF ? !result : !!result) return NULL;
|
if (rule[0] == RULE_IF ? !result : !!result) return NULL;
|
||||||
rule = rule_b;
|
rule = rule_b;
|
||||||
goto tail;
|
goto tail;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_NOT:
|
case RULE_NOT: {
|
||||||
{
|
|
||||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||||
int oldmode = s->mode;
|
|
||||||
s->mode = PEG_MODE_NOCAPTURE;
|
|
||||||
down1(s);
|
down1(s);
|
||||||
const uint8_t *result = peg_rule(s, rule_a, text);
|
const uint8_t *result = peg_rule(s, rule_a, text);
|
||||||
up1(s);
|
up1(s);
|
||||||
s->mode = oldmode;
|
|
||||||
return (result) ? NULL : text;
|
return (result) ? NULL : text;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_BETWEEN:
|
case RULE_BETWEEN: {
|
||||||
{
|
|
||||||
uint32_t lo = rule[1];
|
uint32_t lo = rule[1];
|
||||||
uint32_t hi = rule[2];
|
uint32_t hi = rule[2];
|
||||||
const uint32_t *rule_a = s->bytecode + rule[3];
|
const uint32_t *rule_a = s->bytecode + rule[3];
|
||||||
@@ -279,8 +259,7 @@ tail:
|
|||||||
|
|
||||||
/* Capturing rules */
|
/* Capturing rules */
|
||||||
|
|
||||||
case RULE_GETTAG:
|
case RULE_GETTAG: {
|
||||||
{
|
|
||||||
uint32_t search = rule[1];
|
uint32_t search = rule[1];
|
||||||
uint32_t tag = rule[2];
|
uint32_t tag = rule[2];
|
||||||
for (int32_t i = s->tags->count - 1; i >= 0; i--) {
|
for (int32_t i = s->tags->count - 1; i >= 0; i--) {
|
||||||
@@ -292,33 +271,25 @@ tail:
|
|||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_POSITION:
|
case RULE_POSITION: {
|
||||||
{
|
|
||||||
pushcap(s, janet_wrap_number((double)(text - s->text_start)), rule[1]);
|
pushcap(s, janet_wrap_number((double)(text - s->text_start)), rule[1]);
|
||||||
return text;
|
return text;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_ARGUMENT:
|
case RULE_ARGUMENT: {
|
||||||
{
|
|
||||||
int32_t index = ((int32_t *)rule)[1];
|
int32_t index = ((int32_t *)rule)[1];
|
||||||
Janet capture = (index >= s->extrac) ? janet_wrap_nil() : s->extrav[index];
|
Janet capture = (index >= s->extrac) ? janet_wrap_nil() : s->extrav[index];
|
||||||
pushcap(s, capture, rule[2]);
|
pushcap(s, capture, rule[2]);
|
||||||
return text;
|
return text;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_CONSTANT:
|
case RULE_CONSTANT: {
|
||||||
{
|
|
||||||
pushcap(s, s->constants[rule[1]], rule[2]);
|
pushcap(s, s->constants[rule[1]], rule[2]);
|
||||||
return text;
|
return text;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_CAPTURE:
|
case RULE_CAPTURE: {
|
||||||
{
|
|
||||||
uint32_t tag = rule[2];
|
uint32_t tag = rule[2];
|
||||||
if (!tag && s->mode == PEG_MODE_NOCAPTURE) {
|
|
||||||
rule = s->bytecode + rule[1];
|
|
||||||
goto tail;
|
|
||||||
}
|
|
||||||
down1(s);
|
down1(s);
|
||||||
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
|
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
|
||||||
up1(s);
|
up1(s);
|
||||||
@@ -332,12 +303,10 @@ tail:
|
|||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_ACCUMULATE:
|
case RULE_ACCUMULATE: {
|
||||||
{
|
|
||||||
uint32_t tag = rule[2];
|
uint32_t tag = rule[2];
|
||||||
int oldmode = s->mode;
|
int oldmode = s->mode;
|
||||||
/* No capture mode, skip captures. Accumulate inside accumulate also does nothing. */
|
if (!tag && oldmode == PEG_MODE_ACCUMULATE) {
|
||||||
if (!tag && oldmode != PEG_MODE_NORMAL) {
|
|
||||||
rule = s->bytecode + rule[1];
|
rule = s->bytecode + rule[1];
|
||||||
goto tail;
|
goto tail;
|
||||||
}
|
}
|
||||||
@@ -348,14 +317,14 @@ tail:
|
|||||||
up1(s);
|
up1(s);
|
||||||
s->mode = oldmode;
|
s->mode = oldmode;
|
||||||
if (!result) return NULL;
|
if (!result) return NULL;
|
||||||
Janet cap = janet_stringv(s->scratch->data + cs.scratch, s->scratch->count - cs.scratch);
|
Janet cap = janet_stringv(s->scratch->data + cs.scratch,
|
||||||
|
s->scratch->count - cs.scratch);
|
||||||
cap_load(s, cs);
|
cap_load(s, cs);
|
||||||
pushcap(s, cap, tag);
|
pushcap(s, cap, tag);
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_DROP:
|
case RULE_DROP: {
|
||||||
{
|
|
||||||
CapState cs = cap_save(s);
|
CapState cs = cap_save(s);
|
||||||
down1(s);
|
down1(s);
|
||||||
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
|
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
|
||||||
@@ -365,14 +334,9 @@ tail:
|
|||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_GROUP:
|
case RULE_GROUP: {
|
||||||
{
|
|
||||||
uint32_t tag = rule[2];
|
uint32_t tag = rule[2];
|
||||||
int oldmode = s->mode;
|
int oldmode = s->mode;
|
||||||
if (!tag && oldmode == PEG_MODE_NOCAPTURE) {
|
|
||||||
rule = s->bytecode + rule[1];
|
|
||||||
goto tail;
|
|
||||||
}
|
|
||||||
CapState cs = cap_save(s);
|
CapState cs = cap_save(s);
|
||||||
s->mode = PEG_MODE_NORMAL;
|
s->mode = PEG_MODE_NORMAL;
|
||||||
down1(s);
|
down1(s);
|
||||||
@@ -392,14 +356,9 @@ tail:
|
|||||||
}
|
}
|
||||||
|
|
||||||
case RULE_REPLACE:
|
case RULE_REPLACE:
|
||||||
case RULE_MATCHTIME:
|
case RULE_MATCHTIME: {
|
||||||
{
|
|
||||||
uint32_t tag = rule[3];
|
uint32_t tag = rule[3];
|
||||||
int oldmode = s->mode;
|
int oldmode = s->mode;
|
||||||
if (!tag && rule[0] == RULE_REPLACE && oldmode == PEG_MODE_NOCAPTURE) {
|
|
||||||
rule = s->bytecode + rule[1];
|
|
||||||
goto tail;
|
|
||||||
}
|
|
||||||
CapState cs = cap_save(s);
|
CapState cs = cap_save(s);
|
||||||
s->mode = PEG_MODE_NORMAL;
|
s->mode = PEG_MODE_NORMAL;
|
||||||
down1(s);
|
down1(s);
|
||||||
@@ -438,8 +397,7 @@ tail:
|
|||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_ERROR:
|
case RULE_ERROR: {
|
||||||
{
|
|
||||||
int oldmode = s->mode;
|
int oldmode = s->mode;
|
||||||
s->mode = PEG_MODE_NORMAL;
|
s->mode = PEG_MODE_NORMAL;
|
||||||
int32_t old_cap = s->captures->count;
|
int32_t old_cap = s->captures->count;
|
||||||
@@ -478,7 +436,7 @@ typedef struct {
|
|||||||
} Builder;
|
} Builder;
|
||||||
|
|
||||||
/* Forward declaration to allow recursion */
|
/* Forward declaration to allow recursion */
|
||||||
static uint32_t compile1(Builder *b, Janet peg);
|
static uint32_t peg_compile1(Builder *b, Janet peg);
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* Errors
|
* Errors
|
||||||
@@ -489,7 +447,7 @@ static void builder_cleanup(Builder *b) {
|
|||||||
janet_v_free(b->bytecode);
|
janet_v_free(b->bytecode);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void peg_panic(Builder *b, const char *msg) {
|
JANET_NO_RETURN static void peg_panic(Builder *b, const char *msg) {
|
||||||
builder_cleanup(b);
|
builder_cleanup(b);
|
||||||
janet_panicf("grammar error in %p, %s", b->form, msg);
|
janet_panicf("grammar error in %p, %s", b->form, msg);
|
||||||
}
|
}
|
||||||
@@ -514,14 +472,14 @@ static void peg_arity(Builder *b, int32_t arity, int32_t min, int32_t max) {
|
|||||||
|
|
||||||
static const uint8_t *peg_getset(Builder *b, Janet x) {
|
static const uint8_t *peg_getset(Builder *b, Janet x) {
|
||||||
if (!janet_checktype(x, JANET_STRING))
|
if (!janet_checktype(x, JANET_STRING))
|
||||||
peg_panicf(b, "expected string for character set");
|
peg_panic(b, "expected string for character set");
|
||||||
const uint8_t *str = janet_unwrap_string(x);
|
const uint8_t *str = janet_unwrap_string(x);
|
||||||
return str;
|
return str;
|
||||||
}
|
}
|
||||||
|
|
||||||
static const uint8_t *peg_getrange(Builder *b, Janet x) {
|
static const uint8_t *peg_getrange(Builder *b, Janet x) {
|
||||||
if (!janet_checktype(x, JANET_STRING))
|
if (!janet_checktype(x, JANET_STRING))
|
||||||
peg_panicf(b, "expected string for character range");
|
peg_panic(b, "expected string for character range");
|
||||||
const uint8_t *str = janet_unwrap_string(x);
|
const uint8_t *str = janet_unwrap_string(x);
|
||||||
if (janet_string_length(str) != 2)
|
if (janet_string_length(str) != 2)
|
||||||
peg_panicf(b, "expected string to have length 2, got %v", x);
|
peg_panicf(b, "expected string to have length 2, got %v", x);
|
||||||
@@ -560,7 +518,7 @@ static uint32_t emit_tag(Builder *b, Janet t) {
|
|||||||
if (janet_checktype(check, JANET_NIL)) {
|
if (janet_checktype(check, JANET_NIL)) {
|
||||||
uint32_t tag = b->nexttag++;
|
uint32_t tag = b->nexttag++;
|
||||||
if (tag > 255) {
|
if (tag > 255) {
|
||||||
peg_panicf(b, "too many tags - up to 255 tags are supported per peg");
|
peg_panic(b, "too many tags - up to 255 tags are supported per peg");
|
||||||
}
|
}
|
||||||
Janet val = janet_wrap_number(tag);
|
Janet val = janet_wrap_number(tag);
|
||||||
janet_table_put(b->tags, t, val);
|
janet_table_put(b->tags, t, val);
|
||||||
@@ -664,7 +622,7 @@ static void spec_look(Builder *b, int32_t argc, const Janet *argv) {
|
|||||||
Reserve r = reserve(b, 3);
|
Reserve r = reserve(b, 3);
|
||||||
int32_t rulearg = argc == 2 ? 1 : 0;
|
int32_t rulearg = argc == 2 ? 1 : 0;
|
||||||
int32_t offset = argc == 2 ? peg_getinteger(b, argv[0]) : 0;
|
int32_t offset = argc == 2 ? peg_getinteger(b, argv[0]) : 0;
|
||||||
uint32_t subrule = compile1(b, argv[rulearg]);
|
uint32_t subrule = peg_compile1(b, argv[rulearg]);
|
||||||
emit_2(r, RULE_LOOK, (uint32_t) offset, subrule);
|
emit_2(r, RULE_LOOK, (uint32_t) offset, subrule);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -676,7 +634,7 @@ static void spec_variadic(Builder *b, int32_t argc, const Janet *argv, uint32_t
|
|||||||
for (int32_t i = 0; i < argc; i++)
|
for (int32_t i = 0; i < argc; i++)
|
||||||
janet_v_push(b->bytecode, 0);
|
janet_v_push(b->bytecode, 0);
|
||||||
for (int32_t i = 0; i < argc; i++) {
|
for (int32_t i = 0; i < argc; i++) {
|
||||||
uint32_t rulei = compile1(b, argv[i]);
|
uint32_t rulei = peg_compile1(b, argv[i]);
|
||||||
b->bytecode[rule + 2 + i] = rulei;
|
b->bytecode[rule + 2 + i] = rulei;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -692,8 +650,8 @@ static void spec_sequence(Builder *b, int32_t argc, const Janet *argv) {
|
|||||||
static void spec_branch(Builder *b, int32_t argc, const Janet *argv, uint32_t rule) {
|
static void spec_branch(Builder *b, int32_t argc, const Janet *argv, uint32_t rule) {
|
||||||
peg_fixarity(b, argc, 2);
|
peg_fixarity(b, argc, 2);
|
||||||
Reserve r = reserve(b, 3);
|
Reserve r = reserve(b, 3);
|
||||||
uint32_t rule_a = compile1(b, argv[0]);
|
uint32_t rule_a = peg_compile1(b, argv[0]);
|
||||||
uint32_t rule_b = compile1(b, argv[1]);
|
uint32_t rule_b = peg_compile1(b, argv[1]);
|
||||||
emit_2(r, rule, rule_a, rule_b);
|
emit_2(r, rule, rule_a, rule_b);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -709,14 +667,14 @@ static void spec_between(Builder *b, int32_t argc, const Janet *argv) {
|
|||||||
Reserve r = reserve(b, 4);
|
Reserve r = reserve(b, 4);
|
||||||
int32_t lo = peg_getnat(b, argv[0]);
|
int32_t lo = peg_getnat(b, argv[0]);
|
||||||
int32_t hi = peg_getnat(b, argv[1]);
|
int32_t hi = peg_getnat(b, argv[1]);
|
||||||
uint32_t subrule = compile1(b, argv[2]);
|
uint32_t subrule = peg_compile1(b, argv[2]);
|
||||||
emit_3(r, RULE_BETWEEN, lo, hi, subrule);
|
emit_3(r, RULE_BETWEEN, lo, hi, subrule);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void spec_repeater(Builder *b, int32_t argc, const Janet *argv, int32_t min) {
|
static void spec_repeater(Builder *b, int32_t argc, const Janet *argv, int32_t min) {
|
||||||
peg_fixarity(b, argc, 1);
|
peg_fixarity(b, argc, 1);
|
||||||
Reserve r = reserve(b, 4);
|
Reserve r = reserve(b, 4);
|
||||||
uint32_t subrule = compile1(b, argv[0]);
|
uint32_t subrule = peg_compile1(b, argv[0]);
|
||||||
emit_3(r, RULE_BETWEEN, min, UINT32_MAX, subrule);
|
emit_3(r, RULE_BETWEEN, min, UINT32_MAX, subrule);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -731,7 +689,7 @@ static void spec_atleast(Builder *b, int32_t argc, const Janet *argv) {
|
|||||||
peg_fixarity(b, argc, 2);
|
peg_fixarity(b, argc, 2);
|
||||||
Reserve r = reserve(b, 4);
|
Reserve r = reserve(b, 4);
|
||||||
int32_t n = peg_getnat(b, argv[0]);
|
int32_t n = peg_getnat(b, argv[0]);
|
||||||
uint32_t subrule = compile1(b, argv[1]);
|
uint32_t subrule = peg_compile1(b, argv[1]);
|
||||||
emit_3(r, RULE_BETWEEN, n, UINT32_MAX, subrule);
|
emit_3(r, RULE_BETWEEN, n, UINT32_MAX, subrule);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -739,14 +697,14 @@ static void spec_atmost(Builder *b, int32_t argc, const Janet *argv) {
|
|||||||
peg_fixarity(b, argc, 2);
|
peg_fixarity(b, argc, 2);
|
||||||
Reserve r = reserve(b, 4);
|
Reserve r = reserve(b, 4);
|
||||||
int32_t n = peg_getnat(b, argv[0]);
|
int32_t n = peg_getnat(b, argv[0]);
|
||||||
uint32_t subrule = compile1(b, argv[1]);
|
uint32_t subrule = peg_compile1(b, argv[1]);
|
||||||
emit_3(r, RULE_BETWEEN, 0, n, subrule);
|
emit_3(r, RULE_BETWEEN, 0, n, subrule);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void spec_opt(Builder *b, int32_t argc, const Janet *argv) {
|
static void spec_opt(Builder *b, int32_t argc, const Janet *argv) {
|
||||||
peg_fixarity(b, argc, 1);
|
peg_fixarity(b, argc, 1);
|
||||||
Reserve r = reserve(b, 4);
|
Reserve r = reserve(b, 4);
|
||||||
uint32_t subrule = compile1(b, argv[0]);
|
uint32_t subrule = peg_compile1(b, argv[0]);
|
||||||
emit_3(r, RULE_BETWEEN, 0, 1, subrule);
|
emit_3(r, RULE_BETWEEN, 0, 1, subrule);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -755,7 +713,7 @@ static void spec_opt(Builder *b, int32_t argc, const Janet *argv) {
|
|||||||
static void spec_onerule(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
|
static void spec_onerule(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
|
||||||
peg_fixarity(b, argc, 1);
|
peg_fixarity(b, argc, 1);
|
||||||
Reserve r = reserve(b, 2);
|
Reserve r = reserve(b, 2);
|
||||||
uint32_t rule = compile1(b, argv[0]);
|
uint32_t rule = peg_compile1(b, argv[0]);
|
||||||
emit_1(r, op, rule);
|
emit_1(r, op, rule);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -774,7 +732,7 @@ static void spec_cap1(Builder *b, int32_t argc, const Janet *argv, uint32_t op)
|
|||||||
peg_arity(b, argc, 1, 2);
|
peg_arity(b, argc, 1, 2);
|
||||||
Reserve r = reserve(b, 3);
|
Reserve r = reserve(b, 3);
|
||||||
uint32_t tag = (argc == 2) ? emit_tag(b, argv[1]) : 0;
|
uint32_t tag = (argc == 2) ? emit_tag(b, argv[1]) : 0;
|
||||||
uint32_t rule = compile1(b, argv[0]);
|
uint32_t rule = peg_compile1(b, argv[0]);
|
||||||
emit_2(r, op, rule, tag);
|
emit_2(r, op, rule, tag);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -822,7 +780,7 @@ static void spec_constant(Builder *b, int32_t argc, const Janet *argv) {
|
|||||||
static void spec_replace(Builder *b, int32_t argc, const Janet *argv) {
|
static void spec_replace(Builder *b, int32_t argc, const Janet *argv) {
|
||||||
peg_arity(b, argc, 2, 3);
|
peg_arity(b, argc, 2, 3);
|
||||||
Reserve r = reserve(b, 4);
|
Reserve r = reserve(b, 4);
|
||||||
uint32_t subrule = compile1(b, argv[0]);
|
uint32_t subrule = peg_compile1(b, argv[0]);
|
||||||
uint32_t constant = emit_constant(b, argv[1]);
|
uint32_t constant = emit_constant(b, argv[1]);
|
||||||
uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
|
uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
|
||||||
emit_3(r, RULE_REPLACE, subrule, constant, tag);
|
emit_3(r, RULE_REPLACE, subrule, constant, tag);
|
||||||
@@ -831,7 +789,7 @@ static void spec_replace(Builder *b, int32_t argc, const Janet *argv) {
|
|||||||
static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
|
static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
|
||||||
peg_arity(b, argc, 2, 3);
|
peg_arity(b, argc, 2, 3);
|
||||||
Reserve r = reserve(b, 4);
|
Reserve r = reserve(b, 4);
|
||||||
uint32_t subrule = compile1(b, argv[0]);
|
uint32_t subrule = peg_compile1(b, argv[0]);
|
||||||
Janet fun = argv[1];
|
Janet fun = argv[1];
|
||||||
if (!janet_checktype(fun, JANET_FUNCTION) &&
|
if (!janet_checktype(fun, JANET_FUNCTION) &&
|
||||||
!janet_checktype(fun, JANET_CFUNCTION)) {
|
!janet_checktype(fun, JANET_CFUNCTION)) {
|
||||||
@@ -850,7 +808,7 @@ typedef struct {
|
|||||||
} SpecialPair;
|
} SpecialPair;
|
||||||
|
|
||||||
/* Keep in lexical order (vim :sort works well) */
|
/* Keep in lexical order (vim :sort works well) */
|
||||||
static const SpecialPair specials[] = {
|
static const SpecialPair peg_specials[] = {
|
||||||
{"!", spec_not},
|
{"!", spec_not},
|
||||||
{"$", spec_position},
|
{"$", spec_position},
|
||||||
{"%", spec_accumulate},
|
{"%", spec_accumulate},
|
||||||
@@ -890,7 +848,7 @@ static const SpecialPair specials[] = {
|
|||||||
};
|
};
|
||||||
|
|
||||||
/* Compile a janet value into a rule and return the rule index. */
|
/* Compile a janet value into a rule and return the rule index. */
|
||||||
static uint32_t compile1(Builder *b, Janet peg) {
|
static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||||
|
|
||||||
/* Check for already compiled rules */
|
/* Check for already compiled rules */
|
||||||
Janet check = janet_table_get(b->memoized, peg);
|
Janet check = janet_table_get(b->memoized, peg);
|
||||||
@@ -917,10 +875,9 @@ static uint32_t compile1(Builder *b, Janet peg) {
|
|||||||
|
|
||||||
switch (janet_type(peg)) {
|
switch (janet_type(peg)) {
|
||||||
default:
|
default:
|
||||||
peg_panicf(b, "unexpected peg source");
|
peg_panic(b, "unexpected peg source");
|
||||||
return 0;
|
return 0;
|
||||||
case JANET_NUMBER:
|
case JANET_NUMBER: {
|
||||||
{
|
|
||||||
int32_t n = peg_getinteger(b, peg);
|
int32_t n = peg_getinteger(b, peg);
|
||||||
Reserve r = reserve(b, 2);
|
Reserve r = reserve(b, 2);
|
||||||
if (n < 0) {
|
if (n < 0) {
|
||||||
@@ -930,35 +887,31 @@ static uint32_t compile1(Builder *b, Janet peg) {
|
|||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_STRING:
|
case JANET_STRING: {
|
||||||
{
|
|
||||||
const uint8_t *str = janet_unwrap_string(peg);
|
const uint8_t *str = janet_unwrap_string(peg);
|
||||||
int32_t len = janet_string_length(str);
|
int32_t len = janet_string_length(str);
|
||||||
emit_bytes(b, RULE_LITERAL, len, str);
|
emit_bytes(b, RULE_LITERAL, len, str);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_KEYWORD:
|
case JANET_KEYWORD: {
|
||||||
{
|
|
||||||
Janet check = janet_table_get(b->grammar, peg);
|
Janet check = janet_table_get(b->grammar, peg);
|
||||||
if (janet_checktype(check, JANET_NIL))
|
if (janet_checktype(check, JANET_NIL))
|
||||||
peg_panicf(b, "unknown rule");
|
peg_panic(b, "unknown rule");
|
||||||
rule = compile1(b, check);
|
rule = peg_compile1(b, check);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_STRUCT:
|
case JANET_STRUCT: {
|
||||||
{
|
|
||||||
JanetTable *grammar = janet_struct_to_table(janet_unwrap_struct(peg));
|
JanetTable *grammar = janet_struct_to_table(janet_unwrap_struct(peg));
|
||||||
grammar->proto = b->grammar;
|
grammar->proto = b->grammar;
|
||||||
b->grammar = grammar;
|
b->grammar = grammar;
|
||||||
Janet main_rule = janet_table_get(grammar, janet_ckeywordv("main"));
|
Janet main_rule = janet_table_get(grammar, janet_ckeywordv("main"));
|
||||||
if (janet_checktype(main_rule, JANET_NIL))
|
if (janet_checktype(main_rule, JANET_NIL))
|
||||||
peg_panicf(b, "grammar requires :main rule");
|
peg_panic(b, "grammar requires :main rule");
|
||||||
rule = compile1(b, main_rule);
|
rule = peg_compile1(b, main_rule);
|
||||||
b->grammar = grammar->proto;
|
b->grammar = grammar->proto;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE: {
|
||||||
{
|
|
||||||
const Janet *tup = janet_unwrap_tuple(peg);
|
const Janet *tup = janet_unwrap_tuple(peg);
|
||||||
int32_t len = janet_tuple_length(tup);
|
int32_t len = janet_tuple_length(tup);
|
||||||
if (len == 0) peg_panic(b, "tuple in grammar must have non-zero length");
|
if (len == 0) peg_panic(b, "tuple in grammar must have non-zero length");
|
||||||
@@ -966,13 +919,15 @@ static uint32_t compile1(Builder *b, Janet peg) {
|
|||||||
peg_panicf(b, "expected grammar command, found %v", tup[0]);
|
peg_panicf(b, "expected grammar command, found %v", tup[0]);
|
||||||
const uint8_t *sym = janet_unwrap_symbol(tup[0]);
|
const uint8_t *sym = janet_unwrap_symbol(tup[0]);
|
||||||
const SpecialPair *sp = janet_strbinsearch(
|
const SpecialPair *sp = janet_strbinsearch(
|
||||||
&specials,
|
&peg_specials,
|
||||||
sizeof(specials)/sizeof(SpecialPair),
|
sizeof(peg_specials) / sizeof(SpecialPair),
|
||||||
sizeof(SpecialPair),
|
sizeof(SpecialPair),
|
||||||
sym);
|
sym);
|
||||||
if (!sp)
|
if (sp) {
|
||||||
peg_panicf(b, "unknown special %S", sym);
|
|
||||||
sp->special(b, len - 1, tup + 1);
|
sp->special(b, len - 1, tup + 1);
|
||||||
|
} else {
|
||||||
|
peg_panicf(b, "unknown special %S", sym);
|
||||||
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -990,37 +945,214 @@ static uint32_t compile1(Builder *b, Janet peg) {
|
|||||||
typedef struct {
|
typedef struct {
|
||||||
uint32_t *bytecode;
|
uint32_t *bytecode;
|
||||||
Janet *constants;
|
Janet *constants;
|
||||||
|
size_t bytecode_len;
|
||||||
uint32_t num_constants;
|
uint32_t num_constants;
|
||||||
} Peg;
|
} Peg;
|
||||||
|
|
||||||
static int peg_mark(void *p, size_t size) {
|
static int peg_mark(void *p, size_t size) {
|
||||||
(void) size;
|
(void) size;
|
||||||
Peg *peg = (Peg *)p;
|
Peg *peg = (Peg *)p;
|
||||||
|
if (NULL != peg->constants)
|
||||||
for (uint32_t i = 0; i < peg->num_constants; i++)
|
for (uint32_t i = 0; i < peg->num_constants; i++)
|
||||||
janet_mark(peg->constants[i]);
|
janet_mark(peg->constants[i]);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static JanetAbstractType peg_type = {
|
static void peg_marshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
Peg *peg = (Peg *)p;
|
||||||
|
janet_marshal_size(ctx, peg->bytecode_len);
|
||||||
|
janet_marshal_int(ctx, (int32_t)peg->num_constants);
|
||||||
|
for (size_t i = 0; i < peg->bytecode_len; i++)
|
||||||
|
janet_marshal_int(ctx, (int32_t) peg->bytecode[i]);
|
||||||
|
for (uint32_t j = 0; j < peg->num_constants; j++)
|
||||||
|
janet_marshal_janet(ctx, peg->constants[j]);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Used to ensure that if we place several arrays in one memory chunk, each
|
||||||
|
* array will be correctly aligned */
|
||||||
|
static size_t size_padded(size_t offset, size_t size) {
|
||||||
|
size_t x = size + offset - 1;
|
||||||
|
return x - (x % size);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void peg_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
char *mem = p;
|
||||||
|
Peg *peg = (Peg *)p;
|
||||||
|
peg->bytecode_len = janet_unmarshal_size(ctx);
|
||||||
|
peg->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_size = peg->bytecode_len * sizeof(uint32_t);
|
||||||
|
size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet));
|
||||||
|
uint32_t *bytecode = (uint32_t *)(mem + bytecode_start);
|
||||||
|
Janet *constants = (Janet *)(mem + constants_start);
|
||||||
|
peg->bytecode = NULL;
|
||||||
|
peg->constants = NULL;
|
||||||
|
|
||||||
|
/* Ensure not too large */
|
||||||
|
if (constants_start + sizeof(Janet) * peg->num_constants > janet_abstract_size(p)) {
|
||||||
|
janet_panic("size mismatch");
|
||||||
|
}
|
||||||
|
|
||||||
|
for (size_t i = 0; i < peg->bytecode_len; i++)
|
||||||
|
bytecode[i] = (uint32_t) janet_unmarshal_int(ctx);
|
||||||
|
for (uint32_t j = 0; j < peg->num_constants; j++)
|
||||||
|
constants[j] = janet_unmarshal_janet(ctx);
|
||||||
|
|
||||||
|
/* After here, no panics except for the bad: label. */
|
||||||
|
|
||||||
|
/* Keep track at each index if an instruction was
|
||||||
|
* reference (0x01) or is in a main bytecode position
|
||||||
|
* (0x02). This lets us do a linear scan and not
|
||||||
|
* need to a depth first traversal. It is stricter
|
||||||
|
* than a dfs by not allowing certain kinds of unused
|
||||||
|
* bytecode. */
|
||||||
|
uint32_t blen = (int32_t) peg->bytecode_len;
|
||||||
|
uint32_t clen = peg->num_constants;
|
||||||
|
uint8_t *op_flags = calloc(1, blen);
|
||||||
|
if (NULL == op_flags) {
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* verify peg bytecode */
|
||||||
|
uint32_t i = 0;
|
||||||
|
while (i < blen) {
|
||||||
|
uint32_t instr = bytecode[i];
|
||||||
|
uint32_t *rule = bytecode + i;
|
||||||
|
op_flags[i] |= 0x02;
|
||||||
|
switch (instr & 0x1F) {
|
||||||
|
case RULE_LITERAL:
|
||||||
|
i += 2 + ((rule[1] + 3) >> 2);
|
||||||
|
break;
|
||||||
|
case RULE_NCHAR:
|
||||||
|
case RULE_NOTNCHAR:
|
||||||
|
case RULE_RANGE:
|
||||||
|
case RULE_POSITION:
|
||||||
|
/* [1 word] */
|
||||||
|
i += 2;
|
||||||
|
break;
|
||||||
|
case RULE_SET:
|
||||||
|
/* [8 words] */
|
||||||
|
i += 9;
|
||||||
|
break;
|
||||||
|
case RULE_LOOK:
|
||||||
|
/* [offset, rule] */
|
||||||
|
if (rule[2] >= blen) goto bad;
|
||||||
|
op_flags[rule[2]] |= 0x1;
|
||||||
|
i += 3;
|
||||||
|
break;
|
||||||
|
case RULE_CHOICE:
|
||||||
|
case RULE_SEQUENCE:
|
||||||
|
/* [len, rules...] */
|
||||||
|
{
|
||||||
|
uint32_t len = rule[1];
|
||||||
|
for (uint32_t j = 0; j < len; j++) {
|
||||||
|
if (rule[2 + j] >= blen) goto bad;
|
||||||
|
op_flags[rule[2 + j]] |= 0x1;
|
||||||
|
}
|
||||||
|
i += 2 + len;
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
case RULE_IF:
|
||||||
|
case RULE_IFNOT:
|
||||||
|
/* [rule_a, rule_b (b if not a)] */
|
||||||
|
if (rule[1] >= blen) goto bad;
|
||||||
|
if (rule[2] >= blen) goto bad;
|
||||||
|
op_flags[rule[1]] |= 0x01;
|
||||||
|
op_flags[rule[2]] |= 0x01;
|
||||||
|
i += 3;
|
||||||
|
break;
|
||||||
|
case RULE_BETWEEN:
|
||||||
|
/* [lo, hi, rule] */
|
||||||
|
if (rule[3] >= blen) goto bad;
|
||||||
|
op_flags[rule[3]] |= 0x01;
|
||||||
|
i += 4;
|
||||||
|
break;
|
||||||
|
case RULE_ARGUMENT:
|
||||||
|
case RULE_GETTAG:
|
||||||
|
/* [searchtag, tag] */
|
||||||
|
i += 3;
|
||||||
|
break;
|
||||||
|
case RULE_CONSTANT:
|
||||||
|
/* [constant, tag] */
|
||||||
|
if (rule[1] >= clen) goto bad;
|
||||||
|
i += 3;
|
||||||
|
break;
|
||||||
|
case RULE_ACCUMULATE:
|
||||||
|
case RULE_GROUP:
|
||||||
|
case RULE_CAPTURE:
|
||||||
|
/* [rule, tag] */
|
||||||
|
if (rule[1] >= blen) goto bad;
|
||||||
|
op_flags[rule[1]] |= 0x01;
|
||||||
|
i += 3;
|
||||||
|
break;
|
||||||
|
case RULE_REPLACE:
|
||||||
|
case RULE_MATCHTIME:
|
||||||
|
/* [rule, constant, tag] */
|
||||||
|
if (rule[1] >= blen) goto bad;
|
||||||
|
if (rule[2] >= clen) goto bad;
|
||||||
|
op_flags[rule[1]] |= 0x01;
|
||||||
|
i += 4;
|
||||||
|
break;
|
||||||
|
case RULE_ERROR:
|
||||||
|
case RULE_DROP:
|
||||||
|
case RULE_NOT:
|
||||||
|
/* [rule] */
|
||||||
|
if (rule[1] >= blen) goto bad;
|
||||||
|
op_flags[rule[1]] |= 0x01;
|
||||||
|
i += 2;
|
||||||
|
break;
|
||||||
|
default:
|
||||||
|
goto bad;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* last instruction cannot overflow */
|
||||||
|
if (i != blen) goto bad;
|
||||||
|
|
||||||
|
/* Make sure all referenced instructions are actually
|
||||||
|
* in instruction positions. */
|
||||||
|
for (i = 0; i < blen; i++)
|
||||||
|
if (op_flags[i] == 0x01) goto bad;
|
||||||
|
|
||||||
|
/* Good return */
|
||||||
|
peg->bytecode = bytecode;
|
||||||
|
peg->constants = constants;
|
||||||
|
free(op_flags);
|
||||||
|
return;
|
||||||
|
|
||||||
|
bad:
|
||||||
|
free(op_flags);
|
||||||
|
janet_panic("invalid peg bytecode");
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetAbstractType peg_type = {
|
||||||
"core/peg",
|
"core/peg",
|
||||||
NULL,
|
NULL,
|
||||||
peg_mark,
|
peg_mark,
|
||||||
NULL,
|
NULL,
|
||||||
|
NULL,
|
||||||
|
peg_marshal,
|
||||||
|
peg_unmarshal,
|
||||||
NULL
|
NULL
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Convert Builder to Peg (Janet Abstract Value) */
|
/* Convert Builder to Peg (Janet Abstract Value) */
|
||||||
static Peg *make_peg(Builder *b) {
|
static Peg *make_peg(Builder *b) {
|
||||||
|
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
|
||||||
size_t bytecode_size = janet_v_count(b->bytecode) * 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 constants_size = janet_v_count(b->constants) * sizeof(Janet);
|
||||||
size_t total_size = bytecode_size + constants_size + sizeof(Peg);
|
size_t total_size = constants_start + constants_size;
|
||||||
char *mem = janet_abstract(&peg_type, total_size);
|
char *mem = janet_abstract(&peg_type, total_size);
|
||||||
Peg *peg = (Peg *)mem;
|
Peg *peg = (Peg *)mem;
|
||||||
peg->bytecode = (uint32_t *)(mem + sizeof(Peg));
|
peg->bytecode = (uint32_t *)(mem + bytecode_start);
|
||||||
peg->constants = (Janet *)(mem + sizeof(Peg) + bytecode_size);
|
peg->constants = (Janet *)(mem + constants_start);
|
||||||
peg->num_constants = janet_v_count(b->constants);
|
peg->num_constants = janet_v_count(b->constants);
|
||||||
memcpy(peg->bytecode, b->bytecode, bytecode_size);
|
memcpy(peg->bytecode, b->bytecode, bytecode_size);
|
||||||
memcpy(peg->constants, b->constants, constants_size);
|
memcpy(peg->constants, b->constants, constants_size);
|
||||||
|
peg->bytecode_len = janet_v_count(b->bytecode);
|
||||||
return peg;
|
return peg;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -1035,7 +1167,7 @@ static Peg *compile_peg(Janet x) {
|
|||||||
builder.nexttag = 1;
|
builder.nexttag = 1;
|
||||||
builder.form = x;
|
builder.form = x;
|
||||||
builder.depth = JANET_RECURSION_GUARD;
|
builder.depth = JANET_RECURSION_GUARD;
|
||||||
compile1(&builder, x);
|
peg_compile1(&builder, x);
|
||||||
Peg *peg = make_peg(&builder);
|
Peg *peg = make_peg(&builder);
|
||||||
builder_cleanup(&builder);
|
builder_cleanup(&builder);
|
||||||
return peg;
|
return peg;
|
||||||
@@ -1066,7 +1198,7 @@ static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
|||||||
if (argc > 2) {
|
if (argc > 2) {
|
||||||
start = janet_gethalfrange(argv, 2, bytes.len, "offset");
|
start = janet_gethalfrange(argv, 2, bytes.len, "offset");
|
||||||
s.extrac = argc - 3;
|
s.extrac = argc - 3;
|
||||||
s.extrav = argv + 3;
|
s.extrav = janet_tuple_n(argv + 3, argc - 3);
|
||||||
} else {
|
} else {
|
||||||
start = 0;
|
start = 0;
|
||||||
s.extrac = 0;
|
s.extrac = 0;
|
||||||
@@ -1079,7 +1211,6 @@ static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
|||||||
s.captures = janet_array(0);
|
s.captures = janet_array(0);
|
||||||
s.scratch = janet_buffer(10);
|
s.scratch = janet_buffer(10);
|
||||||
s.tags = janet_buffer(10);
|
s.tags = janet_buffer(10);
|
||||||
|
|
||||||
s.constants = peg->constants;
|
s.constants = peg->constants;
|
||||||
s.bytecode = peg->bytecode;
|
s.bytecode = peg->bytecode;
|
||||||
const uint8_t *result = peg_rule(&s, s.bytecode, bytes.bytes + start);
|
const uint8_t *result = peg_rule(&s, s.bytecode, bytes.bytes + start);
|
||||||
@@ -1087,13 +1218,15 @@ static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg peg_cfuns[] = {
|
static const JanetReg peg_cfuns[] = {
|
||||||
{"peg/compile", cfun_peg_compile,
|
{
|
||||||
|
"peg/compile", cfun_peg_compile,
|
||||||
JDOC("(peg/compile peg)\n\n"
|
JDOC("(peg/compile peg)\n\n"
|
||||||
"Compiles a peg source data structure into a <core/peg>. This will speed up matching "
|
"Compiles a peg source data structure into a <core/peg>. This will speed up matching "
|
||||||
"if the same peg will be used multiple times.")
|
"if the same peg will be used multiple times.")
|
||||||
},
|
},
|
||||||
{"peg/match", cfun_peg_match,
|
{
|
||||||
JDOC("(peg/match peg text [,start=0])\n\n"
|
"peg/match", cfun_peg_match,
|
||||||
|
JDOC("(peg/match peg text &opt start & args)\n\n"
|
||||||
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
|
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
|
||||||
"Returns nil if text does not match the language defined by peg. The syntax of PEGs are very "
|
"Returns nil if text does not match the language defined by peg. The syntax of PEGs are very "
|
||||||
"similar to those defined by LPeg, and have similar capabilities.")
|
"similar to those defined by LPeg, and have similar capabilities.")
|
||||||
@@ -1104,4 +1237,7 @@ static const JanetReg peg_cfuns[] = {
|
|||||||
/* Load the peg module */
|
/* Load the peg module */
|
||||||
void janet_lib_peg(JanetTable *env) {
|
void janet_lib_peg(JanetTable *env) {
|
||||||
janet_core_cfuns(env, NULL, peg_cfuns);
|
janet_core_cfuns(env, NULL, peg_cfuns);
|
||||||
|
janet_register_abstract_type(&peg_type);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#endif /* ifdef JANET_PEG */
|
||||||
|
|||||||
265
src/core/pp.c
265
src/core/pp.c
@@ -24,7 +24,7 @@
|
|||||||
#include <ctype.h>
|
#include <ctype.h>
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#endif
|
#endif
|
||||||
@@ -136,6 +136,15 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
|
|||||||
case '\0':
|
case '\0':
|
||||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\0", 2);
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\0", 2);
|
||||||
break;
|
break;
|
||||||
|
case '\f':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\f", 2);
|
||||||
|
break;
|
||||||
|
case '\v':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
|
||||||
|
break;
|
||||||
|
case 27:
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
|
||||||
|
break;
|
||||||
case '\\':
|
case '\\':
|
||||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
|
||||||
break;
|
break;
|
||||||
@@ -170,11 +179,9 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
|
|||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
janet_buffer_push_cstring(buffer, "nil");
|
janet_buffer_push_cstring(buffer, "nil");
|
||||||
return;
|
return;
|
||||||
case JANET_TRUE:
|
case JANET_BOOLEAN:
|
||||||
janet_buffer_push_cstring(buffer, "true");
|
janet_buffer_push_cstring(buffer,
|
||||||
return;
|
janet_unwrap_boolean(x) ? "true" : "false");
|
||||||
case JANET_FALSE:
|
|
||||||
janet_buffer_push_cstring(buffer, "false");
|
|
||||||
return;
|
return;
|
||||||
case JANET_NUMBER:
|
case JANET_NUMBER:
|
||||||
number_to_string_b(buffer, janet_unwrap_number(x));
|
number_to_string_b(buffer, janet_unwrap_number(x));
|
||||||
@@ -190,17 +197,27 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
|
|||||||
case JANET_STRING:
|
case JANET_STRING:
|
||||||
janet_escape_string_b(buffer, janet_unwrap_string(x));
|
janet_escape_string_b(buffer, janet_unwrap_string(x));
|
||||||
return;
|
return;
|
||||||
case JANET_BUFFER:
|
case JANET_BUFFER: {
|
||||||
janet_escape_buffer_b(buffer, janet_unwrap_buffer(x));
|
JanetBuffer *b = janet_unwrap_buffer(x);
|
||||||
return;
|
if (b == buffer) {
|
||||||
case JANET_ABSTRACT:
|
/* Ensures buffer won't resize while escaping */
|
||||||
{
|
janet_buffer_ensure(b, 5 * b->count + 3, 1);
|
||||||
const char *n = janet_abstract_type(janet_unwrap_abstract(x))->name;
|
}
|
||||||
string_description_b(buffer, n, janet_unwrap_abstract(x));
|
janet_escape_buffer_b(buffer, b);
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
case JANET_CFUNCTION:
|
case JANET_ABSTRACT: {
|
||||||
{
|
void *p = janet_unwrap_abstract(x);
|
||||||
|
const JanetAbstractType *at = janet_abstract_type(p);
|
||||||
|
if (at->tostring) {
|
||||||
|
at->tostring(p, buffer);
|
||||||
|
} else {
|
||||||
|
const char *n = at->name;
|
||||||
|
string_description_b(buffer, n, janet_unwrap_abstract(x));
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
case JANET_CFUNCTION: {
|
||||||
Janet check = janet_table_get(janet_vm_registry, x);
|
Janet check = janet_table_get(janet_vm_registry, x);
|
||||||
if (janet_checktype(check, JANET_SYMBOL)) {
|
if (janet_checktype(check, JANET_SYMBOL)) {
|
||||||
janet_buffer_push_cstring(buffer, "<cfunction ");
|
janet_buffer_push_cstring(buffer, "<cfunction ");
|
||||||
@@ -212,8 +229,7 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
|
|||||||
}
|
}
|
||||||
goto fallthrough;
|
goto fallthrough;
|
||||||
}
|
}
|
||||||
case JANET_FUNCTION:
|
case JANET_FUNCTION: {
|
||||||
{
|
|
||||||
JanetFunction *fun = janet_unwrap_function(x);
|
JanetFunction *fun = janet_unwrap_function(x);
|
||||||
JanetFuncDef *def = fun->def;
|
JanetFuncDef *def = fun->def;
|
||||||
if (def->name) {
|
if (def->name) {
|
||||||
@@ -265,8 +281,7 @@ const uint8_t *janet_description(Janet x) {
|
|||||||
* strings, symbols, and buffers will return their content. */
|
* strings, symbols, and buffers will return their content. */
|
||||||
const uint8_t *janet_to_string(Janet x) {
|
const uint8_t *janet_to_string(Janet x) {
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
default:
|
default: {
|
||||||
{
|
|
||||||
JanetBuffer b;
|
JanetBuffer b;
|
||||||
janet_buffer_init(&b, 10);
|
janet_buffer_init(&b, 10);
|
||||||
janet_to_string_b(&b, x);
|
janet_to_string_b(&b, x);
|
||||||
@@ -288,6 +303,8 @@ struct pretty {
|
|||||||
JanetBuffer *buffer;
|
JanetBuffer *buffer;
|
||||||
int depth;
|
int depth;
|
||||||
int indent;
|
int indent;
|
||||||
|
int flags;
|
||||||
|
int32_t bufstartlen;
|
||||||
JanetTable seen;
|
JanetTable seen;
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -303,6 +320,30 @@ static void print_newline(struct pretty *S, int just_a_space) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Color coding for types */
|
||||||
|
static const char janet_cycle_color[] = "\x1B[36m";
|
||||||
|
static const char *janet_pretty_colors[] = {
|
||||||
|
"\x1B[32m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[35m",
|
||||||
|
"\x1B[34m",
|
||||||
|
"\x1B[33m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m"
|
||||||
|
"\x1B[35m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m",
|
||||||
|
"\x1B[36m"
|
||||||
|
};
|
||||||
|
|
||||||
|
#define JANET_PRETTY_DICT_ONELINE 4
|
||||||
|
#define JANET_PRETTY_IND_ONELINE 10
|
||||||
|
|
||||||
/* Helper for pretty printing */
|
/* Helper for pretty printing */
|
||||||
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||||
/* Add to seen */
|
/* Add to seen */
|
||||||
@@ -310,16 +351,20 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
|||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
case JANET_NUMBER:
|
case JANET_NUMBER:
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
case JANET_TRUE:
|
case JANET_BOOLEAN:
|
||||||
case JANET_FALSE:
|
|
||||||
break;
|
break;
|
||||||
default:
|
default: {
|
||||||
{
|
|
||||||
Janet seenid = janet_table_get(&S->seen, x);
|
Janet seenid = janet_table_get(&S->seen, x);
|
||||||
if (janet_checktype(seenid, JANET_NUMBER)) {
|
if (janet_checktype(seenid, JANET_NUMBER)) {
|
||||||
|
if (S->flags & JANET_PRETTY_COLOR) {
|
||||||
|
janet_buffer_push_cstring(S->buffer, janet_cycle_color);
|
||||||
|
}
|
||||||
janet_buffer_push_cstring(S->buffer, "<cycle ");
|
janet_buffer_push_cstring(S->buffer, "<cycle ");
|
||||||
integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
|
integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
|
||||||
janet_buffer_push_u8(S->buffer, '>');
|
janet_buffer_push_u8(S->buffer, '>');
|
||||||
|
if (S->flags & JANET_PRETTY_COLOR) {
|
||||||
|
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
|
||||||
|
}
|
||||||
return;
|
return;
|
||||||
} else {
|
} else {
|
||||||
janet_table_put(&S->seen, x, janet_wrap_integer(S->seen.count));
|
janet_table_put(&S->seen, x, janet_wrap_integer(S->seen.count));
|
||||||
@@ -329,14 +374,27 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
default:
|
default: {
|
||||||
|
const char *color = janet_pretty_colors[janet_type(x)];
|
||||||
|
if (color && (S->flags & JANET_PRETTY_COLOR)) {
|
||||||
|
janet_buffer_push_cstring(S->buffer, color);
|
||||||
|
}
|
||||||
|
if (janet_checktype(x, JANET_BUFFER) && janet_unwrap_buffer(x) == S->buffer) {
|
||||||
|
janet_buffer_ensure(S->buffer, S->buffer->count + S->bufstartlen * 4 + 3, 1);
|
||||||
|
janet_buffer_push_u8(S->buffer, '@');
|
||||||
|
janet_escape_string_impl(S->buffer, S->buffer->data, S->bufstartlen);
|
||||||
|
} else {
|
||||||
janet_description_b(S->buffer, x);
|
janet_description_b(S->buffer, x);
|
||||||
|
}
|
||||||
|
if (color && (S->flags & JANET_PRETTY_COLOR)) {
|
||||||
|
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
|
||||||
|
}
|
||||||
break;
|
break;
|
||||||
|
}
|
||||||
case JANET_ARRAY:
|
case JANET_ARRAY:
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE: {
|
||||||
{
|
int32_t i = 0, len = 0;
|
||||||
int32_t i, len;
|
const Janet *arr = NULL;
|
||||||
const Janet *arr;
|
|
||||||
int isarray = janet_checktype(x, JANET_ARRAY);
|
int isarray = janet_checktype(x, JANET_ARRAY);
|
||||||
janet_indexed_view(x, &arr, &len);
|
janet_indexed_view(x, &arr, &len);
|
||||||
int hasbrackets = !isarray && (janet_tuple_flag(arr) & JANET_TUPLE_FLAG_BRACKETCTOR);
|
int hasbrackets = !isarray && (janet_tuple_flag(arr) & JANET_TUPLE_FLAG_BRACKETCTOR);
|
||||||
@@ -348,11 +406,11 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
|||||||
if (S->depth == 0) {
|
if (S->depth == 0) {
|
||||||
janet_buffer_push_cstring(S->buffer, "...");
|
janet_buffer_push_cstring(S->buffer, "...");
|
||||||
} else {
|
} else {
|
||||||
if (!isarray && len >= 5)
|
if (!isarray && len >= JANET_PRETTY_IND_ONELINE)
|
||||||
janet_buffer_push_u8(S->buffer, ' ');
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
if (is_dict_value && len >= 5) print_newline(S, 0);
|
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
|
||||||
for (i = 0; i < len; i++) {
|
for (i = 0; i < len; i++) {
|
||||||
if (i) print_newline(S, len < 5);
|
if (i) print_newline(S, len < JANET_PRETTY_IND_ONELINE);
|
||||||
janet_pretty_one(S, arr[i], 0);
|
janet_pretty_one(S, arr[i], 0);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -362,8 +420,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_STRUCT:
|
case JANET_STRUCT:
|
||||||
case JANET_TABLE:
|
case JANET_TABLE: {
|
||||||
{
|
|
||||||
int istable = janet_checktype(x, JANET_TABLE);
|
int istable = janet_checktype(x, JANET_TABLE);
|
||||||
janet_buffer_push_cstring(S->buffer, istable ? "@" : "{");
|
janet_buffer_push_cstring(S->buffer, istable ? "@" : "{");
|
||||||
|
|
||||||
@@ -386,19 +443,19 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
|||||||
if (S->depth == 0) {
|
if (S->depth == 0) {
|
||||||
janet_buffer_push_cstring(S->buffer, "...");
|
janet_buffer_push_cstring(S->buffer, "...");
|
||||||
} else {
|
} else {
|
||||||
int32_t i, len, cap;
|
int32_t i = 0, len = 0, cap = 0;
|
||||||
int first_kv_pair = 1;
|
int first_kv_pair = 1;
|
||||||
const JanetKV *kvs;
|
const JanetKV *kvs = NULL;
|
||||||
janet_dictionary_view(x, &kvs, &len, &cap);
|
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||||
if (!istable && len >= 4)
|
if (!istable && len >= JANET_PRETTY_DICT_ONELINE)
|
||||||
janet_buffer_push_u8(S->buffer, ' ');
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
if (is_dict_value && len >= 5) print_newline(S, 0);
|
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
|
||||||
for (i = 0; i < cap; i++) {
|
for (i = 0; i < cap; i++) {
|
||||||
if (!janet_checktype(kvs[i].key, JANET_NIL)) {
|
if (!janet_checktype(kvs[i].key, JANET_NIL)) {
|
||||||
if (first_kv_pair) {
|
if (first_kv_pair) {
|
||||||
first_kv_pair = 0;
|
first_kv_pair = 0;
|
||||||
} else {
|
} else {
|
||||||
print_newline(S, len < 4);
|
print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
|
||||||
}
|
}
|
||||||
janet_pretty_one(S, kvs[i].key, 0);
|
janet_pretty_one(S, kvs[i].key, 0);
|
||||||
janet_buffer_push_u8(S->buffer, ' ');
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
@@ -417,9 +474,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
|||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Helper for printing a janet value in a pretty form. Not meant to be used
|
static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Janet x, int32_t startlen) {
|
||||||
* for serialization or anything like that. */
|
|
||||||
JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, Janet x) {
|
|
||||||
struct pretty S;
|
struct pretty S;
|
||||||
if (NULL == buffer) {
|
if (NULL == buffer) {
|
||||||
buffer = janet_buffer(0);
|
buffer = janet_buffer(0);
|
||||||
@@ -427,12 +482,20 @@ JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, Janet x) {
|
|||||||
S.buffer = buffer;
|
S.buffer = buffer;
|
||||||
S.depth = depth;
|
S.depth = depth;
|
||||||
S.indent = 0;
|
S.indent = 0;
|
||||||
|
S.flags = flags;
|
||||||
|
S.bufstartlen = startlen;
|
||||||
janet_table_init(&S.seen, 10);
|
janet_table_init(&S.seen, 10);
|
||||||
janet_pretty_one(&S, x, 0);
|
janet_pretty_one(&S, x, 0);
|
||||||
janet_table_deinit(&S.seen);
|
janet_table_deinit(&S.seen);
|
||||||
return S.buffer;
|
return S.buffer;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Helper for printing a janet value in a pretty form. Not meant to be used
|
||||||
|
* for serialization or anything like that. */
|
||||||
|
JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x) {
|
||||||
|
return janet_pretty_(buffer, depth, flags, x, buffer ? buffer->count : 0);
|
||||||
|
}
|
||||||
|
|
||||||
static const char *typestr(Janet x) {
|
static const char *typestr(Janet x) {
|
||||||
JanetType t = janet_type(x);
|
JanetType t = janet_type(x);
|
||||||
return (t == JANET_ABSTRACT)
|
return (t == JANET_ABSTRACT)
|
||||||
@@ -457,39 +520,18 @@ static void pushtypes(JanetBuffer *buffer, int types) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Helper function for formatting strings. Useful for generating error messages and the like.
|
void janet_formatb(JanetBuffer *bufp, const char *format, va_list args) {
|
||||||
* Similar to printf, but specialized for operating with janet. */
|
for (const char *c = format; *c; c++) {
|
||||||
const uint8_t *janet_formatc(const char *format, ...) {
|
switch (*c) {
|
||||||
va_list args;
|
|
||||||
int32_t len = 0;
|
|
||||||
int32_t i;
|
|
||||||
const uint8_t *ret;
|
|
||||||
JanetBuffer buffer;
|
|
||||||
JanetBuffer *bufp = &buffer;
|
|
||||||
|
|
||||||
/* Calculate length */
|
|
||||||
while (format[len]) len++;
|
|
||||||
|
|
||||||
/* Initialize buffer */
|
|
||||||
janet_buffer_init(bufp, len);
|
|
||||||
|
|
||||||
/* Start args */
|
|
||||||
va_start(args, format);
|
|
||||||
|
|
||||||
/* Iterate length */
|
|
||||||
for (i = 0; i < len; i++) {
|
|
||||||
uint8_t c = format[i];
|
|
||||||
switch (c) {
|
|
||||||
default:
|
default:
|
||||||
janet_buffer_push_u8(bufp, c);
|
janet_buffer_push_u8(bufp, *c);
|
||||||
break;
|
break;
|
||||||
case '%':
|
case '%': {
|
||||||
{
|
if (c[1] == '\0')
|
||||||
if (i + 1 >= len)
|
|
||||||
break;
|
break;
|
||||||
switch (format[++i]) {
|
switch (*++c) {
|
||||||
default:
|
default:
|
||||||
janet_buffer_push_u8(bufp, format[i]);
|
janet_buffer_push_u8(bufp, *c);
|
||||||
break;
|
break;
|
||||||
case 'f':
|
case 'f':
|
||||||
number_to_string_b(bufp, va_arg(args, double));
|
number_to_string_b(bufp, va_arg(args, double));
|
||||||
@@ -497,8 +539,7 @@ const uint8_t *janet_formatc(const char *format, ...) {
|
|||||||
case 'd':
|
case 'd':
|
||||||
integer_to_string_b(bufp, va_arg(args, long));
|
integer_to_string_b(bufp, va_arg(args, long));
|
||||||
break;
|
break;
|
||||||
case 'S':
|
case 'S': {
|
||||||
{
|
|
||||||
const uint8_t *str = va_arg(args, const uint8_t *);
|
const uint8_t *str = va_arg(args, const uint8_t *);
|
||||||
janet_buffer_push_bytes(bufp, str, janet_string_length(str));
|
janet_buffer_push_bytes(bufp, str, janet_string_length(str));
|
||||||
break;
|
break;
|
||||||
@@ -509,42 +550,59 @@ const uint8_t *janet_formatc(const char *format, ...) {
|
|||||||
case 'c':
|
case 'c':
|
||||||
janet_buffer_push_u8(bufp, (uint8_t) va_arg(args, long));
|
janet_buffer_push_u8(bufp, (uint8_t) va_arg(args, long));
|
||||||
break;
|
break;
|
||||||
case 'q':
|
case 'q': {
|
||||||
{
|
|
||||||
const uint8_t *str = va_arg(args, const uint8_t *);
|
const uint8_t *str = va_arg(args, const uint8_t *);
|
||||||
janet_escape_string_b(bufp, str);
|
janet_escape_string_b(bufp, str);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case 't':
|
case 't': {
|
||||||
{
|
|
||||||
janet_buffer_push_cstring(bufp, typestr(va_arg(args, Janet)));
|
janet_buffer_push_cstring(bufp, typestr(va_arg(args, Janet)));
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case 'T':
|
case 'T': {
|
||||||
{
|
|
||||||
int types = va_arg(args, long);
|
int types = va_arg(args, long);
|
||||||
pushtypes(bufp, types);
|
pushtypes(bufp, types);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case 'V':
|
case 'V': {
|
||||||
{
|
|
||||||
janet_to_string_b(bufp, va_arg(args, Janet));
|
janet_to_string_b(bufp, va_arg(args, Janet));
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case 'v':
|
case 'v': {
|
||||||
{
|
|
||||||
janet_description_b(bufp, va_arg(args, Janet));
|
janet_description_b(bufp, va_arg(args, Janet));
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case 'p':
|
case 'p': {
|
||||||
{
|
janet_pretty(bufp, 4, 0, va_arg(args, Janet));
|
||||||
janet_pretty(bufp, 4, 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);
|
va_end(args);
|
||||||
|
|
||||||
ret = janet_string(buffer.data, buffer.count);
|
ret = janet_string(buffer.data, buffer.count);
|
||||||
@@ -603,6 +661,7 @@ void janet_buffer_format(
|
|||||||
size_t sfl = strlen(strfrmt);
|
size_t sfl = strlen(strfrmt);
|
||||||
const char *strfrmt_end = strfrmt + sfl;
|
const char *strfrmt_end = strfrmt + sfl;
|
||||||
int32_t arg = argstart;
|
int32_t arg = argstart;
|
||||||
|
int32_t startlen = b->count;
|
||||||
while (strfrmt < strfrmt_end) {
|
while (strfrmt < strfrmt_end) {
|
||||||
if (*strfrmt != '%')
|
if (*strfrmt != '%')
|
||||||
janet_buffer_push_u8(b, (uint8_t) * strfrmt++);
|
janet_buffer_push_u8(b, (uint8_t) * strfrmt++);
|
||||||
@@ -616,8 +675,7 @@ void janet_buffer_format(
|
|||||||
janet_panic("not enough values for format");
|
janet_panic("not enough values for format");
|
||||||
strfrmt = scanformat(strfrmt, form, width, precision);
|
strfrmt = scanformat(strfrmt, form, width, precision);
|
||||||
switch (*strfrmt++) {
|
switch (*strfrmt++) {
|
||||||
case 'c':
|
case 'c': {
|
||||||
{
|
|
||||||
nb = snprintf(item, MAX_ITEM, form, (int)
|
nb = snprintf(item, MAX_ITEM, form, (int)
|
||||||
janet_getinteger(argv, arg));
|
janet_getinteger(argv, arg));
|
||||||
break;
|
break;
|
||||||
@@ -627,8 +685,7 @@ void janet_buffer_format(
|
|||||||
case 'o':
|
case 'o':
|
||||||
case 'u':
|
case 'u':
|
||||||
case 'x':
|
case 'x':
|
||||||
case 'X':
|
case 'X': {
|
||||||
{
|
|
||||||
int32_t n = janet_getinteger(argv, arg);
|
int32_t n = janet_getinteger(argv, arg);
|
||||||
nb = snprintf(item, MAX_ITEM, form, n);
|
nb = snprintf(item, MAX_ITEM, form, n);
|
||||||
break;
|
break;
|
||||||
@@ -639,50 +696,45 @@ void janet_buffer_format(
|
|||||||
case 'E':
|
case 'E':
|
||||||
case 'f':
|
case 'f':
|
||||||
case 'g':
|
case 'g':
|
||||||
case 'G':
|
case 'G': {
|
||||||
{
|
|
||||||
double d = janet_getnumber(argv, arg);
|
double d = janet_getnumber(argv, arg);
|
||||||
nb = snprintf(item, MAX_ITEM, form, d);
|
nb = snprintf(item, MAX_ITEM, form, d);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case 's':
|
case 's': {
|
||||||
{
|
|
||||||
const uint8_t *s = janet_getstring(argv, arg);
|
const uint8_t *s = janet_getstring(argv, arg);
|
||||||
size_t l = janet_string_length(s);
|
int32_t l = janet_string_length(s);
|
||||||
if (form[2] == '\0')
|
if (form[2] == '\0')
|
||||||
janet_buffer_push_bytes(b, s, l);
|
janet_buffer_push_bytes(b, s, l);
|
||||||
else {
|
else {
|
||||||
if (l != strlen((const char *) s))
|
if (l != (int32_t) strlen((const char *) s))
|
||||||
janet_panic("string contains zeros");
|
janet_panic("string contains zeros");
|
||||||
if (!strchr(form, '.') && l >= 100) {
|
if (!strchr(form, '.') && l >= 100) {
|
||||||
janet_panic
|
janet_panic("no precision and string is too long to be formatted");
|
||||||
("no precision and string is too long to be formatted");
|
|
||||||
} else {
|
} else {
|
||||||
nb = snprintf(item, MAX_ITEM, form, s);
|
nb = snprintf(item, MAX_ITEM, form, s);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case 'V':
|
case 'V': {
|
||||||
{
|
|
||||||
janet_to_string_b(b, argv[arg]);
|
janet_to_string_b(b, argv[arg]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case 'v':
|
case 'v': {
|
||||||
{
|
|
||||||
janet_description_b(b, argv[arg]);
|
janet_description_b(b, argv[arg]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case 'p': /* janet pretty , precision = depth */
|
case 'P':
|
||||||
{
|
case 'p': { /* janet pretty , precision = depth */
|
||||||
int depth = atoi(precision);
|
int depth = atoi(precision);
|
||||||
if (depth < 1)
|
if (depth < 1)
|
||||||
depth = 4;
|
depth = 4;
|
||||||
janet_pretty(b, depth, argv[arg]);
|
janet_pretty_(b, depth, (strfrmt[-1] == 'P') ? JANET_PRETTY_COLOR : 0, argv[arg], startlen);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
default:
|
default: {
|
||||||
{ /* also treat cases 'nLlh' */
|
/* also treat cases 'nLlh' */
|
||||||
janet_panicf("invalid conversion '%s' to 'format'",
|
janet_panicf("invalid conversion '%s' to 'format'",
|
||||||
form);
|
form);
|
||||||
}
|
}
|
||||||
@@ -694,4 +746,3 @@ void janet_buffer_format(
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -21,8 +21,9 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "regalloc.h"
|
#include "regalloc.h"
|
||||||
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
|
void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
|
||||||
@@ -66,12 +67,16 @@ void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocato
|
|||||||
dest->capacity = src->capacity;
|
dest->capacity = src->capacity;
|
||||||
dest->max = src->max;
|
dest->max = src->max;
|
||||||
size = sizeof(uint32_t) * dest->capacity;
|
size = sizeof(uint32_t) * dest->capacity;
|
||||||
dest->chunks = malloc(size);
|
|
||||||
dest->regtemps = 0;
|
dest->regtemps = 0;
|
||||||
|
if (size) {
|
||||||
|
dest->chunks = malloc(size);
|
||||||
if (!dest->chunks) {
|
if (!dest->chunks) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
memcpy(dest->chunks, src->chunks, size);
|
memcpy(dest->chunks, src->chunks, size);
|
||||||
|
} else {
|
||||||
|
dest->chunks = NULL;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Allocate one more chunk in chunks */
|
/* Allocate one more chunk in chunks */
|
||||||
|
|||||||
@@ -21,24 +21,25 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Run a string */
|
/* Run a string */
|
||||||
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
|
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
|
||||||
JanetParser parser;
|
JanetParser parser;
|
||||||
int errflags = 0;
|
FILE *errf = janet_dynfile("err", stderr);
|
||||||
|
int errflags = 0, done = 0;
|
||||||
int32_t index = 0;
|
int32_t index = 0;
|
||||||
int dudeol = 0;
|
|
||||||
int done = 0;
|
|
||||||
Janet ret = janet_wrap_nil();
|
Janet ret = janet_wrap_nil();
|
||||||
const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL;
|
const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL;
|
||||||
|
|
||||||
if (where) janet_gcroot(janet_wrap_string(where));
|
if (where) janet_gcroot(janet_wrap_string(where));
|
||||||
if (NULL == sourcePath) sourcePath = "<unknown>";
|
if (NULL == sourcePath) sourcePath = "<unknown>";
|
||||||
janet_parser_init(&parser);
|
janet_parser_init(&parser);
|
||||||
|
|
||||||
while (!errflags && !done) {
|
/* While we haven't seen an error */
|
||||||
|
while (!done) {
|
||||||
|
|
||||||
/* Evaluate parsed values */
|
/* Evaluate parsed values */
|
||||||
while (janet_parser_has_more(&parser)) {
|
while (janet_parser_has_more(&parser)) {
|
||||||
@@ -47,42 +48,42 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
|||||||
if (cres.status == JANET_COMPILE_OK) {
|
if (cres.status == JANET_COMPILE_OK) {
|
||||||
JanetFunction *f = janet_thunk(cres.funcdef);
|
JanetFunction *f = janet_thunk(cres.funcdef);
|
||||||
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
|
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
|
||||||
|
fiber->env = env;
|
||||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||||
if (status != JANET_SIGNAL_OK) {
|
if (status != JANET_SIGNAL_OK) {
|
||||||
janet_stacktrace(fiber, ret);
|
janet_stacktrace(fiber, ret);
|
||||||
errflags |= 0x01;
|
errflags |= 0x01;
|
||||||
|
done = 1;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
fprintf(stderr, "compile error in %s: %s\n", sourcePath,
|
fprintf(errf, "compile error in %s: %s\n", sourcePath,
|
||||||
(const char *)cres.error);
|
(const char *)cres.error);
|
||||||
errflags |= 0x02;
|
errflags |= 0x02;
|
||||||
|
done = 1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Dispatch based on parse state */
|
/* Dispatch based on parse state */
|
||||||
switch (janet_parser_status(&parser)) {
|
switch (janet_parser_status(&parser)) {
|
||||||
|
case JANET_PARSE_DEAD:
|
||||||
|
done = 1;
|
||||||
|
break;
|
||||||
case JANET_PARSE_ERROR:
|
case JANET_PARSE_ERROR:
|
||||||
errflags |= 0x04;
|
errflags |= 0x04;
|
||||||
fprintf(stderr, "parse error in %s: %s\n",
|
fprintf(errf, "parse error in %s: %s\n",
|
||||||
sourcePath, janet_parser_error(&parser));
|
sourcePath, janet_parser_error(&parser));
|
||||||
|
done = 1;
|
||||||
break;
|
break;
|
||||||
case JANET_PARSE_PENDING:
|
case JANET_PARSE_PENDING:
|
||||||
if (index >= len) {
|
if (index == len) {
|
||||||
if (dudeol) {
|
janet_parser_eof(&parser);
|
||||||
errflags |= 0x04;
|
|
||||||
fprintf(stderr, "internal parse error in %s: unexpected end of source\n",
|
|
||||||
sourcePath);
|
|
||||||
} else {
|
|
||||||
dudeol = 1;
|
|
||||||
janet_parser_consume(&parser, '\n');
|
|
||||||
}
|
|
||||||
} else {
|
} else {
|
||||||
janet_parser_consume(&parser, bytes[index++]);
|
janet_parser_consume(&parser, bytes[index++]);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
case JANET_PARSE_ROOT:
|
case JANET_PARSE_ROOT:
|
||||||
if (index >= len) {
|
if (index >= len) {
|
||||||
done = 1;
|
janet_parser_eof(&parser);
|
||||||
} else {
|
} else {
|
||||||
janet_parser_consume(&parser, bytes[index++]);
|
janet_parser_consume(&parser, bytes[index++]);
|
||||||
}
|
}
|
||||||
@@ -90,6 +91,8 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
|||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Clean up and return errors */
|
||||||
janet_parser_deinit(&parser);
|
janet_parser_deinit(&parser);
|
||||||
if (where) janet_gcunroot(janet_wrap_string(where));
|
if (where) janet_gcunroot(janet_wrap_string(where));
|
||||||
if (out) *out = ret;
|
if (out) *out = ret;
|
||||||
|
|||||||
@@ -21,7 +21,7 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "compile.h"
|
#include "compile.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
@@ -60,8 +60,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
|
|||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
default:
|
default:
|
||||||
return janetc_cslot(x);
|
return janetc_cslot(x);
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE: {
|
||||||
{
|
|
||||||
int32_t i, len;
|
int32_t i, len;
|
||||||
const Janet *tup = janet_unwrap_tuple(x);
|
const Janet *tup = janet_unwrap_tuple(x);
|
||||||
len = janet_tuple_length(tup);
|
len = janet_tuple_length(tup);
|
||||||
@@ -72,10 +71,11 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
|
|||||||
}
|
}
|
||||||
for (i = 0; i < len; i++)
|
for (i = 0; i < len; i++)
|
||||||
janet_v_push(slots, quasiquote(opts, tup[i]));
|
janet_v_push(slots, quasiquote(opts, tup[i]));
|
||||||
return qq_slots(opts, slots, JOP_MAKE_TUPLE);
|
return qq_slots(opts, slots, (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR)
|
||||||
|
? JOP_MAKE_BRACKET_TUPLE
|
||||||
|
: JOP_MAKE_TUPLE);
|
||||||
}
|
}
|
||||||
case JANET_ARRAY:
|
case JANET_ARRAY: {
|
||||||
{
|
|
||||||
int32_t i;
|
int32_t i;
|
||||||
JanetArray *array = janet_unwrap_array(x);
|
JanetArray *array = janet_unwrap_array(x);
|
||||||
for (i = 0; i < array->count; i++)
|
for (i = 0; i < array->count; i++)
|
||||||
@@ -83,10 +83,9 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
|
|||||||
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
|
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
|
||||||
}
|
}
|
||||||
case JANET_TABLE:
|
case JANET_TABLE:
|
||||||
case JANET_STRUCT:
|
case JANET_STRUCT: {
|
||||||
{
|
|
||||||
const JanetKV *kv = NULL, *kvs = NULL;
|
const JanetKV *kv = NULL, *kvs = NULL;
|
||||||
int32_t len, cap;
|
int32_t len, cap = 0;
|
||||||
janet_dictionary_view(x, &kvs, &len, &cap);
|
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||||
while ((kv = janet_dictionary_next(kvs, cap, kv))) {
|
while ((kv = janet_dictionary_next(kvs, cap, kv))) {
|
||||||
JanetSlot key = quasiquote(opts, kv->key);
|
JanetSlot key = quasiquote(opts, kv->key);
|
||||||
@@ -136,12 +135,11 @@ static int destructure(JanetCompiler *c,
|
|||||||
/* Leaf, assign right to left */
|
/* Leaf, assign right to left */
|
||||||
return leaf(c, janet_unwrap_symbol(left), right, attr);
|
return leaf(c, janet_unwrap_symbol(left), right, attr);
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE:
|
||||||
case JANET_ARRAY:
|
case JANET_ARRAY: {
|
||||||
{
|
int32_t len = 0;
|
||||||
int32_t i, len;
|
const Janet *values = NULL;
|
||||||
const Janet *values;
|
|
||||||
janet_indexed_view(left, &values, &len);
|
janet_indexed_view(left, &values, &len);
|
||||||
for (i = 0; i < len; i++) {
|
for (int32_t i = 0; i < len; i++) {
|
||||||
JanetSlot nextright = janetc_farslot(c);
|
JanetSlot nextright = janetc_farslot(c);
|
||||||
Janet subval = values[i];
|
Janet subval = values[i];
|
||||||
if (i < 0x100) {
|
if (i < 0x100) {
|
||||||
@@ -156,12 +154,11 @@ static int destructure(JanetCompiler *c,
|
|||||||
}
|
}
|
||||||
return 1;
|
return 1;
|
||||||
case JANET_TABLE:
|
case JANET_TABLE:
|
||||||
case JANET_STRUCT:
|
case JANET_STRUCT: {
|
||||||
{
|
|
||||||
const JanetKV *kvs = NULL;
|
const JanetKV *kvs = NULL;
|
||||||
int32_t i, cap, len;
|
int32_t cap = 0, len = 0;
|
||||||
janet_dictionary_view(left, &kvs, &len, &cap);
|
janet_dictionary_view(left, &kvs, &len, &cap);
|
||||||
for (i = 0; i < cap; i++) {
|
for (int32_t i = 0; i < cap; i++) {
|
||||||
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
|
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
|
||||||
JanetSlot nextright = janetc_farslot(c);
|
JanetSlot nextright = janetc_farslot(c);
|
||||||
JanetSlot k = janetc_value(janetc_fopts_default(c), kvs[i].key);
|
JanetSlot k = janetc_value(janetc_fopts_default(c), kvs[i].key);
|
||||||
@@ -177,7 +174,7 @@ static int destructure(JanetCompiler *c,
|
|||||||
/* Create a source map for definitions. */
|
/* Create a source map for definitions. */
|
||||||
static const Janet *janetc_make_sourcemap(JanetCompiler *c) {
|
static const Janet *janetc_make_sourcemap(JanetCompiler *c) {
|
||||||
Janet *tup = janet_tuple_begin(3);
|
Janet *tup = janet_tuple_begin(3);
|
||||||
tup[0] = janet_wrap_string(c->source);
|
tup[0] = c->source ? janet_wrap_string(c->source) : janet_wrap_nil();
|
||||||
tup[1] = janet_wrap_integer(c->current_mapping.start);
|
tup[1] = janet_wrap_integer(c->current_mapping.start);
|
||||||
tup[2] = janet_wrap_integer(c->current_mapping.end);
|
tup[2] = janet_wrap_integer(c->current_mapping.end);
|
||||||
return janet_tuple_end(tup);
|
return janet_tuple_end(tup);
|
||||||
@@ -281,12 +278,10 @@ static int varleaf(
|
|||||||
JanetCompiler *c,
|
JanetCompiler *c,
|
||||||
const uint8_t *sym,
|
const uint8_t *sym,
|
||||||
JanetSlot s,
|
JanetSlot s,
|
||||||
JanetTable *attr) {
|
JanetTable *reftab) {
|
||||||
if (c->scope->flags & JANET_SCOPE_TOP) {
|
if (c->scope->flags & JANET_SCOPE_TOP) {
|
||||||
/* Global var, generate var */
|
/* Global var, generate var */
|
||||||
JanetSlot refslot;
|
JanetSlot refslot;
|
||||||
JanetTable *reftab = janet_table(1);
|
|
||||||
reftab->proto = attr;
|
|
||||||
JanetArray *ref = janet_array(1);
|
JanetArray *ref = janet_array(1);
|
||||||
janet_array_push(ref, janet_wrap_nil());
|
janet_array_push(ref, janet_wrap_nil());
|
||||||
janet_table_put(reftab, janet_ckeywordv("ref"), janet_wrap_array(ref));
|
janet_table_put(reftab, janet_ckeywordv("ref"), janet_wrap_array(ref));
|
||||||
@@ -315,12 +310,10 @@ static int defleaf(
|
|||||||
JanetCompiler *c,
|
JanetCompiler *c,
|
||||||
const uint8_t *sym,
|
const uint8_t *sym,
|
||||||
JanetSlot s,
|
JanetSlot s,
|
||||||
JanetTable *attr) {
|
JanetTable *tab) {
|
||||||
if (c->scope->flags & JANET_SCOPE_TOP) {
|
if (c->scope->flags & JANET_SCOPE_TOP) {
|
||||||
JanetTable *tab = janet_table(2);
|
|
||||||
janet_table_put(tab, janet_ckeywordv("source-map"),
|
janet_table_put(tab, janet_ckeywordv("source-map"),
|
||||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||||
tab->proto = attr;
|
|
||||||
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
|
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
|
||||||
JanetSlot tabslot = janetc_cslot(janet_wrap_table(tab));
|
JanetSlot tabslot = janetc_cslot(janet_wrap_table(tab));
|
||||||
|
|
||||||
@@ -476,6 +469,61 @@ static int32_t janetc_addfuncdef(JanetCompiler *c, JanetFuncDef *def) {
|
|||||||
return janet_v_count(scope->defs) - 1;
|
return janet_v_count(scope->defs) - 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/*
|
||||||
|
* break
|
||||||
|
*
|
||||||
|
* jump :end or retn if in function
|
||||||
|
*/
|
||||||
|
static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
|
JanetCompiler *c = opts.compiler;
|
||||||
|
JanetScope *scope = c->scope;
|
||||||
|
if (argn > 1) {
|
||||||
|
janetc_cerror(c, "expected at most 1 argument");
|
||||||
|
return janetc_cslot(janet_wrap_nil());
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Find scope to break from */
|
||||||
|
while (scope) {
|
||||||
|
if (scope->flags & (JANET_SCOPE_FUNCTION | JANET_SCOPE_WHILE))
|
||||||
|
break;
|
||||||
|
scope = scope->parent;
|
||||||
|
}
|
||||||
|
if (NULL == scope) {
|
||||||
|
janetc_cerror(c, "break must occur in while loop or closure");
|
||||||
|
return janetc_cslot(janet_wrap_nil());
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Emit code to break from that scope */
|
||||||
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
|
if (scope->flags & JANET_SCOPE_FUNCTION) {
|
||||||
|
if (!(scope->flags & JANET_SCOPE_WHILE) && argn) {
|
||||||
|
/* Closure body with return argument */
|
||||||
|
subopts.flags |= JANET_FOPTS_TAIL;
|
||||||
|
JanetSlot ret = janetc_value(subopts, argv[0]);
|
||||||
|
ret.flags |= JANET_SLOT_RETURNED;
|
||||||
|
return ret;
|
||||||
|
} else {
|
||||||
|
/* while loop IIFE or no argument */
|
||||||
|
if (argn) {
|
||||||
|
subopts.flags |= JANET_FOPTS_DROP;
|
||||||
|
janetc_value(subopts, argv[0]);
|
||||||
|
}
|
||||||
|
janetc_emit(c, JOP_RETURN_NIL);
|
||||||
|
JanetSlot s = janetc_cslot(janet_wrap_nil());
|
||||||
|
s.flags |= JANET_SLOT_RETURNED;
|
||||||
|
return s;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
if (argn) {
|
||||||
|
subopts.flags |= JANET_FOPTS_DROP;
|
||||||
|
janetc_value(subopts, argv[0]);
|
||||||
|
}
|
||||||
|
/* Tag the instruction so the while special can turn it into a proper jump */
|
||||||
|
janetc_emit(c, 0x80 | JOP_JUMP);
|
||||||
|
return janetc_cslot(janet_wrap_nil());
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* :whiletop
|
* :whiletop
|
||||||
* ...
|
* ...
|
||||||
@@ -500,7 +548,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
|
|
||||||
labelwt = janet_v_count(c->buffer);
|
labelwt = janet_v_count(c->buffer);
|
||||||
|
|
||||||
janetc_scope(&tempscope, c, 0, "while");
|
janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
|
||||||
|
|
||||||
/* Compile condition */
|
/* Compile condition */
|
||||||
cond = janetc_value(subopts, argv[0]);
|
cond = janetc_value(subopts, argv[0]);
|
||||||
@@ -571,8 +619,15 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
|
|
||||||
/* Calculate jumps */
|
/* Calculate jumps */
|
||||||
labeld = janet_v_count(c->buffer);
|
labeld = janet_v_count(c->buffer);
|
||||||
if (!infinite) c->buffer[labelc] |= (labeld - labelc) << 16;
|
if (!infinite) c->buffer[labelc] |= (uint32_t)(labeld - labelc) << 16;
|
||||||
c->buffer[labeljt] |= (labelwt - labeljt) << 8;
|
c->buffer[labeljt] |= (uint32_t)(labelwt - labeljt) << 8;
|
||||||
|
|
||||||
|
/* Calculate breaks */
|
||||||
|
for (int32_t i = labelwt; i < labeld; i++) {
|
||||||
|
if (c->buffer[i] == (0x80 | JOP_JUMP)) {
|
||||||
|
c->buffer[i] = JOP_JUMP | ((labeld - i) << 8);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
/* Pop scope and return nil slot */
|
/* Pop scope and return nil slot */
|
||||||
janetc_popscope(c);
|
janetc_popscope(c);
|
||||||
@@ -586,16 +641,18 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
JanetSlot ret;
|
JanetSlot ret;
|
||||||
Janet head;
|
Janet head;
|
||||||
JanetScope fnscope;
|
JanetScope fnscope;
|
||||||
int32_t paramcount, argi, parami, arity, defindex, i;
|
int32_t paramcount, argi, parami, arity, min_arity, max_arity, defindex, i;
|
||||||
JanetFopts subopts = janetc_fopts_default(c);
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
const Janet *params;
|
const Janet *params;
|
||||||
const char *errmsg = NULL;
|
const char *errmsg = NULL;
|
||||||
|
|
||||||
/* Function flags */
|
/* Function flags */
|
||||||
int vararg = 0;
|
int vararg = 0;
|
||||||
int fixarity = 1;
|
int structarg = 0;
|
||||||
|
int allow_extra = 0;
|
||||||
int selfref = 0;
|
int selfref = 0;
|
||||||
int seenamp = 0;
|
int seenamp = 0;
|
||||||
|
int seenopt = 0;
|
||||||
|
|
||||||
/* Begin function */
|
/* Begin function */
|
||||||
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
||||||
@@ -618,6 +675,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
goto error;
|
goto error;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Keep track of destructured parameters */
|
||||||
|
JanetSlot *destructed_params = NULL;
|
||||||
|
|
||||||
/* Compile function parameters */
|
/* Compile function parameters */
|
||||||
params = janet_unwrap_tuple(argv[parami]);
|
params = janet_unwrap_tuple(argv[parami]);
|
||||||
paramcount = janet_tuple_length(params);
|
paramcount = janet_tuple_length(params);
|
||||||
@@ -626,27 +686,68 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
Janet param = params[i];
|
Janet param = params[i];
|
||||||
if (janet_checktype(param, JANET_SYMBOL)) {
|
if (janet_checktype(param, JANET_SYMBOL)) {
|
||||||
/* Check for varargs and unfixed arity */
|
/* Check for varargs and unfixed arity */
|
||||||
if ((!seenamp) &&
|
if (!janet_cstrcmp(janet_unwrap_symbol(param), "&")) {
|
||||||
(0 == janet_cstrcmp(janet_unwrap_symbol(param), "&"))) {
|
if (seenamp) {
|
||||||
seenamp = 1;
|
errmsg = "& in unexpected location";
|
||||||
fixarity = 0;
|
goto error;
|
||||||
if (i == paramcount - 1) {
|
} else if (i == paramcount - 1) {
|
||||||
|
allow_extra = 1;
|
||||||
arity--;
|
arity--;
|
||||||
} else if (i == paramcount - 2) {
|
} else if (i == paramcount - 2) {
|
||||||
vararg = 1;
|
vararg = 1;
|
||||||
arity -= 2;
|
arity -= 2;
|
||||||
} else {
|
} else {
|
||||||
errmsg = "variable argument symbol in unexpected location";
|
errmsg = "& in unexpected location";
|
||||||
goto error;
|
goto error;
|
||||||
}
|
}
|
||||||
|
seenamp = 1;
|
||||||
|
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&opt")) {
|
||||||
|
if (seenopt) {
|
||||||
|
errmsg = "only one &opt allowed";
|
||||||
|
goto error;
|
||||||
|
} else if (i == paramcount - 1) {
|
||||||
|
errmsg = "&opt cannot be last item in parameter list";
|
||||||
|
goto error;
|
||||||
|
}
|
||||||
|
min_arity = i;
|
||||||
|
arity--;
|
||||||
|
seenopt = 1;
|
||||||
|
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&keys")) {
|
||||||
|
if (seenamp) {
|
||||||
|
errmsg = "&keys in unexpected location";
|
||||||
|
goto error;
|
||||||
|
} else if (i == paramcount - 2) {
|
||||||
|
vararg = 1;
|
||||||
|
structarg = 1;
|
||||||
|
arity -= 2;
|
||||||
|
} else {
|
||||||
|
errmsg = "&keys in unexpected location";
|
||||||
|
goto error;
|
||||||
|
}
|
||||||
|
seenamp = 1;
|
||||||
} else {
|
} else {
|
||||||
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
destructure(c, param, janetc_farslot(c), defleaf, NULL);
|
janet_v_push(destructed_params, janetc_farslot(c));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Compile destructed params */
|
||||||
|
int32_t j = 0;
|
||||||
|
for (i = 0; i < paramcount; i++) {
|
||||||
|
Janet param = params[i];
|
||||||
|
if (!janet_checktype(param, JANET_SYMBOL)) {
|
||||||
|
JanetSlot reg = destructed_params[j++];
|
||||||
|
destructure(c, param, reg, defleaf, NULL);
|
||||||
|
janetc_freeslot(c, reg);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_v_free(destructed_params);
|
||||||
|
|
||||||
|
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
|
||||||
|
if (!seenopt) min_arity = arity;
|
||||||
|
|
||||||
/* Check for self ref */
|
/* Check for self ref */
|
||||||
if (selfref) {
|
if (selfref) {
|
||||||
JanetSlot slot = janetc_farslot(c);
|
JanetSlot slot = janetc_farslot(c);
|
||||||
@@ -658,18 +759,22 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
/* Compile function body */
|
/* Compile function body */
|
||||||
if (parami + 1 == argn) {
|
if (parami + 1 == argn) {
|
||||||
janetc_emit(c, JOP_RETURN_NIL);
|
janetc_emit(c, JOP_RETURN_NIL);
|
||||||
} else for (argi = parami + 1; argi < argn; argi++) {
|
} else {
|
||||||
|
for (argi = parami + 1; argi < argn; argi++) {
|
||||||
subopts.flags = (argi == (argn - 1)) ? JANET_FOPTS_TAIL : JANET_FOPTS_DROP;
|
subopts.flags = (argi == (argn - 1)) ? JANET_FOPTS_TAIL : JANET_FOPTS_DROP;
|
||||||
janetc_value(subopts, argv[argi]);
|
janetc_value(subopts, argv[argi]);
|
||||||
if (c->result.status == JANET_COMPILE_ERROR)
|
if (c->result.status == JANET_COMPILE_ERROR)
|
||||||
goto error2;
|
goto error2;
|
||||||
}
|
}
|
||||||
|
}
|
||||||
|
|
||||||
/* Build function */
|
/* Build function */
|
||||||
def = janetc_pop_funcdef(c);
|
def = janetc_pop_funcdef(c);
|
||||||
def->arity = arity;
|
def->arity = arity;
|
||||||
if (fixarity) def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
|
def->min_arity = min_arity;
|
||||||
|
def->max_arity = max_arity;
|
||||||
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||||
|
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||||
|
|
||||||
if (selfref) def->name = janet_unwrap_symbol(head);
|
if (selfref) def->name = janet_unwrap_symbol(head);
|
||||||
defindex = janetc_addfuncdef(c, def);
|
defindex = janetc_addfuncdef(c, def);
|
||||||
@@ -691,6 +796,7 @@ error2:
|
|||||||
|
|
||||||
/* Keep in lexicographic order */
|
/* Keep in lexicographic order */
|
||||||
static const JanetSpecial janetc_specials[] = {
|
static const JanetSpecial janetc_specials[] = {
|
||||||
|
{"break", janetc_break},
|
||||||
{"def", janetc_def},
|
{"def", janetc_def},
|
||||||
{"do", janetc_do},
|
{"do", janetc_do},
|
||||||
{"fn", janetc_fn},
|
{"fn", janetc_fn},
|
||||||
|
|||||||
@@ -65,4 +65,9 @@ extern JANET_THREAD_LOCAL Janet *janet_vm_roots;
|
|||||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
|
extern JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
|
||||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
|
extern JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
|
||||||
|
|
||||||
|
/* Scratch memory */
|
||||||
|
extern JANET_THREAD_LOCAL void **janet_scratch_mem;
|
||||||
|
extern JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||||
|
extern JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||||
|
|
||||||
#endif /* JANET_STATE_H_defined */
|
#endif /* JANET_STATE_H_defined */
|
||||||
|
|||||||
@@ -23,7 +23,7 @@
|
|||||||
#include <string.h>
|
#include <string.h>
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
@@ -31,11 +31,11 @@
|
|||||||
|
|
||||||
/* Begin building a string */
|
/* Begin building a string */
|
||||||
uint8_t *janet_string_begin(int32_t length) {
|
uint8_t *janet_string_begin(int32_t length) {
|
||||||
char *data = janet_gcalloc(JANET_MEMORY_STRING, 2 * sizeof(int32_t) + length + 1);
|
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + length + 1);
|
||||||
uint8_t *str = (uint8_t *) (data + 2 * sizeof(int32_t));
|
head->length = length;
|
||||||
janet_string_length(str) = length;
|
uint8_t *data = (uint8_t *)head->data;
|
||||||
str[length] = 0;
|
data[length] = 0;
|
||||||
return str;
|
return data;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Finish building a string */
|
/* Finish building a string */
|
||||||
@@ -46,14 +46,13 @@ const uint8_t *janet_string_end(uint8_t *str) {
|
|||||||
|
|
||||||
/* Load a buffer as a string */
|
/* Load a buffer as a string */
|
||||||
const uint8_t *janet_string(const uint8_t *buf, int32_t len) {
|
const uint8_t *janet_string(const uint8_t *buf, int32_t len) {
|
||||||
int32_t hash = janet_string_calchash(buf, len);
|
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + len + 1);
|
||||||
char *data = janet_gcalloc(JANET_MEMORY_STRING, 2 * sizeof(int32_t) + len + 1);
|
head->length = len;
|
||||||
uint8_t *str = (uint8_t *) (data + 2 * sizeof(int32_t));
|
head->hash = janet_string_calchash(buf, len);
|
||||||
memcpy(str, buf, len);
|
uint8_t *data = (uint8_t *)head->data;
|
||||||
str[len] = 0;
|
memcpy(data, buf, len);
|
||||||
janet_string_length(str) = len;
|
data[len] = 0;
|
||||||
janet_string_hash(str) = hash;
|
return data;
|
||||||
return str;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Compare two strings */
|
/* Compare two strings */
|
||||||
@@ -183,8 +182,7 @@ static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
|
|||||||
if (mulres > INT32_MAX) janet_panic("result string is too long");
|
if (mulres > INT32_MAX) janet_panic("result string is too long");
|
||||||
uint8_t *newbuf = janet_string_begin((int32_t) mulres);
|
uint8_t *newbuf = janet_string_begin((int32_t) mulres);
|
||||||
uint8_t *end = newbuf + mulres;
|
uint8_t *end = newbuf + mulres;
|
||||||
uint8_t *p = newbuf;
|
for (uint8_t *p = newbuf; p < end; p += view.len) {
|
||||||
for (p = newbuf; p < end; p += view.len) {
|
|
||||||
memcpy(p, view.bytes, view.len);
|
memcpy(p, view.bytes, view.len);
|
||||||
}
|
}
|
||||||
return janet_wrap_string(janet_string_end(newbuf));
|
return janet_wrap_string(janet_string_end(newbuf));
|
||||||
@@ -276,6 +274,26 @@ static Janet cfun_string_find(int32_t argc, Janet *argv) {
|
|||||||
: janet_wrap_integer(result);
|
: janet_wrap_integer(result);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Janet cfun_string_hasprefix(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 2);
|
||||||
|
JanetByteView prefix = janet_getbytes(argv, 0);
|
||||||
|
JanetByteView str = janet_getbytes(argv, 1);
|
||||||
|
return str.len < prefix.len
|
||||||
|
? janet_wrap_false()
|
||||||
|
: janet_wrap_boolean(memcmp(prefix.bytes, str.bytes, prefix.len) == 0);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_string_hassuffix(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 2);
|
||||||
|
JanetByteView suffix = janet_getbytes(argv, 0);
|
||||||
|
JanetByteView str = janet_getbytes(argv, 1);
|
||||||
|
return str.len < suffix.len
|
||||||
|
? janet_wrap_false()
|
||||||
|
: janet_wrap_boolean(memcmp(suffix.bytes,
|
||||||
|
str.bytes + str.len - suffix.len,
|
||||||
|
suffix.len) == 0);
|
||||||
|
}
|
||||||
|
|
||||||
static Janet cfun_string_findall(int32_t argc, Janet *argv) {
|
static Janet cfun_string_findall(int32_t argc, Janet *argv) {
|
||||||
int32_t result;
|
int32_t result;
|
||||||
struct kmp_state state;
|
struct kmp_state state;
|
||||||
@@ -375,25 +393,20 @@ static Janet cfun_string_split(int32_t argc, Janet *argv) {
|
|||||||
|
|
||||||
static Janet cfun_string_checkset(int32_t argc, Janet *argv) {
|
static Janet cfun_string_checkset(int32_t argc, Janet *argv) {
|
||||||
uint32_t bitset[8] = {0, 0, 0, 0, 0, 0, 0, 0};
|
uint32_t bitset[8] = {0, 0, 0, 0, 0, 0, 0, 0};
|
||||||
janet_arity(argc, 2, 3);
|
janet_fixarity(argc, 2);
|
||||||
JanetByteView set = janet_getbytes(argv, 0);
|
JanetByteView set = janet_getbytes(argv, 0);
|
||||||
JanetByteView str = janet_getbytes(argv, 1);
|
JanetByteView str = janet_getbytes(argv, 1);
|
||||||
/* Populate set */
|
/* Populate set */
|
||||||
for (int32_t i = 0; i < set.len; i++) {
|
for (int32_t i = 0; i < set.len; i++) {
|
||||||
int index = set.bytes[i] >> 5;
|
int index = set.bytes[i] >> 5;
|
||||||
uint32_t mask = 1 << (set.bytes[i] & 7);
|
uint32_t mask = 1 << (set.bytes[i] & 0x1F);
|
||||||
bitset[index] |= mask;
|
bitset[index] |= mask;
|
||||||
}
|
}
|
||||||
if (argc == 3) {
|
|
||||||
if (janet_getboolean(argv, 2)) {
|
|
||||||
for (int i = 0; i < 8; i++)
|
|
||||||
bitset[i] = ~bitset[i];
|
|
||||||
}
|
|
||||||
}
|
|
||||||
/* Check set */
|
/* Check set */
|
||||||
|
if (str.len == 0) return janet_wrap_false();
|
||||||
for (int32_t i = 0; i < str.len; i++) {
|
for (int32_t i = 0; i < str.len; i++) {
|
||||||
int index = str.bytes[i] >> 5;
|
int index = str.bytes[i] >> 5;
|
||||||
uint32_t mask = 1 << (str.bytes[i] & 7);
|
uint32_t mask = 1 << (str.bytes[i] & 0x1F);
|
||||||
if (!(bitset[index] & mask)) {
|
if (!(bitset[index] & mask)) {
|
||||||
return janet_wrap_false();
|
return janet_wrap_false();
|
||||||
}
|
}
|
||||||
@@ -449,10 +462,64 @@ static Janet cfun_string_format(int32_t argc, Janet *argv) {
|
|||||||
return janet_stringv(buffer->data, buffer->count);
|
return janet_stringv(buffer->data, buffer->count);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static int trim_help_checkset(JanetByteView set, uint8_t x) {
|
||||||
|
for (int32_t j = 0; j < set.len; j++)
|
||||||
|
if (set.bytes[j] == x)
|
||||||
|
return 1;
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static int32_t trim_help_leftedge(JanetByteView str, JanetByteView set) {
|
||||||
|
for (int32_t i = 0; i < str.len; i++)
|
||||||
|
if (!trim_help_checkset(set, str.bytes[i]))
|
||||||
|
return i;
|
||||||
|
return str.len;
|
||||||
|
}
|
||||||
|
|
||||||
|
static int32_t trim_help_rightedge(JanetByteView str, JanetByteView set) {
|
||||||
|
for (int32_t i = str.len - 1; i >= 0; i--)
|
||||||
|
if (!trim_help_checkset(set, str.bytes[i]))
|
||||||
|
return i + 1;
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static void trim_help_args(int32_t argc, Janet *argv, JanetByteView *str, JanetByteView *set) {
|
||||||
|
janet_arity(argc, 1, 2);
|
||||||
|
*str = janet_getbytes(argv, 0);
|
||||||
|
if (argc >= 2) {
|
||||||
|
*set = janet_getbytes(argv, 1);
|
||||||
|
} else {
|
||||||
|
set->bytes = (const uint8_t *)(" \t\r\n\v\f");
|
||||||
|
set->len = 6;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_string_trim(int32_t argc, Janet *argv) {
|
||||||
|
JanetByteView str, set;
|
||||||
|
trim_help_args(argc, argv, &str, &set);
|
||||||
|
int32_t left_edge = trim_help_leftedge(str, set);
|
||||||
|
int32_t right_edge = trim_help_rightedge(str, set);
|
||||||
|
return janet_stringv(str.bytes + left_edge, right_edge - left_edge);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_string_triml(int32_t argc, Janet *argv) {
|
||||||
|
JanetByteView str, set;
|
||||||
|
trim_help_args(argc, argv, &str, &set);
|
||||||
|
int32_t left_edge = trim_help_leftedge(str, set);
|
||||||
|
return janet_stringv(str.bytes + left_edge, str.len - left_edge);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_string_trimr(int32_t argc, Janet *argv) {
|
||||||
|
JanetByteView str, set;
|
||||||
|
trim_help_args(argc, argv, &str, &set);
|
||||||
|
int32_t right_edge = trim_help_rightedge(str, set);
|
||||||
|
return janet_stringv(str.bytes, right_edge);
|
||||||
|
}
|
||||||
|
|
||||||
static const JanetReg string_cfuns[] = {
|
static const JanetReg string_cfuns[] = {
|
||||||
{
|
{
|
||||||
"string/slice", cfun_string_slice,
|
"string/slice", cfun_string_slice,
|
||||||
JDOC("(string/slice bytes [,start=0 [,end=(length str)]])\n\n"
|
JDOC("(string/slice bytes &opt start end)\n\n"
|
||||||
"Returns a substring from a byte sequence. The substring is from "
|
"Returns a substring from a byte sequence. The substring is from "
|
||||||
"index start inclusive to index end exclusive. All indexing "
|
"index start inclusive to index end exclusive. All indexing "
|
||||||
"is from 0. 'start' and 'end' can also be negative to indicate indexing "
|
"is from 0. 'start' and 'end' can also be negative to indicate indexing "
|
||||||
@@ -470,8 +537,8 @@ static const JanetReg string_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"string/from-bytes", cfun_string_frombytes,
|
"string/from-bytes", cfun_string_frombytes,
|
||||||
JDOC("(string/from-bytes byte-array)\n\n"
|
JDOC("(string/from-bytes & byte-vals)\n\n"
|
||||||
"Creates a string from an array of integers with byte values. All integers "
|
"Creates a string from integer params with byte values. All integers "
|
||||||
"will be coerced to the range of 1 byte 0-255.")
|
"will be coerced to the range of 1 byte 0-255.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
@@ -509,6 +576,16 @@ static const JanetReg string_cfuns[] = {
|
|||||||
"will only contribute to finding at most on occurrence of pattern. If no "
|
"will only contribute to finding at most on occurrence of pattern. If no "
|
||||||
"occurrences are found, will return an empty array.")
|
"occurrences are found, will return an empty array.")
|
||||||
},
|
},
|
||||||
|
{
|
||||||
|
"string/has-prefix?", cfun_string_hasprefix,
|
||||||
|
JDOC("(string/has-prefix? pfx str)\n\n"
|
||||||
|
"Tests whether str starts with pfx.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"string/has-suffix?", cfun_string_hassuffix,
|
||||||
|
JDOC("(string/has-suffix? sfx str)\n\n"
|
||||||
|
"Tests whether str ends with sfx.")
|
||||||
|
},
|
||||||
{
|
{
|
||||||
"string/replace", cfun_string_replace,
|
"string/replace", cfun_string_replace,
|
||||||
JDOC("(string/replace patt subst str)\n\n"
|
JDOC("(string/replace patt subst str)\n\n"
|
||||||
@@ -536,15 +613,34 @@ static const JanetReg string_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"string/join", cfun_string_join,
|
"string/join", cfun_string_join,
|
||||||
JDOC("(string/join parts [,sep])\n\n"
|
JDOC("(string/join parts &opt sep)\n\n"
|
||||||
"Joins an array of strings into one string, optionally separated by "
|
"Joins an array of strings into one string, optionally separated by "
|
||||||
"a separator string sep.")
|
"a separator string sep.")
|
||||||
},
|
},
|
||||||
{ "string/format", cfun_string_format,
|
{
|
||||||
|
"string/format", cfun_string_format,
|
||||||
JDOC("(string/format format & values)\n\n"
|
JDOC("(string/format format & values)\n\n"
|
||||||
"Similar to snprintf, but specialized for operating with janet. Returns "
|
"Similar to snprintf, but specialized for operating with janet. Returns "
|
||||||
"a new string.")
|
"a new string.")
|
||||||
},
|
},
|
||||||
|
{
|
||||||
|
"string/trim", cfun_string_trim,
|
||||||
|
JDOC("(string/trim str &opt set)\n\n"
|
||||||
|
"Trim leading and trailing whitespace from a byte sequence. If the argument "
|
||||||
|
"set is provided, consider only characters in set to be whitespace.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"string/triml", cfun_string_triml,
|
||||||
|
JDOC("(string/triml str &opt set)\n\n"
|
||||||
|
"Trim leading whitespace from a byte sequence. If the argument "
|
||||||
|
"set is provided, consider only characters in set to be whitespace.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"string/trimr", cfun_string_trimr,
|
||||||
|
JDOC("(string/trimr str &opt set)\n\n"
|
||||||
|
"Trim trailing whitespace from a byte sequence. If the argument "
|
||||||
|
"set is provided, consider only characters in set to be whitespace.")
|
||||||
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|||||||
@@ -26,29 +26,26 @@
|
|||||||
* This version has been modified for much greater flexibility in parsing, such
|
* This version has been modified for much greater flexibility in parsing, such
|
||||||
* as choosing the radix and supporting scientific notation with any radix.
|
* as choosing the radix and supporting scientific notation with any radix.
|
||||||
*
|
*
|
||||||
* Numbers are of the form [-+]R[rR]I.F[eE&][-+]X where R is the radix, I is
|
* Numbers are of the form [-+]R[rR]I.F[eE&][-+]X in pseudo-regex form, where R
|
||||||
* the integer part, F is the fractional part, and X is the exponent. All
|
* is the radix, I is the integer part, F is the fractional part, and X is the
|
||||||
* signs, radix, decimal point, fractional part, and exponent can be omitted.
|
* exponent. All signs, radix, decimal point, fractional part, and exponent can
|
||||||
* The number will be considered and integer if the there is no decimal point
|
* be omitted. The radix is assumed to be 10 if omitted, and the E or e
|
||||||
* and no exponent. Any number greater the 2^32-1 or less than -(2^32) will be
|
|
||||||
* coerced to a double. If there is an error, the function janet_scan_number will
|
|
||||||
* return a janet nil. The radix is assumed to be 10 if omitted, and the E
|
|
||||||
* separator for the exponent can only be used when the radix is 10. This is
|
* separator for the exponent can only be used when the radix is 10. This is
|
||||||
* because E is a valid digit in bases 15 or greater. For bases greater than 10,
|
* because E is a valid digit in bases 15 or greater. For bases greater than
|
||||||
* the letters are used as digits. A through Z correspond to the digits 10
|
* 10, the letters are used as digits. A through Z correspond to the digits 10
|
||||||
* through 35, and the lowercase letters have the same values. The radix number
|
* through 35, and the lowercase letters have the same values. The radix number
|
||||||
* is always in base 10. For example, a hexidecimal number could be written
|
* is always in base 10. For example, a hexidecimal number could be written
|
||||||
* '16rdeadbeef'. janet_scan_number also supports some c style syntax for
|
* '16rdeadbeef'. janet_scan_number also supports some c style syntax for
|
||||||
* hexidecimal literals. The previous number could also be written
|
* hexidecimal literals. The previous number could also be written
|
||||||
* '0xdeadbeef'. Note that in this case, the number will actually be a double
|
* '0xdeadbeef'.
|
||||||
* as it will not fit in the range for a signed 32 bit integer. The string
|
*/
|
||||||
* '0xbeef' would parse to an integer as it is in the range of an int32_t. */
|
|
||||||
|
|
||||||
#include <math.h>
|
#include <math.h>
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Lookup table for getting values of characters when parsing numbers. Handles
|
/* Lookup table for getting values of characters when parsing numbers. Handles
|
||||||
@@ -75,6 +72,7 @@ struct BigNat {
|
|||||||
uint32_t *digits; /* Each digit is base (2 ^ 31). Digits are least significant first. */
|
uint32_t *digits; /* Each digit is base (2 ^ 31). Digits are least significant first. */
|
||||||
};
|
};
|
||||||
|
|
||||||
|
/* Initialize a bignat to 0 */
|
||||||
static void bignat_zero(struct BigNat *x) {
|
static void bignat_zero(struct BigNat *x) {
|
||||||
x->first_digit = 0;
|
x->first_digit = 0;
|
||||||
x->n = 0;
|
x->n = 0;
|
||||||
@@ -197,7 +195,7 @@ static double bignat_extract(struct BigNat *mant, int32_t exponent2) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Read in a mantissa and exponent of a certain base, and give
|
/* Read in a mantissa and exponent of a certain base, and give
|
||||||
* back the double value. Should properly handle 0s, Infinities, and
|
* back the double value. Should properly handle 0s, infinities, and
|
||||||
* denormalized numbers. (When the exponent values are too large) */
|
* denormalized numbers. (When the exponent values are too large) */
|
||||||
static double convert(
|
static double convert(
|
||||||
int negative,
|
int negative,
|
||||||
@@ -293,8 +291,9 @@ int janet_scan_number(
|
|||||||
if (*str == '.') {
|
if (*str == '.') {
|
||||||
if (seenpoint) goto error;
|
if (seenpoint) goto error;
|
||||||
seenpoint = 1;
|
seenpoint = 1;
|
||||||
}
|
} else {
|
||||||
seenadigit = 1;
|
seenadigit = 1;
|
||||||
|
}
|
||||||
str++;
|
str++;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -349,7 +348,8 @@ int janet_scan_number(
|
|||||||
str++;
|
str++;
|
||||||
seenadigit = 1;
|
seenadigit = 1;
|
||||||
}
|
}
|
||||||
if (eneg) ex -= ee; else ex += ee;
|
if (eneg) ex -= ee;
|
||||||
|
else ex += ee;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (!seenadigit)
|
if (!seenadigit)
|
||||||
@@ -363,3 +363,100 @@ int janet_scan_number(
|
|||||||
free(mant.digits);
|
free(mant.digits);
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#ifdef JANET_INT_TYPES
|
||||||
|
|
||||||
|
static int scan_uint64(
|
||||||
|
const uint8_t *str,
|
||||||
|
int32_t len,
|
||||||
|
uint64_t *out,
|
||||||
|
int *neg) {
|
||||||
|
const uint8_t *end = str + len;
|
||||||
|
int seenadigit = 0;
|
||||||
|
int base = 10;
|
||||||
|
*neg = 0;
|
||||||
|
*out = 0;
|
||||||
|
uint64_t accum = 0;
|
||||||
|
/* len max is INT64_MAX in base 2 with _ between each bits */
|
||||||
|
/* '2r' + 64 bits + 63 _ + sign = 130 => 150 for some leading */
|
||||||
|
/* zeros */
|
||||||
|
if (len > 150) return 0;
|
||||||
|
/* Get sign */
|
||||||
|
if (str >= end) return 0;
|
||||||
|
if (*str == '-') {
|
||||||
|
*neg = 1;
|
||||||
|
str++;
|
||||||
|
} else if (*str == '+') {
|
||||||
|
str++;
|
||||||
|
}
|
||||||
|
/* Check for leading 0x or digit digit r */
|
||||||
|
if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
|
||||||
|
base = 16;
|
||||||
|
str += 2;
|
||||||
|
} else if (str + 1 < end &&
|
||||||
|
str[0] >= '0' && str[0] <= '9' &&
|
||||||
|
str[1] == 'r') {
|
||||||
|
base = str[0] - '0';
|
||||||
|
str += 2;
|
||||||
|
} else if (str + 2 < end &&
|
||||||
|
str[0] >= '0' && str[0] <= '9' &&
|
||||||
|
str[1] >= '0' && str[1] <= '9' &&
|
||||||
|
str[2] == 'r') {
|
||||||
|
base = 10 * (str[0] - '0') + (str[1] - '0');
|
||||||
|
if (base < 2 || base > 36) return 0;
|
||||||
|
str += 3;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Skip leading zeros */
|
||||||
|
while (str < end && *str == '0') {
|
||||||
|
seenadigit = 1;
|
||||||
|
str++;
|
||||||
|
}
|
||||||
|
/* Parse significant digits */
|
||||||
|
while (str < end) {
|
||||||
|
if (*str == '_') {
|
||||||
|
if (!seenadigit) return 0;
|
||||||
|
} else {
|
||||||
|
int digit = digit_lookup[*str & 0x7F];
|
||||||
|
if (*str > 127 || digit >= base) return 0;
|
||||||
|
if (accum > (UINT64_MAX - digit) / base) return 0;
|
||||||
|
accum = accum * base + digit;
|
||||||
|
seenadigit = 1;
|
||||||
|
}
|
||||||
|
str++;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (!seenadigit) return 0;
|
||||||
|
*out = accum;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
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);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
if (!neg && bi <= 0x7FFFFFFFFFFFFFFFULL) {
|
||||||
|
*out = bi;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out) {
|
||||||
|
int neg;
|
||||||
|
uint64_t bi;
|
||||||
|
if (scan_uint64(str, len, &bi, &neg)) {
|
||||||
|
if (!neg) {
|
||||||
|
*out = bi;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|||||||
@@ -21,7 +21,7 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include <math.h>
|
#include <math.h>
|
||||||
@@ -29,18 +29,18 @@
|
|||||||
|
|
||||||
/* Begin creation of a struct */
|
/* Begin creation of a struct */
|
||||||
JanetKV *janet_struct_begin(int32_t count) {
|
JanetKV *janet_struct_begin(int32_t count) {
|
||||||
|
|
||||||
/* Calculate capacity as power of 2 after 2 * count. */
|
/* Calculate capacity as power of 2 after 2 * count. */
|
||||||
int32_t capacity = janet_tablen(2 * count);
|
int32_t capacity = janet_tablen(2 * count);
|
||||||
if (capacity < 0) capacity = janet_tablen(count + 1);
|
if (capacity < 0) capacity = janet_tablen(count + 1);
|
||||||
|
|
||||||
size_t s = sizeof(int32_t) * 4 + (capacity * sizeof(JanetKV));
|
size_t size = sizeof(JanetStructHead) + capacity * sizeof(JanetKV);
|
||||||
char *data = janet_gcalloc(JANET_MEMORY_STRUCT, s);
|
JanetStructHead *head = janet_gcalloc(JANET_MEMORY_STRUCT, size);
|
||||||
JanetKV *st = (JanetKV *) (data + 4 * sizeof(int32_t));
|
head->length = count;
|
||||||
|
head->capacity = capacity;
|
||||||
|
head->hash = 0;
|
||||||
|
|
||||||
|
JanetKV *st = (JanetKV *)(head->data);
|
||||||
janet_memempty(st, capacity);
|
janet_memempty(st, capacity);
|
||||||
janet_struct_length(st) = count;
|
|
||||||
janet_struct_capacity(st) = capacity;
|
|
||||||
janet_struct_hash(st) = 0;
|
|
||||||
return st;
|
return st;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -25,11 +25,14 @@
|
|||||||
* checks, all symbols are interned so that there is a single copy of it in the
|
* checks, all symbols are interned so that there is a single copy of it in the
|
||||||
* whole program. Equality is then just a pointer check. */
|
* whole program. Equality is then just a pointer check. */
|
||||||
|
|
||||||
|
#include <string.h>
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#include "symcache.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Cache state */
|
/* Cache state */
|
||||||
@@ -41,7 +44,7 @@ JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted = 0;
|
|||||||
/* Initialize the cache (allocate cache memory) */
|
/* Initialize the cache (allocate cache memory) */
|
||||||
void janet_symcache_init() {
|
void janet_symcache_init() {
|
||||||
janet_vm_cache_capacity = 1024;
|
janet_vm_cache_capacity = 1024;
|
||||||
janet_vm_cache = calloc(1, janet_vm_cache_capacity * sizeof(const uint8_t **));
|
janet_vm_cache = calloc(1, janet_vm_cache_capacity * sizeof(const uint8_t *));
|
||||||
if (NULL == janet_vm_cache) {
|
if (NULL == janet_vm_cache) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
@@ -118,7 +121,7 @@ static const uint8_t **janet_symcache_findmem(
|
|||||||
static void janet_cache_resize(uint32_t newCapacity) {
|
static void janet_cache_resize(uint32_t newCapacity) {
|
||||||
uint32_t i, oldCapacity;
|
uint32_t i, oldCapacity;
|
||||||
const uint8_t **oldCache = janet_vm_cache;
|
const uint8_t **oldCache = janet_vm_cache;
|
||||||
const uint8_t **newCache = calloc(1, newCapacity * sizeof(const uint8_t **));
|
const uint8_t **newCache = calloc(1, newCapacity * sizeof(const uint8_t *));
|
||||||
if (newCache == NULL) {
|
if (newCache == NULL) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
@@ -175,10 +178,10 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
|
|||||||
const uint8_t **bucket = janet_symcache_findmem(str, len, hash, &success);
|
const uint8_t **bucket = janet_symcache_findmem(str, len, hash, &success);
|
||||||
if (success)
|
if (success)
|
||||||
return *bucket;
|
return *bucket;
|
||||||
newstr = (uint8_t *) janet_gcalloc(JANET_MEMORY_SYMBOL, 2 * sizeof(int32_t) + len + 1)
|
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + len + 1);
|
||||||
+ (2 * sizeof(int32_t));
|
head->hash = hash;
|
||||||
janet_string_hash(newstr) = hash;
|
head->length = len;
|
||||||
janet_string_length(newstr) = len;
|
newstr = (uint8_t *)(head->data);
|
||||||
memcpy(newstr, str, len);
|
memcpy(newstr, str, len);
|
||||||
newstr[len] = 0;
|
newstr[len] = 0;
|
||||||
janet_symcache_put((const uint8_t *)newstr, bucket);
|
janet_symcache_put((const uint8_t *)newstr, bucket);
|
||||||
@@ -187,9 +190,7 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
|
|||||||
|
|
||||||
/* Get a symbol from a cstring */
|
/* Get a symbol from a cstring */
|
||||||
const uint8_t *janet_csymbol(const char *cstr) {
|
const uint8_t *janet_csymbol(const char *cstr) {
|
||||||
int32_t len = 0;
|
return janet_symbol((const uint8_t *)cstr, (int32_t) strlen(cstr));
|
||||||
while (cstr[len]) len++;
|
|
||||||
return janet_symbol((const uint8_t *)cstr, len);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Store counter for genysm to avoid quadratic behavior */
|
/* Store counter for genysm to avoid quadratic behavior */
|
||||||
@@ -233,13 +234,11 @@ const uint8_t *janet_symbol_gen(void) {
|
|||||||
hash,
|
hash,
|
||||||
&status);
|
&status);
|
||||||
} while (status && (inc_gensym(), 1));
|
} while (status && (inc_gensym(), 1));
|
||||||
sym = (uint8_t *) janet_gcalloc(
|
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + sizeof(gensym_counter));
|
||||||
JANET_MEMORY_SYMBOL,
|
head->length = sizeof(gensym_counter) - 1;
|
||||||
2 * sizeof(int32_t) + sizeof(gensym_counter)) +
|
head->hash = hash;
|
||||||
(2 * sizeof(int32_t));
|
sym = (uint8_t *)(head->data);
|
||||||
memcpy(sym, gensym_counter, sizeof(gensym_counter));
|
memcpy(sym, gensym_counter, sizeof(gensym_counter));
|
||||||
janet_string_length(sym) = sizeof(gensym_counter) - 1;
|
|
||||||
janet_string_hash(sym) = hash;
|
|
||||||
janet_symcache_put((const uint8_t *)sym, bucket);
|
janet_symcache_put((const uint8_t *)sym, bucket);
|
||||||
return (const uint8_t *)sym;
|
return (const uint8_t *)sym;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -24,7 +24,7 @@
|
|||||||
#define JANET_SYMCACHE_H_defined
|
#define JANET_SYMCACHE_H_defined
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Initialize the cache (allocate cache memory) */
|
/* Initialize the cache (allocate cache memory) */
|
||||||
|
|||||||
@@ -21,21 +21,39 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include <math.h>
|
#include <math.h>
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Initialize a table */
|
#define JANET_TABLE_FLAG_STACK 0x10000
|
||||||
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
|
|
||||||
|
static void *janet_memalloc_empty_local(int32_t count) {
|
||||||
|
int32_t i;
|
||||||
|
void *mem = janet_smalloc(count * sizeof(JanetKV));
|
||||||
|
JanetKV *mmem = (JanetKV *)mem;
|
||||||
|
for (i = 0; i < count; i++) {
|
||||||
|
JanetKV *kv = mmem + i;
|
||||||
|
kv->key = janet_wrap_nil();
|
||||||
|
kv->value = janet_wrap_nil();
|
||||||
|
}
|
||||||
|
return mem;
|
||||||
|
}
|
||||||
|
|
||||||
|
static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, int stackalloc) {
|
||||||
JanetKV *data;
|
JanetKV *data;
|
||||||
capacity = janet_tablen(capacity);
|
capacity = janet_tablen(capacity);
|
||||||
|
if (stackalloc) table->gc.flags = JANET_TABLE_FLAG_STACK;
|
||||||
if (capacity) {
|
if (capacity) {
|
||||||
|
if (stackalloc) {
|
||||||
|
data = janet_memalloc_empty_local(capacity);
|
||||||
|
} else {
|
||||||
data = (JanetKV *) janet_memalloc_empty(capacity);
|
data = (JanetKV *) janet_memalloc_empty(capacity);
|
||||||
if (NULL == data) {
|
if (NULL == data) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
|
}
|
||||||
table->data = data;
|
table->data = data;
|
||||||
table->capacity = capacity;
|
table->capacity = capacity;
|
||||||
} else {
|
} else {
|
||||||
@@ -48,15 +66,20 @@ JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
|
|||||||
return table;
|
return table;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Initialize a table */
|
||||||
|
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
|
||||||
|
return janet_table_init_impl(table, capacity, 1);
|
||||||
|
}
|
||||||
|
|
||||||
/* Deinitialize a table */
|
/* Deinitialize a table */
|
||||||
void janet_table_deinit(JanetTable *table) {
|
void janet_table_deinit(JanetTable *table) {
|
||||||
free(table->data);
|
janet_sfree(table->data);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Create a new table */
|
/* Create a new table */
|
||||||
JanetTable *janet_table(int32_t capacity) {
|
JanetTable *janet_table(int32_t capacity) {
|
||||||
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
|
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
|
||||||
return janet_table_init(table, capacity);
|
return janet_table_init_impl(table, capacity, 0);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Find the bucket that contains the given key. Will also return
|
/* Find the bucket that contains the given key. Will also return
|
||||||
@@ -68,10 +91,16 @@ JanetKV *janet_table_find(JanetTable *t, Janet key) {
|
|||||||
/* Resize the dictionary table. */
|
/* Resize the dictionary table. */
|
||||||
static void janet_table_rehash(JanetTable *t, int32_t size) {
|
static void janet_table_rehash(JanetTable *t, int32_t size) {
|
||||||
JanetKV *olddata = t->data;
|
JanetKV *olddata = t->data;
|
||||||
JanetKV *newdata = (JanetKV *) janet_memalloc_empty(size);
|
JanetKV *newdata;
|
||||||
|
int islocal = t->gc.flags & JANET_TABLE_FLAG_STACK;
|
||||||
|
if (islocal) {
|
||||||
|
newdata = (JanetKV *) janet_memalloc_empty_local(size);
|
||||||
|
} else {
|
||||||
|
newdata = (JanetKV *) janet_memalloc_empty(size);
|
||||||
if (NULL == newdata) {
|
if (NULL == newdata) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
|
}
|
||||||
int32_t i, oldcapacity;
|
int32_t i, oldcapacity;
|
||||||
oldcapacity = t->capacity;
|
oldcapacity = t->capacity;
|
||||||
t->data = newdata;
|
t->data = newdata;
|
||||||
@@ -84,8 +113,12 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
|
|||||||
*newkv = *kv;
|
*newkv = *kv;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
if (islocal) {
|
||||||
|
janet_sfree(olddata);
|
||||||
|
} else {
|
||||||
free(olddata);
|
free(olddata);
|
||||||
}
|
}
|
||||||
|
}
|
||||||
|
|
||||||
/* Get a value out of the table */
|
/* Get a value out of the table */
|
||||||
Janet janet_table_get(JanetTable *t, Janet key) {
|
Janet janet_table_get(JanetTable *t, Janet key) {
|
||||||
@@ -144,7 +177,7 @@ void janet_table_put(JanetTable *t, Janet key, Janet value) {
|
|||||||
janet_table_rehash(t, janet_tablen(2 * t->count + 2));
|
janet_table_rehash(t, janet_tablen(2 * t->count + 2));
|
||||||
}
|
}
|
||||||
bucket = janet_table_find(t, key);
|
bucket = janet_table_find(t, key);
|
||||||
if (janet_checktype(bucket->value, JANET_FALSE))
|
if (janet_checktype(bucket->value, JANET_BOOLEAN))
|
||||||
--t->deleted;
|
--t->deleted;
|
||||||
bucket->key = key;
|
bucket->key = key;
|
||||||
bucket->value = value;
|
bucket->value = value;
|
||||||
|
|||||||
@@ -21,7 +21,7 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "symcache.h"
|
#include "symcache.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
@@ -31,13 +31,12 @@
|
|||||||
* which should be filled with Janets. The memory will not be collected until
|
* which should be filled with Janets. The memory will not be collected until
|
||||||
* janet_tuple_end is called. */
|
* janet_tuple_end is called. */
|
||||||
Janet *janet_tuple_begin(int32_t length) {
|
Janet *janet_tuple_begin(int32_t length) {
|
||||||
char *data = janet_gcalloc(JANET_MEMORY_TUPLE, 5 * sizeof(int32_t) + length * sizeof(Janet));
|
size_t size = sizeof(JanetTupleHead) + (length * sizeof(Janet));
|
||||||
Janet *tuple = (Janet *)(data + (5 * sizeof(int32_t)));
|
JanetTupleHead *head = janet_gcalloc(JANET_MEMORY_TUPLE, size);
|
||||||
janet_tuple_length(tuple) = length;
|
head->sm_start = -1;
|
||||||
janet_tuple_sm_start(tuple) = -1;
|
head->sm_end = -1;
|
||||||
janet_tuple_sm_end(tuple) = -1;
|
head->length = length;
|
||||||
janet_tuple_flag(tuple) = 0;
|
return (Janet *)(head->data);
|
||||||
return tuple;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Finish building a tuple */
|
/* Finish building a tuple */
|
||||||
@@ -106,26 +105,6 @@ static Janet cfun_tuple_slice(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
|
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_tuple_prepend(int32_t argc, Janet *argv) {
|
|
||||||
janet_arity(argc, 1, -1);
|
|
||||||
JanetView view = janet_getindexed(argv, 0);
|
|
||||||
Janet *n = janet_tuple_begin(view.len - 1 + argc);
|
|
||||||
memcpy(n - 1 + argc, view.items, sizeof(Janet) * view.len);
|
|
||||||
for (int32_t i = 1; i < argc; i++) {
|
|
||||||
n[argc - i - 1] = argv[i];
|
|
||||||
}
|
|
||||||
return janet_wrap_tuple(janet_tuple_end(n));
|
|
||||||
}
|
|
||||||
|
|
||||||
static Janet cfun_tuple_append(int32_t argc, Janet *argv) {
|
|
||||||
janet_arity(argc, 1, -1);
|
|
||||||
JanetView view = janet_getindexed(argv, 0);
|
|
||||||
Janet *n = janet_tuple_begin(view.len - 1 + argc);
|
|
||||||
memcpy(n, view.items, sizeof(Janet) * view.len);
|
|
||||||
memcpy(n + view.len, argv + 1, sizeof(Janet) * (argc - 1));
|
|
||||||
return janet_wrap_tuple(janet_tuple_end(n));
|
|
||||||
}
|
|
||||||
|
|
||||||
static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
|
static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
const Janet *tup = janet_gettuple(argv, 0);
|
const Janet *tup = janet_gettuple(argv, 0);
|
||||||
@@ -136,6 +115,23 @@ static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Janet cfun_tuple_sourcemap(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
const Janet *tup = janet_gettuple(argv, 0);
|
||||||
|
Janet contents[2];
|
||||||
|
contents[0] = janet_wrap_integer(janet_tuple_head(tup)->sm_start);
|
||||||
|
contents[1] = janet_wrap_integer(janet_tuple_head(tup)->sm_end);
|
||||||
|
return janet_wrap_tuple(janet_tuple_n(contents, 2));
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_tuple_setmap(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 3);
|
||||||
|
const Janet *tup = janet_gettuple(argv, 0);
|
||||||
|
janet_tuple_head(tup)->sm_start = janet_getinteger(argv, 1);
|
||||||
|
janet_tuple_head(tup)->sm_end = janet_getinteger(argv, 2);
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
static const JanetReg tuple_cfuns[] = {
|
static const JanetReg tuple_cfuns[] = {
|
||||||
{
|
{
|
||||||
"tuple/brackets", cfun_tuple_brackets,
|
"tuple/brackets", cfun_tuple_brackets,
|
||||||
@@ -150,19 +146,6 @@ static const JanetReg tuple_cfuns[] = {
|
|||||||
"they default to 0 and the length of arrtup respectively."
|
"they default to 0 and the length of arrtup respectively."
|
||||||
"Returns the new tuple.")
|
"Returns the new tuple.")
|
||||||
},
|
},
|
||||||
{
|
|
||||||
"tuple/append", cfun_tuple_append,
|
|
||||||
JDOC("(tuple/append tup & items)\n\n"
|
|
||||||
"Returns a new tuple that is the result of appending "
|
|
||||||
"each element in items to tup.")
|
|
||||||
},
|
|
||||||
{
|
|
||||||
"tuple/prepend", cfun_tuple_prepend,
|
|
||||||
JDOC("(tuple/prepend tup & items)\n\n"
|
|
||||||
"Prepends each element in items to tuple and "
|
|
||||||
"returns a new tuple. Items are prepended such that the "
|
|
||||||
"last element in items is the first element in the new tuple.")
|
|
||||||
},
|
|
||||||
{
|
{
|
||||||
"tuple/type", cfun_tuple_type,
|
"tuple/type", cfun_tuple_type,
|
||||||
JDOC("(tuple/type tup)\n\n"
|
JDOC("(tuple/type tup)\n\n"
|
||||||
@@ -172,6 +155,20 @@ static const JanetReg tuple_cfuns[] = {
|
|||||||
"the time, but will print differently and be treated differently by "
|
"the time, but will print differently and be treated differently by "
|
||||||
"the compiler.")
|
"the compiler.")
|
||||||
},
|
},
|
||||||
|
{
|
||||||
|
"tuple/sourcemap", cfun_tuple_sourcemap,
|
||||||
|
JDOC("(tuple/sourcemap tup)\n\n"
|
||||||
|
"Returns the sourcemap metadata attached to a tuple. "
|
||||||
|
"The mapping is represented by a pair of byte offsets into the "
|
||||||
|
"the source code representing the start and end byte indices where "
|
||||||
|
"the tuple is. ")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tuple/setmap", cfun_tuple_setmap,
|
||||||
|
JDOC("(tuple/setmap tup start end)\n\n"
|
||||||
|
"Set the sourcemap metadata on a tuple. start and end should "
|
||||||
|
"be integers representing byte offsets into the file. Returns tup.")
|
||||||
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|||||||
561
src/core/typedarray.c
Normal file
561
src/core/typedarray.c
Normal file
@@ -0,0 +1,561 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 Calvin Rose & contributors
|
||||||
|
*
|
||||||
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
* of this software and associated documentation files (the "Software"), to
|
||||||
|
* deal in the Software without restriction, including without limitation the
|
||||||
|
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||||
|
* sell copies of the Software, and to permit persons to whom the Software is
|
||||||
|
* furnished to do so, subject to the following conditions:
|
||||||
|
*
|
||||||
|
* The above copyright notice and this permission notice shall be included in
|
||||||
|
* all copies or substantial portions of the Software.
|
||||||
|
*
|
||||||
|
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||||
|
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
|
* IN THE SOFTWARE.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef JANET_TYPED_ARRAY
|
||||||
|
|
||||||
|
static char *ta_type_names[] = {
|
||||||
|
"uint8",
|
||||||
|
"int8",
|
||||||
|
"uint16",
|
||||||
|
"int16",
|
||||||
|
"uint32",
|
||||||
|
"int32",
|
||||||
|
"uint64",
|
||||||
|
"int64",
|
||||||
|
"float32",
|
||||||
|
"float64",
|
||||||
|
"?"
|
||||||
|
};
|
||||||
|
|
||||||
|
static size_t ta_type_sizes[] = {
|
||||||
|
sizeof(uint8_t),
|
||||||
|
sizeof(int8_t),
|
||||||
|
sizeof(uint16_t),
|
||||||
|
sizeof(int16_t),
|
||||||
|
sizeof(uint32_t),
|
||||||
|
sizeof(int32_t),
|
||||||
|
sizeof(uint64_t),
|
||||||
|
sizeof(int64_t),
|
||||||
|
sizeof(float),
|
||||||
|
sizeof(double),
|
||||||
|
0
|
||||||
|
};
|
||||||
|
|
||||||
|
#define TA_COUNT_TYPES (JANET_TARRAY_TYPE_F64 + 1)
|
||||||
|
#define TA_ATOM_MAXSIZE 8
|
||||||
|
#define TA_FLAG_BIG_ENDIAN 1
|
||||||
|
|
||||||
|
static JanetTArrayType get_ta_type_by_name(const uint8_t *name) {
|
||||||
|
for (int i = 0; i < TA_COUNT_TYPES; i++) {
|
||||||
|
if (!janet_cstrcmp(name, ta_type_names[i]))
|
||||||
|
return i;
|
||||||
|
}
|
||||||
|
janet_panicf("invalid typed array type %S", name);
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static JanetTArrayBuffer *ta_buffer_init(JanetTArrayBuffer *buf, size_t size) {
|
||||||
|
buf->data = NULL;
|
||||||
|
if (size > 0) {
|
||||||
|
buf->data = (uint8_t *)calloc(size, sizeof(uint8_t));
|
||||||
|
if (buf->data == NULL) {
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
buf->size = size;
|
||||||
|
#ifdef JANET_BIG_ENDIAN
|
||||||
|
buf->flags = TA_FLAG_BIG_ENDIAN;
|
||||||
|
#else
|
||||||
|
buf->flags = 0;
|
||||||
|
#endif
|
||||||
|
return buf;
|
||||||
|
}
|
||||||
|
|
||||||
|
static int ta_buffer_gc(void *p, size_t s) {
|
||||||
|
(void) s;
|
||||||
|
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
|
||||||
|
free(buf->data);
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static void ta_buffer_marshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
|
||||||
|
janet_marshal_size(ctx, buf->size);
|
||||||
|
janet_marshal_int(ctx, buf->flags);
|
||||||
|
janet_marshal_bytes(ctx, buf->data, buf->size);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void ta_buffer_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
|
||||||
|
size_t size = janet_unmarshal_size(ctx);
|
||||||
|
ta_buffer_init(buf, size);
|
||||||
|
buf->flags = janet_unmarshal_int(ctx);
|
||||||
|
janet_unmarshal_bytes(ctx, buf->data, size);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetAbstractType ta_buffer_type = {
|
||||||
|
"ta/buffer",
|
||||||
|
ta_buffer_gc,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
ta_buffer_marshal,
|
||||||
|
ta_buffer_unmarshal,
|
||||||
|
NULL
|
||||||
|
};
|
||||||
|
|
||||||
|
static int ta_mark(void *p, size_t s) {
|
||||||
|
(void) s;
|
||||||
|
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||||
|
janet_mark(janet_wrap_abstract(view->buffer));
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static void ta_view_marshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||||
|
size_t offset = (view->buffer->data - view->as.u8);
|
||||||
|
janet_marshal_size(ctx, view->size);
|
||||||
|
janet_marshal_size(ctx, view->stride);
|
||||||
|
janet_marshal_int(ctx, view->type);
|
||||||
|
janet_marshal_size(ctx, offset);
|
||||||
|
janet_marshal_janet(ctx, janet_wrap_abstract(view->buffer));
|
||||||
|
}
|
||||||
|
|
||||||
|
static void ta_view_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||||
|
size_t offset;
|
||||||
|
int32_t atype;
|
||||||
|
Janet buffer;
|
||||||
|
view->size = janet_unmarshal_size(ctx);
|
||||||
|
view->stride = janet_unmarshal_size(ctx);
|
||||||
|
atype = janet_unmarshal_int(ctx);
|
||||||
|
if (atype < 0 || atype >= TA_COUNT_TYPES)
|
||||||
|
janet_panic("bad typed array type");
|
||||||
|
view->type = atype;
|
||||||
|
offset = janet_unmarshal_size(ctx);
|
||||||
|
buffer = janet_unmarshal_janet(ctx);
|
||||||
|
if (!janet_checktype(buffer, JANET_ABSTRACT) ||
|
||||||
|
(janet_abstract_type(janet_unwrap_abstract(buffer)) != &ta_buffer_type)) {
|
||||||
|
janet_panicf("expected typed array buffer");
|
||||||
|
}
|
||||||
|
view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer);
|
||||||
|
size_t buf_need_size = offset + (ta_type_sizes[view->type]) * ((view->size - 1) * view->stride + 1);
|
||||||
|
if (view->buffer->size < buf_need_size)
|
||||||
|
janet_panic("bad typed array offset in marshalled data");
|
||||||
|
view->as.u8 = view->buffer->data + offset;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet ta_getter(void *p, Janet key) {
|
||||||
|
Janet value;
|
||||||
|
size_t index, i;
|
||||||
|
JanetTArrayView *array = p;
|
||||||
|
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||||
|
index = (size_t) janet_unwrap_number(key);
|
||||||
|
i = index * array->stride;
|
||||||
|
if (index >= array->size) {
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
} else {
|
||||||
|
switch (array->type) {
|
||||||
|
case JANET_TARRAY_TYPE_U8:
|
||||||
|
value = janet_wrap_number(array->as.u8[i]);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S8:
|
||||||
|
value = janet_wrap_number(array->as.s8[i]);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_U16:
|
||||||
|
value = janet_wrap_number(array->as.u16[i]);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S16:
|
||||||
|
value = janet_wrap_number(array->as.s16[i]);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_U32:
|
||||||
|
value = janet_wrap_number(array->as.u32[i]);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S32:
|
||||||
|
value = janet_wrap_number(array->as.s32[i]);
|
||||||
|
break;
|
||||||
|
#ifdef JANET_INT_TYPES
|
||||||
|
case JANET_TARRAY_TYPE_U64:
|
||||||
|
value = janet_wrap_u64(array->as.u64[i]);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S64:
|
||||||
|
value = janet_wrap_s64(array->as.s64[i]);
|
||||||
|
break;
|
||||||
|
#endif
|
||||||
|
case JANET_TARRAY_TYPE_F32:
|
||||||
|
value = janet_wrap_number(array->as.f32[i]);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_F64:
|
||||||
|
value = janet_wrap_number(array->as.f64[i]);
|
||||||
|
break;
|
||||||
|
default:
|
||||||
|
janet_panicf("cannot get from typed array of type %s",
|
||||||
|
ta_type_names[array->type]);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return value;
|
||||||
|
}
|
||||||
|
|
||||||
|
static void ta_setter(void *p, Janet key, Janet value) {
|
||||||
|
size_t index, i;
|
||||||
|
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||||
|
index = (size_t) janet_unwrap_number(key);
|
||||||
|
JanetTArrayView *array = p;
|
||||||
|
i = index * array->stride;
|
||||||
|
if (index >= array->size) {
|
||||||
|
janet_panic("index out of bounds");
|
||||||
|
}
|
||||||
|
if (!janet_checktype(value, JANET_NUMBER) &&
|
||||||
|
array->type != JANET_TARRAY_TYPE_U64 &&
|
||||||
|
array->type != JANET_TARRAY_TYPE_S64) {
|
||||||
|
janet_panic("expected number value");
|
||||||
|
}
|
||||||
|
switch (array->type) {
|
||||||
|
case JANET_TARRAY_TYPE_U8:
|
||||||
|
array->as.u8[i] = (uint8_t) janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S8:
|
||||||
|
array->as.s8[i] = (int8_t) janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_U16:
|
||||||
|
array->as.u16[i] = (uint16_t) janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S16:
|
||||||
|
array->as.s16[i] = (int16_t) janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_U32:
|
||||||
|
array->as.u32[i] = (uint32_t) janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S32:
|
||||||
|
array->as.s32[i] = (int32_t) janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
#ifdef JANET_INT_TYPES
|
||||||
|
case JANET_TARRAY_TYPE_U64:
|
||||||
|
array->as.u64[i] = janet_unwrap_u64(value);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_S64:
|
||||||
|
array->as.s64[i] = janet_unwrap_s64(value);
|
||||||
|
break;
|
||||||
|
#endif
|
||||||
|
case JANET_TARRAY_TYPE_F32:
|
||||||
|
array->as.f32[i] = (float) janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
case JANET_TARRAY_TYPE_F64:
|
||||||
|
array->as.f64[i] = janet_unwrap_number(value);
|
||||||
|
break;
|
||||||
|
default:
|
||||||
|
janet_panicf("cannot set typed array of type %s",
|
||||||
|
ta_type_names[array->type]);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetAbstractType ta_view_type = {
|
||||||
|
"ta/view",
|
||||||
|
NULL,
|
||||||
|
ta_mark,
|
||||||
|
ta_getter,
|
||||||
|
ta_setter,
|
||||||
|
ta_view_marshal,
|
||||||
|
ta_view_unmarshal,
|
||||||
|
NULL
|
||||||
|
};
|
||||||
|
|
||||||
|
JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
|
||||||
|
JanetTArrayBuffer *buf = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||||
|
ta_buffer_init(buf, size);
|
||||||
|
return buf;
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetTArrayView *janet_tarray_view(
|
||||||
|
JanetTArrayType type,
|
||||||
|
size_t size,
|
||||||
|
size_t stride,
|
||||||
|
size_t offset,
|
||||||
|
JanetTArrayBuffer *buffer) {
|
||||||
|
|
||||||
|
JanetTArrayView *view = janet_abstract(&ta_view_type, sizeof(JanetTArrayView));
|
||||||
|
|
||||||
|
if ((stride < 1) || (size < 1)) janet_panic("stride and size should be > 0");
|
||||||
|
size_t buf_size = offset + ta_type_sizes[type] * ((size - 1) * stride + 1);
|
||||||
|
|
||||||
|
if (NULL == buffer) {
|
||||||
|
buffer = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||||
|
ta_buffer_init(buffer, buf_size);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (buffer->size < buf_size) {
|
||||||
|
janet_panicf("bad buffer size, %i bytes allocated < %i required",
|
||||||
|
buffer->size,
|
||||||
|
buf_size);
|
||||||
|
}
|
||||||
|
|
||||||
|
view->buffer = buffer;
|
||||||
|
view->stride = stride;
|
||||||
|
view->size = size;
|
||||||
|
view->as.u8 = buffer->data + offset;
|
||||||
|
view->type = type;
|
||||||
|
|
||||||
|
return view;
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) {
|
||||||
|
return janet_getabstract(argv, n, &ta_buffer_type);
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) {
|
||||||
|
return janet_getabstract(argv, n, &ta_view_type);
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) {
|
||||||
|
JanetTArrayView *view = janet_getabstract(argv, n, &ta_view_type);
|
||||||
|
if (view->type != type) {
|
||||||
|
janet_panicf("bad slot #%d, expected typed array of type %s, got %v",
|
||||||
|
n, ta_type_names[type], argv[n]);
|
||||||
|
}
|
||||||
|
return view;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 2, 5);
|
||||||
|
size_t offset = 0;
|
||||||
|
size_t stride = 1;
|
||||||
|
JanetTArrayBuffer *buffer = NULL;
|
||||||
|
const uint8_t *keyw = janet_getkeyword(argv, 0);
|
||||||
|
JanetTArrayType type = get_ta_type_by_name(keyw);
|
||||||
|
size_t size = janet_getsize(argv, 1);
|
||||||
|
if (argc > 2)
|
||||||
|
stride = janet_getsize(argv, 2);
|
||||||
|
if (argc > 3)
|
||||||
|
offset = janet_getsize(argv, 3);
|
||||||
|
if (argc > 4) {
|
||||||
|
if (!janet_checktype(argv[4], JANET_ABSTRACT)) {
|
||||||
|
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
|
||||||
|
4, argv[4]);
|
||||||
|
}
|
||||||
|
void *p = janet_unwrap_abstract(argv[4]);
|
||||||
|
if (janet_abstract_type(p) == &ta_view_type) {
|
||||||
|
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||||
|
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
|
||||||
|
stride *= view->stride;
|
||||||
|
buffer = view->buffer;
|
||||||
|
} else {
|
||||||
|
buffer = p;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer);
|
||||||
|
return janet_wrap_abstract(view);
|
||||||
|
}
|
||||||
|
|
||||||
|
static JanetTArrayView *ta_is_view(Janet x) {
|
||||||
|
if (!janet_checktype(x, JANET_ABSTRACT)) return NULL;
|
||||||
|
void *abst = janet_unwrap_abstract(x);
|
||||||
|
if (janet_abstract_type(abst) != &ta_view_type) return NULL;
|
||||||
|
return (JanetTArrayView *)abst;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_buffer(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetTArrayView *view;
|
||||||
|
if ((view = ta_is_view(argv[0]))) {
|
||||||
|
return janet_wrap_abstract(view->buffer);
|
||||||
|
}
|
||||||
|
size_t size = janet_getsize(argv, 0);
|
||||||
|
JanetTArrayBuffer *buf = janet_tarray_buffer(size);
|
||||||
|
return janet_wrap_abstract(buf);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetTArrayView *view;
|
||||||
|
if ((view = ta_is_view(argv[0]))) {
|
||||||
|
return janet_wrap_number((double) view->size);
|
||||||
|
}
|
||||||
|
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &ta_buffer_type);
|
||||||
|
return janet_wrap_number((double) buf->size);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetTArrayView *view;
|
||||||
|
if ((view = ta_is_view(argv[0]))) {
|
||||||
|
JanetTArrayView *view = janet_unwrap_abstract(argv[0]);
|
||||||
|
JanetKV *props = janet_struct_begin(6);
|
||||||
|
ptrdiff_t boffset = view->as.u8 - view->buffer->data;
|
||||||
|
janet_struct_put(props, janet_ckeywordv("size"),
|
||||||
|
janet_wrap_number((double) view->size));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("byte-offset"),
|
||||||
|
janet_wrap_number((double) boffset));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("stride"),
|
||||||
|
janet_wrap_number((double) view->stride));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("type"),
|
||||||
|
janet_ckeywordv(ta_type_names[view->type]));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("type-size"),
|
||||||
|
janet_wrap_number((double) ta_type_sizes[view->type]));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("buffer"),
|
||||||
|
janet_wrap_abstract(view->buffer));
|
||||||
|
return janet_wrap_struct(janet_struct_end(props));
|
||||||
|
} else {
|
||||||
|
JanetTArrayBuffer *buffer = janet_gettarray_buffer(argv, 0);
|
||||||
|
JanetKV *props = janet_struct_begin(2);
|
||||||
|
janet_struct_put(props, janet_ckeywordv("size"),
|
||||||
|
janet_wrap_number((double) buffer->size));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("big-endian"),
|
||||||
|
janet_wrap_boolean(buffer->flags & TA_FLAG_BIG_ENDIAN));
|
||||||
|
return janet_wrap_struct(janet_struct_end(props));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 3);
|
||||||
|
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
|
||||||
|
JanetRange range;
|
||||||
|
int32_t length = (int32_t)src->size;
|
||||||
|
if (argc == 1) {
|
||||||
|
range.start = 0;
|
||||||
|
range.end = length;
|
||||||
|
} else if (argc == 2) {
|
||||||
|
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||||
|
range.end = length;
|
||||||
|
} else {
|
||||||
|
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||||
|
range.end = janet_gethalfrange(argv, 2, length, "end");
|
||||||
|
if (range.end < range.start)
|
||||||
|
range.end = range.start;
|
||||||
|
}
|
||||||
|
JanetArray *array = janet_array(range.end - range.start);
|
||||||
|
if (array->data) {
|
||||||
|
for (int32_t i = range.start; i < range.end; i++) {
|
||||||
|
array->data[i - range.start] = ta_getter(src, janet_wrap_number(i));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
array->count = range.end - range.start;
|
||||||
|
return janet_wrap_array(array);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 4, 5);
|
||||||
|
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
|
||||||
|
size_t index_src = janet_getsize(argv, 1);
|
||||||
|
JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
|
||||||
|
size_t index_dst = janet_getsize(argv, 3);
|
||||||
|
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
|
||||||
|
size_t src_atom_size = ta_type_sizes[src->type];
|
||||||
|
size_t dst_atom_size = ta_type_sizes[dst->type];
|
||||||
|
size_t step_src = src->stride * src_atom_size;
|
||||||
|
size_t step_dst = dst->stride * dst_atom_size;
|
||||||
|
size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
|
||||||
|
size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst);
|
||||||
|
uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
|
||||||
|
if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
|
||||||
|
(pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
|
||||||
|
for (size_t i = 0; i < count; i++) {
|
||||||
|
memmove(pd, ps, src_atom_size);
|
||||||
|
pd += step_dst;
|
||||||
|
ps += step_src;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
janet_panic("typed array copy out of bounds");
|
||||||
|
}
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 4, 5);
|
||||||
|
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
|
||||||
|
size_t index_src = janet_getsize(argv, 1);
|
||||||
|
JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
|
||||||
|
size_t index_dst = janet_getsize(argv, 3);
|
||||||
|
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
|
||||||
|
size_t src_atom_size = ta_type_sizes[src->type];
|
||||||
|
size_t dst_atom_size = ta_type_sizes[dst->type];
|
||||||
|
size_t step_src = src->stride * src_atom_size;
|
||||||
|
size_t step_dst = dst->stride * dst_atom_size;
|
||||||
|
size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
|
||||||
|
size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst);
|
||||||
|
uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
|
||||||
|
uint8_t temp[TA_ATOM_MAXSIZE];
|
||||||
|
if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
|
||||||
|
(pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
|
||||||
|
for (size_t i = 0; i < count; i++) {
|
||||||
|
memcpy(temp, ps, src_atom_size);
|
||||||
|
memcpy(ps, pd, src_atom_size);
|
||||||
|
memcpy(pd, temp, src_atom_size);
|
||||||
|
pd += step_dst;
|
||||||
|
ps += step_src;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
janet_panic("typed array swap out of bounds");
|
||||||
|
}
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg ta_cfuns[] = {
|
||||||
|
{
|
||||||
|
"tarray/new", cfun_typed_array_new,
|
||||||
|
JDOC("(tarray/new type size &opt stride offset tarray|buffer)\n\n"
|
||||||
|
"Create new typed array.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/buffer", cfun_typed_array_buffer,
|
||||||
|
JDOC("(tarray/buffer array|size)\n\n"
|
||||||
|
"Return typed array buffer or create a new buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/length", cfun_typed_array_size,
|
||||||
|
JDOC("(tarray/length array|buffer)\n\n"
|
||||||
|
"Return typed array or buffer size.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/properties", cfun_typed_array_properties,
|
||||||
|
JDOC("(tarray/properties array)\n\n"
|
||||||
|
"Return typed array properties as a struct.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/copy-bytes", cfun_typed_array_copy_bytes,
|
||||||
|
JDOC("(tarray/copy-bytes src sindex dst dindex &opt count)\n\n"
|
||||||
|
"Copy count elements (default 1) of src array from index sindex "
|
||||||
|
"to dst array at position dindex "
|
||||||
|
"memory can overlap.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/swap-bytes", cfun_typed_array_swap_bytes,
|
||||||
|
JDOC("(tarray/swap-bytes src sindex dst dindex &opt count)\n\n"
|
||||||
|
"Swap count elements (default 1) between src array from index sindex "
|
||||||
|
"and dst array at position dindex "
|
||||||
|
"memory can overlap.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/slice", cfun_typed_array_slice,
|
||||||
|
JDOC("(tarray/slice tarr &opt start end)\n\n"
|
||||||
|
"Takes a slice of a typed array from start to end. The range is half "
|
||||||
|
"open, [start, end). Indexes can also be negative, indicating indexing "
|
||||||
|
"from the end of the end of the typed array. By default, start is 0 and end is "
|
||||||
|
"the size of the typed array. Returns a new janet array.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
/* Module entry point */
|
||||||
|
void janet_lib_typed_array(JanetTable *env) {
|
||||||
|
janet_core_cfuns(env, NULL, ta_cfuns);
|
||||||
|
janet_register_abstract_type(&ta_buffer_type);
|
||||||
|
janet_register_abstract_type(&ta_view_type);
|
||||||
|
}
|
||||||
|
|
||||||
|
#endif
|
||||||
116
src/core/util.c
116
src/core/util.c
@@ -23,7 +23,7 @@
|
|||||||
#include <inttypes.h>
|
#include <inttypes.h>
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
@@ -42,7 +42,6 @@ const char *const janet_type_names[16] = {
|
|||||||
"number",
|
"number",
|
||||||
"nil",
|
"nil",
|
||||||
"boolean",
|
"boolean",
|
||||||
"boolean",
|
|
||||||
"fiber",
|
"fiber",
|
||||||
"string",
|
"string",
|
||||||
"symbol",
|
"symbol",
|
||||||
@@ -54,7 +53,8 @@ const char *const janet_type_names[16] = {
|
|||||||
"buffer",
|
"buffer",
|
||||||
"function",
|
"function",
|
||||||
"cfunction",
|
"cfunction",
|
||||||
"abstract"
|
"abstract",
|
||||||
|
"pointer"
|
||||||
};
|
};
|
||||||
|
|
||||||
const char *const janet_signal_names[14] = {
|
const char *const janet_signal_names[14] = {
|
||||||
@@ -270,12 +270,13 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
|||||||
int32_t nmlen = 0;
|
int32_t nmlen = 0;
|
||||||
while (regprefix[reglen]) reglen++;
|
while (regprefix[reglen]) reglen++;
|
||||||
while (cfuns->name[nmlen]) nmlen++;
|
while (cfuns->name[nmlen]) nmlen++;
|
||||||
uint8_t *longname_buffer =
|
int32_t symlen = reglen + 1 + nmlen;
|
||||||
janet_string_begin(reglen + 1 + nmlen);
|
uint8_t *longname_buffer = malloc(symlen);
|
||||||
memcpy(longname_buffer, regprefix, reglen);
|
memcpy(longname_buffer, regprefix, reglen);
|
||||||
longname_buffer[reglen] = '/';
|
longname_buffer[reglen] = '/';
|
||||||
memcpy(longname_buffer + reglen + 1, cfuns->name, nmlen);
|
memcpy(longname_buffer + reglen + 1, cfuns->name, nmlen);
|
||||||
longname = janet_wrap_symbol(janet_string_end(longname_buffer));
|
longname = janet_wrap_symbol(janet_symbol(longname_buffer, symlen));
|
||||||
|
free(longname_buffer);
|
||||||
}
|
}
|
||||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||||
janet_def(env, cfuns->name, fun, cfuns->documentation);
|
janet_def(env, cfuns->name, fun, cfuns->documentation);
|
||||||
@@ -284,19 +285,72 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Abstract type introspection */
|
||||||
|
|
||||||
|
static const JanetAbstractType type_wrap = {
|
||||||
|
"core/type-info",
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL
|
||||||
|
};
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
const JanetAbstractType *at;
|
||||||
|
} JanetAbstractTypeWrap;
|
||||||
|
|
||||||
|
void janet_register_abstract_type(const JanetAbstractType *at) {
|
||||||
|
JanetAbstractTypeWrap *abstract = (JanetAbstractTypeWrap *)
|
||||||
|
janet_abstract(&type_wrap, sizeof(JanetAbstractTypeWrap));
|
||||||
|
abstract->at = at;
|
||||||
|
Janet sym = janet_csymbolv(at->name);
|
||||||
|
if (!(janet_checktype(janet_table_get(janet_vm_registry, sym), JANET_NIL))) {
|
||||||
|
janet_panicf("cannot register abstract type %s, "
|
||||||
|
"a type with the same name exists", at->name);
|
||||||
|
}
|
||||||
|
janet_table_put(janet_vm_registry, sym, janet_wrap_abstract(abstract));
|
||||||
|
}
|
||||||
|
|
||||||
|
const JanetAbstractType *janet_get_abstract_type(Janet key) {
|
||||||
|
Janet twrap = janet_table_get(janet_vm_registry, key);
|
||||||
|
if (janet_checktype(twrap, 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;
|
||||||
|
}
|
||||||
|
|
||||||
#ifndef JANET_BOOTSTRAP
|
#ifndef JANET_BOOTSTRAP
|
||||||
void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p) {
|
void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p) {
|
||||||
(void) p;
|
(void) p;
|
||||||
janet_table_put(env, janet_csymbolv(name), x);
|
Janet key = janet_csymbolv(name);
|
||||||
|
Janet value;
|
||||||
|
/* During init, allow replacing core library cfunctions with values from
|
||||||
|
* the env. */
|
||||||
|
Janet check = janet_table_get(env, key);
|
||||||
|
if (janet_checktype(check, JANET_NIL)) {
|
||||||
|
value = x;
|
||||||
|
} else {
|
||||||
|
value = check;
|
||||||
|
}
|
||||||
|
janet_table_put(env, key, value);
|
||||||
|
if (janet_checktype(value, JANET_CFUNCTION)) {
|
||||||
|
janet_table_put(janet_vm_registry, value, key);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||||
(void) regprefix;
|
(void) regprefix;
|
||||||
while (cfuns->name) {
|
while (cfuns->name) {
|
||||||
Janet name = janet_csymbolv(cfuns->name);
|
|
||||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||||
janet_core_def(env, cfuns->name, fun, cfuns->documentation);
|
janet_core_def(env, cfuns->name, fun, cfuns->documentation);
|
||||||
janet_table_put(janet_vm_registry, fun, name);
|
|
||||||
cfuns++;
|
cfuns++;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -388,42 +442,10 @@ int janet_checkint64(Janet x) {
|
|||||||
return janet_checkint64range(dval);
|
return janet_checkint64range(dval);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Useful for inspecting values while debugging */
|
int janet_checksize(Janet x) {
|
||||||
void janet_inspect(Janet x) {
|
if (!janet_checktype(x, JANET_NUMBER))
|
||||||
printf("<type=%s, ", janet_type_names[janet_type(x)]);
|
return 0;
|
||||||
|
double dval = janet_unwrap_number(x);
|
||||||
#ifdef JANET_BIG_ENDIAN
|
return dval == (double)((size_t) dval) &&
|
||||||
printf("be ");
|
dval <= SIZE_MAX;
|
||||||
#else
|
|
||||||
printf("le ");
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#ifdef JANET_NANBOX_64
|
|
||||||
printf("nanbox64 raw=0x%.16" PRIx64 ", ", x.u64);
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#ifdef JANET_NANBOX_32
|
|
||||||
printf("nanbox32 type=0x%.8" PRIx32 ", ", x.tagged.type);
|
|
||||||
printf("payload=%" PRId32 ", ", x.tagged.payload.integer);
|
|
||||||
#endif
|
|
||||||
|
|
||||||
switch (janet_type(x)) {
|
|
||||||
case JANET_NIL:
|
|
||||||
printf("value=nil");
|
|
||||||
break;
|
|
||||||
case JANET_NUMBER:
|
|
||||||
printf("number=%.17g", janet_unwrap_number(x));
|
|
||||||
break;
|
|
||||||
case JANET_TRUE:
|
|
||||||
printf("value=true");
|
|
||||||
break;
|
|
||||||
case JANET_FALSE:
|
|
||||||
printf("value=false");
|
|
||||||
break;
|
|
||||||
default:
|
|
||||||
printf("pointer=%p", janet_unwrap_pointer(x));
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
|
|
||||||
printf(">\n");
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -23,8 +23,33 @@
|
|||||||
#ifndef JANET_UTIL_H_defined
|
#ifndef JANET_UTIL_H_defined
|
||||||
#define JANET_UTIL_H_defined
|
#define JANET_UTIL_H_defined
|
||||||
|
|
||||||
|
#include <stdio.h>
|
||||||
|
#include <errno.h>
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Handle runtime errors */
|
||||||
|
#ifndef janet_exit
|
||||||
|
#include <stdio.h>
|
||||||
|
#define janet_exit(m) do { \
|
||||||
|
printf("C runtime error at line %d in file %s: %s\n",\
|
||||||
|
__LINE__,\
|
||||||
|
__FILE__,\
|
||||||
|
(m));\
|
||||||
|
exit(1);\
|
||||||
|
} while (0)
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#define janet_assert(c, m) do { \
|
||||||
|
if (!(c)) janet_exit((m)); \
|
||||||
|
} while (0)
|
||||||
|
|
||||||
|
/* What to do when out of memory */
|
||||||
|
#ifndef JANET_OUT_OF_MEMORY
|
||||||
|
#include <stdio.h>
|
||||||
|
#define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Omit docstrings in some builds */
|
/* Omit docstrings in some builds */
|
||||||
@@ -86,6 +111,14 @@ void janet_lib_asm(JanetTable *env);
|
|||||||
#endif
|
#endif
|
||||||
void janet_lib_compile(JanetTable *env);
|
void janet_lib_compile(JanetTable *env);
|
||||||
void janet_lib_debug(JanetTable *env);
|
void janet_lib_debug(JanetTable *env);
|
||||||
|
#ifdef JANET_PEG
|
||||||
void janet_lib_peg(JanetTable *env);
|
void janet_lib_peg(JanetTable *env);
|
||||||
|
#endif
|
||||||
|
#ifdef JANET_TYPED_ARRAY
|
||||||
|
void janet_lib_typed_array(JanetTable *env);
|
||||||
|
#endif
|
||||||
|
#ifdef JANET_INT_TYPES
|
||||||
|
void janet_lib_inttypes(JanetTable *env);
|
||||||
|
#endif
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -21,7 +21,7 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/*
|
/*
|
||||||
@@ -36,10 +36,11 @@ int janet_equals(Janet x, Janet y) {
|
|||||||
} else {
|
} else {
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
case JANET_TRUE:
|
|
||||||
case JANET_FALSE:
|
|
||||||
result = 1;
|
result = 1;
|
||||||
break;
|
break;
|
||||||
|
case JANET_BOOLEAN:
|
||||||
|
result = (janet_unwrap_boolean(x) == janet_unwrap_boolean(y));
|
||||||
|
break;
|
||||||
case JANET_NUMBER:
|
case JANET_NUMBER:
|
||||||
result = (janet_unwrap_number(x) == janet_unwrap_number(y));
|
result = (janet_unwrap_number(x) == janet_unwrap_number(y));
|
||||||
break;
|
break;
|
||||||
@@ -68,11 +69,8 @@ int32_t janet_hash(Janet x) {
|
|||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
hash = 0;
|
hash = 0;
|
||||||
break;
|
break;
|
||||||
case JANET_FALSE:
|
case JANET_BOOLEAN:
|
||||||
hash = 1;
|
hash = janet_unwrap_boolean(x);
|
||||||
break;
|
|
||||||
case JANET_TRUE:
|
|
||||||
hash = 2;
|
|
||||||
break;
|
break;
|
||||||
case JANET_STRING:
|
case JANET_STRING:
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
@@ -111,9 +109,9 @@ int janet_compare(Janet x, Janet y) {
|
|||||||
if (janet_type(x) == janet_type(y)) {
|
if (janet_type(x) == janet_type(y)) {
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
case JANET_FALSE:
|
|
||||||
case JANET_TRUE:
|
|
||||||
return 0;
|
return 0;
|
||||||
|
case JANET_BOOLEAN:
|
||||||
|
return janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
|
||||||
case JANET_NUMBER:
|
case JANET_NUMBER:
|
||||||
/* Check for NaNs to ensure total order */
|
/* Check for NaNs to ensure total order */
|
||||||
if (janet_unwrap_number(x) != janet_unwrap_number(x))
|
if (janet_unwrap_number(x) != janet_unwrap_number(x))
|
||||||
@@ -153,7 +151,6 @@ Janet janet_get(Janet ds, Janet key) {
|
|||||||
switch (janet_type(ds)) {
|
switch (janet_type(ds)) {
|
||||||
default:
|
default:
|
||||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
||||||
value = janet_wrap_nil();
|
|
||||||
break;
|
break;
|
||||||
case JANET_STRUCT:
|
case JANET_STRUCT:
|
||||||
value = janet_struct_get(janet_unwrap_struct(ds), key);
|
value = janet_struct_get(janet_unwrap_struct(ds), key);
|
||||||
@@ -161,8 +158,7 @@ Janet janet_get(Janet ds, Janet key) {
|
|||||||
case JANET_TABLE:
|
case JANET_TABLE:
|
||||||
value = janet_table_get(janet_unwrap_table(ds), key);
|
value = janet_table_get(janet_unwrap_table(ds), key);
|
||||||
break;
|
break;
|
||||||
case JANET_ARRAY:
|
case JANET_ARRAY: {
|
||||||
{
|
|
||||||
JanetArray *array = janet_unwrap_array(ds);
|
JanetArray *array = janet_unwrap_array(ds);
|
||||||
int32_t index;
|
int32_t index;
|
||||||
if (!janet_checkint(key))
|
if (!janet_checkint(key))
|
||||||
@@ -175,8 +171,7 @@ Janet janet_get(Janet ds, Janet key) {
|
|||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE: {
|
||||||
{
|
|
||||||
const Janet *tuple = janet_unwrap_tuple(ds);
|
const Janet *tuple = janet_unwrap_tuple(ds);
|
||||||
int32_t index;
|
int32_t index;
|
||||||
if (!janet_checkint(key))
|
if (!janet_checkint(key))
|
||||||
@@ -189,8 +184,7 @@ Janet janet_get(Janet ds, Janet key) {
|
|||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_BUFFER:
|
case JANET_BUFFER: {
|
||||||
{
|
|
||||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||||
int32_t index;
|
int32_t index;
|
||||||
if (!janet_checkint(key))
|
if (!janet_checkint(key))
|
||||||
@@ -205,8 +199,7 @@ Janet janet_get(Janet ds, Janet key) {
|
|||||||
}
|
}
|
||||||
case JANET_STRING:
|
case JANET_STRING:
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
case JANET_KEYWORD:
|
case JANET_KEYWORD: {
|
||||||
{
|
|
||||||
const uint8_t *str = janet_unwrap_string(ds);
|
const uint8_t *str = janet_unwrap_string(ds);
|
||||||
int32_t index;
|
int32_t index;
|
||||||
if (!janet_checkint(key))
|
if (!janet_checkint(key))
|
||||||
@@ -219,14 +212,12 @@ Janet janet_get(Janet ds, Janet key) {
|
|||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_ABSTRACT:
|
case JANET_ABSTRACT: {
|
||||||
{
|
|
||||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
||||||
if (type->get) {
|
if (type->get) {
|
||||||
value = (type->get)(janet_unwrap_abstract(ds), key);
|
value = (type->get)(janet_unwrap_abstract(ds), key);
|
||||||
} else {
|
} else {
|
||||||
janet_panicf("no getter for %T ", JANET_TFLAG_LENGTHABLE, ds);
|
janet_panicf("no getter for %v ", ds);
|
||||||
value = janet_wrap_nil();
|
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -240,7 +231,6 @@ Janet janet_getindex(Janet ds, int32_t index) {
|
|||||||
switch (janet_type(ds)) {
|
switch (janet_type(ds)) {
|
||||||
default:
|
default:
|
||||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
||||||
value = janet_wrap_nil();
|
|
||||||
break;
|
break;
|
||||||
case JANET_STRING:
|
case JANET_STRING:
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
@@ -278,14 +268,12 @@ Janet janet_getindex(Janet ds, int32_t index) {
|
|||||||
case JANET_STRUCT:
|
case JANET_STRUCT:
|
||||||
value = janet_struct_get(janet_unwrap_struct(ds), janet_wrap_integer(index));
|
value = janet_struct_get(janet_unwrap_struct(ds), janet_wrap_integer(index));
|
||||||
break;
|
break;
|
||||||
case JANET_ABSTRACT:
|
case JANET_ABSTRACT: {
|
||||||
{
|
|
||||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
||||||
if (type->get) {
|
if (type->get) {
|
||||||
value = (type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index));
|
value = (type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index));
|
||||||
} else {
|
} else {
|
||||||
janet_panicf("no getter for %T ", JANET_TFLAG_LENGTHABLE, ds);
|
janet_panicf("no getter for %v ", ds);
|
||||||
value = janet_wrap_nil();
|
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -297,7 +285,6 @@ int32_t janet_length(Janet x) {
|
|||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
default:
|
default:
|
||||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x);
|
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x);
|
||||||
return 0;
|
|
||||||
case JANET_STRING:
|
case JANET_STRING:
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
case JANET_KEYWORD:
|
case JANET_KEYWORD:
|
||||||
@@ -320,9 +307,7 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
|
|||||||
default:
|
default:
|
||||||
janet_panicf("expected %T, got %v",
|
janet_panicf("expected %T, got %v",
|
||||||
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||||
break;
|
case JANET_ARRAY: {
|
||||||
case JANET_ARRAY:
|
|
||||||
{
|
|
||||||
JanetArray *array = janet_unwrap_array(ds);
|
JanetArray *array = janet_unwrap_array(ds);
|
||||||
if (index >= array->count) {
|
if (index >= array->count) {
|
||||||
janet_array_ensure(array, index + 1, 2);
|
janet_array_ensure(array, index + 1, 2);
|
||||||
@@ -331,8 +316,7 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
|
|||||||
array->data[index] = value;
|
array->data[index] = value;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_BUFFER:
|
case JANET_BUFFER: {
|
||||||
{
|
|
||||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||||
if (!janet_checkint(value))
|
if (!janet_checkint(value))
|
||||||
janet_panicf("can only put integers in buffers, got %v", value);
|
janet_panicf("can only put integers in buffers, got %v", value);
|
||||||
@@ -343,19 +327,17 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
|
|||||||
buffer->data[index] = janet_unwrap_integer(value);
|
buffer->data[index] = janet_unwrap_integer(value);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_TABLE:
|
case JANET_TABLE: {
|
||||||
{
|
|
||||||
JanetTable *table = janet_unwrap_table(ds);
|
JanetTable *table = janet_unwrap_table(ds);
|
||||||
janet_table_put(table, janet_wrap_integer(index), value);
|
janet_table_put(table, janet_wrap_integer(index), value);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_ABSTRACT:
|
case JANET_ABSTRACT: {
|
||||||
{
|
|
||||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
||||||
if (type->put) {
|
if (type->put) {
|
||||||
(type->put)(janet_unwrap_abstract(ds), janet_wrap_integer(index), value);
|
(type->put)(janet_unwrap_abstract(ds), janet_wrap_integer(index), value);
|
||||||
} else {
|
} else {
|
||||||
janet_panicf("no setter for %T ", JANET_TFLAG_LENGTHABLE, ds);
|
janet_panicf("no setter for %v ", ds);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -367,9 +349,7 @@ void janet_put(Janet ds, Janet key, Janet value) {
|
|||||||
default:
|
default:
|
||||||
janet_panicf("expected %T, got %v",
|
janet_panicf("expected %T, got %v",
|
||||||
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||||
break;
|
case JANET_ARRAY: {
|
||||||
case JANET_ARRAY:
|
|
||||||
{
|
|
||||||
int32_t index;
|
int32_t index;
|
||||||
JanetArray *array = janet_unwrap_array(ds);
|
JanetArray *array = janet_unwrap_array(ds);
|
||||||
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
|
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
|
||||||
@@ -381,8 +361,7 @@ void janet_put(Janet ds, Janet key, Janet value) {
|
|||||||
array->data[index] = value;
|
array->data[index] = value;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_BUFFER:
|
case JANET_BUFFER: {
|
||||||
{
|
|
||||||
int32_t index;
|
int32_t index;
|
||||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||||
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
|
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
|
||||||
@@ -399,16 +378,14 @@ void janet_put(Janet ds, Janet key, Janet value) {
|
|||||||
case JANET_TABLE:
|
case JANET_TABLE:
|
||||||
janet_table_put(janet_unwrap_table(ds), key, value);
|
janet_table_put(janet_unwrap_table(ds), key, value);
|
||||||
break;
|
break;
|
||||||
case JANET_ABSTRACT:
|
case JANET_ABSTRACT: {
|
||||||
{
|
|
||||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
||||||
if (type->put) {
|
if (type->put) {
|
||||||
(type->put)(janet_unwrap_abstract(ds), key, value);
|
(type->put)(janet_unwrap_abstract(ds), key, value);
|
||||||
} else {
|
} else {
|
||||||
janet_panicf("no setter for %T ", JANET_TFLAG_LENGTHABLE, ds);
|
janet_panicf("no setter for %v ", ds);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -22,6 +22,7 @@
|
|||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Grow the buffer dynamically. Used for push operations. */
|
/* Grow the buffer dynamically. Used for push operations. */
|
||||||
@@ -29,17 +30,10 @@ void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
|
|||||||
int32_t dbl_cur = (NULL != v) ? 2 * janet_v__cap(v) : 0;
|
int32_t dbl_cur = (NULL != v) ? 2 * janet_v__cap(v) : 0;
|
||||||
int32_t min_needed = janet_v_count(v) + increment;
|
int32_t min_needed = janet_v_count(v) + increment;
|
||||||
int32_t m = dbl_cur > min_needed ? dbl_cur : min_needed;
|
int32_t m = dbl_cur > min_needed ? dbl_cur : min_needed;
|
||||||
int32_t *p = (int32_t *) realloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t)*2);
|
int32_t *p = (int32_t *) janet_srealloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t) * 2);
|
||||||
if (NULL != p) {
|
|
||||||
if (!v) p[1] = 0;
|
if (!v) p[1] = 0;
|
||||||
p[0] = m;
|
p[0] = m;
|
||||||
return p + 2;
|
return p + 2;
|
||||||
} else {
|
|
||||||
{
|
|
||||||
JANET_OUT_OF_MEMORY;
|
|
||||||
}
|
|
||||||
return (void *) (2 * sizeof(int32_t));
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Convert a buffer to normal allocated memory (forget capacity) */
|
/* Convert a buffer to normal allocated memory (forget capacity) */
|
||||||
|
|||||||
@@ -24,7 +24,7 @@
|
|||||||
#define JANET_VECTOR_H_defined
|
#define JANET_VECTOR_H_defined
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/*
|
/*
|
||||||
@@ -33,16 +33,15 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
/* This is mainly used code such as the assembler or compiler, which
|
/* This is mainly used code such as the assembler or compiler, which
|
||||||
* need vector like data structures that are not garbage collected
|
* need vector like data structures that are only garbage collected in case
|
||||||
* and used only from C */
|
* of an error, and normally rely on malloc/free. */
|
||||||
|
|
||||||
#define janet_v_free(v) (((v) != NULL) ? (free(janet_v__raw(v)), 0) : 0)
|
#define janet_v_free(v) (((v) != NULL) ? (janet_sfree(janet_v__raw(v)), 0) : 0)
|
||||||
#define janet_v_push(v, x) (janet_v__maybegrow(v, 1), (v)[janet_v__cnt(v)++] = (x))
|
#define janet_v_push(v, x) (janet_v__maybegrow(v, 1), (v)[janet_v__cnt(v)++] = (x))
|
||||||
#define janet_v_pop(v) (janet_v_count(v) ? janet_v__cnt(v)-- : 0)
|
#define janet_v_pop(v) (janet_v_count(v) ? janet_v__cnt(v)-- : 0)
|
||||||
#define janet_v_count(v) (((v) != NULL) ? janet_v__cnt(v) : 0)
|
#define janet_v_count(v) (((v) != NULL) ? janet_v__cnt(v) : 0)
|
||||||
#define janet_v_last(v) ((v)[janet_v__cnt(v) - 1])
|
#define janet_v_last(v) ((v)[janet_v__cnt(v) - 1])
|
||||||
#define janet_v_empty(v) (((v) != NULL) ? (janet_v__cnt(v) = 0) : 0)
|
#define janet_v_empty(v) (((v) != NULL) ? (janet_v__cnt(v) = 0) : 0)
|
||||||
#define janet_v_copy(v) (janet_v_copymem((v), sizeof(*(v))))
|
|
||||||
#define janet_v_flatten(v) (janet_v_flattenmem((v), sizeof(*(v))))
|
#define janet_v_flatten(v) (janet_v_flattenmem((v), sizeof(*(v))))
|
||||||
|
|
||||||
#define janet_v__raw(v) ((int32_t *)(v) - 2)
|
#define janet_v__raw(v) ((int32_t *)(v) - 2)
|
||||||
@@ -55,7 +54,6 @@
|
|||||||
|
|
||||||
/* Actual functions defined in vector.c */
|
/* Actual functions defined in vector.c */
|
||||||
void *janet_v_grow(void *v, int32_t increment, int32_t itemsize);
|
void *janet_v_grow(void *v, int32_t increment, int32_t itemsize);
|
||||||
void *janet_v_copymem(void *v, int32_t itemsize);
|
|
||||||
void *janet_v_flattenmem(void *v, int32_t itemsize);
|
void *janet_v_flattenmem(void *v, int32_t itemsize);
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
269
src/core/vm.c
269
src/core/vm.c
@@ -21,7 +21,7 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "fiber.h"
|
#include "fiber.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
@@ -57,82 +57,13 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
|||||||
/* How we dispatch instructions. By default, we use
|
/* How we dispatch instructions. By default, we use
|
||||||
* a switch inside an infinite loop. For GCC/clang, we use
|
* a switch inside an infinite loop. For GCC/clang, we use
|
||||||
* computed gotos. */
|
* computed gotos. */
|
||||||
#ifdef ____GNUC__
|
#ifdef __GNUC__
|
||||||
#define VM_START() { goto *op_lookup[first_opcode];
|
#define VM_START() { goto *op_lookup[first_opcode];
|
||||||
#define VM_END() }
|
#define VM_END() }
|
||||||
#define VM_OP(op) label_##op :
|
#define VM_OP(op) label_##op :
|
||||||
#define VM_DEFAULT() label_unknown_op:
|
#define VM_DEFAULT() label_unknown_op:
|
||||||
#define vm_next() goto *op_lookup[*pc & 0xFF]
|
#define vm_next() goto *op_lookup[*pc & 0xFF]
|
||||||
static void *op_lookup[255] = {
|
#define opcode (*pc & 0xFF)
|
||||||
&&label_JOP_NOOP,
|
|
||||||
&&label_JOP_ERROR,
|
|
||||||
&&label_JOP_TYPECHECK,
|
|
||||||
&&label_JOP_RETURN,
|
|
||||||
&&label_JOP_RETURN_NIL,
|
|
||||||
&&label_JOP_ADD_IMMEDIATE,
|
|
||||||
&&label_JOP_ADD,
|
|
||||||
&&label_JOP_SUBTRACT,
|
|
||||||
&&label_JOP_MULTIPLY_IMMEDIATE,
|
|
||||||
&&label_JOP_MULTIPLY,
|
|
||||||
&&label_JOP_DIVIDE_IMMEDIATE,
|
|
||||||
&&label_JOP_DIVIDE,
|
|
||||||
&&label_JOP_BAND,
|
|
||||||
&&label_JOP_BOR,
|
|
||||||
&&label_JOP_BXOR,
|
|
||||||
&&label_JOP_BNOT,
|
|
||||||
&&label_JOP_SHIFT_LEFT,
|
|
||||||
&&label_JOP_SHIFT_LEFT_IMMEDIATE,
|
|
||||||
&&label_JOP_SHIFT_RIGHT,
|
|
||||||
&&label_JOP_SHIFT_RIGHT_IMMEDIATE,
|
|
||||||
&&label_JOP_SHIFT_RIGHT_UNSIGNED,
|
|
||||||
&&label_JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE,
|
|
||||||
&&label_JOP_MOVE_FAR,
|
|
||||||
&&label_JOP_MOVE_NEAR,
|
|
||||||
&&label_JOP_JUMP,
|
|
||||||
&&label_JOP_JUMP_IF,
|
|
||||||
&&label_JOP_JUMP_IF_NOT,
|
|
||||||
&&label_JOP_GREATER_THAN,
|
|
||||||
&&label_JOP_GREATER_THAN_IMMEDIATE,
|
|
||||||
&&label_JOP_LESS_THAN,
|
|
||||||
&&label_JOP_LESS_THAN_IMMEDIATE,
|
|
||||||
&&label_JOP_EQUALS,
|
|
||||||
&&label_JOP_EQUALS_IMMEDIATE,
|
|
||||||
&&label_JOP_COMPARE,
|
|
||||||
&&label_JOP_LOAD_NIL,
|
|
||||||
&&label_JOP_LOAD_TRUE,
|
|
||||||
&&label_JOP_LOAD_FALSE,
|
|
||||||
&&label_JOP_LOAD_INTEGER,
|
|
||||||
&&label_JOP_LOAD_CONSTANT,
|
|
||||||
&&label_JOP_LOAD_UPVALUE,
|
|
||||||
&&label_JOP_LOAD_SELF,
|
|
||||||
&&label_JOP_SET_UPVALUE,
|
|
||||||
&&label_JOP_CLOSURE,
|
|
||||||
&&label_JOP_PUSH,
|
|
||||||
&&label_JOP_PUSH_2,
|
|
||||||
&&label_JOP_PUSH_3,
|
|
||||||
&&label_JOP_PUSH_ARRAY,
|
|
||||||
&&label_JOP_CALL,
|
|
||||||
&&label_JOP_TAILCALL,
|
|
||||||
&&label_JOP_RESUME,
|
|
||||||
&&label_JOP_SIGNAL,
|
|
||||||
&&label_JOP_GET,
|
|
||||||
&&label_JOP_PUT,
|
|
||||||
&&label_JOP_GET_INDEX,
|
|
||||||
&&label_JOP_PUT_INDEX,
|
|
||||||
&&label_JOP_LENGTH,
|
|
||||||
&&label_JOP_MAKE_ARRAY,
|
|
||||||
&&label_JOP_MAKE_BUFFER,
|
|
||||||
&&label_JOP_MAKE_STRING,
|
|
||||||
&&label_JOP_MAKE_STRUCT,
|
|
||||||
&&label_JOP_MAKE_TABLE,
|
|
||||||
&&label_JOP_MAKE_TUPLE,
|
|
||||||
&&label_JOP_NUMERIC_LESS_THAN,
|
|
||||||
&&label_JOP_NUMERIC_LESS_THAN_EQUAL,
|
|
||||||
&&label_JOP_NUMERIC_GREATER_THAN,
|
|
||||||
&&label_JOP_NUMERIC_GREATER_THAN_EQUAL,
|
|
||||||
&&label_JOP_NUMERIC_EQUAL,
|
|
||||||
&&label_unknown_op
|
|
||||||
};
|
|
||||||
#else
|
#else
|
||||||
#define VM_START() uint8_t opcode = first_opcode; for (;;) {switch(opcode) {
|
#define VM_START() uint8_t opcode = first_opcode; for (;;) {switch(opcode) {
|
||||||
#define VM_END() }}
|
#define VM_END() }}
|
||||||
@@ -223,6 +154,23 @@ static void *op_lookup[255] = {
|
|||||||
#define vm_bitop(op) _vm_bitop(op, int32_t)
|
#define vm_bitop(op) _vm_bitop(op, int32_t)
|
||||||
#define vm_bitopu(op) _vm_bitop(op, uint32_t)
|
#define vm_bitopu(op) _vm_bitop(op, uint32_t)
|
||||||
|
|
||||||
|
/* 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;
|
||||||
|
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]);
|
||||||
|
}
|
||||||
|
printf(")\n");
|
||||||
|
}
|
||||||
|
|
||||||
/* Call a non function type */
|
/* Call a non function type */
|
||||||
static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
||||||
int32_t argn = fiber->stacktop - fiber->stackstart;
|
int32_t argn = fiber->stacktop - fiber->stackstart;
|
||||||
@@ -243,6 +191,82 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
|||||||
/* Interpreter main loop */
|
/* Interpreter main loop */
|
||||||
static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status) {
|
static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status) {
|
||||||
|
|
||||||
|
/* opcode -> label lookup if using clang/GCC */
|
||||||
|
#ifdef __GNUC__
|
||||||
|
static void *op_lookup[255] = {
|
||||||
|
&&label_JOP_NOOP,
|
||||||
|
&&label_JOP_ERROR,
|
||||||
|
&&label_JOP_TYPECHECK,
|
||||||
|
&&label_JOP_RETURN,
|
||||||
|
&&label_JOP_RETURN_NIL,
|
||||||
|
&&label_JOP_ADD_IMMEDIATE,
|
||||||
|
&&label_JOP_ADD,
|
||||||
|
&&label_JOP_SUBTRACT,
|
||||||
|
&&label_JOP_MULTIPLY_IMMEDIATE,
|
||||||
|
&&label_JOP_MULTIPLY,
|
||||||
|
&&label_JOP_DIVIDE_IMMEDIATE,
|
||||||
|
&&label_JOP_DIVIDE,
|
||||||
|
&&label_JOP_BAND,
|
||||||
|
&&label_JOP_BOR,
|
||||||
|
&&label_JOP_BXOR,
|
||||||
|
&&label_JOP_BNOT,
|
||||||
|
&&label_JOP_SHIFT_LEFT,
|
||||||
|
&&label_JOP_SHIFT_LEFT_IMMEDIATE,
|
||||||
|
&&label_JOP_SHIFT_RIGHT,
|
||||||
|
&&label_JOP_SHIFT_RIGHT_IMMEDIATE,
|
||||||
|
&&label_JOP_SHIFT_RIGHT_UNSIGNED,
|
||||||
|
&&label_JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE,
|
||||||
|
&&label_JOP_MOVE_FAR,
|
||||||
|
&&label_JOP_MOVE_NEAR,
|
||||||
|
&&label_JOP_JUMP,
|
||||||
|
&&label_JOP_JUMP_IF,
|
||||||
|
&&label_JOP_JUMP_IF_NOT,
|
||||||
|
&&label_JOP_GREATER_THAN,
|
||||||
|
&&label_JOP_GREATER_THAN_IMMEDIATE,
|
||||||
|
&&label_JOP_LESS_THAN,
|
||||||
|
&&label_JOP_LESS_THAN_IMMEDIATE,
|
||||||
|
&&label_JOP_EQUALS,
|
||||||
|
&&label_JOP_EQUALS_IMMEDIATE,
|
||||||
|
&&label_JOP_COMPARE,
|
||||||
|
&&label_JOP_LOAD_NIL,
|
||||||
|
&&label_JOP_LOAD_TRUE,
|
||||||
|
&&label_JOP_LOAD_FALSE,
|
||||||
|
&&label_JOP_LOAD_INTEGER,
|
||||||
|
&&label_JOP_LOAD_CONSTANT,
|
||||||
|
&&label_JOP_LOAD_UPVALUE,
|
||||||
|
&&label_JOP_LOAD_SELF,
|
||||||
|
&&label_JOP_SET_UPVALUE,
|
||||||
|
&&label_JOP_CLOSURE,
|
||||||
|
&&label_JOP_PUSH,
|
||||||
|
&&label_JOP_PUSH_2,
|
||||||
|
&&label_JOP_PUSH_3,
|
||||||
|
&&label_JOP_PUSH_ARRAY,
|
||||||
|
&&label_JOP_CALL,
|
||||||
|
&&label_JOP_TAILCALL,
|
||||||
|
&&label_JOP_RESUME,
|
||||||
|
&&label_JOP_SIGNAL,
|
||||||
|
&&label_JOP_PROPAGATE,
|
||||||
|
&&label_JOP_GET,
|
||||||
|
&&label_JOP_PUT,
|
||||||
|
&&label_JOP_GET_INDEX,
|
||||||
|
&&label_JOP_PUT_INDEX,
|
||||||
|
&&label_JOP_LENGTH,
|
||||||
|
&&label_JOP_MAKE_ARRAY,
|
||||||
|
&&label_JOP_MAKE_BUFFER,
|
||||||
|
&&label_JOP_MAKE_STRING,
|
||||||
|
&&label_JOP_MAKE_STRUCT,
|
||||||
|
&&label_JOP_MAKE_TABLE,
|
||||||
|
&&label_JOP_MAKE_TUPLE,
|
||||||
|
&&label_JOP_MAKE_BRACKET_TUPLE,
|
||||||
|
&&label_JOP_NUMERIC_LESS_THAN,
|
||||||
|
&&label_JOP_NUMERIC_LESS_THAN_EQUAL,
|
||||||
|
&&label_JOP_NUMERIC_GREATER_THAN,
|
||||||
|
&&label_JOP_NUMERIC_GREATER_THAN_EQUAL,
|
||||||
|
&&label_JOP_NUMERIC_EQUAL,
|
||||||
|
&&label_unknown_op
|
||||||
|
};
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Interpreter state */
|
/* Interpreter state */
|
||||||
register Janet *stack;
|
register Janet *stack;
|
||||||
register uint32_t *pc;
|
register uint32_t *pc;
|
||||||
@@ -254,7 +278,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
* DO NOT use input when resuming a fiber that has been interrupted at a
|
* DO NOT use input when resuming a fiber that has been interrupted at a
|
||||||
* breakpoint. */
|
* breakpoint. */
|
||||||
if (status != JANET_STATUS_NEW &&
|
if (status != JANET_STATUS_NEW &&
|
||||||
((*pc & 0xFF) == JOP_SIGNAL || (*pc & 0xFF) == JOP_RESUME)) {
|
((*pc & 0xFF) == JOP_SIGNAL ||
|
||||||
|
(*pc & 0xFF) == JOP_PROPAGATE ||
|
||||||
|
(*pc & 0xFF) == JOP_RESUME)) {
|
||||||
stack[A] = in;
|
stack[A] = in;
|
||||||
pc++;
|
pc++;
|
||||||
}
|
}
|
||||||
@@ -283,8 +309,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
vm_assert_types(stack[A], E);
|
vm_assert_types(stack[A], E);
|
||||||
vm_pcnext();
|
vm_pcnext();
|
||||||
|
|
||||||
VM_OP(JOP_RETURN)
|
VM_OP(JOP_RETURN) {
|
||||||
{
|
|
||||||
Janet retval = stack[D];
|
Janet retval = stack[D];
|
||||||
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
|
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
|
||||||
janet_fiber_popframe(fiber);
|
janet_fiber_popframe(fiber);
|
||||||
@@ -294,8 +319,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_RETURN_NIL)
|
VM_OP(JOP_RETURN_NIL) {
|
||||||
{
|
|
||||||
Janet retval = janet_wrap_nil();
|
Janet retval = janet_wrap_nil();
|
||||||
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
|
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
|
||||||
janet_fiber_popframe(fiber);
|
janet_fiber_popframe(fiber);
|
||||||
@@ -350,8 +374,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
VM_OP(JOP_BXOR)
|
VM_OP(JOP_BXOR)
|
||||||
vm_bitop(^);
|
vm_bitop(^);
|
||||||
|
|
||||||
VM_OP(JOP_BNOT)
|
VM_OP(JOP_BNOT) {
|
||||||
{
|
|
||||||
Janet op = stack[E];
|
Janet op = stack[E];
|
||||||
vm_assert_type(op, JANET_NUMBER);
|
vm_assert_type(op, JANET_NUMBER);
|
||||||
stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
|
stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
|
||||||
@@ -448,8 +471,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
stack[A] = janet_wrap_integer(ES);
|
stack[A] = janet_wrap_integer(ES);
|
||||||
vm_pcnext();
|
vm_pcnext();
|
||||||
|
|
||||||
VM_OP(JOP_LOAD_CONSTANT)
|
VM_OP(JOP_LOAD_CONSTANT) {
|
||||||
{
|
|
||||||
int32_t cindex = (int32_t)E;
|
int32_t cindex = (int32_t)E;
|
||||||
vm_assert(cindex < func->def->constants_length, "invalid constant");
|
vm_assert(cindex < func->def->constants_length, "invalid constant");
|
||||||
stack[A] = func->def->constants[cindex];
|
stack[A] = func->def->constants[cindex];
|
||||||
@@ -460,8 +482,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
stack[D] = janet_wrap_function(func);
|
stack[D] = janet_wrap_function(func);
|
||||||
vm_pcnext();
|
vm_pcnext();
|
||||||
|
|
||||||
VM_OP(JOP_LOAD_UPVALUE)
|
VM_OP(JOP_LOAD_UPVALUE) {
|
||||||
{
|
|
||||||
int32_t eindex = B;
|
int32_t eindex = B;
|
||||||
int32_t vindex = C;
|
int32_t vindex = C;
|
||||||
JanetFuncEnv *env;
|
JanetFuncEnv *env;
|
||||||
@@ -478,8 +499,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
vm_pcnext();
|
vm_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_SET_UPVALUE)
|
VM_OP(JOP_SET_UPVALUE) {
|
||||||
{
|
|
||||||
int32_t eindex = B;
|
int32_t eindex = B;
|
||||||
int32_t vindex = C;
|
int32_t vindex = C;
|
||||||
JanetFuncEnv *env;
|
JanetFuncEnv *env;
|
||||||
@@ -494,8 +514,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
vm_pcnext();
|
vm_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_CLOSURE)
|
VM_OP(JOP_CLOSURE) {
|
||||||
{
|
|
||||||
JanetFuncDef *fd;
|
JanetFuncDef *fd;
|
||||||
JanetFunction *fn;
|
JanetFunction *fn;
|
||||||
int32_t elen;
|
int32_t elen;
|
||||||
@@ -544,8 +563,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
stack = fiber->data + fiber->frame;
|
stack = fiber->data + fiber->frame;
|
||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
|
|
||||||
VM_OP(JOP_PUSH_ARRAY)
|
VM_OP(JOP_PUSH_ARRAY) {
|
||||||
{
|
|
||||||
const Janet *vals;
|
const Janet *vals;
|
||||||
int32_t len;
|
int32_t len;
|
||||||
if (janet_indexed_view(stack[D], &vals, &len)) {
|
if (janet_indexed_view(stack[D], &vals, &len)) {
|
||||||
@@ -557,8 +575,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
stack = fiber->data + fiber->frame;
|
stack = fiber->data + fiber->frame;
|
||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
|
|
||||||
VM_OP(JOP_CALL)
|
VM_OP(JOP_CALL) {
|
||||||
{
|
|
||||||
Janet callee = stack[E];
|
Janet callee = stack[E];
|
||||||
if (fiber->stacktop > fiber->maxstack) {
|
if (fiber->stacktop > fiber->maxstack) {
|
||||||
vm_throw("stack overflow");
|
vm_throw("stack overflow");
|
||||||
@@ -571,6 +588,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
}
|
}
|
||||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||||
func = janet_unwrap_function(callee);
|
func = janet_unwrap_function(callee);
|
||||||
|
if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
|
||||||
janet_stack_frame(stack)->pc = pc;
|
janet_stack_frame(stack)->pc = pc;
|
||||||
if (janet_fiber_funcframe(fiber, func)) {
|
if (janet_fiber_funcframe(fiber, func)) {
|
||||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||||
@@ -586,7 +604,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
janet_fiber_cframe(fiber, janet_unwrap_cfunction(callee));
|
janet_fiber_cframe(fiber, janet_unwrap_cfunction(callee));
|
||||||
Janet ret = janet_unwrap_cfunction(callee)(argc, fiber->data + fiber->frame);
|
Janet ret = janet_unwrap_cfunction(callee)(argc, fiber->data + fiber->frame);
|
||||||
janet_fiber_popframe(fiber);
|
janet_fiber_popframe(fiber);
|
||||||
/*if (fiber->frame == 0) vm_return(JANET_SIGNAL_OK, ret);*/
|
|
||||||
stack = fiber->data + fiber->frame;
|
stack = fiber->data + fiber->frame;
|
||||||
stack[A] = ret;
|
stack[A] = ret;
|
||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
@@ -597,8 +614,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_TAILCALL)
|
VM_OP(JOP_TAILCALL) {
|
||||||
{
|
|
||||||
Janet callee = stack[D];
|
Janet callee = stack[D];
|
||||||
if (janet_checktype(callee, JANET_KEYWORD)) {
|
if (janet_checktype(callee, JANET_KEYWORD)) {
|
||||||
vm_commit();
|
vm_commit();
|
||||||
@@ -608,6 +624,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
}
|
}
|
||||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||||
func = janet_unwrap_function(callee);
|
func = janet_unwrap_function(callee);
|
||||||
|
if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
|
||||||
if (janet_fiber_funcframe_tail(fiber, func)) {
|
if (janet_fiber_funcframe_tail(fiber, func)) {
|
||||||
janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
|
janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
|
||||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||||
@@ -638,8 +655,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_RESUME)
|
VM_OP(JOP_RESUME) {
|
||||||
{
|
|
||||||
Janet retreg;
|
Janet retreg;
|
||||||
vm_assert_type(stack[B], JANET_FIBER);
|
vm_assert_type(stack[B], JANET_FIBER);
|
||||||
JanetFiber *child = janet_unwrap_fiber(stack[B]);
|
JanetFiber *child = janet_unwrap_fiber(stack[B]);
|
||||||
@@ -648,18 +664,30 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig)))
|
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig)))
|
||||||
vm_return(sig, retreg);
|
vm_return(sig, retreg);
|
||||||
fiber->child = NULL;
|
fiber->child = NULL;
|
||||||
|
stack = fiber->data + fiber->frame;
|
||||||
stack[A] = retreg;
|
stack[A] = retreg;
|
||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_SIGNAL)
|
VM_OP(JOP_SIGNAL) {
|
||||||
{
|
|
||||||
int32_t s = C;
|
int32_t s = C;
|
||||||
if (s > JANET_SIGNAL_USER9) s = JANET_SIGNAL_USER9;
|
if (s > JANET_SIGNAL_USER9) s = JANET_SIGNAL_USER9;
|
||||||
if (s < 0) s = 0;
|
if (s < 0) s = 0;
|
||||||
vm_return(s, stack[B]);
|
vm_return(s, stack[B]);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
VM_OP(JOP_PROPAGATE) {
|
||||||
|
Janet fv = stack[C];
|
||||||
|
vm_assert_type(fv, JANET_FIBER);
|
||||||
|
JanetFiber *f = janet_unwrap_fiber(fv);
|
||||||
|
JanetFiberStatus status = janet_fiber_status(f);
|
||||||
|
if (status > JANET_STATUS_USER9) {
|
||||||
|
vm_throw("cannot propagate from new or alive fiber");
|
||||||
|
}
|
||||||
|
janet_vm_fiber->child = f;
|
||||||
|
vm_return((int) status, stack[B]);
|
||||||
|
}
|
||||||
|
|
||||||
VM_OP(JOP_PUT)
|
VM_OP(JOP_PUT)
|
||||||
vm_commit();
|
vm_commit();
|
||||||
janet_put(stack[A], stack[B], stack[C]);
|
janet_put(stack[A], stack[B], stack[C]);
|
||||||
@@ -685,8 +713,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
stack[A] = janet_wrap_integer(janet_length(stack[E]));
|
stack[A] = janet_wrap_integer(janet_length(stack[E]));
|
||||||
vm_pcnext();
|
vm_pcnext();
|
||||||
|
|
||||||
VM_OP(JOP_MAKE_ARRAY)
|
VM_OP(JOP_MAKE_ARRAY) {
|
||||||
{
|
|
||||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||||
Janet *mem = fiber->data + fiber->stackstart;
|
Janet *mem = fiber->data + fiber->stackstart;
|
||||||
stack[D] = janet_wrap_array(janet_array_n(mem, count));
|
stack[D] = janet_wrap_array(janet_array_n(mem, count));
|
||||||
@@ -695,16 +722,19 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_MAKE_TUPLE)
|
VM_OP(JOP_MAKE_TUPLE)
|
||||||
{
|
/* fallthrough */
|
||||||
|
VM_OP(JOP_MAKE_BRACKET_TUPLE) {
|
||||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||||
Janet *mem = fiber->data + fiber->stackstart;
|
Janet *mem = fiber->data + fiber->stackstart;
|
||||||
stack[D] = janet_wrap_tuple(janet_tuple_n(mem, count));
|
const Janet *tup = janet_tuple_n(mem, count);
|
||||||
|
if (opcode == JOP_MAKE_BRACKET_TUPLE)
|
||||||
|
janet_tuple_flag(tup) |= JANET_TUPLE_FLAG_BRACKETCTOR;
|
||||||
|
stack[D] = janet_wrap_tuple(tup);
|
||||||
fiber->stacktop = fiber->stackstart;
|
fiber->stacktop = fiber->stackstart;
|
||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_MAKE_TABLE)
|
VM_OP(JOP_MAKE_TABLE) {
|
||||||
{
|
|
||||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||||
Janet *mem = fiber->data + fiber->stackstart;
|
Janet *mem = fiber->data + fiber->stackstart;
|
||||||
if (count & 1)
|
if (count & 1)
|
||||||
@@ -717,8 +747,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_MAKE_STRUCT)
|
VM_OP(JOP_MAKE_STRUCT) {
|
||||||
{
|
|
||||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||||
Janet *mem = fiber->data + fiber->stackstart;
|
Janet *mem = fiber->data + fiber->stackstart;
|
||||||
if (count & 1)
|
if (count & 1)
|
||||||
@@ -731,8 +760,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_MAKE_STRING)
|
VM_OP(JOP_MAKE_STRING) {
|
||||||
{
|
|
||||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||||
Janet *mem = fiber->data + fiber->stackstart;
|
Janet *mem = fiber->data + fiber->stackstart;
|
||||||
JanetBuffer buffer;
|
JanetBuffer buffer;
|
||||||
@@ -745,8 +773,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_MAKE_BUFFER)
|
VM_OP(JOP_MAKE_BUFFER) {
|
||||||
{
|
|
||||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||||
Janet *mem = fiber->data + fiber->stackstart;
|
Janet *mem = fiber->data + fiber->stackstart;
|
||||||
JanetBuffer *buffer = janet_buffer(10 * count);
|
JanetBuffer *buffer = janet_buffer(10 * count);
|
||||||
@@ -761,9 +788,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
}
|
}
|
||||||
|
|
||||||
Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||||
Janet ret;
|
|
||||||
Janet *old_return_reg = janet_vm_return_reg;
|
|
||||||
|
|
||||||
/* Check entry conditions */
|
/* Check entry conditions */
|
||||||
if (!janet_vm_fiber)
|
if (!janet_vm_fiber)
|
||||||
janet_panic("janet_call failed because there is no current fiber");
|
janet_panic("janet_call failed because there is no current fiber");
|
||||||
@@ -773,14 +797,13 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
|||||||
/* Push frame */
|
/* Push frame */
|
||||||
janet_fiber_pushn(janet_vm_fiber, argv, argc);
|
janet_fiber_pushn(janet_vm_fiber, argv, argc);
|
||||||
if (janet_fiber_funcframe(janet_vm_fiber, fun)) {
|
if (janet_fiber_funcframe(janet_vm_fiber, fun)) {
|
||||||
janet_panicf("arity mismatch in %v", fun);
|
janet_panicf("arity mismatch in %v", janet_wrap_function(fun));
|
||||||
}
|
}
|
||||||
janet_fiber_frame(janet_vm_fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
janet_fiber_frame(janet_vm_fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||||
|
|
||||||
/* Set up */
|
/* Set up */
|
||||||
int32_t oldn = janet_vm_stackn++;
|
int32_t oldn = janet_vm_stackn++;
|
||||||
int handle = janet_gclock();
|
int handle = janet_gclock();
|
||||||
janet_vm_return_reg = &ret;
|
|
||||||
|
|
||||||
/* Run vm */
|
/* Run vm */
|
||||||
JanetSignal signal = run_vm(janet_vm_fiber,
|
JanetSignal signal = run_vm(janet_vm_fiber,
|
||||||
@@ -788,13 +811,12 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
|||||||
JANET_STATUS_ALIVE);
|
JANET_STATUS_ALIVE);
|
||||||
|
|
||||||
/* Teardown */
|
/* Teardown */
|
||||||
janet_vm_return_reg = old_return_reg;
|
|
||||||
janet_vm_stackn = oldn;
|
janet_vm_stackn = oldn;
|
||||||
janet_gcunlock(handle);
|
janet_gcunlock(handle);
|
||||||
|
|
||||||
if (signal != JANET_SIGNAL_OK) janet_panicv(ret);
|
if (signal != JANET_SIGNAL_OK) janet_panicv(*janet_vm_return_reg);
|
||||||
|
|
||||||
return ret;
|
return *janet_vm_return_reg;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Enter the main vm loop */
|
/* Enter the main vm loop */
|
||||||
@@ -870,7 +892,12 @@ JanetSignal janet_pcall(
|
|||||||
const Janet *argv,
|
const Janet *argv,
|
||||||
Janet *out,
|
Janet *out,
|
||||||
JanetFiber **f) {
|
JanetFiber **f) {
|
||||||
JanetFiber *fiber = janet_fiber(fun, 64, argc, argv);
|
JanetFiber *fiber;
|
||||||
|
if (f && *f) {
|
||||||
|
fiber = janet_fiber_reset(*f, fun, argc, argv);
|
||||||
|
} else {
|
||||||
|
fiber = janet_fiber(fun, 64, argc, argv);
|
||||||
|
}
|
||||||
if (f) *f = fiber;
|
if (f) *f = fiber;
|
||||||
if (!fiber) {
|
if (!fiber) {
|
||||||
*out = janet_cstringv("arity mismatch");
|
*out = janet_cstringv("arity mismatch");
|
||||||
@@ -894,6 +921,10 @@ int janet_init(void) {
|
|||||||
janet_vm_roots = NULL;
|
janet_vm_roots = NULL;
|
||||||
janet_vm_root_count = 0;
|
janet_vm_root_count = 0;
|
||||||
janet_vm_root_capacity = 0;
|
janet_vm_root_capacity = 0;
|
||||||
|
/* Scratch memory */
|
||||||
|
janet_scratch_mem = NULL;
|
||||||
|
janet_scratch_len = 0;
|
||||||
|
janet_scratch_cap = 0;
|
||||||
/* Initialize registry */
|
/* Initialize registry */
|
||||||
janet_vm_registry = janet_table(0);
|
janet_vm_registry = janet_table(0);
|
||||||
janet_gcroot(janet_wrap_table(janet_vm_registry));
|
janet_gcroot(janet_wrap_table(janet_vm_registry));
|
||||||
|
|||||||
154
src/core/wrap.c
154
src/core/wrap.c
@@ -21,9 +21,142 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
/* Macro fills */
|
||||||
|
|
||||||
|
JanetType(janet_type)(Janet x) {
|
||||||
|
return janet_type(x);
|
||||||
|
}
|
||||||
|
int (janet_checktype)(Janet x, JanetType type) {
|
||||||
|
return janet_checktype(x, type);
|
||||||
|
}
|
||||||
|
int (janet_checktypes)(Janet x, int typeflags) {
|
||||||
|
return janet_checktypes(x, typeflags);
|
||||||
|
}
|
||||||
|
int (janet_truthy)(Janet x) {
|
||||||
|
return janet_truthy(x);
|
||||||
|
}
|
||||||
|
|
||||||
|
const JanetKV *(janet_unwrap_struct)(Janet x) {
|
||||||
|
return janet_unwrap_struct(x);
|
||||||
|
}
|
||||||
|
const Janet *(janet_unwrap_tuple)(Janet x) {
|
||||||
|
return janet_unwrap_tuple(x);
|
||||||
|
}
|
||||||
|
JanetFiber *(janet_unwrap_fiber)(Janet x) {
|
||||||
|
return janet_unwrap_fiber(x);
|
||||||
|
}
|
||||||
|
JanetArray *(janet_unwrap_array)(Janet x) {
|
||||||
|
return janet_unwrap_array(x);
|
||||||
|
}
|
||||||
|
JanetTable *(janet_unwrap_table)(Janet x) {
|
||||||
|
return janet_unwrap_table(x);
|
||||||
|
}
|
||||||
|
JanetBuffer *(janet_unwrap_buffer)(Janet x) {
|
||||||
|
return janet_unwrap_buffer(x);
|
||||||
|
}
|
||||||
|
const uint8_t *(janet_unwrap_string)(Janet x) {
|
||||||
|
return janet_unwrap_string(x);
|
||||||
|
}
|
||||||
|
const uint8_t *(janet_unwrap_symbol)(Janet x) {
|
||||||
|
return janet_unwrap_symbol(x);
|
||||||
|
}
|
||||||
|
const uint8_t *(janet_unwrap_keyword)(Janet x) {
|
||||||
|
return janet_unwrap_keyword(x);
|
||||||
|
}
|
||||||
|
void *(janet_unwrap_abstract)(Janet x) {
|
||||||
|
return janet_unwrap_abstract(x);
|
||||||
|
}
|
||||||
|
void *(janet_unwrap_pointer)(Janet x) {
|
||||||
|
return janet_unwrap_pointer(x);
|
||||||
|
}
|
||||||
|
JanetFunction *(janet_unwrap_function)(Janet x) {
|
||||||
|
return janet_unwrap_function(x);
|
||||||
|
}
|
||||||
|
JanetCFunction(janet_unwrap_cfunction)(Janet x) {
|
||||||
|
return janet_unwrap_cfunction(x);
|
||||||
|
}
|
||||||
|
int (janet_unwrap_boolean)(Janet x) {
|
||||||
|
return janet_unwrap_boolean(x);
|
||||||
|
}
|
||||||
|
int32_t (janet_unwrap_integer)(Janet x) {
|
||||||
|
return janet_unwrap_integer(x);
|
||||||
|
}
|
||||||
|
|
||||||
|
#if defined(JANET_NANBOX_32) || defined(JANET_NANBOX_64)
|
||||||
|
Janet(janet_wrap_nil)(void) {
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_true)(void) {
|
||||||
|
return janet_wrap_true();
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_false)(void) {
|
||||||
|
return janet_wrap_false();
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_boolean)(int x) {
|
||||||
|
return janet_wrap_boolean(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_string)(const uint8_t *x) {
|
||||||
|
return janet_wrap_string(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_symbol)(const uint8_t *x) {
|
||||||
|
return janet_wrap_symbol(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_keyword)(const uint8_t *x) {
|
||||||
|
return janet_wrap_keyword(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_array)(JanetArray *x) {
|
||||||
|
return janet_wrap_array(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_tuple)(const Janet *x) {
|
||||||
|
return janet_wrap_tuple(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_struct)(const JanetKV *x) {
|
||||||
|
return janet_wrap_struct(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_fiber)(JanetFiber *x) {
|
||||||
|
return janet_wrap_fiber(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_buffer)(JanetBuffer *x) {
|
||||||
|
return janet_wrap_buffer(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_function)(JanetFunction *x) {
|
||||||
|
return janet_wrap_function(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_cfunction)(JanetCFunction x) {
|
||||||
|
return janet_wrap_cfunction(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_table)(JanetTable *x) {
|
||||||
|
return janet_wrap_table(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_abstract)(void *x) {
|
||||||
|
return janet_wrap_abstract(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_pointer)(void *x) {
|
||||||
|
return janet_wrap_pointer(x);
|
||||||
|
}
|
||||||
|
Janet(janet_wrap_integer)(int32_t x) {
|
||||||
|
return janet_wrap_integer(x);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifndef JANET_NANBOX_32
|
||||||
|
double (janet_unwrap_number)(Janet x) {
|
||||||
|
return janet_unwrap_number(x);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef JANET_NANBOX_64
|
||||||
|
Janet(janet_wrap_number)(double x) {
|
||||||
|
return janet_wrap_number(x);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/*****/
|
||||||
|
|
||||||
void *janet_memalloc_empty(int32_t count) {
|
void *janet_memalloc_empty(int32_t count) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
void *mem = malloc(count * sizeof(JanetKV));
|
void *mem = malloc(count * sizeof(JanetKV));
|
||||||
@@ -110,13 +243,7 @@ double janet_unwrap_number(Janet x) {
|
|||||||
|
|
||||||
#else
|
#else
|
||||||
|
|
||||||
/* Wrapper functions wrap a data type that is used from C into a
|
Janet janet_wrap_nil(void) {
|
||||||
* janet value, which can then be used in janet internal functions. Use
|
|
||||||
* these functions sparingly, as these function will let the programmer
|
|
||||||
* leak memory, where as the stack based API ensures that all values can
|
|
||||||
* be collected by the garbage collector. */
|
|
||||||
|
|
||||||
Janet janet_wrap_nil() {
|
|
||||||
Janet y;
|
Janet y;
|
||||||
y.type = JANET_NIL;
|
y.type = JANET_NIL;
|
||||||
y.as.u64 = 0;
|
y.as.u64 = 0;
|
||||||
@@ -125,22 +252,22 @@ Janet janet_wrap_nil() {
|
|||||||
|
|
||||||
Janet janet_wrap_true(void) {
|
Janet janet_wrap_true(void) {
|
||||||
Janet y;
|
Janet y;
|
||||||
y.type = JANET_TRUE;
|
y.type = JANET_BOOLEAN;
|
||||||
y.as.u64 = 0;
|
y.as.u64 = 1;
|
||||||
return y;
|
return y;
|
||||||
}
|
}
|
||||||
|
|
||||||
Janet janet_wrap_false(void) {
|
Janet janet_wrap_false(void) {
|
||||||
Janet y;
|
Janet y;
|
||||||
y.type = JANET_FALSE;
|
y.type = JANET_BOOLEAN;
|
||||||
y.as.u64 = 0;
|
y.as.u64 = 0;
|
||||||
return y;
|
return y;
|
||||||
}
|
}
|
||||||
|
|
||||||
Janet janet_wrap_boolean(int x) {
|
Janet janet_wrap_boolean(int x) {
|
||||||
Janet y;
|
Janet y;
|
||||||
y.type = x ? JANET_TRUE : JANET_FALSE;
|
y.type = JANET_BOOLEAN;
|
||||||
y.as.u64 = 0;
|
y.as.u64 = !!x;
|
||||||
return y;
|
return y;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -166,6 +293,7 @@ JANET_WRAP_DEFINE(function, JanetFunction *, JANET_FUNCTION, pointer)
|
|||||||
JANET_WRAP_DEFINE(cfunction, JanetCFunction, JANET_CFUNCTION, pointer)
|
JANET_WRAP_DEFINE(cfunction, JanetCFunction, JANET_CFUNCTION, pointer)
|
||||||
JANET_WRAP_DEFINE(table, JanetTable *, JANET_TABLE, pointer)
|
JANET_WRAP_DEFINE(table, JanetTable *, JANET_TABLE, pointer)
|
||||||
JANET_WRAP_DEFINE(abstract, void *, JANET_ABSTRACT, pointer)
|
JANET_WRAP_DEFINE(abstract, void *, JANET_ABSTRACT, pointer)
|
||||||
|
JANET_WRAP_DEFINE(pointer, void *, JANET_POINTER, pointer)
|
||||||
|
|
||||||
#undef JANET_WRAP_DEFINE
|
#undef JANET_WRAP_DEFINE
|
||||||
|
|
||||||
|
|||||||
@@ -29,7 +29,11 @@ extern "C" {
|
|||||||
|
|
||||||
/***** START SECTION CONFIG *****/
|
/***** START SECTION CONFIG *****/
|
||||||
|
|
||||||
#define JANET_VERSION "0.4.0"
|
#include "janetconf.h"
|
||||||
|
|
||||||
|
#ifndef JANET_VERSION
|
||||||
|
#define JANET_VERSION "latest"
|
||||||
|
#endif
|
||||||
|
|
||||||
#ifndef JANET_BUILD
|
#ifndef JANET_BUILD
|
||||||
#define JANET_BUILD "local"
|
#define JANET_BUILD "local"
|
||||||
@@ -47,6 +51,7 @@ extern "C" {
|
|||||||
|| defined(__FreeBSD__) || defined(__DragonFly__) \
|
|| defined(__FreeBSD__) || defined(__DragonFly__) \
|
||||||
|| defined(__FreeBSD_kernel__) \
|
|| defined(__FreeBSD_kernel__) \
|
||||||
|| defined(__GNU__) /* GNU/Hurd */ \
|
|| defined(__GNU__) /* GNU/Hurd */ \
|
||||||
|
|| defined(__HAIKU__) \
|
||||||
|| defined(__linux__) \
|
|| defined(__linux__) \
|
||||||
|| defined(__NetBSD__) \
|
|| defined(__NetBSD__) \
|
||||||
|| defined(__OpenBSD__) \
|
|| defined(__OpenBSD__) \
|
||||||
@@ -123,6 +128,21 @@ extern "C" {
|
|||||||
#define JANET_ASSEMBLER
|
#define JANET_ASSEMBLER
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
/* Enable or disable the peg module */
|
||||||
|
#ifndef JANET_NO_PEG
|
||||||
|
#define JANET_PEG
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Enable or disable the typedarray module */
|
||||||
|
#ifndef JANET_NO_TYPED_ARRAY
|
||||||
|
#define JANET_TYPED_ARRAY
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Enable or disable large int types (for now 64 bit, maybe 128 / 256 bit integer types) */
|
||||||
|
#ifndef JANET_NO_INT_TYPES
|
||||||
|
#define JANET_INT_TYPES
|
||||||
|
#endif
|
||||||
|
|
||||||
/* How to export symbols */
|
/* How to export symbols */
|
||||||
#ifndef JANET_API
|
#ifndef JANET_API
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
@@ -132,26 +152,13 @@ extern "C" {
|
|||||||
#endif
|
#endif
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Handle runtime errors */
|
/* Tell complier some functions don't return */
|
||||||
#ifndef janet_exit
|
#ifndef JANET_NO_RETURN
|
||||||
#include <stdio.h>
|
#ifdef JANET_WINDOWS
|
||||||
#define janet_exit(m) do { \
|
#define JANET_NO_RETURN __declspec(noreturn)
|
||||||
printf("C runtime error at line %d in file %s: %s\n",\
|
#else
|
||||||
__LINE__,\
|
#define JANET_NO_RETURN __attribute__ ((noreturn))
|
||||||
__FILE__,\
|
|
||||||
(m));\
|
|
||||||
exit(1);\
|
|
||||||
} while (0)
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#define janet_assert(c, m) do { \
|
|
||||||
if (!(c)) janet_exit((m)); \
|
|
||||||
} while (0)
|
|
||||||
|
|
||||||
/* What to do when out of memory */
|
|
||||||
#ifndef JANET_OUT_OF_MEMORY
|
|
||||||
#include <stdio.h>
|
|
||||||
#define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0)
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Prevent some recursive functions from recursing too deeply
|
/* Prevent some recursive functions from recursing too deeply
|
||||||
@@ -167,7 +174,9 @@ extern "C" {
|
|||||||
/* Define max stack size for stacks before raising a stack overflow error.
|
/* Define max stack size for stacks before raising a stack overflow error.
|
||||||
* If this is not defined, fiber stacks can grow without limit (until memory
|
* If this is not defined, fiber stacks can grow without limit (until memory
|
||||||
* runs out) */
|
* runs out) */
|
||||||
#define JANET_STACK_MAX 8192
|
#ifndef JANET_STACK_MAX
|
||||||
|
#define JANET_STACK_MAX 16384
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Use nanboxed values - uses 8 bytes per value instead of 12 or 16.
|
/* Use nanboxed values - uses 8 bytes per value instead of 12 or 16.
|
||||||
* To turn of nanboxing, for debugging purposes or for certain
|
* To turn of nanboxing, for debugging purposes or for certain
|
||||||
@@ -176,20 +185,46 @@ extern "C" {
|
|||||||
#ifndef JANET_NO_NANBOX
|
#ifndef JANET_NO_NANBOX
|
||||||
#ifdef JANET_32
|
#ifdef JANET_32
|
||||||
#define JANET_NANBOX_32
|
#define JANET_NANBOX_32
|
||||||
#else
|
#elif defined(__x86_64__) || defined(_WIN64)
|
||||||
|
/* We will only enable nanboxing by default on 64 bit systems
|
||||||
|
* on x86. This is mainly because the approach is tied to the
|
||||||
|
* implicit 47 bit address space. */
|
||||||
#define JANET_NANBOX_64
|
#define JANET_NANBOX_64
|
||||||
#endif
|
#endif
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Alignment for pointers */
|
/* Runtime config constants */
|
||||||
#ifndef JANET_WALIGN
|
#ifdef JANET_NO_NANBOX
|
||||||
#ifdef JANET_32
|
#define JANET_NANBOX_BIT 0
|
||||||
#define JANET_WALIGN 4
|
|
||||||
#else
|
#else
|
||||||
#define JANET_WALIGN 8
|
#define JANET_NANBOX_BIT 0x1
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
#ifdef JANET_SINGLE_THREADED
|
||||||
|
#define JANET_SINGLE_THREADED_BIT 0x2
|
||||||
|
#else
|
||||||
|
#define JANET_SINGLE_THREADED_BIT 0
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
#define JANET_CURRENT_CONFIG_BITS \
|
||||||
|
(JANET_SINGLE_THREADED_BIT | \
|
||||||
|
JANET_NANBOX_BIT)
|
||||||
|
|
||||||
|
/* Represents the settings used to compile Janet, as well as the version */
|
||||||
|
typedef struct {
|
||||||
|
unsigned major;
|
||||||
|
unsigned minor;
|
||||||
|
unsigned patch;
|
||||||
|
unsigned bits;
|
||||||
|
} JanetBuildConfig;
|
||||||
|
|
||||||
|
/* Get config of current compilation unit. */
|
||||||
|
#define janet_config_current() ((JanetBuildConfig){ \
|
||||||
|
JANET_VERSION_MAJOR, \
|
||||||
|
JANET_VERSION_MINOR, \
|
||||||
|
JANET_VERSION_PATCH, \
|
||||||
|
JANET_CURRENT_CONFIG_BITS })
|
||||||
|
|
||||||
/***** END SECTION CONFIG *****/
|
/***** END SECTION CONFIG *****/
|
||||||
|
|
||||||
/***** START SECTION TYPES *****/
|
/***** START SECTION TYPES *****/
|
||||||
@@ -199,11 +234,13 @@ extern "C" {
|
|||||||
#include <stdlib.h>
|
#include <stdlib.h>
|
||||||
#include <stdarg.h>
|
#include <stdarg.h>
|
||||||
#include <setjmp.h>
|
#include <setjmp.h>
|
||||||
|
#include <stddef.h>
|
||||||
|
#include <stdio.h>
|
||||||
|
|
||||||
/* Names of all of the types */
|
/* Names of all of the types */
|
||||||
extern const char *const janet_type_names[16];
|
JANET_API const char *const janet_type_names[16];
|
||||||
extern const char *const janet_signal_names[14];
|
JANET_API const char *const janet_signal_names[14];
|
||||||
extern const char *const janet_status_names[16];
|
JANET_API const char *const janet_status_names[16];
|
||||||
|
|
||||||
/* Fiber signals */
|
/* Fiber signals */
|
||||||
typedef enum {
|
typedef enum {
|
||||||
@@ -251,15 +288,23 @@ typedef union Janet Janet;
|
|||||||
typedef struct Janet Janet;
|
typedef struct Janet Janet;
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* All of the janet types */
|
/* Use type punning for GC objects */
|
||||||
|
typedef struct JanetGCObject JanetGCObject;
|
||||||
|
|
||||||
|
/* All of the primary Janet GCed types */
|
||||||
typedef struct JanetFunction JanetFunction;
|
typedef struct JanetFunction JanetFunction;
|
||||||
typedef struct JanetArray JanetArray;
|
typedef struct JanetArray JanetArray;
|
||||||
typedef struct JanetBuffer JanetBuffer;
|
typedef struct JanetBuffer JanetBuffer;
|
||||||
typedef struct JanetTable JanetTable;
|
typedef struct JanetTable JanetTable;
|
||||||
typedef struct JanetFiber JanetFiber;
|
typedef struct JanetFiber JanetFiber;
|
||||||
|
|
||||||
|
/* Prefixed Janet types */
|
||||||
|
typedef struct JanetTupleHead JanetTupleHead;
|
||||||
|
typedef struct JanetStructHead JanetStructHead;
|
||||||
|
typedef struct JanetStringHead JanetStringHead;
|
||||||
|
typedef struct JanetAbstractHead JanetAbstractHead;
|
||||||
|
|
||||||
/* Other structs */
|
/* Other structs */
|
||||||
typedef struct JanetAbstractHeader JanetAbstractHeader;
|
|
||||||
typedef struct JanetFuncDef JanetFuncDef;
|
typedef struct JanetFuncDef JanetFuncDef;
|
||||||
typedef struct JanetFuncEnv JanetFuncEnv;
|
typedef struct JanetFuncEnv JanetFuncEnv;
|
||||||
typedef struct JanetKV JanetKV;
|
typedef struct JanetKV JanetKV;
|
||||||
@@ -278,8 +323,7 @@ typedef Janet (*JanetCFunction)(int32_t argc, Janet *argv);
|
|||||||
typedef enum JanetType {
|
typedef enum JanetType {
|
||||||
JANET_NUMBER,
|
JANET_NUMBER,
|
||||||
JANET_NIL,
|
JANET_NIL,
|
||||||
JANET_FALSE,
|
JANET_BOOLEAN,
|
||||||
JANET_TRUE,
|
|
||||||
JANET_FIBER,
|
JANET_FIBER,
|
||||||
JANET_STRING,
|
JANET_STRING,
|
||||||
JANET_SYMBOL,
|
JANET_SYMBOL,
|
||||||
@@ -291,15 +335,15 @@ typedef enum JanetType {
|
|||||||
JANET_BUFFER,
|
JANET_BUFFER,
|
||||||
JANET_FUNCTION,
|
JANET_FUNCTION,
|
||||||
JANET_CFUNCTION,
|
JANET_CFUNCTION,
|
||||||
JANET_ABSTRACT
|
JANET_ABSTRACT,
|
||||||
|
JANET_POINTER
|
||||||
} JanetType;
|
} JanetType;
|
||||||
|
|
||||||
#define JANET_COUNT_TYPES (JANET_ABSTRACT + 1)
|
#define JANET_COUNT_TYPES (JANET_POINTER + 1)
|
||||||
|
|
||||||
/* Type flags */
|
/* Type flags */
|
||||||
#define JANET_TFLAG_NIL (1 << JANET_NIL)
|
#define JANET_TFLAG_NIL (1 << JANET_NIL)
|
||||||
#define JANET_TFLAG_FALSE (1 << JANET_FALSE)
|
#define JANET_TFLAG_BOOLEAN (1 << JANET_BOOLEAN)
|
||||||
#define JANET_TFLAG_TRUE (1 << JANET_TRUE)
|
|
||||||
#define JANET_TFLAG_FIBER (1 << JANET_FIBER)
|
#define JANET_TFLAG_FIBER (1 << JANET_FIBER)
|
||||||
#define JANET_TFLAG_NUMBER (1 << JANET_NUMBER)
|
#define JANET_TFLAG_NUMBER (1 << JANET_NUMBER)
|
||||||
#define JANET_TFLAG_STRING (1 << JANET_STRING)
|
#define JANET_TFLAG_STRING (1 << JANET_STRING)
|
||||||
@@ -313,14 +357,14 @@ typedef enum JanetType {
|
|||||||
#define JANET_TFLAG_FUNCTION (1 << JANET_FUNCTION)
|
#define JANET_TFLAG_FUNCTION (1 << JANET_FUNCTION)
|
||||||
#define JANET_TFLAG_CFUNCTION (1 << JANET_CFUNCTION)
|
#define JANET_TFLAG_CFUNCTION (1 << JANET_CFUNCTION)
|
||||||
#define JANET_TFLAG_ABSTRACT (1 << JANET_ABSTRACT)
|
#define JANET_TFLAG_ABSTRACT (1 << JANET_ABSTRACT)
|
||||||
|
#define JANET_TFLAG_POINTER (1 << JANET_POINTER)
|
||||||
|
|
||||||
/* Some abstractions */
|
|
||||||
#define JANET_TFLAG_BOOLEAN (JANET_TFLAG_TRUE | JANET_TFLAG_FALSE)
|
|
||||||
#define JANET_TFLAG_BYTES (JANET_TFLAG_STRING | JANET_TFLAG_SYMBOL | JANET_TFLAG_BUFFER | JANET_TFLAG_KEYWORD)
|
#define JANET_TFLAG_BYTES (JANET_TFLAG_STRING | JANET_TFLAG_SYMBOL | JANET_TFLAG_BUFFER | JANET_TFLAG_KEYWORD)
|
||||||
#define JANET_TFLAG_INDEXED (JANET_TFLAG_ARRAY | JANET_TFLAG_TUPLE)
|
#define JANET_TFLAG_INDEXED (JANET_TFLAG_ARRAY | JANET_TFLAG_TUPLE)
|
||||||
#define JANET_TFLAG_DICTIONARY (JANET_TFLAG_TABLE | JANET_TFLAG_STRUCT)
|
#define JANET_TFLAG_DICTIONARY (JANET_TFLAG_TABLE | JANET_TFLAG_STRUCT)
|
||||||
#define JANET_TFLAG_LENGTHABLE (JANET_TFLAG_BYTES | JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY)
|
#define JANET_TFLAG_LENGTHABLE (JANET_TFLAG_BYTES | JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY)
|
||||||
#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION)
|
#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION | \
|
||||||
|
JANET_TFLAG_LENGTHABLE | JANET_TFLAG_ABSTRACT)
|
||||||
|
|
||||||
/* We provide three possible implementations of Janets. The preferred
|
/* We provide three possible implementations of Janets. The preferred
|
||||||
* nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
|
* nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
|
||||||
@@ -342,6 +386,63 @@ typedef enum JanetType {
|
|||||||
* janet_u64(x) - get 64 bits of payload for hashing
|
* janet_u64(x) - get 64 bits of payload for hashing
|
||||||
*/
|
*/
|
||||||
|
|
||||||
|
/***** START SECTION NON-C API *****/
|
||||||
|
|
||||||
|
/* Some janet types use offset tricks to make operations easier in C. For
|
||||||
|
* external bindings, we should prefer using the Head structs directly, and
|
||||||
|
* use the host language to add sugar around the manipulation of the Janet types. */
|
||||||
|
|
||||||
|
JANET_API JanetStructHead *janet_struct_head(const JanetKV *st);
|
||||||
|
JANET_API JanetAbstractHead *janet_abstract_head(const void *abstract);
|
||||||
|
JANET_API JanetStringHead *janet_string_head(const uint8_t *s);
|
||||||
|
JANET_API JanetTupleHead *janet_tuple_head(const Janet *tuple);
|
||||||
|
|
||||||
|
/* Some language bindings won't have access to the macro versions. */
|
||||||
|
|
||||||
|
JANET_API JanetType janet_type(Janet x);
|
||||||
|
JANET_API int janet_checktype(Janet x, JanetType type);
|
||||||
|
JANET_API int janet_checktypes(Janet x, int typeflags);
|
||||||
|
JANET_API int janet_truthy(Janet x);
|
||||||
|
|
||||||
|
JANET_API const JanetKV *janet_unwrap_struct(Janet x);
|
||||||
|
JANET_API const Janet *janet_unwrap_tuple(Janet x);
|
||||||
|
JANET_API JanetFiber *janet_unwrap_fiber(Janet x);
|
||||||
|
JANET_API JanetArray *janet_unwrap_array(Janet x);
|
||||||
|
JANET_API JanetTable *janet_unwrap_table(Janet x);
|
||||||
|
JANET_API JanetBuffer *janet_unwrap_buffer(Janet x);
|
||||||
|
JANET_API const uint8_t *janet_unwrap_string(Janet x);
|
||||||
|
JANET_API const uint8_t *janet_unwrap_symbol(Janet x);
|
||||||
|
JANET_API const uint8_t *janet_unwrap_keyword(Janet x);
|
||||||
|
JANET_API void *janet_unwrap_abstract(Janet x);
|
||||||
|
JANET_API void *janet_unwrap_pointer(Janet x);
|
||||||
|
JANET_API JanetFunction *janet_unwrap_function(Janet x);
|
||||||
|
JANET_API JanetCFunction janet_unwrap_cfunction(Janet x);
|
||||||
|
JANET_API int janet_unwrap_boolean(Janet x);
|
||||||
|
JANET_API double janet_unwrap_number(Janet x);
|
||||||
|
JANET_API int32_t janet_unwrap_integer(Janet x);
|
||||||
|
|
||||||
|
JANET_API Janet janet_wrap_nil(void);
|
||||||
|
JANET_API Janet janet_wrap_number(double x);
|
||||||
|
JANET_API Janet janet_wrap_true(void);
|
||||||
|
JANET_API Janet janet_wrap_false(void);
|
||||||
|
JANET_API Janet janet_wrap_boolean(int x);
|
||||||
|
JANET_API Janet janet_wrap_string(const uint8_t *x);
|
||||||
|
JANET_API Janet janet_wrap_symbol(const uint8_t *x);
|
||||||
|
JANET_API Janet janet_wrap_keyword(const uint8_t *x);
|
||||||
|
JANET_API Janet janet_wrap_array(JanetArray *x);
|
||||||
|
JANET_API Janet janet_wrap_tuple(const Janet *x);
|
||||||
|
JANET_API Janet janet_wrap_struct(const JanetKV *x);
|
||||||
|
JANET_API Janet janet_wrap_fiber(JanetFiber *x);
|
||||||
|
JANET_API Janet janet_wrap_buffer(JanetBuffer *x);
|
||||||
|
JANET_API Janet janet_wrap_function(JanetFunction *x);
|
||||||
|
JANET_API Janet janet_wrap_cfunction(JanetCFunction x);
|
||||||
|
JANET_API Janet janet_wrap_table(JanetTable *x);
|
||||||
|
JANET_API Janet janet_wrap_abstract(void *x);
|
||||||
|
JANET_API Janet janet_wrap_pointer(void *x);
|
||||||
|
JANET_API Janet janet_wrap_integer(int32_t x);
|
||||||
|
|
||||||
|
/***** END SECTION NON-C API *****/
|
||||||
|
|
||||||
#ifdef JANET_NANBOX_64
|
#ifdef JANET_NANBOX_64
|
||||||
|
|
||||||
#include <math.h>
|
#include <math.h>
|
||||||
@@ -382,7 +483,8 @@ JANET_API Janet janet_nanbox_from_double(double d);
|
|||||||
JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||||
|
|
||||||
#define janet_truthy(x) \
|
#define janet_truthy(x) \
|
||||||
(!(janet_checktype((x), JANET_NIL) || janet_checktype((x), JANET_FALSE)))
|
(!janet_checktype((x), JANET_NIL) && \
|
||||||
|
(!janet_checktype((x), JANET_BOOLEAN) || ((x).u64 & 0x1)))
|
||||||
|
|
||||||
#define janet_nanbox_from_payload(t, p) \
|
#define janet_nanbox_from_payload(t, p) \
|
||||||
janet_nanbox_from_bits(janet_nanbox_tag(t) | (p))
|
janet_nanbox_from_bits(janet_nanbox_tag(t) | (p))
|
||||||
@@ -395,14 +497,13 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
|||||||
|
|
||||||
/* Wrap the simple types */
|
/* Wrap the simple types */
|
||||||
#define janet_wrap_nil() janet_nanbox_from_payload(JANET_NIL, 1)
|
#define janet_wrap_nil() janet_nanbox_from_payload(JANET_NIL, 1)
|
||||||
#define janet_wrap_true() janet_nanbox_from_payload(JANET_TRUE, 1)
|
#define janet_wrap_true() janet_nanbox_from_payload(JANET_BOOLEAN, 1)
|
||||||
#define janet_wrap_false() janet_nanbox_from_payload(JANET_FALSE, 1)
|
#define janet_wrap_false() janet_nanbox_from_payload(JANET_BOOLEAN, 0)
|
||||||
#define janet_wrap_boolean(b) janet_nanbox_from_payload((b) ? JANET_TRUE : JANET_FALSE, 1)
|
#define janet_wrap_boolean(b) janet_nanbox_from_payload(JANET_BOOLEAN, !!(b))
|
||||||
#define janet_wrap_number(r) janet_nanbox_from_double(r)
|
#define janet_wrap_number(r) janet_nanbox_from_double(r)
|
||||||
|
|
||||||
/* Unwrap the simple types */
|
/* Unwrap the simple types */
|
||||||
#define janet_unwrap_boolean(x) \
|
#define janet_unwrap_boolean(x) ((x).u64 & 0x1)
|
||||||
(janet_checktype(x, JANET_TRUE))
|
|
||||||
#define janet_unwrap_number(x) ((x).number)
|
#define janet_unwrap_number(x) ((x).number)
|
||||||
|
|
||||||
/* Wrap the pointer types */
|
/* Wrap the pointer types */
|
||||||
@@ -418,6 +519,7 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
|||||||
#define janet_wrap_abstract(s) janet_nanbox_wrap_((s), JANET_ABSTRACT)
|
#define janet_wrap_abstract(s) janet_nanbox_wrap_((s), JANET_ABSTRACT)
|
||||||
#define janet_wrap_function(s) janet_nanbox_wrap_((s), JANET_FUNCTION)
|
#define janet_wrap_function(s) janet_nanbox_wrap_((s), JANET_FUNCTION)
|
||||||
#define janet_wrap_cfunction(s) janet_nanbox_wrap_((s), JANET_CFUNCTION)
|
#define janet_wrap_cfunction(s) janet_nanbox_wrap_((s), JANET_CFUNCTION)
|
||||||
|
#define janet_wrap_pointer(s) janet_nanbox_wrap_((s), JANET_POINTER)
|
||||||
|
|
||||||
/* Unwrap the pointer types */
|
/* Unwrap the pointer types */
|
||||||
#define janet_unwrap_struct(x) ((const JanetKV *)janet_nanbox_to_pointer(x))
|
#define janet_unwrap_struct(x) ((const JanetKV *)janet_nanbox_to_pointer(x))
|
||||||
@@ -464,16 +566,16 @@ union Janet {
|
|||||||
#define janet_checktype(x, t) ((t) == JANET_NUMBER \
|
#define janet_checktype(x, t) ((t) == JANET_NUMBER \
|
||||||
? (x).tagged.type >= JANET_DOUBLE_OFFSET \
|
? (x).tagged.type >= JANET_DOUBLE_OFFSET \
|
||||||
: (x).tagged.type == (t))
|
: (x).tagged.type == (t))
|
||||||
#define janet_truthy(x) ((x).tagged.type != JANET_NIL && (x).tagged.type != JANET_FALSE)
|
#define janet_truthy(x) \
|
||||||
|
((x).tagged.type != JANET_NIL && ((x).tagged.type != JANET_BOOLEAN || ((x).tagged.payload.integer & 0x1)))
|
||||||
|
|
||||||
JANET_API Janet janet_wrap_number(double x);
|
|
||||||
JANET_API Janet janet_nanbox32_from_tagi(uint32_t tag, int32_t integer);
|
JANET_API Janet janet_nanbox32_from_tagi(uint32_t tag, int32_t integer);
|
||||||
JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||||
|
|
||||||
#define janet_wrap_nil() janet_nanbox32_from_tagi(JANET_NIL, 0)
|
#define janet_wrap_nil() janet_nanbox32_from_tagi(JANET_NIL, 0)
|
||||||
#define janet_wrap_true() janet_nanbox32_from_tagi(JANET_TRUE, 0)
|
#define janet_wrap_true() janet_nanbox32_from_tagi(JANET_BOOLEAN, 1)
|
||||||
#define janet_wrap_false() janet_nanbox32_from_tagi(JANET_FALSE, 0)
|
#define janet_wrap_false() janet_nanbox32_from_tagi(JANET_BOOLEAN, 0)
|
||||||
#define janet_wrap_boolean(b) janet_nanbox32_from_tagi((b) ? JANET_TRUE : JANET_FALSE, 0)
|
#define janet_wrap_boolean(b) janet_nanbox32_from_tagi(JANET_BOOLEAN, !!(b))
|
||||||
|
|
||||||
/* Wrap the pointer types */
|
/* Wrap the pointer types */
|
||||||
#define janet_wrap_struct(s) janet_nanbox32_from_tagp(JANET_STRUCT, (void *)(s))
|
#define janet_wrap_struct(s) janet_nanbox32_from_tagp(JANET_STRUCT, (void *)(s))
|
||||||
@@ -488,6 +590,7 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
|||||||
#define janet_wrap_abstract(s) janet_nanbox32_from_tagp(JANET_ABSTRACT, (void *)(s))
|
#define janet_wrap_abstract(s) janet_nanbox32_from_tagp(JANET_ABSTRACT, (void *)(s))
|
||||||
#define janet_wrap_function(s) janet_nanbox32_from_tagp(JANET_FUNCTION, (void *)(s))
|
#define janet_wrap_function(s) janet_nanbox32_from_tagp(JANET_FUNCTION, (void *)(s))
|
||||||
#define janet_wrap_cfunction(s) janet_nanbox32_from_tagp(JANET_CFUNCTION, (void *)(s))
|
#define janet_wrap_cfunction(s) janet_nanbox32_from_tagp(JANET_CFUNCTION, (void *)(s))
|
||||||
|
#define janet_wrap_pointer(s) janet_nanbox32_from_tagp(JANET_POINTER, (void *)(s))
|
||||||
|
|
||||||
#define janet_unwrap_struct(x) ((const JanetKV *)(x).tagged.payload.pointer)
|
#define janet_unwrap_struct(x) ((const JanetKV *)(x).tagged.payload.pointer)
|
||||||
#define janet_unwrap_tuple(x) ((const Janet *)(x).tagged.payload.pointer)
|
#define janet_unwrap_tuple(x) ((const Janet *)(x).tagged.payload.pointer)
|
||||||
@@ -502,8 +605,7 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
|||||||
#define janet_unwrap_pointer(x) ((x).tagged.payload.pointer)
|
#define janet_unwrap_pointer(x) ((x).tagged.payload.pointer)
|
||||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
|
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
|
||||||
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).tagged.payload.pointer)
|
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).tagged.payload.pointer)
|
||||||
#define janet_unwrap_boolean(x) ((x).tagged.type == JANET_TRUE)
|
#define janet_unwrap_boolean(x) ((x).tagged.payload.integer)
|
||||||
JANET_API double janet_unwrap_number(Janet x);
|
|
||||||
|
|
||||||
#else
|
#else
|
||||||
|
|
||||||
@@ -523,7 +625,7 @@ struct Janet {
|
|||||||
#define janet_type(x) ((x).type)
|
#define janet_type(x) ((x).type)
|
||||||
#define janet_checktype(x, t) ((x).type == (t))
|
#define janet_checktype(x, t) ((x).type == (t))
|
||||||
#define janet_truthy(x) \
|
#define janet_truthy(x) \
|
||||||
((x).type != JANET_NIL && (x).type != JANET_FALSE)
|
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.integer & 0x1)))
|
||||||
|
|
||||||
#define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
|
#define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
|
||||||
#define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
|
#define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
|
||||||
@@ -538,32 +640,15 @@ struct Janet {
|
|||||||
#define janet_unwrap_pointer(x) ((x).as.pointer)
|
#define janet_unwrap_pointer(x) ((x).as.pointer)
|
||||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).as.pointer)
|
#define janet_unwrap_function(x) ((JanetFunction *)(x).as.pointer)
|
||||||
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).as.pointer)
|
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).as.pointer)
|
||||||
#define janet_unwrap_boolean(x) ((x).type == JANET_TRUE)
|
#define janet_unwrap_boolean(x) ((x).as.u64 & 0x1)
|
||||||
#define janet_unwrap_number(x) ((x).as.number)
|
#define janet_unwrap_number(x) ((x).as.number)
|
||||||
|
|
||||||
JANET_API Janet janet_wrap_nil(void);
|
|
||||||
JANET_API Janet janet_wrap_number(double x);
|
|
||||||
JANET_API Janet janet_wrap_true(void);
|
|
||||||
JANET_API Janet janet_wrap_false(void);
|
|
||||||
JANET_API Janet janet_wrap_boolean(int x);
|
|
||||||
JANET_API Janet janet_wrap_string(const uint8_t *x);
|
|
||||||
JANET_API Janet janet_wrap_symbol(const uint8_t *x);
|
|
||||||
JANET_API Janet janet_wrap_keyword(const uint8_t *x);
|
|
||||||
JANET_API Janet janet_wrap_array(JanetArray *x);
|
|
||||||
JANET_API Janet janet_wrap_tuple(const Janet *x);
|
|
||||||
JANET_API Janet janet_wrap_struct(const JanetKV *x);
|
|
||||||
JANET_API Janet janet_wrap_fiber(JanetFiber *x);
|
|
||||||
JANET_API Janet janet_wrap_buffer(JanetBuffer *x);
|
|
||||||
JANET_API Janet janet_wrap_function(JanetFunction *x);
|
|
||||||
JANET_API Janet janet_wrap_cfunction(JanetCFunction x);
|
|
||||||
JANET_API Janet janet_wrap_table(JanetTable *x);
|
|
||||||
JANET_API Janet janet_wrap_abstract(void *x);
|
|
||||||
|
|
||||||
/* End of tagged union implementation */
|
/* End of tagged union implementation */
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
JANET_API int janet_checkint(Janet x);
|
JANET_API int janet_checkint(Janet x);
|
||||||
JANET_API int janet_checkint64(Janet x);
|
JANET_API int janet_checkint64(Janet x);
|
||||||
|
JANET_API int janet_checksize(Janet x);
|
||||||
#define janet_checkintrange(x) ((x) == (int32_t)(x))
|
#define janet_checkintrange(x) ((x) == (int32_t)(x))
|
||||||
#define janet_checkint64range(x) ((x) == (int64_t)(x))
|
#define janet_checkint64range(x) ((x) == (int64_t)(x))
|
||||||
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
||||||
@@ -571,6 +656,14 @@ JANET_API int janet_checkint64(Janet x);
|
|||||||
|
|
||||||
#define janet_checktypes(x, tps) ((1 << janet_type(x)) & (tps))
|
#define janet_checktypes(x, tps) ((1 << janet_type(x)) & (tps))
|
||||||
|
|
||||||
|
/* GC Object type pun. The lower 16 bits of flags are reserved for the garbage collector,
|
||||||
|
* but the upper 16 can be used per type for custom flags. The current collector is a linked
|
||||||
|
* list of blocks, which is naive but works. */
|
||||||
|
struct JanetGCObject {
|
||||||
|
int32_t flags;
|
||||||
|
JanetGCObject *next;
|
||||||
|
};
|
||||||
|
|
||||||
/* Fiber signal masks. */
|
/* Fiber signal masks. */
|
||||||
#define JANET_FIBER_MASK_ERROR 2
|
#define JANET_FIBER_MASK_ERROR 2
|
||||||
#define JANET_FIBER_MASK_DEBUG 4
|
#define JANET_FIBER_MASK_DEBUG 4
|
||||||
@@ -596,14 +689,16 @@ JANET_API int janet_checkint64(Janet x);
|
|||||||
/* A lightweight green thread in janet. Does not correspond to
|
/* A lightweight green thread in janet. Does not correspond to
|
||||||
* operating system threads. */
|
* operating system threads. */
|
||||||
struct JanetFiber {
|
struct JanetFiber {
|
||||||
Janet *data;
|
JanetGCObject gc; /* GC Object stuff */
|
||||||
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
|
int32_t flags; /* More flags */
|
||||||
int32_t frame; /* Index of the stack frame */
|
int32_t frame; /* Index of the stack frame */
|
||||||
int32_t stackstart; /* Beginning of next args */
|
int32_t stackstart; /* Beginning of next args */
|
||||||
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */
|
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */
|
||||||
int32_t capacity;
|
int32_t capacity;
|
||||||
int32_t maxstack; /* Arbitrary defined limit for stack overflow */
|
int32_t maxstack; /* Arbitrary defined limit for stack overflow */
|
||||||
int32_t flags; /* Various flags */
|
JanetTable *env; /* Dynamic bindings table (usually current environment). */
|
||||||
|
Janet *data;
|
||||||
|
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Mark if a stack frame is a tail call for debugging */
|
/* Mark if a stack frame is a tail call for debugging */
|
||||||
@@ -626,25 +721,28 @@ struct JanetStackFrame {
|
|||||||
|
|
||||||
/* A dynamic array type. */
|
/* A dynamic array type. */
|
||||||
struct JanetArray {
|
struct JanetArray {
|
||||||
Janet *data;
|
JanetGCObject gc;
|
||||||
int32_t count;
|
int32_t count;
|
||||||
int32_t capacity;
|
int32_t capacity;
|
||||||
|
Janet *data;
|
||||||
};
|
};
|
||||||
|
|
||||||
/* A byte buffer type. Used as a mutable string or string builder. */
|
/* A byte buffer type. Used as a mutable string or string builder. */
|
||||||
struct JanetBuffer {
|
struct JanetBuffer {
|
||||||
uint8_t *data;
|
JanetGCObject gc;
|
||||||
int32_t count;
|
int32_t count;
|
||||||
int32_t capacity;
|
int32_t capacity;
|
||||||
|
uint8_t *data;
|
||||||
};
|
};
|
||||||
|
|
||||||
/* A mutable associative data type. Backed by a hashtable. */
|
/* A mutable associative data type. Backed by a hashtable. */
|
||||||
struct JanetTable {
|
struct JanetTable {
|
||||||
JanetKV *data;
|
JanetGCObject gc;
|
||||||
JanetTable *proto;
|
|
||||||
int32_t count;
|
int32_t count;
|
||||||
int32_t capacity;
|
int32_t capacity;
|
||||||
int32_t deleted;
|
int32_t deleted;
|
||||||
|
JanetKV *data;
|
||||||
|
JanetTable *proto;
|
||||||
};
|
};
|
||||||
|
|
||||||
/* A key value pair in a struct or table */
|
/* A key value pair in a struct or table */
|
||||||
@@ -653,15 +751,50 @@ struct JanetKV {
|
|||||||
Janet value;
|
Janet value;
|
||||||
};
|
};
|
||||||
|
|
||||||
|
/* Prefix for a tuple */
|
||||||
|
struct JanetTupleHead {
|
||||||
|
JanetGCObject gc;
|
||||||
|
int32_t length;
|
||||||
|
int32_t hash;
|
||||||
|
int32_t sm_start;
|
||||||
|
int32_t sm_end;
|
||||||
|
const Janet data[];
|
||||||
|
};
|
||||||
|
|
||||||
|
/* Prefix for a struct */
|
||||||
|
struct JanetStructHead {
|
||||||
|
JanetGCObject gc;
|
||||||
|
int32_t length;
|
||||||
|
int32_t hash;
|
||||||
|
int32_t capacity;
|
||||||
|
const JanetKV data[];
|
||||||
|
};
|
||||||
|
|
||||||
|
/* Prefix for a string */
|
||||||
|
struct JanetStringHead {
|
||||||
|
JanetGCObject gc;
|
||||||
|
int32_t length;
|
||||||
|
int32_t hash;
|
||||||
|
const uint8_t data[];
|
||||||
|
};
|
||||||
|
|
||||||
|
/* Prefix for an abstract value */
|
||||||
|
struct JanetAbstractHead {
|
||||||
|
JanetGCObject gc;
|
||||||
|
const JanetAbstractType *type;
|
||||||
|
size_t size;
|
||||||
|
long long data[]; /* Use long long to ensure most general alignment */
|
||||||
|
};
|
||||||
|
|
||||||
/* Some function definition flags */
|
/* Some function definition flags */
|
||||||
#define JANET_FUNCDEF_FLAG_VARARG 0x10000
|
#define JANET_FUNCDEF_FLAG_VARARG 0x10000
|
||||||
#define JANET_FUNCDEF_FLAG_NEEDSENV 0x20000
|
#define JANET_FUNCDEF_FLAG_NEEDSENV 0x20000
|
||||||
#define JANET_FUNCDEF_FLAG_FIXARITY 0x40000
|
|
||||||
#define JANET_FUNCDEF_FLAG_HASNAME 0x80000
|
#define JANET_FUNCDEF_FLAG_HASNAME 0x80000
|
||||||
#define JANET_FUNCDEF_FLAG_HASSOURCE 0x100000
|
#define JANET_FUNCDEF_FLAG_HASSOURCE 0x100000
|
||||||
#define JANET_FUNCDEF_FLAG_HASDEFS 0x200000
|
#define JANET_FUNCDEF_FLAG_HASDEFS 0x200000
|
||||||
#define JANET_FUNCDEF_FLAG_HASENVS 0x400000
|
#define JANET_FUNCDEF_FLAG_HASENVS 0x400000
|
||||||
#define JANET_FUNCDEF_FLAG_HASSOURCEMAP 0x800000
|
#define JANET_FUNCDEF_FLAG_HASSOURCEMAP 0x800000
|
||||||
|
#define JANET_FUNCDEF_FLAG_STRUCTARG 0x1000000
|
||||||
#define JANET_FUNCDEF_FLAG_TAG 0xFFFF
|
#define JANET_FUNCDEF_FLAG_TAG 0xFFFF
|
||||||
|
|
||||||
/* Source mapping structure for a bytecode instruction */
|
/* Source mapping structure for a bytecode instruction */
|
||||||
@@ -672,6 +805,7 @@ struct JanetSourceMapping {
|
|||||||
|
|
||||||
/* A function definition. Contains information needed to instantiate closures. */
|
/* A function definition. Contains information needed to instantiate closures. */
|
||||||
struct JanetFuncDef {
|
struct JanetFuncDef {
|
||||||
|
JanetGCObject gc;
|
||||||
int32_t *environments; /* Which environments to capture from parent. */
|
int32_t *environments; /* Which environments to capture from parent. */
|
||||||
Janet *constants;
|
Janet *constants;
|
||||||
JanetFuncDef **defs;
|
JanetFuncDef **defs;
|
||||||
@@ -685,6 +819,8 @@ struct JanetFuncDef {
|
|||||||
int32_t flags;
|
int32_t flags;
|
||||||
int32_t slotcount; /* The amount of stack space required for the function */
|
int32_t slotcount; /* The amount of stack space required for the function */
|
||||||
int32_t arity; /* Not including varargs */
|
int32_t arity; /* Not including varargs */
|
||||||
|
int32_t min_arity; /* Including varargs */
|
||||||
|
int32_t max_arity; /* Including varargs */
|
||||||
int32_t constants_length;
|
int32_t constants_length;
|
||||||
int32_t bytecode_length;
|
int32_t bytecode_length;
|
||||||
int32_t environments_length;
|
int32_t environments_length;
|
||||||
@@ -693,6 +829,7 @@ struct JanetFuncDef {
|
|||||||
|
|
||||||
/* A function environment */
|
/* A function environment */
|
||||||
struct JanetFuncEnv {
|
struct JanetFuncEnv {
|
||||||
|
JanetGCObject gc;
|
||||||
union {
|
union {
|
||||||
JanetFiber *fiber;
|
JanetFiber *fiber;
|
||||||
Janet *values;
|
Janet *values;
|
||||||
@@ -702,8 +839,11 @@ struct JanetFuncEnv {
|
|||||||
environment is no longer on the stack. */
|
environment is no longer on the stack. */
|
||||||
};
|
};
|
||||||
|
|
||||||
|
#define JANET_FUNCFLAG_TRACE (1 << 16)
|
||||||
|
|
||||||
/* A function */
|
/* A function */
|
||||||
struct JanetFunction {
|
struct JanetFunction {
|
||||||
|
JanetGCObject gc;
|
||||||
JanetFuncDef *def;
|
JanetFuncDef *def;
|
||||||
JanetFuncEnv *envs[];
|
JanetFuncEnv *envs[];
|
||||||
};
|
};
|
||||||
@@ -714,7 +854,8 @@ typedef struct JanetParser JanetParser;
|
|||||||
enum JanetParserStatus {
|
enum JanetParserStatus {
|
||||||
JANET_PARSE_ROOT,
|
JANET_PARSE_ROOT,
|
||||||
JANET_PARSE_ERROR,
|
JANET_PARSE_ERROR,
|
||||||
JANET_PARSE_PENDING
|
JANET_PARSE_PENDING,
|
||||||
|
JANET_PARSE_DEAD
|
||||||
};
|
};
|
||||||
|
|
||||||
/* A janet parser */
|
/* A janet parser */
|
||||||
@@ -732,8 +873,16 @@ struct JanetParser {
|
|||||||
size_t offset;
|
size_t offset;
|
||||||
size_t pending;
|
size_t pending;
|
||||||
int lookback;
|
int lookback;
|
||||||
|
int flag;
|
||||||
};
|
};
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
void *m_state; /* void* to not expose MarshalState ?*/
|
||||||
|
void *u_state;
|
||||||
|
int flags;
|
||||||
|
const uint8_t *data;
|
||||||
|
} JanetMarshalContext;
|
||||||
|
|
||||||
/* Defines an abstract type */
|
/* Defines an abstract type */
|
||||||
struct JanetAbstractType {
|
struct JanetAbstractType {
|
||||||
const char *name;
|
const char *name;
|
||||||
@@ -741,12 +890,9 @@ struct JanetAbstractType {
|
|||||||
int (*gcmark)(void *data, size_t len);
|
int (*gcmark)(void *data, size_t len);
|
||||||
Janet(*get)(void *data, Janet key);
|
Janet(*get)(void *data, Janet key);
|
||||||
void (*put)(void *data, Janet key, Janet value);
|
void (*put)(void *data, Janet key, Janet value);
|
||||||
};
|
void (*marshal)(void *p, JanetMarshalContext *ctx);
|
||||||
|
void (*unmarshal)(void *p, JanetMarshalContext *ctx);
|
||||||
/* Contains information about abstract types */
|
void (*tostring)(void *p, JanetBuffer *buffer);
|
||||||
struct JanetAbstractHeader {
|
|
||||||
const JanetAbstractType *type;
|
|
||||||
size_t size;
|
|
||||||
};
|
};
|
||||||
|
|
||||||
struct JanetReg {
|
struct JanetReg {
|
||||||
@@ -868,6 +1014,7 @@ enum JanetOpCode {
|
|||||||
JOP_TAILCALL,
|
JOP_TAILCALL,
|
||||||
JOP_RESUME,
|
JOP_RESUME,
|
||||||
JOP_SIGNAL,
|
JOP_SIGNAL,
|
||||||
|
JOP_PROPAGATE,
|
||||||
JOP_GET,
|
JOP_GET,
|
||||||
JOP_PUT,
|
JOP_PUT,
|
||||||
JOP_GET_INDEX,
|
JOP_GET_INDEX,
|
||||||
@@ -879,6 +1026,7 @@ enum JanetOpCode {
|
|||||||
JOP_MAKE_STRUCT,
|
JOP_MAKE_STRUCT,
|
||||||
JOP_MAKE_TABLE,
|
JOP_MAKE_TABLE,
|
||||||
JOP_MAKE_TUPLE,
|
JOP_MAKE_TUPLE,
|
||||||
|
JOP_MAKE_BRACKET_TUPLE,
|
||||||
JOP_NUMERIC_LESS_THAN,
|
JOP_NUMERIC_LESS_THAN,
|
||||||
JOP_NUMERIC_LESS_THAN_EQUAL,
|
JOP_NUMERIC_LESS_THAN_EQUAL,
|
||||||
JOP_NUMERIC_GREATER_THAN,
|
JOP_NUMERIC_GREATER_THAN,
|
||||||
@@ -897,13 +1045,13 @@ extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
|
|||||||
/* Parsing */
|
/* Parsing */
|
||||||
JANET_API void janet_parser_init(JanetParser *parser);
|
JANET_API void janet_parser_init(JanetParser *parser);
|
||||||
JANET_API void janet_parser_deinit(JanetParser *parser);
|
JANET_API void janet_parser_deinit(JanetParser *parser);
|
||||||
JANET_API int janet_parser_consume(JanetParser *parser, uint8_t c);
|
JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c);
|
||||||
JANET_API enum JanetParserStatus janet_parser_status(JanetParser *parser);
|
JANET_API enum JanetParserStatus janet_parser_status(JanetParser *parser);
|
||||||
JANET_API Janet janet_parser_produce(JanetParser *parser);
|
JANET_API Janet janet_parser_produce(JanetParser *parser);
|
||||||
JANET_API const char *janet_parser_error(JanetParser *parser);
|
JANET_API const char *janet_parser_error(JanetParser *parser);
|
||||||
JANET_API void janet_parser_flush(JanetParser *parser);
|
JANET_API void janet_parser_flush(JanetParser *parser);
|
||||||
JANET_API JanetParser *janet_check_parser(Janet x);
|
JANET_API void janet_parser_eof(JanetParser *parser);
|
||||||
#define janet_parser_has_more(P) ((P)->pending)
|
JANET_API int janet_parser_has_more(JanetParser *parser);
|
||||||
|
|
||||||
/* Assembly */
|
/* Assembly */
|
||||||
#ifdef JANET_ASSEMBLER
|
#ifdef JANET_ASSEMBLER
|
||||||
@@ -938,13 +1086,15 @@ struct JanetCompileResult {
|
|||||||
JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where);
|
JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where);
|
||||||
|
|
||||||
/* Get the default environment for janet */
|
/* Get the default environment for janet */
|
||||||
JANET_API JanetTable *janet_core_env(void);
|
JANET_API JanetTable *janet_core_env(JanetTable *replacements);
|
||||||
|
|
||||||
JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out);
|
JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out);
|
||||||
JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
|
JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
|
||||||
|
|
||||||
/* Number scanning */
|
/* Number scanning */
|
||||||
JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out);
|
JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out);
|
||||||
|
JANET_API int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out);
|
||||||
|
JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
|
||||||
|
|
||||||
/* Debugging */
|
/* Debugging */
|
||||||
JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc);
|
JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc);
|
||||||
@@ -956,8 +1106,6 @@ JANET_API void janet_debug_find(
|
|||||||
/* Array functions */
|
/* Array functions */
|
||||||
JANET_API JanetArray *janet_array(int32_t capacity);
|
JANET_API JanetArray *janet_array(int32_t capacity);
|
||||||
JANET_API JanetArray *janet_array_n(const Janet *elements, int32_t n);
|
JANET_API JanetArray *janet_array_n(const Janet *elements, int32_t n);
|
||||||
JANET_API JanetArray *janet_array_init(JanetArray *array, int32_t capacity);
|
|
||||||
JANET_API void janet_array_deinit(JanetArray *array);
|
|
||||||
JANET_API void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth);
|
JANET_API void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth);
|
||||||
JANET_API void janet_array_setcount(JanetArray *array, int32_t count);
|
JANET_API void janet_array_setcount(JanetArray *array, int32_t count);
|
||||||
JANET_API void janet_array_push(JanetArray *array, Janet x);
|
JANET_API void janet_array_push(JanetArray *array, Janet x);
|
||||||
@@ -981,14 +1129,14 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
|||||||
|
|
||||||
/* Tuple */
|
/* Tuple */
|
||||||
|
|
||||||
#define JANET_TUPLE_FLAG_BRACKETCTOR 1
|
#define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000
|
||||||
|
|
||||||
#define janet_tuple_raw(t) ((int32_t *)(t) - 5)
|
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
|
||||||
#define janet_tuple_length(t) (janet_tuple_raw(t)[0])
|
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
|
||||||
#define janet_tuple_hash(t) ((janet_tuple_raw(t)[1]))
|
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
|
||||||
#define janet_tuple_sm_start(t) ((janet_tuple_raw(t)[2]))
|
#define janet_tuple_sm_start(t) (janet_tuple_head(t)->sm_start)
|
||||||
#define janet_tuple_sm_end(t) ((janet_tuple_raw(t)[3]))
|
#define janet_tuple_sm_end(t) (janet_tuple_head(t)->sm_end)
|
||||||
#define janet_tuple_flag(t) ((janet_tuple_raw(t)[4]))
|
#define janet_tuple_flag(t) (janet_tuple_head(t)->gc.flags)
|
||||||
JANET_API Janet *janet_tuple_begin(int32_t length);
|
JANET_API Janet *janet_tuple_begin(int32_t length);
|
||||||
JANET_API const Janet *janet_tuple_end(Janet *tuple);
|
JANET_API const Janet *janet_tuple_end(Janet *tuple);
|
||||||
JANET_API const Janet *janet_tuple_n(const Janet *values, int32_t n);
|
JANET_API const Janet *janet_tuple_n(const Janet *values, int32_t n);
|
||||||
@@ -996,9 +1144,9 @@ JANET_API int janet_tuple_equal(const Janet *lhs, const Janet *rhs);
|
|||||||
JANET_API int janet_tuple_compare(const Janet *lhs, const Janet *rhs);
|
JANET_API int janet_tuple_compare(const Janet *lhs, const Janet *rhs);
|
||||||
|
|
||||||
/* String/Symbol functions */
|
/* String/Symbol functions */
|
||||||
#define janet_string_raw(s) ((int32_t *)(s) - 2)
|
#define janet_string_head(s) ((JanetStringHead *)((char *)s - offsetof(JanetStringHead, data)))
|
||||||
#define janet_string_length(s) (janet_string_raw(s)[0])
|
#define janet_string_length(s) (janet_string_head(s)->length)
|
||||||
#define janet_string_hash(s) ((janet_string_raw(s)[1]))
|
#define janet_string_hash(s) (janet_string_head(s)->hash)
|
||||||
JANET_API uint8_t *janet_string_begin(int32_t length);
|
JANET_API uint8_t *janet_string_begin(int32_t length);
|
||||||
JANET_API const uint8_t *janet_string_end(uint8_t *str);
|
JANET_API const uint8_t *janet_string_end(uint8_t *str);
|
||||||
JANET_API const uint8_t *janet_string(const uint8_t *buf, int32_t len);
|
JANET_API const uint8_t *janet_string(const uint8_t *buf, int32_t len);
|
||||||
@@ -1013,6 +1161,7 @@ JANET_API void janet_description_b(JanetBuffer *buffer, Janet x);
|
|||||||
#define janet_cstringv(cstr) janet_wrap_string(janet_cstring(cstr))
|
#define janet_cstringv(cstr) janet_wrap_string(janet_cstring(cstr))
|
||||||
#define janet_stringv(str, len) janet_wrap_string(janet_string((str), (len)))
|
#define janet_stringv(str, len) janet_wrap_string(janet_string((str), (len)))
|
||||||
JANET_API const uint8_t *janet_formatc(const char *format, ...);
|
JANET_API const uint8_t *janet_formatc(const char *format, ...);
|
||||||
|
JANET_API void janet_formatb(JanetBuffer *bufp, const char *format, va_list args);
|
||||||
|
|
||||||
/* Symbol functions */
|
/* Symbol functions */
|
||||||
JANET_API const uint8_t *janet_symbol(const uint8_t *str, int32_t len);
|
JANET_API const uint8_t *janet_symbol(const uint8_t *str, int32_t len);
|
||||||
@@ -1028,11 +1177,10 @@ JANET_API const uint8_t *janet_symbol_gen(void);
|
|||||||
#define janet_ckeywordv(cstr) janet_wrap_keyword(janet_ckeyword(cstr))
|
#define janet_ckeywordv(cstr) janet_wrap_keyword(janet_ckeyword(cstr))
|
||||||
|
|
||||||
/* Structs */
|
/* Structs */
|
||||||
#define janet_struct_raw(t) ((int32_t *)(t) - 4)
|
#define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
|
||||||
#define janet_struct_length(t) (janet_struct_raw(t)[0])
|
#define janet_struct_length(t) (janet_struct_head(t)->length)
|
||||||
#define janet_struct_capacity(t) (janet_struct_raw(t)[1])
|
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
|
||||||
#define janet_struct_hash(t) (janet_struct_raw(t)[2])
|
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
|
||||||
/* Do something with the 4th header slot - flags? */
|
|
||||||
JANET_API JanetKV *janet_struct_begin(int32_t count);
|
JANET_API JanetKV *janet_struct_begin(int32_t count);
|
||||||
JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
|
JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
|
||||||
JANET_API const JanetKV *janet_struct_end(JanetKV *st);
|
JANET_API const JanetKV *janet_struct_end(JanetKV *st);
|
||||||
@@ -1058,7 +1206,8 @@ JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
|
|||||||
/* Fiber */
|
/* Fiber */
|
||||||
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
|
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
|
||||||
JANET_API JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv);
|
JANET_API JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv);
|
||||||
#define janet_fiber_status(f) (((f)->flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET)
|
JANET_API JanetFiberStatus janet_fiber_status(JanetFiber *fiber);
|
||||||
|
JANET_API JanetFiber *janet_current_fiber(void);
|
||||||
|
|
||||||
/* Treat similar types through uniform interfaces for iteration */
|
/* Treat similar types through uniform interfaces for iteration */
|
||||||
JANET_API int janet_indexed_view(Janet seq, const Janet **data, int32_t *len);
|
JANET_API int janet_indexed_view(Janet seq, const Janet **data, int32_t *len);
|
||||||
@@ -1068,27 +1217,28 @@ JANET_API Janet janet_dictionary_get(const JanetKV *data, int32_t cap, Janet key
|
|||||||
JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap, const JanetKV *kv);
|
JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap, const JanetKV *kv);
|
||||||
|
|
||||||
/* Abstract */
|
/* Abstract */
|
||||||
#define janet_abstract_header(u) ((JanetAbstractHeader *)(u) - 1)
|
#define janet_abstract_head(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
|
||||||
#define janet_abstract_type(u) (janet_abstract_header(u)->type)
|
#define janet_abstract_type(u) (janet_abstract_head(u)->type)
|
||||||
#define janet_abstract_size(u) (janet_abstract_header(u)->size)
|
#define janet_abstract_size(u) (janet_abstract_head(u)->size)
|
||||||
JANET_API void *janet_abstract(const JanetAbstractType *type, size_t size);
|
JANET_API void *janet_abstract_begin(const JanetAbstractType *type, size_t size);
|
||||||
|
JANET_API void *janet_abstract_end(void *);
|
||||||
|
JANET_API void *janet_abstract(const JanetAbstractType *type, size_t size); /* begin and end in one call */
|
||||||
|
|
||||||
/* Native */
|
/* Native */
|
||||||
typedef void (*JanetModule)(JanetTable *);
|
typedef void (*JanetModule)(JanetTable *);
|
||||||
|
typedef JanetBuildConfig(*JanetModconf)(void);
|
||||||
JANET_API JanetModule janet_native(const char *name, const uint8_t **error);
|
JANET_API JanetModule janet_native(const char *name, const uint8_t **error);
|
||||||
|
|
||||||
/* Marshaling */
|
/* Marshaling */
|
||||||
JANET_API int janet_marshal(
|
JANET_API void janet_marshal(
|
||||||
JanetBuffer *buf,
|
JanetBuffer *buf,
|
||||||
Janet x,
|
Janet x,
|
||||||
Janet *errval,
|
|
||||||
JanetTable *rreg,
|
JanetTable *rreg,
|
||||||
int flags);
|
int flags);
|
||||||
JANET_API int janet_unmarshal(
|
JANET_API Janet janet_unmarshal(
|
||||||
const uint8_t *bytes,
|
const uint8_t *bytes,
|
||||||
size_t len,
|
size_t len,
|
||||||
int flags,
|
int flags,
|
||||||
Janet *out,
|
|
||||||
JanetTable *reg,
|
JanetTable *reg,
|
||||||
const uint8_t **next);
|
const uint8_t **next);
|
||||||
JANET_API JanetTable *janet_env_lookup(JanetTable *env);
|
JANET_API JanetTable *janet_env_lookup(JanetTable *env);
|
||||||
@@ -1109,17 +1259,22 @@ JANET_API JanetFuncDef *janet_funcdef_alloc(void);
|
|||||||
JANET_API JanetFunction *janet_thunk(JanetFuncDef *def);
|
JANET_API JanetFunction *janet_thunk(JanetFuncDef *def);
|
||||||
JANET_API int janet_verify(JanetFuncDef *def);
|
JANET_API int janet_verify(JanetFuncDef *def);
|
||||||
|
|
||||||
|
/* Pretty printing */
|
||||||
|
#define JANET_PRETTY_COLOR 1
|
||||||
|
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x);
|
||||||
|
|
||||||
/* Misc */
|
/* Misc */
|
||||||
JANET_API int janet_equals(Janet x, Janet y);
|
JANET_API int janet_equals(Janet x, Janet y);
|
||||||
JANET_API int32_t janet_hash(Janet x);
|
JANET_API int32_t janet_hash(Janet x);
|
||||||
JANET_API int janet_compare(Janet x, Janet y);
|
JANET_API int janet_compare(Janet x, Janet y);
|
||||||
JANET_API int janet_cstrcmp(const uint8_t *str, const char *other);
|
JANET_API int janet_cstrcmp(const uint8_t *str, const char *other);
|
||||||
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, Janet x);
|
|
||||||
JANET_API Janet janet_get(Janet ds, Janet key);
|
JANET_API Janet janet_get(Janet ds, Janet key);
|
||||||
JANET_API Janet janet_getindex(Janet ds, int32_t index);
|
JANET_API Janet janet_getindex(Janet ds, int32_t index);
|
||||||
JANET_API int32_t janet_length(Janet x);
|
JANET_API int32_t janet_length(Janet x);
|
||||||
JANET_API void janet_put(Janet ds, Janet key, Janet value);
|
JANET_API void janet_put(Janet ds, Janet key, Janet value);
|
||||||
JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
|
JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
|
||||||
|
JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
|
||||||
|
#define janet_flag_at(F, I) ((F) & ((1ULL) << (I)))
|
||||||
|
|
||||||
/* VM functions */
|
/* VM functions */
|
||||||
JANET_API int janet_init(void);
|
JANET_API int janet_init(void);
|
||||||
@@ -1129,6 +1284,11 @@ JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet
|
|||||||
JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
|
JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
|
||||||
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
|
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
|
||||||
|
|
||||||
|
/* Scratch Memory API */
|
||||||
|
JANET_API void *janet_smalloc(size_t size);
|
||||||
|
JANET_API void *janet_srealloc(void *mem, size_t size);
|
||||||
|
JANET_API void janet_sfree(void *mem);
|
||||||
|
|
||||||
/* C Library helpers */
|
/* C Library helpers */
|
||||||
typedef enum {
|
typedef enum {
|
||||||
JANET_BINDING_NONE,
|
JANET_BINDING_NONE,
|
||||||
@@ -1144,14 +1304,19 @@ JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
|||||||
|
|
||||||
/* New C API */
|
/* New C API */
|
||||||
|
|
||||||
#define JANET_MODULE_ENTRY JANET_API void _janet_init
|
#define JANET_MODULE_ENTRY \
|
||||||
JANET_API void janet_panicv(Janet message);
|
JANET_API JanetBuildConfig _janet_mod_config(void) { \
|
||||||
JANET_API void janet_panic(const char *message);
|
return janet_config_current(); \
|
||||||
JANET_API void janet_panics(const uint8_t *message);
|
} \
|
||||||
#define janet_panicf(...) janet_panics(janet_formatc(__VA_ARGS__))
|
JANET_API void _janet_init
|
||||||
#define janet_printf(...) fputs((const char *)janet_formatc(__VA_ARGS__), stdout)
|
|
||||||
JANET_API void janet_panic_type(Janet x, int32_t n, int expected);
|
JANET_NO_RETURN JANET_API void janet_panicv(Janet message);
|
||||||
JANET_API void janet_panic_abstract(Janet x, int32_t n, const JanetAbstractType *at);
|
JANET_NO_RETURN JANET_API void janet_panic(const char *message);
|
||||||
|
JANET_NO_RETURN JANET_API void janet_panics(const uint8_t *message);
|
||||||
|
JANET_NO_RETURN JANET_API void janet_panicf(const char *format, ...);
|
||||||
|
JANET_API void janet_printf(const char *format, ...);
|
||||||
|
JANET_NO_RETURN JANET_API void janet_panic_type(Janet x, int32_t n, int expected);
|
||||||
|
JANET_NO_RETURN JANET_API void janet_panic_abstract(Janet x, int32_t n, const JanetAbstractType *at);
|
||||||
JANET_API void janet_arity(int32_t arity, int32_t min, int32_t max);
|
JANET_API void janet_arity(int32_t arity, int32_t min, int32_t max);
|
||||||
JANET_API void janet_fixarity(int32_t arity, int32_t fix);
|
JANET_API void janet_fixarity(int32_t arity, int32_t fix);
|
||||||
|
|
||||||
@@ -1162,6 +1327,7 @@ JANET_API const Janet *janet_gettuple(const Janet *argv, int32_t n);
|
|||||||
JANET_API JanetTable *janet_gettable(const Janet *argv, int32_t n);
|
JANET_API JanetTable *janet_gettable(const Janet *argv, int32_t n);
|
||||||
JANET_API const JanetKV *janet_getstruct(const Janet *argv, int32_t n);
|
JANET_API const JanetKV *janet_getstruct(const Janet *argv, int32_t n);
|
||||||
JANET_API const uint8_t *janet_getstring(const Janet *argv, int32_t n);
|
JANET_API const uint8_t *janet_getstring(const Janet *argv, int32_t n);
|
||||||
|
JANET_API const char *janet_getcstring(const Janet *argv, int32_t n);
|
||||||
JANET_API const uint8_t *janet_getsymbol(const Janet *argv, int32_t n);
|
JANET_API const uint8_t *janet_getsymbol(const Janet *argv, int32_t n);
|
||||||
JANET_API const uint8_t *janet_getkeyword(const Janet *argv, int32_t n);
|
JANET_API const uint8_t *janet_getkeyword(const Janet *argv, int32_t n);
|
||||||
JANET_API JanetBuffer *janet_getbuffer(const Janet *argv, int32_t n);
|
JANET_API JanetBuffer *janet_getbuffer(const Janet *argv, int32_t n);
|
||||||
@@ -1169,9 +1335,11 @@ JANET_API JanetFiber *janet_getfiber(const Janet *argv, int32_t n);
|
|||||||
JANET_API JanetFunction *janet_getfunction(const Janet *argv, int32_t n);
|
JANET_API JanetFunction *janet_getfunction(const Janet *argv, int32_t n);
|
||||||
JANET_API JanetCFunction janet_getcfunction(const Janet *argv, int32_t n);
|
JANET_API JanetCFunction janet_getcfunction(const Janet *argv, int32_t n);
|
||||||
JANET_API int janet_getboolean(const Janet *argv, int32_t n);
|
JANET_API int janet_getboolean(const Janet *argv, int32_t n);
|
||||||
|
JANET_API void *janet_getpointer(const Janet *argv, int32_t n);
|
||||||
|
|
||||||
JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
|
JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
|
||||||
JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
|
JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
|
||||||
|
JANET_API size_t janet_getsize(const Janet *argv, int32_t n);
|
||||||
JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);
|
JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);
|
||||||
JANET_API JanetByteView janet_getbytes(const Janet *argv, int32_t n);
|
JANET_API JanetByteView janet_getbytes(const Janet *argv, int32_t n);
|
||||||
JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n);
|
JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n);
|
||||||
@@ -1180,6 +1348,98 @@ JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
|
|||||||
JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
|
JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
|
||||||
JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
|
JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
|
||||||
|
|
||||||
|
JANET_API Janet janet_dyn(const char *name);
|
||||||
|
JANET_API void janet_setdyn(const char *name, Janet value);
|
||||||
|
|
||||||
|
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
|
||||||
|
JANET_API FILE *janet_dynfile(const char *name, FILE *def);
|
||||||
|
|
||||||
|
/* Marshal API */
|
||||||
|
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
|
||||||
|
JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);
|
||||||
|
JANET_API void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value);
|
||||||
|
JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value);
|
||||||
|
JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len);
|
||||||
|
JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x);
|
||||||
|
|
||||||
|
JANET_API size_t janet_unmarshal_size(JanetMarshalContext *ctx);
|
||||||
|
JANET_API int32_t janet_unmarshal_int(JanetMarshalContext *ctx);
|
||||||
|
JANET_API int64_t janet_unmarshal_int64(JanetMarshalContext *ctx);
|
||||||
|
JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
|
||||||
|
JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
|
||||||
|
JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);
|
||||||
|
|
||||||
|
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
|
||||||
|
JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key);
|
||||||
|
|
||||||
|
#ifdef JANET_TYPED_ARRAY
|
||||||
|
|
||||||
|
typedef enum {
|
||||||
|
JANET_TARRAY_TYPE_U8,
|
||||||
|
JANET_TARRAY_TYPE_S8,
|
||||||
|
JANET_TARRAY_TYPE_U16,
|
||||||
|
JANET_TARRAY_TYPE_S16,
|
||||||
|
JANET_TARRAY_TYPE_U32,
|
||||||
|
JANET_TARRAY_TYPE_S32,
|
||||||
|
JANET_TARRAY_TYPE_U64,
|
||||||
|
JANET_TARRAY_TYPE_S64,
|
||||||
|
JANET_TARRAY_TYPE_F32,
|
||||||
|
JANET_TARRAY_TYPE_F64
|
||||||
|
} JanetTArrayType;
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
uint8_t *data;
|
||||||
|
size_t size;
|
||||||
|
int32_t flags;
|
||||||
|
} JanetTArrayBuffer;
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
union {
|
||||||
|
void *pointer;
|
||||||
|
uint8_t *u8;
|
||||||
|
int8_t *s8;
|
||||||
|
uint16_t *u16;
|
||||||
|
int16_t *s16;
|
||||||
|
uint32_t *u32;
|
||||||
|
int32_t *s32;
|
||||||
|
uint64_t *u64;
|
||||||
|
int64_t *s64;
|
||||||
|
float *f32;
|
||||||
|
double *f64;
|
||||||
|
} as;
|
||||||
|
JanetTArrayBuffer *buffer;
|
||||||
|
size_t size;
|
||||||
|
size_t stride;
|
||||||
|
JanetTArrayType type;
|
||||||
|
} JanetTArrayView;
|
||||||
|
|
||||||
|
JANET_API JanetTArrayBuffer *janet_tarray_buffer(size_t size);
|
||||||
|
JANET_API JanetTArrayView *janet_tarray_view(JanetTArrayType type, size_t size, size_t stride, size_t offset, JanetTArrayBuffer *buffer);
|
||||||
|
JANET_API int janet_is_tarray_view(Janet x, JanetTArrayType type);
|
||||||
|
JANET_API JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n);
|
||||||
|
JANET_API JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type);
|
||||||
|
JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n);
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef JANET_INT_TYPES
|
||||||
|
|
||||||
|
typedef enum {
|
||||||
|
JANET_INT_NONE,
|
||||||
|
JANET_INT_S64,
|
||||||
|
JANET_INT_U64
|
||||||
|
} JanetIntType;
|
||||||
|
|
||||||
|
JANET_API JanetIntType janet_is_int(Janet x);
|
||||||
|
JANET_API Janet janet_wrap_s64(int64_t x);
|
||||||
|
JANET_API Janet janet_wrap_u64(uint64_t x);
|
||||||
|
JANET_API int64_t janet_unwrap_s64(Janet x);
|
||||||
|
JANET_API uint64_t janet_unwrap_u64(Janet x);
|
||||||
|
JANET_API int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out);
|
||||||
|
JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|
||||||
/***** END SECTION MAIN *****/
|
/***** END SECTION MAIN *****/
|
||||||
|
|
||||||
#ifdef __cplusplus
|
#ifdef __cplusplus
|
||||||
@@ -8,6 +8,11 @@
|
|||||||
(var *raw-stdin* false)
|
(var *raw-stdin* false)
|
||||||
(var *handleopts* true)
|
(var *handleopts* true)
|
||||||
(var *exit-on-error* true)
|
(var *exit-on-error* true)
|
||||||
|
(var *colorize* true)
|
||||||
|
(var *compile-only* false)
|
||||||
|
|
||||||
|
(if-let [jp (os/getenv "JANET_PATH")] (setdyn :syspath jp))
|
||||||
|
(if-let [jp (os/getenv "JANET_HEADERPATH")] (setdyn :headerpath jp))
|
||||||
|
|
||||||
# Flag handlers
|
# Flag handlers
|
||||||
(def handlers :private
|
(def handlers :private
|
||||||
@@ -15,15 +20,19 @@
|
|||||||
(print "usage: " (get process/args 0) " [options] script args...")
|
(print "usage: " (get process/args 0) " [options] script args...")
|
||||||
(print
|
(print
|
||||||
`Options are:
|
`Options are:
|
||||||
-h Show this help
|
-h : Show this help
|
||||||
-v Print the version string
|
-v : Print the version string
|
||||||
-s Use raw stdin instead of getline like functionality
|
-s : Use raw stdin instead of getline like functionality
|
||||||
-e Execute a string of janet
|
-e code : Execute a string of janet
|
||||||
-r Enter the repl after running all scripts
|
-r : Enter the repl after running all scripts
|
||||||
-p Keep on executing if there is a top level error (persistent)
|
-p : Keep on executing if there is a top level error (persistent)
|
||||||
-q Hide prompt, logo, and repl output (quiet)
|
-q : Hide prompt, logo, and repl output (quiet)
|
||||||
-l Execute code in a file before running the main script
|
-k : Compile scripts but do not execute
|
||||||
-- Stop handling options`)
|
-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`)
|
||||||
(os/exit 0)
|
(os/exit 0)
|
||||||
1)
|
1)
|
||||||
"v" (fn [&] (print janet/version "-" janet/build) (os/exit 0) 1)
|
"v" (fn [&] (print janet/version "-" janet/build) (os/exit 0) 1)
|
||||||
@@ -31,9 +40,17 @@
|
|||||||
"r" (fn [&] (set *should-repl* true) 1)
|
"r" (fn [&] (set *should-repl* true) 1)
|
||||||
"p" (fn [&] (set *exit-on-error* false) 1)
|
"p" (fn [&] (set *exit-on-error* false) 1)
|
||||||
"q" (fn [&] (set *quiet* true) 1)
|
"q" (fn [&] (set *quiet* true) 1)
|
||||||
|
"k" (fn [&] (set *compile-only* true) (set *exit-on-error* false) 1)
|
||||||
|
"n" (fn [&] (set *colorize* false) 1)
|
||||||
|
"m" (fn [i &] (setdyn :syspath (get process/args (+ i 1))) 2)
|
||||||
|
"c" (fn [i &]
|
||||||
|
(def e (dofile (get process/args (+ i 1))))
|
||||||
|
(spit (get process/args (+ i 2)) (make-image e))
|
||||||
|
(set *no-file* false)
|
||||||
|
3)
|
||||||
"-" (fn [&] (set *handleopts* false) 1)
|
"-" (fn [&] (set *handleopts* false) 1)
|
||||||
"l" (fn [i &]
|
"l" (fn [i &]
|
||||||
(import* *env* (get process/args (+ i 1))
|
(dofile (get process/args (+ i 1))
|
||||||
:prefix "" :exit *exit-on-error*)
|
:prefix "" :exit *exit-on-error*)
|
||||||
2)
|
2)
|
||||||
"e" (fn [i &]
|
"e" (fn [i &]
|
||||||
@@ -54,16 +71,16 @@
|
|||||||
(+= i (dohandler (string/slice arg 1 2) i))
|
(+= i (dohandler (string/slice arg 1 2) i))
|
||||||
(do
|
(do
|
||||||
(set *no-file* false)
|
(set *no-file* false)
|
||||||
(import* *env* arg :prefix "" :exit *exit-on-error*)
|
(dofile arg :prefix "" :exit *exit-on-error* :compile-only *compile-only*)
|
||||||
(set i lenargs))))
|
(set i lenargs))))
|
||||||
|
|
||||||
(when (or *should-repl* *no-file*)
|
(when (and (not *compile-only*) (or *should-repl* *no-file*))
|
||||||
(if-not *quiet*
|
(if-not *quiet*
|
||||||
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
||||||
(defn noprompt [_] "")
|
(defn noprompt [_] "")
|
||||||
(defn getprompt [p]
|
(defn getprompt [p]
|
||||||
(def offset (parser/where p))
|
(def offset (parser/where p))
|
||||||
(string "janet:" offset ":" (parser/state p) "> "))
|
(string "janet:" offset ":" (parser/state p :delimiters) "> "))
|
||||||
(def prompter (if *quiet* noprompt getprompt))
|
(def prompter (if *quiet* noprompt getprompt))
|
||||||
(defn getstdin [prompt buf]
|
(defn getstdin [prompt buf]
|
||||||
(file/write stdout prompt)
|
(file/write stdout prompt)
|
||||||
@@ -73,4 +90,5 @@
|
|||||||
(defn getchunk [buf p]
|
(defn getchunk [buf p]
|
||||||
(getter (prompter p) buf))
|
(getter (prompter p) buf))
|
||||||
(def onsig (if *quiet* (fn [x &] x) nil))
|
(def onsig (if *quiet* (fn [x &] x) nil))
|
||||||
|
(setdyn :pretty-format (if *colorize* "%.20P" "%.20p"))
|
||||||
(repl getchunk onsig)))
|
(repl getchunk onsig)))
|
||||||
|
|||||||
@@ -32,11 +32,12 @@ Janet janet_line_getter(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void simpleline(JanetBuffer *buffer) {
|
static void simpleline(JanetBuffer *buffer) {
|
||||||
|
FILE *in = janet_dynfile("in", stdin);
|
||||||
buffer->count = 0;
|
buffer->count = 0;
|
||||||
int c;
|
int c;
|
||||||
for (;;) {
|
for (;;) {
|
||||||
c = fgetc(stdin);
|
c = fgetc(in);
|
||||||
if (feof(stdin) || c < 0) {
|
if (feof(in) || c < 0) {
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
janet_buffer_push_u8(buffer, (uint8_t) c);
|
janet_buffer_push_u8(buffer, (uint8_t) c);
|
||||||
@@ -56,7 +57,9 @@ void janet_line_deinit() {
|
|||||||
}
|
}
|
||||||
|
|
||||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||||
fputs(p, stdout);
|
FILE *out = janet_dynfile("out", stdout);
|
||||||
|
fputs(p, out);
|
||||||
|
fflush(out);
|
||||||
simpleline(buffer);
|
simpleline(buffer);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -94,6 +97,7 @@ static int cols = 80;
|
|||||||
static char *history[JANET_HISTORY_MAX];
|
static char *history[JANET_HISTORY_MAX];
|
||||||
static int history_count = 0;
|
static int history_count = 0;
|
||||||
static int historyi = 0;
|
static int historyi = 0;
|
||||||
|
static int sigint_flag = 0;
|
||||||
static struct termios termios_start;
|
static struct termios termios_start;
|
||||||
|
|
||||||
/* Unsupported terminal list from linenoise */
|
/* Unsupported terminal list from linenoise */
|
||||||
@@ -333,6 +337,7 @@ static int line() {
|
|||||||
return 0;
|
return 0;
|
||||||
case 3: /* ctrl-c */
|
case 3: /* ctrl-c */
|
||||||
errno = EAGAIN;
|
errno = EAGAIN;
|
||||||
|
sigint_flag = 1;
|
||||||
return -1;
|
return -1;
|
||||||
case 127: /* backspace */
|
case 127: /* backspace */
|
||||||
case 8: /* ctrl-h */
|
case 8: /* ctrl-h */
|
||||||
@@ -448,6 +453,7 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
|||||||
prompt = p;
|
prompt = p;
|
||||||
buffer->count = 0;
|
buffer->count = 0;
|
||||||
historyi = 0;
|
historyi = 0;
|
||||||
|
FILE *out = janet_dynfile("out", stdout);
|
||||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||||
simpleline(buffer);
|
simpleline(buffer);
|
||||||
return;
|
return;
|
||||||
@@ -458,11 +464,15 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
|||||||
}
|
}
|
||||||
if (line()) {
|
if (line()) {
|
||||||
norawmode();
|
norawmode();
|
||||||
fputc('\n', stdout);
|
if (sigint_flag) {
|
||||||
|
raise(SIGINT);
|
||||||
|
} else {
|
||||||
|
fputc('\n', out);
|
||||||
|
}
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
norawmode();
|
norawmode();
|
||||||
fputc('\n', stdout);
|
fputc('\n', out);
|
||||||
janet_buffer_ensure(buffer, len + 1, 2);
|
janet_buffer_ensure(buffer, len + 1, 2);
|
||||||
memcpy(buffer->data, buf, len);
|
memcpy(buffer->data, buf, len);
|
||||||
buffer->data[len] = '\n';
|
buffer->data[len] = '\n';
|
||||||
|
|||||||
@@ -23,7 +23,7 @@
|
|||||||
#ifndef JANET_LINE_H_defined
|
#ifndef JANET_LINE_H_defined
|
||||||
#define JANET_LINE_H_defined
|
#define JANET_LINE_H_defined
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
|
|
||||||
void janet_line_init();
|
void janet_line_init();
|
||||||
void janet_line_deinit();
|
void janet_line_deinit();
|
||||||
|
|||||||
@@ -20,9 +20,16 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "line.h"
|
#include "line.h"
|
||||||
|
|
||||||
|
#ifdef _WIN32
|
||||||
|
#include <windows.h>
|
||||||
|
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
||||||
|
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
||||||
|
#endif
|
||||||
|
#endif
|
||||||
|
|
||||||
extern const unsigned char *janet_gen_init;
|
extern const unsigned char *janet_gen_init;
|
||||||
extern int32_t janet_gen_init_size;
|
extern int32_t janet_gen_init_size;
|
||||||
|
|
||||||
@@ -31,9 +38,26 @@ int main(int argc, char **argv) {
|
|||||||
JanetArray *args;
|
JanetArray *args;
|
||||||
JanetTable *env;
|
JanetTable *env;
|
||||||
|
|
||||||
|
/* Enable color console on windows 10 console and utf8 output. */
|
||||||
|
#ifdef _WIN32
|
||||||
|
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 */
|
/* Set up VM */
|
||||||
janet_init();
|
janet_init();
|
||||||
env = janet_core_env();
|
|
||||||
|
/* 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 */
|
/* Create args tuple */
|
||||||
args = janet_array(argc);
|
args = janet_array(argc);
|
||||||
@@ -41,11 +65,6 @@ int main(int argc, char **argv) {
|
|||||||
janet_array_push(args, janet_cstringv(argv[i]));
|
janet_array_push(args, janet_cstringv(argv[i]));
|
||||||
janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments.");
|
janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments.");
|
||||||
|
|
||||||
/* Expose line getter */
|
|
||||||
janet_def(env, "getline", janet_wrap_cfunction(janet_line_getter), NULL);
|
|
||||||
janet_register("getline", janet_line_getter);
|
|
||||||
janet_line_init();
|
|
||||||
|
|
||||||
/* Run startup script */
|
/* Run startup script */
|
||||||
status = janet_dobytes(env, janet_gen_init, janet_gen_init_size, "init.janet", NULL);
|
status = janet_dobytes(env, janet_gen_init, janet_gen_init_size, "init.janet", NULL);
|
||||||
|
|
||||||
|
|||||||
@@ -20,7 +20,7 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <emscripten.h>
|
#include <emscripten.h>
|
||||||
|
|
||||||
extern const unsigned char *janet_gen_webinit;
|
extern const unsigned char *janet_gen_webinit;
|
||||||
@@ -70,7 +70,7 @@ void repl_init(void) {
|
|||||||
janet_init();
|
janet_init();
|
||||||
janet_register("repl-yield", repl_yield);
|
janet_register("repl-yield", repl_yield);
|
||||||
janet_register("js", cfun_js);
|
janet_register("js", cfun_js);
|
||||||
env = janet_core_env();
|
env = janet_core_env(NULL);
|
||||||
|
|
||||||
janet_def(env, "repl-yield", janet_wrap_cfunction(repl_yield), NULL);
|
janet_def(env, "repl-yield", janet_wrap_cfunction(repl_yield), NULL);
|
||||||
janet_def(env, "js", janet_wrap_cfunction(cfun_js), NULL);
|
janet_def(env, "js", janet_wrap_cfunction(cfun_js), NULL);
|
||||||
|
|||||||
@@ -3,9 +3,10 @@
|
|||||||
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
||||||
|
|
||||||
(fiber/new (fn webrepl []
|
(fiber/new (fn webrepl []
|
||||||
|
(setdyn :pretty-format "%.20P")
|
||||||
(repl (fn get-line [buf p]
|
(repl (fn get-line [buf p]
|
||||||
(def offset (parser/where p))
|
(def offset (parser/where p))
|
||||||
(def prompt (string "janet:" offset ":" (parser/state p) "> "))
|
(def prompt (string "janet:" offset ":" (parser/state p :delimiters) "> "))
|
||||||
(repl-yield prompt buf)
|
(repl-yield prompt buf)
|
||||||
(yield)
|
(yield)
|
||||||
buf))))
|
buf))))
|
||||||
|
|||||||
36
test/amalg/main.c
Normal file
36
test/amalg/main.c
Normal file
@@ -0,0 +1,36 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 Calvin Rose
|
||||||
|
*
|
||||||
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
* of this software and associated documentation files (the "Software"), to
|
||||||
|
* deal in the Software without restriction, including without limitation the
|
||||||
|
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||||
|
* sell copies of the Software, and to permit persons to whom the Software is
|
||||||
|
* furnished to do so, subject to the following conditions:
|
||||||
|
*
|
||||||
|
* The above copyright notice and this permission notice shall be included in
|
||||||
|
* all copies or substantial portions of the Software.
|
||||||
|
*
|
||||||
|
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||||
|
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
|
* IN THE SOFTWARE.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/* A simple client for checking if the amalgamated Janet source compiles
|
||||||
|
* correctly. */
|
||||||
|
|
||||||
|
#include <janet.h>
|
||||||
|
|
||||||
|
int main(int argc, const char *argv[]) {
|
||||||
|
(void) argc;
|
||||||
|
(void) argv;
|
||||||
|
janet_init();
|
||||||
|
JanetTable *env = janet_core_env(NULL);
|
||||||
|
janet_dostring(env, "(print `hello, world!`)", "main", NULL);
|
||||||
|
janet_deinit();
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
@@ -26,6 +26,11 @@
|
|||||||
(def errsym (keyword (gensym)))
|
(def errsym (keyword (gensym)))
|
||||||
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||||
|
|
||||||
|
(defmacro assert-no-error
|
||||||
|
[msg & forms]
|
||||||
|
(def errsym (keyword (gensym)))
|
||||||
|
~(assert (not= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||||
|
|
||||||
(defn start-suite [x]
|
(defn start-suite [x]
|
||||||
(set suite-num x)
|
(set suite-num x)
|
||||||
(print "\nRunning test suite " x " tests...\n "))
|
(print "\nRunning test suite " x " tests...\n "))
|
||||||
|
|||||||
1
test/install/.gitignore
vendored
Normal file
1
test/install/.gitignore
vendored
Normal file
@@ -0,0 +1 @@
|
|||||||
|
/build
|
||||||
7
test/install/project.janet
Normal file
7
test/install/project.janet
Normal file
@@ -0,0 +1,7 @@
|
|||||||
|
(declare-project
|
||||||
|
:name "testmod")
|
||||||
|
|
||||||
|
(declare-native
|
||||||
|
:name "testmod"
|
||||||
|
:source @["testmod.c"])
|
||||||
|
|
||||||
3
test/install/test/test1.janet
Normal file
3
test/install/test/test1.janet
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
(import build/testmod :as testmod)
|
||||||
|
|
||||||
|
(if (not= 5 (testmod/get5)) (error "testmod/get5 failed"))
|
||||||
40
test/install/testmod.c
Normal file
40
test/install/testmod.c
Normal file
@@ -0,0 +1,40 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 Calvin Rose and contributors
|
||||||
|
*
|
||||||
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
* of this software and associated documentation files (the "Software"), to
|
||||||
|
* deal in the Software without restriction, including without limitation the
|
||||||
|
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||||
|
* sell copies of the Software, and to permit persons to whom the Software is
|
||||||
|
* furnished to do so, subject to the following conditions:
|
||||||
|
*
|
||||||
|
* The above copyright notice and this permission notice shall be included in
|
||||||
|
* all copies or substantial portions of the Software.
|
||||||
|
*
|
||||||
|
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||||
|
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
|
* IN THE SOFTWARE.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/* A very simple native module */
|
||||||
|
|
||||||
|
#include <janet.h>
|
||||||
|
|
||||||
|
static Janet cfun_get_five(int32_t argc, Janet *argv) {
|
||||||
|
(void) argv;
|
||||||
|
janet_fixarity(argc, 0);
|
||||||
|
return janet_wrap_number(5.0);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg array_cfuns[] = {
|
||||||
|
{"get5", cfun_get_five, NULL},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
JANET_MODULE_ENTRY(JanetTable *env) {
|
||||||
|
janet_cfuns(env, NULL, array_cfuns);
|
||||||
|
}
|
||||||
@@ -18,7 +18,7 @@
|
|||||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
# IN THE SOFTWARE.
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
(import test/helper :prefix "" :exit true)
|
(import ./helper :prefix "" :exit true)
|
||||||
(start-suite 0)
|
(start-suite 0)
|
||||||
|
|
||||||
(assert (= 10 (+ 1 2 3 4)) "addition")
|
(assert (= 10 (+ 1 2 3 4)) "addition")
|
||||||
@@ -300,5 +300,8 @@
|
|||||||
(assert (= (length {1 2 3 nil}) 1) "nil value struct literal")
|
(assert (= (length {1 2 3 nil}) 1) "nil value struct literal")
|
||||||
(assert (= (length @{1 2 3 nil}) 1) "nil value table literal")
|
(assert (= (length @{1 2 3 nil}) 1) "nil value table literal")
|
||||||
|
|
||||||
|
# Regression Test
|
||||||
|
(assert (= 1 (((compile '(fn [] 1) @{})))) "regression test")
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
|
||||||
|
|||||||
@@ -18,7 +18,7 @@
|
|||||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
# IN THE SOFTWARE.
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
(import test/helper :prefix "" :exit true)
|
(import ./helper :prefix "" :exit true)
|
||||||
(start-suite 1)
|
(start-suite 1)
|
||||||
|
|
||||||
(assert (= 400 (math/sqrt 160000)) "sqrt(160000)=400")
|
(assert (= 400 (math/sqrt 160000)) "sqrt(160000)=400")
|
||||||
@@ -97,8 +97,8 @@
|
|||||||
# of the triangle to the leaves of the triangle.
|
# of the triangle to the leaves of the triangle.
|
||||||
|
|
||||||
(defn myfold [xs ys]
|
(defn myfold [xs ys]
|
||||||
(let [xs1 (tuple/prepend xs 0)
|
(let [xs1 [;xs 0]
|
||||||
xs2 (tuple/append xs 0)
|
xs2 [0 ;xs]
|
||||||
m1 (map + xs1 ys)
|
m1 (map + xs1 ys)
|
||||||
m2 (map + xs2 ys)]
|
m2 (map + xs2 ys)]
|
||||||
(map max m1 m2)))
|
(map max m1 m2)))
|
||||||
@@ -140,7 +140,7 @@
|
|||||||
|
|
||||||
# Marshal
|
# Marshal
|
||||||
|
|
||||||
(def um-lookup (env-lookup *env*))
|
(def um-lookup (env-lookup (fiber/getenv (fiber/current))))
|
||||||
(def m-lookup (invert um-lookup))
|
(def m-lookup (invert um-lookup))
|
||||||
|
|
||||||
(defn testmarsh [x msg]
|
(defn testmarsh [x msg]
|
||||||
@@ -175,10 +175,14 @@
|
|||||||
(testmarsh (fiber/new (fn [] (yield 1) 2)) "marshal simple fiber 1")
|
(testmarsh (fiber/new (fn [] (yield 1) 2)) "marshal simple fiber 1")
|
||||||
(testmarsh (fiber/new (fn [&] (yield 1) 2)) "marshal simple fiber 2")
|
(testmarsh (fiber/new (fn [&] (yield 1) 2)) "marshal simple fiber 2")
|
||||||
|
|
||||||
|
(def strct {:a @[nil]})
|
||||||
|
(put (strct :a) 0 strct)
|
||||||
|
(testmarsh strct "cyclic struct")
|
||||||
|
|
||||||
# Large functions
|
# Large functions
|
||||||
(def manydefs (seq [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))
|
(def manydefs (seq [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))
|
||||||
(array/push manydefs (tuple * 10000 3 5 7 9))
|
(array/push manydefs (tuple * 10000 3 5 7 9))
|
||||||
(def f (compile (tuple/prepend manydefs 'do) *env*))
|
(def f (compile ['do ;manydefs] (fiber/getenv (fiber/current))))
|
||||||
(assert (= (f) (* 10000 3 5 7 9)) "long function compilation")
|
(assert (= (f) (* 10000 3 5 7 9)) "long function compilation")
|
||||||
|
|
||||||
# Some higher order functions and macros
|
# Some higher order functions and macros
|
||||||
@@ -212,6 +216,9 @@
|
|||||||
(def xs (apply tuple (seq [x :range [0 10] :when (even? x)] (tuple (/ x 2) x))))
|
(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")
|
(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")
|
||||||
|
|
||||||
# Some testing for not=
|
# Some testing for not=
|
||||||
(assert (not= 1 1 0) "not= 1")
|
(assert (not= 1 1 0) "not= 1")
|
||||||
(assert (not= 0 1 1) "not= 2")
|
(assert (not= 0 1 1) "not= 2")
|
||||||
|
|||||||
@@ -18,7 +18,7 @@
|
|||||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
# IN THE SOFTWARE.
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
(import test/helper :prefix "" :exit true)
|
(import ./helper :prefix "" :exit true)
|
||||||
(start-suite 2)
|
(start-suite 2)
|
||||||
|
|
||||||
# Buffer stuff
|
# Buffer stuff
|
||||||
@@ -64,6 +64,12 @@
|
|||||||
(assert (= 3 (string/find "abc" " abcdefghijklmnop")) "string/find 1")
|
(assert (= 3 (string/find "abc" " abcdefghijklmnop")) "string/find 1")
|
||||||
(assert (= nil (string/find "" "")) "string/find 2")
|
(assert (= nil (string/find "" "")) "string/find 2")
|
||||||
(assert (= 0 (string/find "A" "A")) "string/find 3")
|
(assert (= 0 (string/find "A" "A")) "string/find 3")
|
||||||
|
(assert (string/has-prefix? "" "foo") "string/has-prefix? 1")
|
||||||
|
(assert (string/has-prefix? "fo" "foo") "string/has-prefix? 2")
|
||||||
|
(assert (not (string/has-prefix? "o" "foo")) "string/has-prefix? 3")
|
||||||
|
(assert (string/has-suffix? "" "foo") "string/has-suffix? 1")
|
||||||
|
(assert (string/has-suffix? "oo" "foo") "string/has-suffix? 2")
|
||||||
|
(assert (not (string/has-suffix? "f" "foo")) "string/has-suffix? 3")
|
||||||
(assert (= (string/replace "X" "." "XXX...XXX...XXX") ".XX...XXX...XXX") "string/replace 1")
|
(assert (= (string/replace "X" "." "XXX...XXX...XXX") ".XX...XXX...XXX") "string/replace 1")
|
||||||
(assert (= (string/replace-all "X" "." "XXX...XXX...XXX") "...............") "string/replace-all 1")
|
(assert (= (string/replace-all "X" "." "XXX...XXX...XXX") "...............") "string/replace-all 1")
|
||||||
(assert (= (string/replace-all "XX" "." "XXX...XXX...XXX") ".X....X....X") "string/replace-all 2")
|
(assert (= (string/replace-all "XX" "." "XXX...XXX...XXX") ".X....X....X") "string/replace-all 2")
|
||||||
@@ -77,6 +83,16 @@
|
|||||||
(assert (= (string/join @["one" "two" "three"] ", ") "one, two, three") "string/join 2")
|
(assert (= (string/join @["one" "two" "three"] ", ") "one, two, three") "string/join 2")
|
||||||
(assert (= (string/join @["one" "two" "three"]) "onetwothree") "string/join 3")
|
(assert (= (string/join @["one" "two" "three"]) "onetwothree") "string/join 3")
|
||||||
(assert (= (string/join @[] "hi") "") "string/join 4")
|
(assert (= (string/join @[] "hi") "") "string/join 4")
|
||||||
|
(assert (= (string/trim " abcd ") "abcd") "string/trim 1")
|
||||||
|
(assert (= (string/trim "abcd \t\t\r\f") "abcd") "string/trim 2")
|
||||||
|
(assert (= (string/trim "\n\n\t abcd") "abcd") "string/trim 3")
|
||||||
|
(assert (= (string/trim "") "") "string/trim 4")
|
||||||
|
(assert (= (string/triml " abcd ") "abcd ") "string/triml 1")
|
||||||
|
(assert (= (string/triml "\tabcd \t\t\r\f") "abcd \t\t\r\f") "string/triml 2")
|
||||||
|
(assert (= (string/triml "abcd ") "abcd ") "string/triml 3")
|
||||||
|
(assert (= (string/trimr " abcd ") " abcd") "string/trimr 1")
|
||||||
|
(assert (= (string/trimr "\tabcd \t\t\r\f") "\tabcd") "string/trimr 2")
|
||||||
|
(assert (= (string/trimr " abcd") " abcd") "string/trimr 3")
|
||||||
(assert (deep= (string/split "," "one,two,three") @["one" "two" "three"]) "string/split 1")
|
(assert (deep= (string/split "," "one,two,three") @["one" "two" "three"]) "string/split 1")
|
||||||
(assert (deep= (string/split "," "onetwothree") @["onetwothree"]) "string/split 2")
|
(assert (deep= (string/split "," "onetwothree") @["onetwothree"]) "string/split 2")
|
||||||
(assert (deep= (string/find-all "e" "onetwothree") @[2 9 10]) "string/find-all 1")
|
(assert (deep= (string/find-all "e" "onetwothree") @[2 9 10]) "string/find-all 1")
|
||||||
|
|||||||
@@ -18,7 +18,7 @@
|
|||||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
# IN THE SOFTWARE.
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
(import test/helper :prefix "" :exit true)
|
(import ./helper :prefix "" :exit true)
|
||||||
(start-suite 3)
|
(start-suite 3)
|
||||||
|
|
||||||
(assert (= (length (range 10)) 10) "(range 10)")
|
(assert (= (length (range 10)) 10) "(range 10)")
|
||||||
@@ -159,6 +159,14 @@
|
|||||||
(buffer/blit b2 "abcdefg" 5 6)
|
(buffer/blit b2 "abcdefg" 5 6)
|
||||||
(assert (= (string b2) "joytogjoyto") "buffer/blit 3")
|
(assert (= (string b2) "joytogjoyto") "buffer/blit 3")
|
||||||
|
|
||||||
|
# Buffer self blitting, check for use after free
|
||||||
|
(def buf1 @"1234567890")
|
||||||
|
(buffer/blit buf1 buf1 -1)
|
||||||
|
(buffer/blit buf1 buf1 -1)
|
||||||
|
(buffer/blit buf1 buf1 -1)
|
||||||
|
(buffer/blit buf1 buf1 -1)
|
||||||
|
(assert (= (string buf1) (string/repeat "1234567890" 16)) "buffer blit against self")
|
||||||
|
|
||||||
# Buffer push word
|
# Buffer push word
|
||||||
|
|
||||||
(def b3 @"")
|
(def b3 @"")
|
||||||
@@ -170,6 +178,22 @@
|
|||||||
(assert (= 8 (length b3)) "buffer/push-word 3")
|
(assert (= 8 (length b3)) "buffer/push-word 3")
|
||||||
(assert (= "\xFF\xFF\xFF\xFF\0\x11\0\0" (string b3)) "buffer/push-word 4")
|
(assert (= "\xFF\xFF\xFF\xFF\0\x11\0\0" (string b3)) "buffer/push-word 4")
|
||||||
|
|
||||||
|
# Buffer push string
|
||||||
|
|
||||||
|
(def b4 (buffer/new-filled 10 0))
|
||||||
|
(buffer/push-string b4 b4)
|
||||||
|
(assert (= "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" (string b4)) "buffer/push-buffer 1")
|
||||||
|
(def b5 @"123")
|
||||||
|
(buffer/push-string b5 "456" @"789")
|
||||||
|
(assert (= "123456789" (string b5)) "buffer/push-buffer 2")
|
||||||
|
|
||||||
|
# Check for bugs with printing self with buffer/format
|
||||||
|
|
||||||
|
(def buftemp @"abcd")
|
||||||
|
(assert (= (string (buffer/format buftemp "---%p---" buftemp)) `abcd---@"abcd"---`) "buffer/format on self 1")
|
||||||
|
(def buftemp @"abcd")
|
||||||
|
(assert (= (string (buffer/format buftemp "---%p %p---" buftemp buftemp)) `abcd---@"abcd" @"abcd"---`) "buffer/format on self 2")
|
||||||
|
|
||||||
# Peg
|
# Peg
|
||||||
|
|
||||||
(defn check-match
|
(defn check-match
|
||||||
@@ -351,6 +375,12 @@
|
|||||||
(def t (put @{} :hi 1))
|
(def t (put @{} :hi 1))
|
||||||
(assert (deep= t @{:hi 1}) "regression #24")
|
(assert (deep= t @{:hi 1}) "regression #24")
|
||||||
|
|
||||||
|
# Peg swallowing errors
|
||||||
|
(assert (try (peg/match ~(/ '1 ,(fn [x] (nil x))) "x") ([err] err))
|
||||||
|
"errors should not be swallowed")
|
||||||
|
(assert (try ((fn [x] (nil x))) ([err] err))
|
||||||
|
"errors should not be swallowed 2")
|
||||||
|
|
||||||
# Tuple types
|
# Tuple types
|
||||||
|
|
||||||
(assert (= (tuple/type '(1 2 3)) :parens) "normal tuple")
|
(assert (= (tuple/type '(1 2 3)) :parens) "normal tuple")
|
||||||
|
|||||||
@@ -18,7 +18,7 @@
|
|||||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
# IN THE SOFTWARE.
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
(import test/helper :prefix "" :exit true)
|
(import ./helper :prefix "" :exit true)
|
||||||
(start-suite 4)
|
(start-suite 4)
|
||||||
# some tests for string/format and buffer/format
|
# some tests for string/format and buffer/format
|
||||||
|
|
||||||
@@ -38,5 +38,35 @@
|
|||||||
(assert (= (string/format "π = %.8g" math/pi) "π = 3.1415927") "π")
|
(assert (= (string/format "π = %.8g" math/pi) "π = 3.1415927") "π")
|
||||||
(assert (= (string/format "\xCF\x80 = %.8g" math/pi) "\xCF\x80 = 3.1415927") "\xCF\x80")
|
(assert (= (string/format "\xCF\x80 = %.8g" math/pi) "\xCF\x80 = 3.1415927") "\xCF\x80")
|
||||||
|
|
||||||
|
# Range
|
||||||
|
(assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "range 1 argument")
|
||||||
|
(assert (deep= (range 5 10) @[5 6 7 8 9]) "range 2 arguments")
|
||||||
|
(assert (deep= (range 5 10 2) @[5 7 9]) "range 3 arguments")
|
||||||
|
|
||||||
|
# More marshalling code
|
||||||
|
|
||||||
|
(defn check-image
|
||||||
|
"Run a marshaling test using the make-image and load-image functions."
|
||||||
|
[x msg]
|
||||||
|
(assert-no-error msg (load-image (make-image x))))
|
||||||
|
|
||||||
|
(check-image (fn [] (fn [] 1)) "marshal nested functions")
|
||||||
|
(check-image (fiber/new (fn [] (fn [] 1))) "marshal nested functions in fiber")
|
||||||
|
(check-image (fiber/new (fn [] (fiber/new (fn [] 1)))) "marshal nested fibers")
|
||||||
|
|
||||||
|
(def issue-53-x
|
||||||
|
(fiber/new
|
||||||
|
(fn []
|
||||||
|
(var y (fiber/new (fn [] (print "1") (yield) (print "2")))))))
|
||||||
|
|
||||||
|
(check-image issue-53-x "issue 53 regression")
|
||||||
|
|
||||||
|
# Bracket tuple issue
|
||||||
|
|
||||||
|
(def do 3)
|
||||||
|
(assert (= [3 1 2 3] [do 1 2 3]) "bracket tuples are never special forms")
|
||||||
|
(assert (= ~(,defn 1 2 3) [defn 1 2 3]) "bracket tuples are never macros")
|
||||||
|
(assert (= ~(,+ 1 2 3) [+ 1 2 3]) "bracket tuples are never function calls")
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
|
||||||
|
|||||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user