mirror of
https://github.com/janet-lang/janet
synced 2025-10-28 06:07:43 +00:00
Compare commits
318 Commits
v1.21.1
...
localbindi
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
9476016741 | ||
|
|
7a1c9c7798 | ||
|
|
c7fb7b4451 | ||
|
|
67c474fc7a | ||
|
|
4e8154cf8a | ||
|
|
9582d3c623 | ||
|
|
0079500713 | ||
|
|
55af6ce834 | ||
|
|
3e82fdc125 | ||
|
|
7344a6cfc0 | ||
|
|
0aded71343 | ||
|
|
7663b1e703 | ||
|
|
282546c03f | ||
|
|
f4bc89d1c0 | ||
|
|
fa277c3797 | ||
|
|
c0c8ab25e6 | ||
|
|
b685bf3026 | ||
|
|
ce31db09e4 | ||
|
|
624a6cf619 | ||
|
|
587aa87d28 | ||
|
|
88813c4f87 | ||
|
|
dacbe29771 | ||
|
|
244833cfa1 | ||
|
|
05e7f974e3 | ||
|
|
0dbef65a73 | ||
|
|
9106228787 | ||
|
|
6ae3bdb25c | ||
|
|
310bcec260 | ||
|
|
8c4cc4e671 | ||
|
|
c6eaaa83ed | ||
|
|
8f598d6f96 | ||
|
|
20bc323d17 | ||
|
|
8b0bcf4db9 | ||
|
|
8955e6f536 | ||
|
|
f8ddea6452 | ||
|
|
987e04086d | ||
|
|
85f2acbf52 | ||
|
|
1acf4c3ab7 | ||
|
|
07a3158fba | ||
|
|
2f8bed9d82 | ||
|
|
a490937cd9 | ||
|
|
8ee5942481 | ||
|
|
93b469885a | ||
|
|
d8d1de2dcb | ||
|
|
ab224514f0 | ||
|
|
75179de8da | ||
|
|
c28df14e6b | ||
|
|
b73855b193 | ||
|
|
2093ab2baa | ||
|
|
a0f40042cb | ||
|
|
3254c2c477 | ||
|
|
0a8eb9e3ba | ||
|
|
70e0c6f9ef | ||
|
|
a8a78d4525 | ||
|
|
57e6ee963d | ||
|
|
ce6bfb8420 | ||
|
|
f0672bdc59 | ||
|
|
23de953fbd | ||
|
|
03c496bdd8 | ||
|
|
d5ee6cf521 | ||
|
|
fb7981e053 | ||
|
|
846123ecab | ||
|
|
373cb444fe | ||
|
|
90f212df92 | ||
|
|
12286e4246 | ||
|
|
aa60c1f36a | ||
|
|
c731f01067 | ||
|
|
6c9c1cdb30 | ||
|
|
9ba2b40e87 | ||
|
|
7a3d055012 | ||
|
|
0824f45e29 | ||
|
|
4debe3446c | ||
|
|
07fe9bcdf6 | ||
|
|
6a557a73f5 | ||
|
|
8d1cfe0c56 | ||
|
|
a3a42eebea | ||
|
|
76be8006a4 | ||
|
|
bfcfd58259 | ||
|
|
914a4360e7 | ||
|
|
8c31874eeb | ||
|
|
ef7afeb2ea | ||
|
|
4067f883a2 | ||
|
|
c8974fffbe | ||
|
|
b75fb8dc9e | ||
|
|
57356781a9 | ||
|
|
e43eab5fd6 | ||
|
|
894cd0e022 | ||
|
|
db2c63fffc | ||
|
|
60e0f32f1a | ||
|
|
e731996a68 | ||
|
|
2f69cd4209 | ||
|
|
fd59de25c5 | ||
|
|
af12c3d41a | ||
|
|
54b52bbeb5 | ||
|
|
1174c68d9a | ||
|
|
448ea7167f | ||
|
|
6b27008c99 | ||
|
|
725c785882 | ||
|
|
ab068cff67 | ||
|
|
9dc03adfda | ||
|
|
49f9e4eddf | ||
|
|
43c47ac44c | ||
|
|
1cebe64664 | ||
|
|
f33c381043 | ||
|
|
3479841c77 | ||
|
|
6a899968a9 | ||
|
|
bb8405a36e | ||
|
|
c7bc711f63 | ||
|
|
e326071c35 | ||
|
|
ad6a669381 | ||
|
|
e4c9dafc9a | ||
|
|
dfc0aefd87 | ||
|
|
356b39c6f5 | ||
|
|
8da7bb6b68 | ||
|
|
9341081a4d | ||
|
|
324a086eb4 | ||
|
|
ed595f52c2 | ||
|
|
64ad0023bb | ||
|
|
fe5f661d15 | ||
|
|
ff26e3a8ba | ||
|
|
14657a762c | ||
|
|
4754fa3902 | ||
|
|
f302f87337 | ||
|
|
94dbcde292 | ||
|
|
4336a174b1 | ||
|
|
0adb13ed71 | ||
|
|
03ba1f7021 | ||
|
|
1f7f20788c | ||
|
|
c59dd29190 | ||
|
|
99f63a41a3 | ||
|
|
a575f5df36 | ||
|
|
0817e627ee | ||
|
|
14d90239a7 | ||
|
|
f5d11dc656 | ||
|
|
6dcf5bf077 | ||
|
|
ac2082e9b3 | ||
|
|
dbac495bee | ||
|
|
fe5ccb163e | ||
|
|
1aea5ee007 | ||
|
|
13cd9f8067 | ||
|
|
34496ecaf0 | ||
|
|
c043b1d949 | ||
|
|
9a6d2a7b32 | ||
|
|
f8a9efa8e4 | ||
|
|
5b2169e0d1 | ||
|
|
2c927ea768 | ||
|
|
f4bbcdcbc8 | ||
|
|
79c375b1af | ||
|
|
f443a3b3a1 | ||
|
|
684d2d63f4 | ||
|
|
1900d8f843 | ||
|
|
3c2af95d21 | ||
|
|
b35414ea0f | ||
|
|
fb5b056f7b | ||
|
|
7248c1dfdb | ||
|
|
4c7ea9e893 | ||
|
|
c7801ce277 | ||
|
|
f741a8e3ff | ||
|
|
6a92e8b609 | ||
|
|
9da91a8217 | ||
|
|
69853c8e5c | ||
|
|
1f41b6c138 | ||
|
|
e001efa9fd | ||
|
|
435e64d4cf | ||
|
|
f296c8f5fb | ||
|
|
8d0e6ed32f | ||
|
|
b6a36afffe | ||
|
|
e422abc269 | ||
|
|
221d71d07b | ||
|
|
9f35f0837e | ||
|
|
515891b035 | ||
|
|
94a506876f | ||
|
|
9bde57854a | ||
|
|
f456369941 | ||
|
|
8f0a1ffe5d | ||
|
|
e4bafc621a | ||
|
|
cfa39ab3b0 | ||
|
|
47e91bfd89 | ||
|
|
eecc388ebd | ||
|
|
0a15a5ee56 | ||
|
|
cfaae47cea | ||
|
|
c1a0352592 | ||
|
|
965f45aa3f | ||
|
|
6ea27fe836 | ||
|
|
0dccc22b38 | ||
|
|
cbe833962b | ||
|
|
b5720f6f10 | ||
|
|
56b4e0b0ec | ||
|
|
e316ccb1e0 | ||
|
|
a6f93efd39 | ||
|
|
20511cf608 | ||
|
|
1a1dd39367 | ||
|
|
589981bdcb | ||
|
|
89546776b2 | ||
|
|
f0d7b3cd12 | ||
|
|
e37be627e0 | ||
|
|
d803561582 | ||
|
|
a1aab4008f | ||
|
|
a1172529bf | ||
|
|
1d905bf07f | ||
|
|
eed678a14b | ||
|
|
b1bdffbc34 | ||
|
|
cff718f37d | ||
|
|
40e9430278 | ||
|
|
62fc55fc74 | ||
|
|
80729353c8 | ||
|
|
105ba5e124 | ||
|
|
ad1b50d1f5 | ||
|
|
1905437abe | ||
|
|
87fc339c45 | ||
|
|
3af7d61d3e | ||
|
|
a45ef7a856 | ||
|
|
299998055d | ||
|
|
c9586d39ed | ||
|
|
2e9f67f4e4 | ||
|
|
e318170fea | ||
|
|
73c4289792 | ||
|
|
ea45d7ee47 | ||
|
|
6d970725e7 | ||
|
|
458c2c6d88 | ||
|
|
0cc53a8964 | ||
|
|
0bc96304a9 | ||
|
|
c75b088ff8 | ||
|
|
181f0341f5 | ||
|
|
33bb08d53b | ||
|
|
6d188f6e44 | ||
|
|
c3648331f1 | ||
|
|
a5b66029d3 | ||
|
|
49bfe80191 | ||
|
|
a5def77bfe | ||
|
|
9ecb5b4791 | ||
|
|
1cc48a370a | ||
|
|
f1ec8d1e11 | ||
|
|
55c34cd84f | ||
|
|
aca52d1e36 | ||
|
|
6f90df26a5 | ||
|
|
9d9cb378ff | ||
|
|
f92aac14aa | ||
|
|
3f27d78ab5 | ||
|
|
282d1ba22f | ||
|
|
94c19575b1 | ||
|
|
e3e485285b | ||
|
|
986e36720e | ||
|
|
74348ab6c2 | ||
|
|
8d1ad99f42 | ||
|
|
e69bbff195 | ||
|
|
c9f33bbde0 | ||
|
|
9c9f9d4fa6 | ||
|
|
2f64a6b0cb | ||
|
|
dfa78ad3c6 | ||
|
|
677ae46f0c | ||
|
|
6ada2a458f | ||
|
|
8145f3b68d | ||
|
|
48289acee6 | ||
|
|
e5a989c6f9 | ||
|
|
4c56704935 | ||
|
|
9cda44f443 | ||
|
|
431451bac2 | ||
|
|
395ca7feea | ||
|
|
e0b7533c39 | ||
|
|
5b2a402930 | ||
|
|
85129a1873 | ||
|
|
487d333024 | ||
|
|
fe7d35171f | ||
|
|
b3aed13567 | ||
|
|
a9d4d2bfa3 | ||
|
|
1ff521683f | ||
|
|
0395a03b6b | ||
|
|
7fda7709ff | ||
|
|
65a9200cff | ||
|
|
473eec26c1 | ||
|
|
9fa945ad93 | ||
|
|
a895219d2f | ||
|
|
427f7c362e | ||
|
|
73f5c41fae | ||
|
|
b4ec168401 | ||
|
|
726d35c766 | ||
|
|
6db796e10c | ||
|
|
c38d9134cd | ||
|
|
471204b163 | ||
|
|
7f23bfa66d | ||
|
|
9287b26042 | ||
|
|
e22936fbf8 | ||
|
|
04ace9fc16 | ||
|
|
8466b333fb | ||
|
|
96602612ba | ||
|
|
690b98bff9 | ||
|
|
8329131bfe | ||
|
|
9986aab326 | ||
|
|
0b105bc535 | ||
|
|
51ac9c9506 | ||
|
|
0310176696 | ||
|
|
84a7a2bc3e | ||
|
|
1e66a7e555 | ||
|
|
2bffb9d682 | ||
|
|
811125a760 | ||
|
|
0dd91082a1 | ||
|
|
c80587868e | ||
|
|
8c52dc86c7 | ||
|
|
be24592bc3 | ||
|
|
0d1a5c621d | ||
|
|
8a3eff3b65 | ||
|
|
b1050b884d | ||
|
|
181d883a1d | ||
|
|
e01b65fd3d | ||
|
|
bbd74b5ae2 | ||
|
|
d5a5c49357 | ||
|
|
a964b164a6 | ||
|
|
1aac0489d7 | ||
|
|
e474755887 | ||
|
|
bf9a60f70d | ||
|
|
a2ba0913d3 | ||
|
|
f74df41fff | ||
|
|
2a950e4ce9 | ||
|
|
f05e5f908e | ||
|
|
43139b43b1 | ||
|
|
5811b47aad | ||
|
|
54e3db4d8c |
@@ -13,7 +13,7 @@ tasks:
|
||||
gmake test-install
|
||||
- meson_min: |
|
||||
cd janet
|
||||
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dtyped_array=false -Dreduced_os=true
|
||||
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dreduced_os=true -Dffi=false
|
||||
cd build_meson_min
|
||||
ninja
|
||||
- meson_prf: |
|
||||
|
||||
3
.gitattributes
vendored
3
.gitattributes
vendored
@@ -1,5 +1,4 @@
|
||||
*.janet linguist-language=Clojure
|
||||
|
||||
*.janet linguist-language=Janet
|
||||
*.janet text eol=lf
|
||||
*.c text eol=lf
|
||||
*.h text eol=lf
|
||||
|
||||
41
.github/workflows/codeql.yml
vendored
Normal file
41
.github/workflows/codeql.yml
vendored
Normal file
@@ -0,0 +1,41 @@
|
||||
name: "CodeQL"
|
||||
|
||||
on:
|
||||
push:
|
||||
branches: [ "master" ]
|
||||
pull_request:
|
||||
branches: [ "master" ]
|
||||
schedule:
|
||||
- cron: "2 7 * * 4"
|
||||
|
||||
jobs:
|
||||
analyze:
|
||||
name: Analyze
|
||||
runs-on: ubuntu-latest
|
||||
permissions:
|
||||
actions: read
|
||||
contents: read
|
||||
security-events: write
|
||||
|
||||
strategy:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
language: [ cpp ]
|
||||
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v3
|
||||
|
||||
- name: Initialize CodeQL
|
||||
uses: github/codeql-action/init@v2
|
||||
with:
|
||||
languages: ${{ matrix.language }}
|
||||
queries: +security-and-quality
|
||||
|
||||
- name: Autobuild
|
||||
uses: github/codeql-action/autobuild@v2
|
||||
|
||||
- name: Perform CodeQL Analysis
|
||||
uses: github/codeql-action/analyze@v2
|
||||
with:
|
||||
category: "/language:${{ matrix.language }}"
|
||||
7
.github/workflows/release.yml
vendored
7
.github/workflows/release.yml
vendored
@@ -5,9 +5,14 @@ on:
|
||||
tags:
|
||||
- "v*.*.*"
|
||||
|
||||
permissions:
|
||||
contents: read
|
||||
|
||||
jobs:
|
||||
|
||||
release:
|
||||
permissions:
|
||||
contents: write # for softprops/action-gh-release to create GitHub release
|
||||
name: Build release binaries
|
||||
runs-on: ${{ matrix.os }}
|
||||
strategy:
|
||||
@@ -35,6 +40,8 @@ jobs:
|
||||
build/c/shell.c
|
||||
|
||||
release-windows:
|
||||
permissions:
|
||||
contents: write # for softprops/action-gh-release to create GitHub release
|
||||
name: Build release binaries for windows
|
||||
runs-on: windows-latest
|
||||
steps:
|
||||
|
||||
25
.github/workflows/test.yml
vendored
25
.github/workflows/test.yml
vendored
@@ -2,6 +2,9 @@ name: Test
|
||||
|
||||
on: [push, pull_request]
|
||||
|
||||
permissions:
|
||||
contents: read
|
||||
|
||||
jobs:
|
||||
|
||||
test-posix:
|
||||
@@ -32,3 +35,25 @@ jobs:
|
||||
- name: Test the project
|
||||
shell: cmd
|
||||
run: build_win test
|
||||
|
||||
test-mingw:
|
||||
name: Build on Windows with Mingw (no test yet)
|
||||
runs-on: windows-latest
|
||||
defaults:
|
||||
run:
|
||||
shell: msys2 {0}
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
- name: Setup Mingw
|
||||
uses: msys2/setup-msys2@v2
|
||||
with:
|
||||
msystem: UCRT64
|
||||
update: true
|
||||
install: >-
|
||||
base-devel
|
||||
git
|
||||
gcc
|
||||
- name: Build the project
|
||||
shell: cmd
|
||||
run: make -j CC=gcc
|
||||
|
||||
5
.gitignore
vendored
5
.gitignore
vendored
@@ -68,10 +68,13 @@ tags
|
||||
vgcore.*
|
||||
*.out.*
|
||||
|
||||
# Wix artifacts
|
||||
# WiX artifacts
|
||||
*.msi
|
||||
*.wixpdb
|
||||
|
||||
# Makefile config
|
||||
/config.mk
|
||||
|
||||
# Created by https://www.gitignore.io/api/c
|
||||
|
||||
### C ###
|
||||
|
||||
77
CHANGELOG.md
77
CHANGELOG.md
@@ -1,7 +1,82 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## 1.21.1 - 2022-03-27
|
||||
## ??? - Unreleased
|
||||
- Add build-time detection for cygwin.
|
||||
|
||||
## 1.26.0 - 2023-01-07
|
||||
- Add `ffi/malloc` and `ffi/free`. Useful as tools of last resort.
|
||||
- Add `ffi/jitfn` to allow calling function pointers generated at runtime from machine code.
|
||||
Bring your own assembler, though.
|
||||
- Channels can now be marshalled. Pending state is not saved, only items in the channel.
|
||||
- Use the new `.length` function pointer on abstract types for lengths. Adding
|
||||
a `length` method will still work as well.
|
||||
- Support byte views on abstract types with the `.bytes` function pointer.
|
||||
- Add the `u` format specifier to printf family functions.
|
||||
- Allow printing 64 integer types in `printf` and `string/format` family functions.
|
||||
- Allow importing modules from custom directories more easily with the `@` prefix
|
||||
to module paths. For example, if there is a dynamic binding :custom-modules that
|
||||
is a file system path to a directory of modules, import from that directory with
|
||||
`(import @custom-modules/mymod)`.
|
||||
- Fix error message bug in FFI library.
|
||||
|
||||
## 1.25.1 - 2022-10-29
|
||||
- Add `memcmp` function to core library.
|
||||
- Fix bug in `os/open` with `:rw` permissions not correct on Linux.
|
||||
- Support config.mk for more easily configuring the Makefile.
|
||||
|
||||
## 1.25.0 - 2022-10-10
|
||||
- Windows FFI fixes.
|
||||
- Fix PEG `if-not` combinator with captures in the condition
|
||||
- Fix bug with `os/date` with nil first argument
|
||||
- Fix bug with `net/accept` on Linux that could leak file descriptors to subprocesses
|
||||
- Reduce number of hash collisions from pointer hashing
|
||||
- Add optional parameter to `marshal` to skip cycle checking code
|
||||
|
||||
## 1.24.1 - 2022-08-24
|
||||
- Fix FFI bug on Linux/Posix
|
||||
- Improve parse error messages for bad delimiters.
|
||||
- Add optional `name` parameter to the `short-fn` macro.
|
||||
|
||||
## 1.24.0 - 2022-08-14
|
||||
- Add FFI support to 64-bit windows compiled with MSVC
|
||||
- Don't process shared object names passed to dlopen.
|
||||
- Add better support for windows console in the default shell.c for auto-completion and
|
||||
other shell-like input features.
|
||||
- Improve default error message from `assert`.
|
||||
- Add the `tabseq` macro for simpler table comprehensions.
|
||||
- Allow setting `(dyn :task-id)` in fibers to improve context in supervisor messages. Prior to
|
||||
this change, supervisor messages over threaded channels would be from ambiguous threads/fibers.
|
||||
|
||||
## 1.23.0 - 2022-06-20
|
||||
- Add experimental `ffi/` module for interfacing with dynamic libraries and raw function pointers. Only available
|
||||
on 64 bit linux, mac, and bsd systems.
|
||||
- Allow using `&named` in function prototypes for named arguments. This is a more ergonomic
|
||||
variant of `&keys` that isn't as redundant, more self documenting, and allows extension to
|
||||
things like default arguments.
|
||||
- Add `delay` macro for lazy evaluate-and-save thunks.
|
||||
- Remove pthread.h from janet.h for easier includes.
|
||||
- Add `debugger` - an easy to use debugger function that just takes a fiber.
|
||||
- `dofile` will now start a debugger on errors if the environment it is passed has `:debug` set.
|
||||
- Add `debugger-on-status` function, which can be passed to `run-context` to start a debugger on
|
||||
abnormal fiber signals.
|
||||
- Allow running scripts with the `-d` flag to use the built-in debugger on errors and breakpoints.
|
||||
- Add mutexes (locks) and reader-writer locks to ev module for thread coordination.
|
||||
- Add `parse-all` as a generalization of the `parse` function.
|
||||
- Add `os/cpu-count` to get the number of available processors on a machine
|
||||
|
||||
## 1.22.0 - 2022-05-09
|
||||
- Prohibit negative size argument to `table/new`.
|
||||
- Add `module/value`.
|
||||
- Remove `file/popen`. Use `os/spawn` with the `:pipe` options instead.
|
||||
- Fix bug in peg `thru` and `to` combinators.
|
||||
- Fix printing issue in `doc` macro.
|
||||
- Numerous updates to function docstrings
|
||||
- Add `defdyn` aliases for various dynamic bindings used in core.
|
||||
- Install `janet.h` symlink to make Janet native libraries and applications
|
||||
easier to build without `jpm`.
|
||||
|
||||
## 1.21.2 - 2022-04-01
|
||||
- C functions `janet_dobytes` and `janet_dostring` will now enter the event loop if it is enabled.
|
||||
- Fix hashing regression - hash of negative 0 must be the same as positive 0 since they are equal.
|
||||
- The `flycheck` function no longer pollutes the module/cache
|
||||
|
||||
@@ -43,7 +43,7 @@ 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
|
||||
omissions.
|
||||
|
||||
* No `restrict`
|
||||
* No `restrict`
|
||||
* Certain functions in the standard library are not always available
|
||||
|
||||
In practice, this means programming for both MSVC on one hand and everything else on the other.
|
||||
@@ -64,6 +64,23 @@ ensure a consistent code style for C.
|
||||
All janet code in the project should be formatted similar to the code in core.janet.
|
||||
The auto formatting from janet.vim will work well.
|
||||
|
||||
## Typo Fixing and One-Line changes
|
||||
|
||||
Typo fixes are welcome, as are simple one line fixes. Do not open many separate pull requests for each
|
||||
individual typo fix. This is incredibly annoying to deal with as someone needs to review each PR, run
|
||||
CI, and merge. Instead, accumulate batches of typo fixes into a single PR. If there are objections to
|
||||
specific changes, these can be addressed in the review process before the final merge, if the changes
|
||||
are accepted.
|
||||
|
||||
Similarly, low effort and bad faith changes are annoying to developers and such issues may be closed
|
||||
immediately without response.
|
||||
|
||||
## Contributions from Automated Tools
|
||||
|
||||
People making changes found or generated by automated tools MUST note this when opening an issue
|
||||
or creating a pull request. This can help give context to developers if the change/issue is
|
||||
confusing or nonsensical.
|
||||
|
||||
## Suggesting Changes
|
||||
|
||||
To suggest changes, open an issue on GitHub. Check GitHub for other issues
|
||||
|
||||
2
LICENSE
2
LICENSE
@@ -1,4 +1,4 @@
|
||||
Copyright (c) 2021 Calvin Rose and contributors
|
||||
Copyright (c) 2023 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
|
||||
|
||||
49
Makefile
49
Makefile
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,15 +21,17 @@
|
||||
################################
|
||||
##### Set global variables #####
|
||||
################################
|
||||
|
||||
sinclude config.mk
|
||||
PREFIX?=/usr/local
|
||||
|
||||
JANETCONF_HEADER?=src/conf/janetconf.h
|
||||
INCLUDEDIR?=$(PREFIX)/include
|
||||
BINDIR?=$(PREFIX)/bin
|
||||
LIBDIR?=$(PREFIX)/lib
|
||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 2> /dev/null || echo local)\""
|
||||
CLIBS=-lm -lpthread
|
||||
JANET_TARGET=build/janet
|
||||
JANET_IMPORT_LIB=build/janet.lib
|
||||
JANET_LIBRARY=build/libjanet.so
|
||||
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||
JANET_PATH?=$(LIBDIR)/janet
|
||||
@@ -58,6 +60,7 @@ UNAME:=$(shell uname -s)
|
||||
ifeq ($(UNAME), Darwin)
|
||||
CLIBS:=$(CLIBS) -ldl
|
||||
SONAME_SETTER:=-Wl,-install_name,
|
||||
JANET_LIBRARY=build/libjanet.dylib
|
||||
LDCONFIG:=true
|
||||
else ifeq ($(UNAME), Linux)
|
||||
CLIBS:=$(CLIBS) -lrt -ldl
|
||||
@@ -75,6 +78,12 @@ ifeq ($(shell uname -o), Android)
|
||||
endif
|
||||
endif
|
||||
|
||||
# Mingw
|
||||
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
|
||||
CLIBS:=-lws2_32 -lpsapi -lwsock32
|
||||
LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB)
|
||||
endif
|
||||
|
||||
$(shell mkdir -p build/core build/c build/boot)
|
||||
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
|
||||
|
||||
@@ -82,7 +91,7 @@ all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
|
||||
##### Name Files #####
|
||||
######################
|
||||
|
||||
JANET_HEADERS=src/include/janet.h src/conf/janetconf.h
|
||||
JANET_HEADERS=src/include/janet.h $(JANETCONF_HEADER)
|
||||
|
||||
JANET_LOCAL_HEADERS=src/core/features.h \
|
||||
src/core/util.h \
|
||||
@@ -107,6 +116,7 @@ JANET_CORE_SOURCES=src/core/abstract.c \
|
||||
src/core/debug.c \
|
||||
src/core/emit.c \
|
||||
src/core/ev.c \
|
||||
src/core/ffi.c \
|
||||
src/core/fiber.c \
|
||||
src/core/gc.c \
|
||||
src/core/inttypes.c \
|
||||
@@ -165,21 +175,25 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1.20
|
||||
ifeq ($(UNAME), Darwin)
|
||||
SONAME=libjanet.1.26.dylib
|
||||
else
|
||||
SONAME=libjanet.so.1.26
|
||||
endif
|
||||
|
||||
build/c/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
|
||||
build/janet.h: $(JANET_TARGET) src/include/janet.h src/conf/janetconf.h
|
||||
./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h src/conf/janetconf.h $@
|
||||
build/janet.h: $(JANET_TARGET) src/include/janet.h $(JANETCONF_HEADER)
|
||||
./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h $(JANETCONF_HEADER) $@
|
||||
|
||||
build/janetconf.h: src/conf/janetconf.h
|
||||
build/janetconf.h: $(JANETCONF_HEADER)
|
||||
cp $< $@
|
||||
|
||||
build/janet.o: build/c/janet.c src/conf/janetconf.h src/include/janet.h
|
||||
build/janet.o: build/c/janet.c $(JANETCONF_HEADER) src/include/janet.h
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
|
||||
|
||||
build/shell.o: build/c/shell.c src/conf/janetconf.h src/include/janet.h
|
||||
build/shell.o: build/c/shell.c $(JANETCONF_HEADER) src/include/janet.h
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
|
||||
|
||||
$(JANET_TARGET): build/janet.o build/shell.o
|
||||
@@ -277,17 +291,25 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
|
||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
ln -sf -T ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h' || true #fixme bsd
|
||||
mkdir -p '$(DESTDIR)$(JANET_PATH)'
|
||||
mkdir -p '$(DESTDIR)$(LIBDIR)'
|
||||
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
|
||||
if test $(UNAME) = Darwin ; then \
|
||||
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib' ; \
|
||||
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.dylib' ; \
|
||||
ln -sf libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
|
||||
else \
|
||||
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')' ; \
|
||||
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so' ; \
|
||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
|
||||
fi
|
||||
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
|
||||
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
|
||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
|
||||
mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
|
||||
cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
|
||||
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
|
||||
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
||||
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
|
||||
cp '$(JANET_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)'
|
||||
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || echo "You can ignore this error for non-Linux systems or local installs"
|
||||
|
||||
install-jpm-git: $(JANET_TARGET)
|
||||
mkdir -p build
|
||||
@@ -304,6 +326,7 @@ install-jpm-git: $(JANET_TARGET)
|
||||
uninstall:
|
||||
-rm '$(DESTDIR)$(BINDIR)/janet'
|
||||
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet.h'
|
||||
-rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.*
|
||||
-rm '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
||||
-rm '$(DESTDIR)$(JANET_MANPATH)/janet.1'
|
||||
|
||||
10
README.md
10
README.md
@@ -1,7 +1,7 @@
|
||||
[](https://gitter.im/janet-language/community)
|
||||
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml?)
|
||||
[](https://github.com/janet-lang/janet/actions/workflows/test.yml)
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
@@ -89,6 +89,8 @@ cd somewhere/my/projects/janet
|
||||
make
|
||||
make test
|
||||
make repl
|
||||
make install
|
||||
make install-jpm-git
|
||||
```
|
||||
|
||||
Find out more about the available make targets by running `make help`.
|
||||
@@ -103,6 +105,8 @@ cd somewhere/my/projects/janet
|
||||
make CC=gcc-x86
|
||||
make test
|
||||
make repl
|
||||
make install
|
||||
make install-jpm-git
|
||||
```
|
||||
|
||||
### FreeBSD
|
||||
@@ -116,6 +120,8 @@ cd somewhere/my/projects/janet
|
||||
gmake
|
||||
gmake test
|
||||
gmake repl
|
||||
gmake install
|
||||
gmake install-jpm-git
|
||||
```
|
||||
|
||||
### NetBSD
|
||||
|
||||
45
examples/evlocks.janet
Normal file
45
examples/evlocks.janet
Normal file
@@ -0,0 +1,45 @@
|
||||
(defn sleep
|
||||
"Sleep the entire thread, not just a single fiber."
|
||||
[n]
|
||||
(os/sleep (* 0.1 n)))
|
||||
|
||||
(defn work [lock n]
|
||||
(ev/acquire-lock lock)
|
||||
(print "working " n "...")
|
||||
(sleep n)
|
||||
(print "done working...")
|
||||
(ev/release-lock lock))
|
||||
|
||||
(defn reader
|
||||
[rwlock n]
|
||||
(ev/acquire-rlock rwlock)
|
||||
(print "reading " n "...")
|
||||
(sleep n)
|
||||
(print "done reading " n "...")
|
||||
(ev/release-rlock rwlock))
|
||||
|
||||
(defn writer
|
||||
[rwlock n]
|
||||
(ev/acquire-wlock rwlock)
|
||||
(print "writing " n "...")
|
||||
(sleep n)
|
||||
(print "done writing...")
|
||||
(ev/release-wlock rwlock))
|
||||
|
||||
(defn test-lock
|
||||
[]
|
||||
(def lock (ev/lock))
|
||||
(for i 3 7
|
||||
(ev/spawn-thread
|
||||
(work lock i))))
|
||||
|
||||
(defn test-rwlock
|
||||
[]
|
||||
(def rwlock (ev/rwlock))
|
||||
(for i 0 20
|
||||
(if (> 0.1 (math/random))
|
||||
(ev/spawn-thread (writer rwlock i))
|
||||
(ev/spawn-thread (reader rwlock i)))))
|
||||
|
||||
(test-rwlock)
|
||||
(test-lock)
|
||||
71
examples/ffi/gtk.janet
Normal file
71
examples/ffi/gtk.janet
Normal file
@@ -0,0 +1,71 @@
|
||||
# :lazy true needed for jpm quickbin
|
||||
# lazily loads library on first function use
|
||||
# so the `main` function
|
||||
# can be marshalled.
|
||||
(ffi/context "/usr/lib/libgtk-3.so" :lazy true)
|
||||
|
||||
(ffi/defbind
|
||||
gtk-application-new :ptr
|
||||
"Add docstrings as needed."
|
||||
[title :string flags :uint])
|
||||
|
||||
(ffi/defbind
|
||||
g-signal-connect-data :ulong
|
||||
[a :ptr b :ptr c :ptr d :ptr e :ptr f :int])
|
||||
|
||||
(ffi/defbind
|
||||
g-application-run :int
|
||||
[app :ptr argc :int argv :ptr])
|
||||
|
||||
(ffi/defbind
|
||||
gtk-application-window-new :ptr
|
||||
[a :ptr])
|
||||
|
||||
(ffi/defbind
|
||||
gtk-button-new-with-label :ptr
|
||||
[a :ptr])
|
||||
|
||||
(ffi/defbind
|
||||
gtk-container-add :void
|
||||
[a :ptr b :ptr])
|
||||
|
||||
(ffi/defbind
|
||||
gtk-widget-show-all :void
|
||||
[a :ptr])
|
||||
|
||||
(ffi/defbind
|
||||
gtk-button-set-label :void
|
||||
[a :ptr b :ptr])
|
||||
|
||||
(def cb (delay (ffi/trampoline :default)))
|
||||
|
||||
(defn ffi/array
|
||||
``Convert a janet array to a buffer that can be passed to FFI functions.
|
||||
For example, to create an array of type `char *` (array of c strings), one
|
||||
could use `(ffi/array ["hello" "world"] :ptr)`. One needs to be careful that
|
||||
array elements are not garbage collected though - the GC can't follow references
|
||||
inside an arbitrary byte buffer.``
|
||||
[arr ctype &opt buf]
|
||||
(default buf @"")
|
||||
(each el arr
|
||||
(ffi/write ctype el buf))
|
||||
buf)
|
||||
|
||||
(defn on-active
|
||||
[app]
|
||||
(def window (gtk-application-window-new app))
|
||||
(def btn (gtk-button-new-with-label "Click Me!"))
|
||||
(g-signal-connect-data btn "clicked" (cb)
|
||||
(fn [btn] (gtk-button-set-label btn "Hello World"))
|
||||
nil 1)
|
||||
(gtk-container-add window btn)
|
||||
(gtk-widget-show-all window))
|
||||
|
||||
(defn main
|
||||
[&]
|
||||
(def app (gtk-application-new "org.janet-lang.example.HelloApp" 0))
|
||||
(g-signal-connect-data app "activate" (cb) on-active nil 1)
|
||||
# manually build an array with ffi/write
|
||||
# - we are responsible for preventing gc when the arg array is used
|
||||
(def argv (ffi/array (dyn *args*) :string))
|
||||
(g-application-run app (length (dyn *args*)) argv))
|
||||
208
examples/ffi/so.c
Normal file
208
examples/ffi/so.c
Normal file
@@ -0,0 +1,208 @@
|
||||
#include <stdio.h>
|
||||
#include <stdint.h>
|
||||
#include <string.h>
|
||||
|
||||
#ifdef _WIN32
|
||||
#define EXPORTER __declspec(dllexport)
|
||||
#else
|
||||
#define EXPORTER
|
||||
#endif
|
||||
|
||||
/* Structs */
|
||||
|
||||
typedef struct {
|
||||
int a, b;
|
||||
float c, d;
|
||||
} Split;
|
||||
|
||||
typedef struct {
|
||||
float c, d;
|
||||
int a, b;
|
||||
} SplitFlip;
|
||||
|
||||
typedef struct {
|
||||
int u, v, w, x, y, z;
|
||||
} SixInts;
|
||||
|
||||
typedef struct {
|
||||
int a;
|
||||
int b;
|
||||
} intint;
|
||||
|
||||
typedef struct {
|
||||
int a;
|
||||
int b;
|
||||
int c;
|
||||
} intintint;
|
||||
|
||||
typedef struct {
|
||||
int64_t a;
|
||||
int64_t b;
|
||||
int64_t c;
|
||||
} big;
|
||||
|
||||
/* Functions */
|
||||
|
||||
EXPORTER
|
||||
int int_fn(int a, int b) {
|
||||
return (a << 2) + b;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
double my_fn(int64_t a, int64_t b, const char *x) {
|
||||
return (double)(a + b) + 0.5 + strlen(x);
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
double double_fn(double x, double y, double z) {
|
||||
return (x + y) * z * 3;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
double double_many(double x, double y, double z, double w, double a, double b) {
|
||||
return x + y + z + w + a + b;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
double double_lots(
|
||||
double a,
|
||||
double b,
|
||||
double c,
|
||||
double d,
|
||||
double e,
|
||||
double f,
|
||||
double g,
|
||||
double h,
|
||||
double i,
|
||||
double j) {
|
||||
return i + j;
|
||||
}
|
||||
|
||||
|
||||
EXPORTER
|
||||
double double_lots_2(
|
||||
double a,
|
||||
double b,
|
||||
double c,
|
||||
double d,
|
||||
double e,
|
||||
double f,
|
||||
double g,
|
||||
double h,
|
||||
double i,
|
||||
double j) {
|
||||
return a +
|
||||
10.0 * b +
|
||||
100.0 * c +
|
||||
1000.0 * d +
|
||||
10000.0 * e +
|
||||
100000.0 * f +
|
||||
1000000.0 * g +
|
||||
10000000.0 * h +
|
||||
100000000.0 * i +
|
||||
1000000000.0 * j;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
double float_fn(float x, float y, float z) {
|
||||
return (x + y) * z;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
int intint_fn(double x, intint ii) {
|
||||
printf("double: %g\n", x);
|
||||
return ii.a + ii.b;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
int intintint_fn(double x, intintint iii) {
|
||||
printf("double: %g\n", x);
|
||||
return iii.a + iii.b + iii.c;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
intint return_struct(int i) {
|
||||
intint ret;
|
||||
ret.a = i;
|
||||
ret.b = i * i;
|
||||
return ret;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
big struct_big(int i, double d) {
|
||||
big ret;
|
||||
ret.a = i;
|
||||
ret.b = (int64_t) d;
|
||||
ret.c = ret.a + ret.b + 1000;
|
||||
return ret;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
void void_fn(void) {
|
||||
printf("void fn ran\n");
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
void void_fn_2(double y) {
|
||||
printf("y = %f\n", y);
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
void void_ret_fn(int x) {
|
||||
printf("void fn ran: %d\n", x);
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
int intintint_fn_2(intintint iii, int i) {
|
||||
fprintf(stderr, "iii.a = %d, iii.b = %d, iii.c = %d, i = %d\n", iii.a, iii.b, iii.c, i);
|
||||
return i * (iii.a + iii.b + iii.c);
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
float split_fn(Split s) {
|
||||
return s.a * s.c + s.b * s.d;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
float split_flip_fn(SplitFlip s) {
|
||||
return s.a * s.c + s.b * s.d;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
Split split_ret_fn(int x, float y) {
|
||||
Split ret;
|
||||
ret.a = x;
|
||||
ret.b = x;
|
||||
ret.c = y;
|
||||
ret.d = y;
|
||||
return ret;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
SplitFlip split_flip_ret_fn(int x, float y) {
|
||||
SplitFlip ret;
|
||||
ret.a = x;
|
||||
ret.b = x;
|
||||
ret.c = y;
|
||||
ret.d = y;
|
||||
return ret;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
SixInts sixints_fn(void) {
|
||||
return (SixInts) {
|
||||
6666, 1111, 2222, 3333, 4444, 5555
|
||||
};
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
int sixints_fn_2(int x, SixInts s) {
|
||||
return x + s.u + s.v + s.w + s.x + s.y + s.z;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
int sixints_fn_3(SixInts s, int x) {
|
||||
return x + s.u + s.v + s.w + s.x + s.y + s.z;
|
||||
}
|
||||
|
||||
|
||||
134
examples/ffi/test.janet
Normal file
134
examples/ffi/test.janet
Normal file
@@ -0,0 +1,134 @@
|
||||
#
|
||||
# Simple FFI test script that tests against a simple shared object
|
||||
#
|
||||
|
||||
(def is-windows (= :windows (os/which)))
|
||||
(def ffi/loc (string "examples/ffi/so." (if is-windows "dll" "so")))
|
||||
(def ffi/source-loc "examples/ffi/so.c")
|
||||
|
||||
(if is-windows
|
||||
(os/execute ["cl.exe" "/nologo" "/LD" ffi/source-loc "/link" "/DLL" (string "/OUT:" ffi/loc)] :px)
|
||||
(os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px))
|
||||
|
||||
(ffi/context ffi/loc)
|
||||
|
||||
(def intintint (ffi/struct :int :int :int))
|
||||
(def big (ffi/struct :s64 :s64 :s64))
|
||||
(def split (ffi/struct :int :int :float :float))
|
||||
(def split-flip (ffi/struct :float :float :int :int))
|
||||
(def six-ints (ffi/struct :int :int :int :int :int :int))
|
||||
|
||||
(ffi/defbind int-fn :int [a :int b :int])
|
||||
(ffi/defbind double-fn :double [a :double b :double c :double])
|
||||
(ffi/defbind double-many :double
|
||||
[x :double y :double z :double w :double a :double b :double])
|
||||
(ffi/defbind double-lots :double
|
||||
[a :double b :double c :double d :double e :double f :double g :double h :double i :double j :double])
|
||||
(ffi/defbind float-fn :double
|
||||
[x :float y :float z :float])
|
||||
(ffi/defbind intint-fn :int
|
||||
[x :double ii [:int :int]])
|
||||
(ffi/defbind return-struct [:int :int]
|
||||
[i :int])
|
||||
(ffi/defbind intintint-fn :int
|
||||
[x :double iii intintint])
|
||||
(ffi/defbind struct-big big
|
||||
[i :int d :double])
|
||||
(ffi/defbind void-fn :void [])
|
||||
(ffi/defbind double-lots-2 :double
|
||||
[a :double
|
||||
b :double
|
||||
c :double
|
||||
d :double
|
||||
e :double
|
||||
f :double
|
||||
g :double
|
||||
h :double
|
||||
i :double
|
||||
j :double])
|
||||
(ffi/defbind void-fn-2 :void [y :double])
|
||||
(ffi/defbind intintint-fn-2 :int [iii intintint i :int])
|
||||
(ffi/defbind split-fn :float [s split])
|
||||
(ffi/defbind split-flip-fn :float [s split-flip])
|
||||
(ffi/defbind split-ret-fn split [x :int y :float])
|
||||
(ffi/defbind split-flip-ret-fn split-flip [x :int y :float])
|
||||
(ffi/defbind sixints-fn six-ints [])
|
||||
(ffi/defbind sixints-fn-2 :int [x :int s six-ints])
|
||||
(ffi/defbind sixints-fn-3 :int [s six-ints x :int])
|
||||
|
||||
#
|
||||
# Struct reading and writing
|
||||
#
|
||||
|
||||
(defn check-round-trip
|
||||
[t value]
|
||||
(def buf (ffi/write t value))
|
||||
(def same-value (ffi/read t buf))
|
||||
(assert (deep= value same-value)
|
||||
(string/format "round trip %j (got %j)" value same-value)))
|
||||
|
||||
(check-round-trip :bool true)
|
||||
(check-round-trip :bool false)
|
||||
(check-round-trip :void nil)
|
||||
(check-round-trip :void nil)
|
||||
(check-round-trip :s8 10)
|
||||
(check-round-trip :s8 0)
|
||||
(check-round-trip :s8 -10)
|
||||
(check-round-trip :u8 10)
|
||||
(check-round-trip :u8 0)
|
||||
(check-round-trip :s16 10)
|
||||
(check-round-trip :s16 0)
|
||||
(check-round-trip :s16 -12312)
|
||||
(check-round-trip :u16 10)
|
||||
(check-round-trip :u16 0)
|
||||
(check-round-trip :u32 0)
|
||||
(check-round-trip :u32 10)
|
||||
(check-round-trip :u32 0xFFFF7777)
|
||||
(check-round-trip :s32 0x7FFF7777)
|
||||
(check-round-trip :s32 0)
|
||||
(check-round-trip :s32 -1234567)
|
||||
|
||||
(def s (ffi/struct :s8 :s8 :s8 :float))
|
||||
(check-round-trip s [1 3 5 123.5])
|
||||
(check-round-trip s [-1 -3 -5 -123.5])
|
||||
|
||||
#
|
||||
# Call functions
|
||||
#
|
||||
|
||||
(tracev (sixints-fn))
|
||||
(tracev (sixints-fn-2 100 [1 2 3 4 5 6]))
|
||||
(tracev (sixints-fn-3 [1 2 3 4 5 6] 200))
|
||||
(tracev (split-ret-fn 10 12))
|
||||
(tracev (split-flip-ret-fn 10 12))
|
||||
(tracev (split-flip-ret-fn 12 10))
|
||||
(tracev (intintint-fn-2 [10 20 30] 3))
|
||||
(tracev (split-fn [5 6 1.2 3.4]))
|
||||
(tracev (void-fn-2 10.3))
|
||||
(tracev (double-many 1 2 3 4 5 6))
|
||||
(tracev (string/format "%.17g" (double-many 1 2 3 4 5 6)))
|
||||
(tracev (type (double-many 1 2 3 4 5 6)))
|
||||
(tracev (double-lots-2 0 1 2 3 4 5 6 7 8 9))
|
||||
(tracev (void-fn))
|
||||
(tracev (int-fn 10 20))
|
||||
(tracev (double-fn 1.5 2.5 3.5))
|
||||
(tracev (double-lots 1 2 3 4 5 6 7 8 9 10))
|
||||
(tracev (float-fn 8 4 17))
|
||||
(tracev (intint-fn 123.456 [10 20]))
|
||||
(tracev (intintint-fn 123.456 [10 20 30]))
|
||||
(tracev (return-struct 42))
|
||||
(tracev (double-lots 1 2 3 4 5 6 700 800 9 10))
|
||||
(tracev (struct-big 11 99.5))
|
||||
|
||||
(assert (= [10 10 12 12] (split-ret-fn 10 12)))
|
||||
(assert (= [12 12 10 10] (split-flip-ret-fn 10 12)))
|
||||
(assert (= 183 (intintint-fn-2 [10 20 31] 3)))
|
||||
(assert (= 264 (math/round (* 10 (split-fn [5 6 1.2 3.4])))))
|
||||
(assert (= 9876543210 (double-lots-2 0 1 2 3 4 5 6 7 8 9)))
|
||||
(assert (= 60 (int-fn 10 20)))
|
||||
(assert (= 42 (double-fn 1.5 2.5 3.5)))
|
||||
(assert (= 21 (math/round (double-many 1 2 3 4 5 6.01))))
|
||||
(assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10)))
|
||||
(assert (= 204 (float-fn 8 4 17)))
|
||||
|
||||
(print "Done.")
|
||||
7
examples/ffi/win32.janet
Normal file
7
examples/ffi/win32.janet
Normal file
@@ -0,0 +1,7 @@
|
||||
(ffi/context "user32.dll")
|
||||
|
||||
(ffi/defbind MessageBoxA :int
|
||||
[w :ptr text :string cap :string typ :int])
|
||||
|
||||
(MessageBoxA nil "Hello, World!" "Test" 0)
|
||||
|
||||
BIN
examples/jitfn/hello.bin
Normal file
BIN
examples/jitfn/hello.bin
Normal file
Binary file not shown.
17
examples/jitfn/hello.nasm
Normal file
17
examples/jitfn/hello.nasm
Normal file
@@ -0,0 +1,17 @@
|
||||
BITS 64
|
||||
|
||||
;;;
|
||||
;;; Code
|
||||
;;;
|
||||
mov rax, 1 ; write(
|
||||
mov rdi, 1 ; STDOUT_FILENO,
|
||||
lea rsi, [rel msg] ; msg,
|
||||
mov rdx, msglen ; sizeof(msg)
|
||||
syscall ; );
|
||||
ret ; return;
|
||||
|
||||
;;;
|
||||
;;; Constants
|
||||
;;;
|
||||
msg: db "Hello, world!", 10
|
||||
msglen: equ $ - msg
|
||||
13
examples/jitfn/jitfn.janet
Normal file
13
examples/jitfn/jitfn.janet
Normal file
@@ -0,0 +1,13 @@
|
||||
###
|
||||
### Relies on NASM being installed to assemble code.
|
||||
### Only works on x86-64 Linux.
|
||||
###
|
||||
### Before running, compile hello.nasm to hello.bin with
|
||||
### $ nasm hello.nasm -o hello.bin
|
||||
|
||||
(def bin (slurp "hello.bin"))
|
||||
(def f (ffi/jitfn bin))
|
||||
(def signature (ffi/signature :default :void))
|
||||
(ffi/call f signature)
|
||||
(print "called a jitted function with FFI!")
|
||||
(print "machine code: " (describe (string/slice f)))
|
||||
2
examples/lineloop.janet
Normal file
2
examples/lineloop.janet
Normal file
@@ -0,0 +1,2 @@
|
||||
(while (not (empty? (def line (getline))))
|
||||
(prin "line: " line))
|
||||
30
examples/marshal-stress.janet
Normal file
30
examples/marshal-stress.janet
Normal file
@@ -0,0 +1,30 @@
|
||||
(defn init-db [c]
|
||||
(def res @{:clients @{}})
|
||||
(var i 0)
|
||||
(repeat c
|
||||
(def n (string "client" i))
|
||||
(put-in res [:clients n] @{:name n :projects @{}})
|
||||
(++ i)
|
||||
(repeat c
|
||||
(def pn (string "project" i))
|
||||
(put-in res [:clients n :projects pn] @{:name pn})
|
||||
(++ i)
|
||||
(repeat c
|
||||
(def tn (string "task" i))
|
||||
(put-in res [:clients n :projects pn :tasks tn] @{:name pn})
|
||||
(++ i))))
|
||||
res)
|
||||
|
||||
(loop [c :range [30 80 1]]
|
||||
(var s (os/clock))
|
||||
(print "Marshal DB with " c " clients, "
|
||||
(* c c) " projects and "
|
||||
(* c c c) " tasks. "
|
||||
"Total " (+ (* c c c) (* c c) c) " tables")
|
||||
(def buf (marshal (init-db c) @{} @""))
|
||||
(print "Buffer is " (length buf) " bytes")
|
||||
(print "Duration " (- (os/clock) s))
|
||||
(set s (os/clock))
|
||||
(gccollect)
|
||||
(print "Collected garbage in " (- (os/clock) s)))
|
||||
|
||||
7
janet.1
7
janet.1
@@ -164,10 +164,15 @@ Execute a string of Janet source. Source code is executed in the order it is enc
|
||||
arguments are executed before later ones.
|
||||
|
||||
.TP
|
||||
.BR \-E\ code arguments
|
||||
.BR \-E\ code\ arguments...
|
||||
Execute a single Janet expression as a Janet short-fn, passing the remaining command line arguments to the expression. This allows
|
||||
more concise one-liners with command line arguments.
|
||||
|
||||
Example: janet -E '(print $0)' 12 is equivalent to '((short-fn (print $0)) 12)', which is in turn equivalent to
|
||||
`((fn [k] (print k)) 12)`
|
||||
|
||||
See docs for the `short-fn` function for more details.
|
||||
|
||||
.TP
|
||||
.BR \-d
|
||||
Enable debug mode. On all terminating signals as well the debug signal, this will
|
||||
|
||||
19
meson.build
19
meson.build
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose and contributors
|
||||
# Copyright (c) 2023 Calvin Rose and contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.21.0')
|
||||
version : '1.26.1')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -76,6 +76,8 @@ conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline'))
|
||||
conf.set('JANET_EV_NO_EPOLL', not get_option('epoll'))
|
||||
conf.set('JANET_EV_NO_KQUEUE', not get_option('kqueue'))
|
||||
conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt'))
|
||||
conf.set('JANET_NO_FFI', not get_option('ffi'))
|
||||
conf.set('JANET_NO_FFI_JIT', not get_option('ffi_jit'))
|
||||
if get_option('os_name') != ''
|
||||
conf.set('JANET_OS_NAME', get_option('os_name'))
|
||||
endif
|
||||
@@ -116,6 +118,7 @@ core_src = [
|
||||
'src/core/debug.c',
|
||||
'src/core/emit.c',
|
||||
'src/core/ev.c',
|
||||
'src/core/ffi.c',
|
||||
'src/core/fiber.c',
|
||||
'src/core/gc.c',
|
||||
'src/core/inttypes.c',
|
||||
@@ -234,7 +237,11 @@ test_files = [
|
||||
'test/suite0007.janet',
|
||||
'test/suite0008.janet',
|
||||
'test/suite0009.janet',
|
||||
'test/suite0010.janet'
|
||||
'test/suite0010.janet',
|
||||
'test/suite0011.janet',
|
||||
'test/suite0012.janet',
|
||||
'test/suite0013.janet',
|
||||
'test/suite0014.janet'
|
||||
]
|
||||
foreach t : test_files
|
||||
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
|
||||
@@ -263,3 +270,9 @@ patched_janet = custom_target('patched-janeth',
|
||||
build_by_default : true,
|
||||
output : ['janet.h'],
|
||||
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@'])
|
||||
|
||||
# Create a version of the janet.h header that matches what jpm often expects
|
||||
if meson.version().version_compare('>=0.61')
|
||||
install_symlink('janet.h', pointing_to: 'janet/janet.h', install_dir: get_option('includedir'))
|
||||
endif
|
||||
|
||||
|
||||
@@ -19,6 +19,8 @@ option('simple_getline', type : 'boolean', value : false)
|
||||
option('epoll', type : 'boolean', value : false)
|
||||
option('kqueue', type : 'boolean', value : false)
|
||||
option('interpreter_interrupt', type : 'boolean', value : false)
|
||||
option('ffi', type : 'boolean', value : true)
|
||||
option('ffi_jit', 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)
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
|
||||
1170
src/boot/boot.janet
1170
src/boot/boot.janet
File diff suppressed because it is too large
Load Diff
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
|
||||
@@ -4,10 +4,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 21
|
||||
#define JANET_VERSION_MINOR 26
|
||||
#define JANET_VERSION_PATCH 1
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.21.1"
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.26.1-dev"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
@@ -33,6 +33,8 @@
|
||||
/* #define JANET_NO_SYMLINKS */
|
||||
/* #define JANET_NO_UMASK */
|
||||
/* #define JANET_NO_THREADS */
|
||||
/* #define JANET_NO_FFI */
|
||||
/* #define JANET_NO_FFI_JIT */
|
||||
|
||||
/* Other settings */
|
||||
/* #define JANET_DEBUG */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,12 +23,16 @@
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#include "gc.h"
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_EV
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#endif
|
||||
#else
|
||||
#include <stdatomic.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
@@ -85,12 +89,20 @@ void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size) {
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
size_t janet_os_mutex_size(void) {
|
||||
return sizeof(CRITICAL_SECTION);
|
||||
}
|
||||
|
||||
size_t janet_os_rwlock_size(void) {
|
||||
return sizeof(void *);
|
||||
}
|
||||
|
||||
static int32_t janet_incref(JanetAbstractHead *ab) {
|
||||
return InterlockedIncrement(&ab->gc.data.refcount);
|
||||
return InterlockedIncrement((LONG volatile *) &ab->gc.data.refcount);
|
||||
}
|
||||
|
||||
static int32_t janet_decref(JanetAbstractHead *ab) {
|
||||
return InterlockedDecrement(&ab->gc.data.refcount);
|
||||
return InterlockedDecrement((LONG volatile *) &ab->gc.data.refcount);
|
||||
}
|
||||
|
||||
void janet_os_mutex_init(JanetOSMutex *mutex) {
|
||||
@@ -106,11 +118,45 @@ void janet_os_mutex_lock(JanetOSMutex *mutex) {
|
||||
}
|
||||
|
||||
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
|
||||
/* error handling? May want to keep counter */
|
||||
LeaveCriticalSection((CRITICAL_SECTION *) mutex);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
|
||||
InitializeSRWLock((PSRWLOCK) rwlock);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) {
|
||||
/* no op? */
|
||||
(void) rwlock;
|
||||
}
|
||||
|
||||
void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) {
|
||||
AcquireSRWLockShared((PSRWLOCK) rwlock);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) {
|
||||
AcquireSRWLockExclusive((PSRWLOCK) rwlock);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) {
|
||||
ReleaseSRWLockShared((PSRWLOCK) rwlock);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
|
||||
ReleaseSRWLockExclusive((PSRWLOCK) rwlock);
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
size_t janet_os_mutex_size(void) {
|
||||
return sizeof(pthread_mutex_t);
|
||||
}
|
||||
|
||||
size_t janet_os_rwlock_size(void) {
|
||||
return sizeof(pthread_rwlock_t);
|
||||
}
|
||||
|
||||
static int32_t janet_incref(JanetAbstractHead *ab) {
|
||||
return __atomic_add_fetch(&ab->gc.data.refcount, 1, __ATOMIC_RELAXED);
|
||||
}
|
||||
@@ -120,19 +166,47 @@ static int32_t janet_decref(JanetAbstractHead *ab) {
|
||||
}
|
||||
|
||||
void janet_os_mutex_init(JanetOSMutex *mutex) {
|
||||
pthread_mutex_init(mutex, NULL);
|
||||
pthread_mutexattr_t attr;
|
||||
pthread_mutexattr_init(&attr);
|
||||
pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
|
||||
pthread_mutex_init((pthread_mutex_t *) mutex, &attr);
|
||||
}
|
||||
|
||||
void janet_os_mutex_deinit(JanetOSMutex *mutex) {
|
||||
pthread_mutex_destroy(mutex);
|
||||
pthread_mutex_destroy((pthread_mutex_t *) mutex);
|
||||
}
|
||||
|
||||
void janet_os_mutex_lock(JanetOSMutex *mutex) {
|
||||
pthread_mutex_lock(mutex);
|
||||
pthread_mutex_lock((pthread_mutex_t *) mutex);
|
||||
}
|
||||
|
||||
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
|
||||
pthread_mutex_unlock(mutex);
|
||||
int ret = pthread_mutex_unlock((pthread_mutex_t *) mutex);
|
||||
if (ret) janet_panic("cannot release lock");
|
||||
}
|
||||
|
||||
void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
|
||||
pthread_rwlock_init((pthread_rwlock_t *) rwlock, NULL);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) {
|
||||
pthread_rwlock_destroy((pthread_rwlock_t *) rwlock);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) {
|
||||
pthread_rwlock_rdlock((pthread_rwlock_t *) rwlock);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) {
|
||||
pthread_rwlock_wrlock((pthread_rwlock_t *) rwlock);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) {
|
||||
pthread_rwlock_unlock((pthread_rwlock_t *) rwlock);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
|
||||
pthread_rwlock_unlock((pthread_rwlock_t *) rwlock);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -125,7 +125,7 @@ Janet janet_array_peek(JanetArray *array) {
|
||||
JANET_CORE_FN(cfun_array_new,
|
||||
"(array/new capacity)",
|
||||
"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.") {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
JanetArray *array = janet_array(cap);
|
||||
@@ -136,7 +136,7 @@ JANET_CORE_FN(cfun_array_new_filled,
|
||||
"(array/new-filled count &opt value)",
|
||||
"Creates a new array of `count` elements, all set to `value`, which defaults to nil. Returns the new array.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
int32_t count = janet_getinteger(argv, 0);
|
||||
int32_t count = janet_getnat(argv, 0);
|
||||
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
|
||||
JanetArray *array = janet_array(count);
|
||||
for (int32_t i = 0; i < count; i++) {
|
||||
@@ -194,7 +194,7 @@ JANET_CORE_FN(cfun_array_push,
|
||||
JANET_CORE_FN(cfun_array_ensure,
|
||||
"(array/ensure arr capacity growth)",
|
||||
"Ensures that the memory backing the array is large enough for `capacity` "
|
||||
"items at the given rate of growth. Capacity and growth must be integers. "
|
||||
"items at the given rate of growth. `capacity` and `growth` must be integers. "
|
||||
"If the backing capacity is already enough, then this function does nothing. "
|
||||
"Otherwise, the backing memory will be reallocated so that there is enough space.") {
|
||||
janet_fixarity(argc, 3);
|
||||
|
||||
109
src/core/asm.c
109
src/core/asm.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -187,7 +187,11 @@ static void janet_asm_longjmp(JanetAssembler *a) {
|
||||
|
||||
/* Throw some kind of assembly error */
|
||||
static void janet_asm_error(JanetAssembler *a, const char *message) {
|
||||
a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex);
|
||||
if (a->errindex < 0) {
|
||||
a->errmessage = janet_formatc("%s", message);
|
||||
} else {
|
||||
a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex);
|
||||
}
|
||||
janet_asm_longjmp(a);
|
||||
}
|
||||
#define janet_asm_assert(a, c, m) do { if (!(c)) janet_asm_error((a), (m)); } while (0)
|
||||
@@ -516,6 +520,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
#endif
|
||||
if (NULL != a.parent) {
|
||||
janet_asm_deinit(&a);
|
||||
a.parent->errmessage = a.errmessage;
|
||||
janet_asm_longjmp(a.parent);
|
||||
}
|
||||
result.funcdef = NULL;
|
||||
@@ -553,6 +558,10 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
x = janet_get1(s, janet_ckeywordv("vararg"));
|
||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||
|
||||
/* Check structarg */
|
||||
x = janet_get1(s, janet_ckeywordv("structarg"));
|
||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
|
||||
/* Check source */
|
||||
x = janet_get1(s, janet_ckeywordv("source"));
|
||||
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
||||
@@ -597,6 +606,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
|
||||
/* Parse sub funcdefs */
|
||||
x = janet_get1(s, janet_ckeywordv("closures"));
|
||||
if (janet_checktype(x, JANET_NIL)) {
|
||||
x = janet_get1(s, janet_ckeywordv("defs"));
|
||||
}
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
int32_t i;
|
||||
for (i = 0; i < count; i++) {
|
||||
@@ -709,10 +721,63 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
}
|
||||
|
||||
/* Set symbolmap */
|
||||
def->symbolmap = NULL;
|
||||
def->symbolmap_length = 0;
|
||||
x = janet_get1(s, janet_ckeywordv("symbolmap"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
def->symbolmap_length = count;
|
||||
def->symbolmap = janet_malloc(sizeof(JanetSymbolMap) * (size_t)count);
|
||||
if (NULL == def->symbolmap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (i = 0; i < count; i++) {
|
||||
const Janet *tup;
|
||||
Janet entry = arr[i];
|
||||
JanetSymbolMap ss;
|
||||
if (!janet_checktype(entry, JANET_TUPLE)) {
|
||||
janet_asm_error(&a, "expected tuple");
|
||||
}
|
||||
tup = janet_unwrap_tuple(entry);
|
||||
if (janet_keyeq(tup[0], "upvalue")) {
|
||||
ss.birth_pc = UINT32_MAX;
|
||||
} else if (!janet_checkint(tup[0])) {
|
||||
janet_asm_error(&a, "expected integer");
|
||||
} else {
|
||||
ss.birth_pc = janet_unwrap_integer(tup[0]);
|
||||
}
|
||||
if (!janet_checkint(tup[1])) {
|
||||
janet_asm_error(&a, "expected integer");
|
||||
}
|
||||
if (!janet_checkint(tup[2])) {
|
||||
janet_asm_error(&a, "expected integer");
|
||||
}
|
||||
if (!janet_checktype(tup[3], JANET_SYMBOL)) {
|
||||
janet_asm_error(&a, "expected symbol");
|
||||
}
|
||||
ss.death_pc = janet_unwrap_integer(tup[1]);
|
||||
ss.slot_index = janet_unwrap_integer(tup[2]);
|
||||
ss.symbol = janet_unwrap_symbol(tup[3]);
|
||||
def->symbolmap[i] = ss;
|
||||
}
|
||||
}
|
||||
if (def->symbolmap_length) def->flags |= JANET_FUNCDEF_FLAG_HASSYMBOLMAP;
|
||||
|
||||
/* Set environments */
|
||||
def->environments =
|
||||
janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
|
||||
if (NULL == def->environments) {
|
||||
x = janet_get1(s, janet_ckeywordv("environments"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
def->environments_length = count;
|
||||
if (def->environments_length) {
|
||||
def->environments = janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
|
||||
}
|
||||
for (int32_t i = 0; i < count; i++) {
|
||||
if (!janet_checkint(arr[i])) {
|
||||
janet_asm_error(&a, "expected integer");
|
||||
}
|
||||
def->environments[i] = janet_unwrap_integer(arr[i]);
|
||||
}
|
||||
}
|
||||
if (def->environments_length && NULL == def->environments) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -861,6 +926,30 @@ static Janet janet_disasm_slotcount(JanetFuncDef *def) {
|
||||
return janet_wrap_integer(def->slotcount);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_symbolslots(JanetFuncDef *def) {
|
||||
if (def->symbolmap == NULL) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
JanetArray *symbolslots = janet_array(def->symbolmap_length);
|
||||
Janet upvaluekw = janet_ckeywordv("upvalue");
|
||||
for (int32_t i = 0; i < def->symbolmap_length; i++) {
|
||||
JanetSymbolMap ss = def->symbolmap[i];
|
||||
Janet *t = janet_tuple_begin(4);
|
||||
if (ss.birth_pc == UINT32_MAX) {
|
||||
t[0] = upvaluekw;
|
||||
} else {
|
||||
t[0] = janet_wrap_integer(ss.birth_pc);
|
||||
}
|
||||
t[1] = janet_wrap_integer(ss.death_pc);
|
||||
t[2] = janet_wrap_integer(ss.slot_index);
|
||||
t[3] = janet_wrap_symbol(ss.symbol);
|
||||
symbolslots->data[i] = janet_wrap_tuple(janet_tuple_end(t));
|
||||
}
|
||||
symbolslots->count = def->symbolmap_length;
|
||||
return janet_wrap_array(symbolslots);
|
||||
}
|
||||
|
||||
|
||||
static Janet janet_disasm_bytecode(JanetFuncDef *def) {
|
||||
JanetArray *bcode = janet_array(def->bytecode_length);
|
||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||
@@ -884,6 +973,10 @@ static Janet janet_disasm_vararg(JanetFuncDef *def) {
|
||||
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_structarg(JanetFuncDef *def) {
|
||||
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_STRUCTARG);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_constants(JanetFuncDef *def) {
|
||||
JanetArray *constants = janet_array(def->constants_length);
|
||||
for (int32_t i = 0; i < def->constants_length; i++) {
|
||||
@@ -933,8 +1026,10 @@ Janet janet_disasm(JanetFuncDef *def) {
|
||||
janet_table_put(ret, janet_ckeywordv("bytecode"), janet_disasm_bytecode(def));
|
||||
janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def));
|
||||
janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(def));
|
||||
janet_table_put(ret, janet_ckeywordv("structarg"), janet_disasm_structarg(def));
|
||||
janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
|
||||
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
|
||||
janet_table_put(ret, janet_ckeywordv("symbolmap"), janet_disasm_symbolslots(def));
|
||||
janet_table_put(ret, janet_ckeywordv("constants"), janet_disasm_constants(def));
|
||||
janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_disasm_sourcemap(def));
|
||||
janet_table_put(ret, janet_ckeywordv("environments"), janet_disasm_environments(def));
|
||||
@@ -952,7 +1047,7 @@ JANET_CORE_FN(cfun_asm,
|
||||
JanetAssembleResult res;
|
||||
res = janet_asm(argv[0], 0);
|
||||
if (res.status != JANET_ASSEMBLE_OK) {
|
||||
janet_panics(res.error);
|
||||
janet_panics(res.error ? res.error : janet_cstring("invalid assembly"));
|
||||
}
|
||||
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||
}
|
||||
@@ -971,6 +1066,7 @@ JANET_CORE_FN(cfun_disasm,
|
||||
"* :source - name of source file that this function was compiled from.\n"
|
||||
"* :name - name of function.\n"
|
||||
"* :slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n"
|
||||
"* :symbolmap - all symbols and their slots.\n"
|
||||
"* :constants - an array of constants referenced by this function.\n"
|
||||
"* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n"
|
||||
"* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n"
|
||||
@@ -986,6 +1082,7 @@ JANET_CORE_FN(cfun_disasm,
|
||||
if (!janet_cstrcmp(kw, "source")) return janet_disasm_source(f->def);
|
||||
if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def);
|
||||
if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def);
|
||||
if (!janet_cstrcmp(kw, "structarg")) return janet_disasm_structarg(f->def);
|
||||
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
|
||||
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
|
||||
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -29,7 +29,7 @@
|
||||
#endif
|
||||
|
||||
/* Initialize a buffer */
|
||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
static JanetBuffer *janet_buffer_init_impl(JanetBuffer *buffer, int32_t capacity) {
|
||||
uint8_t *data = NULL;
|
||||
if (capacity < 4) capacity = 4;
|
||||
janet_gcpressure(capacity);
|
||||
@@ -43,6 +43,14 @@ JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
return buffer;
|
||||
}
|
||||
|
||||
/* Initialize a buffer */
|
||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
janet_buffer_init_impl(buffer, capacity);
|
||||
buffer->gc.data.next = NULL;
|
||||
buffer->gc.flags = JANET_MEM_DISABLED;
|
||||
return buffer;
|
||||
}
|
||||
|
||||
/* Deinitialize a buffer (free data memory) */
|
||||
void janet_buffer_deinit(JanetBuffer *buffer) {
|
||||
janet_free(buffer->data);
|
||||
@@ -51,7 +59,7 @@ void janet_buffer_deinit(JanetBuffer *buffer) {
|
||||
/* Initialize a buffer */
|
||||
JanetBuffer *janet_buffer(int32_t capacity) {
|
||||
JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
|
||||
return janet_buffer_init(buffer, capacity);
|
||||
return janet_buffer_init_impl(buffer, capacity);
|
||||
}
|
||||
|
||||
/* Ensure that the buffer has enough internal capacity */
|
||||
@@ -164,7 +172,7 @@ void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_new,
|
||||
"(buffer/new capacity)",
|
||||
"Creates a new, empty buffer with enough backing memory for capacity bytes. "
|
||||
"Creates a new, empty buffer with enough backing memory for `capacity` bytes. "
|
||||
"Returns a new buffer of length 0.") {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
@@ -174,16 +182,17 @@ JANET_CORE_FN(cfun_buffer_new,
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_new_filled,
|
||||
"(buffer/new-filled count &opt byte)",
|
||||
"Creates a new buffer of length count filled with byte. By default, byte is 0. "
|
||||
"Creates a new buffer of length `count` filled with `byte`. By default, `byte` is 0. "
|
||||
"Returns the new buffer.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
int32_t count = janet_getinteger(argv, 0);
|
||||
if (count < 0) count = 0;
|
||||
int32_t byte = 0;
|
||||
if (argc == 2) {
|
||||
byte = janet_getinteger(argv, 1) & 0xFF;
|
||||
}
|
||||
JanetBuffer *buffer = janet_buffer(count);
|
||||
if (buffer->data)
|
||||
if (buffer->data && count > 0)
|
||||
memset(buffer->data, byte, count);
|
||||
buffer->count = count;
|
||||
return janet_wrap_buffer(buffer);
|
||||
@@ -312,7 +321,7 @@ JANET_CORE_FN(cfun_buffer_clear,
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_popn,
|
||||
"(buffer/popn buffer 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.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int32_t n = janet_getinteger(argv, 1);
|
||||
@@ -327,9 +336,9 @@ JANET_CORE_FN(cfun_buffer_popn,
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_slice,
|
||||
"(buffer/slice bytes &opt start end)",
|
||||
"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 "
|
||||
"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.") {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
@@ -399,9 +408,9 @@ JANET_CORE_FN(cfun_buffer_bittoggle,
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_blit,
|
||||
"(buffer/blit dest src &opt dest-start src-start src-end)",
|
||||
"Insert the contents of src into dest. Can optionally take indices that "
|
||||
"indicate which part of src to copy into which part of dest. Indices can be "
|
||||
"negative to index from the end of src or dest. Returns dest.") {
|
||||
"Insert the contents of `src` into `dest`. Can optionally take indices that "
|
||||
"indicate which part of `src` to copy into which part of `dest`. Indices can be "
|
||||
"negative in order to index from the end of `src` or `dest`. Returns `dest`.") {
|
||||
janet_arity(argc, 2, 5);
|
||||
JanetBuffer *dest = janet_getbuffer(argv, 0);
|
||||
JanetByteView src = janet_getbytes(argv, 1);
|
||||
@@ -441,7 +450,7 @@ JANET_CORE_FN(cfun_buffer_blit,
|
||||
JANET_CORE_FN(cfun_buffer_format,
|
||||
"(buffer/format buffer format & args)",
|
||||
"Snprintf like functionality for printing values into a buffer. Returns "
|
||||
" the modified buffer.") {
|
||||
"the modified buffer.") {
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
const char *strfrmt = (const char *) janet_getstring(argv, 1);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -218,6 +218,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
|
||||
def->closure_bitset = NULL;
|
||||
def->flags = 0;
|
||||
def->slotcount = 0;
|
||||
def->symbolmap = NULL;
|
||||
def->arity = 0;
|
||||
def->min_arity = 0;
|
||||
def->max_arity = INT32_MAX;
|
||||
@@ -229,6 +230,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
|
||||
def->constants_length = 0;
|
||||
def->bytecode_length = 0;
|
||||
def->environments_length = 0;
|
||||
def->symbolmap_length = 0;
|
||||
return def;
|
||||
}
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -260,11 +260,27 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
||||
}
|
||||
|
||||
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
||||
#ifdef JANET_INT_TYPES
|
||||
return janet_unwrap_s64(argv[n]);
|
||||
#else
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint64(x)) {
|
||||
janet_panicf("bad slot #%d, expected 64 bit signed integer, got %v", n, x);
|
||||
}
|
||||
return (int64_t) janet_unwrap_number(x);
|
||||
#endif
|
||||
}
|
||||
|
||||
uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
|
||||
#ifdef JANET_INT_TYPES
|
||||
return janet_unwrap_u64(argv[n]);
|
||||
#else
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint64(x)) {
|
||||
janet_panicf("bad slot #%d, expected 64 bit unsigned integer, got %v", n, x);
|
||||
}
|
||||
return (uint64_t) janet_unwrap_number(x);
|
||||
#endif
|
||||
}
|
||||
|
||||
size_t janet_getsize(const Janet *argv, int32_t n) {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -93,10 +93,14 @@ void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
|
||||
/* Add a slot to a scope with a symbol associated with it (def or var). */
|
||||
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
|
||||
SymPair sp;
|
||||
int32_t cnt = janet_v_count(c->buffer);
|
||||
sp.sym = sym;
|
||||
sp.sym2 = sym;
|
||||
sp.slot = s;
|
||||
sp.keep = 0;
|
||||
sp.slot.flags |= JANET_SLOT_NAMED;
|
||||
sp.birth_pc = cnt ? cnt - 1 : 0;
|
||||
sp.death_pc = UINT32_MAX;
|
||||
janet_v_push(c->scope->syms, sp);
|
||||
}
|
||||
|
||||
@@ -159,21 +163,27 @@ void janetc_popscope(JanetCompiler *c) {
|
||||
if (oldscope->flags & JANET_SCOPE_CLOSURE) {
|
||||
newscope->flags |= JANET_SCOPE_CLOSURE;
|
||||
}
|
||||
if (newscope->ra.max < oldscope->ra.max)
|
||||
if (newscope->ra.max < oldscope->ra.max) {
|
||||
newscope->ra.max = oldscope->ra.max;
|
||||
|
||||
/* Keep upvalue slots */
|
||||
for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
|
||||
SymPair pair = oldscope->syms[i];
|
||||
if (pair.keep) {
|
||||
/* The variable should not be lexically accessible */
|
||||
pair.sym = NULL;
|
||||
janet_v_push(newscope->syms, pair);
|
||||
janetc_regalloc_touch(&newscope->ra, pair.slot.index);
|
||||
}
|
||||
}
|
||||
|
||||
/* Keep upvalue slots and symbols for debugging. */
|
||||
for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
|
||||
SymPair pair = oldscope->syms[i];
|
||||
/* The variable should not be lexically accessible */
|
||||
pair.sym = NULL;
|
||||
if (pair.death_pc == UINT32_MAX) {
|
||||
pair.death_pc = (uint32_t) janet_v_count(c->buffer);
|
||||
}
|
||||
if (pair.keep) {
|
||||
/* The variable should also not be included in the locals */
|
||||
pair.sym2 = NULL;
|
||||
janetc_regalloc_touch(&newscope->ra, pair.slot.index);
|
||||
}
|
||||
janet_v_push(newscope->syms, pair);
|
||||
}
|
||||
}
|
||||
|
||||
/* Free the old scope */
|
||||
janet_v_free(oldscope->consts);
|
||||
janet_v_free(oldscope->syms);
|
||||
@@ -334,6 +344,7 @@ found:
|
||||
}
|
||||
|
||||
/* non-local scope needs to expose its environment */
|
||||
JanetScope *original_scope = scope;
|
||||
pair->keep = 1;
|
||||
while (scope && !(scope->flags & JANET_SCOPE_FUNCTION))
|
||||
scope = scope->parent;
|
||||
@@ -355,7 +366,7 @@ found:
|
||||
/* Check if scope already has env. If so, break */
|
||||
len = janet_v_count(scope->envs);
|
||||
for (j = 0; j < len; j++) {
|
||||
if (scope->envs[j] == envindex) {
|
||||
if (scope->envs[j].envindex == envindex) {
|
||||
scopefound = 1;
|
||||
envindex = j;
|
||||
break;
|
||||
@@ -364,7 +375,10 @@ found:
|
||||
/* Add the environment if it is not already referenced */
|
||||
if (!scopefound) {
|
||||
len = janet_v_count(scope->envs);
|
||||
janet_v_push(scope->envs, envindex);
|
||||
JanetEnvRef ref;
|
||||
ref.envindex = envindex;
|
||||
ref.scope = original_scope;
|
||||
janet_v_push(scope->envs, ref);
|
||||
envindex = len;
|
||||
}
|
||||
}
|
||||
@@ -868,7 +882,10 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
|
||||
/* Copy envs */
|
||||
def->environments_length = janet_v_count(scope->envs);
|
||||
def->environments = janet_v_flatten(scope->envs);
|
||||
def->environments = janet_malloc(sizeof(int32_t) * def->environments_length);
|
||||
for (int32_t i = 0; i < def->environments_length; i++) {
|
||||
def->environments[i] = scope->envs[i].envindex;
|
||||
}
|
||||
|
||||
def->constants_length = janet_v_count(scope->consts);
|
||||
def->constants = janet_v_flatten(scope->consts);
|
||||
@@ -923,6 +940,50 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
def->closure_bitset = chunks;
|
||||
}
|
||||
|
||||
/* Capture symbol to local mapping */
|
||||
JanetSymbolMap *locals = NULL;
|
||||
|
||||
/* Symbol -> upvalue mapping */
|
||||
JanetScope *top = c->scope;
|
||||
while (top->parent) top = top->parent;
|
||||
for (JanetScope *s = top; s != NULL; s = s->child) {
|
||||
for (int32_t j = 0; j < janet_v_count(scope->envs); j++) {
|
||||
JanetEnvRef ref = scope->envs[j];
|
||||
JanetScope *upscope = ref.scope;
|
||||
if (upscope != s) continue;
|
||||
for (int32_t i = 0; i < janet_v_count(upscope->syms); i++) {
|
||||
SymPair pair = upscope->syms[i];
|
||||
if (pair.sym2) {
|
||||
JanetSymbolMap jsm;
|
||||
jsm.birth_pc = UINT32_MAX;
|
||||
jsm.death_pc = j;
|
||||
jsm.slot_index = pair.slot.index;
|
||||
jsm.symbol = pair.sym2;
|
||||
janet_v_push(locals, jsm);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Symbol -> slot mapping */
|
||||
for (int32_t i = 0; i < janet_v_count(scope->syms); i++) {
|
||||
SymPair pair = scope->syms[i];
|
||||
if (pair.sym2) {
|
||||
if (pair.death_pc == UINT32_MAX) {
|
||||
pair.death_pc = def->bytecode_length;
|
||||
}
|
||||
JanetSymbolMap jsm;
|
||||
jsm.birth_pc = pair.birth_pc;
|
||||
jsm.death_pc = pair.death_pc;
|
||||
jsm.slot_index = pair.slot.index;
|
||||
jsm.symbol = pair.sym2;
|
||||
janet_v_push(locals, jsm);
|
||||
}
|
||||
}
|
||||
def->symbolmap_length = janet_v_count(locals);
|
||||
def->symbolmap = janet_v_flatten(locals);
|
||||
if (def->symbolmap_length) def->flags |= JANET_FUNCDEF_FLAG_HASSYMBOLMAP;
|
||||
|
||||
/* Pop the scope */
|
||||
janetc_popscope(c);
|
||||
|
||||
@@ -996,7 +1057,7 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
|
||||
}
|
||||
|
||||
/* C Function for compiling */
|
||||
JANET_CORE_FN(cfun,
|
||||
JANET_CORE_FN(cfun_compile,
|
||||
"(compile ast &opt env source lints)",
|
||||
"Compiles an Abstract Syntax Tree (ast) into a function. "
|
||||
"Pair the compile function with parsing functionality to implement "
|
||||
@@ -1005,7 +1066,8 @@ JANET_CORE_FN(cfun,
|
||||
"If a `lints` array is given, linting messages will be appended to the array. "
|
||||
"Each message will be a tuple of the form `(level line col message)`.") {
|
||||
janet_arity(argc, 1, 4);
|
||||
JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm.fiber->env;
|
||||
JanetTable *env = (argc > 1 && !janet_checktype(argv[1], JANET_NIL))
|
||||
? janet_gettable(argv, 1) : janet_vm.fiber->env;
|
||||
if (NULL == env) {
|
||||
env = janet_table(0);
|
||||
janet_vm.fiber->env = env;
|
||||
@@ -1017,11 +1079,12 @@ JANET_CORE_FN(cfun,
|
||||
source = janet_unwrap_string(x);
|
||||
} else if (janet_checktype(x, JANET_KEYWORD)) {
|
||||
source = janet_unwrap_keyword(x);
|
||||
} else {
|
||||
} else if (!janet_checktype(x, JANET_NIL)) {
|
||||
janet_panic_type(x, 2, JANET_TFLAG_STRING | JANET_TFLAG_KEYWORD);
|
||||
}
|
||||
}
|
||||
JanetArray *lints = (argc >= 4) ? janet_getarray(argv, 3) : NULL;
|
||||
JanetArray *lints = (argc >= 4 && !janet_checktype(argv[3], JANET_NIL))
|
||||
? janet_getarray(argv, 3) : NULL;
|
||||
JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints);
|
||||
if (res.status == JANET_COMPILE_OK) {
|
||||
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||
@@ -1043,7 +1106,7 @@ JANET_CORE_FN(cfun,
|
||||
|
||||
void janet_lib_compile(JanetTable *env) {
|
||||
JanetRegExt cfuns[] = {
|
||||
JANET_CORE_REG("compile", cfun),
|
||||
JANET_CORE_REG("compile", cfun_compile),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, cfuns);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -111,13 +111,21 @@ struct JanetSlot {
|
||||
typedef struct SymPair {
|
||||
JanetSlot slot;
|
||||
const uint8_t *sym;
|
||||
const uint8_t *sym2;
|
||||
int keep;
|
||||
uint32_t birth_pc;
|
||||
uint32_t death_pc;
|
||||
} SymPair;
|
||||
|
||||
typedef struct JanetEnvRef {
|
||||
int32_t envindex;
|
||||
JanetScope *scope;
|
||||
} JanetEnvRef;
|
||||
|
||||
/* A lexical scope during compilation */
|
||||
struct JanetScope {
|
||||
|
||||
/* For debugging */
|
||||
/* For debugging the compiler */
|
||||
const char *name;
|
||||
|
||||
/* Scopes are doubly linked list */
|
||||
@@ -133,7 +141,7 @@ struct JanetScope {
|
||||
/* FuncDefs */
|
||||
JanetFuncDef **defs;
|
||||
|
||||
/* Regsiter allocator */
|
||||
/* Register allocator */
|
||||
JanetcRegisterAllocator ra;
|
||||
|
||||
/* Upvalue allocator */
|
||||
@@ -142,7 +150,7 @@ struct JanetScope {
|
||||
/* Referenced closure environments. The values at each index correspond
|
||||
* to which index to get the environment from in the parent. The environment
|
||||
* that corresponds to the direct parent's stack will always have value 0. */
|
||||
int32_t *envs;
|
||||
JanetEnvRef *envs;
|
||||
|
||||
int32_t bytecode_start;
|
||||
int flags;
|
||||
@@ -227,7 +235,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len);
|
||||
/* Get a bunch of slots for function arguments */
|
||||
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds);
|
||||
|
||||
/* Push slots load via janetc_toslots. */
|
||||
/* Push slots loaded via janetc_toslots. */
|
||||
int32_t janetc_pushslots(JanetCompiler *c, JanetSlot *slots);
|
||||
|
||||
/* Free slots loaded via janetc_toslots */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -42,51 +42,6 @@ extern size_t janet_core_image_size;
|
||||
#define JDOC(x) NULL
|
||||
#endif
|
||||
|
||||
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
|
||||
* with native code. */
|
||||
#if defined(JANET_NO_DYNAMIC_MODULES)
|
||||
typedef int Clib;
|
||||
#define load_clib(name) ((void) name, 0)
|
||||
#define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
|
||||
#define error_clib() "dynamic libraries not supported"
|
||||
#elif defined(JANET_WINDOWS)
|
||||
#include <windows.h>
|
||||
typedef HINSTANCE Clib;
|
||||
#define load_clib(name) LoadLibrary((name))
|
||||
#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
|
||||
static char error_clib_buf[256];
|
||||
static char *error_clib(void) {
|
||||
FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
|
||||
NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
|
||||
error_clib_buf, sizeof(error_clib_buf), NULL);
|
||||
error_clib_buf[strlen(error_clib_buf) - 1] = '\0';
|
||||
return error_clib_buf;
|
||||
}
|
||||
#else
|
||||
#include <dlfcn.h>
|
||||
typedef void *Clib;
|
||||
#define load_clib(name) dlopen((name), RTLD_NOW)
|
||||
#define symbol_clib(lib, sym) dlsym((lib), (sym))
|
||||
#define error_clib() dlerror()
|
||||
#endif
|
||||
|
||||
static char *get_processed_name(const char *name) {
|
||||
if (name[0] == '.') return (char *) name;
|
||||
const char *c;
|
||||
for (c = name; *c; c++) {
|
||||
if (*c == '/') return (char *) name;
|
||||
}
|
||||
size_t l = (size_t)(c - name);
|
||||
char *ret = janet_malloc(l + 3);
|
||||
if (NULL == ret) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
ret[0] = '.';
|
||||
ret[1] = '/';
|
||||
memcpy(ret + 2, name, l + 1);
|
||||
return ret;
|
||||
}
|
||||
|
||||
JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
char *processed_name = get_processed_name(name);
|
||||
Clib lib = load_clib(processed_name);
|
||||
@@ -156,7 +111,10 @@ JANET_CORE_FN(janet_core_expand_path,
|
||||
"This takes in a path (the argument to require) and a template string, "
|
||||
"to expand the path to a path that can be "
|
||||
"used for importing files. The replacements are as follows:\n\n"
|
||||
"* :all: -- the value of path verbatim\n\n"
|
||||
"* :all: -- the value of path verbatim.\n\n"
|
||||
"* :@all: -- Same as :all:, but if `path` starts with the @ character,\n"
|
||||
" the first path segment is replaced with a dynamic binding\n"
|
||||
" `(dyn <first path segment as keyword>)`.\n\n"
|
||||
"* :cur: -- the current file, or (dyn :current-file)\n\n"
|
||||
"* :dir: -- the directory containing the current file\n\n"
|
||||
"* :name: -- the name component of path, with extension if given\n\n"
|
||||
@@ -202,6 +160,21 @@ JANET_CORE_FN(janet_core_expand_path,
|
||||
if (strncmp(template + i, ":all:", 5) == 0) {
|
||||
janet_buffer_push_cstring(out, input);
|
||||
i += 4;
|
||||
} else if (strncmp(template + i, ":@all:", 6) == 0) {
|
||||
if (input[0] == '@') {
|
||||
const char *p = input;
|
||||
while (*p && !is_path_sep(*p)) p++;
|
||||
size_t len = p - input - 1;
|
||||
char *str = janet_smalloc(len + 1);
|
||||
memcpy(str, input + 1, len);
|
||||
str[len] = '\0';
|
||||
janet_formatb(out, "%V", janet_dyn(str));
|
||||
janet_sfree(str);
|
||||
janet_buffer_push_cstring(out, p);
|
||||
} else {
|
||||
janet_buffer_push_cstring(out, input);
|
||||
}
|
||||
i += 5;
|
||||
} else if (strncmp(template + i, ":cur:", 5) == 0) {
|
||||
janet_buffer_push_bytes(out, (const uint8_t *)curdir, curlen);
|
||||
i += 4;
|
||||
@@ -659,27 +632,39 @@ JANET_CORE_FN(janet_core_signal,
|
||||
"(signal what x)",
|
||||
"Raise a signal with payload x. ") {
|
||||
janet_arity(argc, 1, 2);
|
||||
int sig;
|
||||
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
|
||||
if (janet_checkint(argv[0])) {
|
||||
int32_t s = janet_unwrap_integer(argv[0]);
|
||||
if (s < 0 || s > 9) {
|
||||
janet_panicf("expected user signal between 0 and 9, got %d", s);
|
||||
}
|
||||
sig = JANET_SIGNAL_USER0 + s;
|
||||
janet_signalv(JANET_SIGNAL_USER0 + s, payload);
|
||||
} else {
|
||||
JanetKeyword kw = janet_getkeyword(argv, 0);
|
||||
if (!janet_cstrcmp(kw, "yield")) {
|
||||
sig = JANET_SIGNAL_YIELD;
|
||||
} else if (!janet_cstrcmp(kw, "error")) {
|
||||
sig = JANET_SIGNAL_ERROR;
|
||||
} else if (!janet_cstrcmp(kw, "debug")) {
|
||||
sig = JANET_SIGNAL_DEBUG;
|
||||
} else {
|
||||
janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
|
||||
for (unsigned i = 0; i < sizeof(janet_signal_names) / sizeof(char *); i++) {
|
||||
if (!janet_cstrcmp(kw, janet_signal_names[i])) {
|
||||
janet_signalv((JanetSignal) i, payload);
|
||||
}
|
||||
}
|
||||
}
|
||||
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
|
||||
janet_signalv(sig, payload);
|
||||
janet_panicf("unknown signal %v", argv[0]);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_memcmp,
|
||||
"(memcmp a b &opt len offset-a offset-b)",
|
||||
"Compare memory. Takes to byte sequences `a` and `b`, and "
|
||||
"return 0 if they have identical contents, a negative integer if a is less than b, "
|
||||
"and a positive integer if a is greater than b. Optionally take a length and offsets "
|
||||
"to compare slices of the bytes sequences.") {
|
||||
janet_arity(argc, 2, 5);
|
||||
JanetByteView a = janet_getbytes(argv, 0);
|
||||
JanetByteView b = janet_getbytes(argv, 1);
|
||||
int32_t len = janet_optnat(argv, argc, 2, a.len < b.len ? a.len : b.len);
|
||||
int32_t offset_a = janet_optnat(argv, argc, 3, 0);
|
||||
int32_t offset_b = janet_optnat(argv, argc, 4, 0);
|
||||
if (offset_a + len > a.len) janet_panicf("invalid offset-a: %d", offset_a);
|
||||
if (offset_b + len > b.len) janet_panicf("invalid offset-b: %d", offset_b);
|
||||
return janet_wrap_integer(memcmp(a.bytes + offset_a, b.bytes + offset_b, (size_t) len));
|
||||
}
|
||||
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
@@ -983,6 +968,7 @@ static void janet_load_libs(JanetTable *env) {
|
||||
JANET_CORE_REG("nat?", janet_core_check_nat),
|
||||
JANET_CORE_REG("slice", janet_core_slice),
|
||||
JANET_CORE_REG("signal", janet_core_signal),
|
||||
JANET_CORE_REG("memcmp", janet_core_memcmp),
|
||||
JANET_CORE_REG("getproto", janet_core_getproto),
|
||||
JANET_REG_END
|
||||
};
|
||||
@@ -1016,6 +1002,9 @@ static void janet_load_libs(JanetTable *env) {
|
||||
#ifdef JANET_NET
|
||||
janet_lib_net(env);
|
||||
#endif
|
||||
#ifdef JANET_FFI
|
||||
janet_lib_ffi(env);
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -131,9 +131,9 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
||||
if (!wrote_error) {
|
||||
JanetFiberStatus status = janet_fiber_status(fiber);
|
||||
janet_eprintf("%s%s: %s\n",
|
||||
prefix,
|
||||
prefix ? prefix : "",
|
||||
janet_status_names[status],
|
||||
errstr);
|
||||
errstr ? errstr : janet_status_names[status]);
|
||||
wrote_error = 1;
|
||||
}
|
||||
|
||||
@@ -329,6 +329,27 @@ static Janet doframe(JanetStackFrame *frame) {
|
||||
safe_memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
|
||||
slots->count = def->slotcount;
|
||||
janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
|
||||
/* Add local bindings */
|
||||
if (def->symbolmap) {
|
||||
JanetTable *local_bindings = janet_table(0);
|
||||
for (int32_t i = def->symbolmap_length - 1; i >= 0; i--) {
|
||||
JanetSymbolMap jsm = def->symbolmap[i];
|
||||
Janet value = janet_wrap_nil();
|
||||
uint32_t pc = (uint32_t)(frame->pc - def->bytecode);
|
||||
if (jsm.birth_pc == UINT32_MAX) {
|
||||
JanetFuncEnv *env = frame->func->envs[jsm.death_pc];
|
||||
if (env->offset > 0) {
|
||||
value = env->as.fiber->data[env->offset + jsm.slot_index];
|
||||
} else {
|
||||
value = env->as.values[jsm.slot_index];
|
||||
}
|
||||
} else if (pc >= jsm.birth_pc && pc < jsm.death_pc) {
|
||||
value = stack[jsm.slot_index];
|
||||
}
|
||||
janet_table_put(local_bindings, janet_wrap_symbol(jsm.symbol), value);
|
||||
}
|
||||
janet_table_put(t, janet_ckeywordv("locals"), janet_wrap_table(local_bindings));
|
||||
}
|
||||
}
|
||||
return janet_wrap_table(t);
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
|
||||
228
src/core/ev.c
228
src/core/ev.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -79,7 +79,11 @@ typedef struct {
|
||||
int32_t limit;
|
||||
int closed;
|
||||
int is_threaded;
|
||||
JanetOSMutex lock;
|
||||
#ifdef JANET_WINDOWS
|
||||
CRITICAL_SECTION lock;
|
||||
#else
|
||||
pthread_mutex_t lock;
|
||||
#endif
|
||||
} JanetChannel;
|
||||
|
||||
typedef struct {
|
||||
@@ -168,6 +172,9 @@ static JanetTimestamp ts_now(void);
|
||||
|
||||
/* Get current timestamp + an interval (millisecond precision) */
|
||||
static JanetTimestamp ts_delta(JanetTimestamp ts, double delta) {
|
||||
if (isinf(delta)) {
|
||||
return delta < 0 ? ts : INT64_MAX;
|
||||
}
|
||||
ts += (int64_t)round(delta * 1000);
|
||||
return ts;
|
||||
}
|
||||
@@ -531,10 +538,15 @@ static int janet_channel_push(JanetChannel *channel, Janet x, int mode);
|
||||
static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice);
|
||||
|
||||
static Janet make_supervisor_event(const char *name, JanetFiber *fiber, int threaded) {
|
||||
Janet tup[2];
|
||||
Janet tup[3];
|
||||
tup[0] = janet_ckeywordv(name);
|
||||
tup[1] = threaded ? fiber->last_value : janet_wrap_fiber(fiber) ;
|
||||
return janet_wrap_tuple(janet_tuple_n(tup, 2));
|
||||
if (fiber->env != NULL) {
|
||||
tup[2] = janet_table_get(fiber->env, janet_ckeywordv("task-id"));
|
||||
} else {
|
||||
tup[2] = janet_wrap_nil();
|
||||
}
|
||||
return janet_wrap_tuple(janet_tuple_n(tup, 3));
|
||||
}
|
||||
|
||||
/* Common init code */
|
||||
@@ -548,6 +560,10 @@ void janet_ev_init_common(void) {
|
||||
janet_vm.tq_capacity = 0;
|
||||
janet_table_init_raw(&janet_vm.threaded_abstracts, 0);
|
||||
janet_rng_seed(&janet_vm.ev_rng, 0);
|
||||
#ifndef JANET_WINDOWS
|
||||
pthread_attr_init(&janet_vm.new_thread_attr);
|
||||
pthread_attr_setdetachstate(&janet_vm.new_thread_attr, PTHREAD_CREATE_DETACHED);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Common deinit code */
|
||||
@@ -557,6 +573,9 @@ void janet_ev_deinit_common(void) {
|
||||
janet_free(janet_vm.listeners);
|
||||
janet_vm.listeners = NULL;
|
||||
janet_table_deinit(&janet_vm.threaded_abstracts);
|
||||
#ifndef JANET_WINDOWS
|
||||
pthread_attr_destroy(&janet_vm.new_thread_attr);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Short hand to yield to event loop */
|
||||
@@ -643,7 +662,7 @@ static void janet_chan_init(JanetChannel *chan, int32_t limit, int threaded) {
|
||||
janet_q_init(&chan->items);
|
||||
janet_q_init(&chan->read_pending);
|
||||
janet_q_init(&chan->write_pending);
|
||||
janet_os_mutex_init(&chan->lock);
|
||||
janet_os_mutex_init((JanetOSMutex *) &chan->lock);
|
||||
}
|
||||
|
||||
static void janet_chan_deinit(JanetChannel *chan) {
|
||||
@@ -656,17 +675,17 @@ static void janet_chan_deinit(JanetChannel *chan) {
|
||||
}
|
||||
}
|
||||
janet_q_deinit(&chan->items);
|
||||
janet_os_mutex_deinit(&chan->lock);
|
||||
janet_os_mutex_deinit((JanetOSMutex *) &chan->lock);
|
||||
}
|
||||
|
||||
static void janet_chan_lock(JanetChannel *chan) {
|
||||
if (!janet_chan_is_threaded(chan)) return;
|
||||
janet_os_mutex_lock(&chan->lock);
|
||||
janet_os_mutex_lock((JanetOSMutex *) &chan->lock);
|
||||
}
|
||||
|
||||
static void janet_chan_unlock(JanetChannel *chan) {
|
||||
if (!janet_chan_is_threaded(chan)) return;
|
||||
janet_os_mutex_unlock(&chan->lock);
|
||||
janet_os_mutex_unlock((JanetOSMutex *) &chan->lock);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1166,14 +1185,48 @@ static Janet janet_chanat_next(void *p, Janet key) {
|
||||
return janet_nextmethod(ev_chanat_methods, key);
|
||||
}
|
||||
|
||||
static void janet_chanat_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetChannel *channel = (JanetChannel *)p;
|
||||
janet_marshal_byte(ctx, channel->closed);
|
||||
janet_marshal_int(ctx, channel->limit);
|
||||
int32_t count = janet_q_count(&channel->items);
|
||||
janet_marshal_int(ctx, count);
|
||||
JanetQueue *items = &channel->items;
|
||||
Janet *data = channel->items.data;
|
||||
if (items->head <= items->tail) {
|
||||
for (int32_t i = items->head; i < items->tail; i++)
|
||||
janet_marshal_janet(ctx, data[i]);
|
||||
} else {
|
||||
for (int32_t i = items->head; i < items->capacity; i++)
|
||||
janet_marshal_janet(ctx, data[i]);
|
||||
for (int32_t i = 0; i < items->tail; i++)
|
||||
janet_marshal_janet(ctx, data[i]);
|
||||
}
|
||||
}
|
||||
|
||||
static void *janet_chanat_unmarshal(JanetMarshalContext *ctx) {
|
||||
JanetChannel *abst = janet_unmarshal_abstract(ctx, sizeof(JanetChannel));
|
||||
uint8_t is_closed = janet_unmarshal_byte(ctx);
|
||||
int32_t limit = janet_unmarshal_int(ctx);
|
||||
int32_t count = janet_unmarshal_int(ctx);
|
||||
if (count < 0) janet_panic("invalid negative channel count");
|
||||
janet_chan_init(abst, limit, 0);
|
||||
abst->closed = !!is_closed;
|
||||
for (int32_t i = 0; i < count; i++) {
|
||||
Janet item = janet_unmarshal_janet(ctx);
|
||||
janet_q_push(&abst->items, &item, sizeof(item));
|
||||
}
|
||||
return abst;
|
||||
}
|
||||
|
||||
const JanetAbstractType janet_channel_type = {
|
||||
"core/channel",
|
||||
janet_chanat_gc,
|
||||
janet_chanat_mark,
|
||||
janet_chanat_get,
|
||||
NULL, /* put */
|
||||
NULL, /* marshal */
|
||||
NULL, /* unmarshal */
|
||||
janet_chanat_marshal,
|
||||
janet_chanat_unmarshal,
|
||||
NULL, /* tostring */
|
||||
NULL, /* compare */
|
||||
NULL, /* hash */
|
||||
@@ -2029,12 +2082,11 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar
|
||||
#else
|
||||
init->write_pipe = janet_vm.selfpipe[1];
|
||||
pthread_t waiter_thread;
|
||||
int err = pthread_create(&waiter_thread, NULL, janet_thread_body, init);
|
||||
int err = pthread_create(&waiter_thread, &janet_vm.new_thread_attr, janet_thread_body, init);
|
||||
if (err) {
|
||||
janet_free(init);
|
||||
janet_panicf("%s", strerror(err));
|
||||
}
|
||||
pthread_detach(waiter_thread);
|
||||
#endif
|
||||
|
||||
/* Increment ev refcount so we don't quit while waiting for a subprocess */
|
||||
@@ -2163,9 +2215,9 @@ typedef struct {
|
||||
JanetReadMode mode;
|
||||
#ifdef JANET_WINDOWS
|
||||
OVERLAPPED overlapped;
|
||||
DWORD flags;
|
||||
#ifdef JANET_NET
|
||||
WSABUF wbuf;
|
||||
DWORD flags;
|
||||
struct sockaddr from;
|
||||
int fromlen;
|
||||
#endif
|
||||
@@ -2224,7 +2276,7 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
#ifdef JANET_NET
|
||||
if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
|
||||
state->wbuf.len = (ULONG) chunk_size;
|
||||
state->wbuf.buf = state->chunk_buf;
|
||||
state->wbuf.buf = (char *) state->chunk_buf;
|
||||
status = WSARecvFrom((SOCKET) s->stream->handle, &state->wbuf, 1,
|
||||
NULL, &state->flags, &state->from, &state->fromlen, &state->overlapped, NULL);
|
||||
if (status && (WSA_IO_PENDING != WSAGetLastError())) {
|
||||
@@ -2239,8 +2291,8 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
state->overlapped.Offset = (DWORD) state->bytes_read;
|
||||
|
||||
status = ReadFile(s->stream->handle, state->chunk_buf, chunk_size, NULL, &state->overlapped);
|
||||
if (!status && (ERROR_IO_PENDING != WSAGetLastError())) {
|
||||
if (WSAGetLastError() == ERROR_BROKEN_PIPE) {
|
||||
if (!status && (ERROR_IO_PENDING != GetLastError())) {
|
||||
if (GetLastError() == ERROR_BROKEN_PIPE) {
|
||||
if (state->bytes_read) {
|
||||
janet_schedule(s->fiber, janet_wrap_buffer(state->buf));
|
||||
} else {
|
||||
@@ -2392,9 +2444,9 @@ typedef struct {
|
||||
void *dest_abst;
|
||||
#ifdef JANET_WINDOWS
|
||||
OVERLAPPED overlapped;
|
||||
DWORD flags;
|
||||
#ifdef JANET_NET
|
||||
WSABUF wbuf;
|
||||
DWORD flags;
|
||||
#endif
|
||||
#else
|
||||
int flags;
|
||||
@@ -2479,7 +2531,7 @@ JanetAsyncStatus ev_machine_write(JanetListenerState *s, JanetAsyncEvent event)
|
||||
state->overlapped.Offset = (DWORD) 0xFFFFFFFF;
|
||||
state->overlapped.OffsetHigh = (DWORD) 0xFFFFFFFF;
|
||||
status = WriteFile(s->stream->handle, bytes, len, NULL, &state->overlapped);
|
||||
if (!status && (ERROR_IO_PENDING != WSAGetLastError())) {
|
||||
if (!status && (ERROR_IO_PENDING != GetLastError())) {
|
||||
janet_cancel(s->fiber, janet_ev_lasterr());
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
}
|
||||
@@ -2615,15 +2667,15 @@ int janet_make_pipe(JanetHandle handles[2], int mode) {
|
||||
* so we lift from the windows source code and modify for our own version.
|
||||
*/
|
||||
JanetHandle shandle, chandle;
|
||||
UCHAR PipeNameBuffer[MAX_PATH];
|
||||
CHAR PipeNameBuffer[MAX_PATH];
|
||||
SECURITY_ATTRIBUTES saAttr;
|
||||
memset(&saAttr, 0, sizeof(saAttr));
|
||||
saAttr.nLength = sizeof(saAttr);
|
||||
saAttr.bInheritHandle = TRUE;
|
||||
sprintf(PipeNameBuffer,
|
||||
"\\\\.\\Pipe\\JanetPipeFile.%08x.%08x",
|
||||
GetCurrentProcessId(),
|
||||
InterlockedIncrement(&PipeSerialNumber));
|
||||
(unsigned int) GetCurrentProcessId(),
|
||||
(unsigned int) InterlockedIncrement(&PipeSerialNumber));
|
||||
|
||||
/* server handle goes to subprocess */
|
||||
shandle = CreateNamedPipeA(
|
||||
@@ -2678,9 +2730,10 @@ error:
|
||||
/* C functions */
|
||||
|
||||
JANET_CORE_FN(cfun_ev_go,
|
||||
"(ev/go fiber &opt value supervisor)",
|
||||
"Put a fiber on the event loop to be resumed later. Optionally pass "
|
||||
"a value to resume with, otherwise resumes with nil. Returns the fiber. "
|
||||
"(ev/go fiber-or-fun &opt value supervisor)",
|
||||
"Put a fiber on the event loop to be resumed later. If a function is used, it is wrapped "
|
||||
"with `fiber/new` first. "
|
||||
"Optionally pass a value to resume with, otherwise resumes with nil. Returns the fiber. "
|
||||
"An optional `core/channel` can be provided as a supervisor. When various "
|
||||
"events occur in the newly scheduled fiber, an event will be pushed to the supervisor. "
|
||||
"If not provided, the new fiber will inherit the current supervisor.") {
|
||||
@@ -2715,6 +2768,8 @@ JANET_CORE_FN(cfun_ev_go,
|
||||
return janet_wrap_fiber(fiber);
|
||||
}
|
||||
|
||||
#define JANET_THREAD_SUPERVISOR_FLAG 0x100
|
||||
|
||||
/* For ev/thread - Run an interpreter in the new thread. */
|
||||
static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
||||
JanetBuffer *buffer = (JanetBuffer *) args.argp;
|
||||
@@ -2737,7 +2792,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
||||
}
|
||||
|
||||
/* Get supervsior */
|
||||
if (flags & 0x8) {
|
||||
if (flags & JANET_THREAD_SUPERVISOR_FLAG) {
|
||||
Janet sup =
|
||||
janet_unmarshal(nextbytes, endbytes - nextbytes,
|
||||
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
|
||||
@@ -2789,6 +2844,10 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
||||
} else {
|
||||
fiber = janet_unwrap_fiber(fiberv);
|
||||
}
|
||||
if (flags & 0x8) {
|
||||
if (NULL == fiber->env) fiber->env = janet_table(0);
|
||||
janet_table_put(fiber->env, janet_ckeywordv("task-id"), value);
|
||||
}
|
||||
fiber->supervisor_channel = janet_vm.user;
|
||||
janet_schedule(fiber, value);
|
||||
janet_loop();
|
||||
@@ -2833,6 +2892,7 @@ JANET_CORE_FN(cfun_ev_thread,
|
||||
"If you want to run the thread without waiting for a result, pass the `:n` flag to return nil immediately. "
|
||||
"Otherwise, returns nil. Available flags:\n\n"
|
||||
"* `:n` - return immediately\n"
|
||||
"* `:t` - set the task-id of the new thread to value. The task-id is passed in messages to the supervisor channel.\n"
|
||||
"* `:a` - don't copy abstract registry to new thread (performance optimization)\n"
|
||||
"* `:c` - don't copy cfunction registry to new thread (performance optimization)") {
|
||||
janet_arity(argc, 1, 4);
|
||||
@@ -2840,10 +2900,10 @@ JANET_CORE_FN(cfun_ev_thread,
|
||||
if (!janet_checktype(argv[0], JANET_FUNCTION)) janet_getfiber(argv, 0);
|
||||
uint64_t flags = 0;
|
||||
if (argc >= 3) {
|
||||
flags = janet_getflags(argv, 2, "nac");
|
||||
flags = janet_getflags(argv, 2, "nact");
|
||||
}
|
||||
void *supervisor = janet_optabstract(argv, argc, 3, &janet_channel_type, janet_vm.root_fiber->supervisor_channel);
|
||||
if (NULL != supervisor) flags |= 0x8;
|
||||
if (NULL != supervisor) flags |= JANET_THREAD_SUPERVISOR_FLAG;
|
||||
|
||||
/* Marshal arguments for the new thread. */
|
||||
JanetBuffer *buffer = janet_malloc(sizeof(JanetBuffer));
|
||||
@@ -2854,7 +2914,7 @@ JANET_CORE_FN(cfun_ev_thread,
|
||||
if (!(flags & 0x2)) {
|
||||
janet_marshal(buffer, janet_wrap_table(janet_vm.abstract_registry), NULL, JANET_MARSHAL_UNSAFE);
|
||||
}
|
||||
if (flags & 0x8) {
|
||||
if (flags & JANET_THREAD_SUPERVISOR_FLAG) {
|
||||
janet_marshal(buffer, janet_wrap_abstract(supervisor), NULL, JANET_MARSHAL_UNSAFE);
|
||||
}
|
||||
if (!(flags & 0x4)) {
|
||||
@@ -2882,7 +2942,7 @@ JANET_CORE_FN(cfun_ev_thread,
|
||||
|
||||
JANET_CORE_FN(cfun_ev_give_supervisor,
|
||||
"(ev/give-supervisor tag & payload)",
|
||||
"Send a message to the current supervior channel if there is one. The message will be a "
|
||||
"Send a message to the current supervisor channel if there is one. The message will be a "
|
||||
"tuple of all of the arguments combined into a single message, where the first element is tag. "
|
||||
"By convention, tag should be a keyword indicating the type of message. Returns nil.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
@@ -3013,6 +3073,106 @@ JANET_CORE_FN(janet_cfun_stream_write,
|
||||
janet_await();
|
||||
}
|
||||
|
||||
static int mutexgc(void *p, size_t size) {
|
||||
(void) size;
|
||||
janet_os_mutex_deinit(p);
|
||||
return 0;
|
||||
}
|
||||
|
||||
const JanetAbstractType janet_mutex_type = {
|
||||
"core/lock",
|
||||
mutexgc,
|
||||
JANET_ATEND_GC
|
||||
};
|
||||
|
||||
JANET_CORE_FN(janet_cfun_mutex,
|
||||
"(ev/lock)",
|
||||
"Create a new lock to coordinate threads.") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
void *mutex = janet_abstract_threaded(&janet_mutex_type, janet_os_mutex_size());
|
||||
janet_os_mutex_init(mutex);
|
||||
return janet_wrap_abstract(mutex);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_cfun_mutex_acquire,
|
||||
"(ev/acquire-lock lock)",
|
||||
"Acquire a lock such that this operating system thread is the only thread with access to this resource."
|
||||
" This will block this entire thread until the lock becomes available, and will not yield to other fibers "
|
||||
"on this system thread.") {
|
||||
janet_fixarity(argc, 1);
|
||||
void *mutex = janet_getabstract(argv, 0, &janet_mutex_type);
|
||||
janet_os_mutex_lock(mutex);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_cfun_mutex_release,
|
||||
"(ev/release-lock lock)",
|
||||
"Release a lock such that other threads may acquire it.") {
|
||||
janet_fixarity(argc, 1);
|
||||
void *mutex = janet_getabstract(argv, 0, &janet_mutex_type);
|
||||
janet_os_mutex_unlock(mutex);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int rwlockgc(void *p, size_t size) {
|
||||
(void) size;
|
||||
janet_os_rwlock_deinit(p);
|
||||
return 0;
|
||||
}
|
||||
|
||||
const JanetAbstractType janet_rwlock_type = {
|
||||
"core/rwlock",
|
||||
rwlockgc,
|
||||
JANET_ATEND_GC
|
||||
};
|
||||
|
||||
JANET_CORE_FN(janet_cfun_rwlock,
|
||||
"(ev/rwlock)",
|
||||
"Create a new read-write lock to coordinate threads.") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
void *rwlock = janet_abstract_threaded(&janet_rwlock_type, janet_os_rwlock_size());
|
||||
janet_os_rwlock_init(rwlock);
|
||||
return janet_wrap_abstract(rwlock);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_cfun_rwlock_read_lock,
|
||||
"(ev/acquire-rlock rwlock)",
|
||||
"Acquire a read lock an a read-write lock.") {
|
||||
janet_fixarity(argc, 1);
|
||||
void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
||||
janet_os_rwlock_rlock(rwlock);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_cfun_rwlock_write_lock,
|
||||
"(ev/acquire-wlock rwlock)",
|
||||
"Acquire a write lock on a read-write lock.") {
|
||||
janet_fixarity(argc, 1);
|
||||
void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
||||
janet_os_rwlock_wlock(rwlock);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_cfun_rwlock_read_release,
|
||||
"(ev/release-rlock rwlock)",
|
||||
"Release a read lock on a read-write lock") {
|
||||
janet_fixarity(argc, 1);
|
||||
void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
||||
janet_os_rwlock_runlock(rwlock);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_cfun_rwlock_write_release,
|
||||
"(ev/release-wlock rwlock)",
|
||||
"Release a write lock on a read-write lock") {
|
||||
janet_fixarity(argc, 1);
|
||||
void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
||||
janet_os_rwlock_wunlock(rwlock);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
void janet_lib_ev(JanetTable *env) {
|
||||
JanetRegExt ev_cfuns_ext[] = {
|
||||
JANET_CORE_REG("ev/give", cfun_channel_push),
|
||||
@@ -3035,12 +3195,22 @@ void janet_lib_ev(JanetTable *env) {
|
||||
JANET_CORE_REG("ev/read", janet_cfun_stream_read),
|
||||
JANET_CORE_REG("ev/chunk", janet_cfun_stream_chunk),
|
||||
JANET_CORE_REG("ev/write", janet_cfun_stream_write),
|
||||
JANET_CORE_REG("ev/lock", janet_cfun_mutex),
|
||||
JANET_CORE_REG("ev/acquire-lock", janet_cfun_mutex_acquire),
|
||||
JANET_CORE_REG("ev/release-lock", janet_cfun_mutex_release),
|
||||
JANET_CORE_REG("ev/rwlock", janet_cfun_rwlock),
|
||||
JANET_CORE_REG("ev/acquire-rlock", janet_cfun_rwlock_read_lock),
|
||||
JANET_CORE_REG("ev/acquire-wlock", janet_cfun_rwlock_write_lock),
|
||||
JANET_CORE_REG("ev/release-rlock", janet_cfun_rwlock_read_release),
|
||||
JANET_CORE_REG("ev/release-wlock", janet_cfun_rwlock_write_release),
|
||||
JANET_REG_END
|
||||
};
|
||||
|
||||
janet_core_cfuns_ext(env, NULL, ev_cfuns_ext);
|
||||
janet_register_abstract_type(&janet_stream_type);
|
||||
janet_register_abstract_type(&janet_channel_type);
|
||||
janet_register_abstract_type(&janet_mutex_type);
|
||||
janet_register_abstract_type(&janet_rwlock_type);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -36,13 +36,22 @@
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/* Needed for sched.h for cpu count */
|
||||
#ifdef __linux__
|
||||
#define _GNU_SOURCE
|
||||
#endif
|
||||
|
||||
#if defined(WIN32) || defined(_WIN32)
|
||||
#define WIN32_LEAN_AND_MEAN
|
||||
#endif
|
||||
|
||||
/* Needed for realpath on linux */
|
||||
#if !defined(_XOPEN_SOURCE) && (defined(__linux__) || defined(__EMSCRIPTEN__))
|
||||
#define _XOPEN_SOURCE 500
|
||||
/* Needed for realpath on linux, as well as pthread rwlocks. */
|
||||
#ifndef _XOPEN_SOURCE
|
||||
#define _XOPEN_SOURCE 600
|
||||
#endif
|
||||
#if _XOPEN_SOURCE < 600
|
||||
#undef _XOPEN_SOURCE
|
||||
#define _XOPEN_SOURCE 600
|
||||
#endif
|
||||
|
||||
/* Needed for timegm and other extensions when building with -std=c99.
|
||||
|
||||
1515
src/core/ffi.c
Normal file
1515
src/core/ffi.c
Normal file
File diff suppressed because it is too large
Load Diff
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -209,6 +209,12 @@ static void janet_mark_funcdef(JanetFuncDef *def) {
|
||||
janet_mark_string(def->source);
|
||||
if (def->name)
|
||||
janet_mark_string(def->name);
|
||||
if (def->symbolmap) {
|
||||
for (int i = 0; i < def->symbolmap_length; i++) {
|
||||
janet_mark_string(def->symbolmap[i].symbol);
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
static void janet_mark_function(JanetFunction *func) {
|
||||
@@ -314,6 +320,7 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
janet_free(def->bytecode);
|
||||
janet_free(def->sourcemap);
|
||||
janet_free(def->closure_bitset);
|
||||
janet_free(def->symbolmap);
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose & contributors
|
||||
* Copyright (c) 2023 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
|
||||
@@ -407,13 +407,26 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/*
|
||||
* In C, signed arithmetic overflow is undefined behvior
|
||||
* but unsigned arithmetic overflow is twos complement
|
||||
*
|
||||
* Reference:
|
||||
* https://en.cppreference.com/w/cpp/language/ub
|
||||
* http://blog.llvm.org/2011/05/what-every-c-programmer-should-know.html
|
||||
*
|
||||
* This means OPMETHOD & OPMETHODINVERT must always use
|
||||
* unsigned arithmetic internally, regardless of the true type.
|
||||
* This will not affect the end result (property of twos complement).
|
||||
*/
|
||||
#define OPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int32_t i = 1; i < argc; i++) \
|
||||
*box oper##= janet_unwrap_##type(argv[i]); \
|
||||
/* This avoids undefined behavior. See above for why. */ \
|
||||
*box = (T) ((uint64_t) (*box)) oper ((uint64_t) janet_unwrap_##type(argv[i])); \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
@@ -422,7 +435,8 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
*box oper##= janet_unwrap_##type(argv[0]); \
|
||||
/* This avoids undefined behavior. See above for why. */ \
|
||||
*box = (T) ((uint64_t) *box) oper ((uint64_t) janet_unwrap_##type(argv[0])); \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
@@ -518,7 +532,6 @@ OPMETHOD(uint64_t, u64, rshift, >>)
|
||||
#undef DIVMETHOD_SIGNED
|
||||
#undef COMPMETHOD
|
||||
|
||||
|
||||
static JanetMethod it_s64_methods[] = {
|
||||
{"+", cfun_it_s64_add},
|
||||
{"r+", cfun_it_s64_add},
|
||||
@@ -541,7 +554,6 @@ static JanetMethod it_s64_methods[] = {
|
||||
{"<<", cfun_it_s64_lshift},
|
||||
{">>", cfun_it_s64_rshift},
|
||||
{"compare", cfun_it_s64_compare},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -567,7 +579,6 @@ static JanetMethod it_u64_methods[] = {
|
||||
{"<<", cfun_it_u64_lshift},
|
||||
{">>", cfun_it_u64_rshift},
|
||||
{"compare", cfun_it_u64_compare},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
150
src/core/io.c
150
src/core/io.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -112,42 +112,6 @@ static void *makef(FILE *f, int32_t flags) {
|
||||
return iof;
|
||||
}
|
||||
|
||||
/* Open a process */
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
JANET_CORE_FN(cfun_io_popen,
|
||||
"(file/popen command &opt mode) (DEPRECATED for os/spawn)",
|
||||
"Open a file that is backed by a process. The file must be opened in either "
|
||||
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
|
||||
"process can be read from the file. In :w mode, the stdin of the process "
|
||||
"can be written to. Returns the new file.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
const uint8_t *fmode = NULL;
|
||||
int32_t flags;
|
||||
if (argc == 2) {
|
||||
fmode = janet_getkeyword(argv, 1);
|
||||
flags = JANET_FILE_PIPED | checkflags(fmode);
|
||||
if (flags & (JANET_FILE_UPDATE | JANET_FILE_BINARY | JANET_FILE_APPEND)) {
|
||||
janet_panicf("invalid popen file mode :%S, expected :r or :w", fmode);
|
||||
}
|
||||
fmode = (const uint8_t *)((fmode[0] == 'r') ? "r" : "w");
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
flags = JANET_FILE_PIPED | JANET_FILE_READ;
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
#define popen _popen
|
||||
#endif
|
||||
FILE *f = popen((const char *)fname, (const char *)fmode);
|
||||
if (!f) {
|
||||
if (flags & JANET_FILE_NONIL)
|
||||
janet_panicf("failed to popen %s: %s", fname, strerror(errno));
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
return janet_makefile(f, flags);
|
||||
}
|
||||
#endif
|
||||
|
||||
JANET_CORE_FN(cfun_io_temp,
|
||||
"(file/temp)",
|
||||
"Open an anonymous temporary file that is removed on close. "
|
||||
@@ -279,6 +243,13 @@ JANET_CORE_FN(cfun_io_fwrite,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static void io_assert_writeable(JanetFile *iof) {
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
|
||||
janet_panic("file is not writeable");
|
||||
}
|
||||
|
||||
/* Flush the bytes in the file */
|
||||
JANET_CORE_FN(cfun_io_fflush,
|
||||
"(file/flush f)",
|
||||
@@ -286,17 +257,13 @@ JANET_CORE_FN(cfun_io_fflush,
|
||||
"buffered for efficiency reasons. Returns the file handle.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
|
||||
janet_panic("file is not writeable");
|
||||
io_assert_writeable(iof);
|
||||
if (fflush(iof->file))
|
||||
janet_panic("could not flush file");
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#define pclose _pclose
|
||||
#define WEXITSTATUS(x) x
|
||||
#endif
|
||||
|
||||
@@ -304,15 +271,9 @@ JANET_CORE_FN(cfun_io_fflush,
|
||||
int janet_file_close(JanetFile *file) {
|
||||
int ret = 0;
|
||||
if (!(file->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
if (file->flags & JANET_FILE_PIPED) {
|
||||
ret = pclose(file->file);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
ret = fclose(file->file);
|
||||
}
|
||||
ret = fclose(file->file);
|
||||
file->flags |= JANET_FILE_CLOSED;
|
||||
file->file = NULL; /* NULL derefence is easier to debug then other problems */
|
||||
return ret;
|
||||
}
|
||||
return 0;
|
||||
@@ -331,30 +292,18 @@ JANET_CORE_FN(cfun_io_fclose,
|
||||
"(file/close f)",
|
||||
"Close a file and release all related resources. When you are "
|
||||
"done reading a file, close it to prevent a resource leak and let "
|
||||
"other processes read the file. If the file is the result of a file/popen "
|
||||
"call, close waits for and returns the process exit status.") {
|
||||
"other processes read the file.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
return janet_wrap_nil();
|
||||
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
|
||||
janet_panic("file not closable");
|
||||
if (iof->flags & JANET_FILE_PIPED) {
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
int status = pclose(iof->file);
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
if (status == -1) janet_panic("could not close file");
|
||||
return janet_wrap_integer(WEXITSTATUS(status));
|
||||
#else
|
||||
return janet_wrap_nil();
|
||||
#endif
|
||||
} else {
|
||||
if (fclose(iof->file)) {
|
||||
iof->flags |= JANET_FILE_NOT_CLOSEABLE;
|
||||
janet_panic("could not close file");
|
||||
}
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
if (fclose(iof->file)) {
|
||||
iof->flags |= JANET_FILE_NOT_CLOSEABLE;
|
||||
janet_panic("could not close file");
|
||||
}
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
@@ -505,6 +454,7 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||
return janet_wrap_nil();
|
||||
JanetFile *iofile = abstract;
|
||||
io_assert_writeable(iofile);
|
||||
f = iofile->file;
|
||||
break;
|
||||
}
|
||||
@@ -546,27 +496,27 @@ JANET_CORE_FN(cfun_io_print,
|
||||
"(print & xs)",
|
||||
"Print values to the console (standard out). Value are converted "
|
||||
"to strings if they are not already. After printing all values, a "
|
||||
"newline character is printed. Use the value of (dyn :out stdout) to determine "
|
||||
"what to push characters to. Expects (dyn :out stdout) to be either a core/file or "
|
||||
"newline character is printed. Use the value of `(dyn :out stdout)` to determine "
|
||||
"what to push characters to. Expects `(dyn :out stdout)` to be either a core/file or "
|
||||
"a buffer. Returns nil.") {
|
||||
return cfun_io_print_impl(argc, argv, 1, "out", stdout);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_prin,
|
||||
"(prin & xs)",
|
||||
"Same as print, but does not add trailing newline.") {
|
||||
"Same as `print`, but does not add trailing newline.") {
|
||||
return cfun_io_print_impl(argc, argv, 0, "out", stdout);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_eprint,
|
||||
"(eprint & xs)",
|
||||
"Same as print, but uses (dyn :err stderr) instead of (dyn :out stdout).") {
|
||||
"Same as `print`, but uses `(dyn :err stderr)` instead of `(dyn :out stdout)`.") {
|
||||
return cfun_io_print_impl(argc, argv, 1, "err", stderr);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_eprin,
|
||||
"(eprin & xs)",
|
||||
"Same as prin, but uses (dyn :err stderr) instead of (dyn :out stdout).") {
|
||||
"Same as `prin`, but uses `(dyn :err stderr)` instead of `(dyn :out stdout)`.") {
|
||||
return cfun_io_print_impl(argc, argv, 0, "err", stderr);
|
||||
}
|
||||
|
||||
@@ -574,7 +524,7 @@ JANET_CORE_FN(cfun_io_xprint,
|
||||
"(xprint to & xs)",
|
||||
"Print to a file or other value explicitly (no dynamic bindings) with a trailing "
|
||||
"newline character. The value to print "
|
||||
"to is the first argument, and is otherwise the same as print. Returns nil.") {
|
||||
"to is the first argument, and is otherwise the same as `print`. Returns nil.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
return cfun_io_print_impl_x(argc, argv, 1, NULL, 1, argv[0]);
|
||||
}
|
||||
@@ -582,7 +532,7 @@ JANET_CORE_FN(cfun_io_xprint,
|
||||
JANET_CORE_FN(cfun_io_xprin,
|
||||
"(xprin to & xs)",
|
||||
"Print to a file or other value explicitly (no dynamic bindings). The value to print "
|
||||
"to is the first argument, and is otherwise the same as prin. Returns nil.") {
|
||||
"to is the first argument, and is otherwise the same as `prin`. Returns nil.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
return cfun_io_print_impl_x(argc, argv, 0, NULL, 1, argv[0]);
|
||||
}
|
||||
@@ -601,6 +551,16 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
if (newline) janet_buffer_push_u8(buf, '\n');
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
case JANET_FUNCTION: {
|
||||
/* Special case function */
|
||||
JanetFunction *fun = janet_unwrap_function(x);
|
||||
JanetBuffer *buf = janet_buffer(0);
|
||||
janet_buffer_format(buf, fmt, offset, argc, argv);
|
||||
if (newline) janet_buffer_push_u8(buf, '\n');
|
||||
Janet args[1] = { janet_wrap_buffer(buf) };
|
||||
janet_call(fun, 1, args);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
case JANET_NIL:
|
||||
f = dflt_file;
|
||||
if (f == NULL) janet_panic("cannot print to nil");
|
||||
@@ -610,6 +570,10 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||
return janet_wrap_nil();
|
||||
JanetFile *iofile = abstract;
|
||||
if (iofile->flags & JANET_FILE_CLOSED) {
|
||||
janet_panic("cannot print to closed file");
|
||||
}
|
||||
io_assert_writeable(iofile);
|
||||
f = iofile->file;
|
||||
break;
|
||||
}
|
||||
@@ -640,38 +604,38 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
|
||||
|
||||
JANET_CORE_FN(cfun_io_printf,
|
||||
"(printf fmt & xs)",
|
||||
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :out stdout) with a trailing newline.") {
|
||||
"Prints output formatted as if with `(string/format fmt ;xs)` to `(dyn :out stdout)` with a trailing newline.") {
|
||||
return cfun_io_printf_impl(argc, argv, 1, "out", stdout);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_prinf,
|
||||
"(prinf fmt & xs)",
|
||||
"Like printf but with no trailing newline.") {
|
||||
"Like `printf` but with no trailing newline.") {
|
||||
return cfun_io_printf_impl(argc, argv, 0, "out", stdout);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_eprintf,
|
||||
"(eprintf fmt & xs)",
|
||||
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :err stderr) with a trailing newline.") {
|
||||
"Prints output formatted as if with `(string/format fmt ;xs)` to `(dyn :err stderr)` with a trailing newline.") {
|
||||
return cfun_io_printf_impl(argc, argv, 1, "err", stderr);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_eprinf,
|
||||
"(eprinf fmt & xs)",
|
||||
"Like eprintf but with no trailing newline.") {
|
||||
"Like `eprintf` but with no trailing newline.") {
|
||||
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_xprintf,
|
||||
"(xprintf to fmt & xs)",
|
||||
"Like printf but prints to an explicit file or value to. Returns nil.") {
|
||||
"Like `printf` but prints to an explicit file or value `to`. Returns nil.") {
|
||||
janet_arity(argc, 2, -1);
|
||||
return cfun_io_printf_impl_x(argc, argv, 1, NULL, 1, argv[0]);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_xprinf,
|
||||
"(xprinf to fmt & xs)",
|
||||
"Like prinf but prints to an explicit file or value to. Returns nil.") {
|
||||
"Like `prinf` but prints to an explicit file or value `to`. Returns nil.") {
|
||||
janet_arity(argc, 2, -1);
|
||||
return cfun_io_printf_impl_x(argc, argv, 0, NULL, 1, argv[0]);
|
||||
}
|
||||
@@ -696,7 +660,7 @@ static void janet_flusher(const char *name, FILE *dflt_file) {
|
||||
|
||||
JANET_CORE_FN(cfun_io_flush,
|
||||
"(flush)",
|
||||
"Flush (dyn :out stdout) if it is a file, otherwise do nothing.") {
|
||||
"Flush `(dyn :out stdout)` if it is a file, otherwise do nothing.") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
janet_flusher("out", stdout);
|
||||
@@ -705,7 +669,7 @@ JANET_CORE_FN(cfun_io_flush,
|
||||
|
||||
JANET_CORE_FN(cfun_io_eflush,
|
||||
"(eflush)",
|
||||
"Flush (dyn :err stderr) if it is a file, otherwise do nothing.") {
|
||||
"Flush `(dyn :err stderr)` if it is a file, otherwise do nothing.") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
janet_flusher("err", stderr);
|
||||
@@ -734,12 +698,23 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
|
||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||
break;
|
||||
JanetFile *iofile = abstract;
|
||||
io_assert_writeable(iofile);
|
||||
f = iofile->file;
|
||||
}
|
||||
fwrite(buffer.data, buffer.count, 1, f);
|
||||
janet_buffer_deinit(&buffer);
|
||||
break;
|
||||
}
|
||||
case JANET_FUNCTION: {
|
||||
JanetFunction *fun = janet_unwrap_function(x);
|
||||
int32_t len = 0;
|
||||
while (format[len]) len++;
|
||||
JanetBuffer *buf = janet_buffer(len);
|
||||
janet_formatbv(buf, format, args);
|
||||
Janet args[1] = { janet_wrap_buffer(buf) };
|
||||
janet_call(fun, 1, args);
|
||||
break;
|
||||
}
|
||||
case JANET_BUFFER:
|
||||
janet_formatbv(janet_unwrap_buffer(x), format, args);
|
||||
break;
|
||||
@@ -754,17 +729,17 @@ JanetFile *janet_getjfile(const Janet *argv, int32_t n) {
|
||||
return janet_getabstract(argv, n, &janet_file_type);
|
||||
}
|
||||
|
||||
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
|
||||
FILE *janet_getfile(const Janet *argv, int32_t n, int32_t *flags) {
|
||||
JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
|
||||
if (NULL != flags) *flags = iof->flags;
|
||||
return iof->file;
|
||||
}
|
||||
|
||||
JanetFile *janet_makejfile(FILE *f, int flags) {
|
||||
JanetFile *janet_makejfile(FILE *f, int32_t flags) {
|
||||
return makef(f, flags);
|
||||
}
|
||||
|
||||
Janet janet_makefile(FILE *f, int flags) {
|
||||
Janet janet_makefile(FILE *f, int32_t flags) {
|
||||
return janet_wrap_abstract(makef(f, flags));
|
||||
}
|
||||
|
||||
@@ -772,7 +747,7 @@ JanetAbstract janet_checkfile(Janet j) {
|
||||
return janet_checkabstract(j, &janet_file_type);
|
||||
}
|
||||
|
||||
FILE *janet_unwrapfile(Janet j, int *flags) {
|
||||
FILE *janet_unwrapfile(Janet j, int32_t *flags) {
|
||||
JanetFile *iof = janet_unwrap_abstract(j);
|
||||
if (NULL != flags) *flags = iof->flags;
|
||||
return iof->file;
|
||||
@@ -802,9 +777,6 @@ void janet_lib_io(JanetTable *env) {
|
||||
JANET_CORE_REG("file/write", cfun_io_fwrite),
|
||||
JANET_CORE_REG("file/flush", cfun_io_fflush),
|
||||
JANET_CORE_REG("file/seek", cfun_io_fseek),
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
JANET_CORE_REG("file/popen", cfun_io_popen),
|
||||
#endif
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, io_cfuns);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -37,6 +37,7 @@ typedef struct {
|
||||
JanetFuncEnv **seen_envs;
|
||||
JanetFuncDef **seen_defs;
|
||||
int32_t nextid;
|
||||
int maybe_cycles;
|
||||
} MarshalState;
|
||||
|
||||
/* Lead bytes in marshaling protocol */
|
||||
@@ -251,6 +252,8 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
pushint(st, def->environments_length);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
||||
pushint(st, def->defs_length);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP)
|
||||
pushint(st, def->symbolmap_length);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME)
|
||||
marshal_one(st, janet_wrap_string(def->name), flags);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE)
|
||||
@@ -260,6 +263,14 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
for (int32_t i = 0; i < def->constants_length; i++)
|
||||
marshal_one(st, def->constants[i], flags);
|
||||
|
||||
/* Marshal symbol map, if needed */
|
||||
for (int32_t i = 0; i < def->symbolmap_length; i++) {
|
||||
pushint(st, (int32_t) def->symbolmap[i].birth_pc);
|
||||
pushint(st, (int32_t) def->symbolmap[i].death_pc);
|
||||
pushint(st, (int32_t) def->symbolmap[i].slot_index);
|
||||
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags);
|
||||
}
|
||||
|
||||
/* marshal the bytecode */
|
||||
janet_marshal_u32s(st, def->bytecode, def->bytecode_length);
|
||||
|
||||
@@ -269,7 +280,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
|
||||
/* marshal the sub funcdefs if needed */
|
||||
for (int32_t i = 0; i < def->defs_length; i++)
|
||||
marshal_one_def(st, def->defs[i], flags);
|
||||
marshal_one_def(st, def->defs[i], flags + 1);
|
||||
|
||||
/* marshal source maps if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
|
||||
@@ -364,13 +375,15 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
|
||||
|
||||
void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
janet_table_put(&st->seen,
|
||||
janet_wrap_abstract(abstract),
|
||||
janet_wrap_integer(st->nextid++));
|
||||
if (st->maybe_cycles) {
|
||||
janet_table_put(&st->seen,
|
||||
janet_wrap_abstract(abstract),
|
||||
janet_wrap_integer(st->nextid++));
|
||||
}
|
||||
}
|
||||
|
||||
#define MARK_SEEN() \
|
||||
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++))
|
||||
do { if (st->maybe_cycles) janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); } while (0)
|
||||
|
||||
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
@@ -428,11 +441,14 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
|
||||
/* Check reference and registry value */
|
||||
{
|
||||
Janet check = janet_table_get(&st->seen, x);
|
||||
if (janet_checkint(check)) {
|
||||
pushbyte(st, LB_REFERENCE);
|
||||
pushint(st, janet_unwrap_integer(check));
|
||||
return;
|
||||
Janet check;
|
||||
if (st->maybe_cycles) {
|
||||
check = janet_table_get(&st->seen, x);
|
||||
if (janet_checkint(check)) {
|
||||
pushbyte(st, LB_REFERENCE);
|
||||
pushint(st, janet_unwrap_integer(check));
|
||||
return;
|
||||
}
|
||||
}
|
||||
if (st->rreg) {
|
||||
check = janet_table_get(st->rreg, x);
|
||||
@@ -613,6 +629,7 @@ void janet_marshal(
|
||||
st.seen_defs = NULL;
|
||||
st.seen_envs = NULL;
|
||||
st.rreg = rreg;
|
||||
st.maybe_cycles = !(flags & JANET_MARSHAL_NO_CYCLES);
|
||||
janet_table_init(&st.seen, 0);
|
||||
marshal_one(&st, x, flags);
|
||||
janet_table_deinit(&st.seen);
|
||||
@@ -817,6 +834,8 @@ static const uint8_t *unmarshal_one_def(
|
||||
def->constants = NULL;
|
||||
def->bytecode = NULL;
|
||||
def->sourcemap = NULL;
|
||||
def->symbolmap = NULL;
|
||||
def->symbolmap_length = 0;
|
||||
janet_v_push(st->lookup_defs, def);
|
||||
|
||||
/* Set default lengths to zero */
|
||||
@@ -824,6 +843,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
int32_t constants_length = 0;
|
||||
int32_t environments_length = 0;
|
||||
int32_t defs_length = 0;
|
||||
int32_t symbolmap_length = 0;
|
||||
|
||||
/* Read flags and other fixed values */
|
||||
def->flags = readint(st, &data);
|
||||
@@ -839,6 +859,8 @@ static const uint8_t *unmarshal_one_def(
|
||||
environments_length = readnat(st, &data);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
||||
defs_length = readnat(st, &data);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP)
|
||||
symbolmap_length = readnat(st, &data);
|
||||
|
||||
/* Check name and source (optional) */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
|
||||
@@ -867,6 +889,26 @@ static const uint8_t *unmarshal_one_def(
|
||||
}
|
||||
def->constants_length = constants_length;
|
||||
|
||||
/* Unmarshal symbol map, if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP) {
|
||||
size_t size = sizeof(JanetSymbolMap) * symbolmap_length;
|
||||
def->symbolmap = janet_malloc(size);
|
||||
if (def->symbolmap == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (int32_t i = 0; i < symbolmap_length; i++) {
|
||||
def->symbolmap[i].birth_pc = (uint32_t) readint(st, &data);
|
||||
def->symbolmap[i].death_pc = (uint32_t) readint(st, &data);
|
||||
def->symbolmap[i].slot_index = (uint32_t) readint(st, &data);
|
||||
Janet value;
|
||||
data = unmarshal_one(st, data, &value, flags + 1);
|
||||
if (!janet_checktype(value, JANET_SYMBOL))
|
||||
janet_panic("expected symbol in symbol map");
|
||||
def->symbolmap[i].symbol = janet_unwrap_symbol(value);
|
||||
}
|
||||
def->symbolmap_length = (uint32_t) symbolmap_length;
|
||||
}
|
||||
|
||||
/* Unmarshal bytecode */
|
||||
def->bytecode = janet_malloc(sizeof(uint32_t) * bytecode_length);
|
||||
if (!def->bytecode) {
|
||||
@@ -1471,16 +1513,17 @@ JANET_CORE_FN(cfun_env_lookup,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_marshal,
|
||||
"(marshal x &opt reverse-lookup buffer)",
|
||||
"(marshal x &opt reverse-lookup buffer no-cycles)",
|
||||
"Marshal a value into a buffer and return the buffer. The buffer "
|
||||
"can then later be unmarshalled to reconstruct the initial value. "
|
||||
"Optionally, one can pass in a reverse lookup table to not marshal "
|
||||
"aliased values that are found in the table. Then a forward "
|
||||
"lookup table can be used to recover the original value when "
|
||||
"unmarshalling.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
janet_arity(argc, 1, 4);
|
||||
JanetBuffer *buffer;
|
||||
JanetTable *rreg = NULL;
|
||||
uint32_t flags = 0;
|
||||
if (argc > 1) {
|
||||
rreg = janet_gettable(argv, 1);
|
||||
}
|
||||
@@ -1489,7 +1532,10 @@ JANET_CORE_FN(cfun_marshal,
|
||||
} else {
|
||||
buffer = janet_buffer(10);
|
||||
}
|
||||
janet_marshal(buffer, argv[0], rreg, 0);
|
||||
if (argc > 3 && janet_truthy(argv[3])) {
|
||||
flags |= JANET_MARSHAL_NO_CYCLES;
|
||||
}
|
||||
janet_marshal(buffer, argv[0], rreg, flags);
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -231,7 +231,7 @@ static Janet janet_rng_next(void *p, Janet key) {
|
||||
/* Get a random number */
|
||||
JANET_CORE_FN(janet_rand,
|
||||
"(math/random)",
|
||||
"Returns a uniformly distributed random number between 0 and 1") {
|
||||
"Returns a uniformly distributed random number between 0 and 1.") {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_number(janet_rng_double(&janet_vm.rng));
|
||||
@@ -240,7 +240,7 @@ JANET_CORE_FN(janet_rand,
|
||||
/* Seed the random number generator */
|
||||
JANET_CORE_FN(janet_srand,
|
||||
"(math/seedrandom seed)",
|
||||
"Set the seed for the random number generator. seed should be "
|
||||
"Set the seed for the random number generator. `seed` should be "
|
||||
"an integer or a buffer."
|
||||
) {
|
||||
janet_fixarity(argc, 1);
|
||||
@@ -254,14 +254,16 @@ JANET_CORE_FN(janet_srand,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#define JANET_DEFINE_MATHOP(name, fop, doc)\
|
||||
JANET_CORE_FN(janet_##name, "(math/" #name " x)", doc) {\
|
||||
#define JANET_DEFINE_NAMED_MATHOP(c_name, janet_name, fop, doc)\
|
||||
JANET_CORE_FN(janet_##c_name, "(math/" #janet_name " x)", doc) {\
|
||||
janet_fixarity(argc, 1); \
|
||||
double x = janet_getnumber(argv, 0); \
|
||||
return janet_wrap_number(fop(x)); \
|
||||
}
|
||||
|
||||
JANET_DEFINE_MATHOP(acos, acos, "Returns the arccosize of x.")
|
||||
#define JANET_DEFINE_MATHOP(name, fop, doc) JANET_DEFINE_NAMED_MATHOP(name, name, fop, doc)
|
||||
|
||||
JANET_DEFINE_MATHOP(acos, acos, "Returns the arccosine of x.")
|
||||
JANET_DEFINE_MATHOP(asin, asin, "Returns the arcsin of x.")
|
||||
JANET_DEFINE_MATHOP(atan, atan, "Returns the arctangent of x.")
|
||||
JANET_DEFINE_MATHOP(cos, cos, "Returns the cosine of x.")
|
||||
@@ -269,7 +271,7 @@ JANET_DEFINE_MATHOP(cosh, cosh, "Returns the hyperbolic cosine of x.")
|
||||
JANET_DEFINE_MATHOP(acosh, acosh, "Returns the hyperbolic arccosine of x.")
|
||||
JANET_DEFINE_MATHOP(sin, sin, "Returns the sine of x.")
|
||||
JANET_DEFINE_MATHOP(sinh, sinh, "Returns the hyperbolic sine of x.")
|
||||
JANET_DEFINE_MATHOP(asinh, asinh, "Returns the hypberbolic arcsine of x.")
|
||||
JANET_DEFINE_MATHOP(asinh, asinh, "Returns the hyperbolic arcsine of x.")
|
||||
JANET_DEFINE_MATHOP(tan, tan, "Returns the tangent of x.")
|
||||
JANET_DEFINE_MATHOP(tanh, tanh, "Returns the hyperbolic tangent of x.")
|
||||
JANET_DEFINE_MATHOP(atanh, atanh, "Returns the hyperbolic arctangent of x.")
|
||||
@@ -282,12 +284,12 @@ JANET_DEFINE_MATHOP(log2, log2, "Returns the log base 2 of x.")
|
||||
JANET_DEFINE_MATHOP(sqrt, sqrt, "Returns the square root of x.")
|
||||
JANET_DEFINE_MATHOP(cbrt, cbrt, "Returns the cube root of x.")
|
||||
JANET_DEFINE_MATHOP(ceil, ceil, "Returns the smallest integer value number that is not less than x.")
|
||||
JANET_DEFINE_MATHOP(fabs, fabs, "Return the absolute value of x.")
|
||||
JANET_DEFINE_MATHOP(abs, fabs, "Return the absolute value of x.")
|
||||
JANET_DEFINE_MATHOP(floor, floor, "Returns the largest integer value number that is not greater than x.")
|
||||
JANET_DEFINE_MATHOP(trunc, trunc, "Returns the integer between x and 0 nearest to x.")
|
||||
JANET_DEFINE_MATHOP(round, round, "Returns the integer nearest to x.")
|
||||
JANET_DEFINE_MATHOP(gamma, tgamma, "Returns gamma(x).")
|
||||
JANET_DEFINE_MATHOP(lgamma, lgamma, "Returns log-gamma(x).")
|
||||
JANET_DEFINE_NAMED_MATHOP(lgamma, "log-gamma", lgamma, "Returns log-gamma(x).")
|
||||
JANET_DEFINE_MATHOP(log1p, log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
|
||||
JANET_DEFINE_MATHOP(erf, erf, "Returns the error function of x.")
|
||||
JANET_DEFINE_MATHOP(erfc, erfc, "Returns the complementary error function of x.")
|
||||
@@ -303,7 +305,7 @@ JANET_CORE_FN(janet_##name, signature, doc) {\
|
||||
JANET_DEFINE_MATH2OP(atan2, atan2, "(math/atan2 y x)", "Returns the arctangent of y/x. Works even when x is 0.")
|
||||
JANET_DEFINE_MATH2OP(pow, pow, "(math/pow a x)", "Returns a to the power of x.")
|
||||
JANET_DEFINE_MATH2OP(hypot, hypot, "(math/hypot a b)", "Returns c from the equation c^2 = a^2 + b^2.")
|
||||
JANET_DEFINE_MATH2OP(nextafter, nextafter, "(math/next x y)", "Returns the next representable floating point vaue after x in the direction of y.")
|
||||
JANET_DEFINE_MATH2OP(nextafter, nextafter, "(math/next x y)", "Returns the next representable floating point value after x in the direction of y.")
|
||||
|
||||
JANET_CORE_FN(janet_not, "(not x)", "Returns the boolean inverse of x.") {
|
||||
janet_fixarity(argc, 1);
|
||||
@@ -368,7 +370,7 @@ void janet_lib_math(JanetTable *env) {
|
||||
JANET_CORE_REG("math/floor", janet_floor),
|
||||
JANET_CORE_REG("math/ceil", janet_ceil),
|
||||
JANET_CORE_REG("math/pow", janet_pow),
|
||||
JANET_CORE_REG("math/abs", janet_fabs),
|
||||
JANET_CORE_REG("math/abs", janet_abs),
|
||||
JANET_CORE_REG("math/sinh", janet_sinh),
|
||||
JANET_CORE_REG("math/cosh", janet_cosh),
|
||||
JANET_CORE_REG("math/tanh", janet_tanh),
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose and contributors.
|
||||
* Copyright (c) 2023 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
|
||||
@@ -34,9 +34,11 @@
|
||||
#include <windows.h>
|
||||
#include <ws2tcpip.h>
|
||||
#include <mswsock.h>
|
||||
#ifdef JANET_MSVC
|
||||
#pragma comment (lib, "Ws2_32.lib")
|
||||
#pragma comment (lib, "Mswsock.lib")
|
||||
#pragma comment (lib, "Advapi32.lib")
|
||||
#endif
|
||||
#else
|
||||
#include <arpa/inet.h>
|
||||
#include <unistd.h>
|
||||
@@ -173,7 +175,6 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
|
||||
Janet err;
|
||||
SOCKET lsock = (SOCKET) stream->handle;
|
||||
JanetListenerState *s = janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
|
||||
NetStateAccept *state = (NetStateAccept *)s;
|
||||
memset(&state->overlapped, 0, sizeof(WSAOVERLAPPED));
|
||||
@@ -224,7 +225,12 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
|
||||
janet_schedule(s->fiber, janet_wrap_nil());
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
case JANET_ASYNC_EVENT_READ: {
|
||||
#if defined(JANET_LINUX)
|
||||
JSock connfd = accept4(s->stream->handle, NULL, NULL, SOCK_CLOEXEC);
|
||||
#else
|
||||
/* On BSDs, CLOEXEC should be inherited from server socket */
|
||||
JSock connfd = accept(s->stream->handle, NULL, NULL);
|
||||
#endif
|
||||
if (JSOCKVALID(connfd)) {
|
||||
janet_net_socknoblock(connfd);
|
||||
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||
@@ -701,7 +707,7 @@ JANET_CORE_FN(cfun_net_getsockname,
|
||||
if (getsockname((JSock)js->handle, (struct sockaddr *) &ss, &slen)) {
|
||||
janet_panicf("Failed to get localname on %v: %V", argv[0], janet_ev_lasterr());
|
||||
}
|
||||
janet_assert(slen <= sizeof(ss), "socket address truncated");
|
||||
janet_assert(slen <= (socklen_t) sizeof(ss), "socket address truncated");
|
||||
return janet_so_getname(&ss);
|
||||
}
|
||||
|
||||
@@ -717,13 +723,13 @@ JANET_CORE_FN(cfun_net_getpeername,
|
||||
if (getpeername((JSock)js->handle, (struct sockaddr *)&ss, &slen)) {
|
||||
janet_panicf("Failed to get peername on %v: %V", argv[0], janet_ev_lasterr());
|
||||
}
|
||||
janet_assert(slen <= sizeof(ss), "socket address truncated");
|
||||
janet_assert(slen <= (socklen_t) sizeof(ss), "socket address truncated");
|
||||
return janet_so_getname(&ss);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_net_address_unpack,
|
||||
"(net/address-unpack address)",
|
||||
"Given an address returned by net/adress, return a host, port pair. Unix domain sockets "
|
||||
"Given an address returned by net/address, return a host, port pair. Unix domain sockets "
|
||||
"will have only the path in the returned tuple.") {
|
||||
janet_fixarity(argc, 1);
|
||||
struct sockaddr *sa = janet_getabstract(argv, 0, &janet_address_type);
|
||||
@@ -793,7 +799,7 @@ JANET_CORE_FN(cfun_stream_chunk,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_recv_from,
|
||||
"(net/recv-from stream nbytes buf &opt timoeut)",
|
||||
"(net/recv-from stream nbytes buf &opt timeout)",
|
||||
"Receives data from a server stream and puts it into a buffer. Returns the socket-address the "
|
||||
"packet came from. Takes an optional timeout in seconds, after which will return nil.") {
|
||||
janet_arity(argc, 3, 4);
|
||||
@@ -884,7 +890,6 @@ static JanetStream *make_stream(JSock handle, uint32_t flags) {
|
||||
return janet_stream((JanetHandle) handle, flags | JANET_STREAM_SOCKET, net_stream_methods);
|
||||
}
|
||||
|
||||
|
||||
void janet_lib_net(JanetTable *env) {
|
||||
JanetRegExt net_cfuns[] = {
|
||||
JANET_CORE_REG("net/address", cfun_net_sockaddr),
|
||||
|
||||
241
src/core/os.c
241
src/core/os.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose and contributors.
|
||||
* Copyright (c) 2023 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
|
||||
@@ -39,6 +39,14 @@
|
||||
#include <sys/stat.h>
|
||||
#include <signal.h>
|
||||
|
||||
#ifdef JANET_BSD
|
||||
#include <sys/sysctl.h>
|
||||
#endif
|
||||
|
||||
#ifdef JANET_LINUX
|
||||
#include <sched.h>
|
||||
#endif
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#include <direct.h>
|
||||
@@ -110,6 +118,8 @@ JANET_CORE_FN(os_which,
|
||||
"(os/which)",
|
||||
"Check the current operating system. Returns one of:\n\n"
|
||||
"* :windows\n\n"
|
||||
"* :mingw\n\n"
|
||||
"* :cygwin\n\n"
|
||||
"* :macos\n\n"
|
||||
"* :web - Web assembly (emscripten)\n\n"
|
||||
"* :linux\n\n"
|
||||
@@ -122,6 +132,10 @@ JANET_CORE_FN(os_which,
|
||||
(void) argv;
|
||||
#if defined(JANET_OS_NAME)
|
||||
return janet_ckeywordv(janet_stringify(JANET_OS_NAME));
|
||||
#elif defined(JANET_MINGW)
|
||||
return janet_ckeywordv("mingw");
|
||||
#elif defined(JANET_CYGWIN)
|
||||
return janet_ckeywordv("cygwin");
|
||||
#elif defined(JANET_WINDOWS)
|
||||
return janet_ckeywordv("windows");
|
||||
#elif defined(JANET_APPLE)
|
||||
@@ -151,6 +165,8 @@ JANET_CORE_FN(os_arch,
|
||||
"* :x64\n\n"
|
||||
"* :arm\n\n"
|
||||
"* :aarch64\n\n"
|
||||
"* :riscv32\n\n"
|
||||
"* :riscv64\n\n"
|
||||
"* :sparc\n\n"
|
||||
"* :wasm\n\n"
|
||||
"* :unknown\n") {
|
||||
@@ -169,6 +185,10 @@ JANET_CORE_FN(os_arch,
|
||||
return janet_ckeywordv("aarch64");
|
||||
#elif defined(_M_ARM) || defined(__arm__)
|
||||
return janet_ckeywordv("arm");
|
||||
#elif (defined(__riscv) && (__riscv_xlen == 64))
|
||||
return janet_ckeywordv("riscv64");
|
||||
#elif (defined(__riscv) && (__riscv_xlen == 32))
|
||||
return janet_ckeywordv("riscv32");
|
||||
#elif (defined(__sparc__))
|
||||
return janet_ckeywordv("sparc");
|
||||
#elif (defined(__ppc__))
|
||||
@@ -180,6 +200,27 @@ JANET_CORE_FN(os_arch,
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Detect the compiler used to build the interpreter */
|
||||
JANET_CORE_FN(os_compiler,
|
||||
"(os/compiler)",
|
||||
"Get the compiler used to compile the interpreter. Returns one of:\n\n"
|
||||
"* :gcc\n\n"
|
||||
"* :clang\n\n"
|
||||
"* :msvc\n\n"
|
||||
"* :unknown\n\n") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
#if defined(_MSC_VER)
|
||||
return janet_ckeywordv("msvc");
|
||||
#elif defined(__clang__)
|
||||
return janet_ckeywordv("clang");
|
||||
#elif defined(__GNUC__)
|
||||
return janet_ckeywordv("gcc");
|
||||
#else
|
||||
return janet_ckeywordv("unknown");
|
||||
#endif
|
||||
}
|
||||
|
||||
#undef janet_stringify1
|
||||
#undef janet_stringify
|
||||
|
||||
@@ -203,6 +244,48 @@ JANET_CORE_FN(os_exit,
|
||||
|
||||
#ifndef JANET_REDUCED_OS
|
||||
|
||||
JANET_CORE_FN(os_cpu_count,
|
||||
"(os/cpu-count &opt dflt)",
|
||||
"Get an approximate number of CPUs available on for this process to use. If "
|
||||
"unable to get an approximation, will return a default value dflt.") {
|
||||
janet_arity(argc, 0, 1);
|
||||
Janet dflt = argc > 0 ? argv[0] : janet_wrap_nil();
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) dflt;
|
||||
SYSTEM_INFO info;
|
||||
GetSystemInfo(&info);
|
||||
return janet_wrap_integer(info.dwNumberOfProcessors);
|
||||
#elif defined(JANET_LINUX)
|
||||
(void) dflt;
|
||||
cpu_set_t cs;
|
||||
CPU_ZERO(&cs);
|
||||
sched_getaffinity(0, sizeof(cs), &cs);
|
||||
int count = CPU_COUNT(&cs);
|
||||
return janet_wrap_integer(count);
|
||||
#elif defined(JANET_BSD) && defined(HW_NCPUONLINE)
|
||||
(void) dflt;
|
||||
const int name[2] = {CTL_HW, HW_NCPUONLINE};
|
||||
int result = 0;
|
||||
size_t len = sizeof(int);
|
||||
if (-1 == sysctl(name, 2, &result, &len, NULL, 0)) {
|
||||
return dflt;
|
||||
}
|
||||
return janet_wrap_integer(result);
|
||||
#elif defined(JANET_BSD) && defined(HW_NCPU)
|
||||
(void) dflt;
|
||||
const int name[2] = {CTL_HW, HW_NCPU};
|
||||
int result = 0;
|
||||
size_t len = sizeof(int);
|
||||
if (-1 == sysctl(name, 2, &result, &len, NULL, 0)) {
|
||||
return dflt;
|
||||
}
|
||||
return janet_wrap_integer(result);
|
||||
#else
|
||||
return dflt;
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
|
||||
/* Get env for os_execute */
|
||||
@@ -395,7 +478,9 @@ typedef struct {
|
||||
static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
|
||||
JanetProc *proc = (JanetProc *) args.argp;
|
||||
WaitForSingleObject(proc->pHandle, INFINITE);
|
||||
GetExitCodeProcess(proc->pHandle, &args.argi);
|
||||
DWORD exitcode = 0;
|
||||
GetExitCodeProcess(proc->pHandle, &exitcode);
|
||||
args.tag = (int32_t) exitcode;
|
||||
return args;
|
||||
}
|
||||
|
||||
@@ -421,15 +506,7 @@ static int proc_get_status(JanetProc *proc) {
|
||||
/* Function that is called in separate thread to wait on a pid */
|
||||
static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
|
||||
JanetProc *proc = (JanetProc *) args.argp;
|
||||
#ifdef WNOWAIT
|
||||
pid_t result;
|
||||
int status = 0;
|
||||
do {
|
||||
result = waitpid(proc->pid, &status, WNOWAIT);
|
||||
} while (result == -1 && errno == EINTR);
|
||||
#else
|
||||
args.tag = proc_get_status(proc);
|
||||
#endif
|
||||
return args;
|
||||
}
|
||||
|
||||
@@ -440,11 +517,7 @@ static void janet_proc_wait_cb(JanetEVGenericMessage args) {
|
||||
janet_ev_dec_refcount();
|
||||
JanetProc *proc = (JanetProc *) args.argp;
|
||||
if (NULL != proc) {
|
||||
#ifdef WNOWAIT
|
||||
int status = proc_get_status(proc);
|
||||
#else
|
||||
int status = args.tag;
|
||||
#endif
|
||||
proc->return_code = (int32_t) status;
|
||||
proc->flags |= JANET_PROC_WAITED;
|
||||
proc->flags &= ~JANET_PROC_WAITING;
|
||||
@@ -550,8 +623,8 @@ JANET_CORE_FN(os_proc_wait,
|
||||
JANET_CORE_FN(os_proc_kill,
|
||||
"(os/proc-kill proc &opt wait)",
|
||||
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
|
||||
"handle on windows. If wait is truthy, will wait for the process to finish and "
|
||||
"returns the exit code. Otherwise, returns proc.") {
|
||||
"handle on windows. If `wait` is truthy, will wait for the process to finish and "
|
||||
"returns the exit code. Otherwise, returns `proc`.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
if (proc->flags & JANET_PROC_WAITED) {
|
||||
@@ -836,19 +909,19 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
Janet maybe_stdin = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("in"));
|
||||
Janet maybe_stdout = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("out"));
|
||||
Janet maybe_stderr = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("err"));
|
||||
if (janet_keyeq(maybe_stdin, "pipe")) {
|
||||
if (is_spawn && janet_keyeq(maybe_stdin, "pipe")) {
|
||||
new_in = make_pipes(&pipe_in, 1, &pipe_errflag);
|
||||
pipe_owner_flags |= JANET_PROC_OWNS_STDIN;
|
||||
} else if (!janet_checktype(maybe_stdin, JANET_NIL)) {
|
||||
new_in = janet_getjstream(&maybe_stdin, 0, &orig_in);
|
||||
}
|
||||
if (janet_keyeq(maybe_stdout, "pipe")) {
|
||||
if (is_spawn && janet_keyeq(maybe_stdout, "pipe")) {
|
||||
new_out = make_pipes(&pipe_out, 0, &pipe_errflag);
|
||||
pipe_owner_flags |= JANET_PROC_OWNS_STDOUT;
|
||||
} else if (!janet_checktype(maybe_stdout, JANET_NIL)) {
|
||||
new_out = janet_getjstream(&maybe_stdout, 0, &orig_out);
|
||||
}
|
||||
if (janet_keyeq(maybe_stderr, "pipe")) {
|
||||
if (is_spawn && janet_keyeq(maybe_stderr, "pipe")) {
|
||||
new_err = make_pipes(&pipe_err, 0, &pipe_errflag);
|
||||
pipe_owner_flags |= JANET_PROC_OWNS_STDERR;
|
||||
} else if (!janet_checktype(maybe_stderr, JANET_NIL)) {
|
||||
@@ -864,9 +937,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
janet_panic("failed to create pipes");
|
||||
}
|
||||
|
||||
/* Result */
|
||||
int status = 0;
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
HANDLE pHandle, tHandle;
|
||||
@@ -945,6 +1015,9 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
|
||||
#else
|
||||
|
||||
/* Result */
|
||||
int status = 0;
|
||||
|
||||
const char **child_argv = janet_smalloc(sizeof(char *) * ((size_t) exargs.len + 1));
|
||||
for (int32_t i = 0; i < exargs.len; i++)
|
||||
child_argv[i] = janet_getcstring(exargs.items, i);
|
||||
@@ -1063,21 +1136,20 @@ JANET_CORE_FN(os_execute,
|
||||
"`env` is a table or struct mapping environment variables to values. It can also "
|
||||
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
|
||||
"These arguments should be core/file values. "
|
||||
"One can also pass in the :pipe keyword "
|
||||
"for these arguments to create files that will read (for :err and :out) or write (for :in) "
|
||||
"to the file descriptor of the subprocess. This is only useful in `os/spawn`, which takes "
|
||||
"the same parameters as `os/execute`, but will return an object that contains references to these "
|
||||
"files via (return-value :in), (return-value :out), and (return-value :err). "
|
||||
"Returns the exit status of the program.") {
|
||||
return os_execute_impl(argc, argv, 0);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_spawn,
|
||||
"(os/spawn args &opt flags env)",
|
||||
"Execute a program on the system and return a handle to the process. Otherwise, the "
|
||||
"same arguments as os/execute. Does not wait for the process. "
|
||||
"The returned value has the fields :in, :out, :err, :return-code and "
|
||||
"the additional field :pid on unix like platforms.") {
|
||||
"Execute a program on the system and return a handle to the process. Otherwise, takes the "
|
||||
"same arguments as `os/execute`. Does not wait for the process. "
|
||||
"For each of the :in, :out, and :err keys to the `env` argument, one "
|
||||
"can also pass in the keyword `:pipe` "
|
||||
"to get streams for standard IO of the subprocess that can be read from and written to. "
|
||||
"The returned value `proc` has the fields :in, :out, :err, :return-code, and "
|
||||
"the additional field :pid on unix-like platforms. Use `(os/proc-wait proc)` to rejoin the "
|
||||
"subprocess or `(os/proc-kill proc)`.") {
|
||||
return os_execute_impl(argc, argv, 1);
|
||||
}
|
||||
|
||||
@@ -1117,7 +1189,7 @@ JANET_CORE_FN(os_shell,
|
||||
|
||||
JANET_CORE_FN(os_environ,
|
||||
"(os/environ)",
|
||||
"Get a copy of the os environment table.") {
|
||||
"Get a copy of the OS environment table.") {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
int32_t nenv = 0;
|
||||
@@ -1198,7 +1270,7 @@ JANET_CORE_FN(os_time,
|
||||
JANET_CORE_FN(os_clock,
|
||||
"(os/clock)",
|
||||
"Return the number of whole + fractional seconds since some fixed point in time. The clock "
|
||||
"is guaranteed to be non decreasing in real time.") {
|
||||
"is guaranteed to be non-decreasing in real time.") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
struct timespec tv;
|
||||
@@ -1209,7 +1281,7 @@ JANET_CORE_FN(os_clock,
|
||||
|
||||
JANET_CORE_FN(os_sleep,
|
||||
"(os/sleep n)",
|
||||
"Suspend the program for n seconds. 'nsec' can be a real number. Returns "
|
||||
"Suspend the program for `n` seconds. `n` can be a real number. Returns "
|
||||
"nil.") {
|
||||
janet_fixarity(argc, 1);
|
||||
double delay = janet_getnumber(argv, 0);
|
||||
@@ -1246,7 +1318,7 @@ JANET_CORE_FN(os_cwd,
|
||||
|
||||
JANET_CORE_FN(os_cryptorand,
|
||||
"(os/cryptorand n &opt buf)",
|
||||
"Get or append n bytes of good quality random data provided by the OS. Returns a new buffer or buf.") {
|
||||
"Get or append `n` bytes of good quality random data provided by the OS. Returns a new buffer or `buf`.") {
|
||||
JanetBuffer *buffer;
|
||||
janet_arity(argc, 1, 2);
|
||||
int32_t offset;
|
||||
@@ -1288,7 +1360,7 @@ JANET_CORE_FN(os_date,
|
||||
time_t t;
|
||||
struct tm t_infos;
|
||||
struct tm *t_info = NULL;
|
||||
if (argc) {
|
||||
if (argc && !janet_checktype(argv[0], JANET_NIL)) {
|
||||
int64_t integer = janet_getinteger64(argv, 0);
|
||||
t = (time_t) integer;
|
||||
} else {
|
||||
@@ -1297,6 +1369,7 @@ JANET_CORE_FN(os_date,
|
||||
if (argc >= 2 && janet_truthy(argv[1])) {
|
||||
/* local time */
|
||||
#ifdef JANET_WINDOWS
|
||||
_tzset();
|
||||
localtime_s(&t_infos, &t);
|
||||
t_info = &t_infos;
|
||||
#else
|
||||
@@ -1383,9 +1456,9 @@ static timeint_t entry_getint(Janet env_entry, char *field) {
|
||||
JANET_CORE_FN(os_mktime,
|
||||
"(os/mktime date-struct &opt local)",
|
||||
"Get the broken down date-struct time expressed as the number "
|
||||
" of seconds since January 1, 1970, the Unix epoch. "
|
||||
"of seconds since January 1, 1970, the Unix epoch. "
|
||||
"Returns a real number. "
|
||||
"Date is given in UTC unless local is truthy, in which case the "
|
||||
"Date is given in UTC unless `local` is truthy, in which case the "
|
||||
"date is computed for the local timezone.\n\n"
|
||||
"Inverse function to os/date.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
@@ -1456,7 +1529,7 @@ JANET_CORE_FN(os_link,
|
||||
|
||||
JANET_CORE_FN(os_symlink,
|
||||
"(os/symlink oldpath newpath)",
|
||||
"Create a symlink from oldpath to newpath, returning nil. Same as (os/link oldpath newpath true).") {
|
||||
"Create a symlink from oldpath to newpath, returning nil. Same as `(os/link oldpath newpath true)`.") {
|
||||
janet_fixarity(argc, 2);
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
@@ -1731,9 +1804,11 @@ static Janet os_stat_changed(jstat_t *st) {
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
static Janet os_stat_blocks(jstat_t *st) {
|
||||
(void) st;
|
||||
return janet_wrap_number(0);
|
||||
}
|
||||
static Janet os_stat_blocksize(jstat_t *st) {
|
||||
(void) st;
|
||||
return janet_wrap_number(0);
|
||||
}
|
||||
#else
|
||||
@@ -1773,11 +1848,9 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
JanetTable *tab = NULL;
|
||||
int getall = 1;
|
||||
const uint8_t *key;
|
||||
const uint8_t *key = NULL;
|
||||
if (argc == 2) {
|
||||
if (janet_checktype(argv[1], JANET_KEYWORD)) {
|
||||
getall = 0;
|
||||
key = janet_getkeyword(argv, 1);
|
||||
} else {
|
||||
tab = janet_gettable(argv, 1);
|
||||
@@ -1803,7 +1876,7 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
if (getall) {
|
||||
if (NULL == key) {
|
||||
/* 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));
|
||||
@@ -1823,7 +1896,7 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_stat,
|
||||
"(os/stat path &opt tab|key)",
|
||||
"Gets information about a file or directory. Returns a table if the second 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"
|
||||
"only that information from stat. If the file or directory does not exist, returns nil. The keys are:\n\n"
|
||||
"* :dev - the device that the file is on\n\n"
|
||||
"* :mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n\n"
|
||||
"* :int-permissions - A Unix permission integer like 8r744\n\n"
|
||||
@@ -1831,10 +1904,10 @@ JANET_CORE_FN(os_stat,
|
||||
"* :uid - File uid\n\n"
|
||||
"* :gid - File gid\n\n"
|
||||
"* :nlink - number of links to file\n\n"
|
||||
"* :rdev - Real device of file. 0 on windows.\n\n"
|
||||
"* :rdev - Real device of file. 0 on Windows\n\n"
|
||||
"* :size - size of file in bytes\n\n"
|
||||
"* :blocks - number of blocks in file. 0 on windows\n\n"
|
||||
"* :blocksize - size of blocks in file. 0 on windows\n\n"
|
||||
"* :blocks - number of blocks in file. 0 on Windows\n\n"
|
||||
"* :blocksize - size of blocks in file. 0 on Windows\n\n"
|
||||
"* :accessed - timestamp when file last accessed\n\n"
|
||||
"* :changed - timestamp when file last changed (permissions changed)\n\n"
|
||||
"* :modified - timestamp when file last modified (content changed)\n") {
|
||||
@@ -1849,9 +1922,9 @@ JANET_CORE_FN(os_lstat,
|
||||
|
||||
JANET_CORE_FN(os_chmod,
|
||||
"(os/chmod path mode)",
|
||||
"Change file permissions, where mode is a permission string as returned by "
|
||||
"os/perm-string, or an integer as returned by os/perm-int. "
|
||||
"When mode is an integer, it is interpreted as a Unix permission value, best specified in octal, like "
|
||||
"Change file permissions, where `mode` is a permission string as returned by "
|
||||
"`os/perm-string`, or an integer as returned by `os/perm-int`. "
|
||||
"When `mode` is an integer, it is interpreted as a Unix permission value, best specified in octal, like "
|
||||
"8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil.") {
|
||||
janet_fixarity(argc, 2);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
@@ -1933,7 +2006,7 @@ JANET_CORE_FN(os_rename,
|
||||
JANET_CORE_FN(os_realpath,
|
||||
"(os/realpath path)",
|
||||
"Get the absolute path for a given path, following ../, ./, and symlinks. "
|
||||
"Returns an absolute path as a string. Will raise an error on Windows.") {
|
||||
"Returns an absolute path as a string.") {
|
||||
janet_fixarity(argc, 1);
|
||||
const char *src = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_NO_REALPATH
|
||||
@@ -1953,9 +2026,9 @@ JANET_CORE_FN(os_realpath,
|
||||
|
||||
JANET_CORE_FN(os_permission_string,
|
||||
"(os/perm-string int)",
|
||||
"Convert a Unix octal permission value from a permission integer as returned by os/stat "
|
||||
"Convert a Unix octal permission value from a permission integer as returned by `os/stat` "
|
||||
"to a human readable string, that follows the formatting "
|
||||
"of unix tools like ls. Returns the string as a 9 character string of r, w, x and - characters. Does not "
|
||||
"of Unix tools like `ls`. Returns the string as a 9-character string of r, w, x and - characters. Does not "
|
||||
"include the file/directory/symlink character as rendered by `ls`.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return os_make_permstring(os_get_unix_mode(argv, 0));
|
||||
@@ -1963,7 +2036,7 @@ JANET_CORE_FN(os_permission_string,
|
||||
|
||||
JANET_CORE_FN(os_permission_int,
|
||||
"(os/perm-int bytes)",
|
||||
"Parse a 9 character permission string and return an integer that can be used by chmod.") {
|
||||
"Parse a 9-character permission string and return an integer that can be used by chmod.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_integer(os_get_unix_mode(argv, 0));
|
||||
}
|
||||
@@ -1982,28 +2055,28 @@ static jmode_t os_optmode(int32_t argc, const Janet *argv, int32_t n, int32_t df
|
||||
JANET_CORE_FN(os_open,
|
||||
"(os/open path &opt flags mode)",
|
||||
"Create a stream from a file, like the POSIX open system call. Returns a new stream. "
|
||||
"mode should be a file mode as passed to os/chmod, but only if the create flag is given. "
|
||||
"`mode` should be a file mode as passed to `os/chmod`, but only if the create flag is given. "
|
||||
"The default mode is 8r666. "
|
||||
"Allowed flags are as follows:\n\n"
|
||||
" * :r - open this file for reading\n"
|
||||
" * :w - open this file for writing\n"
|
||||
" * :c - create a new file (O_CREATE)\n"
|
||||
" * :e - fail if the file exists (O_EXCL)\n"
|
||||
" * :t - shorten an existing file to length 0 (O_TRUNC)\n\n"
|
||||
"Posix only flags:\n\n"
|
||||
" * :a - append to a file (O_APPEND)\n"
|
||||
" * :x - O_SYNC\n"
|
||||
" * :C - O_NOCTTY\n\n"
|
||||
"Windows only flags:\n\n"
|
||||
" * :R - share reads (FILE_SHARE_READ)\n"
|
||||
" * :W - share writes (FILE_SHARE_WRITE)\n"
|
||||
" * :D - share deletes (FILE_SHARE_DELETE)\n"
|
||||
" * :H - FILE_ATTRIBUTE_HIDDEN\n"
|
||||
" * :O - FILE_ATTRIBUTE_READONLY\n"
|
||||
" * :F - FILE_ATTRIBUTE_OFFLINE\n"
|
||||
" * :T - FILE_ATTRIBUTE_TEMPORARY\n"
|
||||
" * :d - FILE_FLAG_DELETE_ON_CLOSE\n"
|
||||
" * :b - FILE_FLAG_NO_BUFFERING\n") {
|
||||
" * :c - create a new file (O\\_CREATE)\n"
|
||||
" * :e - fail if the file exists (O\\_EXCL)\n"
|
||||
" * :t - shorten an existing file to length 0 (O\\_TRUNC)\n\n"
|
||||
"Posix-only flags:\n\n"
|
||||
" * :a - append to a file (O\\_APPEND)\n"
|
||||
" * :x - O\\_SYNC\n"
|
||||
" * :C - O\\_NOCTTY\n\n"
|
||||
"Windows-only flags:\n\n"
|
||||
" * :R - share reads (FILE\\_SHARE\\_READ)\n"
|
||||
" * :W - share writes (FILE\\_SHARE\\_WRITE)\n"
|
||||
" * :D - share deletes (FILE\\_SHARE\\_DELETE)\n"
|
||||
" * :H - FILE\\_ATTRIBUTE\\_HIDDEN\n"
|
||||
" * :O - FILE\\_ATTRIBUTE\\_READONLY\n"
|
||||
" * :F - FILE\\_ATTRIBUTE\\_OFFLINE\n"
|
||||
" * :T - FILE\\_ATTRIBUTE\\_TEMPORARY\n"
|
||||
" * :d - FILE\\_FLAG\\_DELETE\\_ON\\_CLOSE\n"
|
||||
" * :b - FILE\\_FLAG\\_NO\\_BUFFERING\n") {
|
||||
janet_arity(argc, 1, 3);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
const uint8_t *opt_flags = janet_optkeyword(argv, argc, 1, (const uint8_t *) "r");
|
||||
@@ -2011,6 +2084,7 @@ JANET_CORE_FN(os_open,
|
||||
uint32_t stream_flags = 0;
|
||||
JanetHandle fd;
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) mode;
|
||||
DWORD desiredAccess = 0;
|
||||
DWORD shareMode = 0;
|
||||
DWORD creationDisp = 0;
|
||||
@@ -2100,20 +2174,18 @@ JANET_CORE_FN(os_open,
|
||||
#ifdef JANET_LINUX
|
||||
open_flags |= O_CLOEXEC;
|
||||
#endif
|
||||
int read_flag = 0;
|
||||
int write_flag = 0;
|
||||
for (const uint8_t *c = opt_flags; *c; c++) {
|
||||
switch (*c) {
|
||||
default:
|
||||
break;
|
||||
case 'r':
|
||||
open_flags = (open_flags & O_WRONLY)
|
||||
? ((open_flags & ~O_WRONLY) | O_RDWR)
|
||||
: (open_flags | O_RDONLY);
|
||||
read_flag = 1;
|
||||
stream_flags |= JANET_STREAM_READABLE;
|
||||
break;
|
||||
case 'w':
|
||||
open_flags = (open_flags & O_RDONLY)
|
||||
? ((open_flags & ~O_RDONLY) | O_RDWR)
|
||||
: (open_flags | O_WRONLY);
|
||||
write_flag = 1;
|
||||
stream_flags |= JANET_STREAM_WRITABLE;
|
||||
break;
|
||||
case 'c':
|
||||
@@ -2137,6 +2209,15 @@ JANET_CORE_FN(os_open,
|
||||
break;
|
||||
}
|
||||
}
|
||||
/* If both read and write, fix up to O_RDWR */
|
||||
if (read_flag && !write_flag) {
|
||||
open_flags |= O_RDONLY;
|
||||
} else if (write_flag && !read_flag) {
|
||||
open_flags |= O_WRONLY;
|
||||
} else {
|
||||
open_flags = O_RDWR;
|
||||
}
|
||||
|
||||
do {
|
||||
fd = open(path, open_flags, mode);
|
||||
} while (fd == -1 && errno == EINTR);
|
||||
@@ -2147,7 +2228,7 @@ JANET_CORE_FN(os_open,
|
||||
|
||||
JANET_CORE_FN(os_pipe,
|
||||
"(os/pipe)",
|
||||
"Create a readable stream and a writable stream that are connected. Returns a two element "
|
||||
"Create a readable stream and a writable stream that are connected. Returns a two-element "
|
||||
"tuple where the first element is a readable stream and the second element is the writable "
|
||||
"stream.") {
|
||||
(void) argv;
|
||||
@@ -2187,6 +2268,7 @@ void janet_lib_os(JanetTable *env) {
|
||||
JANET_CORE_REG("os/exit", os_exit),
|
||||
JANET_CORE_REG("os/which", os_which),
|
||||
JANET_CORE_REG("os/arch", os_arch),
|
||||
JANET_CORE_REG("os/compiler", os_compiler),
|
||||
#ifndef JANET_REDUCED_OS
|
||||
JANET_CORE_REG("os/environ", os_environ),
|
||||
JANET_CORE_REG("os/getenv", os_getenv),
|
||||
@@ -2196,6 +2278,7 @@ void janet_lib_os(JanetTable *env) {
|
||||
JANET_CORE_REG("os/chmod", os_chmod),
|
||||
JANET_CORE_REG("os/touch", os_touch),
|
||||
JANET_CORE_REG("os/cd", os_cd),
|
||||
JANET_CORE_REG("os/cpu-count", os_cpu_count),
|
||||
#ifndef JANET_NO_UMASK
|
||||
JANET_CORE_REG("os/umask", os_umask),
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -206,6 +206,37 @@ static void popstate(JanetParser *p, Janet val) {
|
||||
}
|
||||
}
|
||||
|
||||
static void delim_error(JanetParser *parser, size_t stack_index, char c, const char *msg) {
|
||||
JanetParseState *s = parser->states + stack_index;
|
||||
JanetBuffer *buffer = janet_buffer(40);
|
||||
if (msg) {
|
||||
janet_buffer_push_cstring(buffer, msg);
|
||||
}
|
||||
if (c) {
|
||||
janet_buffer_push_u8(buffer, c);
|
||||
}
|
||||
if (stack_index > 0) {
|
||||
janet_buffer_push_cstring(buffer, ", ");
|
||||
if (s->flags & PFLAG_PARENS) {
|
||||
janet_buffer_push_u8(buffer, '(');
|
||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||
janet_buffer_push_u8(buffer, '[');
|
||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||
janet_buffer_push_u8(buffer, '{');
|
||||
} else if (s->flags & PFLAG_STRING) {
|
||||
janet_buffer_push_u8(buffer, '"');
|
||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||
int32_t i;
|
||||
for (i = 0; i < s->argn; i++) {
|
||||
janet_buffer_push_u8(buffer, '`');
|
||||
}
|
||||
}
|
||||
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
|
||||
}
|
||||
parser->error = (const char *) janet_string(buffer->data, buffer->count);
|
||||
parser->flag |= JANET_PARSER_GENERATED_ERROR;
|
||||
}
|
||||
|
||||
static int checkescape(uint8_t c) {
|
||||
switch (c) {
|
||||
default:
|
||||
@@ -612,7 +643,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
case '}': {
|
||||
Janet ds;
|
||||
if (p->statecount == 1) {
|
||||
p->error = "unexpected delimiter";
|
||||
delim_error(p, 0, c, "unexpected closing delimiter ");
|
||||
return 1;
|
||||
}
|
||||
if ((c == ')' && (state->flags & PFLAG_PARENS)) ||
|
||||
@@ -633,7 +664,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
ds = close_struct(p, state);
|
||||
}
|
||||
} else {
|
||||
p->error = "mismatched delimiter";
|
||||
delim_error(p, p->statecount - 1, c, "mismatched delimiter ");
|
||||
return 1;
|
||||
}
|
||||
popstate(p, ds);
|
||||
@@ -684,26 +715,7 @@ void janet_parser_eof(JanetParser *parser) {
|
||||
size_t oldline = parser->line;
|
||||
janet_parser_consume(parser, '\n');
|
||||
if (parser->statecount > 1) {
|
||||
JanetParseState *s = parser->states + (parser->statecount - 1);
|
||||
JanetBuffer *buffer = janet_buffer(40);
|
||||
janet_buffer_push_cstring(buffer, "unexpected end of source, ");
|
||||
if (s->flags & PFLAG_PARENS) {
|
||||
janet_buffer_push_u8(buffer, '(');
|
||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||
janet_buffer_push_u8(buffer, '[');
|
||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||
janet_buffer_push_u8(buffer, '{');
|
||||
} else if (s->flags & PFLAG_STRING) {
|
||||
janet_buffer_push_u8(buffer, '"');
|
||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||
int32_t i;
|
||||
for (i = 0; i < s->argn; i++) {
|
||||
janet_buffer_push_u8(buffer, '`');
|
||||
}
|
||||
}
|
||||
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
|
||||
parser->error = (const char *) janet_string(buffer->data, buffer->count);
|
||||
parser->flag |= JANET_PARSER_GENERATED_ERROR;
|
||||
delim_error(parser, parser->statecount - 1, 0, "unexpected end of source");
|
||||
}
|
||||
parser->line = oldline;
|
||||
parser->column = oldcolumn;
|
||||
@@ -883,7 +895,7 @@ const JanetAbstractType janet_parser_type = {
|
||||
JANET_CORE_FN(cfun_parse_parser,
|
||||
"(parser/new)",
|
||||
"Creates and returns a new parser object. Parsers are state machines "
|
||||
"that can receive bytes, and generate a stream of values.") {
|
||||
"that can receive bytes and generate a stream of values.") {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
JanetParser *p = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||
@@ -894,7 +906,7 @@ JANET_CORE_FN(cfun_parse_parser,
|
||||
JANET_CORE_FN(cfun_parse_consume,
|
||||
"(parser/consume parser bytes &opt index)",
|
||||
"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.") {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
@@ -922,7 +934,7 @@ JANET_CORE_FN(cfun_parse_consume,
|
||||
|
||||
JANET_CORE_FN(cfun_parse_eof,
|
||||
"(parser/eof parser)",
|
||||
"Indicate that the end of file was reached to the parser. This puts the parser in the :dead state.") {
|
||||
"Indicate to the parser that the end of file was reached. This puts the parser in the :dead state.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
janet_parser_eof(p);
|
||||
@@ -982,7 +994,7 @@ JANET_CORE_FN(cfun_parse_has_more,
|
||||
|
||||
JANET_CORE_FN(cfun_parse_byte,
|
||||
"(parser/byte parser b)",
|
||||
"Input a single byte into the parser byte stream. Returns the parser.") {
|
||||
"Input a single byte `b` into the parser byte stream. Returns the parser.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
int32_t i = janet_getinteger(argv, 1);
|
||||
@@ -1022,7 +1034,7 @@ JANET_CORE_FN(cfun_parse_error,
|
||||
"If the parser is in the error state, returns the message associated with "
|
||||
"that error. Otherwise, returns nil. Also flushes the parser state and parser "
|
||||
"queue, so be sure to handle everything in the queue before calling "
|
||||
"parser/error.") {
|
||||
"`parser/error`.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
const char *err = janet_parser_error(p);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -211,9 +211,10 @@ tail:
|
||||
}
|
||||
|
||||
case RULE_SET: {
|
||||
if (text >= s->text_end) return NULL;
|
||||
uint32_t word = rule[1 + (text[0] >> 5)];
|
||||
uint32_t mask = (uint32_t)1 << (text[0] & 0x1F);
|
||||
return (text < s->text_end && (word & mask))
|
||||
return (word & mask)
|
||||
? text + 1
|
||||
: NULL;
|
||||
}
|
||||
@@ -260,30 +261,52 @@ tail:
|
||||
goto tail;
|
||||
}
|
||||
|
||||
case RULE_IF:
|
||||
case RULE_IFNOT: {
|
||||
case RULE_IF: {
|
||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||
const uint32_t *rule_b = s->bytecode + rule[2];
|
||||
down1(s);
|
||||
const uint8_t *result = peg_rule(s, rule_a, text);
|
||||
up1(s);
|
||||
if (rule[0] == RULE_IF ? !result : !!result) return NULL;
|
||||
if (!result) return NULL;
|
||||
rule = rule_b;
|
||||
goto tail;
|
||||
}
|
||||
case RULE_IFNOT: {
|
||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||
const uint32_t *rule_b = s->bytecode + rule[2];
|
||||
down1(s);
|
||||
CapState cs = cap_save(s);
|
||||
const uint8_t *result = peg_rule(s, rule_a, text);
|
||||
if (!!result) {
|
||||
up1(s);
|
||||
return NULL;
|
||||
} else {
|
||||
cap_load(s, cs);
|
||||
up1(s);
|
||||
rule = rule_b;
|
||||
goto tail;
|
||||
}
|
||||
}
|
||||
|
||||
case RULE_NOT: {
|
||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||
down1(s);
|
||||
CapState cs = cap_save(s);
|
||||
const uint8_t *result = peg_rule(s, rule_a, text);
|
||||
up1(s);
|
||||
return (result) ? NULL : text;
|
||||
if (result) {
|
||||
up1(s);
|
||||
return NULL;
|
||||
} else {
|
||||
cap_load(s, cs);
|
||||
up1(s);
|
||||
return text;
|
||||
}
|
||||
}
|
||||
|
||||
case RULE_THRU:
|
||||
case RULE_TO: {
|
||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||
const uint8_t *next_text;
|
||||
const uint8_t *next_text = NULL;
|
||||
CapState cs = cap_save(s);
|
||||
down1(s);
|
||||
while (text <= s->text_end) {
|
||||
@@ -293,6 +316,7 @@ tail:
|
||||
if (rule[0] == RULE_TO) cap_load(s, cs2);
|
||||
break;
|
||||
}
|
||||
cap_load(s, cs2);
|
||||
text++;
|
||||
}
|
||||
up1(s);
|
||||
@@ -1660,7 +1684,9 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
||||
}
|
||||
|
||||
static void peg_call_reset(PegCall *c) {
|
||||
c->s.depth = JANET_RECURSION_GUARD;
|
||||
c->s.captures->count = 0;
|
||||
c->s.tagged_captures->count = 0;
|
||||
c->s.scratch->count = 0;
|
||||
c->s.tags->count = 0;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -30,6 +30,7 @@
|
||||
|
||||
#include <string.h>
|
||||
#include <ctype.h>
|
||||
#include <inttypes.h>
|
||||
|
||||
/* Implements a pretty printer for Janet. The pretty printer
|
||||
* is simple and not that flexible, but fast. */
|
||||
@@ -108,7 +109,7 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
|
||||
pbuf.p = pointer;
|
||||
*c++ = '<';
|
||||
/* Maximum of 32 bytes for abstract type name */
|
||||
for (i = 0; title[i] && i < 32; ++i)
|
||||
for (i = 0; i < 32 && title[i]; ++i)
|
||||
*c++ = ((uint8_t *)title) [i];
|
||||
*c++ = ' ';
|
||||
*c++ = '0';
|
||||
@@ -750,20 +751,46 @@ static void pushtypes(JanetBuffer *buffer, int types) {
|
||||
|
||||
#define MAX_ITEM 256
|
||||
#define FMT_FLAGS "-+ #0"
|
||||
#define FMT_REPLACE_INTTYPES "diouxX"
|
||||
#define MAX_FORMAT 32
|
||||
|
||||
struct FmtMapping {
|
||||
char c;
|
||||
const char *mapping;
|
||||
};
|
||||
|
||||
/* Janet uses fixed width integer types for most things, so map
|
||||
* format specifiers to these fixed sizes */
|
||||
static const struct FmtMapping format_mappings[] = {
|
||||
{'d', PRId64},
|
||||
{'i', PRIi64},
|
||||
{'o', PRIo64},
|
||||
{'u', PRIu64},
|
||||
{'x', PRIx64},
|
||||
{'X', PRIX64},
|
||||
};
|
||||
|
||||
static const char *get_fmt_mapping(char c) {
|
||||
for (size_t i = 0; i < (sizeof(format_mappings) / sizeof(struct FmtMapping)); i++) {
|
||||
if (format_mappings[i].c == c)
|
||||
return format_mappings[i].mapping;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static const char *scanformat(
|
||||
const char *strfrmt,
|
||||
char *form,
|
||||
char width[3],
|
||||
char precision[3]) {
|
||||
const char *p = strfrmt;
|
||||
|
||||
/* Parse strfrmt */
|
||||
memset(width, '\0', 3);
|
||||
memset(precision, '\0', 3);
|
||||
while (*p != '\0' && strchr(FMT_FLAGS, *p) != NULL)
|
||||
p++; /* skip flags */
|
||||
if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS) / sizeof(char))
|
||||
janet_panic("invalid format (repeated flags)");
|
||||
if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS)) janet_panic("invalid format (repeated flags)");
|
||||
if (isdigit((int)(*p)))
|
||||
width[0] = *p++; /* skip width */
|
||||
if (isdigit((int)(*p)))
|
||||
@@ -777,10 +804,22 @@ static const char *scanformat(
|
||||
}
|
||||
if (isdigit((int)(*p)))
|
||||
janet_panic("invalid format (width or precision too long)");
|
||||
|
||||
/* Write to form - replace characters with fixed size stuff */
|
||||
*(form++) = '%';
|
||||
memcpy(form, strfrmt, ((p - strfrmt) + 1) * sizeof(char));
|
||||
form += (p - strfrmt) + 1;
|
||||
const char *p2 = strfrmt;
|
||||
while (p2 <= p) {
|
||||
if (strchr(FMT_REPLACE_INTTYPES, *p2) != NULL) {
|
||||
const char *mapping = get_fmt_mapping(*p2++);
|
||||
size_t len = strlen(mapping);
|
||||
strcpy(form, mapping);
|
||||
form += len;
|
||||
} else {
|
||||
*(form++) = *(p2++);
|
||||
}
|
||||
}
|
||||
*form = '\0';
|
||||
|
||||
return p;
|
||||
}
|
||||
|
||||
@@ -805,11 +844,16 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
break;
|
||||
}
|
||||
case 'd':
|
||||
case 'i':
|
||||
case 'o':
|
||||
case 'i': {
|
||||
int64_t n = va_arg(args, long);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
case 'x':
|
||||
case 'X': {
|
||||
int32_t n = va_arg(args, long);
|
||||
case 'X':
|
||||
case 'o':
|
||||
case 'u': {
|
||||
uint64_t n = va_arg(args, unsigned long);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
@@ -963,11 +1007,16 @@ void janet_buffer_format(
|
||||
break;
|
||||
}
|
||||
case 'd':
|
||||
case 'i':
|
||||
case 'o':
|
||||
case 'i': {
|
||||
int64_t n = janet_getinteger64(argv, arg);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
case 'x':
|
||||
case 'X': {
|
||||
int32_t n = janet_getinteger(argv, arg);
|
||||
case 'X':
|
||||
case 'o':
|
||||
case 'u': {
|
||||
uint64_t n = janet_getuinteger64(argv, arg);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
@@ -983,8 +1032,9 @@ void janet_buffer_format(
|
||||
break;
|
||||
}
|
||||
case 's': {
|
||||
const uint8_t *s = janet_getstring(argv, arg);
|
||||
int32_t l = janet_string_length(s);
|
||||
JanetByteView bytes = janet_getbytes(argv, arg);
|
||||
const uint8_t *s = bytes.bytes;
|
||||
int32_t l = bytes.len;
|
||||
if (form[2] == '\0')
|
||||
janet_buffer_push_bytes(b, s, l);
|
||||
else {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -80,9 +80,9 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
const char *e = janet_parser_error(&parser);
|
||||
errflags |= 0x04;
|
||||
ret = janet_cstringv(e);
|
||||
size_t line = parser.line;
|
||||
size_t col = parser.column;
|
||||
janet_eprintf("%s:%lu:%lu: parse error: %s\n", sourcePath, line, col, e);
|
||||
int32_t line = (int32_t) parser.line;
|
||||
int32_t col = (int32_t) parser.column;
|
||||
janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e);
|
||||
done = 1;
|
||||
break;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -31,7 +31,7 @@
|
||||
|
||||
static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
if (argn != 1) {
|
||||
janetc_cerror(opts.compiler, "expected 1 argument");
|
||||
janetc_cerror(opts.compiler, "expected 1 argument to quote");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
return janetc_cslot(argv[0]);
|
||||
@@ -40,7 +40,7 @@ static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
static JanetSlot janetc_splice(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
JanetSlot ret;
|
||||
if (argn != 1) {
|
||||
janetc_cerror(opts.compiler, "expected 1 argument");
|
||||
janetc_cerror(opts.compiler, "expected 1 argument to splice");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
ret = janetc_value(opts, argv[0]);
|
||||
@@ -117,7 +117,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
||||
|
||||
static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
if (argn != 1) {
|
||||
janetc_cerror(opts.compiler, "expected 1 argument");
|
||||
janetc_cerror(opts.compiler, "expected 1 argument to quasiquote");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0);
|
||||
@@ -143,7 +143,7 @@ static int destructure(JanetCompiler *c,
|
||||
JanetTable *attr) {
|
||||
switch (janet_type(left)) {
|
||||
default:
|
||||
janetc_cerror(c, "unexpected type in destructuring");
|
||||
janetc_error(c, janet_formatc("unexpected type in destruction, got %v", left));
|
||||
return 1;
|
||||
case JANET_SYMBOL:
|
||||
/* Leaf, assign right to left */
|
||||
@@ -302,11 +302,17 @@ static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv) {
|
||||
int32_t i;
|
||||
JanetTable *tab = janet_table(2);
|
||||
const char *binding_name = janet_type(argv[0]) == JANET_SYMBOL
|
||||
? ((const char *)janet_unwrap_symbol(argv[0]))
|
||||
: "<multiple bindings>";
|
||||
for (i = 1; i < argn - 1; i++) {
|
||||
Janet attr = argv[i];
|
||||
switch (janet_type(attr)) {
|
||||
case JANET_TUPLE:
|
||||
janetc_cerror(c, "unexpected form - did you intend to use defn?");
|
||||
break;
|
||||
default:
|
||||
janetc_cerror(c, "could not add metadata to binding");
|
||||
janetc_error(c, janet_formatc("cannot add metadata %v to binding %s", attr, binding_name));
|
||||
break;
|
||||
case JANET_KEYWORD:
|
||||
janet_table_put(tab, attr, janet_wrap_true());
|
||||
@@ -390,10 +396,11 @@ static int varleaf(
|
||||
static JanetSlot janetc_var(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
Janet head;
|
||||
JanetTable *attr_table = handleattr(c, argn, argv);
|
||||
JanetSlot ret = dohead(c, opts, &head, argn, argv);
|
||||
if (c->result.status == JANET_COMPILE_ERROR)
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
destructure(c, argv[0], ret, varleaf, handleattr(c, argn, argv));
|
||||
destructure(c, argv[0], ret, varleaf, attr_table);
|
||||
return ret;
|
||||
}
|
||||
|
||||
@@ -439,10 +446,11 @@ static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
Janet head;
|
||||
opts.flags &= ~JANET_FOPTS_HINT;
|
||||
JanetTable *attr_table = handleattr(c, argn, argv);
|
||||
JanetSlot ret = dohead(c, opts, &head, argn, argv);
|
||||
if (c->result.status == JANET_COMPILE_ERROR)
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
destructure(c, argv[0], ret, defleaf, handleattr(c, argn, argv));
|
||||
destructure(c, argv[0], ret, defleaf, attr_table);
|
||||
return ret;
|
||||
}
|
||||
|
||||
@@ -805,7 +813,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
JanetSlot ret;
|
||||
Janet head;
|
||||
JanetScope fnscope;
|
||||
int32_t paramcount, argi, parami, arity, min_arity, max_arity, defindex, i;
|
||||
int32_t paramcount, argi, parami, arity, min_arity = 0, max_arity, defindex, i;
|
||||
JanetFopts subopts = janetc_fopts_default(c);
|
||||
const Janet *params;
|
||||
const char *errmsg = NULL;
|
||||
@@ -817,6 +825,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
int selfref = 0;
|
||||
int seenamp = 0;
|
||||
int seenopt = 0;
|
||||
int namedargs = 0;
|
||||
|
||||
/* Begin function */
|
||||
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
||||
@@ -841,6 +850,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
|
||||
/* Keep track of destructured parameters */
|
||||
JanetSlot *destructed_params = NULL;
|
||||
JanetSlot *named_params = NULL;
|
||||
JanetTable *named_table = NULL;
|
||||
JanetSlot named_slot;
|
||||
|
||||
/* Compile function parameters */
|
||||
params = janet_unwrap_tuple(argv[parami]);
|
||||
@@ -848,49 +860,75 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
arity = paramcount;
|
||||
for (i = 0; i < paramcount; i++) {
|
||||
Janet param = params[i];
|
||||
if (janet_checktype(param, JANET_SYMBOL)) {
|
||||
if (namedargs) {
|
||||
arity--;
|
||||
if (!janet_checktype(param, JANET_SYMBOL)) {
|
||||
errmsg = "only named arguments can follow &named";
|
||||
goto error;
|
||||
}
|
||||
Janet key = janet_wrap_keyword(janet_unwrap_symbol(param));
|
||||
janet_table_put(named_table, key, param);
|
||||
janet_v_push(named_params, janetc_farslot(c));
|
||||
} else if (janet_checktype(param, JANET_SYMBOL)) {
|
||||
/* Check for varargs and unfixed arity */
|
||||
if (!janet_cstrcmp(janet_unwrap_symbol(param), "&")) {
|
||||
if (seenamp) {
|
||||
errmsg = "& in unexpected location";
|
||||
goto error;
|
||||
} else if (i == paramcount - 1) {
|
||||
allow_extra = 1;
|
||||
const uint8_t *sym = janet_unwrap_symbol(param);
|
||||
if (sym[0] == '&') {
|
||||
if (!janet_cstrcmp(sym, "&")) {
|
||||
if (seenamp) {
|
||||
errmsg = "& in unexpected location";
|
||||
goto error;
|
||||
} else if (i == paramcount - 1) {
|
||||
allow_extra = 1;
|
||||
arity--;
|
||||
} else if (i == paramcount - 2) {
|
||||
vararg = 1;
|
||||
arity -= 2;
|
||||
} else {
|
||||
errmsg = "& in unexpected location";
|
||||
goto error;
|
||||
}
|
||||
seenamp = 1;
|
||||
} else if (!janet_cstrcmp(sym, "&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--;
|
||||
} else if (i == paramcount - 2) {
|
||||
vararg = 1;
|
||||
arity -= 2;
|
||||
} else {
|
||||
errmsg = "& in unexpected location";
|
||||
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) {
|
||||
seenopt = 1;
|
||||
} else if (!janet_cstrcmp(sym, "&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 if (!janet_cstrcmp(sym, "&named")) {
|
||||
if (seenamp) {
|
||||
errmsg = "&named in unexpected location";
|
||||
goto error;
|
||||
}
|
||||
vararg = 1;
|
||||
structarg = 1;
|
||||
arity -= 2;
|
||||
arity--;
|
||||
seenamp = 1;
|
||||
namedargs = 1;
|
||||
named_table = janet_table(10);
|
||||
named_slot = janetc_farslot(c);
|
||||
} else {
|
||||
errmsg = "&keys in unexpected location";
|
||||
goto error;
|
||||
janetc_nameslot(c, sym, janetc_farslot(c));
|
||||
}
|
||||
seenamp = 1;
|
||||
} else {
|
||||
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
||||
janetc_nameslot(c, sym, janetc_farslot(c));
|
||||
}
|
||||
} else {
|
||||
janet_v_push(destructed_params, janetc_farslot(c));
|
||||
@@ -909,6 +947,14 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
}
|
||||
janet_v_free(destructed_params);
|
||||
|
||||
/* Compile named arguments */
|
||||
if (namedargs) {
|
||||
Janet param = janet_wrap_table(named_table);
|
||||
destructure(c, param, named_slot, defleaf, NULL);
|
||||
janetc_freeslot(c, named_slot);
|
||||
janet_v_free(named_params);
|
||||
}
|
||||
|
||||
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
|
||||
if (!seenopt) min_arity = arity;
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -25,6 +25,12 @@
|
||||
|
||||
#include <stdint.h>
|
||||
|
||||
#ifdef JANET_EV
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <pthread.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
typedef int64_t JanetTimestamp;
|
||||
|
||||
typedef struct JanetScratch {
|
||||
@@ -54,7 +60,7 @@ typedef struct {
|
||||
int is_error;
|
||||
} JanetTimeout;
|
||||
|
||||
/* Registry table for C functions - containts metadata that can
|
||||
/* Registry table for C functions - contains metadata that can
|
||||
* be looked up by cfunction pointer. All strings here are pointing to
|
||||
* static memory not managed by Janet. */
|
||||
typedef struct {
|
||||
@@ -85,7 +91,7 @@ struct JanetVM {
|
||||
int auto_suspend;
|
||||
|
||||
/* The current running fiber on the current thread.
|
||||
* Set and unset by janet_run. */
|
||||
* Set and unset by functions in vm.c */
|
||||
JanetFiber *fiber;
|
||||
JanetFiber *root_fiber;
|
||||
|
||||
@@ -101,7 +107,7 @@ struct JanetVM {
|
||||
size_t registry_count;
|
||||
int registry_dirty;
|
||||
|
||||
/* Registry for abstract abstract types that can be marshalled.
|
||||
/* Registry for abstract types that can be marshalled.
|
||||
* We need this to look up the constructors when unmarshalling. */
|
||||
JanetTable *abstract_registry;
|
||||
|
||||
@@ -152,16 +158,19 @@ struct JanetVM {
|
||||
#ifdef JANET_WINDOWS
|
||||
void **iocp;
|
||||
#elif defined(JANET_EV_EPOLL)
|
||||
pthread_attr_t new_thread_attr;
|
||||
JanetHandle selfpipe[2];
|
||||
int epoll;
|
||||
int timerfd;
|
||||
int timer_enabled;
|
||||
#elif defined(JANET_EV_KQUEUE)
|
||||
pthread_attr_t new_thread_attr;
|
||||
JanetHandle selfpipe[2];
|
||||
int kq;
|
||||
int timer;
|
||||
int timer_enabled;
|
||||
#else
|
||||
pthread_attr_t new_thread_attr;
|
||||
JanetHandle selfpipe[2];
|
||||
struct pollfd *fds;
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -173,10 +173,10 @@ static int32_t kmp_next(struct kmp_state *state) {
|
||||
JANET_CORE_FN(cfun_string_slice,
|
||||
"(string/slice bytes &opt start end)",
|
||||
"Returns a substring from a byte sequence. The substring is from "
|
||||
"index start inclusive to index end exclusive. All indexing "
|
||||
"is from 0. 'start' and 'end' can also be negative to indicate indexing "
|
||||
"index `start` inclusive to index `end`, exclusive. All indexing "
|
||||
"is from 0. `start` and `end` can also be negative to indicate indexing "
|
||||
"from the end of the string. Note that index -1 is synonymous with "
|
||||
"index (length bytes) to allow a full negative slice range. ") {
|
||||
"index `(length bytes)` to allow a full negative slice range. ") {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_stringv(view.bytes + range.start, range.end - range.start);
|
||||
@@ -184,7 +184,7 @@ JANET_CORE_FN(cfun_string_slice,
|
||||
|
||||
JANET_CORE_FN(cfun_symbol_slice,
|
||||
"(symbol/slice bytes &opt start end)",
|
||||
"Same a string/slice, but returns a symbol.") {
|
||||
"Same as string/slice, but returns a symbol.") {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_symbolv(view.bytes + range.start, range.end - range.start);
|
||||
@@ -192,7 +192,7 @@ JANET_CORE_FN(cfun_symbol_slice,
|
||||
|
||||
JANET_CORE_FN(cfun_keyword_slice,
|
||||
"(keyword/slice bytes &opt start end)",
|
||||
"Same a string/slice, but returns a keyword.") {
|
||||
"Same as string/slice, but returns a keyword.") {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_keywordv(view.bytes + range.start, range.end - range.start);
|
||||
@@ -200,7 +200,7 @@ JANET_CORE_FN(cfun_keyword_slice,
|
||||
|
||||
JANET_CORE_FN(cfun_string_repeat,
|
||||
"(string/repeat bytes n)",
|
||||
"Returns a string that is n copies of bytes concatenated.") {
|
||||
"Returns a string that is `n` copies of `bytes` concatenated.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
int32_t rep = janet_getinteger(argv, 1);
|
||||
@@ -282,7 +282,7 @@ JANET_CORE_FN(cfun_string_asciiupper,
|
||||
|
||||
JANET_CORE_FN(cfun_string_reverse,
|
||||
"(string/reverse str)",
|
||||
"Returns a string that is the reversed version of str.") {
|
||||
"Returns a string that is the reversed version of `str`.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
uint8_t *buf = janet_string_begin(view.len);
|
||||
@@ -308,8 +308,8 @@ static void findsetup(int32_t argc, Janet *argv, struct kmp_state *s, int32_t ex
|
||||
|
||||
JANET_CORE_FN(cfun_string_find,
|
||||
"(string/find patt str &opt start-index)",
|
||||
"Searches for the first instance of pattern patt in string "
|
||||
"str. Returns the index of the first character in patt if found, "
|
||||
"Searches for the first instance of pattern `patt` in string "
|
||||
"`str`. Returns the index of the first character in `patt` if found, "
|
||||
"otherwise returns nil.") {
|
||||
int32_t result;
|
||||
struct kmp_state state;
|
||||
@@ -323,7 +323,7 @@ JANET_CORE_FN(cfun_string_find,
|
||||
|
||||
JANET_CORE_FN(cfun_string_hasprefix,
|
||||
"(string/has-prefix? pfx str)",
|
||||
"Tests whether str starts with pfx.") {
|
||||
"Tests whether `str` starts with `pfx`.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView prefix = janet_getbytes(argv, 0);
|
||||
JanetByteView str = janet_getbytes(argv, 1);
|
||||
@@ -334,7 +334,7 @@ JANET_CORE_FN(cfun_string_hasprefix,
|
||||
|
||||
JANET_CORE_FN(cfun_string_hassuffix,
|
||||
"(string/has-suffix? sfx str)",
|
||||
"Tests whether str ends with sfx.") {
|
||||
"Tests whether `str` ends with `sfx`.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView suffix = janet_getbytes(argv, 0);
|
||||
JanetByteView str = janet_getbytes(argv, 1);
|
||||
@@ -347,9 +347,9 @@ JANET_CORE_FN(cfun_string_hassuffix,
|
||||
|
||||
JANET_CORE_FN(cfun_string_findall,
|
||||
"(string/find-all patt str &opt start-index)",
|
||||
"Searches for all instances of pattern patt in string "
|
||||
"str. Returns an array of all indices of found patterns. Overlapping "
|
||||
"instances of the pattern are counted individually, meaning a byte in str "
|
||||
"Searches for all instances of pattern `patt` in string "
|
||||
"`str`. Returns an array of all indices of found patterns. Overlapping "
|
||||
"instances of the pattern are counted individually, meaning a byte in `str` "
|
||||
"may contribute to multiple found patterns.") {
|
||||
int32_t result;
|
||||
struct kmp_state state;
|
||||
@@ -386,8 +386,8 @@ static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) {
|
||||
|
||||
JANET_CORE_FN(cfun_string_replace,
|
||||
"(string/replace patt subst str)",
|
||||
"Replace the first occurrence of patt with subst in the string str. "
|
||||
"Will return the new string if patt is found, otherwise returns str.") {
|
||||
"Replace the first occurrence of `patt` with `subst` in the string `str`. "
|
||||
"Will return the new string if `patt` is found, otherwise returns `str`.") {
|
||||
int32_t result;
|
||||
struct replace_state s;
|
||||
uint8_t *buf;
|
||||
@@ -409,9 +409,9 @@ JANET_CORE_FN(cfun_string_replace,
|
||||
|
||||
JANET_CORE_FN(cfun_string_replaceall,
|
||||
"(string/replace-all patt subst str)",
|
||||
"Replace all instances of patt with subst in the string str. Overlapping "
|
||||
"Replace all instances of `patt` with `subst` in the string `str`. Overlapping "
|
||||
"matches will not be counted, only the first match in such a span will be replaced. "
|
||||
"Will return the new string if patt is found, otherwise returns str.") {
|
||||
"Will return the new string if `patt` is found, otherwise returns `str`.") {
|
||||
int32_t result;
|
||||
struct replace_state s;
|
||||
JanetBuffer b;
|
||||
@@ -433,11 +433,11 @@ JANET_CORE_FN(cfun_string_replaceall,
|
||||
|
||||
JANET_CORE_FN(cfun_string_split,
|
||||
"(string/split delim str &opt start limit)",
|
||||
"Splits a string str with delimiter delim and returns an array of "
|
||||
"substrings. The substrings will not contain the delimiter delim. If delim "
|
||||
"Splits a string `str` with delimiter `delim` and returns an array of "
|
||||
"substrings. The substrings will not contain the delimiter `delim`. If `delim` "
|
||||
"is not found, the returned array will have one element. Will start searching "
|
||||
"for delim at the index start (if provided), and return up to a maximum "
|
||||
"of limit results (if provided).") {
|
||||
"for `delim` at the index `start` (if provided), and return up to a maximum "
|
||||
"of `limit` results (if provided).") {
|
||||
int32_t result;
|
||||
JanetArray *array;
|
||||
struct kmp_state state;
|
||||
@@ -461,9 +461,9 @@ JANET_CORE_FN(cfun_string_split,
|
||||
|
||||
JANET_CORE_FN(cfun_string_checkset,
|
||||
"(string/check-set set str)",
|
||||
"Checks that the string str only contains bytes that appear in the string set. "
|
||||
"Returns true if all bytes in str appear in set, false if some bytes in str do "
|
||||
"not appear in set.") {
|
||||
"Checks that the string `str` only contains bytes that appear in the string `set`. "
|
||||
"Returns true if all bytes in `str` appear in `set`, false if some bytes in `str` do "
|
||||
"not appear in `set`.") {
|
||||
uint32_t bitset[8] = {0, 0, 0, 0, 0, 0, 0, 0};
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView set = janet_getbytes(argv, 0);
|
||||
@@ -488,7 +488,7 @@ JANET_CORE_FN(cfun_string_checkset,
|
||||
JANET_CORE_FN(cfun_string_join,
|
||||
"(string/join parts &opt sep)",
|
||||
"Joins an array of strings into one string, optionally separated by "
|
||||
"a separator string sep.") {
|
||||
"a separator string `sep`.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetView parts = janet_getindexed(argv, 0);
|
||||
JanetByteView joiner;
|
||||
@@ -530,7 +530,7 @@ JANET_CORE_FN(cfun_string_join,
|
||||
|
||||
JANET_CORE_FN(cfun_string_format,
|
||||
"(string/format format & values)",
|
||||
"Similar to snprintf, but specialized for operating with Janet values. Returns "
|
||||
"Similar to C's `snprintf`, but specialized for operating with Janet values. Returns "
|
||||
"a new string.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_buffer(0);
|
||||
@@ -574,7 +574,7 @@ static void trim_help_args(int32_t argc, Janet *argv, JanetByteView *str, JanetB
|
||||
JANET_CORE_FN(cfun_string_trim,
|
||||
"(string/trim str &opt set)",
|
||||
"Trim leading and trailing whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.") {
|
||||
"`set` is provided, consider only characters in `set` to be whitespace.") {
|
||||
JanetByteView str, set;
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t left_edge = trim_help_leftedge(str, set);
|
||||
@@ -587,7 +587,7 @@ JANET_CORE_FN(cfun_string_trim,
|
||||
JANET_CORE_FN(cfun_string_triml,
|
||||
"(string/triml str &opt set)",
|
||||
"Trim leading whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.") {
|
||||
"`set` is provided, consider only characters in `set` to be whitespace.") {
|
||||
JanetByteView str, set;
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t left_edge = trim_help_leftedge(str, set);
|
||||
@@ -597,7 +597,7 @@ JANET_CORE_FN(cfun_string_triml,
|
||||
JANET_CORE_FN(cfun_string_trimr,
|
||||
"(string/trimr str &opt set)",
|
||||
"Trim trailing whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.") {
|
||||
"`set` is provided, consider only characters in `set` to be whitespace.") {
|
||||
JanetByteView str, set;
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t right_edge = trim_help_rightedge(str, set);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -296,17 +296,17 @@ JanetTable *janet_table_proto_flatten(JanetTable *t) {
|
||||
JANET_CORE_FN(cfun_table_new,
|
||||
"(table/new capacity)",
|
||||
"Creates a new empty table with pre-allocated memory "
|
||||
"for capacity entries. This means that if one knows the number of "
|
||||
"entries going to go in a table on creation, extra memory allocation "
|
||||
"for `capacity` entries. This means that if one knows the number of "
|
||||
"entries going into a table on creation, extra memory allocation "
|
||||
"can be avoided. Returns the new table.") {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
int32_t cap = janet_getnat(argv, 0);
|
||||
return janet_wrap_table(janet_table(cap));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_getproto,
|
||||
"(table/getproto tab)",
|
||||
"Get the prototype table of a table. Returns nil if a table "
|
||||
"Get the prototype table of a table. Returns nil if the table "
|
||||
"has no prototype, otherwise returns the prototype.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *t = janet_gettable(argv, 0);
|
||||
@@ -317,7 +317,7 @@ JANET_CORE_FN(cfun_table_getproto,
|
||||
|
||||
JANET_CORE_FN(cfun_table_setproto,
|
||||
"(table/setproto tab proto)",
|
||||
"Set the prototype of a table. Returns the original table tab.") {
|
||||
"Set the prototype of a table. Returns the original table `tab`.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
JanetTable *proto = NULL;
|
||||
@@ -339,8 +339,8 @@ JANET_CORE_FN(cfun_table_tostruct,
|
||||
|
||||
JANET_CORE_FN(cfun_table_rawget,
|
||||
"(table/rawget tab key)",
|
||||
"Gets a value from a table without looking at the prototype table. "
|
||||
"If a table tab does not contain t directly, the function will return "
|
||||
"Gets a value from a table `tab` without looking at the prototype table. "
|
||||
"If `tab` does not contain the key directly, the function will return "
|
||||
"nil without checking the prototype. Returns the value in the table.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -65,12 +65,12 @@ JANET_CORE_FN(cfun_tuple_brackets,
|
||||
|
||||
JANET_CORE_FN(cfun_tuple_slice,
|
||||
"(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])",
|
||||
"Take a sub sequence of an array or tuple from index start "
|
||||
"inclusive to index end exclusive. If start or end are not provided, "
|
||||
"they default to 0 and the length of arrtup respectively. "
|
||||
"'start' and 'end' can also be negative to indicate indexing "
|
||||
"Take a sub-sequence of an array or tuple from index `start` "
|
||||
"inclusive to index `end` exclusive. If `start` or `end` are not provided, "
|
||||
"they default to 0 and the length of `arrtup`, respectively. "
|
||||
"`start` and `end` can also be negative to indicate indexing "
|
||||
"from the end of the input. Note that index -1 is synonymous with "
|
||||
"index '(length arrtup)' to allow a full negative slice range. "
|
||||
"index `(length arrtup)` to allow a full negative slice range. "
|
||||
"Returns the new tuple.") {
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
@@ -96,7 +96,7 @@ JANET_CORE_FN(cfun_tuple_type,
|
||||
JANET_CORE_FN(cfun_tuple_sourcemap,
|
||||
"(tuple/sourcemap tup)",
|
||||
"Returns the sourcemap metadata attached to a tuple, "
|
||||
" which is another tuple (line, column).") {
|
||||
"which is another tuple (line, column).") {
|
||||
janet_fixarity(argc, 1);
|
||||
const Janet *tup = janet_gettuple(argv, 0);
|
||||
Janet contents[2];
|
||||
|
||||
114
src/core/util.c
114
src/core/util.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -36,6 +36,15 @@
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#ifdef JANET_DYNAMIC_MODULES
|
||||
#include <psapi.h>
|
||||
#ifdef JANET_MSVC
|
||||
#pragma comment (lib, "Psapi.lib")
|
||||
#endif
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifdef JANET_APPLE
|
||||
#include <AvailabilityMacros.h>
|
||||
#endif
|
||||
@@ -258,6 +267,7 @@ int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
|
||||
/* Calculate next power of 2. May overflow. If n is 0,
|
||||
* will return 0. */
|
||||
int32_t janet_tablen(int32_t n) {
|
||||
if (n < 0) return 0;
|
||||
n |= n >> 1;
|
||||
n |= n >> 2;
|
||||
n |= n >> 4;
|
||||
@@ -693,15 +703,25 @@ int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
|
||||
/* Read both strings and buffer as unsigned character array + int32_t len.
|
||||
* Returns 1 if the view can be constructed and 0 if the type is invalid. */
|
||||
int janet_bytes_view(Janet str, const uint8_t **data, int32_t *len) {
|
||||
if (janet_checktype(str, JANET_STRING) || janet_checktype(str, JANET_SYMBOL) ||
|
||||
janet_checktype(str, JANET_KEYWORD)) {
|
||||
JanetType t = janet_type(str);
|
||||
if (t == JANET_STRING || t == JANET_SYMBOL || t == JANET_KEYWORD) {
|
||||
*data = janet_unwrap_string(str);
|
||||
*len = janet_string_length(janet_unwrap_string(str));
|
||||
return 1;
|
||||
} else if (janet_checktype(str, JANET_BUFFER)) {
|
||||
} else if (t == JANET_BUFFER) {
|
||||
*data = janet_unwrap_buffer(str)->data;
|
||||
*len = janet_unwrap_buffer(str)->count;
|
||||
return 1;
|
||||
} else if (t == JANET_ABSTRACT) {
|
||||
void *abst = janet_unwrap_abstract(str);
|
||||
const JanetAbstractType *atype = janet_abstract_type(abst);
|
||||
if (NULL == atype->bytes) {
|
||||
return 0;
|
||||
}
|
||||
JanetByteView view = atype->bytes(abst, janet_abstract_size(abst));
|
||||
*data = view.bytes;
|
||||
*len = view.len;
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
@@ -738,6 +758,13 @@ int janet_checkint64(Janet x) {
|
||||
return janet_checkint64range(dval);
|
||||
}
|
||||
|
||||
int janet_checkuint64(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
double dval = janet_unwrap_number(x);
|
||||
return dval >= 0 && dval <= JANET_INTMAX_DOUBLE && dval == (uint64_t) dval;
|
||||
}
|
||||
|
||||
int janet_checksize(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
@@ -838,13 +865,13 @@ int janet_cryptorand(uint8_t *out, size_t n) {
|
||||
unsigned int v;
|
||||
if (rand_s(&v))
|
||||
return -1;
|
||||
for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < n); j++) {
|
||||
for (int32_t j = 0; (j < (int32_t) sizeof(unsigned int)) && (i + j < n); j++) {
|
||||
out[i + j] = v & 0xff;
|
||||
v = v >> 8;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
#elif defined(JANET_LINUX) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
|
||||
#elif defined(JANET_LINUX) || defined(JANET_CYGWIN) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
|
||||
/* We should be able to call getrandom on linux, but it doesn't seem
|
||||
to be uniformly supported on linux distros.
|
||||
On Mac, arc4random_buf wasn't available on until 10.7.
|
||||
@@ -876,6 +903,81 @@ int janet_cryptorand(uint8_t *out, size_t n) {
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Dynamic library loading */
|
||||
|
||||
char *get_processed_name(const char *name) {
|
||||
if (name[0] == '.') return (char *) name;
|
||||
const char *c;
|
||||
for (c = name; *c; c++) {
|
||||
if (*c == '/') return (char *) name;
|
||||
}
|
||||
size_t l = (size_t)(c - name);
|
||||
char *ret = janet_malloc(l + 3);
|
||||
if (NULL == ret) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
ret[0] = '.';
|
||||
ret[1] = '/';
|
||||
memcpy(ret + 2, name, l + 1);
|
||||
return ret;
|
||||
}
|
||||
|
||||
#if defined(JANET_NO_DYNAMIC_MODULES)
|
||||
|
||||
const char *error_clib(void) {
|
||||
return "dynamic modules not supported";
|
||||
}
|
||||
|
||||
#else
|
||||
#if defined(JANET_WINDOWS)
|
||||
|
||||
static char error_clib_buf[256];
|
||||
char *error_clib(void) {
|
||||
FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
|
||||
NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
|
||||
error_clib_buf, sizeof(error_clib_buf), NULL);
|
||||
error_clib_buf[strlen(error_clib_buf) - 1] = '\0';
|
||||
return error_clib_buf;
|
||||
}
|
||||
|
||||
Clib load_clib(const char *name) {
|
||||
if (name == NULL) {
|
||||
return GetModuleHandle(NULL);
|
||||
} else {
|
||||
return LoadLibrary(name);
|
||||
}
|
||||
}
|
||||
|
||||
void free_clib(HINSTANCE clib) {
|
||||
if (clib != GetModuleHandle(NULL)) {
|
||||
FreeLibrary(clib);
|
||||
}
|
||||
}
|
||||
|
||||
void *symbol_clib(HINSTANCE clib, const char *sym) {
|
||||
if (clib != GetModuleHandle(NULL)) {
|
||||
return GetProcAddress(clib, sym);
|
||||
} else {
|
||||
/* Look up symbols from all loaded modules */
|
||||
HMODULE hMods[1024];
|
||||
DWORD needed = 0;
|
||||
if (EnumProcessModules(GetCurrentProcess(), hMods, sizeof(hMods), &needed)) {
|
||||
needed /= sizeof(HMODULE);
|
||||
for (DWORD i = 0; i < needed; i++) {
|
||||
void *address = GetProcAddress(hMods[i], sym);
|
||||
if (NULL != address) {
|
||||
return address;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
janet_panicf("ffi: %s", error_clib());
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Alloc function macro fills */
|
||||
void *(janet_malloc)(size_t size) {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -31,6 +31,14 @@
|
||||
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
#include <stddef.h>
|
||||
#include <stdbool.h>
|
||||
|
||||
#ifdef JANET_EV
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <pthread.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED)
|
||||
#include <time.h>
|
||||
@@ -121,6 +129,31 @@ int janet_gettime(struct timespec *spec);
|
||||
#define strdup(x) _strdup(x)
|
||||
#endif
|
||||
|
||||
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
|
||||
* with native code. */
|
||||
#if defined(JANET_NO_DYNAMIC_MODULES)
|
||||
typedef int Clib;
|
||||
#define load_clib(name) ((void) name, 0)
|
||||
#define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
|
||||
const char *error_clib(void);
|
||||
#define free_clib(c) ((void) (c), 0)
|
||||
#elif defined(JANET_WINDOWS)
|
||||
#include <windows.h>
|
||||
typedef HINSTANCE Clib;
|
||||
void *symbol_clib(Clib clib, const char *sym);
|
||||
void free_clib(Clib clib);
|
||||
Clib load_clib(const char *name);
|
||||
char *error_clib(void);
|
||||
#else
|
||||
#include <dlfcn.h>
|
||||
typedef void *Clib;
|
||||
#define load_clib(name) dlopen((name), RTLD_NOW)
|
||||
#define free_clib(lib) dlclose((lib))
|
||||
#define symbol_clib(lib, sym) dlsym((lib), (sym))
|
||||
#define error_clib dlerror
|
||||
#endif
|
||||
char *get_processed_name(const char *name);
|
||||
|
||||
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
|
||||
|
||||
/* Initialize builtin libraries */
|
||||
@@ -159,5 +192,8 @@ void janet_lib_ev(JanetTable *env);
|
||||
void janet_ev_mark(void);
|
||||
int janet_make_pipe(JanetHandle handles[2], int mode);
|
||||
#endif
|
||||
#ifdef JANET_FFI
|
||||
void janet_lib_ffi(JanetTable *env);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -295,6 +295,15 @@ int janet_equals(Janet x, Janet y) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
static uint64_t murmur64(uint64_t h) {
|
||||
h ^= h >> 33;
|
||||
h *= 0xff51afd7ed558ccdUL;
|
||||
h ^= h >> 33;
|
||||
h *= 0xc4ceb9fe1a85ec53UL;
|
||||
h ^= h >> 33;
|
||||
return h;
|
||||
}
|
||||
|
||||
/* Computes a hash value for a function */
|
||||
int32_t janet_hash(Janet x) {
|
||||
int32_t hash = 0;
|
||||
@@ -341,14 +350,11 @@ int32_t janet_hash(Janet x) {
|
||||
default:
|
||||
if (sizeof(double) == sizeof(void *)) {
|
||||
/* Assuming 8 byte pointer (8 byte aligned) */
|
||||
uint64_t i = janet_u64(x);
|
||||
uint32_t lo = (uint32_t)(i & 0xFFFFFFFF);
|
||||
uint32_t hi = (uint32_t)(i >> 32);
|
||||
uint32_t hilo = (hi ^ lo) * 2654435769u;
|
||||
hash = (int32_t)((hilo << 16) | (hilo >> 16));
|
||||
uint64_t i = murmur64(janet_u64(x));
|
||||
hash = (int32_t)(i >> 32);
|
||||
} else {
|
||||
/* Assuming 4 byte pointer (or smaller) */
|
||||
ptrdiff_t diff = ((char *)janet_unwrap_pointer(x) - (char *)0);
|
||||
uintptr_t diff = (uintptr_t) janet_unwrap_pointer(x);
|
||||
uint32_t hilo = (uint32_t) diff * 2654435769u;
|
||||
hash = (int32_t)((hilo << 16) | (hilo >> 16));
|
||||
}
|
||||
@@ -645,6 +651,15 @@ int32_t janet_length(Janet x) {
|
||||
case JANET_TABLE:
|
||||
return janet_unwrap_table(x)->count;
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
const JanetAbstractType *type = janet_abstract_type(abst);
|
||||
if (type->length != NULL) {
|
||||
size_t len = type->length(abst, janet_abstract_size(abst));
|
||||
if (len > INT32_MAX) {
|
||||
janet_panicf("invalid integer length %u", len);
|
||||
}
|
||||
return (int32_t)(len);
|
||||
}
|
||||
Janet argv[1] = { x };
|
||||
Janet len = janet_mcall("length", 1, argv);
|
||||
if (!janet_checkint(len))
|
||||
@@ -673,6 +688,16 @@ Janet janet_lengthv(Janet x) {
|
||||
case JANET_TABLE:
|
||||
return janet_wrap_integer(janet_unwrap_table(x)->count);
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
const JanetAbstractType *type = janet_abstract_type(abst);
|
||||
if (type->length != NULL) {
|
||||
size_t len = type->length(abst, janet_abstract_size(abst));
|
||||
if ((uint64_t) len <= (uint64_t) JANET_INTMAX_INT64) {
|
||||
return janet_wrap_number((double) len);
|
||||
} else {
|
||||
janet_panicf("integer length %u too large", len);
|
||||
}
|
||||
}
|
||||
Janet argv[1] = { x };
|
||||
return janet_mcall("length", 1, argv);
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -220,14 +220,14 @@
|
||||
/* Trace a function call */
|
||||
static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
|
||||
if (func->def->name) {
|
||||
janet_printf("trace (%S", func->def->name);
|
||||
janet_eprintf("trace (%S", func->def->name);
|
||||
} else {
|
||||
janet_printf("trace (%p", janet_wrap_function(func));
|
||||
janet_eprintf("trace (%p", janet_wrap_function(func));
|
||||
}
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
janet_printf(" %p", argv[i]);
|
||||
janet_eprintf(" %p", argv[i]);
|
||||
}
|
||||
janet_printf(")\n");
|
||||
janet_eprintf(")\n");
|
||||
}
|
||||
|
||||
/* Invoke a method once we have looked it up */
|
||||
@@ -918,7 +918,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
int32_t i;
|
||||
for (i = 0; i < elen; ++i) {
|
||||
int32_t inherit = fd->environments[i];
|
||||
if (inherit == -1) {
|
||||
if (inherit == -1 || inherit >= func->def->environments_length) {
|
||||
JanetStackFrame *frame = janet_stack_frame(stack);
|
||||
if (!frame->env) {
|
||||
/* Lazy capture of current stack frame */
|
||||
@@ -1285,6 +1285,12 @@ JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
return signal;
|
||||
}
|
||||
|
||||
static Janet void_cfunction(int32_t argc, Janet *argv) {
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("placeholder");
|
||||
}
|
||||
|
||||
Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
/* Check entry conditions */
|
||||
if (!janet_vm.fiber)
|
||||
@@ -1292,9 +1298,17 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
if (janet_vm.stackn >= JANET_RECURSION_GUARD)
|
||||
janet_panic("C stack recursed too deeply");
|
||||
|
||||
/* Dirty stack */
|
||||
int32_t dirty_stack = janet_vm.fiber->stacktop - janet_vm.fiber->stackstart;
|
||||
if (dirty_stack) {
|
||||
janet_fiber_cframe(janet_vm.fiber, void_cfunction);
|
||||
}
|
||||
|
||||
/* Tracing */
|
||||
if (fun->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
janet_vm.stackn++;
|
||||
vm_do_trace(fun, argc, argv);
|
||||
janet_vm.stackn--;
|
||||
}
|
||||
|
||||
/* Push frame */
|
||||
@@ -1322,6 +1336,10 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
/* Teardown */
|
||||
janet_vm.stackn = oldn;
|
||||
janet_gcunlock(handle);
|
||||
if (dirty_stack) {
|
||||
janet_fiber_popframe(janet_vm.fiber);
|
||||
janet_vm.fiber->stacktop += dirty_stack;
|
||||
}
|
||||
|
||||
if (signal != JANET_SIGNAL_OK) {
|
||||
janet_panicv(*janet_vm.return_reg);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -67,6 +67,11 @@ extern "C" {
|
||||
#define JANET_LINUX 1
|
||||
#endif
|
||||
|
||||
/* Check for Cygwin */
|
||||
#if defined(__CYGWIN__)
|
||||
#define JANET_CYGWIN 1
|
||||
#endif
|
||||
|
||||
/* Check Unix */
|
||||
#if defined(_AIX) \
|
||||
|| defined(__APPLE__) /* Darwin */ \
|
||||
@@ -87,6 +92,16 @@ extern "C" {
|
||||
#define JANET_WINDOWS 1
|
||||
#endif
|
||||
|
||||
/* Check if compiling with MSVC - else assume a GCC-like compiler by default */
|
||||
#ifdef _MSC_VER
|
||||
#define JANET_MSVC
|
||||
#endif
|
||||
|
||||
/* Check Mingw 32-bit and 64-bit */
|
||||
#ifdef __MINGW32__
|
||||
#define JANET_MINGW
|
||||
#endif
|
||||
|
||||
/* Check 64-bit vs 32-bit */
|
||||
#if ((defined(__x86_64__) || defined(_M_X64)) \
|
||||
&& (defined(JANET_POSIX) || defined(JANET_WINDOWS))) \
|
||||
@@ -96,7 +111,8 @@ extern "C" {
|
||||
|| (defined(__sparc__) && defined(__arch64__) || defined (__sparcv9)) /* BE */ \
|
||||
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|
||||
|| (defined(__ppc64__) || defined(__PPC64__)) \
|
||||
|| defined(__aarch64__) /* ARM 64-bit */
|
||||
|| defined(__aarch64__) /* ARM 64-bit */ \
|
||||
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */
|
||||
#define JANET_64 1
|
||||
#else
|
||||
#define JANET_32 1
|
||||
@@ -163,6 +179,21 @@ extern "C" {
|
||||
#define JANET_DYNAMIC_MODULES
|
||||
#endif
|
||||
|
||||
/* Enable or disable the FFI library. Currently, FFI only enabled on
|
||||
* x86-64 operating systems. */
|
||||
#ifndef JANET_NO_FFI
|
||||
#if !defined(__EMSCRIPTEN__) && (defined(__x86_64__) || defined(_M_X64))
|
||||
#define JANET_FFI
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* If FFI is enabled and FFI-JIT is not disabled... */
|
||||
#ifdef JANET_FFI
|
||||
#ifndef JANET_NO_FFI_JIT
|
||||
#define JANET_FFI_JIT
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Enable or disable the assembler. Enabled by default. */
|
||||
#ifndef JANET_NO_ASSEMBLER
|
||||
#define JANET_ASSEMBLER
|
||||
@@ -228,7 +259,7 @@ extern "C" {
|
||||
/* Maximum depth to follow table prototypes before giving up and returning nil. */
|
||||
#define JANET_MAX_PROTO_DEPTH 200
|
||||
|
||||
/* Maximum depth to follow table prototypes before giving up and returning nil. */
|
||||
/* Prevent macros to expand too deeply and error out. */
|
||||
#define JANET_MAX_MACRO_EXPAND 200
|
||||
|
||||
/* Define default max stack size for stacks before raising a stack overflow error.
|
||||
@@ -299,10 +330,10 @@ typedef struct {
|
||||
JANET_CURRENT_CONFIG_BITS })
|
||||
#endif
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
#include <stdio.h>
|
||||
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
|
||||
/* Some extra includes if EV is enabled */
|
||||
#ifdef JANET_EV
|
||||
typedef struct JanetOSMutex JanetOSMutex;
|
||||
typedef struct JanetOSRWLock JanetOSRWLock;
|
||||
#endif
|
||||
|
||||
/***** END SECTION CONFIG *****/
|
||||
@@ -322,23 +353,10 @@ typedef struct {
|
||||
#include <stddef.h>
|
||||
#include <stdio.h>
|
||||
|
||||
/* Some extra includes if EV is enabled */
|
||||
#ifdef JANET_EV
|
||||
#ifdef JANET_WINDOWS
|
||||
typedef struct JanetDudCriticalSection {
|
||||
/* Avoid including windows.h here - instead, create a structure of the same size */
|
||||
/* Needs to be same size as crtical section see WinNT.h for CRITCIAL_SECTION definition */
|
||||
void *debug_info;
|
||||
long lock_count;
|
||||
long recursion_count;
|
||||
void *owning_thread;
|
||||
void *lock_semaphore;
|
||||
unsigned long spin_count;
|
||||
} JanetOSMutex;
|
||||
#else
|
||||
#include <pthread.h>
|
||||
typedef pthread_mutex_t JanetOSMutex;
|
||||
#endif
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "%s:%d - janet out of memory\n", __FILE__, __LINE__); exit(1); } while (0)
|
||||
#endif
|
||||
|
||||
#ifdef JANET_BSD
|
||||
@@ -430,6 +448,7 @@ typedef struct JanetReg JanetReg;
|
||||
typedef struct JanetRegExt JanetRegExt;
|
||||
typedef struct JanetMethod JanetMethod;
|
||||
typedef struct JanetSourceMapping JanetSourceMapping;
|
||||
typedef struct JanetSymbolMap JanetSymbolMap;
|
||||
typedef struct JanetView JanetView;
|
||||
typedef struct JanetByteView JanetByteView;
|
||||
typedef struct JanetDictView JanetDictView;
|
||||
@@ -849,6 +868,7 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
|
||||
JANET_API int janet_checkint(Janet x);
|
||||
JANET_API int janet_checkint64(Janet x);
|
||||
JANET_API int janet_checkuint64(Janet x);
|
||||
JANET_API int janet_checksize(Janet x);
|
||||
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
|
||||
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
|
||||
@@ -984,6 +1004,7 @@ struct JanetAbstractHead {
|
||||
/* Some function definition flags */
|
||||
#define JANET_FUNCDEF_FLAG_VARARG 0x10000
|
||||
#define JANET_FUNCDEF_FLAG_NEEDSENV 0x20000
|
||||
#define JANET_FUNCDEF_FLAG_HASSYMBOLMAP 0x40000
|
||||
#define JANET_FUNCDEF_FLAG_HASNAME 0x80000
|
||||
#define JANET_FUNCDEF_FLAG_HASSOURCE 0x100000
|
||||
#define JANET_FUNCDEF_FLAG_HASDEFS 0x200000
|
||||
@@ -999,6 +1020,14 @@ struct JanetSourceMapping {
|
||||
int32_t column;
|
||||
};
|
||||
|
||||
/* Symbol to slot mapping & lifetime structure. */
|
||||
struct JanetSymbolMap {
|
||||
uint32_t birth_pc;
|
||||
uint32_t death_pc;
|
||||
uint32_t slot_index;
|
||||
const uint8_t *symbol;
|
||||
};
|
||||
|
||||
/* A function definition. Contains information needed to instantiate closures. */
|
||||
struct JanetFuncDef {
|
||||
JanetGCObject gc;
|
||||
@@ -1012,6 +1041,7 @@ struct JanetFuncDef {
|
||||
JanetSourceMapping *sourcemap;
|
||||
JanetString source;
|
||||
JanetString name;
|
||||
JanetSymbolMap *symbolmap;
|
||||
|
||||
int32_t flags;
|
||||
int32_t slotcount; /* The amount of stack space required for the function */
|
||||
@@ -1022,6 +1052,7 @@ struct JanetFuncDef {
|
||||
int32_t bytecode_length;
|
||||
int32_t environments_length;
|
||||
int32_t defs_length;
|
||||
int32_t symbolmap_length;
|
||||
};
|
||||
|
||||
/* A function environment */
|
||||
@@ -1097,6 +1128,8 @@ struct JanetAbstractType {
|
||||
int32_t (*hash)(void *p, size_t len);
|
||||
Janet(*next)(void *p, Janet key);
|
||||
Janet(*call)(void *p, int32_t argc, Janet *argv);
|
||||
size_t (*length)(void *p, size_t len);
|
||||
JanetByteView(*bytes)(void *p, size_t len);
|
||||
};
|
||||
|
||||
/* Some macros to let us add extra types to JanetAbstract types without
|
||||
@@ -1114,7 +1147,9 @@ struct JanetAbstractType {
|
||||
#define JANET_ATEND_COMPARE NULL,JANET_ATEND_HASH
|
||||
#define JANET_ATEND_HASH NULL,JANET_ATEND_NEXT
|
||||
#define JANET_ATEND_NEXT NULL,JANET_ATEND_CALL
|
||||
#define JANET_ATEND_CALL
|
||||
#define JANET_ATEND_CALL NULL,JANET_ATEND_LENGTH
|
||||
#define JANET_ATEND_LENGTH NULL,JANET_ATEND_BYTES
|
||||
#define JANET_ATEND_BYTES
|
||||
|
||||
struct JanetReg {
|
||||
const char *name;
|
||||
@@ -1180,17 +1215,6 @@ typedef struct {
|
||||
Janet payload;
|
||||
} JanetTryState;
|
||||
|
||||
/* Thread types */
|
||||
#ifdef JANET_THREADS
|
||||
typedef struct JanetThread JanetThread;
|
||||
typedef struct JanetMailbox JanetMailbox;
|
||||
struct JanetThread {
|
||||
JanetMailbox *mailbox;
|
||||
JanetTable *encode;
|
||||
};
|
||||
#endif
|
||||
|
||||
|
||||
/***** END SECTION TYPES *****/
|
||||
|
||||
/***** START SECTION OPCODES *****/
|
||||
@@ -1379,11 +1403,19 @@ JANET_API void *janet_abstract_threaded(const JanetAbstractType *atype, size_t s
|
||||
JANET_API int32_t janet_abstract_incref(void *abst);
|
||||
JANET_API int32_t janet_abstract_decref(void *abst);
|
||||
|
||||
/* Expose some OS sync primitives to make portable abstract types easier to implement */
|
||||
/* Expose some OS sync primitives */
|
||||
JANET_API size_t janet_os_mutex_size(void);
|
||||
JANET_API size_t janet_os_rwlock_size(void);
|
||||
JANET_API void janet_os_mutex_init(JanetOSMutex *mutex);
|
||||
JANET_API void janet_os_mutex_deinit(JanetOSMutex *mutex);
|
||||
JANET_API void janet_os_mutex_lock(JanetOSMutex *mutex);
|
||||
JANET_API void janet_os_mutex_unlock(JanetOSMutex *mutex);
|
||||
JANET_API void janet_os_rwlock_init(JanetOSRWLock *rwlock);
|
||||
JANET_API void janet_os_rwlock_deinit(JanetOSRWLock *rwlock);
|
||||
JANET_API void janet_os_rwlock_rlock(JanetOSRWLock *rwlock);
|
||||
JANET_API void janet_os_rwlock_wlock(JanetOSRWLock *rwlock);
|
||||
JANET_API void janet_os_rwlock_runlock(JanetOSRWLock *rwlock);
|
||||
JANET_API void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock);
|
||||
|
||||
/* Get last error from an IO operation */
|
||||
JANET_API Janet janet_ev_lasterr(void);
|
||||
@@ -1678,6 +1710,7 @@ JANET_API JanetModule janet_native(const char *name, JanetString *error);
|
||||
|
||||
/* Marshaling */
|
||||
#define JANET_MARSHAL_UNSAFE 0x20000
|
||||
#define JANET_MARSHAL_NO_CYCLES 0x40000
|
||||
|
||||
JANET_API void janet_marshal(
|
||||
JanetBuffer *buf,
|
||||
@@ -1925,6 +1958,7 @@ JANET_API void *janet_getpointer(const Janet *argv, int32_t n);
|
||||
JANET_API int32_t janet_getnat(const Janet *argv, int32_t n);
|
||||
JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
|
||||
JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
|
||||
JANET_API uint64_t janet_getuinteger64(const Janet *argv, int32_t n);
|
||||
JANET_API size_t janet_getsize(const Janet *argv, int32_t n);
|
||||
JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);
|
||||
JANET_API JanetByteView janet_getbytes(const Janet *argv, int32_t n);
|
||||
@@ -1972,7 +2006,6 @@ extern JANET_API const JanetAbstractType janet_file_type;
|
||||
#define JANET_FILE_CLOSED 32
|
||||
#define JANET_FILE_BINARY 64
|
||||
#define JANET_FILE_SERIALIZABLE 128
|
||||
#define JANET_FILE_PIPED 256
|
||||
#define JANET_FILE_NONIL 512
|
||||
|
||||
JANET_API Janet janet_makefile(FILE *f, int32_t flags);
|
||||
@@ -2079,16 +2112,6 @@ JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
|
||||
|
||||
#endif
|
||||
|
||||
#ifdef JANET_THREADS
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_thread_type;
|
||||
|
||||
JANET_API int janet_thread_receive(Janet *msg_out, double timeout);
|
||||
JANET_API int janet_thread_send(JanetThread *thread, Janet msg, double timeout);
|
||||
JANET_API JanetThread *janet_thread_current(void);
|
||||
|
||||
#endif
|
||||
|
||||
/* Custom allocator support */
|
||||
JANET_API void *(janet_malloc)(size_t);
|
||||
JANET_API void *(janet_realloc)(void *, size_t);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 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
|
||||
@@ -33,6 +33,9 @@
|
||||
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
||||
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
||||
#endif
|
||||
#ifndef ENABLE_VIRTUAL_TERMINAL_INPUT
|
||||
#define ENABLE_VIRTUAL_TERMINAL_INPUT 0x0200
|
||||
#endif
|
||||
#endif
|
||||
|
||||
void janet_line_init();
|
||||
@@ -87,8 +90,30 @@ static void simpleline(JanetBuffer *buffer) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Windows */
|
||||
#if defined(JANET_WINDOWS) || defined(JANET_SIMPLE_GETLINE)
|
||||
/* State */
|
||||
|
||||
#ifndef JANET_SIMPLE_GETLINE
|
||||
/* static state */
|
||||
#define JANET_LINE_MAX 1024
|
||||
#define JANET_MATCH_MAX 256
|
||||
#define JANET_HISTORY_MAX 100
|
||||
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
|
||||
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
|
||||
static JANET_THREAD_LOCAL int gbl_plen = 2;
|
||||
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_len = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_pos = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_cols = 80;
|
||||
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_history_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_historyi = 0;
|
||||
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_match_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
|
||||
#endif
|
||||
|
||||
/* Fallback */
|
||||
#if defined(JANET_SIMPLE_GETLINE)
|
||||
|
||||
void janet_line_init() {
|
||||
;
|
||||
@@ -105,6 +130,80 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
simpleline(buffer);
|
||||
}
|
||||
|
||||
/* Rich implementation */
|
||||
#else
|
||||
|
||||
/* Windows */
|
||||
#ifdef _WIN32
|
||||
|
||||
#include <stdbool.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <io.h>
|
||||
|
||||
static void setup_console_output(void) {
|
||||
/* Enable color console on windows 10 console and utf8 output and other processing */
|
||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
SetConsoleOutputCP(65001);
|
||||
}
|
||||
|
||||
/* Ansi terminal raw mode */
|
||||
static int rawmode(void) {
|
||||
if (gbl_israwmode) return 0;
|
||||
HANDLE hOut = GetStdHandle(STD_INPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode &= ~ENABLE_LINE_INPUT;
|
||||
dwMode &= ~ENABLE_INSERT_MODE;
|
||||
dwMode &= ~ENABLE_ECHO_INPUT;
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_INPUT;
|
||||
dwMode &= ~ENABLE_PROCESSED_INPUT;
|
||||
if (!SetConsoleMode(hOut, dwMode)) return 1;
|
||||
gbl_israwmode = 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Disable raw mode */
|
||||
static void norawmode(void) {
|
||||
if (!gbl_israwmode) return;
|
||||
HANDLE hOut = GetStdHandle(STD_INPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode |= ENABLE_LINE_INPUT;
|
||||
dwMode |= ENABLE_INSERT_MODE;
|
||||
dwMode |= ENABLE_ECHO_INPUT;
|
||||
dwMode &= ~ENABLE_VIRTUAL_TERMINAL_INPUT;
|
||||
dwMode |= ENABLE_PROCESSED_INPUT;
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
gbl_israwmode = 0;
|
||||
}
|
||||
|
||||
static long write_console(const char *bytes, size_t n) {
|
||||
DWORD nwritten = 0;
|
||||
BOOL result = WriteConsole(GetStdHandle(STD_OUTPUT_HANDLE), bytes, (DWORD) n, &nwritten, NULL);
|
||||
if (!result) return -1; /* error */
|
||||
return (long)nwritten;
|
||||
}
|
||||
|
||||
static long read_console(char *into, size_t n) {
|
||||
DWORD numread;
|
||||
BOOL result = ReadConsole(GetStdHandle(STD_INPUT_HANDLE), into, (DWORD) n, &numread, NULL);
|
||||
if (!result) return -1; /* error */
|
||||
return (long)numread;
|
||||
}
|
||||
|
||||
static int check_simpleline(JanetBuffer *buffer) {
|
||||
if (!_isatty(_fileno(stdin)) || rawmode()) {
|
||||
simpleline(buffer);
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Posix */
|
||||
#else
|
||||
|
||||
@@ -125,24 +224,7 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
|
||||
#include <string.h>
|
||||
#include <signal.h>
|
||||
|
||||
/* static state */
|
||||
#define JANET_LINE_MAX 1024
|
||||
#define JANET_MATCH_MAX 256
|
||||
#define JANET_HISTORY_MAX 100
|
||||
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
|
||||
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
|
||||
static JANET_THREAD_LOCAL int gbl_plen = 2;
|
||||
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_len = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_pos = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_cols = 80;
|
||||
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_history_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_historyi = 0;
|
||||
static JANET_THREAD_LOCAL struct termios gbl_termios_start;
|
||||
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_match_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
|
||||
|
||||
/* Unsupported terminal list from linenoise */
|
||||
static const char *badterms[] = {
|
||||
@@ -152,15 +234,6 @@ static const char *badterms[] = {
|
||||
NULL
|
||||
};
|
||||
|
||||
static char *sdup(const char *s) {
|
||||
size_t len = strlen(s) + 1;
|
||||
char *mem = janet_malloc(len);
|
||||
if (!mem) {
|
||||
return NULL;
|
||||
}
|
||||
return memcpy(mem, s, len);
|
||||
}
|
||||
|
||||
/* Ansi terminal raw mode */
|
||||
static int rawmode(void) {
|
||||
struct termios t;
|
||||
@@ -186,13 +259,54 @@ static void norawmode(void) {
|
||||
gbl_israwmode = 0;
|
||||
}
|
||||
|
||||
static int checktermsupport() {
|
||||
const char *t = getenv("TERM");
|
||||
int i;
|
||||
if (!t) return 1;
|
||||
for (i = 0; badterms[i]; i++)
|
||||
if (!strcmp(t, badterms[i])) return 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
static long write_console(char *bytes, size_t n) {
|
||||
return write(STDOUT_FILENO, bytes, n);
|
||||
}
|
||||
|
||||
static long read_console(char *into, size_t n) {
|
||||
return read(STDIN_FILENO, into, n);
|
||||
}
|
||||
|
||||
static int check_simpleline(JanetBuffer *buffer) {
|
||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||
simpleline(buffer);
|
||||
return 1;
|
||||
}
|
||||
if (rawmode()) {
|
||||
simpleline(buffer);
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
static char *sdup(const char *s) {
|
||||
size_t len = strlen(s) + 1;
|
||||
char *mem = janet_malloc(len);
|
||||
if (!mem) {
|
||||
return NULL;
|
||||
}
|
||||
return memcpy(mem, s, len);
|
||||
}
|
||||
|
||||
#ifndef _WIN32
|
||||
static int curpos(void) {
|
||||
char buf[32];
|
||||
int cols, rows;
|
||||
unsigned int i = 0;
|
||||
if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
|
||||
if (write_console("\x1b[6n", 4) != 4) return -1;
|
||||
while (i < sizeof(buf) - 1) {
|
||||
if (read(STDIN_FILENO, buf + i, 1) != 1) break;
|
||||
if (read_console(buf + i, 1) != 1) break;
|
||||
if (buf[i] == 'R') break;
|
||||
i++;
|
||||
}
|
||||
@@ -201,20 +315,26 @@ static int curpos(void) {
|
||||
if (sscanf(buf + 2, "%d;%d", &rows, &cols) != 2) return -1;
|
||||
return cols;
|
||||
}
|
||||
#endif
|
||||
|
||||
static int getcols(void) {
|
||||
#ifdef _WIN32
|
||||
CONSOLE_SCREEN_BUFFER_INFO csbi;
|
||||
GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), &csbi);
|
||||
return (int)(csbi.srWindow.Right - csbi.srWindow.Left + 1);
|
||||
#else
|
||||
struct winsize ws;
|
||||
if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_col == 0) {
|
||||
int start, cols;
|
||||
start = curpos();
|
||||
if (start == -1) goto failed;
|
||||
if (write(STDOUT_FILENO, "\x1b[999C", 6) != 6) goto failed;
|
||||
if (write_console("\x1b[999C", 6) != 6) goto failed;
|
||||
cols = curpos();
|
||||
if (cols == -1) goto failed;
|
||||
if (cols > start) {
|
||||
char seq[32];
|
||||
snprintf(seq, 32, "\x1b[%dD", cols - start);
|
||||
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {
|
||||
if (write_console(seq, strlen(seq)) == -1) {
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
@@ -224,10 +344,11 @@ static int getcols(void) {
|
||||
}
|
||||
failed:
|
||||
return 80;
|
||||
#endif
|
||||
}
|
||||
|
||||
static void clear(void) {
|
||||
if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {
|
||||
if (write_console("\x1b[H\x1b[2J", 7) <= 0) {
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
@@ -259,7 +380,7 @@ static void refresh(void) {
|
||||
/* Move cursor to original position. */
|
||||
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
|
||||
janet_buffer_push_cstring(&b, seq);
|
||||
if (write(STDOUT_FILENO, b.data, b.count) == -1) {
|
||||
if (write_console((char *) b.data, b.count) == -1) {
|
||||
exit(1);
|
||||
}
|
||||
janet_buffer_deinit(&b);
|
||||
@@ -285,7 +406,7 @@ static int insert(char c, int draw) {
|
||||
if (gbl_plen + gbl_len < gbl_cols) {
|
||||
/* Avoid a full update of the line in the
|
||||
* trivial case. */
|
||||
if (write(STDOUT_FILENO, &c, 1) == -1) return -1;
|
||||
if (write_console(&c, 1) == -1) return -1;
|
||||
} else {
|
||||
refresh();
|
||||
}
|
||||
@@ -312,7 +433,7 @@ static void historymove(int delta) {
|
||||
gbl_historyi = gbl_history_count - 1;
|
||||
}
|
||||
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
|
||||
gbl_pos = gbl_len = strlen(gbl_buf);
|
||||
gbl_pos = gbl_len = (int) strlen(gbl_buf);
|
||||
gbl_buf[gbl_len] = '\0';
|
||||
|
||||
refresh();
|
||||
@@ -527,6 +648,7 @@ static void check_specials(JanetByteView src) {
|
||||
check_cmatch(src, "unquote");
|
||||
check_cmatch(src, "var");
|
||||
check_cmatch(src, "while");
|
||||
check_cmatch(src, "upscope");
|
||||
}
|
||||
|
||||
static void resolve_format(JanetTable *entry) {
|
||||
@@ -740,14 +862,14 @@ static int line() {
|
||||
|
||||
addhistory();
|
||||
|
||||
if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
|
||||
if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1;
|
||||
for (;;) {
|
||||
char c;
|
||||
char seq[3];
|
||||
|
||||
int rc;
|
||||
do {
|
||||
rc = read(STDIN_FILENO, &c, 1);
|
||||
rc = read_console(&c, 1);
|
||||
} while (rc < 0 && errno == EINTR);
|
||||
if (rc <= 0) return -1;
|
||||
|
||||
@@ -764,8 +886,13 @@ static int line() {
|
||||
kleft();
|
||||
break;
|
||||
case 3: /* ctrl-c */
|
||||
clearlines();
|
||||
norawmode();
|
||||
#ifdef _WIN32
|
||||
ExitProcess(1);
|
||||
#else
|
||||
kill(getpid(), SIGINT);
|
||||
#endif
|
||||
/* fallthrough */
|
||||
case 17: /* ctrl-q */
|
||||
gbl_cancel_current_repl_form = 1;
|
||||
@@ -826,23 +953,26 @@ static int line() {
|
||||
case 23: /* ctrl-w */
|
||||
kbackspacew();
|
||||
break;
|
||||
#ifndef _WIN32
|
||||
case 26: /* ctrl-z */
|
||||
clearlines();
|
||||
norawmode();
|
||||
kill(getpid(), SIGSTOP);
|
||||
rawmode();
|
||||
refresh();
|
||||
break;
|
||||
#endif
|
||||
case 27: /* escape sequence */
|
||||
/* Read the next two bytes representing the escape sequence.
|
||||
* Use two calls to handle slow terminals returning the two
|
||||
* chars at different times. */
|
||||
if (read(STDIN_FILENO, seq, 1) == -1) break;
|
||||
if (read_console(seq, 1) == -1) break;
|
||||
/* Esc[ = Control Sequence Introducer (CSI) */
|
||||
if (seq[0] == '[') {
|
||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
||||
if (read_console(seq + 1, 1) == -1) break;
|
||||
if (seq[1] >= '0' && seq[1] <= '9') {
|
||||
/* Extended escape, read additional byte. */
|
||||
if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
|
||||
if (read_console(seq + 2, 1) == -1) break;
|
||||
if (seq[2] == '~') {
|
||||
switch (seq[1]) {
|
||||
case '1': /* Home */
|
||||
@@ -861,7 +991,7 @@ static int line() {
|
||||
}
|
||||
}
|
||||
} else if (seq[0] == 'O') {
|
||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
||||
if (read_console(seq + 1, 1) == -1) break;
|
||||
switch (seq[1]) {
|
||||
default:
|
||||
break;
|
||||
@@ -944,28 +1074,12 @@ void janet_line_deinit() {
|
||||
gbl_historyi = 0;
|
||||
}
|
||||
|
||||
static int checktermsupport() {
|
||||
const char *t = getenv("TERM");
|
||||
int i;
|
||||
if (!t) return 1;
|
||||
for (i = 0; badterms[i]; i++)
|
||||
if (!strcmp(t, badterms[i])) return 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
gbl_prompt = p;
|
||||
buffer->count = 0;
|
||||
gbl_historyi = 0;
|
||||
if (check_simpleline(buffer)) return;
|
||||
FILE *out = janet_dynfile("err", stderr);
|
||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||
simpleline(buffer);
|
||||
return;
|
||||
}
|
||||
if (rawmode()) {
|
||||
simpleline(buffer);
|
||||
return;
|
||||
}
|
||||
if (line()) {
|
||||
norawmode();
|
||||
fputc('\n', out);
|
||||
@@ -981,6 +1095,13 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
replacehistory();
|
||||
}
|
||||
|
||||
static void clear_at_exit(void) {
|
||||
if (!gbl_israwmode) {
|
||||
clearlines();
|
||||
norawmode();
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/*
|
||||
@@ -993,18 +1114,11 @@ int main(int argc, char **argv) {
|
||||
JanetTable *env;
|
||||
|
||||
#ifdef _WIN32
|
||||
/* Enable color console on windows 10 console and utf8 output. */
|
||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
SetConsoleOutputCP(65001);
|
||||
setup_console_output();
|
||||
#endif
|
||||
|
||||
#if !defined(JANET_WINDOWS) && !defined(JANET_SIMPLE_GETLINE)
|
||||
/* Try and not leave the terminal in a bad state */
|
||||
atexit(norawmode);
|
||||
#if !defined(JANET_SIMPLE_GETLINE)
|
||||
atexit(clear_at_exit);
|
||||
#endif
|
||||
|
||||
#if defined(JANET_PRF)
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 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
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 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
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 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
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 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
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 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
|
||||
@@ -164,36 +164,26 @@
|
||||
|
||||
(:close s))
|
||||
|
||||
(defn check-matching-names [stream]
|
||||
(def ln (net/localname stream))
|
||||
(def pn (net/peername stream))
|
||||
(def [my-ip my-port] ln)
|
||||
(def [remote-ip remote-port] pn)
|
||||
(def msg (string my-ip " " my-port " " remote-ip " " remote-port))
|
||||
(def buf @"")
|
||||
(ev/gather
|
||||
(net/write stream msg)
|
||||
(net/read stream 1024 buf))
|
||||
(def comparison (string/split " " buf))
|
||||
(assert (and (= my-ip (get comparison 2))
|
||||
(= (string my-port) (get comparison 3))
|
||||
(= remote-ip (get comparison 0))
|
||||
(= (string remote-port) (get comparison 1)))
|
||||
(string/format "localname should match peername: msg=%j, buf=%j" msg buf)))
|
||||
|
||||
# Test on both server and client
|
||||
(defn names-handler
|
||||
[stream]
|
||||
(defer (:close stream)
|
||||
(check-matching-names stream)))
|
||||
# prevent immediate close
|
||||
(ev/read stream 1)
|
||||
(def [host port] (net/localname stream))
|
||||
(assert (= host "127.0.0.1") "localname host server")
|
||||
(assert (= port 8000) "localname port server")))
|
||||
|
||||
# Test localname and peername
|
||||
(repeat 20
|
||||
(repeat 10
|
||||
(with [s (net/server "127.0.0.1" "8000" names-handler)]
|
||||
(defn test-names []
|
||||
(repeat 10
|
||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||
(check-matching-names conn)))
|
||||
(repeat 20 (test-names)))
|
||||
(def [host port] (net/peername conn))
|
||||
(assert (= host "127.0.0.1") "peername host client ")
|
||||
(assert (= port 8000) "peername port client")
|
||||
# let server close
|
||||
(ev/write conn " "))))
|
||||
(gccollect))
|
||||
|
||||
# Create pipe
|
||||
@@ -275,4 +265,15 @@
|
||||
(ev/do-thread
|
||||
(assert (ev/take ch) "channel packing bug for threaded abstracts on threaded channels."))
|
||||
|
||||
# marshal channels
|
||||
|
||||
(def ch (ev/chan 10))
|
||||
(ev/give ch "hello")
|
||||
(ev/give ch "world")
|
||||
(def ch2 (-> ch marshal unmarshal))
|
||||
(def item1 (ev/take ch2))
|
||||
(def item2 (ev/take ch2))
|
||||
(assert (= item1 "hello"))
|
||||
(assert (= item2 "world"))
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 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
|
||||
@@ -144,7 +144,7 @@
|
||||
(assert (< 1000 1e23) "greater than immediate 2")
|
||||
|
||||
# os/execute with environment variables
|
||||
(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe {"HELLO" "WORLD"})) "os/execute with env")
|
||||
(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe (merge (os/environ) {"HELLO" "WORLD"}))) "os/execute with env")
|
||||
|
||||
# Regression #638
|
||||
(compwhen
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 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
|
||||
@@ -50,5 +50,59 @@
|
||||
|
||||
(assert (= (hash 0) (hash (* -1 0))) "hash -0 same as hash 0")
|
||||
|
||||
(end-suite)
|
||||
# os/execute regressions
|
||||
(for i 0 10
|
||||
(assert (= i (os/execute [(dyn :executable) "-e" (string/format "(os/exit %d)" i)] :p)) (string "os/execute " i)))
|
||||
|
||||
# to/thru bug
|
||||
(def pattern
|
||||
(peg/compile
|
||||
'{:dd (sequence :d :d)
|
||||
:sep (set "/-")
|
||||
:date (sequence :dd :sep :dd)
|
||||
:wsep (some (set " \t"))
|
||||
:entry (group (sequence (capture :date) :wsep (capture :date)))
|
||||
:main (some (thru :entry))}))
|
||||
|
||||
(def alt-pattern
|
||||
(peg/compile
|
||||
'{:dd (sequence :d :d)
|
||||
:sep (set "/-")
|
||||
:date (sequence :dd :sep :dd)
|
||||
:wsep (some (set " \t"))
|
||||
:entry (group (sequence (capture :date) :wsep (capture :date)))
|
||||
:main (some (choice :entry 1))}))
|
||||
|
||||
(def text "1800-10-818-9-818 16/12\n17/12 19/12\n20/12 11/01")
|
||||
(assert (deep= (peg/match pattern text) (peg/match alt-pattern text)) "to/thru bug #971")
|
||||
|
||||
(assert-error
|
||||
"table rawget regression"
|
||||
(table/new -1))
|
||||
|
||||
# Named arguments
|
||||
(defn named-arguments
|
||||
[&named bob sally joe]
|
||||
(+ bob sally joe))
|
||||
|
||||
(assert (= 15 (named-arguments :bob 3 :sally 5 :joe 7)) "named arguments 1")
|
||||
|
||||
(defn named-opt-arguments
|
||||
[&opt x &named a b c]
|
||||
(+ x a b c))
|
||||
|
||||
(assert (= 10 (named-opt-arguments 1 :a 2 :b 3 :c 4)) "named arguments 2")
|
||||
|
||||
(let [b @""]
|
||||
(defn dummy [a b c]
|
||||
(+ a b c))
|
||||
(trace dummy)
|
||||
(defn errout [arg]
|
||||
(buffer/push b arg))
|
||||
(assert (= 6 (with-dyns [*err* errout] (dummy 1 2 3))) "trace to custom err function")
|
||||
(assert (deep= @"trace (dummy 1 2 3)\n" b) "trace buffer correct"))
|
||||
|
||||
(def f (asm (disasm (fn [x] (fn [y] (+ x y))))))
|
||||
(assert (= ((f 10) 37) 47) "asm environment tables")
|
||||
|
||||
(end-suite)
|
||||
|
||||
55
test/suite0012.janet
Normal file
55
test/suite0012.janet
Normal file
@@ -0,0 +1,55 @@
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
# deal in the Software without restriction, including without limitation the
|
||||
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
# sell copies of the Software, and to permit persons to whom the Software is
|
||||
# furnished to do so, subject to the following conditions:
|
||||
#
|
||||
# The above copyright notice and this permission notice shall be included in
|
||||
# all copies or substantial portions of the Software.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 12)
|
||||
|
||||
(var counter 0)
|
||||
(def thunk (delay (++ counter)))
|
||||
(assert (= (thunk) 1) "delay 1")
|
||||
(assert (= counter 1) "delay 2")
|
||||
(assert (= (thunk) 1) "delay 3")
|
||||
(assert (= counter 1) "delay 4")
|
||||
|
||||
(def has-ffi (dyn 'ffi/native))
|
||||
|
||||
# FFI check
|
||||
(compwhen has-ffi
|
||||
(ffi/context))
|
||||
|
||||
(compwhen has-ffi
|
||||
(ffi/defbind memcpy :ptr [dest :ptr src :ptr n :size]))
|
||||
(compwhen has-ffi
|
||||
(def buffer1 @"aaaa")
|
||||
(def buffer2 @"bbbb")
|
||||
(memcpy buffer1 buffer2 4)
|
||||
(assert (= (string buffer1) "bbbb") "ffi 1 - memcpy"))
|
||||
|
||||
(compwhen has-ffi
|
||||
(assert (= 8 (ffi/size [:int :char])) "size unpacked struct 1")
|
||||
(assert (= 5 (ffi/size [:pack :int :char])) "size packed struct 1")
|
||||
(assert (= 5 (ffi/size [:int :pack-all :char])) "size packed struct 2")
|
||||
(assert (= 4 (ffi/align [:int :char])) "align 1")
|
||||
(assert (= 1 (ffi/align [:pack :int :char])) "align 2")
|
||||
(assert (= 1 (ffi/align [:int :char :pack-all])) "align 3")
|
||||
(assert (= 26 (ffi/size [:char :pack :int @[:char 21]])) "array struct size"))
|
||||
|
||||
(end-suite)
|
||||
|
||||
43
test/suite0013.janet
Normal file
43
test/suite0013.janet
Normal file
@@ -0,0 +1,43 @@
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
# deal in the Software without restriction, including without limitation the
|
||||
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
# sell copies of the Software, and to permit persons to whom the Software is
|
||||
# furnished to do so, subject to the following conditions:
|
||||
#
|
||||
# The above copyright notice and this permission notice shall be included in
|
||||
# all copies or substantial portions of the Software.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 13)
|
||||
|
||||
(assert (deep= (tabseq [i :in (range 3)] i (* 3 i))
|
||||
@{0 0 1 3 2 6}))
|
||||
|
||||
(assert (deep= (tabseq [i :in (range 3)] i)
|
||||
@{}))
|
||||
|
||||
(def- sym-prefix-peg
|
||||
(peg/compile
|
||||
~{:symchar (+ (range "\x80\xff" "AZ" "az" "09") (set "!$%&*+-./:<?=>@^_"))
|
||||
:anchor (drop (cmt ($) ,|(= $ 0)))
|
||||
:cap (* (+ (> -1 (not :symchar)) :anchor) (* ($) '(some :symchar)))
|
||||
:recur (+ :cap (> -1 :recur))
|
||||
:main (> -1 :recur)}))
|
||||
|
||||
(assert (deep= (peg/match sym-prefix-peg @"123" 3) @[0 "123"]) "peg lookback")
|
||||
(assert (deep= (peg/match sym-prefix-peg @"1234" 4) @[0 "1234"]) "peg lookback 2")
|
||||
|
||||
(assert (deep= (peg/replace-all '(* (<- 1) 1 (backmatch)) "xxx" "aba cdc efa") @"xxx xxx efa") "peg replace-all 1")
|
||||
|
||||
(end-suite)
|
||||
20
test/suite0014.janet
Normal file
20
test/suite0014.janet
Normal file
@@ -0,0 +1,20 @@
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 14)
|
||||
|
||||
(assert (deep=
|
||||
(peg/match '(not (* (constant 7) "a")) "hello")
|
||||
@[]) "peg not")
|
||||
|
||||
(assert (deep=
|
||||
(peg/match '(if-not (* (constant 7) "a") "hello") "hello")
|
||||
@[]) "peg if-not")
|
||||
|
||||
(assert (deep=
|
||||
(peg/match '(if-not (drop (* (constant 7) "a")) "hello") "hello")
|
||||
@[]) "peg if-not drop")
|
||||
|
||||
(assert (deep=
|
||||
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
|
||||
@[]) "peg if not")
|
||||
|
||||
(end-suite)
|
||||
44
test/suite0015.janet
Normal file
44
test/suite0015.janet
Normal file
@@ -0,0 +1,44 @@
|
||||
# test *debug* flags
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 15)
|
||||
|
||||
(assert (deep= (in (disasm (defn a [] (def x 10) x)) :symbolmap)
|
||||
@[[0 3 0 'a] [1 3 1 'x]])
|
||||
"symbolslots when *debug* is true")
|
||||
|
||||
(defn a [arg]
|
||||
(def x 10)
|
||||
(do
|
||||
(def y 20)
|
||||
(def z 30)
|
||||
(+ x y z)))
|
||||
(def symbolslots (in (disasm a) :symbolslots))
|
||||
(def f (asm (disasm a)))
|
||||
(assert (deep= (in (disasm f) :symbolslots)
|
||||
symbolslots)
|
||||
"symbolslots survive disasm/asm")
|
||||
|
||||
# need to fix upvalues
|
||||
(comment
|
||||
(setdyn *debug* true)
|
||||
(setdyn :pretty-format "%.40M")
|
||||
(def f (fn [x] (fn [y] (+ x y))))
|
||||
(assert (deep= (map last (in (disasm (f 10)) :symbolmap))
|
||||
@['x 'y])
|
||||
"symbolslots upvalues"))
|
||||
|
||||
(assert (deep= (in (disasm (defn a [arg]
|
||||
(def x 10)
|
||||
(do
|
||||
(def y 20)
|
||||
(def z 30)
|
||||
(+ x y z)))) :symbolmap)
|
||||
@[[0 7 0 'arg]
|
||||
[0 7 1 'a]
|
||||
[1 7 2 'x]
|
||||
[2 7 3 'y]
|
||||
[3 7 4 'z]])
|
||||
"arg & inner symbolslots")
|
||||
|
||||
(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